Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-compiler/comman.mac
There are 8 other files named comman.mac in the archive. Click here to see a list.
	TITLE	FTNCMD - COMMAND SCANNER INTERFACE FOR FORTRAN COMPILER
	SUBTTL	/DCE/EGM/EDS/TFV

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
;AUTHOR: Dave Eklund


	INTERN COMMAV
	COMMAV= BYTE (3)0(9)6(6)0(18)^D113	; Version Date:	28-Sep-81

	TWOSEG

	SUBTTL	Revision History

Comment \

***** Begin Revision History *****

***** Begin Version 5B *****

--	656	25246	PROTECTION FAILURES NOT REPORTED, (DCE)

--	704	26390	FIX DEFAULT BUFFER SIZE (IF DEVSIZ FAILS)

--	723	-----	ADD /NOWARN SELECTIVITY, (DCE)

***** Begin Version 6 *****

--	760	TFV	1-Jan-80	-----
	Make /KA and /KI switchs errors.

100	762	EGM	22-Apr-80	-----
	Move Revision History to REVHST.MAC

101	767	DCE	20-May-80	-----
	Rewrite the bulk of the Command Scanner module.
	In particular, make feature testing cleaner.
	Fix various problems with /GFL and add /F77 (future).
	Merge as much of the TOPS-10 and TOPS-20 code as possible.

102	1001	EGM	30-Jun-80	-----
	Replace SEARCH of C with UUOSYM,MACTEN. Replace LINK command file
	references to SCAN, WILD, and HELPER with MACRO .REQUESTs.

103	1043	EGM	19-Jan-81	20-15466
	Add CAO (Consecutive arith ops illegal) to nowarn keyword table

104	1047	EGM	22-Jan-81	Q10-05323
	Add support for TOPS-10 execute only.

105	1053	EDS	11-Feb-81	-----
	Make FORTRA a global symbol.

106	1061	DCE	9-Apr-81	-----
	Add PSR (Pound sign in Random access illegal) to noward table

107	1065	EGM	7-May-81	Q10-05053
	Replace M.XXXX SCAN macros with FORTRAN specific ones. Do not
	attempt to handle all the cases, or 10 type message standard.

109	1115	EGM	31-Jul-81	--------
	Rework /NOWARN for expandability, and efficiency.

110	1117	EGM	26-Aug-81
	Add additional TOPS-10 EXO support code to allow lifting fixed high seg
	origin restrictions.

111	1121	EGM	9-Sep-81	--------
	Add code to get GETSEG parameters from GETTABs, and store path info.
	Also update several comments concerning initialization.

113	1133	TFV	28-Sep-18	------
	Add /STATISTICS flag for in-house performance measurement.  It is
	disabled in the released V6.

***** End Revision History *****

\

	PAGE
	SUBTTL	REQUIRED UNIVERSAL FILES

	ENTRY	NXTFIL			;ONLY USED IN MAIN.BLI

	SEARCH	FTTENX			;ASSEMBLY TIME SWITCHES

	IFN FTTENX,<	SEARCH MONSYM	>

	SEARCH	UUOSYM,MACTEN,SCNMAC	;[1001]
	SEARCH	GFOPDF		;GFLOATING OPCODES

	IFN FTTENX,<	.REQUEST SYS:SCAN	;[1001]
			.REQUEST SYS:HELPER>	;[1001]
	IFE FTTENX,<	.REQUEST REL:SCAN	;[1001]
			.REQUEST REL:WILD	;[1001]
			.REQUEST REL:HELPER>	;[1001]
	IF2,<
		IFE FTTENX, <PRINTX ASSEMBLING FORTRAN-10 COMMAN>
		IFN FTTENX, <PRINTX ASSEMBLING FORTRAN-20 COMMAN>
	>

	PAGE
	SUBTTL	SYMBOLIC DEFINITIONS

	RELOC	400000

;AC'S USED BY COMMAND SCANNER

	F=0		;FLAGS
	T1=1		;TEMP
	T2=2		; ..
	T3=3		; ..
	T4=4		; ..
	P1=5		;PRESERVED AC
	P2=6		; ..
	N=7		;NUMBER AC
	C=10		;CHARACTER AC
	VREG=15		;BLIS10 VALUE RETURN REG
	FREG=16		;STACK FRAME POINTER
	P=17		;PUSH DOWN POINTER

;I/O CHANNELS
	BIN==1		;REL FILE OUTPUT
	LST==2		;LISTING FILE OUTPUT
	SRC==3		;SOURCE FILE INPUT
	ICL==4		;INCLUDE FILE INPUT

;OFFSETS INTO CHNLTBL
	TBLMAX==^D10
	JFN==0
	HDR==3
	PNT==4
	CNT==5

;FLAG BITS IN F (SEE IOFLG.BLI BEFORE CHANGING THESE BITS)
SW.OPT==1B35		;GLOBAL OPTIMIZE
SW.NET==1B34		;NO ERRORS ON TTY
SW.MAC==1B33		;MACRO CODE
SW.IDS==1B32		;INCLUDE DEBUG STATEMENTS
SW.EXP==1B31		;EXPAND
SW.DEB==1B30		;DEBUG
SW.CRF==1B29		;CREF
EOCS==1B28		;END OF COMMAND STRING
LSTFLG==1B25		;LISTING FILE BEING MADE
SW.KAX==1B24		;KA-10 FLAG
RELFLG==1B22		;REL FILE BEING MADE
SW.MAP==1B16		;LINE NUMBER/OCTAL LOCATION MAP
SW.ERR==1B14		;FATAL ERRORS DURING COMPILE
SW.OCS==1B13		;ONLY CHECK SYNTAX
COMKA==1B12		;COMPILING ON A KA-10
SW.PHO==1B10		;PEEP HOLE OPTIMIZE
SW.BOU==1B5		;ARRAY BOUNDS CHECKING SWITCH
SW.NOW==1B2		;DON'T PRINT WARNING MESSAGES
TTYDEV==1B1		;LISTING ON TTY:


	PAGE
EXTERN	FLAGS2		;SECONDARY FLAG REGISTER (TTYINP,GFMCOK, ETC.)
EXTERN	F2		;USER SETTABLE SWITCHES (GFL, F77, ETC.)
EXTERN	DEBGSW

;FLAG BITS IN FLAGS2 (SEE IOFLG.BLI BEFORE CHANGING THESE BITS)

TTYINP==1B0		;INPUT DEVICE IS A TTY
GFMCOK==1B1		;GFLOATING MICROCODE PRESENT

;FLAG BITS IN F2 (SEE IOFLG.BLI BEFORE CHANGING THESE BITS)
;THIS FLAG WORD IS RESERVED FOR USER SETTABLE SWITCHES

SW.GFL==1B0		;Switch for /GFLOATING DP
SW.F77==1B1		;F77 SELECTED
SW.STA==1B2		;[1113] /STATISTICS

IFN	FTTENX,<


	; OPENF BITS
	INBYT==440000	;NON-TTY INPUT BYTE SIZE
	BINBYT==440000	;BINARY BYTE SIZE
	LSTBYT==070000	;LISTING BYTE SIZE
	TTYBYT==070000	;TTY INPUT BYTE SIZE
	READ==200000	;READABLE
	WRITEE==100000	;WRITEABLE

	TTCODE==600012	;TTY: DEVICE CODE
	DSKCOD==600000	;DSK: DEVICE CODE

;	DEFAULT GTJFN TABLE FOR LISTING

LSTTAB:		GJ%FOU		;FLAGS,VERSION DEFAULT
	XWD	377777,377777	;NO JFN'S
	0			;DEVICE
	0			;DIRECTORY
	0			;FILENAME
	XWD	-1,[ASCIZ /LST/] ;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT

;	DEFAULT GTJFN TABLE FOR BINARY OUTPUT FILE

BINTAB:		GJ%FOU		;FLAGS,DEFAULT VERSION
	XWD	377777,377777	;NO JFN'S
	0			;DEVICE
	0			;DIRECTORY
	0			;FILE NAME
	XWD	-1,[ASCIZ /REL/] ;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT

;	DEFAULT TABLE FOR SOURCE INPUT

SRCTAB:		GJ%OLD!GJ%IFG	;FLAGS,VERSION DEFAULT
	XWD	377777,377777	;NO JFN'S
	0			;DEV
	0			;DIRECTORY
	0			;FILE NAME
	XWD	-1,[ASCIZ /FOR/] ;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT

;	DEFAULT TABLE FOR INCLUDE INPUT

ICLTAB:		GJ%OLD		;FLAGS,VERSION DEFAULT
	XWD	377777,377777	;NO JFN'S
	0			;DEV
	0			;DIRECTORY
	0			;FILE NAME
	XWD	-1,[ASCIZ /FOR/] ;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT


>			;END TOPS-20 ONLY
	PAGE
	SUBTTL	Compiler Switch Definitions and Defaults

	;DEFAULTS FOR SWITCH SETTINGS - ALL CURRENTLY "OFF"

DM	ADV,1,0,1
DM	BAK,1,0,1
DM	BOU,1,0,1
DM	BUG,377777,0,1
DM	CRF,1,0,1
DM	DEB,1,0,1
DM	EXP,1,0,1
DM	GFL,1,0,1
DM	F77,1,0,1
DM	INC,1,0,1
DM	MAC,1,0,1
DM	NOE,1,0,1
DM	WEO,1,0,1
DM	ZER,1,0,1
DM	OPT,1,0,1
DM	OCS,1,0,1
DM	NOW,1,0,1
DM	MAP,1,0,1
DM	STA,1,0,1	;[1133] statistics switch

ND	PDLLEN,^D500 + ^D600		;LENGTH OF PDL
					;NOTE THE ADDITION OF 600 OF SPACE TO PDLLEN!!!
					;SEE DECLARATION POOLSIZ IN FIRST.BLI
					;THIS SPACE WILL ACTUALLY BE OCCUPIED BY
					;THE GLOBAL VECTORS STK AND POOL SO THAT
					;MORE SPACE FOR THE STACK CAN BE MADE AVAILABLE
					;TO HIGHLY RECURSIVE OPERATIONS
					;THAT MAY OCCUR IN THE COMPILER

;DEFAULT FLAG SETTINGS (FOR F)

INDADF:	EXP	<<AD.MAP>_<43-^L<SW.MAP>>> ! 
		<<AD.CRF>_<43-^L<SW.CRF>>> ! 
		<<AD.DEB>_<43-^L<SW.DEB>>> ! 
		<<AD.EXP>_<43-^L<SW.EXP>>> ! 
		<<AD.INC>_<43-^L<SW.IDS>>> ! 
		<<AD.MAC>_<43-^L<SW.MAC>>> ! 
		<<AD.NOE>_<43-^L<SW.NET>>>

;DEFAULT SWITCH SETTINGS FOR F2

