Google
 

Trailing-Edge - PDP-10 Archives - fortv11 - 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/SRM/AHM/CDM/PLB/RVM/CKS/MRB/AlB/MEM/JB

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;AUTHOR: Dave Eklund


	INTERN COMMAV
	COMMAV= BYTE (3)0(9)10(6)0(18)4553	; Version Date:	15-Oct-86

	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-81	------
	Add /STATISTICS flag for in-house performance measurement.  It is
	disabled in the released V6.

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

1160	EGM	14-Jun-82
	Properly discard .REL file when fatal errors occur during current
	compile command (correct edit 752). Also prevent 20 code from
	producing a .REL file when doing systax only checking (same as
	10 code).

***** Begin Version 7 *****

108	1205	DCE	20-Mar-81	-----
	Turn on the F66 and F77 switches.  Make F77 the default.

112	1261	CKS	25-Sep-81
	Add CNM to warning messages

114	1270	CDM	6-Oct-81
	Add DGI to warning messages.

115	1430	CKS	3-Dec-81
	Add SBR to warning messages

116	1437	CDM	16-Dec-81
	Add DEBUG:ARGUMENTS  as a compiler switch for argument block
	checking.

117	1445	SRM	20-Dec-81
	Changed FORTB stack size from 500 to 2100 so that we could
	compile the validation test FM045.FOR which has 57 nested
	parens (note: Approximately 100 words of stack
	are needed for each additional 3 levels of nesting. )

118	1460	SRM	12-Jan-82
	Added CHO to list of warning abbreviations.

119	1465	CKS	1-Feb-82
	Change PSR warning to PSN.  (Pound sign used as REC= warning.)
	The prefix is different so that old /NOWARNs will not suppress
	the new message.  	

120	1466	CDM	4-Feb-82
	Add IAT, WNA to /NOWARN table for statement function arg checking.

121	1467	CDM	4-Feb-82
	Add SNO to /NOWARN table for SAVE statement.

1504	AHM	26-Feb-82
	Implement /EXTEND and /NOEXTEND for extended addressing.  Also
	remove the leading "*" from the switch definitions of /F77 and
	/STATISTICS because they shouldn't be there.

1535	CDM	29-July-82
	Add ACB, AIL to /NOWARN switches.

1563	PLB	18-Jun-82
	Implement TTYSTR routine to do a PSOUT from BLISS & EXITUUO to
	simulate CALLI 12.  Temporary since the native command scanner
	will be a separate file.

1600	PLB	9-Jul-82
	TOPS-20 Native  hacks.   Will  never  be  used,  but  supplies
	routine CORUUO,  and PSI  support,  remove Address  Break  APR
	trap.

1606	RVM	3-Aug-82
	Reserve the SW.ABO flag so that COMMAN, IOFLG, and CMND20 all
	agree about which bits are taken.

1613	CDM	13-Aug-82
	Change /DEBUG:PARAMETERS to /DEBUG:ARGUMENTS.

1617	CKS	24-Aug-82
	Add 'FORTRA' to .ISCAN call so that
		.FORTRAN FILE=FILE
	works, given the appropriate command definition.

1621	RVM	25-Aug-82
	Add the /DFLOATING switch to the TOPS-10 command scanner.  Reorder
	switch table so that it is in alphabetical order.  Give an error
	message if the user specifies /GFLOAT.

1652	CDM	20-Oct-82
	Add RIM to /NOWARN switch.

1654	SRM	22-Oct-82
	Changed FORTB stack size from 2100 to 2200 so that we could
	compile the validation test FM045.FOR which has 57 nested
	parens (note: Approximately 100 words of stack
	are needed for each additional 3 levels of nesting. )

1656	CKS	25-Oct-82
	Change PLP warning to TSI.

1750	MRB	6-May-83
	Add FOO warning to /NOWARNING.


***** Begin Version 10 *********

2246	AlB	20-Dec-83
	Reserve bits in flag word F2 for Compatibility Flagging.
	SW.CFS => CFLGANSI, SW.CFV => CFLGVAX

