Google
 

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