.TITLE FILEVMS .IDENT /850304/ ;+ ;.ENTRY FILEVMS ; - F I L E R S X ; FILE: FILEVMS.MAC ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT (BASED ON FLERSX OF CHRIS MEYERS) ; DATE: 25-FEB-85 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: MACRO SUPPORT ROUTINES FOR THE FLECS TRANSLATOR ROUTINES ; IN FILE FILE.FLX. ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: SEE INDIVIDUAL ROUTINES ; ;****NOTES: ; 1. These routines are supplied in MACRO instead of FORTRAN ; because similar VAX routines using FORTRAN READ/WRITES took four times ; as much CPU time as these MACRO routines! ;- ; Data .PSECT FLECS_DATA,WRT,NOEXE TRUE = -1 ;F77 TRUE FALSE= 0 ;F77 FALSE FLLFAB: $FAB FAC=,FOP=,MRS=132,ORG=SEQ,RAT=CR,RFM=VAR FLLRAB: $RAB FAB=FLLFAB,RAC=SEQ FLXFAB: $FAB FAC=GET,FOP= FLXRAB: $RAB FAB=FLXFAB,RAC=SEQ FTNFAB: $FAB FAC=,FOP=,MRS=80,ORG=SEQ,RAT=CR,RFM=FIX FTNRAB: $RAB FAB=FTNFAB,RAC=SEQ IMPFAB: $FAB FAC=,FOP=,MRS=80,ORG=SEQ,RAT=CR,RFM=VAR IMPRAB: $RAB FAB=IMPFAB,RAC=SEQ INCFAB1: $FAB FAC=GET,FOP= INCRAB1: $RAB FAB=INCFAB1,RAC=SEQ INCFAB2: $FAB FAC=GET,FOP= INCRAB2: $RAB FAB=INCFAB2,RAC=SEQ INCFAB3: $FAB FAC=GET,FOP= INCRAB3: $RAB FAB=INCFAB3,RAC=SEQ INFAB: .ADDRESS FLXFAB ;address of FABs for each .INCLUDE level .ADDRESS INCFAB1 .ADDRESS INCFAB2 .ADDRESS INCFAB3 INRAB: .ADDRESS FLXRAB ;address of RABs for each .INCLUDE level .ADDRESS INCRAB1 .ADDRESS INCRAB2 .ADDRESS INCRAB3 INRAB_CUR: .BLKL 1 ;address of current input RAB OPNFLL: .WORD 0 ;<>0 ==>FLL file open OPNFLX: .WORD 0 ;<>0 ==>FLX file open OPNFTN: .WORD 0 ;<>0 ==>FTN file open ; Code .PSECT CODE,NOWRT,EXE ;+ ;.ENTRY FCLOSE ; - F C L O S E ; IDENT: /850228/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: Close files for CLOSEF. ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FCLOSE ; ; INPUT: None ; ; MODIFIED: None ; ; OUTPUT: None ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: .FLX, .FTN, & .FLL files ; DEVICES: Device above files are on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $CLOSE ; ;****NOTES: ;- .ENTRY FCLOSE,^M<> TSTW OPNFLX ;.FLX file open? BEQL 10$ $CLOSE FAB=FLXFAB ;Yes, close FLX file CLRW OPNFLX ; and flag it closed 10$: TSTW OPNFTN ;.FTN FILE OPEN? BEQL 20$ $CLOSE FAB=FTNFAB ;YES, CLOSE IT CLRW OPNFTN ; and flag it closed 20$: TSTW OPNFLL ;.FLL FILE OPEN? BEQL 30$ $CLOSE FAB=FLLFAB ;YES, CLOSE IT CLRW OPNFLL ; and flag it closed 30$: RET ;+ ;.ENTRY FGET ; - F G E T ; IDENT: /850228/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: Get input line for GET. ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FGET (NCHAR,INPUT,EOF,ERR1,ERR2) ; ; INPUT: None ; ; MODIFIED: None ; ; OUTPUT: ; ; NCHAR = (I*2) # of characters in INPUT ; INPUT = (I*2) line read from input file ; EOF = (L*2) .T.==>read end-of-file on input ; ERR1 = (I*2) IO error code, 0==>no error ; ERR2 = (I*2) IO error type (defined only if ERR1<>0) ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: Current input file (.FLX or .INCLUDE) ; DEVICES: Device file is on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $FAB_STORE, $GET ; ;****NOTES: ;- .ENTRY FGET,^M CLRW @12(AP) ;ASSUME NO ERRORS CLRW @16(AP) CLRW @20(AP) MOVL INRAB_CUR,R2 ;addr current input RAB $RAB_STORE - RAB = R2, - UBF = @8(AP), - ;addr buffer USZ = #80 ;buffer size $GET RAB=R2 BLBC R0,10$ ;ANY ERRORS? 5$: MOVW RAB$W_RSZ(R2),@4(AP) ;NO, GET # CHAR INPUT RET 10$: CMPL #RMS$_EOF,R0 ;EOF ERROR? BNEQ 20$ MOVW #TRUE,@12(AP) ;YES RET 20$: MOVW RAB$L_STS(R2),@16(AP) ;RETURN ERROR MOVW RAB$L_STV(R2),@20(AP) ;RETURN ERROR CLASS BRB 5$ ;PROCESS WHAT WE GOT ;+ ;.ENTRY FIMPCL ; - F I M P C L ; IDENT: /850228/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: Close a file for IMPCLS ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FIMPCL ; ; INPUT: None ; ; MODIFIED: None ; ; OUTPUT: None ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: Innnnn.FID ; DEVICES: device file is on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $CLOSE ; ;****NOTES: ;- .ENTRY FIMPCL,^M<> $CLOSE FAB=IMPFAB ;close the file RET ;+ ;.ENTRY FIMPOP ; - F I M P O P ; IDENT: /850304/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ; 850304mao New calling sequence for subroutine. ;+ ; ;****PURPOSE: Open a file for IMPOPN ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FIMPOP (NAME,IMPDSC) ; ; INPUT: ; ; NAME = (byte array) file name ; IMPDSC= (2X4 I*2 array) Descriptor for file name, see note 1. ; ; MODIFIED: None ; ; OUTPUT: None ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: In.FID ; DEVICES: device file is on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $FAB_STGORE, $CREATE, $CONNECT ; ;****NOTES: ; 1. THE DSC ARRAYS ARE ARRANGED AS FOLLOWS: ; XDSC(M,1) = INFORMATION FOR DEVICE ; XDSC(M,2) = INFORMATION FOR DIRECTORY ; XDSC(M,3) = INFORMATION FOR FILE NAME ; XDSC(M,4) = INFORMATION FOR THE WHOLE FILE NAME INC DEV, DIR, NAME. ; ; XDSC(1,N) = LENGTH OF THE FIELD (0==>NO FIELD IN INPUT) ; XDSC(2,N) = INDEX IN ARRAY XNAME OF THE START OF THE FIELD ;- .ENTRY FIMPOP,^M ADDL3 #12,8(AP),R2 ;addr of length of filename MOVZWL 2(R2),R3 ;array index DECL R3 ; offset ADDL2 4(AP),R3 ;addr of specifier $FAB_STORE - FAB=IMPFAB, - FNS=(R2), FNA=(R3) $CREATE FAB=IMPFAB $CONNECT RAB=IMPRAB RET ;+ ;.ENTRY FIMPWR ; - F I M P W R ; IDENT: /850228/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: Write a line to a file for IMPWRT ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FIMPWR (LINE, LEN) ; ; INPUT: ; ; LINE = (byte array) line to output ; LEN = (I*2) length of LINE in bytes ; ; MODIFIED: None ; ; OUTPUT: None ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: In.FID ; DEVICES: device file is on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $RAB_STORE, $PUT ; ;****NOTES: ;- .ENTRY FIMPWR,^M<> $RAB_STORE - RAB=IMPRAB, - RBF=@4(AP), - RSZ=@8(AP) $PUT RAB=IMPRAB RET ;+ ;.ENTRY FOPN ; - F O P N ; IDENT: /850228/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: Open .FLX, .FTN & .FLL files for OPENF. ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: ; ; CALL FOPN (LINE,FLXDEF,FLXDSC,FORT,FTNDEF,FTNDSC, ; LIST,FLLDEF,FLLDSC,ERRNUM) ; ; INPUT: ; ; LINE = (BYTE ARRAY) LINE CONTAINING FILE NAMES. ; FLXDEF= (4L*1) DEFAULT FILE EXTENSION IN ASCII (EG. ".FLX"). ; FLXDSC= (2X4 I*2 ARRAY) DESCRIPTOR FOR FILE NAME, SEE NOTE 1. ; FORT = (L*2) .T. IF SHOULD OPEN .FTN OUTPUT FILE ; FTNDEF= (4L*1) DEFAULT FILE EXTENSION IN ASCII (EG. ".FTN"). ; FTNDSC= (2X4 I*2 ARRAY) DESCRIPTOR FOR FILE NAME, SEE NOTE 1. ; LIST = (L*2) .T. IF SHOULD OPEN .FLL OUTPUT FILE ; FLLDEF= (4L*1) DEFAULT FILE EXTENSION IN ASCII (EG. ".ALL"). ; FLLDSC= (2X4 I*2 ARRAY) DESCRIPTOR FOR FILE NAME, SEE NOTE 1. ; ; MODIFIED: None ; ; OUTPUT: ; ; ERRNUM = (I*2) ERROR STATUS ; = 0, SUCCESS ; = 1, OPEN ERROR ON .FLX FILE ; = 2, OPEN ERROR ON .FTN FILE ; = 3, OPEN ERROR ON .FLL FILE ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: .FLX, .FTN & .FLL files ; DEVICES: Device files are on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $FAB_STORE, $OPEN, $CONNECT, $CREATE, $CLOSE ; ;****NOTES: ; 1. THE DSC ARRAYS ARE ARRANGED AS FOLLOWS: ; XDSC(M,1) = INFORMATION FOR DEVICE ; XDSC(M,2) = INFORMATION FOR DIRECTORY ; XDSC(M,3) = INFORMATION FOR FILE NAME ; XDSC(M,4) = INFORMATION FOR THE WHOLE FILE NAME INC DEV, DIR, NAME. ; ; XDSC(1,N) = LENGTH OF THE FIELD (0==>NO FIELD IN INPUT) ; XDSC(2,N) = INDEX IN ARRAY XNAME OF THE START OF THE FIELD ;- .ENTRY FOPN,^M CLRW @40(AP) ;ASSUME SUCCESS ;-------------------------------------------------------------------- ; Open .FLX input file ;-------------------------------------------------------------------- ADDL3 #12,12(AP),R2 ;ADDR OF LEN OF TOTAL FILENAME MOVZWL 2(R2),R3 ;array index DECL R3 ; offset ADDL2 4(AP),R3 ;Addr of specifier $FAB_STORE - FAB=FLXFAB,- DNS=#4,DNA=@8(AP), - ;DEFAULT EXTENSION FNS=(R2),FNA=(R3) ;GIVEN FILE NAME $OPEN FAB=FLXFAB ;Open the file BLBS R0,20$ 10$: MOVW #1,@40(AP) ;FLAG OPEN ERROR ON FLX FILE BRW 1000$ 20$: INCW OPNFLX ;FLAG AS OPEN $CONNECT RAB=FLXRAB BLBC R0,10$ MOVAL FLXRAB,INRAB_CUR ;CURRENT INPUT RAB ADDRESS CMPW @16(AP),#FALSE ;IS THERE TO BE AN FTN FILE? BEQL 200$ ;------------------------------------------------------------------ ; YES, Open the .FTN code output file ;------------------------------------------------------------------ ADDL3 #12,24(AP),R2 ;ADDR OF LENGTH OF WHOLE FILENAME MOVZWL 2(R2),R3 ;array index DECL R3 ; offset ADDL2 4(AP),R3 ;addr of specifier $FAB_STORE - FAB=FTNFAB, - DNS=#4,DNA=@20(AP), - ;DEFAULT EXTENSION FNS=(R2),FNA=(R3) ;GIVEN FILE NAME $CREATE FAB=FTNFAB BLBS R0,120$ 110$: MOVW #2,@40(AP) ;FLAG AS OPEN ERROR ON FTN FILE BRW 1000$ 120$: INCW OPNFTN ;FLAG .FTN FILE AS OPEN $CONNECT RAB=FTNRAB BLBC R0,110$ 200$: CMPW @28(AP),#FALSE ;IS THERE TO BE AN FLL FILE? BEQL 300$ ;------------------------------------------------------------------ ; YES, Open the .FLL/.ALL listing file ;------------------------------------------------------------------ ADDL3 #12,36(AP),R2 ;ADDR OF LENGTH OF WHOLE FILENAME MOVZWL 2(R2),R3 ;array index DECL R3 ; offset ADDL2 4(AP),R3 ;addr of specifier $FAB_STORE - FAB=FLLFAB, - DNS=#4,DNA=@32(AP), - ;DEFAULT EXTENSION FNS=(R2),FNA=(R3) ;GIVEN FILE NAME $CREATE FAB=FLLFAB BLBS R0,220$ 210$: MOVW #3,@40(AP) ;FLAG AS OPEN ERROR ON FLL FILE BRB 1000$ 220$: INCW OPNFLL ;FLAG AS OPEN $CONNECT RAB=FLLRAB BLBC R0,210$ 300$: RET ;----------------------------------------------------------------- ; On open error, close open files, deleting output files ;----------------------------------------------------------------- 1000$: TSTW OPNFLX ;.FLX file open? BEQL 1100$ $CLOSE FAB=FLXFAB ;CLOSE FLX FILE CLRW OPNFLX 1100$: TSTW OPNFTN ;.FTN file open? BEQL 1200$ BISL2 #FAB$M_DLT, - ;Yes, close and delete .FTN file FTNFAB+FAB$L_FOP $CLOSE FAB=FTNFAB BICL2 #FAB$M_DLT, - ;Clear bit for future use of FAB FTNFAB+FAB$L_FOP CLRW OPNFTN ;Flag it as closed 1200$: TSTW OPNFLL ;.FLL file open? BEQL 1300$ BISL2 #FAB$M_DLT, - ;Yes, close and delete .FLL file FLLFAB+FAB$L_FOP $CLOSE FAB=FLLFAB BICL2 #FAB$M_DLT, - ;Clear bit for future use of FAB FLLFAB+FAB$L_FOP CLRW OPNFLL ;Flag it as closed 1300$: RET ;+ ;.ENTRY FOPNIN ; - F O P N I N ; IDENT: /850304/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ; 850403mao New arguments in call. ;+ ; ;****PURPOSE: Open an .INCLUDE file for OPNINC. ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FOPNIN(INCLVL,NAME,FILDSC,IERR) ; ; INPUT: ; ; INCLVL= (I*2) INCLUDE level of file to open ; NAME = (byte array) name of file ; FILDSC= (2X4 I*2 array) descriptor for filename, see note 1. ; ; MODIFIED: None ; ; OUTPUT: ; ; IERR = (I*2) 0==> success, <>0 ==> failure ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: .INCLUDE file ; DEVICES: Device file is on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $FAB_STORE, $OPEN, $CONNECT, $CLOSE ; ;****NOTES: ; 1. THE DSC ARRAYS ARE ARRANGED AS FOLLOWS: ; XDSC(M,1) = INFORMATION FOR DEVICE ; XDSC(M,2) = INFORMATION FOR DIRECTORY ; XDSC(M,3) = INFORMATION FOR FILE NAME ; XDSC(M,4) = INFORMATION FOR THE WHOLE FILE NAME INC DEV, DIR, NAME. ; ; XDSC(1,N) = LENGTH OF THE FIELD (0==>NO FIELD IN INPUT) ; XDSC(2,N) = INDEX IN ARRAY XNAME OF THE START OF THE FIELD ;- .ENTRY FOPNIN,^M CLRW @16(AP) ;assume success MOVZWL @4(AP),R2 ;include level MULL2 #4,R2 ;Offset in RAB/FAB lists ADDL3 #INFAB,R2,R3 ;Get addr of addr of FAB ADDL3 #12,12(AP),R4 ;Address of len of filename MOVZWL 2(R4),R5 ;array index DECL R5 ; offset ADDL2 8(AP),R5 ;addr of specifier $FAB_STORE - FAB = @(R3), - FNS=(R4),FNA=(R5) $OPEN FAB = @(R3) BLBC R0,100$ ADDL2 #INRAB,R2 ;Get addr of addr of RAB $CONNECT RAB = @(R2) BLBS R0,20$ $CLOSE FAB = @(R3) ;connect error, close the file BRB 100$ 20$: MOVL (R2),INRAB_CUR ;save addr current RAB RET 100$: MOVW #1,@16(AP) ;flag as an error RET ;+ ;.ENTRY FPUT ; - F P U T ; IDENT: /850228/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: Output to .FLL or .FTN file for PUT. ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FPUT (CLASS,LINE,LEN) ; ; INPUT: ; ; CLASS = (I*2) IO class for output: 1-->FTN, 2-->FLL ; LINE = (byte array) line to output ; LEN = (I*2) number of bytes in the array ; ; MODIFIED: None ; ; OUTPUT: None ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: .FTN or .FLL file ; DEVICES: Device file is on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $RAB_STORE, $PUT ; ;****NOTES: ;- .ENTRY FPUT,^M<> CMPW @4(AP),#1 ;FORT OUTPUT? BNEQ 20$ $RAB_STORE - RAB=FTNRAB,- RBF = @8(AP), - ;addr user buffer RSZ = @12(AP) ;buffer length $PUT RAB=FTNRAB RET 20$: ; Must be listing file output $RAB_STORE - RAB = FLLRAB, - RBF = @8(AP), - RSZ = @12(AP) $PUT RAB=FLLRAB RET ;+ ;.ENTRY FROPN ; - F R O P N ; IDENT: /850228/ ; FILE: FILEVMS.MAR ; SYSTEM: VMS V4.0 ; LANGUAGE: MACRO 32 ; AUTHOR: M. OOTHOUDT ; DATE: 850228 ;- ; REFERENCES: ; ; REVISIONS: ;+ ; ;****PURPOSE: Reopen previous level of .INCLUDE for ROPN. ; ;****RESTRICTIONS: ; ;****CALLING SEQUENCE: CALL FROPN (INCLVL,CLS) ; ; INPUT: ; ; INCLVL= (I*2) .INCLUDE level to go to ; CLS = (L*2) .T. ==> close file for next deeper .INCLUDE level ; ; MODIFIED: None ; ; OUTPUT: None ; ; CMN BLOCKS USED: None ; ;****RESOURCES: ; LIBRARIES: None ; OTHER SUBR: None ; DISK FILES: .INCLUDE files ; DEVICES: Device file is on ; SGAS: None ; EVENT FLAGS: None ; SYSTEM DIR: $CLOSE ; ;****NOTES: ; 1. Under VMS there is no need to close a file in order to open ; a more deeply nested .INCLUDE file. Thus this routine only resets ; pointers to the proper RAB. (It may close a more deeply nested ; .INCLUDE file if requested by the caller.) ;- .ENTRY FROPN,^M MOVZWL @4(AP),R2 ;new include level MULL2 #4,R2 ;offset to RAB/FAB ADDL3 #INRAB,R2,R3 MOVL (R3),INRAB_CUR ;new RAB address CMPW @8(AP),#FALSE ;close old level? BEQL 100$ ADDL2 #INFAB,R2 ;yes, find the FAB ADDL2 #4,R2 ;addr of old file's FAB addr $CLOSE FAB = @(R2) ;close it 100$: RET .END