2265	TFV	12-Jan-84
	Increase POOLSIZE to 6000 words so we can compile programs  with
	large blocks of  comment lines.  The  standard allows  unlimited
	numbers of comment lines between initial and continuation lines.

2305	AlB	8-Feb-84
	Added a slough of entries to the /NOWARN tables.  All entries are
	for the Compatibility Flagger warnings.

	It is recognized that this module does not handle the /FLAG switch
	yet, but it will someday.  Meanwhile, The /NOWARN table is
	compatible with CMND20.

2322	CDM	27-Apr-84
	Fix array subscript calculations for /EXTEND to use a full  word
	to calculate  arithmetic.  In  PROCEQUIV  and BLDDIM,  check  an
	array reference against  the correct  maximum size  of an  array
	declaration  /EXTEND.   In   BLDDIM,  call   CNSTCM  for   array
	calculations to  give  underflow/overflow messages  for  illegal
	declarations.  Otherwise arrays  that are too  large may not  be
	detected since their size will overflow.

2353	AlB	30-Apr-84
	Add the /FLAG and /NOFLAG switches to the Tops-10 command scanner.
	/FLAG has the keywords ALL, ANSI, VAX, NONE, NOANSI, NOVAX.
	/NOFLAG has no keywords.

	Re-arranged the location of NOWCLR in order to improve the
	readability of the source.

2367	RVM	14-Jun-84
	Add the label "GFLPAT" in case we want to find the instruction to
	No-op in order  to turn on TOPS-10 gfloating support.

2422	RVM	12-Jul=84
	Set BIGCONCAT in the -10 command scanner.  See edit 2251.

2430	CDM	18-Jul-84
	Have the compiler complain /FLAG  for a variable mentioned  more
	than once  in  SAVE statements  (SAVE  A,B,A -  A  is  mentioned
	twice).

2442	RVM	4-Aug-84
	Get a bit for /EXTEND:CODE

2454	RVM	28-Aug-84
	Move the definition of DEFLON (the default value for LONAME)
	and DEFHIN (the default value for HINAME) from CMND20 into
	GLOBAL.  Then make OUTMOD use DEFLON and DEFHIN where needed
	in the twoseg redirection rel block.  For kicks, make the -10
	command scanner set up LONAME and HINAME.

2455	MEM	30-Aug-84
	Replace all occurrences of VAX with VMS.

2471	RVM	25-Oct-84
	Remove the instruction at GFLPAT.  FORTRAN-10 will now support
	gfloating!

2473	CDM	29-Oct-84
	Add IMPLICIT NONE for the Military Standard MIL-STD-1753.

2524	JB	13-Mar-85
	Add INC to the list of NOWARNs.

***** End V10 Development *****

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

***** Begin Version 11 *****

4543	JB	10-Jul-86
	Add LDI to list of NOWARNs.

4544	MEM	7-Aug-86
	Add ADV to list of NOWARNs.

4553	JB	15-OCT-86
	Remove edit 4543.

ENDV11
\

	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,<	SEARCH MACSYM	>	;[1600] SEARCH LAST

	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

;LOCATIONS IN GLOBAL USED BY INOUT BUT SET UP HERE

;[1504] Definitions moved here  from the lowseg  definition region  to
;[1504] avoid using the  pass 1  definitions of  these symbols.   This
;[1504] prevents us from  getting near  a MACRO  deficiency, which  is
;[1504] that MACRO has no concept of polish expressions during pass 1,
;[1504] and that is what these macros generate.

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>) >