INDAD2:	EXP	<<AD.F77>_<43-^L<SW.F77>>> ! 
		<<AD.GFL>_<43-^L<SW.GFL>>> ! 
		<<AD.STA>_<43-^L<SW.STA>>>		;[1133] /STATISTICS


DEFINE	RESETUUO	<CALLI	0>
DEFINE	RESETJSYS	<JSYS 147>
DEFINE	RESET		<PRINTX ?DO NOT USE RESET - USE RESETUUO OR RESETJSYS>
	PAGE
	SUBTTL Compiler Switches

DEFINE	SWTCHS,<

SP	ADVANCE,FAREA+F.ADV,.SWDEC##,ADV
SP	BACKSPACE,FAREA+F.BACK,.SWDEC##,BAK
;SP	BOUNDS,<POINTR(SAVEF,SW.BOU)>,.SWDEC##,BOU
SP	BUGOUT,<POINT 18,BUGINT,35>,.SWOCT##,BUG
SP	CROSSREF,<POINTR(SAVEF,SW.CRF)>,.SWDEC##,CRF
SL	DEBUG,DEBGSD,BUGK,-1,FS.OBV
SP	EXPAND,<POINTR(SAVEF,SW.EXP)>,.SWDEC##,EXP
SN	*GFLOATING,<POINTR(SAVE2,SW.GFL)>	;ALLOW /NOGFL
;SN	*F77,<POINTR(SAVE2,SW.F77)>		;ALLOW /NOF77
;SS	F66,<POINTR(SAVE2,SW.F77)>,0		;SAME AS /NOF77
SP	KA10,<POINTR(SAVEF,SW.KAX)>,KA10SW	;[760] /KA is fatal error
SP	KI10,<POINTR(SAVEF,SW.KAX)>,KI10SW	;[760] /KI is obsolete
SP	INCLUDE,<POINTR(SAVEF,SW.IDS)>,.SWDEC##,INC
SP	*MACROCODE,<POINTR(SAVEF,SW.MAC)>,.SWDEC##,MAC
SP	*LNMAP,<POINTR(SAVEF,SW.MAP)>,.SWDEC##,MAP
SP	NOERRORS,<POINTR(SAVEF,SW.NET)>,.SWDEC##,NOE
SL	NOWARNING,<777700,,NOWARN>,NOW,-1  ;[1115] NOWARN SWITCH AND PROCESSOR
SP	*OPTIMIZE,<POINTR(SAVEF,SW.OPT)>,.SWDEC##,OPT
;SN	*STATISTICS,<POINTR(SAVE2,SW.STA)>	;[1133] ALLOW /NOSTA
SP	*SYNTAX,<POINTR(SAVEF,SW.OCS)>,.SWDEC##,OCS
SP	TAPEND,FAREA+F.WEOF,.SWDEC##,WEO
SP	ZERO,FAREA+F.DTZR,.SWDEC##,ZER
>
	PAGE

;[1115]Keywords that can be used with the /NOWARN switch. Exclusive
;[1115] of ALL and NONE (must be keywords 1 and 2), the rest represent the
;[1115] 3 letter error message mnuemonics for errors defined in ERROUT.BLI.
;[1115] Always add new keywords to the end of the macro.

	RELOC				;[1115] Retain in low seg
NWKTB::					;[1115] Global handle on the table
	KEYS	NOW,<
ALL,NONE,ZMT,FNA,DIS,MVC,AGA,CUO,NED,LID,DIM,WOP,
VNI,RDI,CTR,CAI,IFL,ICD,SOD,ICC,XCR,ICS,FMR,VND,
NOD,PPS,DXB,VAI,IDN,PAV,SID,IUA,CAO,PSR> ;[1115]
	NWKTBC==:.-NWKTB		;[1115] Global keyword count
	NWWDCT==<<NWKTBC-1>/^D36>+1	;[1115] Words needed for bits
	RELOC				;[1115] Back to high seg

KEYS	BUGK,<DIMENSIONS,LABELS,INDEX,TRACE,BOUNDS>
	XALL
	DOSCAN(FORT)
	SALL
	PAGE
	SUBTTL	Error macros

;	Miscellaneous error macros
;	These parallel the macros used by SCAN to handle errors
;	including the type ahead clearing and re-prompt.
;	They use several SCAN typeout routines.


;	General Fatal error - continues
;	 TEXT   = Error message text, includes prefix

	DEFINE	F.FAIL (TEXT) ,<
	SKPINL
	JFCL
	OUTSTR	[ASCIZ \
?'TEXT

\]
	CLRBFI
	JRST	FORTR2
	>
