Trailing-Edge
-
PDP-10 Archives
-
KS10_APT_INSTALL_TAPE
-
uetp/lib/cmlbfl.mac
There is 1 other file named cmlbfl.mac in the archive. Click here to see a list.
TITLE FLFDA FIND OUT EVERYTHING ABOUT THE FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLFDA
;ROUTINE TO FIND OUT EVERYTHING THERE IS TO KNOW ABOUT
;A FILE. ENTER WITH T1 POINTING TO AN ARGUMENT BLOCK.
;THIS ARGUMENT BLOCK SHOULD BE SET UP WITH THE JFN IN
;WORD F%%JFN AND WITH POINTERS TO BUFFERS FOR FILE
;NAME DETAILS IN OTHER SPECIFIED LOCATIONS. (SEE DEFINITION
;OF ARGUMENT BLOCK IN "CMLBSM"). IF WORD F%%EXI IS NON-ZERO
;THE ROUTINE WILL LOOK FOR ASSOCIATED FILES AND WILL
;RETURN FLAGS IN F%%EXI. FLAGS ARE RETURNED IN F%%TYP
;INDICATING THE FILE TYPE. RETURN IS SKIP WITH T1
;POINTING TO THE ARGUMENT BLOCK. ALL DETAILS FROM THE
;FDB WILL BE FOUND IN THIS BLOCK. RETURN IS NON-SKIP
;FOR ERROR. IF F%%DRF=0 DIRECTORY DETAILS WILL BE FOUND AS WELL.
FLFDA: PUSH P,T1 ;SAVE POINTER TO ARG BLOCK
SETZM F%%TST(T1) ;NO TEST YET
PUSHJ P,FLFDT## ;GET FULL DETAILS OF THE FILE.
PJRST T1POPJ## ;SHOULD NOT HAPPEN!
MOVE T1,(P) ;RETORE POINTER TO BLOCK
SKIPN F%%EXI(T1) ;DOES HE WANT MORE?
JRST FLFLP1 ;NO
SETZM F%%EXI(T1) ;CLEAR FLAGS
SKIPE T2,F%%TST(T1) ;DO WE HAVE A TEST?
PUSHJ P,(T2) ;FIND DEPENDENT FILES
FLFLP1: SKIPN F%%DRF(T1) ;DO WE WANT DIRECTORY DETAILS ALSO
PUSHJ P,DIRFDA## ;YES
PJRST FLFOK## ;OK
PRGEND
TITLE DIRFDA FIND OUT SOME DETAILS OF A DIRECTORY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY DIRFDA
;ROUTINE TO FIND SOME DETAILS ABOUT A DIRECTORY. ENTER
;WITH T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN
;"CMLBSM" FOR LOOKUPS. THE STRUCTURE AND THE DIRECTORY
;NAME SHOULD BE POINTED TO BY THE VARIOUS POINTERS IN
;THIS ARGUMENT BLOCK. THE ROUTINE PERFORMS A "RCUSR"
;JSYS AND RETURNS THE DIRECTORY NUMBER AND FLAGS IN
;F%%DRF IN THE BLOCK. IT ALSO LOOKS AT ALL THE JOBS TO
;SEE WHETHER ANYBODY IS LOGGED IN TO THE DIRECTORY OR
;IS CONNECTED TO IT. IF SO, D%%LGC IS SET IN F%%DFL.
DIRFDA: PUSH P,T1 ;SAVE POINTER TO ARGUMENT BLOCK
PUSH P,OUTP ;THIS IS A KLUDGE
HRROI OUTP,SPACE## ;WRITE RESULT IN CORE
HRRZ T1,F%%JFN(T1) ;GET JFN
MOVX T2,<S%%STR+S%%DIR> ;JUST NAME AND DIRECTORY
PUSHJ P,OTPFSP## ;PRINT IT
POP P,OUTP ;RESTORE LOG FILE JFN
MOVE A,(P) ;POINT TO BLOCK
HRROI T2,SPACE## ;POINT TO SPECIFICATION
MOVX T1,RC%EMO ;EXACT MATCH REQUIRED
RCDIR ;FIND IT
TXNE T1,<RC%NOM+RC%AMB> ;PROBLEMS?
SETZM T3 ;IGNORE IT THEN
MOVEM T3,F%%DRF(A) ;STORE RESULT
HLLZM T1,F%%DFL(A) ;SAVE FLAGS
MOVE B,F%%DRF(A) ;GET OUR DIRECTORY NUMBER
SETZM D ;START AT JOB 0
DIRFLP: MOVE T1,D ;GET INDEX INTO TABLE
MOVE T2,[-.JILNO-1,,SPACE##] ;WHERE TO PUT INFO
SETZM T3
GETJI ;GET SOME JOB INFORMATION
JRST GTJER ;ERROR
CAME B,SPACE##+.JILNO ;MATCH WITH LOGGED IN DIRECTORY?
CAMN B,SPACE##+.JIDNO ;OR CONNECTED DIRECTORY?
JRST LGCON ;YES
DIRFL1: AOJA D,DIRFLP ;DO ALL
PJRST T1POPJ## ;RETURN
LGCON: MOVX T1,D%%LGC ;SET FLAG
IORM T1,F%%DFL(A) ;IN BLOCK
PJRST T1POPJ## ;RETURN
PAGE
GTJER: CAIN T1,GTJIX3 ;ALL DONE?
PJRST T1POPJ## ;YES
JRST DIRFL1 ;LOOK AT NEXT
PRGEND
TITLE FLFDT FIND FULL DETAILS OF A FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLFDT
;ROUTINE TO FIND FULL DETAILS OF A FILE. ENTER WITH T1 POINTING
;TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM". THIS ARGUMENT
;BLOCK SHOULD BE FILLED AS DESCRIBED FOR ROUTINE "FLFDA".
;RETURN IS SKIP IF OK, OF NON-SKIP FOR ERROR. THE ARG BLOCK
;IS FILLED WITH ITEMS FROM THE FDB AS WELL AS FLAGS IN F%%TYP
;AND THE FULL NAME IS PUT INTO THE APPROPRIATE PLACES.
FLFDT: PUSH P,T1 ;SAVE POINTER TO ARG BLOCK
PUSHJ P,FLFDN## ;GET FILE NAME
PJRST T1POPJ## ;SHOULD NOT HAPPEN
MOVE T3,(P) ;RESTORE POINTER TO ARG BLOCK
HRRZ T1,F%%JFN(T3) ;GET JFN
MOVE T2,[.FBGNL,,.FBHDR] ;WHAT TO READ
MOVEI T3,F%%HDR(T3) ;WHERE TO READ IT
GTFDB ;GET IT
ERJMP FLFJNK## ;SHOULD NOT HAPPEN
MOVE T1,(P) ;RESTORE POINTER
PUSHJ P,FLFTP## ;FIND FILE TYPE
PUSHJ P,FLSYFK## ;A KNOWN FILENAME?
JRST FLFOK## ;OK
PRGEND
TITLE FLSYFK CHECK IF FILE IS A KNOWN SYSTEM FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLSYFK
;ROUTINE TO ESTABLISH WHETHER THE CURRENT FILE IS ONE
;OF THE FILES COMMONLY USED ON THE SYSTEM. IF SO SET
;FLAG T%%SFK IN F%%TYP. ENTER WITH T1 POINTING TO AN
;ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM" FOR LOOKUPS.
;THE FULL FILESPEC SHOULD BE POINTED TO BY THE VARIOUS
;POINTERS IN THIS BLOCK. THIS ROUTINE CHECKS THE
;FILENAME AND EXTENSION AGAINST NAMES, SUCH AS "MAIL.TXT"
;AND WILL SET THE FLAG IF IT IS ONE OF THESE FILES.
;RETURN IS +1 ALWAYS.
FLSYFK: PUSH P,T1 ;SAVE POINTER TO ARGUMENT BLOCK
HRRO T2,F%%NAM(T1) ;POINT TO NAME
MOVEI T1,SYFKTB ;POINT TO TABLE
TBLUK ;FIND IT
TXNN T2,TL%EXM ;GOOD MATCH?
JRST T1POPJ## ;NO
HRROS T2 ;POINT TO EXTENSION
MOVE T1,(P) ;POINT TO ARG BLOCK
HRRO T1,F%%EXT(T1) ;POINT TO EXTENSION
STCMP ;MATCH?
JUMPN T1,T1POPJ## ;SO NEAR YET...
MOVE T1,(P) ;POINT TO ARG BLOCK
MOVX T2,T%%SFK ;SET FLAG
IORM T2,F%%TYP(T1) ;SET IT
PJRST T1POPJ## ;ALL DONE
;TABLE OF KNOWN FILES
SYFKTB: SYFSIZ,,SYFMAX
DMPNAM BATCH,CMD
DMPNAM LOGIN,CMD
DMPNAM MAIL,TXT
DMPNAM SWITCH,INI
SYFSIZ==.-SYFKTB-1
SYFMAX==SYFSIZ+1
PRGEND
TITLE FLFDN ROUTINE TO GET FULL NAME FOR FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLFDN
;ROUTINE TO GET FULL FILESPEC FOR FILE. ENTER WITH T1
;POINTING TO ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM" WITH
;THE JFN FOR THE FILE IN F%%JFN. POINTERS SHOULD BE SET
;UP IN THIS BLOCK POINTING TO BUFFERS WHERE VARIOUS
;PARTS OF THE FILESPEC ARE TO BE STORED. RETURN IS SKIP
;IF OK, OR NON-SKIP IF ERROR OCCURRED. ON RETURN, THE
;FULL FILENAME WITH PROTECTION AND ACCOUNT REFERENCE
;ARE RETURNED IN THE ARGUMENT BLOCK.
FLFDN: PUSH P,T1 ;SAVE POINTER TO ARG BLOCK
MOVE A,T1 ;MAKE "A" POINT TO ARG BLOCK
HRRZ T2,F%%JFN(A) ;GET JFN
HRRO T1,F%%STR(A) ;GET STRUCTURE
MOVX T3,<FLD(1,JS%DEV)>
JFNS ;WRITE IT
ERJMP FLFJNK## ;BAD
HRRO T1,F%%DIR(A) ;GET DIRECTORY
MOVX T3,<FLD(1,JS%DIR)>
JFNS ;WRITE IT
ERJMP FLFJNK## ;BAD
HRRO T1,F%%NAM(A) ;GET NAME
MOVX T3,<FLD(1,JS%NAM)>
JFNS
ERJMP FLFJNK## ;BAD
HRRO T1,F%%EXT(A) ;GET EXTENSION
MOVX T3,<FLD(1,JS%TYP)>
JFNS
ERJMP FLFJNK## ;BAD
HRRO T1,F%%PTC(A) ;PROTECTION
MOVX T3,<FLD(1,JS%PRO)>
JFNS
ERJMP FLFJNK## ;BAD
HRRO T1,F%%ACC(A) ;ACCOUNT
MOVX T3,<FLD(1,JS%ACT)>
JFNS
ERJMP FLFJNK## ;BAD
PJRST FLFOK## ;OK
PRGEND
TITLE FLFTP ROUTINE TO ESTABLISH FILE TYPE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLFTP
;ROUTINE TO ESTABLISH FILE TYPE. ENTER WITH T1 POINTING TO
;ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM" WITH AT LEAST THE
;EXTENSION OF THE FILE POINTED TO BY F%%EXT OF THE BLOCK.
;RETURN IS +1 WITH FLAGS SET IN F%%TYP DEPENDING ON THE
;EXTENSION OF THE FILE. FLAGS ARE DEFINED IN "CMLBSM".
FLFTP: PUSH P,T1 ;SAVE POINTER TO ARG BLOCK
SETZM F%%TYP(T1) ;NO FLAGS YET
HRRO T2,F%%EXT(T1) ;POINT TO EXTENSION
MOVEI T1,EXTTAB ;POINT TO TABLE
TBLUK ;FIND IT
HRRZ T3,(T1) ;GET DISPATCH
MOVE T1,(P) ;RETORE POINTER TO ARG BLOCK
TXNN T2,TL%EXM ;EXACT MATCH?
MOVEI T3,EXTNOP ;NO-ASSUME NOTHING
MOVE T2,(T3) ;GET FLAGS
IORM T2,F%%TYP(T1) ;SET FLAGS
MOVE T2,1(T3) ;GET TEST ROUTINE
MOVEM T2,F%%TST(T1) ;SAVE IT
PJRST T1POPJ## ;RETURN
PAGE
;TABLE OF RECOGNISED EXTENSIONS
EXTTAB: EXTSIZ,,EXTMAX
TB (EXTALG,ALG) ;ALGOL
TB (EXTB20,B20) ;BASIC PLUS
TB (EXTBAK,BAK) ;TECO BACKUP
TB (EXTBAS,BAS) ;OLD BASIC
TB (EXTBLI,BLI) ;BLISS
TB (EXTCCL,CCL) ;OLD CCL
TB (EXTCBL,CBL) ;COBOL FILE
TB (EXTCMD,CMD) ;CMD FILE
TB (EXTCRF,CRF) ;CREF FILE
TB (EXTCTL,CTL) ;BATCH CONTROL
TB (EXTDAT,DAT) ;DAT FILE
TB (EXTDOC,DOC) ;DOCUMENTATION FILE
TB (EXTEXE,EXE) ;EXE FILE
TB (EXTF10,F10) ;F10 FILE
TB (EXTF40,F40) ;OLD F40 FILE
TB (EXTFOR,FOR) ;FORTRAN FILE
TB (EXTHLP,HLP) ;HELP FILE
TB (EXTIDA,IDA) ;IDA FILE
TB (EXTIDX,IDX) ;IDX FILE
TB (EXTLOG,LOG) ;LOG FILE
TB (EXTLST,LST) ;LST FILE
TB (EXTMAC,MAC) ;MACRO FILE
TB (EXTMEM,MEM) ;MEM FILE
TB (EXTQ10,Q10) ;EDIT BACKUP F10
TB (EXTQ20,Q20) ;EDIT BACKUP B20
TB (EXTQ40,Q40) ;EDIT BACKUP F40
TB (EXTQAC,QAC) ;EDIT BACKUP MAC
TB (EXTQBL,QBL) ;EDIT BACKUP COBOL
TB (EXTQCL,QCL) ;EDIT BACKUP CCL
TB (EXTQEM,QEM) ;EDIT BACKUP MEM
TB (EXTQLG,QLG) ;EDIT BACKUP ALGOL
TB (EXTQLI,QLI) ;EDIT BACKUP BLISS
TB (EXTQMD,QMD) ;EDIT BACKUP CMD
TB (EXTQND,QND) ;EDIT BACKUP RND
TB (EXTQNH,QNH) ;EDIT BACKUP RNH
TB (EXTQNO,QNO) ;EDIT BACKUP RNO
TB (EXTQOC,QOC) ;EDIT BACKUP DOC
TB (EXTQOR,QOR) ;EDIT BACKUP FOR
TB (EXTQTL,QTL) ;EDIT BACKUP CTL
TB (EXTQXT,QXT) ;EDIT BACKUP TXT
TB (EXTREL,REL) ;REL FILE
TB (EXTRND,RND) ;RND FILE
TB (EXTRNH,RNH) ;RNH FILE
TB (EXTRNO,RNO) ;RNO FILE
TB (EXTSAV,SAV) ;OLD SAV FILE
TB (EXTTMP,TMP) ;TMP FILE
TB (EXTTXT,TXT) ;TEXT FILE
TB (EXTUNV,UNV) ;UNIVERSAL FILE
EXTSIZ==.-EXTTAB-1
EXTMAX==EXTSIZ+1
PAGE
;FLAGS AND TEST ROUTINES FOR ABOVE
EXTSAV: T%%SAV ;FILE IS SAV FILE
EXIREL## ;TEST FOR REL
EXTEXE: T%%EXE ;FILE IS EXE
EXIREL## ;TEST FOR REL
EXTREL: T%%REL ;FILE IS REL
EXISRC## ;LOOK FOR SOURCE
EXTUNV: T%%UNV ;FILE IS UNV
EXIMAC## ;LOOK FOR MACRO SOURCE
EXTCRF: T%%CRF ;FILE IS UNPROCESSED CREF
EXISRC## ;TEST FOR SOURCE
EXTLST: T%%LST ;FILE IS LST
EXISRC## ;TEST FOR SOURCE
EXTTXT: T%%TXT ;FILE IS TXT
CPOPJ## ;NO TEST
EXTDOC: T%%DOC ;FILE IS DOC
EXIRND## ;TEST FOR RND FILE
EXTMEM: T%%MEM ;FILE IS MEM
EXIRNO## ;TEST FOR RNO
EXTHLP: T%%HLP ;FILE IS HLP
EXIRNH## ;TEST FOR RNH
EXTRNO: T%%RNO ;FILE IS RNO
CPOPJ## ;NO TEST
EXTRNH: T%%RNH ;FILE IS RNH
CPOPJ## ;NO TEST
EXTRND: T%%RND ;FILE IS RND
CPOPJ## ;NO TEST
EXTDAT: T%%DAT ;FILE IS DAT
EXIDAT## ;CHECK TYPE
EXTIDA: T%%IDA ;FILE IS IDA
EXIIDX## ;LOOK FOR IDX
EXTIDX: T%%IDX ;FILE IS IDX
EXIIDA## ;LOOK FOR IDA
PAGE
EXTALG:
EXTMAC:
EXTFOR:
EXTCBL:
EXTB20:
EXTF10:
EXTF40:
EXTBLI: T%%SRC ;FILE IS REL-GENERATING SOURCE
CPOPJ## ;NO TEST
EXTCTL: T%%CTL ;FILE IS CTL
CPOPJ## ;NO TEST
EXTLOG: T%%LOG ;FILE IS LOG
EXICTL## ;LOOK FOR CTL
EXTCMD: T%%CMD ;FILE IS CMD
CPOPJ## ;NO TEST
EXTCCL: T%%CCL ;FILE IS CCL
CPOPJ## ;NO TEST
EXTTMP: T%%TMP ;FILE IS TMP
CPOPJ## ;NO TEST
EXTBAS: T%%WSP ;FILE IS OLD BASIC
CPOPJ## ;NO TEST
EXTQAC: T%%BAK ;BACKUP OF MAC
EXIMAC## ;LOOK FOR MAC
EXTQOR: T%%BAK ;BACKUP OF FOR
EXIFOR## ;LOOK FOR FOR
EXTQBL: T%%BAK ;BACKUP OF CBL
EXICBL## ;LOOK FOR CBL
EXTQ20: T%%BAK ;BACKUP OF B20
EXIB20## ;LOOK FOR B20
EXTQ10: T%%BAK ;BACKUP OF F10
EXIF10## ;LOOK FOR F10
EXTQ40: T%%BAK ;BACKUP OF F40
EXIF40## ;LOOK FOR F40
PAGE
EXTQLG: T%%BAK ;BACKUP OF ALG
EXIALG## ;LOOK FOR ALG
EXTQLI: T%%BAK ;BACKUP OF BLI
EXIBLI## ;LOOK FOR BLI
EXTQNO: T%%BAK ;BACKUP OF RNO
EXIRNO## ;LOOK FOR RNO
EXTQNH: T%%BAK ;BACKUP OF RNH
EXIRNH## ;LOOK FOR RNH
EXTQND: T%%BAK ;BACKUP OF RND
EXIRND## ;LOOK FOR RND
EXTQXT: T%%BAK ;BACKUP OF TXT
EXITXT## ;LOOK FOR TXT
EXTQOC: T%%BAK ;BACKUP OF DOC
EXIDOC## ;LOOK FOR DOC
EXTQEM: T%%BAK ;BACKUP OF MEM
EXIMEM## ;LOOK FOR MEM
EXTQTL: T%%BAK ;BACKUP OF CTL
EXICTL## ;LOOK FOR CTL
EXTQMD: T%%BAK ;BACKUP FOR CMD
EXICMD## ;LOOK FOR CMD
EXTQCL: T%%BAK ;BACKUP FOR CCL
EXICCL## ;LOOK FOR CCL
EXTBAK: T%%BAK ;BACKUP FROM TECO
EXISRC## ;LOOK FOR SOURCE
EXTNOP: T%%UNK ;UNKNOWN TYPE
CPOPJ## ;NO TEST
PRGEND
TITLE EXISRC TEST FOR EXISTENCE OF SRC FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY EXISRC
;ROUTINE TO TEST FOR EXISTENCE OF A SRC FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXISRC: PUSHJ P,EXIMAC## ;LOOK FOR MACRO
PUSHJ P,FNDIT ;FOUND IT?
PUSHJ P,EXIFOR## ;TRY FORTRAN
PUSHJ P,FNDIT ;FOUND IT?
PUSHJ P,EXICBL## ;TRY COBOL
PUSHJ P,FNDIT ;FOUND IT
PUSHJ P,EXIB20## ;BASIC?
PUSHJ P,FNDIT
PUSHJ P,EXIF10## ;LOOK FOR OLD F10
PUSHJ P,FNDIT
PUSHJ P,EXIF40## ;NOW SCRAPE THE BARREL!
PUSHJ P,FNDIT
PUSHJ P,EXIALG## ;LOOK FOR ALGOL
PUSHJ P,FNDIT
PUSHJ P,EXIBLI## ;BLISS IS IGNORANCE!
POPJ P, ;ALL DONE
;HERE TO TEST IF WE HAVE FOUND IT
FNDIT: MOVX T2,<E%%SRC> ;FLAG BEEN SET YET?
TDNE T2,F%%EXI(T1) ;LOOK
POP P,(P) ;GO UP A LEVEL
POPJ P, ;AND RETURN
PRGEND
TITLE EXITPS TEST FOR EXISTENCE OF FILE TYPES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY EXIREL,EXIRND,EXIRNO,EXIRNH,EXIIDX,EXIIDA,EXICTL
ENTRY EXIMAC,EXIFOR,EXICBL,EXIB20,EXIF10,EXIF40,EXIALG
ENTRY EXIBLI,EXITXT,EXIDOC,EXIMEM,EXICMD,EXICCL
;ROUTINE TO TEST FOR EXISTENCE OF A REL FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIREL: HRROI T2,[ASCIZ /REL/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%REL ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A RND FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIRND: HRROI T2,[ASCIZ /RND/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%RND ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A RNO FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIRNO: HRROI T2,[ASCIZ /RNO/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%RNO ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A RNH FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIRNH: HRROI T2,[ASCIZ /RNH/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%RNH ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A IDX FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIIDX: HRROI T2,[ASCIZ /IDX/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%IDX ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A IDA FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIIDA: HRROI T2,[ASCIZ /IDA/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%IDA ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A CTL FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXICTL: HRROI T2,[ASCIZ /CTL/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%CTL ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A MAC FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIMAC: HRROI T2,[ASCIZ /MAC/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A FOR FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIFOR: HRROI T2,[ASCIZ /FOR/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A CBL FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXICBL: HRROI T2,[ASCIZ /CBL/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A B20 FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIB20: HRROI T2,[ASCIZ /B20/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A F10 FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIF10: HRROI T2,[ASCIZ /F10/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A F40 FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIF40: HRROI T2,[ASCIZ /F40/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A ALG FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIALG: HRROI T2,[ASCIZ /ALG/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A BLI FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIBLI: HRROI T2,[ASCIZ /BLI/] ;POINT TO REQUIRED EXTENSION
MOVX T3,E%%SRC ;FLAG TO SET IF FILE EXISTS
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A TXT FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXITXT: HRROI T2,[ASCIZ /TXT/] ;POINT TO REQUIRED EXTENSION
SETZM T3 ;NO FLAG--JUST TEST
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A DOC FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIDOC: HRROI T2,[ASCIZ /DOC/] ;POINT TO REQUIRED EXTENSION
SETZM T3 ;NO FLAG-JUST TEST
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A MEM FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXIMEM: HRROI T2,[ASCIZ /MEM/] ;POINT TO REQUIRED EXTENSION
SETZM T3 ;NO FLAG-JUST TEST
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A CMD FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXICMD: HRROI T2,[ASCIZ /CMD/] ;POINT TO REQUIRED EXTENSION
SETZM T3 ;NO FLAG-JUST TEST
PJRST EXIFIL## ;GO FIND IT
;ROUTINE TO TEST FOR EXISTENCE OF A CCL FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUP. THE FULL DESCRIPTION OF THE FILE MUST
;BE POINTED TO BY THE VARIOUS POINTERS IN THIS BLOCK.
;EXIT IS +1 ALWAYS WITH FLAGS SET IN F%%EXI
;ACCORDING TO THE CLASSIFICATION OF THE FILE.
EXICCL: HRROI T2,[ASCIZ /CCL/] ;POINT TO REQUIRED EXTENSION
SETZM T3 ;NO FLAG-JUST TEST
PJRST EXIFIL## ;GO FIND IT
PRGEND
TITLE EXIDAT CHECK TYPE OF DAT FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY EXIDAT
;THIS ROUTINE DIFFERS FROM THE OTHER "EXI" ROUTINES IN
;THAT INSTEAD OF SEARCHING FOR RELATED FILES IT MERELY
;CHECKS THE NAME AGAINST A LIST OF KNOWN NAMES FOR
;OUTPUT DATA FILES. IF A MATCH IS FOUND FLAGS E%%DEP
;AND E%%ODT ARE SET IN F%%EXI. ENTER WITH T1 POINTING
;TO ARG BLOCK AS DESCRIBED IN "CMLBSM" FOR LOOKUP. THE
;FULL FILESPEC SHOULD BE POINTED TO BY THE VARIOUS POINTERS
;RETURN IS +1 ALWAYS.
EXIDAT: PUSH P,T1 ;SAVE POINTER TO ARG BLOCK
HRRO T2,F%%NAM(T1) ;POINT TO NAME
MOVEI T1,OUTDAT ;POINT TO TABLES
TBLUK ;SEE IF IT EXISTS
MOVX T3,<E%%ODT+E%%DEP> ;FLAGS TO SET
POP P,T1 ;RESTORE POINTER
TXNN T2,TL%EXM ;WELL?
SETZM T3 ;NO-SO SET NO FLAGS
IORM T3,F%%EXI(T1) ;SET THEM
POPJ P,
;TABLE OF KNOWN OUTPUT FILES
OUTDAT: OUTSIZ,,OUTMAX
TB (0,FOR06) ;FORTRAN LPT OUTPUT
OUTSIZ==.-OUTDAT-1
OUTMAX==OUTSIZ+1
PRGEND
TITLE EXIFIL CHECK FOR THE EXISTENCE OF A FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY EXIFIL
;ROUTINE TO CHECK FOR THE EXISTENCE OF A FILE. ENTER WITH
;T1 POINTING TO AN ARGUMENT BLOCK AS DESCRIBED IN "CMLBSM"
;FOR FILE LOOKUPS WITH ALL THE COMPONENTS OF THE FILE
;DESCRIPTION IN PLACE. T2 SHOULD POINT TO THE NEW EXTENSION
;TO BE USED FOR THE LOOKUP, AND T3 SHOULD CONTAIN THE FLAG
;TO BE SET IN F%%EXI ON SUCCESS. RETURN IS +1 ALWAYS WITH
;EITHER NO FLAGS SET ON FAILURE, OR WITH E%%DEP PLUS THOSE
;SUPPLIED IN T3 SET IF SUCCESS.
EXIFIL: EXCH T2,F%%EXT(T1) ;TEMPORARILY UPDATE ARG BLOCK
PUSH P,T2 ;SAVE OLD EXTENSION
PUSH P,F%%JFN(T1) ;SAVE OUR JFN
PUSH P,T1 ;SAVE POINTER
TXO T3,E%%DEP ;WE SET THIS FLAG FOR ALL CASES
PUSH P,T3 ;SAVE FLAGS
PUSHJ P,FLFLKP## ;GO FIND IT
SETZM (P) ;CLEAR FLAGS
POP P,T3 ;RESTORE FLAGS
IORM T3,F%%EXI(T1) ;SET THEM
HRRZ T1,F%%JFN(T1) ;NOW CLOSE FILE
JUMPE T1,FLLP1 ;NO FILE
RLJFN ;RELEASE JFN
JFCL
FLLP1: POP P,T1 ;RESTORE POINTER
POP P,F%%JFN(T1) ;RESTORE JFN
POP P,F%%EXT(T1) ;AND EXTENSION
POPJ P,
PRGEND
TITLE FLFLKP LOOKUP FILE AS SPECIFIED IN ARG BLOCK
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLFLKP
;ROUTINE TO LOOKUP A FILE AS SPECIFIED IN THE ARGUMENT
;BLOCK DESCRIBED IN "CMLBSM". ENTER WITH T1 POINTING
;TO THE ARGUMENT BLOCK WITH FULL FILE SPECIFICATION
;POINTED TO BY THE VARIOUS POINTERS IN THE BLOCK. RETURN
;IS NON-SKIP FOR NON-EXISTENT FILE, OR SKIP IF FILE
;EXISTS WITH JFN IN F%%JFN. NO OTHER DETAILS ARE FILLED.
FLFLKP: PUSH P,T1 ;SAVE POINTER TO ARG BLOCK
MOVX A,<GJ%OLD> ;FILE MUST EXIST
HRR A,F%%STR(T1) ;POINT TO STRUCTURE
HRRO B,F%%DIR(T1) ;AND DIRECTORY
HRRO C,F%%NAM(T1) ;AND NAME
HRRZ D,F%%EXT(T1) ;AND EXTENSION
PUSHJ P,FNDFIL## ;FIND FILE
TDZA T1,T1 ;NO JFN
AOS -1(P) ;ELSE GIVE SKIP RETURN
MOVE T2,(P) ;GET POINTER TO BLOCK
MOVEM T1,F%%JFN(T2) ;SAVE JFN
PJRST T1POPJ## ;RETURN
PRGEND
TITLE FLFOK NORMAL RETURNS FOR FILE FINDING ROUTINES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLFOK,FLFJNK
;RETURN AT FLFOK IF EVERYTHING IS OK. IT POPS T1
;OFF THE STACK AND GIVES A SKIP RETURN. RETURN AT
;FLFJNK IF BAD. IT POPS T1 OFF THE STACK, GIVES A
;JSYS ERROR MESSAGE AND NON-SKIP RETURN.
FLFOK: AOSA -1(P) ;SKIP RETURN
FLFJNK: PUSHJ P,JSERPJ## ;PRINT ERROR
PJRST T1POPJ## ;RETURN
PRGEND
TITLE OTFMIN SET UP OUTPUT FILESPECS FROM INPUT SPECS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OTFMIN
;ROUTINE TO SET UP DEFAULT FILESPECS IN A,B,C,D FROM THE
;SPECS OF THE FILE SPECIFIED BY "INP". RETURN +1 ALWAYS.
OTFMIN: HRRZ T2,INP ;GET JFN
HRROI T1,STRSPC## ;WHERE TO PUT IT
MOVX T3,<FLD(.JSAOF,JS%DEV)> ;STRUCTURE
JFNS ;WRITE IT
HRROI T1,DIRSPC## ;WHERE TO PUT IT
MOVX T3,<FLD(.JSAOF,JS%DIR)> ;DIRECTORY
JFNS ;WRITE IT
HRROI T1,NAMSPC## ;WHERE TO PUT IT
MOVX T3,<FLD(.JSAOF,JS%NAM)> ;NAME
JFNS ;WRITE IT
HRROI T1,EXTSPC## ;WHERE TO PUT IT
MOVX T3,<FLD(.JSAOF,JS%TYP)> ;EXTENSION
JFNS ;WRITE IT
HRRZI A,STRSPC## ;POINT TO STRUCTURE
HRROI B,DIRSPC## ;DIRECTORY
HRROI C,NAMSPC## ;NAME
HRRZI D,EXTSPC## ;EXTENSION
POPJ P, ;OK
PRGEND
TITLE OPFLOA OPEN FILE FOR WRITING ASCII
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OPFLOA
;ROUTINE TO OPEN FILE FOR WRITING IN ASCII. ENTER WITH
;JFN IN "OUTP". RETURNS +1 IF CANNOT, SKIP IF OK.
OPFLOA: HRRZ T1,OUTP ;GET JFN
MOVX T2,<OF%APP+FLD(7,OF%BSZ)>
PJRST JOPENF## ;OPEN IT
PRGEND
TITLE OPFLOB OPEN FILE FOR OUTPUT BINARY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OPFLOB
;ROUTINE TO OPEN A FILE FOR WRITING IN BINARY(36 BIT BYTES).
;ENTER WITH JFN IN "OUTP". RETURN +1 IF FAILED, OR SKIP IF OK.
OPFLOB: HRRZ T1,OUTP ;GET JFN
MOVX T2,<OF%APP+FLD(^D36,OF%BSZ)>
PJRST JOPENF## ;OPEN IT
PRGEND
TITLE OPFLIA OPEN FILE FOR READING ASCII
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OPFLIA
;ROUTINE TO OPEN FILE FOR READING IN ASCII MODE. ENTER
;WITH JFN IN "INP". RETURN +1 IF ERROR, OR SKIP IF OK
OPFLIA: HRRZ T1,INP ;GET JFN
MOVX T2,<OF%RD+FLD(7,OF%BSZ)>
PJRST JOPENF## ;OPEN IT
PRGEND
TITLE OPFLIB OPEN FILE FOR READING BINARY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OPFLIB
;ROUTINE TO OPEN FILE FOR READING IN BINARY(36 BIT BYTES).
;ENTER WITH JFN IN "INP". EXIT +1 IF ERROR, OR SKIP IF OK.
OPFLIB: HRRZ T1,INP ;GET JFN
MOVX T2,<OF%RD+FLD(^D36,OF%BSZ)>
PJRST JOPENF## ;OPEN IT
PRGEND
TITLE GJOFMI GET OUTPUT JFN BASED ON INPUT JFN
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY GJOFMI
;ROUTINE TO GET JFN FOR A FILE WHICH IS THE NEXT GENERATION
;ABOVE THAT OF THE FILE WHOSE JFN IS IN "INP". THIS IS
;FOR PROGRAMS WHICH NEED TO PROCESS A FILE AND PRODUCE
;A NEW GENERATION FOR OUTPUT. RETURN +1 IF ERROR, OR SKIP
;IF OK WITH JFN IN OUTP.
GJOFMI: HRROI OUTP,SPACE## ;FIRST WE MUST FIND FILESPEC
MOVE T1,INP ;POINT TO INPUT FILESPEC
MOVX T2,<S%%STR+S%%DIR+S%%NAM+S%%EXT>
PUSHJ P,OTPFSP## ;PRINT FILESPEC INTO CORE
MOVX T1,<GJ%FOU+GJ%SHT> ;NOW LOOK FOR NEW SPEC
HRROI T2,SPACE## ;POINT TO OLD SPEC
GTJFN ;FIND IT
POPJ P, ;ERROR
HRRZ OUTP,T1 ;SAVE JFN
PJRST CPOPJ1## ;SKIP HOME
PRGEND
TITLE FNDFIL ROUTINE TO LOOKUP FILE USING NAME COMPONENTS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FNDFIL
;ROUTINE TO FIND FILE FROM COMPONENTS. ENTER WITH DEVICE
;POINTED BY "A", DIRECTORY POINTED BY "B", FILENAME BY
;"C" AND EXTENSION BY "D". RETURNS +1 IF ERROR, OR SKIP
;IF FOUND, WITH JFN IN T2.
FNDFIL: PUSHJ P,GTJCLS## ;CLEAR AND SET BLOCK
MOVE T1,[.NULIO,,.NULIO] ;NO DEVICES
MOVEM T1,GTJBLK##+.GJSRC ;SAVE IT
MOVEI T1,GTJBLK## ;POINT TO BLOCK
HRROI T2,[ASCIZ //] ;NO OTHER DETAILS
GTJFN ;DO THINGS
POPJ P, ;ERROR
PJRST CPOPJ1## ;SKIP--OK JFN IN T1
PRGEND
TITLE GSTSIN GET STATUS OF INPUT FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY GSTSIN
;ROUTINE TO GET STATUS OF INPUT FILE. RETURN +1 FOR BAD
;ERROR, SKIP IF EOF, OR DOUBLE SKIP IF OK.
GSTSIN: MOVE T1,INP ;GET JFN
GTSTS ;GET STATUS
TXNE T2,GS%EOF ;END OF FILE?
PJRST CPOPJ1## ;YES--SKIP
TXNE T2,GS%ERR ;ERROR?
POPJ P, ;YES
PJRST CPOPJ2## ;OK
PRGEND
TITLE GSTSOT GET STATUS OF OUTPUT FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY GSTSOT
;ROUTINE TO GET STATUS OF OUTPUT FILE. RETURN +1 FOR BAD
;ERROR, SKIP IF EOF, OR DOUBLE SKIP IF OK.
GSTSOT: MOVE T1,OUTP ;GET JFN
GTSTS ;GET STATUS
TXNE T2,GS%EOF ;END OF FILE?
PJRST CPOPJ1## ;YES--SKIP
TXNE T2,GS%ERR ;ERROR?
POPJ P, ;YES
PJRST CPOPJ2## ;OK
PRGEND
TITLE COFLXX CLOSE FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY COFLLJ,COFLDJ
;ROUTINE TO CLOSE UP OUTPUT FILE. ENTER WITH JFN
;IN "OUTP". ENTER AT COFLDJ IF WE DON'T WANT TO LOSE JFN.
;ENTER AT COFLLJ IF WE WANT TO LOSE JFN.
;RETURN +1 IF ERROR. SKIP IF OK.
COFLLJ: TDZA T1,T1 ;LOSE JFN
COFLDJ: MOVX T1,<CO%NRJ> ;DO NOT LOSE JFN
HRR T1,OUTP ;GET JFN
CLOSF ;CLOSE IT
PJRST JSERPJ## ;ERROR
PJRST CPOPJ1## ;SKIP BACK
PRGEND
TITLE CIFLXX CLOSE FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY CIFLLJ,CIFLDJ
;ROUTINE TO CLOSE UP INPUT FILE. ENTER WITH JFN
;IN "INP". ENTER AT CIFLDJ IF WE DON'T WANT TO LOSE JFN.
;ENTER AT CIFLLJ IF WE WANT TO LOSE JFN.
;RETURN +1 IF ERROR. SKIP IF OK.
CIFLLJ: TDZA T1,T1 ;LOSE JFN
CIFLDJ: MOVX T1,<CO%NRJ> ;DO NOT LOSE JFN
HRR T1,INP ;GET JFN
CLOSF ;CLOSE IT
PJRST JSERPJ## ;ERROR
PJRST CPOPJ1## ;SKIP BACK
PRGEND
TITLE FLFGNJ GET NEXT FILE FROM JFN
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FLFGNJ
;ROUTINE TO GET NEXT FILE SPECIFICATION FROM SPECIFIED
;JFN. ENTER WITH FILE HANDLE IN T1. THE ROUTINE
;PERFORMS A "GNJFN" JSYS AND RETURNS NON-SKIP IF THERE
;ARE NO MORE FILES, SKIP IF THERE IS A CHANGE OF
;DIRECTORY, AND DOUBLE SKIP OTHERWISE.
FLFGNJ: GNJFN ;GET NEXT FILE
POPJ P, ;NO MORE
TXNE T1,GN%DIR ;CHANGED DIRECTORY
JRST CPOPJ1## ;YES--SKIP
JRST CPOPJ2## ;ELSE DOUBLE SKIP
END