;FLAG BITS IN F (SEE IOFLG.BLI & CMND20.MAC 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
EXTERN	VMSIZE		;[2322] Virtual memory size for this compilation.
EXTERN	BIGCONCAT	;[2422] The   size   of   the    biggest
			;[2422] concatenation to allow as a "fixed length"
			;[2422] or "known maximum length".  Maximum size of
			;[2422] non dynamic concatenation.
EXTERN	LONAME		;[2454] Name of the low (data) PSECT in SIXBIT
EXTERN	HINAME		;[2454] Name of the high (code) PSECT in SIXBIT
EXTERN	DEFLON		;[2454] Default for LONAME
EXTERN	DEFHIN		;[2454] Default for HINAME

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

TTYINP==1B0		;INPUT DEVICE IS A TTY
GFMCOK==1B1		;GFLOATING MICROCODE PRESENT
FTLCOM==1B2		;[1160] Fatal errors during this compile command
SW.ABO==1B3		;[1606] Abort (exit) on fatal errors

;FLAG BITS IN F2 (SEE IOFLG.BLI & CMND20.MAC 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
SW.EXT==1B3		;[1504] /EXTEND
SW.CFS==1B4		;[2246] /FLAG:ANSI
SW.CFV==1B5		;[2455] /FLAG:VMS
SW.EXC==1B6		;[2442] /EXTEND:CODE

DBIGCON=[EXP	^D50000]	;[2422] Default for BIGCONCAT

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

; DM(NAM,MX,AD,PD) expands  into  definitions of  MX.NAM,  AD.NAM  and
; PD.NAM with the  values of  the 2nd, 3rd  and 4th  arguments to  the
; macro.  These symbols get  used as the  MaXimum, Absent Default  and
; Present Default later on.

DM	ADV,1,0,1
DM	BAK,1,0,1
DM	BOU,1,0,1
DM	BUG,377777,0,1
DM	CFS,1,0,1		;[2353] /FLAG:ANSI
DM	CFV,1,0,1		;[2455] /FLAG:VMS
DM	CRF,1,0,1
DM	DEB,1,0,1
DM	EXP,1,0,1
DM	EXT,1,0,1		;[1504] /EXTEND
DM	GFL,1,0,1
DM	F77,1,1,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,^D2200+^D6000	;[2265] Length of PDL
			;Note the addition of 600 words to PDLLEN!!!  See  the
			;declaration of 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

;[1133] AD.STA for /STATISTICS
;[1504] AD.EXT for /EXTEND
;[2353] AD.CFS for /FLAG:ANSI
;[2455] AD.CFV for /FLAG:VMS

; Don't even think about moving the above comments onto the lines that
; they describe.  You can't comment a line that is continued with  ^_.

INDAD2:	EXP	<<AD.F77>_<43-^L<SW.F77>>> ! 
		<<AD.GFL>_<43-^L<SW.GFL>>> ! 
		<<AD.STA>_<43-^L<SW.STA>>> ! 
		<<AD.EXT>_<43-^L<SW.EXT>>> ! 
		<<AD.CFS>_<43-^L<SW.CFS>>> ! 
		<<AD.CFV>_<43-^L<SW.CFV>>>

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

;[2353] The Tops-20 /FLAG-NON-STANDARD switch is implemented here as just
;[2353] /FLAG, because the Tops-10 scanner does not allow hyphens.  It is
;[2353] expected that COMMAN.MAC will never again be assembled for Tops-20,
;[2353] but if it ever is then the Tops-20 switch will become /FLAG instead
;[2353] of /FLAG-NON-STANDARD.

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
SS	DFLOATING,<POINTR(SAVE2,SW.GFL)>,0	;[1621]
SP	EXPAND,<POINTR(SAVEF,SW.EXP)>,.SWDEC##,EXP
IFN FTTENX,<
SN	*EXTEND,<POINTR(SAVE2,SW.EXT)>		;[1504] /[NO]EXTEND
>
SS	*GFLOATING,<POINTR(SAVE2,SW.GFL)>,1	;[1621]
SS	F66,<POINTR(SAVE2,SW.F77)>,0		;[1505] SAME AS /NOF77
SN	F77,<POINTR(SAVE2,SW.F77)>		;[1205] ALLOW /NOF77
SL	FLAG,<777700,,FLAG>,FLG,-1		;[2353]
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	*LNMAP,<POINTR(SAVEF,SW.MAP)>,.SWDEC##,MAP
SP	*MACROCODE,<POINTR(SAVEF,SW.MAC)>,.SWDEC##,MAC
SP	NOERRORS,<POINTR(SAVEF,SW.NET)>,.SWDEC##,NOE
SS	NOFLAG,<POINTR(SAVE2,<SW.CFS!SW.CFV>)>,0 ;[2353]
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.

;[2305] Added keywords AIS through VNF.

	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,CNM,DGI,SBR,CHO,
WNA,IAT,SNO,TSI,ACB,AIL,RIM,FOO,
AIS,CAP,CCC,CNS,COS,COV,CSM,DEB,DFN,DOW,DPE,DWE,DWL,
EDD,EDS,EDX,EOC,EXD,FAR,FIF,FIN,FMT,FNG,HCP,HCU,INS,
KWU,KWV,LNE,LOL,LSP,MLN,MSL,NAM,NDP,NEC,NIB,NIG,NIK,
NIS,NIX,NLK,NPC,NPP,NSC,OCU,OIO,PWS,RLC,SBC,SEP,SMD,
ANS,SNN,SPN,SRO,SVN,TLF,VFS,VGF,VIF,VNG,WDU,XEN,XOR,
RLX,LNC,NLC,CIS,SOR,FNS,VSD,VNS,VNF,ADS,IMN,MBD,INC,
ADV>	;[4553]
	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,ARGUMENTS>	;[1613]

;[2353] The FLAG subroutine expects these keywords to be in this order
KEYS	FLG,<ALL,NONE,ANSI,NOANSI,VMS,NOVMS>			;[2455]
	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
;
; TOPS-10	TOPS-20
; AP.POV	.ICPOV		PUSHDOWN OVERFLOW
; AP.NXM	.ICNXP		NON-EXISTENT MEMORY
; AP.ILM	.ICIRD 		MEMORY PROTECTION VIOLATION
;		.ICIWR		(READ & WRITE)
;
APRINI:
IFE FTTENX,<
	MOVEI	T1,APRTRP	;LOCATE TRAP ROUTINE
	MOVEM	T1,.JBAPR##	;TELL THE MONITOR WHERE TRAP OCCURS
	MOVEI	T1,AP.POV!AP.ILM!AP.NXM	;SET CONDITIONS
	APRENB	T1,		;ENABLE TRAPS
	POPJ	P,
> ;TOPS-10

IFN FTTENX,<			;[1600] NEW
	MOVEI	T1,.FHSLF	;[1600] OWN FORK
	CIS			;[1600] CLEAR INTERUPT SYSTEM
	MOVE	T2,[LEVTAB,,CHNTAB] ;[1600] ADDR OF LEVEL TAB & CHAN TAB
	SIR			;[1600] SET INTERUPT ADDRESSES
	EIR			;[1600] ENABLE INTERUPT SYSTEM

	SETO	T2,		;[1600] DISABLE ANY CHANS *** TEMP ***
	DIC			;[1600] PA1050 MIGHT HAVE STARTED *** TEMP ***

	MOVE	T2,.JBREL	;[1600] END OF CORE (REFERENCES PG 0)
	MOVE	T3,[1777,,1777]	;[1600] END OF PAGE 1
	BLT	T3,(T2)		;[1600] REFERENCE PAGES TO THE END

	MOVE	T2,[CHNMSK]	;[1600] ARM PROPER CHANNELS
	AIC			;[1600] ENABLE INTERUPT CHANNELS
	POPJ	P,		;[1600]

; [1600] Blocks for TOPS-20 interupt system
; [1600]  Note: all interupts happen at level 1

LEVTAB:	LEV1PC			;[1600] ADDR OF LEVEL 1 PC
	LEV2PC			;[1600] ADDR OF LEVEL 2 PC
	LEV3PC			;[1600] ADDR OF LEVEL 3 PC

	RELOC			;[1600] TO THE LOWSEG

LEV1PC:	BLOCK	1		;[1600] LEVEL 1 PC
LEV2PC:	BLOCK	1		;[1600] LEVEL 2 PC
LEV3PC:	BLOCK	1		;[1600] LEVEL 3 PC

	RELOC			;[1600] BACK TO PURE STORAGE

CHNMSK==1B<.ICPOV>!1B<.ICIRD>!1B<.ICIWR>!1B<.ICNXP> ;[1600] CHANNEL MASK

CHNTAB:	PHASE	0		;[1600] *** BEWARE! ***

;[1600] The value of  "." is  now the  current offset  into the  table
;[1600] instead of .-CHNTAB so you  are allways <n>-. words away  from
;[1600] entry <n> instead of <n>-<.-CHNTAB>

	BLOCK	.ICPOV-.	;[1600]  (0-8)
	1,,POVTRP		;[1600]  (9) PDL OVERFLOW

	BLOCK	.ICIRD-.	;[1600]  (10-15)
	1,,IRDTRP		;[1600]  (11) ILL MEM READ
	1,,IWRTRP		;[1600]  (12) ILL MEM WRITE

	BLOCK	.ICNXP-.	;[1600]  (13-21)
	1,,NXPTRP		;[1600]  (22) NON-EXISTANT PAGE

	BLOCK	^D35-.		;[1600]  (23-35)
	DEPHASE			;[1600]  *** END OF PHASE 0 ***

> ; [1600] TOPS-20

	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

	SETZB	T2,T3		;[1621] Make sure registers have safe value
	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,,[IOWD 1,['FORTRA'] ;[1617] Commands to RESCAN for
			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

IFN FTTENX,<			;[1600] TOPS-20
	MOVEI	T1, .FHSLF	;[1600] OUR PROCESS
	SETZ	T2,		;[1600] ALLOW UUOS
	SCVEC			;[1600] SET COMP VECTOR
> ;TOPS-20

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

IFE FTTENX,<			;[1600] LET PA1050 DO IT FOR NOW
	PUSHJ	P,APRINI	;[1600] INITIALIZE APR TRAPPING
> ;TOPS-10

	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

	; Switches local to this compilation have now been set up.
	; Set up global variables the compiler needs.

	HRLZI	T1,1		;[2322] Load 2**18
	MOVEM	T1,VMSIZE	;[2322] Store size of virtual memory

	;[2422] The loading of BIGCONCAT is done this way so that it can
	;[2422] be made an /EXTEND: switch at a later date if desired.

	MOVE	T1,DBIGCON	;[2422] Get default for BIGCONCAT
	MOVEM	T1,BIGCONCAT	;[2422] Store default

	;[2454] Copy DEFLON to LONAME
	MOVE	T1,DEFLON	;[2454] Get size of default name for data psect
	MOVE	T2,[XWD DEFLON,LONAME] ;[2454] Source,,Destination
	BLT	T2,LONAME(T1)	;[2454] Copy DEFLON to LONAME

	;[2454] Copy DEFHIN to HINAME
	MOVE	T1,DEFHIN	;[2454] Get size of default name for code psect
	MOVE	T2,[XWD DEFHIN,HINAME] ;[2454] Source,,Destination
	BLT	T2,HINAME(T1)	;[2454] Copy DEFHIN to HINAME

	; Check if /GFLOAT

	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

	MOVX	T1,FTLCOM	;[1160] No fatal compile errors yet
	ANDCAM	T1,FLAGS2	;[1160] for this command

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

	TXNN	F,SW.OCS	;[1160] 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:
	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:
IFN FTTENX,<			;[1600] *TEMP* SUICIDE CLOSES ALL CHANS
;;	MOVE	T1,[1,,[11]]	;[1600] PAT SUICIDE FUNCTION
;;	COMPT.	T1,		;[1600] CALL PA1050
;;	 HALT			;[1600] SIGH
	PUSHJ	P,APRINI	;[1600] START TOPS-20 PSI SYSTEM
	MOVEI	T1,.FHSLF	;[1600] HACK OUR PROCESS
	SETO	T2,		;[1600] MAKE UUO'S FATAL
	SCVEC			;[1600] KILL PAT ENTRY VECTOR
> ;TOPS-20
	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,<
	MOVEI	T1,.FHSLF	;[1600] HACK OUR PROCESS
	SETZ	T2,		;[1600] MAKE UUO'S LEGAL AGAIN
	SCVEC			;[1600]
	PUSHJ	P,CLOSUP## >	;CLOSE EVERYTHING
IFE FTTENX,<
	CLOSE	LST,		;CLOSE LISTING FILE
	CLOSE	SRC,		;CLOSE SOURCE FILE
	MOVE	T1,FLAGS2	;[1160] Any fatal compile errors seen
	TXNE	T1,FTLCOM	;[1160] during this command?
	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

IFN FTTENX,<
; NEW [1600] /PLB
; Simulate CORE UUO for Twenex
CORUUO::
	PUSH	P, T1
	PUSH	P, T2
	MOVEI	T1, .HIGH.##	;GET HI-SEGMENT ORIGIN
	CAMG	T1, -3(P)	;LARGER THEN REQUESTED CORE BREAK?
	 PUSHJ	P, CORERR	;'FRAID SO

	MOVEI	T1, .FHSLF	;THIS PROCESS
	MOVEI	T2, 1B<.ICNXP>	;NON-EXISTANT PAGE
	DIC			;DEACTIVATE

	MOVE	T2, -3(P)	;GET DESIRED LOW SEGMENT BREAK
	ORI	T2, 777		;END-OF-PAGE-IFY
	MOVE	T1, .JBREL##	;GET CURRENT END OF CORE

	CAMG	T2, T1		;CUTTING BACK????
	 JRST	CORE.1		;YES

	AOJ	T1,		;BUMP UP FROM END OF LAST PAGE
	SETZM	(T1)		;ZERO FIRST WORD
	HRL	T1, T1		;PREPARE FOR BLT
	BLT	T1, (T2)	;SMEAR THE ZEROS

CORE.1:	MOVEM	T2, .JBREL	;STORE AS NEW END

	MOVEI	T1, .FHSLF	;OUR FORK
	MOVEI	T2, 1B<.ICNXP>	;NXP INTERUPT CONDITION
	AIC			;ACTIVATE CHANNEL

	POP	P, T2
	POP	P, T1
	POPJ	P,
> ;TOPS-20 CORUUO

	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 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
;Subroutine to set up for SWITCH.INI processing

NOWSAV:	MOVE	T1,[NWBITS,,NWSAVB]	;[1115] MOVE /NOWARN DATA AND
	BLT	T1,<NWSAVM+NWWDCT-1>	;[1115] MASKS TO SAVE AREA
	MOVX	T1,SW.CFS!SW.CFV	;[2353] Move /FLAG bits
	AND	T1,SAVE2		;[2353]  to a
	MOVEM	T1,SAVBIT		;[2353]   safe place
	MOVX	T1,SW.CFS!SW.CFV	;[2353] Move /FLAG mask
	AND	T1,SAVE2M		;[2353]  to a
	MOVEM	T1,SAVMSK		;[2353]   safe place

;Subroutine to clear /NOWARN and /FLAG bits

NOWCLR:	SETZM	NWBITS			;[1115] CLEAR THE KEYWORD DATA
	MOVE	T1,[NWBITS,,NWBITS+1]	;[1115] AND THE MASKS
	BLT	T1,<NWMASK+NWWDCT-1>	;[1115]
	MOVX	T1,SW.CFS!SW.CFV	;[2353] Clear the
	ANDCAM	T1,SAVE2		;[2353]  bits
	ANDCAM	T1,SAVE2M		;[2353]   and the mask
	POPJ	P,			;[1115] DONE

;Subroutine to merge command line and SWITCH.INI for /NOWARN and /FLAG

NOWMRG:	MOVE	T1,SAVMSK	;[2353] Mask bits for /FLAG from command line
	ANDCAM	T1,SAVE2	;[2353]  cannot be overridden by SWITCH.INI
	IORM	T1,SAVE2M	;[2353] Merge with SWITCH.INI mask
	MOVE	T1,SAVBIT	;[2353] Switch setting for /FLAG from command
	IORM	T1,SAVE2	;[2353]  are merged with SWITCH.INI settings
	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
;Subroutine to process the FLAG switch keywords.	[2353] New by AlB
;This routine depends upon the keywords being in the following order:
;	ALL, NONE, ANSI, NOANSI, VMS, NOVMS [2455]

FLAG:	SKIPE	N		;If /FLAG: or /FLAG:0
	CAIN	N,-1		;  or /FLAG (with no keyword)
	MOVEI	N,1		;  assume ALL

	MOVX	T1,SW.CFS!SW.CFV ;Assume ALL/NONE
	CAILE	N,2		;Is it ALL/NONE?
	MOVX	T1,SW.CFS	;No--Assume ANSI/NOANSI
	CAILE	N,4		;Is it VMS/NOVMS? [2455]
	MOVX	T1,SW.CFV	;It is VMS/NOVMS  [2455]

	TRNN	N,1		;Is it NOxxx?
	JRST	CF.OFF		;Yes--Turn off bits

	IORM	T1,SAVE2	;Turn on bits
	ANDCAM	T1,SAVE2M	;Turn off bits in mask
	AOS	(P)		;Skip return
	POPJ	P,		;Back to scan

CF.OFF:	ANDCAM	T1,SAVE2	;Turn off bits
	IORM	T1,SAVE2M	;Turn on bits in mask
	AOS	(P)		;Skip return
	POPJ	P,		;Back to scan
	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

GFLSUP:	OUTSTR	[ASCIZ \?FTNGFS /GFLOATING is not yet supported
\]				;[1621]
	CLRBFI			;[1621]
	JRST	FORTR2		;[1621] TRY ANOTHER COMMAND LINE

GFLBAD:	OUTSTR	[ASCIZ \?FTNGFM /GFLOATING 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
	DMOVEM	T1,APRSV1	;STORE T1, 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\
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

IFN FTTENX,<
NXPTRP:	DMOVEM	T1, APRSV1	;[1600] SAVE REGS
	MOVEM	T3, APRSV3	;[1600] T1, T2 & T3
	MOVEI	T1, .FHSLF	;[1600] US
	GTRPW			;[1600] GET TRAP WORD
	JUMPE	T1, NXP.1	;[1600] NO ERROR ?
	MOVE	T2, .JBREL##	;[1600] HIGHEST ALLOWED LOCN
	CAIGE	T2, (T1)	;[1600] ABOVE TOP ?
	 JRST	NXP.1		;[1600] YES, INTERNAL ERROR TIME
	DMOVE	T1, APRSV1	;[1600] GET REGS BACK
	DEBRK			;[1600] RETURN FROM TRAP
				;[1600] FALL THRU ON ERROR
NXP.1:	HRROI	T2, APRNXM	;[1600] GENERIC NON-EXISTANT MEMORY
	TLNE	T1, (PF%WRT)	;[1600] PAGE FAIL ON WRITE?
	 HRROI	T2, [ASCIZ \Non-existant memory write\]
	TRNA
IRDTRP:	 HRROI	T2, [ASCIZ \Illegal memory read\]
	TRNA
IWRTRP:	 HRROI	T2, [ASCIZ \Illegal memory write\]
	TRNA
POVTRP:	 HRROI	T2,APRPOV		;PDL OVERFLOW

	HRROI	T1,APRTX0
	PSOUT
APRTR4:	MOVE	T1,T2
	PSOUT
	HRROI	T1,APRTX1
	PSOUT			;CONTINUE..

	MOVEI	T1,.PRIOU	;TO TERMINAL
	HRRZ	T2,LEV1PC	;TRAP PC
	MOVE	T3,[NO%OOV!NO%LFL!NO%ZRO!FLD(6,NO%COL)!10] ;LPAD W/ ZERO , SIX OITS
	NOUT
	 JFCL			;OVERFLOW?

	SKIPN	GETSBL##+1	;IN A PHASE?
	 JRST	APRTR2

	HRROI	T1,APRTX2
	PSOUT
> ;TOPS-20

IFE FTTENX,<			;[1600] TOPS-10
APRTRP:	JRSTF	@.+1		;CLEAR FIRST PART DONE
	0,,.+1			;CLEAR APR FLAGS
	OUTSTR	APRTX0		;PREFACE MESSAGE
	DMOVEM	T1,APRSV1	;SAVE REGISTERS

	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.ILM	;MEMORY PROTECTION
	 MOVEI	T2,APRILM	;LOCATE MESSAGE

APRTR4:	OUTSTR	(T2)		;TYPE MESSAGE
	OUTSTR	APRTX1		;CONTINUE
	MOVE	T2,APRPN1	;LOAD POINTER

APRTR1:	ILDB	T1,T2		;TYPE ADDRESS
	MOVEI	T1,"0"(T1)	;TYPE ADDRESS
	OUTCHR	T1		;TYPE DIGIT
	TLNE	T2,770000	;TYPE 6 DIGITS
	 JRST	APRTR1		;TYPE 6 DIGITS

	SKIPN	.JBHRL##	;HIGH SEGMENT?
	 JRST	APRTR2		;NO
	OUTSTR	APRTX2		;CONTINUE
> ;TOPS-10

	MOVE	T2,APRPN2	;TYPE SEGMENT NAME
APRTR3:	ILDB	T1,T2		;LOAD BYTE
	MOVEI	T1," "(T1)	;TO ASCII
IFE FTTENX,< OUTCHR T1 >	;[1600] TYPE BYTE
IFN FTTENX,< PBOUT >		;[1600] TYPE BYTE
	TLNE	T2,770000	;TYPE 6 CHARACTERS
	 JRST	APRTR3

APRTR2:
IFN FTTENX,<			;[1600] TOPS-20
	HRROI	T1,APRTX3	;[1600] WHILE PROCESSING STATEMENT
	PSOUT

	MOVEI	T1,.PRIOU
	MOVE	T2,ISN##
	MOVE	T3,[NO%OOV!NO%LFL!NO%ZRO!FLD(5,NO%COL)!^D10] ;LPAD W/ ZERO , 5 DIGITS
	NOUT
	 JFCL
	HALTF
	JRST	.-1
> ;TOPS-20

IFE FTTENX,<
	OUTSTR	APRTX3		;[1600] WHILE PROCESSING...
	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
	OUTSTR	T1		;FINISH MESSAGE
	MOVE	T1,APRSV1	;RESTORE AC
	MOVE	T2,APRSV2	;RESTORE AC
	MOVE	T3,APRSV3	;RESTORE AC
	EXIT			;DONE
> ;TOPS-10

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

;[2353] Save the /FLAG settings from command line
SAVBIT:	BLOCK	1	;The switch settings
SAVMSK:	BLOCK	1	;The masks

;[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

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 PSOUT A STRING FROM BLISS
; [1563] /PLB
TTYSTR::
	PUSH	P,T1		;SAVE AC 1
	HRRO	T1,-2(P)	;GET -1,,ADDR
	PSOUT			;OUTPUT
	POP	P,T1		;RESTORE
	POPJ	P,

;SUBROUTINE TO SIMULATE AN EXIT UUO
; [1563] /PLB
EXITUUO::
	PUSH	P,T1		;SAVE AC 1
	HRROI	T1, [ASCIZ /
Exit/]				;BE LIKE TOP-10 (ALMOST)
	PSOUT			;STUFF IT
	POP	P,T1		;RESTORE

	HALTF
	JRST	.-1

;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