;	Fatal error with decimal value typeout - continues
;	 TEXT   = Error message text
;	 NUM    = Decimal number to append to text

	DEFINE	F.FAID (TEXT,NUM) ,<
	SKPINL
	JFCL
	OUTSTR	[ASCIZ \
?'TEXT\]
	OUTSTR	[ASCIZ / /]
	PUSHJ	P,.TDECW##
	OUTSTR	[ASCIZ /

/]
	CLRBFI
	JRST	FORTR2
	>

;	Fatal error with octal value and filespec typeout - continues
;	 TEXT   = Error message text
;	 NUM    = Octal number to append to text
;	 FSPEC  = Pointer to file spec to append to text

	DEFINE	F.FAIF (TEXT,NUM,FSPEC) ,<
	SKPINL
	JFCL
	OUTSTR	[ASCIZ \
?'TEXT\]
	OUTSTR	[ASCIZ / /]
	MOVE	T1,NUM
	JUMPL	T1,.+3
	PUSHJ	P,.TOCTW##
	OUTSTR	[ASCIZ / /]
	MOVE	T1,FSPEC
	PUSHJ	P,.TFBLK##
	OUTSTR	[ASCIZ /

/]
	CLRBFI
	JRST	FORTR2
	>

	PAGE
	SUBTTL TRAP handling routines

;
;	Subroutine to initialize for APR trapping
;

; SET UP TRAP FOR
;
; AP.POV	PUSHDOWN OVERFLOW
; AP.ABK	ADDRESS BREAK (FUTURE)
; AP.ILM	MEMORY PROTECTION VIOLATION
; AP.NXM	NON-EXISTENT MEMORY
;
APRINI:	MOVEI	T1,APRTRP	;LOCATE TRAP ROUTINE
	MOVEM	T1,.JBAPR##	;TELL THE MONITOR WHERE TRAP OCCURS
	MOVEI	T1,AP.POV!AP.ABK!AP.ILM!AP.NXM	;SET CONDITIONS
	APRENB	T1,		;ENABLE TRAPS
	POPJ	P,
	PAGE
	SUBTTL	GFLOATING Microcode test

;
;	Subroutine to test for the presence of GFLOATING microcode
;
;	Notice that the way that one tests for the microcode is quite
;	different for the two different types of monitors.
;	For TOPS-10, we need to set up an interrupt block to trap the
;	error, while for TOPS-20 we basically need only to attempt
;	a typical GFLOATING instruction and directly trap the error
;	return which would indicate the microcode is not present.
;	The result of this routine is that the bit GFMCOK will be
;	set (or reset) to zero if the GFLOATING microcode is
;	available and -1 if not.
;

GFLTST:	SETZM	T4		;ASSUME MICROCODE NOT PRESENT

IFE FTTENX,<
	MOVEI	T1,INTBLK	;GET ADDRESS OF INTERRUPT BLOCK
	EXCH	T1,.JBINT	;SET UP FOR TRAPPING FAILURE OURSELVES
	SETZM	INTBLK+2	;MUST ZERO THIS OLD PC
	>			;ALL SET FOR TOPS-10 NOW

	GFAD	T2,T2		;TRY A TYPICAL GFLOATING INSTRUCTION

IFN FTTENX,< ERJMP INTDON >	;SIMPLE FOR TOPS-20!

	MOVX	T4,GFMCOK	;YES, THE MICROCODE IS PRESENT.
INTDON:	IORM	T4,FLAGS2	;SET UP THE GFMCOK BIT
IFE FTTENX,< EXCH T1,.JBINT >	;PUT INTERRUPT TRAPPING BACK FOR TOPS-10
	POPJ	P,		;AND RETURN IN ANY CASE

IFE FTTENX,<
	RELOC
INTBLK:	XWD	4,INTDON	;LENGTH, NEW PC
	EXP	ER.MSG+ER.EIJ	;NO MESSAGE, TRAP FATAL ERRORS
	EXP	0		;OLD PC
	EXP 	0		;ERROR BITS
	RELOC
	>			;HARDER FOR TOPS-10!
	PAGE
	SUBTTL Interface to SCAN

;
;	Subroutine to initialize SCAN
;

SINIT:	MOVE	T1,[2,,[EXP 0
			XWD CCLSW##,'FOR']]
	PUSHJ	P,.ISCAN##	; FIRE UP SCAN
	POPJ	P,

;
;	Subroutine to process SWITCH.INI switches
;

PSWINI:	MOVE	T1,[4,,[IOWD FORTL,FORTN
			XWD  FORTD,FORTM
			XWD      0,FORTP
			EXP  -1]]
	PUSHJ	P,.OSCAN##	;SCAN SWITCH.INI FILE
	POPJ	P,

;
;	Subroutine to scan one command line
;

SLINE:	MOVE	T1,[11,,[IOWD FORTL,FORTN
		 XWD  FORTD,FORTM
		 XWD      0,FORTP
		 EXP  -1
		 XWD  CLRALL,CLRFIL
		 XWD  ALLIN,ALLOUT
		 XWD  MEMSTK,APPSTK
		 XWD  CLRSTK,1B18
		 XWD       0]]		;[1115] Let SCAN process switches
	PUSHJ	P,.TSCAN##	;SCAN ONE COMMAND LINE
	POPJ	P,

	PAGE
	SUBTTL	Compiler Initialization

	;Here is where it all begins.  One enters the compiler at label
	;FORTRA or one instruction down for CCL entry.  At this point
	;[1121]one cannot depend upon the stack being set up.
	;[1121]For the TOPS-10 multi segment version, the full RUN
	;[1121]directory path, and the high seg origin must be
	;[1121]saved away for later use by the GETSEGs and high
	;[1121]segment entry code.

MRP0::	PORTAL	.+1		;[1121] NORMAL Execute only entry
FORTRA::			;[1053]
	TDZA	T1,T1		;FLAG AS NORMAL ENTRY
	MOVEI	T1,1		;FLAG AS CCL ENTRY
	MOVEM	T1,CCLSW##	;SAVE CCL SWITCH
IFE	FTTENX,<
	SKIPE	T1,GETSBL##	;HAVE WE BEEN HERE BEFORE?
	JRST	FORTR1		;YES MUST BE DOING ^C START
	MOVEM	7,GETSBL##+4	;[1121]Save old RUN PPN
	MOVEM	11,GETSBL##	;[1121]And device
	MOVSI	T2,-5		;[1121]Max of 5 SFDs
FOR.I1:	HRROI	T1,.GTRS0(T2)	;[1121]Get SFD name
	GETTAB	T1,		;[1121]
	  JRST	FOR.I2		;[1121]Failed - assume done
	JUMPE	T1,FOR.I2	;[1121]End - really done
	MOVEM	T1,GETSPA##+3(T2) ;[1121]Save in PATH block
	AOBJN	T2,FOR.I1	;[1121]Loop for all
FOR.I2:	SETZM	GETSPA##+3(T2)	;[1121]Terminate list
	HRROI	T1,.GTRDI	;[1121]Get RUN PPN
	GETTAB	T1,		;[1121]
	  JRST FOR.I3		;[1121]Failed - use old value
	JUMPE	T1,FOR.I3	;[1121]Also if not available
	MOVEM	T1,GETSPA##+2	;[1121]Save in full path block
	SKIPE	GETSPA##+3	;[1121]If any SFDs
	MOVEI	T1,GETSPA##	;[1121]Get PATH pointer
	MOVEM	T1,GETSBL##+4	;[1121]Save PPN or path pointer
FOR.I3:	HRROI	T1,.GTRDV	;[1121]Get RUN device
	GETTAB	T1,		;[1121]
	  JRST	FOR.I4		;[1121]Failed - use old value
	JUMPE	T1,FOR.I4	;[1121]Also if not available
	MOVEM	T1,GETSBL##	;[1121]Save in GETSEG block
FOR.I4:	MOVE	T1,[-2,,.GTUPM]	;[1121]Get high seg origin
	GETTAB	T1,		;[1117]From table
	  MOVSI	T1,400000	;[1117]Must have hiseg - use default origin
	LSH	T1,-^D18	;[1117]Position
	TRZ	T1,777		;[1117]No extra bits
	MOVEM	T1,HSGORG##	;[1117]And save
	>			;End of TOPS-10 code

FORTR1:	JUMPPT	(T1,CP166,KA10)	;CANNOT RUN ON PDP-6 OR KA10

	MOVE	P,[IOWD PDLLEN,STACK##] ;SET UP THE STACK
	HRRZI	FREG,(P)	;LIFE IS BLISS

	PUSHJ	P,GFLTST	;TEST FOR GFLOATING MICROCODE
	PUSHJ	P,SINIT		;INITIALIZE SCAN


FORTR2:	MOVE	T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
	SETZM	FIRZER		; ..
	BLT	T2,LASZER	; ..

	RESETUUO		;RESET ACTIVE I/O
	MOVE	T1,.JBFF##	;START OF CORE
	CORE	T1,		;REMOVE CRUFT FROM PREVIOUS JOBS
	  JFCL			;DO NOT CARE IF IT FAILS
	PUSHJ	P,APRINI	;INITIALIZE APR TRAPPING

	PAGE
	SUBTTL	Command Scanner

COMND:

	PUSHJ	P,SLINE		;PRINT "*" AND SCAN NEXT COMMAND LINE
	PUSHJ	P,NOWSAV	;[1115] SAVE COMMAND LINE NOWARN VALUES
	PUSHJ	P,PSWINI	;PROCESS SWITCH.INI FILE
	PUSHJ	P,NOWMRG	;[1115] MERGE COMMAND LINE/SWITCH.INI NOWARNS
	PUSHJ	P,ABSDEF	;FILL IN ABSENT DEFAULTS

	MOVE	T1,F2		;GET SWITCHES
	TXNN	T1,SW.GFL	;WAS /GFL REQUESTED?
	 JRST	GFLOK		;NO, WE ARE ALL SET TO GO!
	MOVE	T1,FLAGS2	;GET RESULT OF MICROCODE TEST
	TXNN	T1,GFMCOK	;IS GFL MICROCODE PRESENT?
	 JRST	GFLBAD		;NO, TOO BAD - FATAL ERROR
GFLOK:

	EXTERN	RTIME		;[1133] runtime for this program unit
	EXTERN	CTIME		;[1133] time of day for connect time

IFE	FTTENX,<		;[1133] TOPS-10 code
	MOVEI	T1,0		;[1133] get time for this job
	RUNTIM	T1,		;[1133] get runtime
	MOVEM	T1,RTIME	;[1133] save it

	MSTIME	T1,		;[1133] get current time
	MOVEM	T1,CTIME	;[1133] save it
	>			;[1133] end TOPS-10 code

IFN	FTTENX,<		;[1133] TOPS-20 code
	MOVEI	T1,.FHSLF	;[1133] get time for this job
	RUNTM			;[1133] get runtime, current time
	MOVEM	T1,RTIME	;[1133] save runtime
	MOVEM	T3,CTIME	;[1133] save current time
	>			;[1133] end TOPS-20 code

IFE	FTTENX,<		;TOPS-20 CODE IS ALL DIFFERENT...
	SKIPN	T1,FINPTR	;CHECK FOR NO INPUT FILES
	JRST	FORTR1		;NO INPUT FILES
	PUSHJ	P,GETSIZ	;CALCULATE MAXIMUM BUFFER CORE REQUIREMENTS
	PUSHJ	P,NXTFIL	;GET THE NEXT FILE
	  JRST	FORTR1		;NO INPUT FILES GIVEN
	MOVE	T1,LBLOCK+.RBALC;GET THE NUMBER OF BLOCKS ALLOCATED
	MOVEM	T1,LBLOCK+.RBEST; AND ESTIMATE THAT AS THE SIZE OF
	SETZM	LBLOCK+.RBALC	; EACH OUTPUT FILE.

	TXNN	F,SW.OCS	;SYNTAX ONLY? IF SO LEAVE .REL ALONE
	SKIPN	T2,RELSPC+F.DEV	;IS THERE A REL DEVICE
	JRST	NOREL			;NONE TRY LISTING
	MOVE	T2,RELSPC+F.MOD	;CHECK FOR NUL DEVICE AND NAME
	TXNN	T2,FX.NDV	;NO SKIP MEANS DEVICE THERE
	JRST	ISREL
	SKIPN	RELSPC+F.NAME	;NO SKIP MEANS DEVICE THERE
	JRST	NOREL		;NO NAME SPECIFIED
ISREL:
	MOVE	T2,RELSPC+F.DEV	;SET UP OPEN BLK
	TXO	F,RELFLG	;LIGHT THE REL FILE BIT FOR OUTMOD
	MOVEI	P1,RELSPC	;POINTER TO FILESPEC
	PUSHJ	P,MTMODE	;SET UP MODE FOR MAG TAPE
	ADDX	T1,.IOBIN	;BINARY MODE
	MOVSI	T3,BINHDR	;HEADER POINTER
	OPEN	BIN,T1		;OPEN THE DEVICE
	  JRST	OPNERR		;CAN NOT DO IT!!!
	PUSHJ	P,SETENT	;SET UP FOR ENTER
	  JRST	ERRST		;FILE NAME ERROR
	MOVEI	T1,BIN
	DEVCHR	T1,
	TXNN	T1,DV.DTA	;IS DEVICE A DECTAPE
	JRST	REL1		;NO
	ENTER	BIN,LBLOCK+2
	  JRST	UUOERR
	JRST	REL2
REL1:
	ENTER	BIN,LBLOCK	;ENTER IN UFD
	  JRST	UUOERR
REL2:
	OUTBUF	BIN,0		;SET UP O/P BUFFER
NOREL:
	SKIPN	T2,LSTSPC+F.DEV	;IS THERE A LISTING DEVICE
	JRST	NOLST		;NONE TODAY
	MOVE	T2,LSTSPC+F.MOD	;SAME AS FOR .REL FILE
	TXNN	T2,FX.NDV
	JRST	ISLST
	SKIPN	LSTSPC+F.NAME
	JRST	NOLST		;NO LISTING IF ZERO
ISLST:
	MOVE	T2,LSTSPC+F.DEV	;SET UP OPEN BLK
;	MOVE	T3,LSTSPC+F.MOD
;	JRST	NOLST
	TXO	F,LSTFLG	;FLAG THAT A LISTING IS NEEDED
	MOVEI	P1,LSTSPC	;LISTING SPEC POINTER
	MOVE	T3,LSTSPC+F.MOD	;GET MODIFIERS
	TXNE	F,SW.CRF	;CREF ?
	TXNN	T3,FX.NUL	;NUL EXTENSION?
	JRST	NOCREF		;NOT CREF OR EXTENSION ALREADY SPECIFIED
;	MOVE	T3,LSTSPC+F.EXT
;	JUMPL	T3,NOCREF	;SKIP IF EXPLICIT EXTENSION
	MOVEI	T3,'CRF'
	HRLM	T3,F.EXT(P1)	;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
	PUSHJ	P,MTMODE	;SET T1 FOR MAG TAPE MODE
	ADDX	T1,.IOASC	;ASCII MODE
	MOVSI	T3,LSTHDR	;POINTER TO BUFFER HEADER
	OPEN	LST,T1		;OPEN THE DEVICE
	  JRST	OPNERR		;CAN NOT OPEN DEVICE
	PUSHJ	P,SETENT	;SET UP FOR ENTER
	JRST	ERRST	;FILE NAME ERROR
	MOVEI	T1,LST	;SKIP RETURN OK
	DEVCHR	T1,
	TXNE	T1,DV.TTA
	TXO	F,TTYDEV	;SET BIT ON IF LST DEVICE IS TTY
	TXNN	T1,DV.DTA	;IS DEVICE A DECTAPE
	JRST	LST1		;NO
	ENTER	LST,LBLOCK+2
	  JRST	UUOERR
	JRST	LST2
LST1:
	ENTER	LST,LBLOCK	;ENTER THE FILE
	  JRST	UUOERR
LST2:
	MOVE	T1,F.NAME(P1)	;GET LISTING FILENAME
	MOVEM	T1,CHNLTB##+20	;STORE FOR USE IN PHASE1
	OUTBUF	LST,0		;SET UP O/P LST BUFFER
NOLST:	MOVEI	T1,[ASCIZ /%FTNNOF No output files given
/]
	TXNN	F,RELFLG!LSTFLG!SW.OCS	;ANY OUTPUT REQUESTED?
	PUSHJ	P,.TSTRG##	;NO--GIVE THE WARNING
	>			;END TOPS-10 ONLY

	PAGE
IFN	FTTENX,<		;HERE IS THE TOPS-20 SPECIFIC CODE
	SKIPN	T1,FINPTR	;CHECK FOR NO INPUT FILES
	JRST	FORTR1		;NO INPUT FILES
	SUBI	T1,F.LEN	;INITIALIZE CURRENT INPUT POINTER
	MOVEM	T1,CINPTR	;SAVE
	PUSHJ	P,NEWJFN	;GET THE NEXT FILE
	  JRST	FORTR1		;NO INPUT FILES GIVEN

	SKIPN	T2,RELSPC+F.DEV	;IS THERE A REL DEVICE
	JRST	NOREL			;NONE TRY LISTING
	MOVE	T2,RELSPC+F.MOD	;CHECK FOR NUL DEVICE AND NAME
	TXNN	T2,FX.NDV	;NO SKIP MEANS DEVICE THERE
	JRST	ISREL
	SKIPN	RELSPC+F.NAME	;NO SKIP MEANS DEVICE THERE
	JRST	NOREL		;NO NAME SPECIFIED
ISREL:
	TXO	F,RELFLG	;LIGHT THE REL FILE BIT FOR OUTMOD
	MOVEI	P1,RELSPC	;POINTER TO FILESPEC
	PUSHJ	P,MTMODE	;SET UP MODE FOR MAG TAPE
	PUSHJ	P,XFILCV	;CONVERT REL SPEC BACK TO ASCII
	MOVE	T2,[POINT 7,FILSPC]	;POINTER TO NEW SPEC
	HRRZI	T1,BINTAB	;LONG GTJFN FOR OUTPUT
	GTJFN
	  JRST	FILERR		;PROBLEMS
	MOVEM	T1,BINJFN	;OK - SAVE JFN
	HRRZ	T1,T1		;ZERO LEFT
	MOVE	T2,[XWD BINBYT,WRITEE]	;OPEN FOR WRITE
	OPENF
	  JRST	FILERR		;PROBLEMS

NOREL:
	SKIPN	T2,LSTSPC+F.DEV	;IS THERE A LISTING DEVICE
	JRST	NOLST			;NONE TODAY
	MOVE	T2,LSTSPC+F.MOD	;SAME AS FOR .REL FILE
	TXNN	T2,FX.NDV
	JRST	ISLST
	SKIPN	LSTSPC+F.NAME
	JRST	NOLST		;NO LISTING IF ZERO
ISLST:
	TXO	F,LSTFLG	;FLAG THAT A LISTING IS NEEDED
	MOVEI	P1,LSTSPC	;LISTING SPEC POINTER
	MOVE	T3,LSTSPC+F.MOD	;GET MODIFIERS
	TXNE	F,SW.CRF	;CREF ?
	TXNN	T3,FX.NUL	;NUL EXTENSION?
	JRST	NOCREF		;NOT CREF OR EXTENSION ALREADY SPECIFIED
	MOVEI	T3,'CRF'
	HRLM	T3,F.EXT(P1)	;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
	PUSHJ	P,MTMODE	;SET T1 FOR MAG TAPE MODE
	PUSHJ	P,XFILCV	;CONVERT LST SPEC BACK TO ASCII
	MOVE	T2,[POINT 7,FILSPC]	;POINTER TO NEW SPEC
	HRRZI	T1,LSTTAB	;LONG GTJFN FOR OUTPUT
	GTJFN
	  JRST	FILERR		;PROBLEMS
	MOVEM	T1,LSTJFN	;OK - SAVE JFN
	HRRZ	T1,T1		;ZERO LEFT
	MOVE	T2,[XWD LSTBYT,WRITEE]	;OPEN FOR WRITE
	OPENF
	  JRST	FILERR		;PROBLEMS

	;CONTROLLING TERMINAL?
	HRRZ	T1,LSTJFN	;GET JFN
	DVCHR			;CHARACTERISTICS
	HLRZ	T1,T1		;GET DEVICE TYPE
	CAIE	T1,TTCODE	;IS IT A TERMINAL
	JRST	NOTTY		;NO
	HRRZ	T3,T3		;SAVE TERMINAL NUMBER
	PUSH	P,T3
	GJINF			;CONTROLING INFORMATION
	POP	P,T3		;GET TERMINAL NUMBER BACK
	CAMN	T4,T3		;COMPARE TO CONROLLING TERMINAL NUMBER
	TXO	F,TTYDEV	;NOTE LST = CONTROLLING TTY:
NOTTY:
	MOVE	T1,F.NAME(P1)	;GET LISTING FILENAME
	MOVEM	T1,CHNLTB##+20	;STORE FOR USE IN PHASE1
NOLST:	MOVEI	T1,[ASCIZ /%FTNNOF No output files given
/]
	TXNN	F,RELFLG!LSTFLG!SW.OCS	;ANY OUTPUT REQUESTED?
	PUSHJ	P,.TSTRG##	;NO--GIVE THE WARNING
	>			;END TOPS-20 ONLY

;TOPS-10 AND TOPS-20 MERGE HERE

LOOP:
	SKIPN	T1,CCLSW
	JRST	BYNAM
	MOVEI	T1,[ASCIZ /FORTRAN: /]
	PUSHJ	P,.TSTRG##
	SKIPE	T1,CHNLTB##+32	;GET FILE NAME IF ANY
	PUSHJ	P,.TSIXN##	;TYPE AS SIXBIT
	PUSHJ	P,.TCRLF##	;GIVE AN EOL
BYNAM:
	MOVE	T1,DEBGSD	;MOVE LOCAL TO GLOBAL - MACRO BUG
	MOVEM	T1,DEBGSW##
	MOVE	T1,BUGINT
	MOVEM	T1,BUGOUT##	;INTERMEDIATE OUTPUT REQUEST SWITCHWES
	SETZM	SEGINCORE##	;ARGUMENT TO PHASE CONTROL
	PUSHJ	P,PHAZCONTROL##	;GET THE NEXT PHASE
	PORTAL	.+1		;[1047] Execute only re-entry
LOOPDN:
IFN FTTENX,< PUSHJ	P,CLOSUP## >	;CLOSE EVERYTHING
IFE FTTENX,<
	CLOSE	LST,		;CLOSE LISTING FILE
	CLOSE	SRC,		;CLOSE SOURCE FILE
	TXNE	F,SW.ERR	;ANY FATAL ERRORS?
	CLOSE	BIN,40		;YES - DISCARD .REL
	RELEASE	BIN,		;WILL DO CLOSE IF NEEDED
	>			;END TOPS-10 ONLY
	JRST	FORTR2		;INITIALIZE AND LOOK FOR NEXT COMMAND

	PAGE
	SUBTTL	SUBROUTINES CALLED FROM .TSCAN

;SUBROUTINE TO CLEAR ALL ANSWERS
CLRALL:	SETZM	SAVEF		;ERASE OLD SWITCHES
	SETZM	SAVEFM		;MASK WORD TOO
	SETZM	SAVE2		;MORE OF THE SAME
	SETZM	SAVE2M		;MASK WORD TOO
	PUSHJ	P,NOWCLR	;[1115] DEFAULT THE NOWARN DATA
	SKIPA	T2,[LSTCLR]	;THE WHOLE THING

;SUBROUTINE TO CLEAR FILE ANSWERS
CLRFIL:	MOVEI	T2,FAREA+F.LEN	;JUST CLEAR F AREA
	MOVE	T1,[FIRZER,,FIRZER+1] ;CLEAR FROM FIRZER
	SETZM	FIRZER		; ..
	BLT	T1,(T2)		; TO THE END
	POPJ	P,		; ..

;SUBROUTINE TO ALLOCATE AN OUTPUT AREA
ALLOUT:	AOS	T3,OUTCNT	;T3 = COUNT OF OUPUT FILES
	MOVE	T1,[EXP RELSPC,LSTSPC]-1(T3) ;T1 = ADDRESS OF SPEC
	MOVEI	T2,F.SLEN	;T2 = LENGTH OF SPEC
	CAIG	T3,2		;TOO MANY SPECS?
	POPJ	P,		;NO--ALL DONE
	F.FAIL	(<FTNTOF More than 2 output files are not allowed>) ;[1065]

;SUBROUTINE TO ALLOCATE AN INPUT AREA

ALLIN:	SKIPE	T1,LINPTR	;ANY LAST INPUT SPEC?
	JRST	ALLIN1		;YES--MAKE ANOTHER
	MOVE	T1,.JBFF##	;FIRST INPUT SPEC GOES HERE
	MOVEM	T1,FINPTR	;SAVE FOR LATER
	SUBI	T1,F.LEN	;FIX UP SO FIRST SPEC IS CORRECT
	MOVEM	T1,LINPTR	;SAVE AWAY
ALLIN1:	MOVEI	T2,<F.LEN*2>(T1);ADDRESS OF NEXT SPEC
	CAMGE	T2,.JBREL##	;WILL IT FIT?
	JRST	ALLIN2		;YES--CONTINUE
	CORE	T2,		;NO--EXPAND CORE
	  JRST	E.NCF		;NO CORE--YOU LOOSE
ALLIN2:	MOVEI	T1,F.LEN	;LENGTH OF SPEC
	ADDM	T1,.JBFF##	;UPDATE JOBFF
	ADDB	T1,LINPTR	;UPDATE T1 AND POINTER
	MOVEI	T2,F.SLEN	;AMOUNT SCAN KNOWS ABOUT
	POPJ	P,		;RETURN

;SUBROUTINE TO CLEAR STICKEY DEFAULTS

CLRSTK:	SETZM	PAREA		;ALL THE STICKEY DEFAULTS
	MOVE	T1,[PAREA,,PAREA+1] ; ..
	BLT	T1,PAREA+F.LEN-1; ARE IN THE PAREA
	POPJ	P,
;[1115] SUBROUTINE TO DEFAULT NOWARN DATA ANSWERS

NOWCLR:	SETZM	NWBITS			;[1115] CLEAR THE KEYWORD DATA
	MOVE	T1,[NWBITS,,NWBITS+1]	;[1115] AND THE MASKS
	BLT	T1,<NWMASK+NWWDCT-1>	;[1115]
	POPJ	P,			;[1115] DONE

;[1115] SUBROUTINE TO PROCESS THE NOWARN SWITCH KEYWORDS.
;[1115]  OPTIONS ARE ALWAYS APPLIED, IN THE ORDER GIVEN
;[1115]  EXACTLY AS SCAN OR-BIT-VALUES.

NOWARN:	SKIPN	N		;[1115] /NOWARN: OR /NOWARN:0?
	MOVEI	N,2		;[1115] MAKE IT NONE
	CAIE	N,-1		;[1115] WAS IT JUST /NOWARN
	CAIN	N,1		;[1115] OR /NOWARN:ALL?
	JRST	NW.ALL		;[1115] YES - SET ALL BITS ON
	CAIN	N,2		;[1115] /NOWARN:NONE?
	JRST	NW.NON		;[1115] YEP - CLEAR ALL BITS
	MOVEI	T1,-1(N)	;[1115] DETERMINE CORRECT WORD
	IDIVI	T1,^D36		;[1115]  AND POSITION TO SET
	MOVEI	T3,1		;[1115] GET BIT TO SHIFT
	LSH	T3,(T2)		;[1115] SHIFT TO PROPER POSITION
	IORM	T3,NWBITS(T1)	;[1115] SET NOWARN OPTION
	IORM	T3,NWMASK(T1)	;[1115] AND MASK BIT
	JRST	NW.DON		;[1115] LEAVE

NW.NON:	SETZ	T1,		;[1115] CLEAR ALL BITS
	SKIPA			;[1115] CHECK FURTHER
NW.ALL:	SETO	T1,		;[1115] SET ALL BITS
	MOVSI	T2,-NWWDCT	;[1115] SETUP FOR LOOP
NW.SET:	MOVEM	T1,NWBITS(T2)	;[1115] STORE VALUE
	SETOM	NWMASK(T2)	;[1115] SET MASK
	AOBJN	T2,NW.SET	;[1115] SET THEM ALL
	
NW.DON:	AOS	(P)		;[1115] WE STORED THE VALUE
	POPJ	P,		;[1115] BACK TO SCAN

;[1115] SUBROUTINE TO SETUP FOR SWITCH.INI PROCESSING

NOWSAV:	MOVE	T1,[NWBITS,,NWSAVB]	;[1115] MOVE COMMAND LINE DATA AND
	BLT	T1,<NWSAVM+NWWDCT-1>	;[1115] MASKS TO SAVE AREA
	PUSHJ	P,NOWCLR		;[1115] DEFAULT NOWARN ANSWERS
	POPJ	P,			;[1115] RETURN TO PROCESS SWITCH.INI

;[1115] SUBROUTINE TO MERGE COMMAND LINE/SWITCH.INI NOWARN ANSWERS

NOWMRG:	MOVSI	T1,-NWWDCT	;[1115] SETUP FOR LOOP
	MOVE	T3,[SW.NOW]	;[1115] GET NOWARN INDICATOR
NW.UPD:	MOVE	T2,NWSAVM(T1)	;[1115] GET MASK BITS FROM COMMAND LINE
	ANDCAM	T2,NWBITS(T1)	;[1115] CANNOT BE OVERRIDEN BY SWITCH.INI
	IORM	T2,NWMASK(T1)	;[1115] UPDATE MASK
	MOVE	T2,NWSAVB(T1)	;[1115] GET COMMAND LINE KEYWORDS
	IORM	T2,NWBITS(T1)	;[1115] UPDATE NOWARN KEYWORD SETTINGS
	SKIPE	NWBITS(T1)	;[1115] ANY OPTIONS REQUESTED?
	IORM	T3,SAVEF	;[1115] MAKE SURE NOWARN IS INDICATED
	AOBJN	T1,NW.UPD	;[1115] LOOP FOR ALL WORDS
	POPJ	P,		;[1115] DONE
	XALL
DEFINE	MEM(A),<
IRP	A,<
	SKIPE	T1,FAREA+F.'A	;IS A SPECIFIED?
	MOVEM	T1,PAREA+F.'A	;YES--REMEMBER A
>>



;SUBROUTINE TO MEMORIZE STICKEY DEFAULTS

MEMSTK:	MEM	(<ADV,BACK,WEOF,REW,DTZR>)
	POPJ	P,

DEFINE	APPLY(A),<
IRP	A,<
	MOVE	T1,PAREA+F.'A	;PICK UP STICKEY DEFAULT FOR A
	SKIPN	FAREA+F.'A	;IS A LOCAL OVER RIDE PRESENT
	MOVEM	T1,FAREA+F.'A	;NO--APPLY THE DEFAULT


>>

;SUBROUTINE TO APPLY STICKEY DEFAULTS

APPSTK:	APPLY	(<ADV,BACK,WEOF,REW,DTZR>)
	POPJ	P,
	SALL
IFE FTTENX,<
	PAGE
	SUBTTL	SUBROUTINES FOR COMMAND SCANNING

;SUBROUTINE TO  APPLY ABSENT DEFAULTS

ABSDEF:	SETCM	F,SAVEFM	;T1 GETS A 1 BIT FOR EVERY BIT IN F
				; WHICH WAS NOT EXPLICITLY SPECIFIED
				; BY THE USER.
	AND	F,INDADF	;AND WITH THE DEFAULTS.
	IORB	F,SAVEF		;OR IN THE SELECTED BITS.
	SETCM	T1,SAVE2M	;GET THOSE SWITCHES NOT REQUESTED
	AND	T1,INDAD2	;PICK UP DEFAULTS FOR THEM
	IORB	T1,SAVE2	;OR IN THE SELECTED SWITCHES
	MOVEM	T1,F2		;PUT OUT IN THE FLAG REGISTER
	MOVEI	T1,RELSPC	;POINT AT REL FILE
	HRLOI	T2,'REL'	;DEFAULT EXTENSION
	PUSHJ	P,DEFEXT	;FILL IN DEFAULT
	MOVEI	T1,LSTSPC	;POINT TO LISTING FILE SPEC
	HRLOI	T2,'LST'	;DEFAULT EXTENSION
	PUSHJ	P,DEFEXT	;FILL IN DEFAULT
	MOVE	T1,FINPTR	;POINT TO FIRST INPUT SPEC
ABSDF1:	HRLOI	T2,'FOR'	;DEFAULT EXTENSION
	PUSHJ	P,DEFEXT	;GO DEFAULT IT
	MOVX	T3,FX.PRT	;[656] BE SURE TO NOTICE 
	IORM	T3,F.MODM(T1)	;[656] THE /OKPROT BIT
	CAMN	T1,LINPTR	;LAST INPUT POINTER
	POPJ	P,		;YES--ALL SET UP
	ADDI	T1,F.LEN	;POINT TO NEXT SPEC
	JRST	ABSDF1		;LOOP FOR NEXT SPEC

;SUBROUTINE TO FILL IN A DEFAULT EXTENSION
;CALL WITH:
;	T1 = FILE SPEC POINTER (PRESERVED)
;	T2 = EXTENSION
;	PUSHJ	P,DEFEXT
;	RETURN HERE
DEFEXT:	HLRZ	T3,F.EXT(T1)	;GET EXTENSION
	JUMPN	T3,.POPJ##	;ALL DONE IF IT WAS GIVEN
	HRRE	T3,F.EXT(T1)	;EXPLICITLY NULL
	AOJE	T3,.POPJ##	;JUMP IF YES
	MOVEM	T2,F.EXT(T1)	;NO--SET UP DEFAULT
	POPJ	P,		; RETURN
	PAGE
	SUBTTL	LOOKUP/ENTER SUBROUTINES

;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
;	PUSHJ	P,NXTFIL
;	  NOTHING FOUND
;	SPEC POINTER IN P1
NXTFIL:	PORTAL	.+1		;[1047] Execute only entry
	MOVE	T1,[4,,[XWD FINPTR,LINPTR	;[1047]
			XWD OBLOCK,LBLOCK
			XWD F.LEN,.RBALC
			EXP 1B0+<SRC>B17+LKTEMP]]
	PUSHJ	P,.LKWLD##	;SCAN THE DISK OR TAPE
	  POPJ	P,		;NON-SKIP WHEN DONE
	MOVE	P1,LKTEMP	;POINTER TO CURRENT SPEC
	CAMN	P1,LINPTR	;SAME AS LAST SPEC
	SKIPE	.WLDFL##	; AND NO WILD CARDS?
	TXZA	F,EOCS		;NO--MAY BE MORE
	TXO	F,EOCS		;YES--THIS IS THE LAST SPEC.
	PUSHJ	P,OPENIN	;OPEN THE INPUT FILE
	MOVE	T1,F.NAME(P1)	;GET SRC FILENAME
	MOVEM	T1,CHNLTBL##+32	;PUT IN TABLE TO BE LOOKED
				; AT BY LISTING HEADER
	MOVE 	T1,F.EXT(P1)	;EXTENSION
	MOVEM	T1,CHNLTBL+33	;EXTENSION FIELD FOR SRC
				;ROUTINE IN CLASS
	JRST	.POPJ1##	;SKIP RETURN


;SUBROUTINE TO OPEN THE INPUT FILE
;CALL WITH:
;	P1 = FILE SPEC POINTER
;	PUSHJ 	P,OPENIN
;	RETURN HERE
OPENIN:	HRRZI	T1,SRCHDR	;BUFFER HEADER
	MOVEM	T1,OBLOCK+2	;STORE IN OPEN BLOCK
	OPEN	SRC,OBLOCK	;OPEN THE DEVICE
	  JRST	OPNER1		;OPEN ERROR
	MOVEI 	T1,SRC
	DEVCHR	T1,
	MOVE	T2,FLAGS2##	;SECONDARY FLAG REGISTER
	TXNE	T1,DV.TTY	;IS DEVICE A TTY
	TXOA	T2,TTYINP	;YES
	TXZ	T2,TTYINP	;NO
	MOVEM	T2,FLAGS2##	;SAVE IT
	PUSH	P,LBLOCK+.RBPPN	;SAVE .RBPPN OVER LOOKUP
	TXNN	T1,DV.DTA	;IS DEVICE DECTAPE
	JRST	OPEN1		;NO
	LOOKUP	SRC,LBLOCK+2	;DO DIFFERENT LOOKUP
	JRST	OPNER2
	JRST	OPEN2
OPEN1:
	LOOKUP	SRC,LBLOCK	;LOOKUP THE FILE
	  JRST	OPNER2		;NO CAN DO
OPEN2:
	POP	P,LBLOCK+.RBPPN	;RESTORE .RBPPN TO WHAT USER SAID
	MOVE	T2,OBLOCK	;T2 GETS THE DEVICE NAME
	PJRST	MTAOP		;POSITION MAG TAPE
OPNER1:
	PUSHJ	P,E.DFO##
ERRST:			;ERROR ENTRY
	SKIPE	T1,CCLSW
	JRST	COMND
	JRST	FORTR1		;LOOP BACK
OPNER2:
	POP	P,LBLOCK+.RBPPN	;RESTORE .RBPPN FROM LOOKUP ERROR
	HRRZ	T1,LBLOCK+.RBEXT
	JUMPN	T1,OPNE2A	;EXPLICIT EXTENSION FILE LOOKUP ERROR
	MOVX	T1,FX.NUL	;NULL EXT MASK
	TDNN	T1,F.MOD(P1)	;WAS NULL EXTENSION INPUT?
	JRST	OPNE2A		;NO
	ANDCAM	T1,F.MOD(P1)	;YES,TURN OFF THAT BIT TO AVOID ALOOP
	HRRZS	LBLOCK+.RBEXT	;ZERO THE EXTENSION FIELD IN LOOKUP BLOCK
	JRST	OPENIN		;TRY AGAIN WITH NULL EXTENSION
OPNE2A:
	PUSHJ	P,E.DFL##	;TRY AGAIN AFTER ERROR MESSAGE
	SKIPE	T1,CCLSW
	JRST	COMND
	JRST	FORTR1		;LOOP BACK


;	SUBROUTINE TO CALCULATE THE MAX CORE REQUIREMENTS FOR THE LIST
;	OF INPUT FILES.  CHECK THE
;	LIST OF FILES AND SAVE THE REQUIREMENTS OF THE LARGEST.
;	CALL WITH:
;		PUSHJ	GETSIZ
;		RETURN	HERE
GETSIZ:MOVE	T1,FINPTR	;FIRST FILE AREA
	SETZM	BGSTBF##	;CLEAR LARGEST SAVE LOCATION
GETSI2:		;SET UP ARG BLOCK
	MOVEI	T2,0	;STATUS
	MOVE	T3,F.DEV(T1)	;DEVICE NAME
	MOVEI	T4,T2	;ARG BLOCK ADDRESS
	DEVSIZ	T4,		;GET DEFAULT NUMBER AND SIZE OF BUFFERS
	MOVE	T4,[2,,203]	;[704] ASSUME OLD MONITOR - 2 DSK BUFFERS
	JUMPLE	T4,GETSI1		;IGNORE ANY ERRORS
				;SOMEONE ELSE WILL CATCH THEM
	HLRZ	T3,T4		;MOVE NUMBER OF BUFFERS
	HRRZ	T4,T4		;ZERO T4<LEFT>
	IMUL	T4,T3		;TOTAL SIZE
	CAMLE	T4,BGSTBF##	;IS THIS LARGEST SO FAR?
	MOVEM	T4,BGSTBF##	;YES - SAVE IT
GETSI1:
	CAMN	T1,LINPTR	;ARE WE DONE?
	POPJ	P,		;YES
	ADDI	T1,F.LEN	;NO - DO NEXT ONE
	JRST	GETSI2

;SUBROUTINE TO SET UP FOR AN ENTER
;CALL WITH:
;	P1 = FILE SPEC POINTER
;	PUSHJ	P,SETENT
;	RETURN HERE
SETENT:	PUSHJ	P,MTAOP		;POSITION THE TAPE
	SETZM	LBLOCK+.RBPPN
	SETZM	LBLOCK+.RBSIZ
	SETZM	LBLOCK+.RBVER
	SETZM	LBLOCK+.RBSPL
	SETZM	LBLOCK+.RBALC
	MOVE	T1,F.NAME(P1)	;PICK UP FILE NAME
	MOVE	T2,F.NAMM(P1)	;PICK UP FILE NAME MASK
	AOJN	T2,E.WILD	;CAN NOT BE WILD
	MOVEM	T1,LBLOCK+.RBNAM;STORE THE FILE NAME
	HRRE	T2,F.EXT(P1)	;GET THE EXTION MASK
	AOJN	T2,E.WILD	;MUST BE ALL SPECIFIED
	HLLZ	T2,F.EXT(P1)	;PICK UP THE EXTENSION
	MOVEM	T2,LBLOCK+.RBEXT;STORE FOR THE ENTER
	LDB	T1,[<POINTR(F.MOD(P1),FX.PRO)>] ;GET THE PROTECTION
	ROT	T1,-^D9		;PUT IN THE LEFT 9 BITS
	MOVEM	T1,LBLOCK+.RBPRV;STORE FOR THE ENTER
	MOVX	T1,FX.DIR	;DIRECTORY SPECIFIED?
	TDNN	T1,.FXMOD(P1)	; ??
	JRST	.POPJ1##		;NO--ALL DONE
	MOVE	T2,F.DIRM(P1)	;IS PPN WILD?
	AOJN	T2,E.WILD	;YES == ERROR
	MOVE	T1,F.DIR(P1)	;PICK UP PPN
	MOVEM	T1,LBLOCK+.RBPPN;STORE FOR THE MOMENT
	SKIPN	F.DIR+2(P1)	;NEED ANY SFD'S TODAY
	JRST	.POPJ1##		;NO--ALL DONE
	MOVEI	T2,PATH		;YES--POINT ENTER TO PATH
	MOVEM	T2,LBLOCK+.RBPPN;  ..
	ADDI	T2,2		;SKIP PAST SWITCHES
	MOVEM	T1,(T2)		;STORE PPN
	MOVEI	T1,F.DIR+2(P1)	;POINT TO SFD LIST
SETEN1:	MOVE	T3,1(T1)	;IS SFD WILD?
	AOJN	T3,E.WILD	;YES == ERROR
	MOVE	T3,(T1)		;PICK UP SFD
	MOVEM	T3,1(T2)	;STORE IN PATH
	ADDI	T1,2		;SKIP TO NEXT SFD
	SKIPE	(T1)		;IS IT THERE??
	AOJA	T2,SETEN1	;YES--LOOP OVER IT
	SETZM	2(T2)		;NO--END THE LIST
	JRST	.POPJ1##
;SUBROUTINE TO PERFORM MAG TAPE OPERATIONS
;CALL WITH:
;	MOVEI	P1,FILE-SPEC-POINTER
;	PUSHJ	P,MTAOP
;	RETURN HERE WITH TAPE POSITIONED
MTAOP:	POPJ	P,		;NULL FOR NOW

;SUBROUTINE TO SET UP T1 AS A MODE  WORD FOR MAG TAPES
;CALL WITH:
;	MOVEI	P1,FILE-SPEC-POINTER
;	PUSHJ	P,MTAOP
;	RETURN HERE WITH T1 SET UP
MTMODE:	SETZM	T1		;START WITH A CLEAN SLATE
	POPJ	P,		;RETURN
	>		;End of TOPS-10 code
	PAGE
	SUBTTL	ERROR CONDITIONS

CP166:	OUTSTR	[ASCIZ /?FTNPD6 FORTRAN will not run on a PDP-6
/]
	CLRBFI	
	EXIT			;Totally fatal

KA10:	OUTSTR	[ASCIZ /?FTNKA FORTRAN will not run on a KA
/]
	CLRBFI
	EXIT			;Totally fatal

GFLBAD:	OUTSTR	[ASCIZ \?FTNGFM /GFL requires GFLOATING microcode
\]
	CLRBFI
	JRST	FORTR2		;TRY ANOTHER COMMAND LINE

KA10SW:	OUTSTR	[ASCIZ \?FTNKAS FORTRAN can not compile for a KA
\]
	CLRBFI
	JRST	FORTR2		;TRY ANOTHER COMMAND LINE

KI10SW:	OUTSTR	[ASCIZ \%FTNKIS Obsolete switch /KI
\]
	POPJ	P,		;Return to scan - ignore the stitch

E.NCF:	MOVEI	N,1(T2)
	F.FAID	(<FTNNCF Not enough core for file specs. Total K needed=>,N);[1065]

IFE FTTENX,<
UUOERR:	HRRZ	T2,LBLOCK+.RBEXT
	HRRZ	N,P1		
	SETZM	LKTEMP		;CLEAR .LKWLD STATE
	CAIN	T2,2
	JRST	EER02
	CAIN	T2,6
	JRST	EER06
	CAIN	T2,14
	JRST	EER14
	F.FAIF	(<FTNETF ENTER failure>,T2,N)		;[1065]
EER02:	F.FAIF	(<FTNPRF Protection failure>,T2,N)	;[1065]
EER06:	F.FAIF	(<FTNRDE RIB or directory error>,T2,N)	;[1065]
EER14:	F.FAIF	(<FTNQEF Quota exceeded or disk full>,T2,N) ;[1065]

OPNERR:	MOVEM	T2,.WILDZ##	;COPY DEVICE NAME TO FSTR IN WILD
	JRST	OPNER1		;GIVE ERROR MESSAGE

E.WILD:	MOVE	N,P1
	MOVE	T1,F.DEV(P1)	;GET DEVICE NAME
	DEVTYP	T1,		;GET THE DEVICE TYPE
	  HALT	.		;CAN ONLY FAIL IF THERE IS A BUG IN FORTRAN
				; SINCE FOROTS NEEDS THIS CALLI IT MUST EXIST
	TXNN	T1,TY.INT	;IF INTERACTIVE, ALWAYS OK
	TXNN	T1,TY.MAN	;LOOKUP/ENTER MANDATORY?
	JRST	.POPJ1##		;NO--IGNORE BAD FILE NAME
	SETOM	T2		;YES--GIVE ERROR MESSAGE
	SETZM	LKTEMP		;CLEAR .LKWLD STATE
	F.FAIF	(<FTNNWD Incorrect use of * or ? in>,T2,N)	;[1065]

				; FOR ERROR MESSAGES.
	XLIST			;Literals
LIT::	LIT

	>			;END TOPS-10 ONLY

	LIST

	PAGE
	SUBTTL	Resident low core routines and data

	RELOC			;IMPURE CODE

; CORE UUO FAILURE ROUTINE IS LOW SEGMENT RESIDENT (CALLED FROM CORMAN AND GETCOR)

CORERR::			;HERE WHEN CORE UUO FAILS
	MOVEM	T1,APRSV1	;STORE T1
	MOVEM	T2,APRSV2	;STORE T2
	SOS	T1,0(P)		;WHERE WERE WE CALLED FROM
	HRRZM	T1,.JBTPC##	;STORE ADDRESS
	MOVEI	T2,CORTXT	;LOCATE MESSAGE
	JRST	APRTR4		;FINISH MESSAGE
	
CORTXT:	ASCIZ	\?FTNUCE User Core Exceeded\

; APR TRAP ROUTINE IS LOW-SEGMENT RESIDENT

; TEXT FOR APR TRAP ROUTINE

APRNXM:	ASCIZ	\Illegal Memory Reference\
APRPOV:	ASCIZ	\Stack exhausted\
APRILM:	ASCIZ	\Memory Protection Violation\
APRABK:	ASCIZ	\Address Break\
APRTX0:	ASCIZ	\
?Internal Compiler Error
?\
APRTX1:	ASCIZ	\ at location \
APRTX2:	ASCIZ	\ in Phase \
APRTX3:	ASCIZ	\
?while processing statement \

APRPN1:	POINT	3,.JBTPC##,17		;USEFUL BYTE POINTER
APRPN2:	POINT	6,GETSBL##+1		;[1047] USEFUL BYTE POINTER
APRIOR:	ASCII	\00000\			;MAKE A NUMBER

APRTRP:	JRSTF	@.+1			;CLEAR FIRST PART DONE
	0,,.+1				;CLEAR APR FLAGS
	TTCALL	3,APRTX0		;PREFACE MESSAGE
	MOVEM	T1,APRSV1		;SAVE A REGISTER
	MOVEM	T2,APRSV2		;SAVE A REGISTER
	MOVEI	T2,APRNXM		;ASSUME ILL MEM REF
	MOVE	T1,.JBCNI##		;TEST ERROR
	TRNE	T1,AP.POV		;PDL OVERFLOW?
	MOVEI	T2,APRPOV		;LOCATE MESSAGE
	TRNE	T1,AP.ABK		;ADDRESS BREAK
	MOVEI	T2,APRABK		;LOCATE MESSAGE
	TRNE	T1,AP.ILM		;MEMORY PROTECTION
	MOVEI	T2,APRILM		;LOCATE MESSAGE
APRTR4:	TTCALL	3,0(T2)			;TYPE MESSAGE
	TTCALL	3,APRTX1		;CONTINUE
	MOVE	T2,APRPN1		;LOAD POINTER
APRTR1:	ILDB	T1,T2			;TYPE ADDRESS
	MOVEI	T1,"0"(T1)		;TYPE ADDRESS
	TTCALL	1,T1			;TYPE DIGIT
	TLNE	T2,770000		;TYPE 6 DIGITS
	JRST	APRTR1			;TYPE 6 DIGITS
	SKIPN	.JBHRL##		;HIGH SEGMENT?
	JRST	APRTR2			;NO
	TTCALL	3,APRTX2		;CONTINUE
	MOVE	T2,APRPN2		;TYPE SEGMENT NAME
APRTR3:	ILDB	T1,T2			;LOAD BYTE
	MOVEI	T1," "(T1)		;TO ASCII
	TTCALL	1,T1			;TYPE BYTE
	TLNE	T2,770000		;TYPE 6 CHARACTER
	JRST	APRTR3			;TYPE 6 CHARACTER
APRTR2:	TTCALL	3,APRTX3		;CONTINUE
	MOVE	T1,ISN##		;GET STATEMENT #
	MOVEM	T3,APRSV3		;SAVE A REGISTER
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,-7			;STORE
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,-7			;STORE
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,-7			;STORE
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,^D29			;BUILD NUMBER
	LSHC	T1,^D29			;BUILD NUMBER
	IOR	T1,APRIOR		;CONVERT TO ASCII
	MOVSI	T2,(BYTE (7)15,12)	;FINISH MESSAGE
	TTCALL	3,T1			;FINISH MESSAGE
	MOVE	T1,APRSV1		;RESTORE AC
	MOVE	T2,APRSV2		;RESTORE AC
	MOVE	T3,APRSV3		;RESTORE AC
	EXIT	1,			;DONE
APRSV1:	BLOCK	1
APRSV2:	BLOCK	1
APRSV3:	BLOCK	1

	PAGE
	SUBTTL	File specification area definitions

;CCLSW:	BLOCK 	1	;0 IF NORMAL START, 1 IF CCL START (NOW IN GLOBAL.BLI)
FIRZER:!		;FIRST LOCATION TO ZERO
FAREA:	PHASE	0
F.DEV:!	BLOCK	1	;DEVICE NAME
F.NAME:!BLOCK	1	;FILE NAME
F.NAMM:!BLOCK	1	;FILE NAME MASK
F.EXT:!	BLOCK	1	;EXTENSION
F.MOD:!	BLOCK	1	;MOD WORD
F.MODM:!BLOCK	1	;MOD MASKS
F.DIR:!	BLOCK	1	;PPN
F.DIRM:!BLOCK	1	;DIRECTORY MASK
	BLOCK	12	;SPACE FOR SFD BIWORDS

F.SLEN==.-F.DEV		;SIZE OF THE BLOCK SCAN KNOWS ABOUT

F.ADV:!	BLOCK	1	;NUMBER OF FILES TO ADVANCE TAPE
F.BACK:!BLOCK	1	;NUMBER OF FILES TO BACKSPACE TAPE
F.WEOF:!BLOCK	1	;WRITE AN END OF FILE
F.REW:!	BLOCK	1	;REWIND THE TAPE
F.DTZR:!BLOCK	1	;ZERO THE DTA DIRECTORY
	DEPHASE

F.LEN=.-FAREA		;SIZE OF THE FAREA

;AREA TO REMEMBER STICKEY SWITCHES

PAREA:	BLOCK	F.LEN	;STICKEY SPEC BLOCK

;OTHER FILE SPECIFICATION STORAGE

RELSPC:	BLOCK	F.LEN	;AREA FOR REL FILE SPEC
LSTSPC:	BLOCK	F.LEN	;AREA FOR LIST FILE SPEC
FINPTR:	BLOCK	1	;POINTRER TO FIRST INPUT SPEC
LINPTR:	BLOCK	1	;POINTER TO LAST INPUT SPEC
CINPTR:	BLOCK	1	;CURRENT SPEC POINTER
OUTCNT:	BLOCK	1	;NUMBER OF OUTPUT FILE SPECS
LSTCLR==.-1		;LAST WORD TO ZERO ON A *

; THE FOLLOWING FOUR WORDS ARE TO HOLD SETTABLE SWITCH VALUES

SAVEF:	BLOCK	1	;HOLDS F WHILE IN SCAN SO .SWDPB DOES NOT
			; HARM T1.
SAVEFM:	BLOCK	1	;MASKS FOR STORED FLAGS
SAVE2:	BLOCK	1	;SECOND FLAG WORD FOR SWITCHES
SAVE2M:	BLOCK	1	;SECOND MASK WORD FOR STORED FLAGS

;[1115] DATA FOR PROCESSING /NOWARN, AND RELATED KEYWORDS
NWBITS:: BLOCK	NWWDCT	;[1115] NOWARN BITS
NWMASK:	BLOCK	NWWDCT	;[1115] NOWARN CONFLICT MASK BITS
NWSAVB:	BLOCK	NWWDCT	;[1115] NOWARN COMMAND BITS SAVE AREA
NWSAVM:	BLOCK	NWWDCT	;[1115] NOWARN COMMAND MASK SAVE AREA

DEBGSD:	BLOCK	1	;LOCAL HOLDER OF DEBUG SWITCHES
BUGINT:	BLOCK	1	;HOLDS INTERNAL OUTPUT SWITCHES

;LOCATIONS IN GLOBAL USED BY INOUT BUT SET UP HERE

DEFINE	BUFHDR(A,B),<
IRP A,<
IRP B,<
	A'B=CHNLTBL##+<<A-1>*TBLMAX>+B
>>>

IFE FTTENX	< BUFHDR (<BIN,LST,SRC>,<HDR,PNT,CNT>) >
IFN FTTENX	< BUFHDR (<BIN,LST,SRC,ICL>,<JFN,HDR,PNT,CNT>) >

IFE FTTENX	<
;UUO BLOCKS

LBLOCK:	BLOCK	.RBALC+1	;FOR LOOKUPS
OBLOCK:	BLOCK	3		;FOR OPENS
LKTEMP:	BLOCK	1		;FOR WILD
PATH:	BLOCK	1		;FOR PATH. UUO
		>		;END OF LOCAL TOPS10 STORAGE

IFN FTTENX	<
FILSPC:	BLOCK	10		;BUILD AREA FOR FILE SPEC
ICLEST:	BLOCK	24		;STORE AREA FOR INCLUDE FILE ERROR MESSAGE
		>		;END OF LOCAL TOPS20 STORAGE

LASZER==.-1
IFN FTTENX,<
	PAGE
	SUBTTL	SUBROUTINES FOR COMMAND SCANNING

;SUBROUTINE TO  APPLY ABSENT DEFAULTS

	RELOC

ABSDEF:	SETCM	F,SAVEFM	;T1 GETS A 1 BIT FOR EVERY BIT IN F
				; WHICH WAS NOT EXPLICITLY SPECIFIED
				; BY THE USER.
	AND	F,INDADF	;AND WITH THE DEFAULTS.
	IORB	F,SAVEF		;OR IN THE SELECTED BITS.
	SETCM	T1,SAVE2M	;GET THOSE SWITCHES NOT REQUESTED
	AND	T1,INDAD2	;PICK UP DEFAULTS FOR THEM
	IORB	T1,SAVE2	;OR IN THE SELECTED SWITCHES
	MOVEM	T1,F2		;PUT OUT IN THE FLAG REGISTER
	POPJ	P,		;--ALL SET UP
	PAGE
	SUBTTL	LOOKUP/ENTER SUBROUTINES

;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
;	PUSHJ	P,NXTFIL
;	  NOTHING FOUND
;	SPEC POINTER IN P1
NXTFIL:
	MOVE	T1,SRCJFN	;GET JFN
	GNJFN			;SEE IF THERE IS ANOTHER FILE HERE
	  JRST	NEWJFN		;NO MORE
	JRST	OPNSRC		;GOT ONE

	;GET 1ST JFN FOR FILE
NEWJFN:
	MOVE	P1,CINPTR	;GET CURRENT SPEC POINTER
	CAMN	P1,LINPTR	;ARE WE DONE
	POPJ	P,		;YES - NONSKIP RETURN
	ADDI	P1,F.LEN	;UPDATE POINTER
	MOVEM	P1,CINPTR	;SAVE IT
	PUSHJ	P,XFILCV	;CONVERT SPEC BACK TO ASCII
	HRRZI	T1,SRCTAB	;SRC LONG JFN TABLE
	MOVE	T2,[POINT 7,FILSPC]	;NEW FILE SPEC
	GTJFN
	  JRST	SRCNUL		;TRY WITHOUT DEFAULT OF "FOR"
NOTFOR:
	MOVEM	T1,SRCJFN	;SAVE JFN

	;WHAT SORT OF DEVICE DO WE HAVE
OPNSRC:
	HRRZ	T1,T1		;ZERO LEFT
	DVCHR
	MOVE	T3,FLAGS2##	;PREPARE TO SET TTY BIT

	HLRZ	T1,T1		;GET DEVICE CODE
	CAIN	T1,TTCODE	;IS IT TTY?
	JRST	TTYSRC		;YES

	;SRC NOT TTY:
	TXZ	T3,TTYINP	;NOTE NOT TTY:
	MOVE	T2,[XWD INBYT,READ]	;SET UP FOR OPEN
	JRST	GOTSRC

	;TTY:
TTYSRC:
	TXO	T3,TTYINP	;NOTE TTY:
	MOVE	T2,[XWD TTYBYT,READ!WRITEE]	;SET UP FOR OPEN

	;OPEN THE FILE
GOTSRC:
	MOVEM	T3,FLAGS2##	;SAVE THOSE FLAGS
	HRRZ	T1,SRCJFN	;GET JFN
	OPENF
	  JRST	FILERR		;PROBLEMS
	MOVE	T1,F.NAME(P1)	;SAVE FILE NAME FOR
	MOVEM	T1,CHNLTBL##+32		; THE COMPILER
	MOVE	T1,F.EXT(P1)		; AND EXTENSION
	MOVEM	T1,CHNLTBL##+33
	TXZ	F,EOCS			;CLEAR END INPUT BIT
	JRST	.POPJ1##		;GOT FILE - SKIP RETURN

	;TRY SRC WITHOUT "FOR"
SRCNUL:
	MOVE	T1,[GJ%SHT!GJ%OLD!GJ%IFG]	;FLAGS
	MOVE	T2,[POINT 7,FILSPC]	;ASCII FILE SPEC
	GTJFN
	  JRST	FILERR			;GIVE IT UP
	JRST	NOTFOR			;GOT IT WITH "NUL"

	;SUBROUTINE TO CONVERT FILE SPEC BLOCK
	;POINTED TO BY P1 INTO AN ASCII STRING
	; AND PUT IT IN FILSPC
	;CALL WITH
	;	P1 - SPEC POINTER
	;	PUSHJ	XFILCV
	;	RETURN	HERE
XFILCV:
	MOVE	T1,[ASCIZ /DSK:/]	;DEFAULT DEVICE
	MOVEM	T1,FILSPC		; FOR PPNST
	MOVE	T3,[POINT 7,FILSPC,27]	;PTR TO AFTER DEFAULT DEV:

	SKIPN	T2,F.DEV(P1)		;GET DEVICE NAME
	JRST	NODEV			;NONE THERE
	SETZM	T1,FILSPC		;CLEAR DEFAULT DEVICE
	MOVE	T3,[POINT 7,FILSPC]	;INITIAL POINTER
	PUSHJ	P,X6.7CV		;CONVERT
	MOVEI	T1,":"			;PUT IN COLON
	IDPB	T1,T3

NODEV:
	MOVX	T2,FX.DIR		;
	TDNN	T2,.FXMOD(P1)		;IS THERE A PPN?
	JRST	NOPPN			;NO
	MOVE	T2,F.DIRM(P1)		;IS PPN WILD?
	AOJN	T2,E.WILD		;YES == ERROR
	MOVE	T1,[POINT 7,FILSPC]	;PUT ANSWER HERE
	MOVE	T2,F.DIR(P1)		;GET PPN
	MOVE	T4,T3			;SAVE PTR TO AFTER DEV: FOR DIRST
	MOVE	T3,T1			;POINT TO DEV:
	PPNST				;PPN TO DIRECTORY
	ERJMP	CHK1B			;DIDN'T WORK: CHECK FOR 1B
PPNOK:					;
	MOVE	T3,T1			;T3 IS OUR FILE SPEC PTR
NOPPN:					;
	SKIPN	T2,F.NAME(P1)		;FILE NAME
	JRST	NONAM			;NOPE
	PUSHJ	P,X6.7CV		;CONVERT IT

NONAM:
	HLLZS	F.EXT(P1)		;CLEAR RIGHT HALF
	SKIPE	T2,F.EXT(P1)		;EXTENSION
	JRST	DODOT			;YES
	MOVX	T1,FX.NUL		;NULL EXT MASK
	TDNE	T1,F.MOD(P1)		;EXPLICITLY NULL?
	JRST	NULEXT			;NO
DODOT:	MOVEI	T1,"."			;PUT DOT IN
	IDPB	T1,T3
	CAIE	T2,			;DID WE HAVE A NAME
	PUSHJ	P,X6.7CV		;YES CONVERT
NULEXT:
	MOVEI	T1,0			;NULL TERMINATOR
	IDPB	T1,T3		
	POPJ	P,			;RETURN

;PPNST FAILED: IF IT FAILED BECAUSE THE JSYS WAS UNDEFINED,
;  THEN WE MUST BE RUNNING ON VERSION 1B MONITOR AND CAN USE
;  DIRST TO CONVERT THE PPN TO A DIRECTORY
CHK1B:					;
	HRRZI	T1,400000		;GET PROCESS HANDLE
	GETER				;WHY DID PPNST FAIL?
	HRRZ	T2,T2			;REMOVE PROCESS HANDLE
	CAIE	T2,ILINS2		;IS PPNST JSYS DEFINED?
	JRST	FILERR			;YES == VERSION 2 ERROR
	HLRZ	T2,F.DIR(P1)		;CHECK PROJECT #
	CAIE	T2,4			;IS PROJ # = 4?
	JRST	PPN4ER			;NO == ERROR
	HRRZ	T2,F.DIR(P1)		;GET PROG # = DIRECTORY #
	MOVE	T1,T4			;GET PTR TO AFTER DEV: SAVED ABOVE
	MOVEI	T3,"<"			;
	IDPB	T3,T1			;PUT IN PUNCTUATION
	DIRST				;PROG # TO DIRECTORY
	  JRST	FILERR			;PPN ERROR
	MOVEI	T3,">"			;
	IDPB	T3,T1			;PUT IN PUNCTUATION
	JRST	PPNOK			;


	;ROUTINE TO CONVERT 6BIT TO 7BIT
	;CALL WITH
	;	T3 = BYTE POINTER OF DESTINATION
	;	T2 = 6BIT NAME
	;	PUSHJ	P,X6.7CV
	;	RETURN	HERE
X6.7CV:
	SETZM	T1		;CLEAR CHARACTER REG
	LSHC	T1,6		;GET CHAR
	CAIN	T1,
	POPJ	P,		;DONE
	ADDI	T1," "		; TO 7BIT
	IDPB	T1,T3		;STORE IT
	JRST	X6.7CV		;DO MORE


	;ROUTINE TO PROCESS FILE ERRORS
	;	JRST	FILERR
FILERR:
	MOVE	T1,[-1,,FLEHDR]	;MESSAGE HEADER
	PSOUT			;TYPE IT
	HRRZI	T1,101		;PRIMARY OUTPUT JFN
	HRLOI	T2,400000	;CURRENT FORK,CURRENT ERROR
	SETZM	T3
	ERSTR
	  JRST	ERRERR		;UNKNOWN ERROR
	  JRST	ERRERR		;PROBLEM
	MOVE	T1,[-1,,CRLFST]	;ADD CRLF
	PSOUT
	JRST	ERRST		;TAKE IT FROM THE TOP

	;ERROR HANDLING ERROR
ERRERR:
	MOVE	T1,[POINT 7,UNKFLE]
	PSOUT
	JRST	ERRST		;RESTART

UNKFLE:	ASCIZ	/FILE ERROR - UNKNOWN
/

CRLFST:	ASCIZ	/
/
FLEHDR:	ASCIZ	/?FTNFER /		;ERROR MESSAGE PREFIX

;ROUTINE TO PROCESS WILD PPN ERRORS
E.WILD:	MOVE	T1,[POINT 7,WLDERR]	;GET ERROR MESSAGE
	PSOUT				;DISPLAY IT
	JRST	ERRST			;GET OUT

WLDERR:	ASCIZ	/?FTNNWD Incorrect use of * or % in ppn
/

;PROJECT # MUST = 4 FOR DIRST JSYS ON TOPS-20 V1B

PPN4ER:					;
	MOVE	T1,[POINT 7,PRJERR]	;GET ERROR MESSAGE
	PSOUT				;DISPLAY IT
	JRST	ERRST			;GET OUT

PRJERR:	ASCIZ	/?FTNPN4 Project number must be 4 in ppn
/


ERRST:			;ERROR ENTRY
	SKIPE	T1,CCLSW
	JRST	COMND
	JRST	FORTR1		;LOOP BACK


	;SUBROUTINE TO OPEN INCLUDE FILES
	;CHECK TO SEE THAT THEY ARE DISK
	;CALL WITH
	;	ICLPTR = ASCIII FILE SPEC POINTER
	;	PUSHJ	P,OPNICL
	;	RETURN	HERE
	;		VREG = 0 - OK
	;		OR
	;		VREG = ASCII ERROR STRING MESSAGE POINTER
OPNICL::
	PUSH	P,T1
	PUSH	P,T2
	PUSH	P,T3
	HRRZI	T1,ICLTAB	;LONG GTJFN INCLUDE FILE TABLE
	MOVE	T2,ICLPTR	;SPEC POINTER
	GTJFN
	  JRST	ICLNUL		;TRY WITHOUT DEFAULT "FOR"
NULX:	MOVEM	T1,ICLJFN	;SAVE JFN
	MOVEM	T2,ICLPTR	;SAVE POINTER TO LOOK FOR SWITCHES
	;CHECK FOR DSK:
	HRRZ	T1,T1		;ZERO LEFT
	DVCHR
	HLRZ	T1,T1		;GET DEVICE CODE
	CAIE	T1,DSKCOD	;DSK:?
	JRST	NOTDSK		;NO
	HRRZ	T1,ICLJFN	;GET JFN AGAIN
	MOVE	T2,[XWD INBYT,READ]	;SETUP FOR OPEN
	OPENF
	  JRST	ICLERR		;PROBLEMS
	MOVEI	VREG,0		;GOOD RETURN
ICLRET:	POP	P,T3
	POP	P,T2
	POP	P,T1
	POPJ	P,

	;TRY WITHOUT DEFAULT "FOR"
ICLNUL:	MOVE	T1,[GJ%SHT!GJ%OLD]	;FLAGS
	MOVE	T2,ICLPTR##		;FILE SPEC POINTER
	GTJFN	
	  JRST	ICLERR		;DIDN'T HELP
	JRST	NULX			;OK GOT IT

NOTDSK:	MOVE	VREG,[POINT 7,NODSK]	;NOT DSK MESSAGE
	JRST	ICLRET

NODSK:	ASCIZ	/DEVICE MUST BE DISK/

ICLERR:
	MOVE	T1,[POINT 7,ICLEST]	;MESSAGE STORE AREA
	HRLOI	T2,400000		;CURRENT FORK,CURRENT ERROR
	HRLZI	T3,-^D100		;MESSAGE LIMIT
	ERSTR
	  JRST	ICLERR			;UNKNOWN
	  JRST	ICLERR			;PROBLEM
	MOVE	VREG,[POINT 7,ICLEST]	;MESSAGE POINTER
	JRST	ICLRET

ICLEER:	MOVE	VREG,[POINT 7,UNKFLE]	;UNKNOWN ERROR
	JRST	ICLRET

	;ROUTINE TO CLOSE THE ICL FILE
	;CALL WITH
	;	PUSHJ	P,CLOICL
	;	RETURN	HERE
CLOICL::
	PUSH	P,T1
	HRRZ	T1,ICLJFN	;GET JFN
	CLOSF
	  JFCL	0,0
	POP	P,T1
	POPJ	P,

;SUBROUTINE TO PERFORM MAG TAPE OPERATIONS
;CALL WITH:
;	MOVEI	P1,FILE-SPEC-POINTER
;	PUSHJ	P,MTAOP
;	RETURN HERE WITH TAPE POSITIONED
MTAOP:	POPJ	P,		;NULL FOR NOW

;SUBROUTINE TO SET UP T1 AS A MODE  WORD FOR MAG TAPES
;CALL WITH:
;	MOVEI	P1,FILE-SPEC-POINTER
;	PUSHJ	P,MTAOP
;	RETURN HERE WITH T1 SET UP
MTMODE:	SETZM	T1		;START WITH A CLEAN SLATE
	POPJ	P,		;RETURN

	XLIST			;Literals
LIT::	LIT
	LIST
	>			;END TOPS-20 COMMAND PROCESSOR

	END	FORTRAN