Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ftncsr/cmnd20.mac
There are 12 other files named cmnd20.mac in the archive. Click here to see a list.
	TITLE CMND20 - The FORTRAN-20 Command Scanner
	SUBTTL	Randall Meyers/PLB/CDM/SRM/CKS/MRB/TGS/AlB/AHM/MEM/JB

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1982, 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: Randall Meyers


	INTERN COMMAV
	COMMAV= BYTE (3)0(9)11(6)0(18)4561	; Version Date:	13-Jan-87

	SUBTTL	Revision History

Comment \

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

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

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 and,
	EXITUUO routine to simulate CALLI 12

1600	PLB	9-Jul-82
	TOPS-20 Native hacks.  Supplies routine CORUUO, and PSI support

1602	RVM	14-Jul-82
	Implement the TOPS-20 Native Scanner.

1603	RVM	16-Jul-82
	Make .DEBUG preserve T2 so that a switch may follow /DEBUG.  Remove
	square brackets around the CCL "FORTRAN: etc." message.  Disable
	CONTROL/H recovery under batch, so that an error in a command
	will not effect the next command line (otherwise, the next command
	tries to hang, waiting for a CONTROL/H).

1611	RVM	6-Aug-82
	Many command scanner changes to fix bugs, incorporate suggestions,
	and to add features.  Major changes:  Exit compiler after processing
	PRARG block.  Rewrite /RUN code.  Add /HELP.  Rename /OBJECT and
	/NOOBJECT to be /BINARY and /NOBINARY.  Improve error message maker.
	Add /DFLOATING.

1612	PLB	13-August-82
	Trap code cleanup for edit 1600

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

1623	RVM	26-Aug-82
	TOPS-20 command scanner: Do a CLZFF% before each command read
	from the primary input stream in order close all files and
	release all JFNs.  This fixes the problem of unreleased JFNs
	when a command or compile is aborted due to a catastrophic
	error.  A consequence of this edit is that the compiler cannot
	keep a JFN on SWITCH.INI across compiles.

1631	RVM	1-Sep-82	Q20-03013
	If the PRARG block overflows, the EXEC writes out TMP files to
	disk.  The TOPS-20 command scanner didn't look on disk for its
	arguments if it found a null PRARG block.

1632	RVM	1-Sep-82
	The TOPS-20 compiler does not reclaim its data area after a
	compile.  The locations .JBFF and .JBREL were only being set
	once when the compiler started, rather than after each compile.

1636	RVM	28-Sep-82
	Make /EXTEND and /NOEXTEND invisible, as they are not supported
	aspects of the FORTRAN product.

1643	RVM	11-Oct-82
	If the EXEC's arguments to the compiler do not exist in a PRARG
	block or on disk, then do not complain, just accept commands from
	the terminal.  Also, add the ;T(emporary) attribute to the filespec
	for the disk file which holds the EXEC arguments.

1645	RVM	15-Oct-82
	Add the /NOECHO switch to the TOPS-20 command scanner, and change
	a nested /TAKE which does not specify /ECHO or /NOECHO to use the
	current value of the echo flag.

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

1654	SRM	21-Oct-82
	Increased PDLLEN from 2100 to 2200 to allow FM045.FOR in the
	validation tests to work.

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

1657	RVM	27-Oct-82
	Improve the "Error occured while processing ..." message from
	the TOPS-20 command scanner.


1671	RVM	11-Nov-82
	The TOPS-20 command scanner had problems when the compiler was
	reSTARTed because the COMND% JSYS state block was not being
	reset.

1672	RVM	11-Nov-82
	The TOPS-20 command scanner complained overmuch if the user's
	SWITCH.INI file was offline.  The scanner no longer complains
	if the switch file is offline.  I/O errors while reading the
	switch file now produce warning instead of error messages,
	and the warnings are now followed by a message stating that
	the problem occurred while reading the switch file.

1673	RVM	11-Nov-82
	Make the error message about nesting /TAKE commands too deep
	a warning message and recover from the error by just ignoring
	the errant command and continuing to process the nested /TAKEs
	already in process.  This has the nice property that the user
	can recover by issuing the ignored /TAKE command when prompted
	again by the compiler.

1701	RVM	13-Dec-82	Q20-06057
	Remove the abbreviation for the /NOOBJECT switch since
	that swich will disappear as soon as the EXEC no longer
	needs it.

1705	PLB	21-Dec-82
	Fix BLT word in CORUUO to zero more than one word.

1711	RVM	7-Jan-83
	Make /O mean /OPTIMIZE, just as advertised.  Also, have
	the compiler to exit if the primary input designator is
	invalid (this lets the compiler run as a background fork).

***** End V7 Development *****

1750	MRB	6-May-83
	Add FOO to /NOWARN table.

2014	TGS	25-OCT-83	SPR:20-19657
	Correct batch parsing so legal TOPS20-style command strings
	won't be rejected as illegal TOPS10 commands.

2015	TGS	25-OCT-83	SPR:NONE
	If a switch is given after the comma separating the list file
	from the object file in a TOPS-10 compatibility command, the
	error message "?FTNCMD Comma not given" is returned.  (This is
	part of edit 2220 in V10).

2032	TGS	10-JAN-84	SPR:NONE
	Remove the default "+" which was available after parsing a
	source filespec.  If the .CMTOK function of the COMND% JSYS
	is changed, the default for a .CMTOK field will be parsed
	before the confirm.  This will mean that the command scanner
	sees all command lines ending with a "+", which is illegal.
	(Accomplished in V10 by edit 2263)

2044	TGS	6-MAR-84	SPR:20-20007
	Fix undeserved "Command too long for internal buffer" error
	when there are lots of command strings under batch.  Correct
	.CMCNT word of the COMND% state block to accurately reflect
	the number of free characters. (Accomplished in V10 by 2262)

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

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

2220	RVM	29-Sep-83
	Make the command scanner accept the revised TOPS-20 command
	syntax and implement the extend switch.  Also, a problem was
	fixed that prevented switches from appearing between the comma
	and listing filespec in a TOPS-10 command under compatibility
	scanning.  (This last problem was fixed in V7a as edit 2015.)

2221	RVM	29-Sep-83
	Add new feature test FT612 to control debugging with SIX12.
	Change how feature tests so that they recieve their default
	values if their symbols are not defined.

2242	RVM	12-Dec-83
	The /NOEXTEND switch was not using the proper offset into ONFLG
	and OFFFLG for the SW.EXT flag.  Thus, /NOEXTEND did not cancel
	/EXTEND.  Also, make /BUGOUT imply /LIST, since this allows code
	to be removed from LEXICA (which is almost to big to compile!).

2246	AlB	20-Dec-83
	Add the /FLAG and /NOFLAG switches for Compatibility Flagging.
	See new routines .FLAG and .NOFLAG

2251	CDM	22-Dec-83
	Add new global  variable BIGCONCAT to  declare the size  (50,000
	for now) of the largest concatenation allowed as fixed  (CONCTF)
	or known maximum  (CONCTM) in length.   If the concatenation  is
	larger  than  this,  then  the  concatenation  will  be  dynamic
	(CONCTV) so that it will use the character stack.
	
2262	RVM	5-Jan-83
	Fix bug that caused the "Command too long for internal buffer"
	message to be given when a great many command strings were
	given the compiler under batch.  The bug had two causes.
	First, edit 1603 disabled CONTROL/H error recovery under batch
	by reseting some of the words in the COMND% state block.  It
	turns out the the .CMINI function would not reset the .CMCNT
	word if the state block had been so munged.  Second, when
	command strings where put into the COMND% buffer "by hand,"
	the command scanner would subtract the length of the command
	from .CMCNT (the count of free characters in the command
	buffer).  This is incorrect since .CMCNT is the space left
	after the text which has been parsed in the buffer.  No text
	in the buffer had been parsed yet.

2263	RVM	9-Jan-83
	Remove the default "+" which was available after parsing a
	source filespec.  A Change to the .CMTOK function of the
	COMND% JSYS now causes the default for a .CMTOK field to be
	parsed before a confirm.  This ment that the command scanner
	saw all command lines ending with a "+", which is illegal.
	(This was fixed in V7a by edit 2032.)

2264	PLB	11-JAN-83
	Force OWGBPSECTION to 1 when /EXTEND typed.  Zero at REPARSE.
	This means the compiler will always output OWGs under /EXTEND.

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.

2310	CDM	13-Feb-84
	Output type 1131  rel block  for PSECT  redirection of  segments
	into psects.  The command scanner sets the names for the  psects
	and the code generator dumps the rel block.

2320	RVM	9-Mar-84
	First, change the name of the /FLAG switch to
	/FLAG-NON-STANDARD and 	/NOFLAG to /NOFLAG-NON-STANDARD.
	Second, allow the command standard required abbreviations of
	/F for /FLAG... and /NOF for /NOFLAG....  Third, add a default
	value of "ALL" for /FLAG....

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.
	Change /FLAG:STANDARD  to  /FLAG:ANSI and  /FLAG:NOSTANDARD  to
	/FLAG:NOANSI at AlB's request.

2330	AHM	28-Mar-84
	Remove all references to the global OWGBPSECTION, since it is
	no longer used by the code generator.

2331	RVM	28-Mar-84
	Fix a bug in the way that colons at the end of the /EXTEND keywords
	were handled.  Under the old code, a ? immediately after the colon
	in the /EXTEND switch keyword, would produce the wrong help text.
	This occured because the CHKCOLON routine would look for something
	in the follow set of the switch keyword when it had no colon, and
	if that failed, look for a colon.  The solution was simple: look
	for a colon AND the follow set at the same time.

2343	RVM	18-Apr-84
	Implement /EXTEND:COMMON and /EXTEND:NOCOMMON.

2347	RVM	27-Apr-84
	Make /EXTEND mean /EXTEND:COMMON rather than /EXTEND:NOCOMMON.
	Also, fix two bugs.  First, /NOEXTEND was not setting the default
	psect for COMMON blocks back to PSDATA.  Second, /EXTEND:COMMON
	had the side effect of changing the /EXTEND:DATA size to its
	default value!

2350	RVM	28-Apr-84
	Make the code and psect keywords to /EXTEND invisible for now,
	as they are not yet supported.

2415	RVM	7-Jul-84
	First, provide some additional help when the user types "?" at
	the COMND% JSYS.  Second, create an new entry into the error
	message maker that allows us to provide some error text rather
	than use the ERSTR% JSYS.  This improves the reporting of various
	semantic errors.  Third, echo the command line in error if it is
	coming from a indirect command file, regardless of the state of the
	echo flag.  Fourth, correct a long standing bug that caused the
	command scanner not to complain if a TOPS-10 style command didn't
	contain any source files.

2416	RVM	8-Jul-84
	Make the /EXTEND:COMMON:name(s) switch imply that the default
	psect for unnamed COMMON blocks is PSDATA.  Likewise, make the
	/EXTEND:NOCOMMON:name(s) switch imply that the default psect
	for unnamed COMMON blocks is PSLARGE.

2417	RVM	9-Jul-84
	Improve upon the rotten error message given when the first thing
	in the command line was either a bad keyword or a non-existing
	file.  The solution was to scan for the old-style action switches
	at the same time as all the new stuff, to examine the error that
	occured, and to substitute a better error message for the monitor's
	bad one using the new SEMERR routine.

2421	RVM	10-Jul-84
	Impove the error messages for a command that looks like it starts
	out at a keyword command by then goes awry.

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

2441	RVM	4-Aug-84
	Change the way the TOPS-20 command scanner resolves command
	line switches and SWITCH.INI switches.  This will require less
	work in the future to add new flag words.
	Module:
		CMND20

2442	RVM	4-Aug-84
	Make /EXTEND:CODE turn on its bit.

2445	RVM	8-Aug-84
	Make /EXTEND:PSECT fill in LONAME and HINAME.

2447	PLB	10-Aug-84
	Changes for nested INCLUDE files: Modified OPNICL to return
	JFN in VREG, rather than store in CHNLTBL. Removed CLOICL.

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.

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

2465	RVM	11-Oct-84
	BLISS and CMND20 disagree about which registers are saved across
	routine calls.  Thus, CMND20 should save and restore all the
	preserved registers when calling a BLISS routine.

2470	RVM	19-Oct-84
	BIGARY was getting the wrong value if /EXTEND was never seen.  This
	also had the effect that BIGARY was wrong if /EXTEND:anything-but-data
	was given.

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

4500	MEM	22-Jan-85
	Add warning message mnemonic VKI.

4501	MEM	22-Jan-85	
	Add warning message mnemonic EIR.

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].

4530	MEM	17-Feb-86
	Add long symbol support: Add warning message mnemonic EID;
	Accept long common block names in /EXTEND switch.

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

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

4547	RVM	24-Aug-86
	Update the version number in the argument to SETSN%.  Thus,
	the exec command @INFO SUBSYS will display "FTN 11" statistics.

4553	JB	15-OCT-86
	Remove edit 4543.

4561	MEM	13-Jan-87
	Correct check to see if /GFLOAT was specified on a machine
	that does not have gfloating microcode.

ENDV11

\
	SEARCH	JOBDAT,MONSYM,MACSYM
	SEARCH	GFOPDF		;Define GFLOATING instructions

	EXTERN	PHAZCONTROL
	EXTERN	CLOSUP		;Close everything
	EXTERN	FNDCOM		;[2343] Find an entry in ECTAB

	ENTRY	NXTFIL		;Opens next source file for compiler
	ENTRY	OPNICL		;Open the include file for the compiler

	INTERN	NWBITS		;The flags of warnings have been suppressed
	INTERN	NWKTBC		;The number of warning message mnemonics
	INTERN	NWKTB		;The table of sixbit warning message mnemonics

	INTERN	MRP0		;Execute-only entry
	INTERN	FORTRA		;Start address of FORTRA


	EXTERN	.HIGH.		;Start of compiler's high segment (Defined by
				; a /SET switch to LINK)
	EXTERN	ISN		;Statement number of line being compiled
	EXTERN	ICLPTR		;Points to INCLUDE filespec
	EXTERN	CCLSW		;Contains 0 or 1, the start address offset used
				; to start FORTRA
	EXTERN	STACK		;The stack used by BLISS
	EXTERN	CTIME		;The current time of day
	EXTERN	RTIME		;The runtime of this fork
	EXTERN	DEBGSW		;Holds the debug switches
	EXTERN	BUGOUT		;Holds BUGOUT mask for debugging the compiler
	EXTERN	FLAGS2		;A flag word
	EXTERN	F2		;A flag word
	EXTERN	BIGARY		;[2220] Size of arrays to put in PSLARGE
 	EXTERN	BIGCONCAT	;[2251] The   size   of   the    biggest
				;[2251] concatenation  to  allow  as   a
				;[2251] "fixed length" or "known maximum
				;[2251] length".  Maximum  size  of  non
				;[2251] dynamic concatenation.
	EXTERN	DFCMPS		;[2343] The default psect for COMMON blocks
	EXTERN	ECTABL		;[2343] Max number of common blocks allowed
				;[2343] to be named in /EXTEND
	EXTERN	ECRECL		;[2343] Length of a entry in ECTAB
	EXTERN	ECHSHL		;[2343] Length of hash table for list of COMMON
				;[2343] named in a /EXTEND switch
	EXTERN	ECUSED		;[2343] Number of entries in ECTAB
	EXTERN	ECTAB		;[2343] Table of COMMON blks named in /EXTEND
	EXTERN	ECHASH		;[2343] Hash Table of COMMON blocks named in 
				;[2343] /EXTEND switch
	EXTERN	CHNLTBL		;Holds filenames and JFNs for the compiler
	EXTERN	SEGINCORE	;Argument to PHAZCONTROL
	EXTERN	LONAME		;[2310] Name of the low (data) PSECT in SIXBIT
	EXTERN	HINAME		;[2310] Name of the high (code) PSECT in SIXBIT
	EXTERN	DEFLON		;[2454] Default for LONAME
	EXTERN	DEFHIN		;[2454] Default for HINAME
	EXTERN	VMSIZE		;[2322] Size of virtual memory for this compile

	SALL

; Default feature test settings

	IFNDEF DEBUG,DEBUG==0	;[2221] Enables tracing (default off)
	IFNDEF FTUS,FTUS==0	;[2221] DEC in-house features (default off)
	IFNDEF FT612,FT612==0	;[2221] Build in SIX12 debugger (default off)

; Parameters for sizes of various data structures

	BUFSIZ==^D96		;Length (words) of command line buffer
	ATMBLN==^D34		;Length (words) of atom buffer
	MAXSYM==^D72		;[2445] Maximum length is a symbolic name
	SYMLEN==<MAXSYM+5>/6	;[2445] Symbolic name length in words
	ATM6SZ==SYMLEN		;[2445] Length (words) of largest SIXBIT atom
	MAXCHR==^D32		;[4530] Maximum number of characters in symbol
				;[4530] Only psect names can have size MAXSYM
	MAXWD==<MAXCHR+5>/6	;[4530] Maximum number of words in symbol
	SIXBCHARSPERWORD==6	;[4530] Number of Sixbit characters per word
	MAXFILES==^D20		;Maximum number of sources files in one command
	TMPLEN==200		;Length of the PRARG block
	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.

	DEFBIGARY==^D10000	;[2470] Default for /EXTEND:DATA (no value)

	PSOOPS==0		;[2343] "Bad" psect (Also defined in FIRST.BLI)
	PSDATA==1		;[2343] Data psect (Also defined in FIRST.BLI)
	PSLARGE==3		;[2343] Large psect (Also defined in FIRST.BLI)

	DEFINE	ECPSE2(REG)	;[2343] 
	< [POINT 2,1('REG),3] > ;/EXTEND:COMMON SWITCH.INI psect

	DEFINE	ECPSECT(REG)	;[2343] 
	< [POINT 2,1('REG),1] > ;/EXTEND:COMMON command line psect


	TRUE==1			;[2343] BLISS-10 Truth

	TWOSEG	400000

;AC'S USED BY COMMAND SCANNER

	F==0		;Known as FLGREG by the compiler.
	T1==1		;TEMP
	T2==2		; ..
	T3==3		; ..
	T4==4		; ..
	T5==5		; ..
	T6==6		; ..
	P1==7		;PRESERVED AC
	P2==10		; ..
	P3==11		; ..
	P4==12		;
	P5==13		;
	P6==14		;
	VREG=15		;BLIS10 VALUE RETURN REG
	FREG=16		;BLIS10 FRAME POINTER
	SREG=17		;BLIS10 STACK POINTER


	OPDEF	PJRST	[JRST]	;PUSHJ and POPJ
	OPDEF	NOOP	[TRN]	;Fastest No-op in machine
	.NODDT	PJRST,NOOP

	FRMTTY==0		;Command input comes from terminal
	FRMPRA==1		;Command input comes from PRARGs
	FRMTAK==2		;Command input comes from /TAKE file
	FRMSWI==3		;Command input comes from SWITCH.INI
	FRMTEN==4		;Command input is under TOPS-10 compatibility


DEFINE	TRACE(S)<		;;Does statement label tracing
	IFN	DEBUG,<
	   PUSH   SREG,T1
	   HRROI  T1,[ASCIZ \
Got to 'S
\]
	   PSOUT%
	   POP	  SREG,T1>
>
	SUBTTL	Low Segment Data Area

	RELOC 0

RUNCOD:		;[1611] This code rewritten
RUNJFN:	XWD	.FHSLF,.-.	; 0- .-. gets JFN of file to run
	EXP	-1		; 1-Throw away pages
	XWD	.FHSLF,0	; 2-Of this fork starting at page zero
	EXP	PM%CNT+1000	; 3-and going through to the last page
	PMAP%			; 4-Throw away pages
	MOVE	1,0		; 5-Get JFN of file to run
	GET%			; 6-Map its pages
	RESET%			; 7-Reset the world
RUNSTO:	MOVEM	15,.JBERR	;10-Store old value of .JBERR
	MOVEI	1,.FHSLF	;11-This fork
	MOVE	2,14		;12-Get value of start address offset
	SFRKV%			;13-Start this fork
RUNOFF:	EXP	.-.		;14- .-. gets start address offset
RUNERR:	EXP	.-.		;15- .-. gets old value of .JBERR


ICLEST:	BLOCK	24		;STORE AREA FOR INCLUDE FILE ERROR MESSAGE

APRSV1:	BLOCK	1
APRSV2:	BLOCK	1
APRSV3:	BLOCK	1

;	DEFAULT TABLE FOR INCLUDE INPUT

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



	;State block for COMND% JSYS

STATE:	XWD	0,0			;Flags,,Reparse address
	XWD	.PRIIN,.PRIOU		;Input JFN,,Output JFN
	EXP	0			;Pointer to Command Prompt
	POINT	7,BUFF			;Pointer to command buffer
	POINT	7,BUFF			;Pointer to next text to parse
	EXP	5*BUFSIZ		;# of Chars unused in buffer
	EXP	0			;# of Chars unparsed in buffer
	POINT	7,ATMBUF		;Pointer to atom buffer
	EXP	5*ATMBLN		;# of chars in atom buffer
	EXP	CJFNBK			;Pointer to GTJFN% block


	;Copy of the ACs returned by the COMND JSYS

CMDFLG:	BLOCK	1		;[2220] Flags in left half (AC1)
CMDDAT:	BLOCK	1		;[2220] Data obtained (AC2)
CMDUSD:	BLOCK	1		;[2220] Descriptor used (AC3)

LKAHD:	BLOCK	1		;[2220] Flag nonzero means next symbol scanned

DEFEXT:	BLOCK	1		;[2220] Pointer to table of default file
				;[2220] extensions to be used by COMND% JSYS

FOLLOW:	BLOCK	1		;[2220] Follow set (used by CHKCOLON)

BUFF:	BLOCK	BUFSIZ		;Command buffer for COMND% JSYS
COMBUF:	BLOCK	MAXWD		;[4530] Buffer for long common block naem
ATMBUF:	BLOCK	ATMBLN		;Atom buffer for COMND% JSYS
DEFFIL:	BLOCK	ATMBLN		;Holds default filename for /LIST & /OBJECT
LSTTYP:	BLOCK	ATMBLN		;Holds user's typescript if he gives value to
				;/LIST
	
INIFIL:	BLOCK	^D19		;Holds filename of SWITCH.INI file

CMDSOU:	BLOCK	1		;Source code,,Optional JFN of COMND% input
ERRPFX:	BLOCK	1		;Pointer to prefix of error message line
ERRTXT:	BLOCK	1		;[2415] Pointer to error text used by SEMERR
OLDSTK:	BLOCK	1		;Used to restore the stack pointer
CJFNBK:	BLOCK	.GJATR+1	;Block for GTJFN%


PRAFIL:	ASCIZ	\/TAKE:000NFO.TMP;T
\				;[1643] Used to read EXEC args if PRARG fails


INCFIL:	BLOCK	1		;JFN of include file
RELFIL:	BLOCK	1		;JFN of object file
LSTFIL:	BLOCK	1		;JFN of list file
CNTIDX:	BLOCK	1		;Index in FORFIL to currently open source file
FORIDX:	BLOCK	1		;Index to get last source file JFN in FORFIL
FORFIL:	BLOCK	MAXFILES	;JFN's of source files

JOBNUM:	BLOCK	1		;[1631] Job number
XJBFF:	BLOCK	1		;[1632] Holds .JBFF across compiles
XJBREL:	BLOCK	1		;[1632] Holds .JBREL across compiles

BATCH:	BLOCK	1		;Flag: Is this a batch job?

TDEPTH:	BLOCK	1		;Level of nesting of /TAKE: files

ECHOFLG:BLOCK	1		;Flag: Is command to be echoed?
OPTECHO:BLOCK	1		;Flag: Are option lines from SWITCH.INI echoed?

NOPTION:BLOCK	1		;Flag: Has /NOOPTION been seen?

OPTION: BLOCK	10		;Storage for option string--stores 39 chars

PERIOD:	BLOCK	1		;[2343] Flag: Has a period been seen in this
				;[2343] COMMON block name?  (Used by CVTCOM)

ARGBLK:	BLOCK	TMPLEN		;Area to hold Process Args

SIXATM:	BLOCK	ATM6SZ		;[2445] Hold Sixbit atoms produced by CVT76

COLON:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \:\]>,a ":" followed by value of the keyword) ;[2331] Modified at runtime to chain to follow set

EP.CL:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \:\]>,a ":" followed by name of the code psect) ;[2445] Modified at runtime to chain to follow set
;++
;
; To add a new flag word to the command scanner, you must do the following:
;
;	1.  Add the name of the flag word to the EXTERN list.
;
;	2.  Add an XX entry to the FLGTBL list below.   The first argument
;	    to the XX macro is the name of the flag word being set.  The
;	    second argument is the default value for that word.
;
; The FLGTBL macro, when it expands, will define an offset into the ONFLG
; and OFFFLG tables to be used in action routine for a switch to build up
; the value to be set in the flag work by the command scanner.  When it is
; time to compile a file, the RESFLG routine will be caller, and it will do
; all the processing necessary to assign the final value to the flag word.
;
;--


DEFINE	FLGTBL(LIST)<		;;[2441] Macro to expand flag word tables
	NUMFLGS==0		;;[2441] NUMFLGS is the number of flag words

	DEFINE	XX(ONE,TWO)<	;;[2441] Expand FLGNAM table
	EXP	ONE		;;[2441] Pointer to flag word to update
	$'ONE==NUMFLGS		;;[2441] Symbolic offset into ONFLG/OFFFLG
	NUMFLGS==NUMFLGS+1	;;[2441] Count number of Flag words
	>			;;[2441]

FLGNAM:	LIST			;;[2441] Table of pointers to the flag words

	DEFINE	XX(ONE,TWO)<	;;[2441] Expand DEFFLG table
	EXP	TWO		;;[2441] Default values for flag words
	>			;;[2441]

DEFFLG:	LIST			;;[2441] Table of default values for flag words

>				;;[2441]


FLGTBL	<			;[2441] Create this table
XX	(F, RELFLG)		;Default for F switch word
XX	(F2, SW.F77)		;Default for F2 switch word
XX	(FLAGS2, 0)		;Default for FLAG2 switch word
XX	(DEBGSW, 0)		;Default for DEBGSW switch word
XX	(BUGOUT, 0)		;Default for BUGOUT switch word
XX	(BIGARY, <1_^D30>-1)	;[2470] Default for BIGARY <set by /EXTEND>
XX	(DFCMPS, PSDATA)	;[2343] Default for DEFCOMPSECT <set by /EXT>
XX	(BIGCONCAT, ^D50000)	;[2251] Default for BIGCONCAT
>				;[2441] Create this table


;	!! DO NOT SEPERATE ONFLG, OFFLG, SONFLG, SOFFFLG !!
;		!!   THEY MUST BE CONTIGUOUS   !!

ONFLG:	BLOCK	NUMFLGS		;The flags that must be turned on
OFFFLG:	BLOCK	NUMFLGS		;The flags that must be turned off
SONFLG:	BLOCK	NUMFLGS		;Holds ON flags from command line
				;during SWITCH.INI processing.
SOFFLG:	BLOCK	NUMFLGS		;Holds OFF flags from command line
				;during SWITCH.INI processing.

;	!! DO NOT SEPERATE ONHIN, ONLON, OFFHIN, OFFLON, SONHIN, !!
;	!!	   and SONLON, SOFFHI, SOFFLON 			 !!
;		!!   THEY MUST BE CONTIGUOUS   !!

ONHIN:	BLOCK	SYMLEN+1	;[2445] Like ONFLG, but only for HINAME
ONLON:	BLOCK	SYMLEN+1	;[2445] Like ONFLG, but only for LONAME
OFFHIN:	BLOCK	SYMLEN+1	;[2445] Like OFFFLG, but only for HINAME
OFFLON:	BLOCK	SYMLEN+1	;[2445] Like OFFFLG, but only for LONAME

SONHIN:	BLOCK	SYMLEN+1	;[2445] Like SONFLG, but only for HINAME
SONLON:	BLOCK	SYMLEN+1	;[2445] Like SONFLG, but only for LONAME
SOFFHI:	BLOCK	SYMLEN+1	;[2445] Like SOFFFLG, but only for HINAME
SOFFLO:	BLOCK	SYMLEN+1	;[2445] Like SOFFFLG, but only for LONAME
	SUBTTL	Compiler Initialization

	RELOC	400000

MRP0:	   ;Label used by PHAZCONTROL, becomes starts address

FORTRA:	TDZA	VREG,VREG	;Flag as normal entry
	 MOVEI	VREG,1		;Flag as CCL entry
	MOVEM	VREG,CCLSW	;Save the CCL switch

	RESET%

	GETNM%			;[1612] Get the name of the program
	MOVE	T2,T1		;[1612] Private name is name returned by GETNM%
	MOVE	T1,[SIXBIT \FTN 11\] ;[4547] System name
	SETSN%			;Let's tell the Monitor!
	 NOOP			;Failure return, we don't care!

	MOVEI	T1,.FHSLF	;This process's compatibility vector
	SETO	T2,		;Do not allow UUOs
	SCVEC%

	HLRZ	T1,.JBSA	;Get first free low-segment start address
	HRRM	T1,.JBFF	;"Deallocate" core
	HRRM	T1,.JBREL	;"Deallocate" core

	MOVE	SREG,[IOWD PDLLEN,STACK] ;Set up the stack
	HRRZI	FREG,(SREG)	;LIFE IS BLISS


IFN FT612,<			;[2221] Are we being built for debugging?
				;[2221] Yes - force the debugger to be loaded
				;[2221]  and called upon startup

	.REQUIRE DUMP		;[2221] Dump routines
	.REQUIRE DSUB		;[2221] More dump routines
	.REQUIRE DSTATE		;[2221] Yet more dump routines
	.REQUIRE DEXPR		;[2221] Still more dump routines
	.REQUEST SIX12		;[2221] Debugger (finally)

	MOVE	VREG,CCLSW	;[2221] Get back the value of the CCL switch
	PUSHJ	SREG,SIX36##	;[2221] ENABLE . . .
	MOVEM	VREG,CCLSW	;[2221] Save the CCL switch
				;[2221]  (Can be set by "RETURN n" in SIX12)
	PUSHJ	SREG,DUMPINIT##	;[2221] . . . SW/REG

> ; End of IFN FT612		;[2221] End of SIX12 initialization code

	PUSHJ	SREG,APRINI	;Initialize interrupt system

	SETZM	ECHOFLG		;[1645] Assume that commands are not echoed
	SETZM	STATE+.CMFLG	;[1671] No reparse address or flags
	MOVE	T1,[XWD .PRIIN,.PRIOU] ;[1671] JFNs for command input, output
	MOVEM	T1,STATE+.CMIOJ	;[1671] Restore JFNs
	MOVE	T1,[POINT 7,BUFF] ;[1671] Pointer to command buffer
	MOVEM	T1,STATE+.CMBFP	;[1671]
	MOVEM	T1,STATE+.CMPTR	;[1671]
	MOVX	T1,5*BUFSIZ	;[1671] # Chars unused in buffer
	MOVEM	T1,STATE+.CMCNT	;[1671]
	SETZM	STATE+.CMINC	;[1671] # Chars unparsed in buffer
	;**********************************************************************
	;
	; Test for the presence of the gfloating microcode.  This code will
	; turn on or off the GFMCOK flag in the default word for FLAGS2.
	;
	;**********************************************************************

	SETZB	T2,T3		;Clear T2 & T3 so we can do a GFAD on it
	SETZ	T4,		;Clear T4 to assume don't have gfloating ucode
	GFAD	T2,T2		;Do a typical gfloating instruction
	ERJMP	INTDON		;Oh, no! No gfloating microcode!
	MOVX	T4,GFMCOK	;Yes, we have the gfloating microcode
INTDON:	IORM	T4,DEFFLG+$FLAGS2 ;Set GFMCOK flag in the defaults for FLAGS2
	SUBTTL	Get Name of SWITCH.INI file
	;**********************************************************************
	;
	; Get name of the user's SWITCH.INI file.
	;
	;**********************************************************************

	;Rewritten edit 1623

	SETO	T1,		;Get info about this job
	MOVE	T2,[XWD -<.JILNO+1>,BUFF] ;-Length,,address
	MOVEI	T3,.JIJNO	;First thing that we are interested in
	GETJI%
	 ERCAL	UNXERR		;Failure return

	MOVE	T1,BUFF+.JIJNO	;[1631] Get job number
	MOVEM	T1,JOBNUM	;[1631] Store

	MOVE	T1,BUFF+.JIBAT	;Get batch flag
	MOVEM	T1,BATCH	;Store

	HRROI	T1,INIFIL	;Area to receive name of switch file
	MOVE	T2,BUFF+.JILNO	;Get number of logged-in directory
	DIRST%
	 ERCAL	UNXERR		;Failure return

	MOVEI	P1,^D11		;Source is ten characters
	MOVE	P2,[POINT 7,[ASCIZ \SWITCH.INI\]] ;Source byte pointer
	SETZB	P3,P6		;No second word in byte pointers
	MOVEI	P4,^D11		;Destination to receive ten characters
	MOVE	P5,T1		;Destination Byte pointer
	EXTEND	P1,[MOVSLJ	;Copy the string
			0]
	 NOOP
	SUBTTL	Process Fork Argument from the EXEC
	;**********************************************************************
	;
	; Read and process the proccess arguments set up by the EXEC.  The
	; EXEC sets up the process arguments when it calls FORTRA to do
	; a COMPILE, EXECUTE, etc. EXEC command.
	;
	;**********************************************************************

	SKIPN	CCLSW		;Was FORTRA started at the CCL entry point?
	 JRST	MAIN		;No--Don't try to get process arguments

	MOVE	T1,[XWD .PRARD,.FHSLF]	;Read arguments for this fork
	MOVEI	T2,ARGBLK	;Area in which to get arguments
	MOVEI	T3,TMPLEN	;Length of area to hold text
	PRARG%

	SKIPG	T1,ARGBLK	;Get number of "files" in TMPCOR
	 JRST	DSKTMP		;[1631] Get arguments from file on disk
LOOP:	MOVE	T2,ARGBLK(T1)	;Get displacement of file in TMPCOR
	HLRZ	T3,ARGBLK(T2)	;Get header of first file
	CAIN	T3,(SIXBIT \NFO\) ;Have we got the file we want?
	 JRST	FOUND		;Yes--process it
	SOJG	T1,LOOP
	JRST	MAIN

FOUND:	HRRZ	P1,ARGBLK(T2)	;Get length (in words) of TMP file
	IMULI	P1,5		;Get length (in characters) of TMP file
	MOVEI	P2,ARGBLK+1(T2)	;Get address of string in TMP file
	HRLI	P2,(POINT 7,0,-1) ;Make into a byte pointer

SL2:	HRLZI	T1,FRMPRA	;The command stream is the process arguments
	MOVE	T2,[XWD .NULIO,.NULIO] ;COMND% will not have to do I/O
	HRROI	T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
	PUSHJ	SREG,CMDINI	;Init COMND% JSYS and its state block

	MOVEI	P3,BUFSIZ*5	;[2262] Get length of receiving area
	MOVE	T1,STATE+.CMPTR	;Get byte pointer to command buffer
L2:	ILDB	T2,P2		;Get a character from TMP file
	IDPB	T2,T1		;Deposit in command buffer
	SOJE	P1,GOTSTR	;Jump if no more text in TMP file
	CAIN	T2,.CHLFD	;Was character linefeed?
	 SOJA	P3,GOTSTR	;Yes--Got the command string
	SOJGE	P3,L2		;If room still in command buffer, loop

	HRROI	T1,[ASCIZ \FTNCMD Command passed by EXEC is too long
\]
	ESOUT%
	JRST	MAIN

GOTSTR:	SETZM	TDEPTH	;No take files nested here!
	SUBI	P3,BUFSIZ*5	;[2262] Get the number of unparsed characters
	MOVNM	P3,STATE+.CMINC	;[2262] Store number of unparsed chars
	PUSHJ	SREG,SCAN20	;Scan the command line

	MOVE	T1,P2		;Get copy of pointer to text in TMP file
	ILDB	T2,T1		;Get next character
	JUMPE	T2,PFAHLT	;[1611]If char is null, then got end of command
	JUMPN	P1,SL2		;Continue processing if more text
PFAHLT:	HALTF%			;[1611] Through processing fork arguments
	JRST	MAIN		;[1631] User typed "CONTINUE" ...
	SUBTTL	Process TMP file on DSK:

	;[1631] This routine added by RVM

DSKTMP:	HRLZI	T1,FRMPRA	;The command stream is the process arguments
	MOVE	T2,[XWD .NULIO,.NULIO] ;COMND% will not have to do I/O
	HRROI	T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
	PUSHJ	SREG,CMDINI	;Init COMND% JSYS and its state block

	MOVE	T1,JOBNUM	;Get job number
	IDIVI	T1,^D100	;Get hundreds digit
	MOVE	T3,T1		;Store hundreds digit
	MOVE	T1,T2		;Get remainder of job number
	IDIVI	T1,^D10		;Get tens and ones digits
	LSH	T3,7		;Make room for tens digit
	ADD	T3,T1		;Add in tens digit
	LSH	T3,7		;Make room for ones digit
	ADD	T3,T2		;Add in ones digit
	LSH	T3,^D8		;Position in order to form filename
	ADDM	T3,PRAFIL+1	;Form filename of TMP file

	MOVX	T1,GJ%SHT+GJ%OLD+GJ%TMP	;[1643] An existing TMP file
	MOVE	T2,[POINT 7,PRAFIL+1,6]	;[1643] Filename is in PRAFIL
	GTJFN%			;[1643] Get a JFN to see if file exists
	 ERJMP	MAIN		;[1643] Can't read file--get commands from tty

	MOVE	T1,[XWD PRAFIL,BUFF] ;From PRAFIL to BUFF
	BLT	T1,BUFF+4	;[1643] Move the command string+null byte

	SETZM	TDEPTH		;No take files nested here (yet)!
	MOVEI	T1,^D20		;[1643] Number of characters in command
	MOVEM	T1,STATE+.CMINC	;Store number of unparsed chars in state block
	PUSHJ	SREG,SCAN20	;Scan the command line

	MOVX	T1,.FHSLF+CZ%NIF+CZ%ABT ;Abort I/O for this process
	CLZFF%			;Close open files and release all JFNs

	MOVX	T1,GJ%SHT+GJ%OLD+GJ%TMP ;[1643] Get a JFN on an old TMP file
	MOVE	T2,[POINT 7,PRAFIL+1,6] ;Filename pointer
	GTJFN%
	 ERCAL	UNXERR		;Unexpected error
	HRRZ	T1,T1		;Zero left half of T1
	DELF%			;Delete the TMP file
	 ERCAL	UNXERR		;Unexpected error
	HALTF%			;Done
	SUBTTL	Main Command Loop of the Compiler

	;**********************************************************************
	;
	; This is the main command loop of the compiler.  It is responsable
	; for calling SCAN20 or SCAN10 to process a command line input from
	; the terminal.
	;
	;**********************************************************************

MAIN:
	SKIPE	BATCH		;Are we running under batch?
	 JRST	GOTBAT		;Yes--Might have to do -10 compatability stuff

NOTBAT:	MOVX	T1,.FHSLF+CZ%NIF+CZ%ABT ;[1623] Abort I/O for this process
	CLZFF%			;[1623] Close open files and release all JFNs
	SETZM	TDEPTH		;No take files are nested here!
	HRLZI	T1,FRMTTY	;COMND% input comes from terminal
	MOVE	T2,[XWD .PRIIN,.PRIOU] ;Input from terminal,,ouput to terminal
	HRROI	T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
	PUSHJ	SREG,CMDINI	;Init COMND% JSYS and its state block
	PUSHJ	SREG,SCAN20	;Scan a TOPS-20 command line
	JRST	NOTBAT

GOTBAT:	MOVX	T1,.FHSLF+CZ%NIF+CZ%ABT ;[1623] Abort I/O for this process
	CLZFF%			;[1623] Close open files and release all JFNs
	MOVEI	T1,"*"		;The batch prompt
	PBOUT%
	SETZM	TDEPTH		;No take files are nested here!
	MOVEI	T1,BUFSIZ*5	;[2262] Get size of buffer
	MOVEM	T1,STATE+.CMCNT	;[2262] Store number of chars free in buffer
	SETZM	STATE+.CMINC	;[2262] No characters left unparsed
	MOVE	T2,[POINT 7,BUFF] ;[2262] Point to the COMND% JSYS buffer
	MOVEM	T2,STATE+.CMPTR	;[1603] Disable CONTROL/H feature under batch
	SETZ	P1,		;No charaters read Yet

BATLP:	PBIN%			;Get a character
	AOJ	P1,		;Got another character
	CAILE	P1,BUFSIZ*5	;Have we exceeded the size of the buffer?
	 JRST	CMDOVL		;Yes--Buffer overflowed!
	IDPB	T1,T2		;Store character in COMND%'s buffer
				;[2014]
	CAIN	T1,"="		;[2014] Is this character an equal sign?
	 JRST	TOPS10		;[2014] Yes--Got a TOPS-10 command
	CAIE	T1,"+"		;Is this character an plus sign?
	 CAIN	T1,"?"		;Is this character a question mark?
	  JRST	TOPS20		;Yes--Got a TOPS-20 command
	CAIE	T1,.CHCNF	;Is this character a CONTROL/F?
	 CAIN	T1,.CHESC	;Is this character an escape?
	  JRST	TOPS20		;Yes--Got a TOPS-20 command
	CAIE	T1,.CHCNV	;Is this character a CONTROL/V?
	 CAIN	T1,.CHLFD	;Is this character a linefeed?
	  JRST	TOPS20		;Yes--Got a TOPS-20 command
	CAIE	T1,.CHFFD	;Is this character a form feed?
	 JRST	BATLP		;No--Go get another character

TOPS20:	HRLZI	T1,FRMTTY	;COMND% input comes from terminal
	MOVE	T2,[XWD .PRIIN,.NULIO] ;Input from terminal,,ouput to nowhere
	HRROI	T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
	PUSHJ	SREG,CMDINI	;Init COMND% JSYS and its state block
	MOVEM	P1,STATE+.CMINC	;Store number of unparsed characters
	PUSHJ	SREG,SCAN20	;Scan a TOPS-20 command line
	JRST	GOTBAT

TOPS10:	MOVSI	T1,FRMTEN	;COMND% input processed under -10 compatibility
	MOVE	T2,[XWD .PRIIN,.NULIO] ;Input from terminal,,ouput to nowhere
	HRROI	T3,[ASCIZ \*\]	;Prompt pointer
	PUSHJ	SREG,CMDINI	;Init COMND% JSYS and its state block
	MOVEM	P1,STATE+.CMINC	;Store number of unparsed characters
	PUSHJ	SREG,SCAN10	;Scan a TOPS-10 command line
	JRST	GOTBAT

CMDOVL:	HRROI	T1,[ASCIZ \FTNCMD Command too big for internal buffer
\]
	ESOUT%
	JRST	GOTBAT
	SUBTTL	UNXERR -- Unexpected JSYS error

;************************************************************************
; This rouine is used when an unexpected JSYS error occurs
; Added by edit 1623.
;************************************************************************

UNXERR:	HRROI	T1,[ASCIZ \FTNCMD Unexpected JSYS error at PC \]
	ESOUT%
	MOVEI	T1,.PRIOU	;Output to primary output stream
	HRRZ	T2,(SREG)	;Get the return address from the PC
	SOJ	T2,		;Back the PC over the call
	MOVX	T3,NO%ZRO+FLD(6,NO%COL)+FLD(^D8,NO%RDX)	;6 col. octal #
	NOUT%			;Output number
	 NOOP			;Pretty bad if this fails
	HRROI	T1,[ASCIZ \
\]
	PSOUT%
	HALTF%			;Halt this fork
	POPJ	SREG,		;Brave person typed "CONTINUE"--so return
	SUBTTL	NXTFIL -- Open Next Source File

;***********************************************************************
; This routine is called by the compiler to open the next source file.
;***********************************************************************

NXTFIL:
	AOS	T4,CNTIDX	;Get index into FORFIL of source file to open
	CAMLE	T4,FORIDX	;Have all the files been opened?
	 POPJ	SREG,		;Yes--Take failure return

	PUSH	SREG,P1		;Save P1
	PUSH	SREG,P2		;Save P2

	MOVE	P1,FORFIL(T4)	;Get JFN of list file
	MOVE	T1,P1		;Get JFN of list file
	DVCHR%			;Get characteristics of source file
	LDB	T1,[POINTR(T1,DV%TYP)] ;Get device type
	MOVX	T3,TTYINP	;Get bit that indicates TTY input
	CAIE	T1,.DVTTY	;Is it a terminal?
	 JRST	NOTTTY		;No--Don't need to do anything
	IORM	T3,FLAGS2	;Set TTY input flag
	MOVX	T2,FLD(7,OF%BSZ)+OF%RD+OF%WR ;Byte size is 7, allow read&write
	JRST	OPNSOU		;Open the source file
NOTTTY:	ANDCAM	T3,FLAGS2	;Clear TTY input bit
	MOVX	T2,OF%RD	;Open file for writing, ASCII 36 bit bytes
OPNSOU:	MOVE	T1,P1		;Get JFN of next source file
	OPENF%
	 ERJMP	[MOVE	T1,XJBFF	;[1632] Restore value of .JBFF
		MOVEM	T1,.JBFF	;[1632]
		MOVE	T1,XJBREL	;[1632] Restore value of .JBREL
		MOVEM	T1,.JBREL	;[1632]
		JRST	MONERR]

	MOVEI	P2,CHNLTBL+^D20	;Get address of the source file CHNLTBL entry
	PUSHJ	SREG,LDCHNL	;Load CHNLTBL entry of object file

	TXZ	F,EOCS		;Clear end of command string flag

	POP	SREG,P2		;Restore P2
	POP	SREG,P1		;Restore P1
	AOS	(SREG)
	POPJ	SREG,		;Take success return
	SUBTTL TRAP handling routines

;
;	Subroutine to initialize for 'APR' trapping
;

; SET UP TRAPS 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:
	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

	MOVE	T2, .JBREL	;[1600] END OF CORE (REFERENCES PG 0)
	ORI	T2, 777		;[1612] END OF PAGE-IFY
	MOVEI	T3, 1777	;[1600] START AT END OF PAGE 1
APR.1:	CAMLE	T3, T2		;[1612] DONE YET?
	 JRST	APR.2		;[1612] YES, ACTIVATE INTERUPTS
	SKIP	(T3)		;[1612] NO, REFERENCE THIS PAGE
	ADDI	T3, 1000	;[1612] BUMP UP 1 PAGE
	JRST	APR.1

APR.2:	MOVE	T2,[CHNMSK]	;[1600] ARM PROPER CHANNELS
	AIC%			;[1600] ENABLE INTERUPT CHANNELS
	POPJ	SREG,		;[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-EXISTENT PAGE

	BLOCK	^D35-.		;[1600]  (23-35)
	DEPHASE			;[1600]  *** END OF PHASE 0 ***
	SUBTTL	CORE UUO Simulation Routines
; NEW [1600] /PLB
; Simulate CORE UUO for Twenex
CORUUO::
	PUSH	SREG, T1
	PUSH	SREG, T2
	MOVEI	T1, .HIGH.	;GET HI-SEGMENT ORIGIN
	CAMG	T1, -3(P)	;LARGER THEN REQUESTED CORE BREAK?
	 PUSHJ	SREG, CORERR	;'FRAID SO

	MOVEI	T1, .FHSLF	;THIS PROCESS
	MOVEI	T2, 1B<.ICNXP>	;NON-EXISTENT PAGE TRAP
	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 OLD CORE
	SETZM	(T1)		;ZERO FIRST WORD
	HRL	T1, T1		;PREPARE FOR BLT
	AOJ	T1,		;[1705] BUMP RIGHT HALF FOR SMEAR
	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	SREG, T2
	POP	SREG, T1
	POPJ	SREG,
	SUBTTL	Misc. Error Utility Routines

; 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
	MOVEM	T3,APRSV3	;[1612] STORE T3
	SOS	T1,0(P)		;WHERE WERE WE CALLED FROM
	HRRZM	T1,.JBTPC	;STORE ADDRESS
	HRROI	T2,[ASCIZ \?FTNUCE User Core Exceeded\]	;LOCATE MESSAGE
	JRST	APRTR4		;FINISH MESSAGE

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, [ASCIZ \Illegal Memory Reference\] ;[1600] GENERIC NXM
	TLNE	T1, (PF%WRT)	;[1600] PAGE FAIL ON WRITE?
	 HRROI	T2, [ASCIZ \Non-existent memory write\]
	TRNA
IRDTRP:	 HRROI	T2, [ASCIZ \Illegal memory read\]
	TRNA
IWRTRP:	 HRROI	T2, [ASCIZ \Illegal memory write\]
	TRNA
POVTRP:	 HRROI	T2,[ASCIZ \Stack exhausted\] ;PDL OVERFLOW
	HRROI	T1,[ASCIZ \
?Internal Compiler Error
?\]
	PSOUT%
APRTR4:	HRRO	T1,T2		;GET ERROR STRING
	PSOUT%
	HRROI	T1,[ASCIZ \ at location \]
	PSOUT%

	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,[ASCIZ \ in Phase \]
	PSOUT%

	MOVE	T2,[POINT 6,GETSBL##+1] ;TYPE SEGMENT NAME
APRTR3:	ILDB	T1,T2		;LOAD BYTE
	MOVEI	T1," "(T1)	;TO ASCII
	PBOUT%			;[1600] TYPE BYTE
	TLNE	T2,770000	;TYPE 6 CHARACTERS
	 JRST	APRTR3

APRTR2:	HRROI	T1,[ASCIZ \
?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
	DMOVE	T1,APRSV1	;[1612] RESTORE REGS
	MOVE	T3,APRSV3	;[1612] FOR CRASH
	HALTF%
	JRST	.-1
	SUBTTL	OPNICL -- Open the INCLUDE File for the Compiler
	;SUBROUTINE TO OPEN INCLUDE FILES
	;CHECK TO SEE THAT THEY ARE DISK
	;CALL WITH
	;	ICLPTR = ASCIII FILE SPEC POINTER
	;	PUSHJ	SREG,OPNICL
	;	RETURN	HERE
;[2447]	;		VREG = 0,,JFN - OK
	;		OR
	;		VREG = ASCII ERROR STRING MESSAGE POINTER

OPNICL::
	PUSH	SREG,T1
	PUSH	SREG,T2
	PUSH	SREG,T3
	HRRZI	T1,ICLTAB	;LONG GTJFN% INCLUDE FILE TABLE
	MOVE	T2,ICLPTR	;SPEC POINTER
	GTJFN%
	  JRST	ICLNUL		;TRY WITHOUT DEFAULT "FOR"
NULX:	HRRZM	T1,VREG		;[2447] SAVE JFN AS RETURN VALUE
	MOVEM	T2,ICLPTR	;SAVE POINTER TO LOOK FOR SWITCHES
	;CHECK FOR DSK:
	HRRZ	T1,T1		;ZERO LEFT
	DVCHR%
	LDB	T1,[POINTR(T1,DV%TYP)] ;Get device type
	CAIE	T1,.DVDSK	;Is it a disk?
	JRST	NOTDSK		;NO
	MOVE	T1,VREG		;[2447] GET JFN AGAIN
	MOVX	T2,OF%RD	;Read, ASCII, 36 bit bytes
	OPENF%
	  JRST	ICLERR		;PROBLEMS
ICLRET:	POP	SREG,T3
	POP	SREG,T2
	POP	SREG,T1
	POPJ	SREG,

	;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"	;[2447]

ICLERR:
	MOVE	T1,[POINT 7,ICLEST]	;MESSAGE STORE AREA
	HRLOI	T2,.FHSLF		;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,[ASCIZ \Unknown file error\]]	;UNKNOWN ERROR
	JRST	ICLRET
	SUBTTL	Misc. Utility Routines
;SUBROUTINE TO PSOUT% A STRING FROM BLISS
; [1563] /PLB
TTYSTR::
	PUSH	SREG,T1		;SAVE AC 1
	HRRO	T1,-2(P)	;GET -1,,ADDR
	PSOUT%			;OUTPUT
	POP	SREG,T1		;RESTORE
	POPJ	SREG,

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

	HALTF%
	JRST	.-1
	SUBTTL	Initialize the Flag Areas

INIT:
	SETZM	ONFLG		;Clear first word of flags
	MOVE	T1,[XWD	ONFLG,ONFLG+1] ;Clear "must be ON or OFF" flags
	BLT	T1,ONFLG+2*NUMFLGS-1

	SETZM	ONHIN		;[2445] Clear first word psect names
	MOVE	T1,[XWD	ONHIN,ONHIN+1] ;[2445] Want to clear rest of blocks
	BLT	T1,ONHIN+4*<SYMLEN+1>-1

	SETZM	NWON		;Clear first word of nowarn bits
	MOVE	T1,[XWD NWON,NWON+1] ;Clear nowarn "must be ON or OFF" bits
	BLT	T1,NWON+2*NWWDCT-1

	POPJ	SREG,
	SUBTTL	RESFLG -- Resolves the SWITCH.INI and Command Line Flags

;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine resolves the flags read during SWITCH.INI
;	processing and the flags read during normal command line
;	processing, and assigns the result to the various flag words
;	used by the compiler.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,RESFLG
;
; INPUT PARAMETERS:
;
;	None.
;
; IMPLICIT INPUTS:
;
;	NUMFLGS		The number of flag words
;	ONFLG		The flags turned on during SWITCH.INI processing
;	OFFFLG		The flags turned off during SWITCH.INI processing
;	SONFLG		The flags turned on during command line processing
;	SOFFFLG		The flags turned off during command line processing
;	DEFFLG		The table of default values for the flag words
;	FLGNAM		The table of pointers to the flag words
;	ONHIN		The code psect name set during SWITCH.INI processing
;	OFFHIN		The code psect name set during SWITCH.INI processing
;	SONHIN		The code psect name set during command line processing
;	SOFFHI		The code psect name set during command line processing
;	DEFHIN		The default name of the code psect
;	ONLON		The data psect name set during SWITCH.INI processing
;	OFFLON		The data psect name set during SWITCH.INI processing
;	SONLON		The data psect name set during command line processing
;	SOFFLO		The data psect name set during command line processing
;	DEFLON		The default name of the data psect
;	ECTAB		The table of COMMON blocks named during /EXTEND
;	NWON		The no warning bits set during SWITCH.INI processing
;	SNWOFF		The no warning bits cleared during command line proc.
;	SNWON		The no warning bits set during command line processing
;
; OUTPUT PARAMETERS:
;
;	None.
;
; IMPLICIT OUTPUTS:
;
;	HINAME		The name of the code psect
;	LONAME		The name of the data psect
;	ECTAB		The table of COMMON blocks named during /EXTEND
;	NWBITS		The /NOWARN flags
;
;	And, the flag words pointed to by FLGNAM.
;
; FUNCTION VALUE:
;
;	None.
;
; SIDE EFFECTS:
;
;	None.
;
;--


;[2441] New Routine

;	Process normal flags

RESFLG:	MOVEI	T2,NUMFLGS-1	;Get the highest index into ONFLG/OFFLG
GFLOOP:	MOVE	T1,DEFFLG(T2)	;Get the default value of switch word
	ANDCM	T1,OFFFLG(T2)	;Turn off flags that must be off
	IOR	T1,ONFLG(T2)	;Turn on flags that must be on
	ANDCM	T1,SOFFLG(T2)	;Turn off flags that must be off
	IOR	T1,SONFLG(T2)	;Turn on flags that must be on
	MOVEM	T1,@FLGNAM(T2)	;Store flag word
	SOJGE	T2,GFLOOP	;Process all flag words

;	Process HINAME

	MOVEI	T2,SYMLEN	;Get the highest index into ONHIN/OFFHIN
HINL:	MOVE	T1,DEFHIN(T2)	;Get the default value of switch word
	ANDCM	T1,OFFHIN(T2)	;Turn off bits that must be off
	IOR	T1,ONHIN(T2)	;Turn on bits that must be on
	ANDCM	T1,SOFFHI(T2)	;Turn off bits that must be off
	IOR	T1,SONHIN(T2)	;Turn on bits that must be on
	MOVEM	T1,HINAME(T2)	;Store word
	SOJGE	T2,HINL		;Process all words

;	Process LONAME

	MOVEI	T2,SYMLEN	;Get the highest index into ONLON/OFFLON
LONL:	MOVE	T1,DEFLON(T2)	;Get the default value of switch word
	ANDCM	T1,OFFLON(T2)	;Turn off bits that must be off
	IOR	T1,ONLON(T2)	;Turn on bits that must be on
	ANDCM	T1,SOFFLO(T2)	;Turn off bits that must be off
	IOR	T1,SONLON(T2)	;Turn on bits that must be on
	MOVEM	T1,LONAME(T2)	;Store word
	SOJGE	T2,LONL		;Process all words

	;Make sure that the ECPSECT fields in ECTAB are set correctly.  The
	;rest of the compiler uses ECPSECT as the psect that the COMMON
	;block should be allocated to.  But, the command scanner (up until
	;this point) uses ECPSECT to store the psect set for the common
	;block during "normal" command line processing and ECPSE2 to store
	;the psect set for the common block during SWITCH.INI processing.
	;So that the rest of the compiler can use ECPSECT as the psect of
	;the common block, the value store in ECPSE2 must be moved into
	;ECPSECT iff ECPSECT has not been set.  (Remember, a value set
	;during command line scanning overrules a value set during SWITCH.INI
	;scanning.)

	MOVE	T1,ECUSED	;[2343] Get number of entries in ECTAB
	MOVEI	VREG,ECTAB	;[2343] Get pointer to table
ECMERG:	LDB	T2,ECPSECT(VREG);[2343] Get psect of this entry
	CAIE	T2,PSOOPS	;[2343] Is field PSOOPS?
	 JRST	ECCONT		;[2343] No--Go to end of loop
	LDB	T2,ECPSE2(VREG)	;[2343] Get psect set by SWITCH.INI
	DPB	T2,ECPSECT(VREG);[2343] Move the value into the "real" psect
				;[2343] field
ECCONT:	ADDI	VREG,ECRECL	;[2343] Point VREG at next entry in ECTAB
	SOJG	T1,ECMERG	;[2343] Process rest of ECTAB


	;Note that since there is no default mechanism for the
	;nowarning bits, and that all the bits are by default
	;zero, there is no need to turn off any bits that were
	;explicitly turned off by SWITCH.INI.

	MOVEI	T2,NWWDCT-1	;Get maximum index into nowarn tables
MRGNW:	MOVE	T1,NWON(T2)	;Turn on flags that must be on
	ANDCM	T1,SNWOFF(T2)   ;Turn off flags that must be off
	IOR	T1,SNWON(T2)	;Turn on flags that must be on
	MOVEM	T1,NWBITS(T2)	;Store nowarning bits
	SOJGE	T2,MRGNW	;If more nowarn bits, then merge flags

	POPJ	SREG,
	SUBTTL	DOCOMPILE -- Call the FORTRAN Compiler

DOCOMPILE:
	PUSH	SREG,P1		;Save old value of P1
	PUSH	SREG,P2		;Save old value of P2
	PUSH	SREG,P3		;[2465] Save P3	    Smashed
	PUSH	SREG,P4		;[2465] Save P4		By
	PUSH	SREG,P5		;[2465] Save P5		  PHAZCONTROL     
	PUSH	SREG,P6		;[2465] Save P6


	MOVE	T1,[XWD	ONFLG,SONFLG] ;Move command line flags to save area
	BLT	T1,SONFLG+2*NUMFLGS-1 ;Move flags

	MOVE	T1,[XWD	ONHIN,SONHIN] ;[2445] Move psect names to save area
	BLT	T1,SONHIN+4*<SYMLEN+1>-1 ;[2445] Save names

	MOVE	T1,[XWD NWON,SNWON] ;Move command line nowarn bits to save area
	BLT	T1,SNWON+2*NWWDCT-1  ;Move bits
	PUSHJ	SREG,INIT	;Zero flag areas
	PUSHJ	SREG,SCANSW	;Get switches for SWITCH.INI

	PUSHJ	SREG,RESFLG	;[2441] Resolve the flag values

	;[2322] Set the size of virtual memory depending on whether /EXTEND
	;[2322] is given.

	MOVE	T1,F2			;[2322] Copy global flag to register
	HRLZI	T2,1			;[2322] assume /NOEXTEND, 1,,0
	TXNE	T1,SW.EXT		;[2322] Test if /EXTEND was given
	 MOVX	T2,<40,,0>		;[2322] /EXTEND, load 40,,0
	MOVEM	T2,VMSIZE		;[2322] Save the size away!

	;The following table is used by the compiler to hold
	;the names and JFNs of active files.  Let's clear it
	;out for now.

	SETZM	CHNLTBL		;Zap first word
	MOVE	T1,[XWD CHNLTBL,CHNLTBL+1] ;Set up for BLT
	BLT	T1,CHNLTBL+^D40-1 ;Zap the table

	MOVE	T1,F2		;[4561] Copy global flag to register
	TXNN	T1,SW.GFL	;[4561]Did the user specify /GFLOATING?
	 JRST	GETOBJ		;No--Everything is OK
	MOVE	T1,FLAGS2	;Get flag word
	TXNE	T1,GFMCOK	;Does the machine have gfloating microcode?
	 JRST	GETOBJ		;Yes--Everything is OK
	HRROI	T1,[ASCIZ \FTNGFL /GFLOATING requires GFLOATING microcode.
\]
	ESOUT%			;Give error message
	JRST	RET.ERR		;Take error return


GETOBJ:	TXNE	F,SW.OCS	;Is /SYNTAX specified?
	 TXZA	F,RELFLG	;Yes--Turn off /OBJECT flag
	  TXNN	F,RELFLG	;Is a object file required?
	   JRST	RELOBJ		;No--See if an object file JFN must be released
	SKIPL	T1,RELFIL	;Do we have an object file JFN?
	 JRST	OPNOBJ		;Yes--Now ready to open file

	SETZM	CJFNBK		;Zero first word of GTJFN block
	MOVE	T1,[XWD CJFNBK,CJFNBK+1] ;Source,,destination
	BLT	T1,CJFNBK+.GJATR ;Zero GTJFN block

	MOVX	T1,GJ%FOU
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	MOVE	T1,[XWD .NULIO,.NULIO] ;Do no I/O
	MOVEM	T1,CJFNBK+.GJSRC ;Set up I/O JFNs for GTJFN

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	HRROI	T1,[ASCIZ \REL\]
	MOVEM	T1,CJFNBK+.GJEXT ;Set default extension

	HRRZI	T1,CJFNBK	;Get pointer to arg block for GTJFN
	HRROI	T2,DEFFIL	;The default name block will be the filespec
	GTJFN%			;Get a JFN on the object file
	ERJMP	MONERR		;
	HRRZM	T1,RELFIL	;Store JFN of object file

OPNOBJ:	MOVX	T2,OF%WR	;Open file for writing, ASCII 36 bit bytes
	OPENF%
	 ERJMP	MONERR		;Problems

	MOVE	P1,RELFIL	;Get the object file JFN
	MOVEI	P2,CHNLTBL+^D0	;Get address of the object file CHNLTBL entry
	PUSHJ	SREG,LDCHNL	;Load CHNLTBL entry of object file
	JRST	GETLST

RELOBJ:	SKIPGE	T1,RELFIL	;Get JFN of object file
	 JRST	GETLST		;No JFN of object file
	RLJFN%			;Release JFN
	ERJMP	MONERR
	SETOM	RELFIL		;Mark JFN as released

GETLST:	TXNN	F,SW.CRF	;Is cref specified?
	 TXNN	F,LSTFLG	;Is any list file specified?
	  SKIPGE T1,LSTFIL	;Get JFN of list file
	   JRST	GETL2		;No JFN for list file
	RLJFN%			;Release JFN
	ERJMP	MONERR
	SETOM	LSTFIL		;Mark list file as having no JFN

GETL2:	SKIPN	BUGOUT		;[2242] Has /BUGOUT been given?
	 TXNE	F,SW.CRF!SW.MAP!SW.MAC!SW.EXP ;Are any flags set that imply /LIST?
	  TXO	F,LSTFLG	;Yes--Make sure list flag is set

	TXNN	F,LSTFLG	;Is list flag set?
	 JRST	LDSOU		;No--Don't have to get a list file JFN
	SKIPL	T1,LSTFIL	;Do we have an listing file JFN?
	 JRST	OPNLST		;Yes--Now ready to open list file

	SETZM	CJFNBK		;Zero first word of GTJFN block
	MOVE	T1,[XWD CJFNBK,CJFNBK+1] ;Source,,destination
	BLT	T1,CJFNBK+.GJATR ;Zero GTJFN block

	MOVX	T1,GJ%FOU
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	MOVE	T1,[XWD .NULIO,.NULIO] ;Do no I/O
	MOVEM	T1,CJFNBK+.GJSRC ;Set up I/O JFNs for GTJFN

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	TXNE	F,SW.CRF	;Has /CREF been specified?
	 SKIPA	T1,[POINT 7,[ASCIZ \CRF\]] ;Yes--default extension is .CRF
	  HRROI	T1,[ASCIZ \LST\] ;No--default extension is .LST
	MOVEM	T1,CJFNBK+.GJEXT ;Set default extension

	HRRZI	T1,CJFNBK	;Set up for GTJFN%
	SKIPE	LSTTYP		;Does the original typescript from /LIST exist?
	 SKIPA	T2,[POINT 7,LSTTYP] ;Yes--Use it as filespec
	  HRROI	T2,DEFFIL	;No--Use default file as filespec
	GTJFN%			;Get list file JFN
	ERJMP	MONERR
	HRRZM	T1,LSTFIL	;Store list file JFN

OPNLST:	MOVX	T2,FLD(7,OF%BSZ)+OF%WR ;Open file for writing, 7 bit bytes
	OPENF%
	 ERJMP	MONERR		;Problems

	MOVE	P1,LSTFIL	;Get the list file JFN
	MOVEI	P2,CHNLTBL+^D10	;Get address of the list file CHNLTBL entry
	PUSHJ	SREG,LDCHNL	;Load CHNLTBL entry of list file

	MOVE	T1,LSTFIL	;Get JFN of list file
	DVCHR%			;Get characteristics of listing file
	LDB	T1,[POINTR(T1,DV%TYP)] ;Get device type
	CAIE	T1,.DVTTY	;Is it a terminal?
	 JRST	LDSOU		;No--Don't need to do anything
	HRRZ	P1,T3		;Save number of job that owns the terminal
	GJINF%			;Get this job's job number
	CAMN	P1,T4		;Are the job numbers the same?
	 TXO	F,TTYDEV	;Yes--Set the list file goes to our TTY flag

LDSOU:
	SETOM	CNTIDX		;No source file is currently open
	PUSHJ	SREG,NXTFIL	;Open the first source file
	 HALTF%			;Error return--can not happen!
	SKIPN	CCLSW		;Was FORTRAN entered at CCL start address
	 JRST	CALLFTN		;No--Load list file entry in CHNLTBL
	HRROI	T1,[ASCIZ \FORTRAN: \] ;[1603] No square bracket
	PSOUT%			;Tell the user who we are
	HRROI	T1,ATMBUF
	PSOUT%			;Print name of first source file
	HRROI	T1,[ASCIZ \
\]				;[1603] No square bracket
	PSOUT%

CALLFTN:
	MOVEI	T1,.FHSLF	;Get runtime for this fork
	RUNTM%			;Get runtime and current time
	MOVEM	T1,RTIME	;Save runtime
	MOVEM	T3,CTIME	;Save current time

	MOVE	T1,.JBFF	;[1632] Save value of .JBFF across compile
	MOVEM	T1,XJBFF	;[1632]
	MOVE	T1,.JBREL	;[1632] Save value of .JBREL across compile
	MOVEM	T1,XJBREL	;[1632]

	SETZM	SEGINCORE	;Argument to PHASE CONTROL
	PUSHJ	SREG,PHAZCONTROL ;Get the next phase

	PUSHJ	SREG,CLOSUP	;Close all files

	MOVE	T1,XJBFF	;[1632] Restore value of .JBFF
	MOVEM	T1,.JBFF	;[1632]
	MOVE	T1,XJBREL	;[1632] Restore value of .JBREL
	MOVEM	T1,.JBREL	;[1632]

	MOVE	T1,FLAGS2	;Get word of flags
	TXNE	T1,SW.ABO	;Was /ABORT specified?
	 TXNN	F,SW.ERR	;Was there fatal errors during compile?
	  JRST	RETCOM		;No--Return from this compilation

	HRROI	T1,[ASCIZ \[Exit due to /ABORT]
\]
	PSOUT%
	HALTF%

RETCOM:	POP	SREG,P6		;[2465] Restore P6  Restore
	POP	SREG,P5		;[2465] Restore P5	Regs
	POP	SREG,P4		;[2465] Restore P4	  Used by
	POP	SREG,P3		;[2465] Restore P3	    PHAZCONTROL
	POP	SREG,P2		;Restore P2
	POP	SREG,P1		;Restore P1
	POPJ	SREG,		;Return
	SUBTTL	LDCHNL -- Set up an Entry in CHNLTBL

;Set up an entry in CHNLTBL for the compiler.
;Arguments:
;	P1	JFN
;	P2	Pointer to CHNLTBL entry for this file
;Note that when this file returns, the name of the file in
;the atom buffer.

	CHNJFN==0		;Offset in a CHNLTBL entry for JFN
	CHNDEV==1		;Offset in a CHNLTBL entry for device
	CHNNAM==6		;Offset in a CHNLTBL entry for name
	CHNEXT==7		;Offset in a CHNLTBL entry for extension

LDCHNL:	HRRM	P1,CHNJFN(P2)	;Store JFN

	HRROI	T1,ATMBUF	;Get string in atom buffer
	MOVE	T2,P1		;Get the JFN
	MOVX	T3,FLD(.JSAOF,JS%DEV) ;We want the device field
	JFNS%			;Get the device name
	PUSHJ	SREG,CVT76	;Convert atom buffer to sixbit
	MOVE	VREG,SIXATM	;[2445] Get the SIXBIT
	MOVEM	VREG,CHNDEV(P2)	;Store device in channel table

	HRROI	T1,ATMBUF	;Get string in atom buffer
	MOVE	T2,P1		;Get the JFN
	MOVX	T3,FLD(.JSAOF,JS%TYP) ;We want the extension field
	JFNS%			;Get the extension
	PUSHJ	SREG,CVT76	;Convert atom buffer to sixbit
	MOVE	VREG,SIXATM	;[2445] Get the SIXBIT
	HLLM	VREG,CHNEXT(P2)	;Store in channel table

	HRROI	T1,ATMBUF	;Get string in atom buffer
	MOVE	T2,P1		;Get the JFN
	MOVX	T3,FLD(.JSAOF,JS%NAM) ;We want the name field
	JFNS%			;Get the name
	PUSHJ	SREG,CVT76	;Convert atom buffer to sixbit
	MOVE	VREG,SIXATM	;[2445] Get the SIXBIT
	MOVEM	VREG,CHNNAM(P2)	;Store in channel table

	POPJ	SREG,		;Return
	SUBTTL	CVT76 - Convert ASCII to SIXBIT
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine converts the 7 bit ASCII string in the atom buffer
;	to SIXBIT.  The conversion stops when 6*ATM6SZ characters have
;	been processed or when a null is found in the atom buffer.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,CVT76
;
; INPUT PARAMETERS:
;
;	None.
;
; IMPLICIT INPUTS:
;
;	ATMBUF		The atom buffer.
;
; OUTPUT PARAMETERS:
;
;	None.
;
; IMPLICIT OUTPUTS:
;
;	SIXATM		The atom buffer converted to sixbit and padded
;			with nulls.
;
; FUNCTION VALUE:
;
;	Number of words used in SIXATM.
;
; SIDE EFFECTS:
;
;	None.
;
;--


;[2445] Routine rewritten to convert more that six characters

CVT76:	SETZM	SIXATM		;Clear out first word for BLT
	MOVE	T1,[XWD SIXATM,SIXATM+1] ;Source,,destination
	BLT	T1,SIXATM+ATM6SZ-1 ;Zero out block

	MOVE	T1,[POINT 7,ATMBUF] ;7 bit string comes from the atom buffer
	MOVE	T2,[POINT 6,SIXATM] ;6 bits string goes into SIXATM
	MOVEI	T4,6*ATM6SZ	;Get number of characters to process

C76LP:	ILDB	T3,T1		;Get a seven bit character
	JUMPE	T3,C76RET	;Return if null encountered
	CAIL	T3,140		;Is character lowercase?
	 SUBI	T3,40		;Yes--Make it uppercase
	SUBI	T3," "-' '	;Convert 7 bit to sixbit
	IDPB	T3,T2		;Store sixbit character
	SOJG	T4,C76LP	;Process up to 6 characters

C76RET:	MOVEI	VREG,6*ATM6SZ+5	;Get ready ...
	SUB	VREG,T4		;     ... to find ...
	IDIVI	VREG,6		;	    ... Number of words used in SIXATM
	POPJ	SREG,		;Return
	SUBTTL	SCAN20 -- Scan a TOPS-20 Command Line

	;**********************************************************************
	;
	; SCAN20 -- scan and process a TOPS-20 compiler command line.
	;
	;**********************************************************************


SCAN20:
	TRACE	<SCAN20:>
	PUSH	SREG,P1		;Save P1
	PUSH	SREG,P2		;Save P2
	PUSH	SREG,P3		;Save P3
	PUSH	SREG,P4		;Save P4
	PUSH	SREG,P5		;Save P5
	PUSH	SREG,P6		;Save P6
	PUSH	SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
	PUSH	SREG,OLDSTK	;Save old "old stack pointer"

	MOVEM	SREG,OLDSTK	;Save stack pointer so we can abort

	MOVEI	T1,REPARSE	;Get address of code to handle a reparse
	HRRM	T1,STATE+.CMFLG	;Store in state block

	JRST	GETCOMM
REPARSE:
	TRACE	<REPARSE>
	MOVE	SREG,OLDSTK	;Restore the stack pointer

	SKIPL	T1,RELFIL	;Get JFN of object file (-1 means no JFN)
	 RLJFN%			;Release JFN
	ERJMP	MONERR

	SKIPL	T1,LSTFIL	;Get JFN of list file (-1 means no JFN)
	RLJFN%			;Release JFN
	ERJMP	MONERR

	SKIPGE	T5,FORIDX	;Get index to JFN of last source file
	 JRST	GETCOMM		;No source file JFN's
RL:	MOVE	T1,FORFIL(T5)	;Get JFN of next source file
	RLJFN%			;Release JFN
	ERJMP	MONERR
	SOJGE	T5,RL		;Loop to release rest of source file JFN's

GETCOMM:
	TRACE	<GETCOMMAND>
	PUSHJ	SREG,INIT	;Clear flags
	SETOM	LSTFIL		;Clear JFN of list file
	SETOM	RELFIL		;Clear JFN of object file
	SETOM	FORIDX		;No source files have JFN's
	SETZM	LSTTYP		;Throw away typescript from /LIST:
	SETZM	OPTECHO		;Don't echo options from SWITCH.INI
	SETZM	NOPTION		;/NOOPTION has not been seen--read SWITCH.INI
	SETZM	OPTION		;No option string has been given
	SETZM	LKAHD		;[2220] Next field not scanned yet
	SETZM	ECUSED		;[2343] No entries on table of /EXT:COMMON

	SETZM	ECTAB		;[2343] Clear first word of /EXT:COMMON table
	MOVE	T1,[XWD	ECTAB,ECTAB+1]
	BLT	T1,ECTAB+2*ECTABL-1 ;[2343] Clear rest of table

	SETZM	ECHASH		;[2343] Clear first word of /EXT:COM hash table
	MOVE	T1,[XWD	ECHASH,ECHASH+1]
	BLT	T1,ECHASH+ECHSHL-1 ;[2343] Clear rest of table

	MOVX	T1,GJ%OLD!GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags for source file

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device for source file

	SETZM	CJFNBK+.GJNAM	;Set default name for source file

	MOVEI	T1,FOREXT	;Setup pointer to table of default extensions
	MOVEM	T1,DEFEXT	;for source file

	HRROI	T1,[ASCIZ \FTNCMD \] ;Get pointer to prefix of error messages
	MOVEM	T1,ERRPFX	;Store error message prefix

	MOVEI	T1,STA1		;[2220] Setup follow set for the /EXTEND
	MOVEM	T1,FOLLOW	;[2220] switch while in STATE1

	MOVEI	T2,KEYWD	;[2220] Look for a command or a filespec
	PUSHJ	SREG,ECMD	;[2220] Do COMND% JSYS
	 JRST	RET.EOF		;Got end of file, so return
	 JRST	IMPRER		;[2417] Nothing found, see if we can improve
				;[2417] on the monitor error message

	CAIN	T3,CMFIL0	;[2220] Was a filename found?
	 JRST	GOTFIL		;[2220] Yes--process a compile command

	CAIN	T3,CMSWI0	;[2220] Was a switch found?
	 JRST	GOTSWI		;[2220] Yes--process a compile command

	HRRZ	T2,(T2)		;[2220] Get action code
	JRST	(T2)		;[2220] Call routine to process command


IMPRER:	MOVX	T1,.FHSLF	;[2417] This process's last error
	GETER%			;[2417] Get last error in T2
	HRRZ	T2,T2		;[2417] Throw away fork handle

	CAIE	T2,NPXNOM	;[2417] "Does not match switch or keyword"
	 JRST	USRERR		;[2417] Not that error--use monitor message

	HRROI	T1,[ASCIZ \Does not match switch or keyword, or file not found\] ;[2417]
	JRST	SEMERR		;[2417] Use better error message
.EXIT:
	TRACE	<.EXIT>

	HRROI	T1,[ASCIZ \FTNCMD EXIT command must be confirmed -- \] ;[2421]
	MOVEM	T1,ERRPFX	;[2421] Store error message prefix

	MOVEI	T2,CONFIRM	;Wait for confirmation
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HALTF%			;All done
	JRST	RET.OK		;[1611] Continue the compiler
.HELP:				;[1611] Routine added
	TRACE	<.HELP>

	HRROI	T1,[ASCIZ \FTNCMD HELP command must be confirmed -- \] ;[2421]
	MOVEM	T1,ERRPFX	;[2421] Store error message prefix

	MOVEI	T2,CONFIRM	;Wait for confirmation
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	MOVX	T1,GJ%OLD+GJ%SHT ;Try logical HLP:
	HRROI	T2,[ASCIZ \HLP:FORTRA.HLP\]
	GTJFN%
	 TRNA			;Failure return, try next source
	  JRST	HLPOPN		;Success return, Open the file

	MOVX	T1,GJ%OLD+GJ%SHT+GJ%PHY	;Try physical HLP:
	HRROI	T2,[ASCIZ \HLP:FORTRA.HLP\]
	GTJFN%
	 TRNA			;Failure return, try next source
	  JRST	HLPOPN		;Success return, Open the file

	MOVX	T1,GJ%OLD+GJ%SHT ;Try logical SYS:
	HRROI	T2,[ASCIZ \SYS:FORTRA.HLP\]
	GTJFN%
	 TRNA			;Failure return, try next source
	  JRST	HLPOPN		;Success return, Open the file

	MOVX	T1,GJ%OLD+GJ%SHT+GJ%PHY	;Try physical SYS:
	HRROI	T2,[ASCIZ \SYS:FORTRA.HLP\]
	GTJFN%
	 JRST	HLPERR		;Failure return, Cannot open the file

HLPOPN:	HRRZ	T5,T1		;Save JFN of help file
	MOVX	T2,FLD(7,OF%BSZ)+OF%RD ;Read the file
	OPENF%
	 JRST	HLPERR		;Failure return, tell user

HLPLP:	MOVE	T1,T5		;Get JFN of help file
	HRROI	T2,BUFF		;Area in which to put string
	MOVNI	T3,BUFSIZ*5	;Size of string buffer
	SIN
	ERJMP	HLPEOF		;Failure, maybe EOF

	SETZ	T3,		;Need a zero byte
	IDPB	T3,T2		;Mark end of buffer with zero byte
	HRROI	T1,BUFF		;Point to string in buff
	PSOUT%
	JRST	HLPLP		;Type rest of help file

HLPEOF:	
	SETZ	T3,		;Need a zero byte
	IDPB	T3,T2		;Mark end of buffer with zero byte
	HRROI	T1,BUFF		;Point to string in buff
	PSOUT%

	MOVE	T1,T5		;Get JFN of help file
	CLOSF%			;Close file
	 NOOP			;Not likely
	JRST	RET.OK		;Return to caller

HLPERR:	HRROI	T1,[ASCIZ \%FTNCMD Can't open help file;  I'm sorry but I can't help you.
\]
	PSOUT%
	JRST	RET.OK		;Nothing really bad occured, take normal return
;Register Usage:
;	P1	JFN of file to run
;	P2	Offset to be added to its start address
;	P3	Program name in SIXBIT

.RUN:	TRACE	<.RUN>
	MOVEI	T2,[FLDDB. (.CMNOI,,<POINT 7,[ASCIZ \program\]>)] ;[2220] 
	PUSHJ	SREG,CMD	;[2220] Look for guide word
	 JRST	USRERR		;[2220] EOF return--command not completed

	HRROI	T1,[ASCIZ \FTNCMD Filespec required in RUN command -- \] ;[2421]
	MOVEM	T1,ERRPFX	;[2421] Store error message prefix

	MOVX	T1,GJ%OLD!GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN	;Set default flags

	HRROI	T1,[ASCIZ \SYS\]
	MOVEM	T1,CJFNBK+.GJDEV	;Set default device

	SETZM	CJFNBK+.GJNAM		;Clear default name

	MOVEI	T1,EXEEXT	;[2220] Get pointer to table of default
	MOVEM	T1,DEFEXT	;[2220] extensions for the file to be run

	MOVEI	T2,RUNFIL	;Look for a filename
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	MOVE	P1,T2		;Save JFN of file to run

	SETZ	P2,		;Assume an offset of zero

	HRROI	T1,[ASCIZ \FTNCMD \] ;[2421] Get pointer to error prefix
	MOVEM	T1,ERRPFX	;[2421] Store error message prefix

	MOVEI	T2,OFFSET	;Look for /OFFSET or confirmation
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,CONFIRM	;Was command confirmed?
	 JRST	DORUN		;Yes--Run the program

	MOVEI	P2,1		;Assume an offset of 1

	MOVEI	T2,RUNNUM	;Look for a number or confirmation
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,CONFIRM	;Was command confirmed?
	 JRST	DORUN		;Yes--Run the program

	MOVE	P2,T2		;Get new value of offset

	MOVEI	T2,CONFIRM	;Wait for confirmation
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

DORUN:	JUMPL	P2,BIGOFF	;Is the offset too small?
	CAILE	P2,1		;Is the offset too big?
	 JRST	BIGOFF		;Yes--Complain

	;Get name of program in SIXBIT

	HRROI	T1,ATMBUF	;Get string in atom buffer
	MOVE	T2,P1		;Get the JFN
	MOVX	T3,FLD(.JSAOF,JS%NAM) ;We want the name field
	JFNS%			;Get the name
	PUSHJ	SREG,CVT76	;Convert atom buffer to sixbit
	MOVE	P3,SIXATM	;[2445] Store the sixbit program name

	;Get the directory of the program file if the file is on disk

	MOVE	T1,P1		;Get JFN of file to run
	DVCHR%
	TXNN	T2,DV%MDD	;Does device have multiple directories?
	 JRST	NOTSYS		;No, not disk, so program has no system name
	HRROI	T1,ATMBUF	;Get string in atom buffer
	MOVE	T2,P1		;Get the JFN
	MOVX	T3,FLD(.JSAOF,JS%DIR) ;We want the directory of file
	JFNS%			;Get the directory

	;Compare the directory of the program with the system's directory
	; of SUBSYS.  If the directories are equal, then assume that this
	; program has comes from PS:<SUBSYS>.

	MOVEI	T1,7		;Number of characters in ASCIZ 'SUBSYS'
	MOVE	T2,[POINT 7,[ASCIZ \SUBSYS\]]
	MOVEI	T4,7		;May not have 7 characters, but who cares
	MOVE	T5,[POINT 7,ATMBUF] ;Directory of file
	EXTEND	T1,[CMPSN]	;Is the directory of the file SUBSYS?
	 SKIPA	T1,P3		;Yes--System name is name of program
NOTSYS:   MOVE	T1,[SIXBIT \(PRIV)\] ;System name is "(PRIV)"
	MOVE	T2,P3		;Private name is name of file
	SETSN%			;Tell the monitor
	 NOOP			;Error return is never taken

	MOVEI	T1,.FHSLF	;This process
	SETZ	T2,		;Allow UUOs
	SCVEC%

	HRRM	P1,RUNJFN	;[1611] Store JFN of file to run
	HRLZM	P2,RUNOFF	;[1611] Store the start address offset
	MOVE	P3,.JBERR	;[1611] Get this fork's error count
	MOVEM	P3,RUNERR	;[1611] Store error count for run code
	SKIPE	.JBERR		;[1611] Is .JBERR zero?
	 JRST	NOFIX		;[1611] Yes--Don't need to patch run code
	HRLI	T1,(NOOP)	;[1611] Get a No-op instruction
	MOVEM	T1,RUNSTO	;[1611] Don't save old value of .JBERR
NOFIX:	MOVE	17,[XWD RUNCOD,0] ;[1611] Load Run code into the registers
	BLT	17,15		;[1611] Move the code into the registers
	JRST	4		;[1611] .JBERR was zero, just do the run code


BIGOFF:	HRROI	T1,[ASCIZ \Value of /OFFSET: can not be greater than 1\] ;[2415]
	JRST	SEMERR		;[2415] Give error message

RUNFIL:
	FLDDB.	(.CMFIL,CM%SDH,,<filespec of .EXE file to run>)

RUNNUM:
	FLDDB.	(.CMNUM,CM%SDH,^D8,<offset from start address, must be 0 or 1>,1,CONFIRM)
;Register usage:
;	P1	JFN of indirect command file
;	P2	Past value of echo switch

.TAKE:
	TRACE	<.TAKE>

	MOVEI	T2,[FLDDB. (.CMNOI,,<POINT 7,[ASCIZ \commands from\]>)]	;[2220]
	PUSHJ	SREG,CMD	;[2220] Look for guide word
	 JRST	USRERR		;[2220] EOF return--command not completed

	HRROI	T1,[ASCIZ \FTNCMD Filespec required in TAKE command -- \] ;[2421]
	MOVEM	T1,ERRPFX	;[2421] Store error message prefix

	MOVX	T1,GJ%OLD+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	SETZ	CJFNBK+.GJNAM	;Set default name

	MOVEI	T1,CMDEXT	;[2220] Get pointer to table of default
	MOVEM	T1,DEFEXT	;[2220] extensions to use for take file

	MOVEI	T2,TAKEFIL	;Look for a filename
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRRZ	P1,T2		;Save JFN of indirect command file
	MOVE	P2,ECHOFLG	;[1645] Assume current value of the echo switch

	HRROI	T1,[ASCIZ \FTNCMD \] ;[2421] Get pointer to error prefix
	MOVEM	T1,ERRPFX	;[2421] Store error message prefix

	MOVEI	T2,ECHO		;Look for echo switch or confirmation
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,CONFIRM	;Was command confirmed?
	 JRST	TAKLVL		;[1673] Yes--Check that this /TAKE is not
				; too many levels deep

	HRRZ	P2,(T2)		;[1645] /ECHO or /NOECHO was given--get new
				; value of ECHOFLG from table entry

	MOVEI	T2,CONFIRM	;Wait for confirmation
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

TAKLVL:	AOS	T1,TDEPTH	;About to nest another level
	CAIG	T1,^D10		;Have we nested more than 10 levels deep?
	 JRST	READF		;[1673] No--It is OK to do the /TAKE
	SOS	TDEPTH		;[1673] Since we didn't really nest

	HRROI	T1,[ASCIZ \%FTNCMD /TAKE: commands may not be nested more than ten levels deep
%FTNCMD /TAKE:\]		;[1673]
	PSOUT%			;[1673]
	MOVEI	T1,.PRIOU	;[1673] Output goes to terminal
	HRRZ	T2,P1		;[1673] Get optional JFN of source
	MOVE	T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF]	;[1673]
	JFNS%			;[1673]
	HRROI	T1,[ASCIZ \ is ignored
\]				;[1673]
	PSOUT%			;[1673]
	JRST	RET.OK		;[1673] Not an error, since we can recover


READF:	EXCH	P2,ECHOFLG	;Exchange new and old values of echo flag

	MOVE	T1,P1		;JFN of take file
	MOVX	T2,FLD(7,OF%BSZ)+.GSNRM+OF%RD ;Ascii Chars, normal read access
	OPENF%
	ERJMP	TAKERR

TAKLOOP:

	MOVE	T1,P1		;Get JFN of /TAKE file
	HRLI	T1,FRMTAK	;The input is coming from a take file
	HRL	T2,P1		;Input from take file
	HRRI	T2,.NULIO	;Throw away output
	HRROI	T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
	PUSHJ	SREG,CMDINI	;Init COMND% JSYS and its state block

	PUSHJ	SREG,SCAN20
	JUMPE	VREG,TAKLOOP	;If no error and not EOF, then loop


	MOVEM	P2,ECHOFLG	;Restore echo flag to its old value
	SOS	TDEPTH		;We've come up one level of nesting
	HRRZ	T1,P1		;Get JFN of indirect command file
	CLOSF%			;Close file
	 JRST	MONERR		;Failure return

	JUMPL	VREG,RET.OK	;If end of file, then do a normal return
	JRST	RET.ERR		;Otherwise, pass back that we got an error

TAKERR:	HRROI	T1,[ASCIZ \?FTNCMD Cannot open /TAKE file \]
	PSOUT%
	MOVEI	T1,.PRIOU	;Output goes to terminal
	MOVE	T2,P1		;JFN of /TAKE file
	MOVE	T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF]
	JFNS%
	HRROI	T1,[ASCIZ \ -- \]
	PSOUT%
	MOVX	T1,.PRIOU	;Primary output stream
	HRLOI	T2,.FHSLF	;This process' most recent error
	SETZ	T3,		;Write all of message
	ERSTR%
	 JRST	UNKERR		;Unknown error return
	 JRST	BADCALL		;Bad call to ERSTR% return
	HRROI	T1,[ASCIZ \
\]
	PSOUT%
	JRST	RET.ERR		;Take the error return

TAKEFILE:
	FLDDB.	(.CMFIL,CM%SDH,,<filespec of indirect command file>)
.COMPILE:			;[2220] This rouitne rewritten
	SKIPA	T1,[POINT 7,[ASCIZ \FTNCMD Filespec or switch should follow COMPILE command -- \]] ;[2421]
STATE1:	 HRROI	T1,[ASCIZ \FTNCMD \] ;Get pointer to prefix of error messages
	MOVEM	T1,ERRPFX	;Store error message prefix

	MOVX	T1,GJ%OLD!GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags for the source file

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device for the source file

	SETZM	CJFNBK+.GJNAM	;No default name for the source file

	MOVEI	T1,FOREXT	;Setup pointer to table of default extensions
	MOVEM	T1,DEFEXT	;for source file

	MOVEI	T2,STA1		;Look for a filespec or switch
	MOVEM	T2,FOLLOW	;Setup follow set for the /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,S1FILE	;Did we get a filespec?
	 JRST	GOTFIL		;Yes--store filename

	;Must have got switch
GOTSWI:	HRROI	T1,[ASCIZ \FTNCMD \] ;Get pointer to prefix of error messages
	MOVEM	T1,ERRPFX	;Store error message prefix
	HRRZ	T2,(T2)		;Get action code from selected switch
	PUSHJ	SREG,@(T2)	;Call the routine to process the switch
	JRST	STATE1

GOTFIL:	AOS	T1,FORIDX	;Get index to use to store new source file JFN
	CAIL	T1,MAXFILES	;Does index still fit in table
	 JRST	TOOMANY		;No--give an error message
	HRRZM	T2,FORFIL(T1)	;Store JFN of source file

STATE2:
	HRROI	T4,[ASCIZ \FTNCMD "+", switch, or confirm required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,STA2		;Look for a "+", switch, or confirm
	MOVEM	T2,FOLLOW	;Setup follow set for the /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,S2PLUS	;Was a "+" found?
	 JRST	STATE1		;Yes--goto state 1

	CAIN	T3,CONFIRM	;Was command confirmed?
	 JRST	STATE3		;Yes--command is done

	;Must have got a switch
	HRROI	T1,[ASCIZ \FTNCMD \] ;Get pointer to prefix of error messages
	MOVEM	T1,ERRPFX	;Store error message prefix
	HRRZ	T2,(T2)		;Get action code from selected switch
	PUSHJ	SREG,@(T2)	;Call the routine to process the switch
	JRST	STATE2		;Stay in state 2


STATE3:	PUSHJ	SREG,GETDEF	;Get the default filename for /LIST and /OBJECT
	PUSHJ	SREG,DOCOMPILE	;Compile the program
	JRST	RET.OK		;Return from SCAN20


TOOMANY:
	HRROI	T1,[ASCIZ \Too many source files\] ;[2415]
	JRST	SEMERR		;[2415] Give error message

STA1:
S1FILE:	FLDDB. (.CMFIL,CM%SDH,,<filespec of source file>,,S1SWIT)
S1SWIT:	FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>)

STA2:
S2PLUS:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \+\]>,<a "+" followed by filespec of the next source file>,,S2SWIT) ;[2263]
S2SWIT:	FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>,,CONFIRM)
	SUBTTL	GETDEF - Setup default filename for list and object files
;++					[2220] Create this routine
; FUNCTIONAL DESCRIPTION:
;
;	This routine stores the default name for the listing and object
;	files into DEFFIL.  The default name is an ASCIZ string, and is
;	name of the last source file, or the string "FORTRAN-OUTPUT" if
;	no source files have been scanned or if the last source files
;	didn't have a name.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,GETDEF
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FORIDX		The index to the last source file JFN
;	FORFIL		Table of source file JFNs
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	DEFFIL		The ASCIZ default name string
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--




GETDEF:	HRROI	T1,DEFFIL	;Get pointer to where to store default file
	MOVE	T2,FORIDX	;Get index to last source file
	JUMPL	T2,NUL		;Negative index means no source files yet
	MOVE	T2,FORFIL(T2)	;Get JFN of last source file
	MOVX	T3,FLD(.JSAOF,JS%NAM) ;Write only the name of the source file
	JFNS%			;Convert source JFN to a string
	LDB	T1,[POINT 7,DEFFIL,6] ;Get first character of file name
	JUMPN	T1,GDRET	;Everything is fine if filename isn't null
NUL:	MOVE	T1,[XWD [ASCIZ \FORTRAN-OUTPUT\],DEFFIL]
	BLT	T1,DEFFIL+3-1	;Move in the 3 word default string
GDRET:	POPJ	SREG,		;Return
	SUBTTL	CLRFLG - Clear bits in a flag word
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine is used to clear some number of bits in a flag
;	word.  Generally, this routine is called because it was given as
;	the routine to process a switch in the COMSW data structure.
;
; CALLING SEQUENCE:
;
;	PUSPJ	SREG,CLRFLG
;
; INPUT PARAMETERS:
;
;	T2	Points to a vector of arguments, where:
;	1(T2)	is a mask of what bits in a flag need to be turned off;
;	2(T2)	is an index into the ONFLG/OFFFLG vextors which indicate
;		which flag word is to have bits turned off.
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ONFLG	Will have the mashed bits turned off in the entry for
;		the flag word.
;	OFFFLG	Will have the mashed bits turned in in the entry for
;		the flag word.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--




CLRFLG:
	TRACE	<CLRFLG>

	DMOVE	T3,1(T2)	;Get into T3 flag mask
				;Get into T4 index into ONFLG to pick flag word

	ANDCAM	T3,ONFLG(T4)	;Turn off bit that might say that flag is true
	IORM	T3,OFFFLG(T4)	;Turn on bit that says that flag must be false

	POPJ	SREG,		;Get next switch
	SUBTTL	SETFLG - Set bits in a flag word
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine is used to set some number of bits in a flag word.
;	Generally, this routine is called because it was given as the
;	routine to process a switch in the COMSW data structure.
;
; CALLING SEQUENCE:
;
;	PUSPJ	SREG,SETFLG
;
; INPUT PARAMETERS:
;
;	T2	Points to a vector of arguments, where:
;	1(T2)	is a mask of what bits in a flag need to be turned on;
;	2(T2)	is an index into the ONFLG/OFFFLG vextors which indicate
;		which flag word is to have bits turned off.
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ONFLG	Will have the mashed bits turned off in the entry for
;		the flag word.
;	OFFFLG	Will have the mashed bits turned in in the entry for
;		the flag word.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--




SETFLG:
	TRACE	<SETFLG>

	DMOVE	T3,1(T2)	;Get into T3 flag mask
				;Get into T4 index into ONFLG to pick flag word

	IORM	T3,ONFLG(T4)	;Turn on bit that says that flag must be true
	ANDCAM	T3,OFFFLG(T4)	;Turn off bit that might say that flag is false

	POPJ	SREG,		;Get next switch
	SUBTTL	.BUGOUT - Process a /BUGOUT switch
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine is called when a BUGOUT switch is scanned.  This
;	routine scans for an octal mask that becomes the value of the
;	/BUGOUT switch.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,BUGOUT
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ONFLG+$BUGOUT	Will be set to the octal mask
;	OFFFLG+$BUGOUT	Will be set to the complement of the mask
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	An octal number is scanned with the COMND% JSYS
;
;--




.BUGOUT:
	TRACE	<.BUGOUT:>
	MOVEI	T2,[FLDDB.(.CMNUM,CM%SDH,^D8,<octal mask>)] ;Look for a number
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	MOVEM	T2,ONFLG+$BUGOUT  ;Will need to turn on these bits
	SETCAM	T2,OFFFLG+$BUGOUT ;Will need to turn off these bits

	POPJ	SREG,		;Get next switch
	SUBTTL	.DEBUG - Process the /DEBUG switch
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine sets the flag bits to show that a debug switch was
;	seen.  If the switch ends with a colon, either a debug keyword
;	or a list of debug keywords enclosed in parentheses is scanned.
;	Each debug keyword has associated with it a mask which will
;	control which debug bits are set or cleared.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,.DEBUG
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	STATE+.CMFLG	The flags returned by the COMND% JSYS when the
;			/DEBUG switch was scanned.
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ONFLG+$DEBGSW	Set to show which debug bits are to be turned on
;	OFFFLG+$DEBGSW	Set to show which debug bits are to be turned off
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	A switch value is scanned with the COMND% JSYS, if the switch
;	ended with a colon.
;
;--




.DEBUG:
	TRACE	<.DEBUG:>

	MOVE	T1,STATE+.CMFLG	;[2220] Get flags returnd by the COMND% JSYS
	TXNE	T1,CM%SWT	;[2220] Was switch terminated with a colon?
	 JRST	DCOLON		;[2220] Yes--get keyword or list of keywords

	MOVEI	T1,DB.ALL	  ;[1603] Use default of /DEBUG:ALL
	IORM	T1,ONFLG+$DEBGSW  ;[1603] Turn on flags that must be on
	ANDCAM	T1,OFFFLG+$DEBGSW ;[1603] Turn off flags that must be off
	POPJ	SREG,		  ;Return


DCOLON:	MOVEI	T2,DB.K1	;Look for a keyword or "("
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,DB.K1	;Was a keyword found?
	 PJRST	PRSK1		;Yes--go process keyword

	;Must have got a open parenthesis

GETK1:
	MOVEI	T2,DB.K2	;Look for only a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSK1	;Process this keyword

	HRROI	T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \FTNCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA	;Was a comma found?
	 JRST	GETK1		;Yes--get next keyword
	POPJ	SREG,		;Must have got close paren--return

PRSK1:	HRRZ	T2,(T2)		;Get keyword mask
	TRNE	T2,400000	;Was this a NO form of a keyword
	 JRST	PRNO		;Yes--Process no keyword
	IORM	T2,ONFLG+$DEBGSW  ;Turn on flags that must be on
	ANDCAM	T2,OFFFLG+$DEBGSW ;Turn off flags that must be off
	POPJ	SREG,		  ;Return

PRNO:	MOVE	T2,ONFLG+$DEBGSW  ;Turn off any on bits that were not selected
	SETCAM	T2,OFFFLG+$DEBGSW ;Turn off bits that must be off
	POPJ	SREG,		  ;Return
	SUBTTL	.ECHOOP - Process the /ECHO-OPTION switch
;++
; FUNCTIONAL DESCRIPTION:
;
;	Process the /ECHO-OPTION switch by setting the word OPTECHO.
;	This switch does go through the general bookkeeping required for
;	other switch words because this switch word is used while
;	processing SWITCH.INI, and SWITCH.INI cannot turn off this
;	switch once it is set.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,.ECHOOP
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	OPTECHO		Set to ones.  In this state, the flag word says
;			that the selected lines from SWITCH.INI are to
;			be echoed.
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--




.ECHOOP:
	TRACE	<.ECHO-OPTION>

	SETOM	OPTECHO		;Echo the switches read from SWITCH.INI

	POPJ	SREG,		;Get next switch
	SUBTTL	.EXTEND - Process the /EXTEND switch
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine sets the flag bits to show that a extend switch was
;	seen.  If the switch ends with a colon, either a extend keyword
;	or a list of extend keywords enclosed in parentheses is scanned.
;	Each extend keyword has associated with it a mask which will
;	control which extend bits are set or cleared.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,.EXTEND
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	STATE+.CMFLG	The flags returned by the COMND% JSYS when the
;			/EXTEND switch was scanned.
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ONFLG+$F2	Set to show that a /EXTEND switch has been seen
;	OFFFLG+$F2	Set to show that a /NOEXTEND switch has not been seen
;	ONFLG+$BIGARY	Set to new value of BIGARY
;	OFFFLG+$BIGARY	Set to complement of new value of BIGARY
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	A switch value is scanned with the COMND% JSYS, if the switch
;	ended with a colon.
;
;--




.EXTEND:			;[2220] This routine rewritten by RVM
	TRACE	<.EXTEND:>

	MOVX	T3,SW.EXT	;Get flag bit
	IORM	T3,ONFLG+$F2	;Turn on bit that says that flag must be true
	ANDCAM	T3,OFFFLG+$F2	;Turn off bit that might say that flag is false

	MOVE	T1,STATE+.CMFLG	;[2347] Get flags returnd by the COMND% JSYS
	TXNE	T1,CM%SWT	;[2347] Was switch terminated with a colon?
	 JRST	EXTARG		;[2347] Yes--Process /EXTEND arguments

	MOVX	T3,DEFBIGARY	;[2470] Get default value of BIGARY
	MOVEM	T3,ONFLG+$BIGARY  ;Will need to turn on these bits
	SETCAM	T3,OFFFLG+$BIGARY ;Will need to turn off these bits

	MOVX	T2,PSLARGE	;[2347] Get New Default Psect for COMMON blocks
	MOVEM	T2,ONFLG+$DFCMPS  ;[2347] Store new DeFault CoMmon block PSect
	SETCAM	T2,OFFFLG+$DFCMPS ;[2347] Turn off bits that must be off

	MOVX	T3,SW.EXC	;[2442] Get flag bit for /EXTEND:CODE
	IORM	T3,OFFFLG+$F2	;[2442] Turn on bit that says flag is false
	ANDCAM	T3,ONFLG+$F2	;[2442] Turn off bit that says flag is true

	POPJ	SREG,		;[2347] Return

EXTARG:	MOVEI	T2,ET.K1	;Look for a keyword or "("
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,ET.K1	;Was a keyword found?
	 PJRST	PRSK2		;Yes--go process keyword

	;Must have got an open parenthesis
GETK2:
	MOVEI	T5,COMMA	;Follow set of list of keyword in list
	MOVEM	T5,FOLLOW	;is a comma or ")"

	MOVEI	T2,ET.K2	;Look for only a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSK2	;Process this keyword

	HRROI	T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \FTNCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA	;Was a comma found?
	 JRST	GETK2		;Yes--get next keyword
	POPJ	SREG,		;Must have got a parenthesis--return

PRSK2:
	HRRZ	T2,(T2)		;Get address of code to process keyword from
				;the entry in the keyword table
	JRST	(T2)		;Go to process the keyword


.CODE:	MOVX	T3,SW.EXC	;[2442] Get flag bit for /EXTEND:CODE
	IORM	T3,ONFLG+$F2	;[2442] Turn on bit that says flag is true
	ANDCAM	T3,OFFFLG+$F2	;[2442] Turn off bit that says flag is false
	POPJ	SREG,		;[2442] Return


.DATA:	PUSHJ	SREG,CHKCOLON	;See if colon flag is set
	 JRST	DATDEF		;No colon--use default value
	MOVEI	T2,[FLDDB.(.CMNUM,CM%SDH,^D10,
<decimal number which is the minimum size of data objects in .LARG.>,10000)]
	PUSHJ	SREG,CMD	;Look for a decimal number
	 JRST	USRERR		;EOF return--command not completed
	TRNA			;Always skip
DATDEF:	 MOVX	T2,DEFBIGARY	;[2470] Get default value
	MOVEM	T2,ONFLG+$BIGARY  ;Will need to turn on these bits
	SETCAM	T2,OFFFLG+$BIGARY ;Will need to turn off these bits
	POPJ	SREG,


.NOCODE:MOVX	T3,SW.EXC	;[2442] Get flag bit for /EXTEND:CODE
	IORM	T3,OFFFLG+$F2	;[2442] Turn on bit that says flag is false
	ANDCAM	T3,ONFLG+$F2	;[2442] Turn off bit that says flag is true
	POPJ	SREG,		;[2442] Return


.NODATA:
	MOVE	T2,DEFFLG+$BIGARY ;[2470] BIGARY is infinity for 30 bit addrs
	MOVEM	T2,ONFLG+$BIGARY  ;Will need to turn on these bits
	SETCAM	T2,OFFFLG+$BIGARY ;Will need to turn off these bits
	POPJ	SREG,		;Return
	SUBTTL	.COMMON - Process COMMON keyword of /EXTEND
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine either sets the default psect for all COMMON
;	blocks or sets the psect for individually named COMMON blocks.
;	If the keyword does not end in a colon, then the default
;	common block for all psects is set to PSLARGE.  If the keyword
;	ends in a colon, then the keyword must be followed by either a
;	COMMON block name or a list of COMMON blocks inclosed in
;	parenthesis.  In this case, the named COMMON block(s) are
;	explicitly put in PSLARGE, overriding for the named block(s)
;	the default psect, and the default psect for COMMON blocks is
;	set to PSDATA.
;
;	This routine uses the routine FNDCOMMON to construct a table
;	that contains the COMMON blocks named in either /EXTEND:COMMON
;	or /EXTEND:NOCOMMON.  This table is then used during COMMSTA
;	to assign those COMMON blocks to their proper psects.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,.COMMON
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FOLLOW		Follow set of /EXTEND, used by CHKCOLON
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ECTAB		Table of COMMON blocks named in /EXTEND:[NO]COMMON
;	ONFLG+$DFCMPS	Set to show what the new value of DFCMPS should be
;	OFFFLG+$DFCMPS	Set to show what the new value of DFCMPS should be
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	A switch value is scanned with the COMND% JSYS, if the keyword
;	ends with a colon.  CHKCOLON may scan something in the FOLLOW set
;	while checking for the trailing colon.
;
;--




;[2343] New routine

.COMMON:
	PUSHJ	SREG,CHKCOLON	;See if colon flag is set
	 PJRST	COMLRG		;No colon follows keyword

	MOVEI	T2,EC.K1	;Look for a COMMON block name or "("
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,EC.K3	;Was a COMMON block name found?
	 PJRST	PRSK4A		;[2416] Yes--go process COMMON block name

	;Must have got a open parenthesis

	PUSHJ	SREG,COMSML	;[2416] Set default psect for COMMON to small
GETK4:	MOVEI	T2,EC.K2	;Look for only a COMMON block name
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSK4	;Process this COMMON block name

	HRROI	T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \FTNCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA	;Was a comma found?
	 JRST	GETK4		;Yes--get next COMMON block name
	POPJ	SREG,		;Must have got close paren--return

PRSK4A:	PUSHJ	SREG,COMSML	;[2416] Set default psect for COMMON to small
PRSK4:	PUSH	SREG,P1		;[2465] Save P1  Save
	PUSH	SREG,P2		;[2465] Save P2	   Registers
	PUSH	SREG,P3		;[2465] Save P3		Smashed
	PUSH	SREG,P4		;[2465] Save P4		   By
	PUSH	SREG,P5		;[2465] Save P5		      FNDCOM
	PUSH	SREG,P6		;[2465] Save P6

	PUSHJ	SREG,CVTCOM	;Convert COMMON block name to SIXBIT


	PUSH	SREG,VREG	;Pass the name as the first argument
	PUSH	SREG,[TRUE]	;True--Insert entry if not in table
	PUSHJ	SREG,FNDCOM	;Find the common block entry
	ADJSP	SREG,-2		;Pop arguments off stack

	POP	SREG,P6		;[2465] Restore P6  Restore
	POP	SREG,P5		;[2465] Restore P5	Regs
	POP	SREG,P4		;[2465] Restore P4	  Used
	POP	SREG,P3		;[2465] Restore P3	    by
	POP	SREG,P2		;[2465] Restore P2	      FNDCOM
	POP	SREG,P1		;[2465] Restore P1

	JUMPE	VREG,MANYCM	;Was there too many COMMON blocks?

	HLRZ	T1,CMDSOU	;Get source from which this switch came
	CAIN	T1,FRMSWI	;Did this switch come from SWITCH.INI
	 SKIPA	T2,ECPSE2(VREG)	;Yes--Store into SWITCH.INI psect
	  MOVE	T2,ECPSECT(VREG);No--Store into command line field
    	MOVX	T3,PSLARGE	;Get psect for this entry
	DPB	T3,T2		;Store psect into entry for COMMON block
	POPJ	SREG,		;Return


COMLRG:	MOVX	T2,PSLARGE	;Get New Default Psect for COMMON blocks
	MOVEM	T2,ONFLG+$DFCMPS  ;Store new DeFault CoMmon block PSect
	SETCAM	T2,OFFFLG+$DFCMPS ;Turn off bits that must be off
	POPJ	SREG,		;Return

MANYCM:	HRROI	T1,[ASCIZ \Too many COMMON block names in /EXTEND\] ;[2415]
	JRST	SEMERR		;[2415] Give error message
	SUBTTL	.NOCOMMON - Process NOCOMMON keyword of /EXTEND
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine either sets the default psect for all COMMON
;	blocks or sets the psect for individually named COMMON blocks.
;	If the keyword does not end in a colon, then the default
;	common block for all psects is set to PSDATA.  If the keyword
;	ends in a colon, then the keyword must be followed by either a
;	COMMON block name or a list of COMMON blocks inclosed in
;	parenthesis.  In this case, the named COMMON block(s) are
;	explicitly put in PSDATA, overriding for the named block(s)
;	the default psect, and the default psect for COMMON blocks is
;	set to PSLARGE.
;
;	This routine uses the routine FNDCOMMON to construct a table
;	that contains the COMMON blocks named in either /EXTEND:COMMON
;	or /EXTEND:NOCOMMON.  This table is then used during COMMSTA
;	to assign those COMMON blocks to their proper psects.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,.NOCOMMON
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FOLLOW		Follow set of /EXTEND, used by CHKCOLON
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ECTAB		Table of COMMON blocks named in /EXTEND:[NO]COMMON
;	ONFLG+$DFCMPS	Set to show what the new value of DFCMPS should be
;	OFFFLG+$DFCMPS	Set to show what the new value of DFCMPS should be
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	A switch value is scanned with the COMND% JSYS, if the keyword
;	ends with a colon.  CHKCOLON may scan something in the FOLLOW set
;	while checking for the trailing colon.
;
;--




;[2343] New routine

.NOCOMMON:
	PUSHJ	SREG,CHKCOLON	;See if colon flag is set
	 JRST	COMSML		;No colon follows keyword

	MOVEI	T2,EC.K1	;Look for a COMMON block name or "("
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,EC.K3	;Was a COMMON block name found?
	 PJRST	PRSK5A		;[2416] Yes--go process COMMON block name

	;Must have got a open parenthesis

	PUSHJ	SREG,COMLRG	;[2416] Set default psect for COMMON to large
GETK5:	MOVEI	T2,EC.K2	;Look for only a COMMON block name
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSK5	;Process this COMMON block name

	HRROI	T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \FTNCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA	;Was a comma found?
	 JRST	GETK5		;Yes--get next COMMON block name
	POPJ	SREG,		;Must have got close paren--return

PRSK5A:	PUSHJ	SREG,COMLRG	;[2416] Set default psect for COMMON to large
PRSK5:	PUSH	SREG,P1		;[2465] Save P1  Save
	PUSH	SREG,P2		;[2465] Save P2	   Registers
	PUSH	SREG,P3		;[2465] Save P3		Smashed
	PUSH	SREG,P4		;[2465] Save P4		   By
	PUSH	SREG,P5		;[2465] Save P5		      FNDCOM
	PUSH	SREG,P6		;[2465] Save P6

	PUSHJ	SREG,CVTCOM	;Convert COMMON block name to SIXBIT

	PUSH	SREG,VREG	;Pass the name as the first argument
	PUSH	SREG,[TRUE]	;True--Insert entry if not in table
	PUSHJ	SREG,FNDCOM	;Find the common block entry
	ADJSP	SREG,-2		;Pop arguments off stack
	POP	SREG,P6		;[2465] Restore P6  Restore
	POP	SREG,P5		;[2465] Restore P5	Regs
	POP	SREG,P4		;[2465] Restore P4	  Used
	POP	SREG,P3		;[2465] Restore P3	    by
	POP	SREG,P2		;[2465] Restore P2	      FNDCOM
	POP	SREG,P1		;[2465] Restore P1

	JUMPE	VREG,MANYCM	;Was there too many COMMON blocks?

	HLRZ	T1,CMDSOU	;Get source from which this switch came
	CAIN	T1,FRMSWI	;Did this switch come from SWITCH.INI
	 SKIPA	T2,ECPSE2(VREG)	;Yes--Store into SWITCH.INI psect
	  MOVE	T2,ECPSECT(VREG);No--Store into command line field
	MOVX	T3,PSDATA	;Get psect for this entry
	DPB	T3,T2		;Store psect into entry for COMMON block
	POPJ	SREG,		;Return


COMSML:	MOVX	T2,PSDATA	;Get New Default Psect for COMMON blocks
	MOVEM	T2,ONFLG+$DFCMPS  ;Store new DeFault CoMmon block PSect
	SETCAM	T2,OFFFLG+$DFCMPS ;Turn off bits that must be off
	POPJ	SREG,		;Return
	SUBTTL	.PSECT - Process PSECT keyword of /EXTEND
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine sets the names of the code and data psects.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,.PSECT
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	FOLLOW		Follow set of /EXTEND
;	DEFHIN		Default value for HINAME (the code psect)
;	DEFLON		Default value for LONAME (the data psect)
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ONHIN		Set to show what the new value of HINAME should be
;	OFFHIN		Set to show what the new value of HINAME should be
;	ONLON		Set to show what the new value of LONAME should be
;	OFFLON		Set to show what the new value of LONAME should be
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	The COMND% jsys will scan the keyword value or stuff in the follow
;	set.
;
;--




;[2445] New routine

.PSECT:
	;Assume that no more of switch is typed, so set length
	;and name info in HINAME and LONAME.

	MOVE	T1,DEFHIN	;Get word count of HINAME
DHNL:	MOVE	T2,DEFHIN(T1)	;Get word of default
	MOVEM	T2,ONHIN(T1)	;Will need to turn on these bits
	SETCAM	T2,OFFHIN(T1)	;Will need to turn off these bits
	SOJGE	T1,DHNL		;Process rest of default high name

	MOVE	T1,DEFLON	;Get word count of LONAME
DLNL:	MOVE	T2,DEFLON(T1)	;Get word of default
	MOVEM	T2,ONLON(T1)	;Will need to turn on these bits
	SETCAM	T2,OFFLON(T1)	;Will need to turn off these bits
	SOJGE	T1,DLNL		;Process rest of default low name


	PUSHJ	SREG,CHKCOLON	;See if colon flag is set
	 POPJ	SREG,		;No colon follows keyword--Return

	SETZ	T1,		;No options follow colon in command
	HRRM	T1,EP.CL+.CMFNP	;so, make sure  chain ends

	MOVEI	T2,EP.DA	;Look for data psect name or ":"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,EP.CL	;Was colon found instead of name
	 JRST	GETCPN		;Yes--go get code psect name

	;Got name of data psect in atom buffer--store it away.

	PUSHJ	SREG,CVT76	;Convert the atom buffer to SIXBIT
	JUMPE	VREG,BADDPS	;Bad data psect name, or bug in TOPS-20

	MOVEM	VREG,ONLON	;Will need to turn on these bits
	SETCAM	VREG,OFFLON	;Will need to turn off these bits
	SOJ	VREG,		;Make count into a good index
SLNL:	MOVE	T2,SIXATM(VREG)	;Get word of SIXBIT psect name
	MOVEM	T2,ONLON+1(VREG) ;Will need to turn on these bits
	SETCAM	T2,OFFLON+1(VREG) ;Will need to turn off these bits
	SOJGE	VREG,SLNL	;Move rest of SIXATM to ONLON, OFFLON

	;Get a colon

	MOVE	T1,FOLLOW	;Get pointer to descriptor blocks of the
	HRRM	T1,EP.CL+.CMFNP	;follow set and build up chain

	MOVEI	T2,EP.CL	;Look for colon or stuff in follow set
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,EP.CL	;Was colon found instead of name
	 JRST	GETCPN		;Yes--go get code psect name

	;We must have got something the the follow set, so tell COMND% JSYS
	;routines that the next field has already been scanned.

	SETOM	LKAHD		;Next field scanned
	POPJ	SREG,		;No more to do here

	;Get name of code psect

GETCPN:	MOVEI	T2,EP.CO	;Look for code psect name
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	;Store code psect name

	PUSHJ	SREG,CVT76	;Convert the atom buffer to sixbit
	JUMPE	VREG,BADCPS	;Bad code psect name

	MOVEM	VREG,ONHIN	;Will need to turn on these bits
	SETCAM	VREG,OFFHIN	;Will need to turn off these bits
	SOJ	VREG,		;Make count into a good index
SHNL:	MOVE	T2,SIXATM(VREG)	;Get word SIXBIT psect name
	MOVEM	T2,ONHIN+1(VREG) ;Will need to turn on these bits
	SETCAM	T2,OFFHIN+1(VREG) ;Will need to turn off these bits
	SOJGE	VREG,SHNL	;Move rest of SIXATM to ONHIN, OFFHIN

	POPJ	SREG,		;Return


BADDPS:	;TOPS-20 has a bug that allows a string to get null string when
	;an alternative would match text!

	MOVEI	T2,EP.CL	;Look for colon
	PUSHJ	SREG,ECMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed
	 JRST	GIVERR		;Nothing parsed return--Colon not found

	CAIN	T3,EP.CL	;Was colon found
	 JRST	GETCPN		;Yes--go get code psect name

GIVERR:	HRROI	T1,[ASCIZ \Psect name or colon required\]
	JRST	SEMERR		;Give error message



BADCPS:	HRROI	T1,[ASCIZ \Bad psect name\]
	JRST	SEMERR		;Give error message
	SUBTTL	CVTCOM - Convert and Syntax Check COMMON Block Name
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine converts the ASCIZ string in the atom buffer to
;	sixbit and returns the result.  This routine also syntax
;	checks the string to make sure that it is a legal COMMON block
;	name.
;
;	The COMMON block name is assumed to be incorrect if:
;		The name is less than 1 character long
;		The name is more than 32 characters long
;		The name contains a "." and is not ".COMM."
;		The name does not begin with a letter or "."
;		The COMMON block name is the null string
;
;	Note that the COMND% JSYS insures that only string is only
;	made up of periods, digits, dollar signs, underlines, and
;	upper and lower case letters.
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,CVTCOM
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	ATMBUF		The atom buffer, the source of the COMMON
;			block name
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	PERIOD		Zero, Iff a period was seen while scanning
;			the string
;
; FUNCTION VALUE:
;
;	Length,,pointer to COMMON block name in SIXBIT.
;
; SIDE EFFECTS:
;
;	None
;
;--





;[2343] New routine

CVTCOM:	SETZM	COMBUF		;[4530]Clear COMBUF so it can get 6 bit string
	MOVE	T1,[XWD COMBUF,COMBUF+1];[4530]
	BLT	T1,COMBUF+MAXWD-1;[4530]

	MOVE	T1,[POINT 7,ATMBUF] ;7 bit string comes from the atom buffer
	MOVE	T2,[POINT 6,COMBUF] ;[4530]6 bit string goes into COMBUF
	MOVEI	T4,MAXCHR	;[4530]Process up to 31 characters
	SETZM	PERIOD		;Assume no period has been seen

CCLP:	ILDB	T3,T1		;Get a seven bit character
	JUMPE	T3,CCCHK	;Return if null encountered
	CAIN	T3,"."		;Is character a period?
	 SETOM	PERIOD		;Yes--light period flag
	CAIL	T3,140		;Is character lowercase?
	 SUBI	T3,40		;Yes--Make it uppercase
	SUBI	T3," "-' '	;Convert 7 bit to sixbit
	IDPB	T3,T2		;Store sixbit character
	SOJG	T4,CCLP		;Process up to 31 characters

	ILDB	T3,T1		;We processed 31 charaters in the loop above
	JUMPN	T3,CCERR	;so next character should be a null
CCCHK:	SKIPN	COMBUF		;[4530]The COMMON block name must not be null
	 JRST	CCERR		;[4530] it is null
	MOVEI	T3,MAXCHR	;[4530] T3 = max number of characters
	SUB	T3,T4		;[4530] T3 = number of characters
	ADDI	T3,SIXBCHARSPERWORD-1 ;[4530] number words of sixbit characters
	IDIVI	T3,SIXBCHARSPERWORD   ;[4530]    = (number characters+5)/6 
	SKIPE	COMBUF(T3)	;[4530]    
	AOJ	T3,		;[4530]  +1 if num chars is not multiple of 6
	MOVEI	VREG,COMBUF	;[4530] Form cnt,,ptr to symbol in VREG
	HRL	VREG,T3		;[4530]
	SKIPE	PERIOD		;Was a period seen while converting the name?
	 JRST	CHKBLK		;Yes--name better be ".COMM."
	LDB	T3,[POINT 6,COMBUF,5] ;[4530]Get first sixbit character of name
	CAIL	T3,'A'		;If first character isn't a letter
	 CAILE	T3,'Z'		;If first character isn't a letter
	  JRST	CCERR		;First character  not a letter
	POPJ	SREG,		;Was a letter:  All was ok, return

CHKBLK:	MOVE	T3,COMBUF	;[4530] Get first word of symbol
	CAME	T3,[SIXBIT \.COMM.\] ;[4530]Was the name the name of blank COMMON?
	 JRST	CCERR		;[4530]
	SKIPN	COMBUF+1	;[4530] Is the next word null
	 POPJ	SREG,		;All was ok, return



CCERR:	HRROI	T1,[ASCIZ \Illegal or missing COMMON block name in /EXTEND:[NO]COMMON\] ;[2415]
	JRST	SEMERR		;[2415] Give error message
	SUBTTL	CHKCOLON  -- See if there is a colon following keyword
;++
; FUNCTIONAL DESCRIPTION:
;
;	<detailed functional description of the routine>
;
; CALLING SEQUENCE:
;
;	None
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	None
;
;--




;[2220] This routine added

; Call
;	PUSHJ	SREG,CHKCOLON
;	 return+1	;Here if no colon
;	return+2	;Here if colon was scanned


CHKCOLON:
	LDB	T1,STATE+.CMPTR	;Pickup last character scanned
	CAIN	T1,":"		;Was character a colon?
	 JRST	FOUCOL		;Yes--take found return

	MOVE	T1,FOLLOW	;[2331] Get pointer to descriptor blocks of the
	HRRM	T1,COLON+.CMFNP	;[2331] follow set and build up chain

TRYCOL:	MOVEI	T2,COLON	;Look for a colon using COMND
	PUSHJ	SREG,ECMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed
	 POPJ	SREG,		;Nothing parsed return--Colon not found
	CAIN	T3,COLON	;[2331] Was a colon found?
	 JRST	FOUCOL		;[2331] Yes--return
	SETOM	LKAHD		;Next field scanned since something was found
	POPJ	SREG,		;[2331] Colon not found

FOUCOL:	AOS	(SREG)		;Take return that says "colon was found"
	POPJ	SREG,		;Take return that says nothing was found
	SUBTTL	.FLAG - Process the /FLAG switch
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine sets the flag bits to show that a FLAG switch was
;	seen.  If the switch ends with a colon, either a FLAG keyword
;	or a list of FLAG keywords enclosed in parentheses is scanned.
;	Each FLAG keyword has associated with it a mask which will
;	control which FLAG bits are set or cleared.
;
;
; CALLING SEQUENCE:
;
;	PUSHJ	SREG,.FLAG
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	STATE+.CMFLG	The flags returned by the COMND% JSYS when the
;			/FLAG switch was scanned.
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	ONFLG+$F2	Set to show that a /FLAG switch has been seen
;	OFFFLG+$F2	Set to show that a /NOFLAG switch has not been seen
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	A switch value is scanned with the COMND% JSYS, if the switch
;	ended with a colon.
;
;--


.FLAG:				;[2246] added this entire routine
	TRACE	<.FLAG:>

	MOVE	T1,STATE+.CMFLG	;Flags returned by COMND% JSYS
	TXNN	T1,CM%SWT	;Terminated by colon?
	  JRST	CF.ALL		;No--Use default of ALL

	MOVEI	T2,CF.K1	;Look for keyword or "("
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	  JRST	USRERR		;EOF -- Command not completed

	CAIN	T3,CF.K1	;Keyword found?
	  PJRST	CF.KWD		;Yes--Process it and leave

	;Must have gotten an open parenthesis
CF.PRN:
	MOVEI	T2,CF.K2	;Look only for keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	  JRST	USRERR		;EOF -- Command not completed

	PUSHJ	SREG,CF.KWD	;Process that keyword

	HRROI	T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA	;Look for "," or ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	  JRST	USRERR		;EOF -- Command not completed

	HRROI	T4,[ASCIZ \FTNCMD \]
	MOVEM	T4,ERRPFX	;Restore the error message prefix

	CAIN	T3,COMMA	;Comma found?
	  JRST	CF.PRN		;Yes--Back for another keyword

	POPJ	SREG,		;Must be ")" -- Return

	;Process one keyword
CF.KWD:
	HRRZ	T2,(T2)		;Address of code to process keyword
	PJRST	(T2)		;Do it

	;VMS Keyword [2455]
CF.VMS:
	MOVX	T3,SW.CFV	;This bit set
	JRST	CF.SET

	;ANSI keyword
CF.STD:
	MOVX	T3,SW.CFS	;This bit set
	JRST	CF.SET

	;ALL keyword
CF.ALL:
	MOVX	T3,SW.CFS!SW.CFV;Both bits set

CF.SET:
	IORM	T3,ONFLG+$F2	;Turn on bit that says flag is true
	ANDCAM	T3,OFFFLG+$F2	;Turn off bit that says flag is false
	POPJ	SREG,

	;NOVMS keyword [2455]
CF.NOV:
	MOVX	T3,SW.CFV	;This bit turned off
	JRST	CF.RES

	;NOANSI keyword
CF.NOS:
	MOVX	T3,SW.CFS	;This bit turned off
	JRST	CF.RES
	SUBTTL /NOFLAG - Process the /NOFLAG switch

	;This switch is equivalent to /FLAG:NONE
	;There are no keywords.

.NOFLAG:			;[2246] added this routine
	TRACE	<.NOFLAG:>

CF.NON:
	MOVX	T3,SW.CFV!SW.CFS;Both bits turned off

CF.RES:	ANDCAM	T3,ONFLG+$F2	;Turn off bit that says /FLAG is true
	IORM	T3,OFFFLG+$F2	;Turn on bit that says /FLAG is false
	POPJ	SREG,
	SUBTTL .LIST -- Process the /LIST switch	;[2246]
.LIST:
	TRACE	<.LIST:>

	MOVX	T1,LSTFLG	;Get flag that says a list file is being made
	IORM	T1,ONFLG+$F	;Turn on flag that says a list file is made
	ANDCAM	T1,OFFFLG+$F	;Turn off the no list file flag

	HLRZ	T1,CMDSOU	;Get source from which this switch came
	CAIN	T1,FRMSWI	;Did this switch come from SWITCH.INI
	 JRST	LSTRET		;Yes--Return since /LIST in SWITCH.INI can
				;not take a value.

	MOVE	T1,STATE+.CMFLG	;[2220] Get flags returnd by the COMND% JSYS
	TXNN	T1,CM%SWT	;[2220] Was switch terminated with a colon?
	 POPJ	SREG,		;[2220] No--return

	SKIPGE	T1,LSTFIL	;Get the possibly old listing file JFN
	 JRST	NEWLST		;If no old JFN, then try and get new JFN
	RLJFN%			;Release old JFN
	ERJMP	MONERR
	SETOM	LSTFIL		;Mark JFN as unused

NEWLST:	MOVX	T1,GJ%FOU+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	PUSHJ	SREG,GETDEF	;[2220] Get default filename text into DEFFIL
	HRROI	T1,DEFFIL	;Get pointer to default text
	MOVEM	T1,CJFNBK+.GJNAM ;Set default name

	MOVE	T2,ONFLG+$F	;Get flags that have been turned on
	TXNE	T2,SW.CRF	;Has /CREF been specified?
	 SKIPA	T1,[CRFEXT]	;[2220] Yes--default extension is .CRF
	  MOVEI	T1,LSTEXT	;[2220] No--default extension is .LST
	MOVEM	T1,DEFEXT	;[2220] Set default extension

	MOVEI	T2,LFIL		;Look for a filename
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRRZM	T2,LSTFIL	;Store the new listing file JFN

	MOVE	T1,[POINT 7,ATMBUF]
	MOVE	T2,[POINT 7,LSTTYP]
LSTLP:	ILDB	T3,T1		;Copy what the user typed . . .
	IDPB	T3,T2		;. . . into the area to hold his typescript
	JUMPN	T3,LSTLP	;Copy until null byte is found


LSTRET:	POPJ	SREG,		;Get next switch


LFIL:	FLDDB.	(.CMFIL,CM%SDH,,<filespec of list file>) ;[2220] 
.NODEBUG:
	TRACE	<.NODEBUG:>

	HRRZI	T2,^-DB.ALL	;Turn off all debugging options

	MOVE	T2,ONFLG+$DEBGSW  ;Turn off any on bits that were not selected
	SETCAM	T2,OFFFLG+$DEBGSW ;Turn off bits that must be off

	POPJ	SREG,		;Go get next switch
.NOEXTEND:
	TRACE	<.NOEXTEND>

	MOVX	T3,SW.EXT	;Get flag bit
	ANDCAM	T3,ONFLG+$F2	;[2242] Turn off bit that might say that
				;  flag is true
	IORM	T3,OFFFLG+$F2	;[2242] Turn on bit that says that flag
				;  must be false

	MOVX	T2,PSDATA	;[2347] Get New Default Psect for COMMON blocks
	MOVEM	T2,ONFLG+$DFCMPS  ;[2347] Store new DeFault CoMmon block PSect
	SETCAM	T2,OFFFLG+$DFCMPS ;[2347] Turn off bits that must be off

	MOVX	T3,SW.EXC	;[2442] Get flag bit for /EXTEND:CODE
	IORM	T3,OFFFLG+$F2	;[2442] Turn on bit that says flag is false
	ANDCAM	T3,ONFLG+$F2	;[2442] Turn off bit that says flag is true

	POPJ	SREG,		;Go get next switch
.NOLIST:
	TRACE	<.NOLIST>

	;Load T3 with /LIST, /CREF, /LNMAP, /MACHINE-CODE, and /EXPAND bits

	MOVX	T3,LSTFLG+SW.CRF+SW.MAP+SW.MAC+SW.EXP
	ANDCAM	T3,ONFLG+$F	;Turn off bits that might say flags are true
	IORM	T3,OFFFLG+$F	;Turn on bits that say that flags must be false

	POPJ	SREG,		;Go get next switch
.NOOPTION:

	TRACE	<NOOPTION>

	SETOM	NOPTION		;Do not read SWITCH.INI

	POPJ	SREG,		;Go get next switch
.NOWARN:
	TRACE	<.NOWARN:>

	MOVX	T3,SW.NOW	;Get bit to turn off
	IORM	T3,ONFLG+$F	;Turn on bit that says that flag must be true
	ANDCAM	T3,OFFFLG+$F	;Turn off bit that might say that flag is false

	MOVE	T1,STATE+.CMFLG	;[2220] Get flags returnd by the COMND% JSYS
	TXNN	T1,CM%SWT	;[2220] Was switch terminated with a colon?
	 PJRST	NWALL		;[2220] No--use default of /NOWARN:ALL

	MOVEI	T2,WN.K1	;Look for a keyword or "("
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,WN.K1	;Was a keyword found?
	 PJRST	PRSK3		;Yes--go process keyword

	;Must have got a left parenthesis
GETK3:
	MOVEI	T2,WN.K2	;Look for only a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSK3	;Process this keyword

	HRROI	T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \FTNCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA	;Was a comma found?
	 JRST	GETK3		;Yes--get next keyword
	POPJ	SREG,		;Must have got paren--return

PRSK3:
	HRRZ	T2,(T2)		;Get keyword's code
	CAIN	T2,1		;Is this keyword ALL?
	 JRST	NWALL		;Yes--Set all flags

	CAIN	T2,2		;Is this keyword NONE?
	 PJRST	.WARN		;Yes--Let .WARN clear all the flags

	;Must have got a normal keyword

	MOVEI	T3,-1(T2)	;Determine correct word ...
	IDIVI	T3,^D36		; ... and position to set
	MOVEI	T1,1		;Get bit to shift
	LSH	T1,(T4)		;Shift to proper position
	IORM	T1,NWON(T3)	;Turn on bit that says that flag must be true
	ANDCAM	T1,NWOFF(T3)	;Turn off bit that might say that flag is false
	POPJ	SREG,

NWALL:	SETOM	NWON		;Set first word of nowarn bits
	MOVE	T1,[XWD NWON,NWON+1] ;Set nowarn "must be ON" bits
	BLT	T1,NWON+NWWDCT-1 ;Set rest of must be on bits

	SETZM	NWOFF		;Clear first word of nowarn bits
	MOVE	T1,[XWD NWOFF,NWOFF+1] ;Clear nowarn "must be OFF" bits
	BLT	T1,NWOFF+NWWDCT-1 ;Set rest of must be on bits

	POPJ	SREG,
.OBJECT:
	TRACE	<.OBJECT:>

	MOVX	T1,RELFLG	;Get flag that says a .REL file is being made
	IORM	T1,ONFLG+$F	;Turn on flag that says a .REL file is made
	ANDCAM	T1,OFFFLG+$F	;Turn off the no .REL file flag

	MOVX	T3,SW.OCS	;Get the /SYNTAX switch
	ANDCAM	T3,ONFLG+$F	;Turn off bit that might say that flag is true
	IORM	T3,OFFFLG+$F	;Turn on bit that says that flag must be false

	HLRZ	T1,CMDSOU	;Get source from which this switch came
	CAIN	T1,FRMSWI	;Did this switch come from SWITCH.INI
	 JRST	OBJRET		;Yes--Return since /OBJECT doesn't take a
				;value in SWITCH.INI

	MOVE	T1,STATE+.CMFLG	;[2220] Get flags returned by the COMND% JSYS
	TXNN	T1,CM%SWT	;[2220] Was switch terminated with a colon?
	 POPJ	SREG,		;[2220] No--return

	SKIPGE	T1,RELFIL	;Get the possibly old object file JFN
	 JRST	NEWOBJ		;If no old JFN, then try and get new object JFN
	RLJFN%			;Release old JFN
	ERJMP	MONERR
	SETOM	RELFIL

NEWOBJ:	MOVX	T1,GJ%FOU+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	PUSHJ	SREG,GETDEF	;[2220] Get default filename into DEFFIL
	HRROI	T1,DEFFIL	;Get pointer to default filename
	MOVEM	T1,CJFNBK+.GJNAM ;Set default name

	MOVEI	T1,RELEXT	;[2220] Get pointer to table of default
	MOVEM	T1,DEFEXT	;[2220] extensions and store it for CMD

	MOVEI	T2,OBFIL	;Look for a filename
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRRZM	T2,RELFIL	;Store the new object file JFN

OBJRET:	POPJ	SREG,		;Return


OBFIL:	FLDDB.	(.CMFIL,CM%SDH,,<filespec of object file>) ;[2220] 
.OPTION:
	TRACE	<.OPTION>

	MOVEI	T2,[FLDDB.(.CMFLD,CM%SDH,,<option name>)]
	PUSHJ	SREG,CMD	;Try and get option string
	 JRST	RET.ERR		;EOF return--error command not completed

	MOVE	T1,[POINT 7,ATMBUF] ;Get pointer to option string
	MOVE	T2,[POINT 7,OPTION] ;Get pointer to where to store it
	MOVEI	T3,^D40		;Get max. number characters allowed (including
				;null character that ends string)

OPTLP:	SOJL	T3,OPTLNG	;Jump if option becomes too long
	ILDB	T4,T1		;Get a character of the option string
	CAILE	T4,140		;Is character lower case?
	 SUBI	T4,40		;Yes--Convert to upper case
	IDPB	T4,T2		;Store in its new home
	JUMPN	T4,OPTLP	;Loop until null is copied

	CAIN	T3,^D39		;Was option string null
	 JRST	OPTSHT		;Jump if option is too short

	POPJ	SREG,	

OPTLNG:	SKIPA	T1,[POINT 7,[ASCIZ \Option name may not exceed 39 characters\]]
OPTSHT:	 HRROI	T1,[ASCIZ \Option name was not specified\] ;[2415]
	JRST	SEMERR		;[2415] Give error message
.WARN:
	TRACE	<.WARN>

	SETZM	NWON		;Clear first word of nowarn bits
	MOVE	T1,[XWD NWON,NWON+1] ;Clear nowarn "must be ON" bits
	BLT	T1,NWON+NWWDCT-1

	SETOM	NWOFF		;Set first word of nowarn bits
	MOVE	T1,[XWD NWOFF,NWOFF+1] ;Set nowarn "must be OFF" bits
	BLT	T1,NWOFF+NWWDCT-1

	MOVX	T3,SW.NOW	;Get /NOWARN flag
	ANDCAM	T3,ONFLG+$F	;Turn off bit that might say that flag is true
	IORM	T3,OFFFLG+$F	;Turn on bit that says that flag must be false

	POPJ	SREG,	
	SUBTTL	CMDINI -- Initilize the COMND% JSYS

;Call to this routine:
;	T1	CMDSOU designator
;	T2	INPUT,,OUTPUT JFN's for command
;	T3	Byte pointer to ASCIZ prompt

CMDINI:
	MOVEM	T1,CMDSOU	;Tell error routine from where commands come
	MOVEM	T2,STATE+.CMIOJ	;Store I/O JFNs in COMND% state block
	MOVEM	T3,STATE+.CMRTY	;Store prompt pointer for COMND%

	MOVEI	T1,STATE	;Point at COMND% state block
	MOVEI	T2,[FLDDB. (.CMINI)] ;Do COMND% initialize function
	COMND%
	ERJMP	MONERR		;This should never happen!

	POPJ	SREG,		;Return
	SUBTTL	CMD -- Do a COMND% JSYS
;[2220] this routine added
;Call to this routine:
;	MOVEI	T2,descriptor	;Get address of function descriptor
;	PUSHJ	SREG,CMD	;Do COMND% JSYS
;	  End of file return
;	Normal return
;
;
;Registers, on normal return:
;	T1	COMND% state Flags,,Pointer to COMND% state block
;	T2	Data returned by COMND%
;	T3	Address for function descriptor used (the alternative found)

CMD:
	MOVE	T5,DEFEXT	;Get pointer to default extension pointer
	SKIPN	LKAHD		;Was the next field already scanned?
	 JRST	CMDLP		;No--try to get next field

	SETZM	LKAHD		;No longer got the next field already scanned
	MOVE	T1,CMDFLG	;Restore T1, T2, and T3 to the values
	MOVE	T2,CMDDAT	;they had when this routine scanned
	MOVE	T3,CMDUSD	;the last field
	AOS	(SREG)		;Prepare to take normal return
	POPJ	SREG,		;Return

CMDLP:	MOVE	T4,(T5)		;Get pointer to file extension to try
	MOVEM	T4,CJFNBK+.GJEXT ;Store pointer for COMND%

	MOVEI	T1,STATE	;Point at COMND% state block
	COMND%
	ERJMP	CMERR		;Maybe end of file?

	TXNN	T1,CM%NOP	;Was something found?
	 PJRST	CFOUND		;Yes--process what was found

	JUMPE	T4,USRERR	;If hit the end of the list then got an error
	HLRZ	T2,T3		;Get back address of descriptor used in call
	AOJA	T5,CMDLP	;Try next default extension

CFOUND:	MOVEM	T1,CMDFLG	;[2220] Save flags for possible later use
	MOVEM	T2,CMDDAT	;[2220] Save data for possible later use
	HRRZ	T3,T3		;Get address of function descriptor used
	MOVEM	T3,CMDUSD	;[2220] Save which descriptor block was used
				;[2220] for possible later use

	AOS	(SREG)		;Assume a normal return

	CAIN	T3,CONFIRM	;Was a carriage return found?
	 SKIPN	ECHOFLG		;Is this command supposted to be echoed?
	  POPJ	SREG,		;Take normal return

	MOVE	T1,STATE+.CMRTY	;Get pointer to prompt string
	PSOUT%			;Echo on terminal
	HRROI	T1,BUFF		;Get pointer to command buffer
	PSOUT%			;Echo on terminal

	MOVE	T1,CMDFLG	;Restore value returned by COMND% JSYS
	POPJ	SREG,		;Return


CMERR:
	MOVX	T1,.FHSLF	;This process's last error
	GETER%			;Get last error in T2
	HRRZ	T2,T2		;Throw away fork handle

	CAIE	T2,COMNX9	;Was "error" really end of file?
	 CAIN	T2,IOX4		;Was "error" really end of file?
	  POPJ	SREG,		;Yes--Take failure return

	CAIE	T2,COMNX2	;Was field too long for internal buffer?
	 CAIN	T2,COMNX3	;Was command too long for internal buffer?
	  PJRST	USRERR		;Yes--Show user where his command went wrong

	CAIE	T2,DESX1	;[1711] Was error "invalid source designator"?
	 PJRST	MONERR		;[1711] No--Some strange error happened

	HLRZ	T2,CMDSOU	;[1711] Get source of command
	CAIE	T2,FRMTTY	;[1711] Was source designator the terminal?
	 PJRST	MONERR		;[1711] No--Some strange error happened

	;[1711] The "error" was that the primary input JFN is illegal.  This
	;[1711] means that the compiler is being run as a background fork.
	;[1711] Since the compiler cannot get another command string, simply
	;[1711] exit.

	HALTF%			;[1711]
	JRST	RET.OK		;[1711] Try and get a new command ...
	SUBTTL	ECMD -- Do a COMND% JSYS with error return
;[2220] This routine added
;Call to this routine:
;	MOVEI	T2,descriptor	;Get address of function descriptor
;	PUSHJ	SREG,ECMD	;Do COMND% JSYS
;	 EOF return		;EOF occured
;	 Error return		;Failure to find match
;	Normal return
;
;
;Registers, on normal return:
;	T1	COMND% state Flags,,Pointer to COMND% state block
;	T2	Data returned by COMND%
;	T3	Address for function descriptor used (the alternative found)

ECMD:
	MOVE	T5,DEFEXT	;Get pointer to default extension pointer
	SKIPN	LKAHD		;Was the next field already scanned?
	 JRST	ECMDLP		;No--try to get next field

	SETZM	LKAHD		;No longer got the next field already scanned
	MOVEI	T1,2		;Prepare to take normal return
	ADDM	T1,(SREG)
	MOVE	T1,CMDFLG	;Restore T1, T2, and T3 to the values
	MOVE	T2,CMDDAT	;they had when this routine scanned
	MOVE	T3,CMDUSD	;the last field
	POPJ	SREG,		;Return


ECMDLP:	MOVE	T4,(T5)		;Get pointer to file extension to try
	MOVEM	T4,CJFNBK+.GJEXT ;Store pointer for COMND%

	MOVEI	T1,STATE	;Point at COMND% state block
	COMND%
	ERJMP	CMERR		;Maybe end of file?

	TXNN	T1,CM%NOP	;Was something found?
	 PJRST	EFND		;Yes--process what was found

	JUMPE	T4,EERR		;If hit the end of the list then got an error
	HLRZ	T2,T3		;Get back address of descriptor used in call
	AOJA	T5,ECMDLP	;Try next default extension

EFND:	AOS	(SREG)		;We know we have a normal return.  The
				;code at CFOUND will AOS return address again.
	JRST	CFOUND		;Process found code


EERR:	AOS	(SREG)		;Prepare to take error return
	POPJ	SREG,		;Take error return
	SUBTTL	SCANSW -- Scan SWITCH.INI

;Register usage:
;	P1	Stores the first character of the switch line
;	P2	Stores the old value of the /ECHO flag
;	P3	Flag:  True iff at least one line selected from SWITCH.INI
;	P4	JFN of SWITCH.INI file

SCANSW:
	TRACE	<SCANSW:>
	SKIPGE	NOPTION		;Was /NOOPTION specified?
	 POPJ	SREG,		;Yes--just return

	PUSH	SREG,P1		;Save P1
	PUSH	SREG,P2		;Save P2
	PUSH	SREG,P3		;Save P3
	PUSH	SREG,P4		;Save P4
	PUSH	SREG,P5		;Save P5
	PUSH	SREG,P6		;Save P6
	PUSH	SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
	PUSH	SREG,OLDSTK	;Save old "old stack pointer"

	MOVEM	SREG,OLDSTK	;Save stack pointer so we can abort

	MOVX	T1,GJ%SHT+GJ%OLD ;[1623] Short arg block, File must exist
	HRROI	T2,INIFIL	;[1623] Filename of SWITCH.INI is in INIFIL
	GTJFN%			;[1623]
	 JRST	NOINI		;[1623] Failure return--maybe no file at all?
	HRRZ	P4,T1		;Save JFN of switch file for later use

	SETZ	P3,		;[1611] No lines yet selected from SWITCH.INI
	MOVE	P2,ECHOFLG	;Save the value of the /ECHO flag
	MOVE	T1,OPTECHO	;Get the value of the SWITCH.INI echo flag
	MOVEM	T1,ECHOFLG	;Store in new value of the echo flag

	MOVE	T1,P4		;Get JFN of switch file
	MOVX	T2,FLD(7,OF%BSZ)+.GSNRM+OF%RD ;ASCII chars, normal read access
	OPENF%
	 JRST	[CAIN T1,OPNX31 ;[1672] Did open fail because file was offline?
		  JRST RET.OK	;[1672] Yes--Not an error, just return
		 JRST  IOERR]	;[1672] No--We have a real I/O error

NEWLINE:
	TRACE	<NEWLINE:>
	MOVE	T1,P4		;Get JFN of SWITCH.INI for BIN% JSYS
	MOVE	T3,[POINT 7,[ASCIZ \FORTRA\]] ;Look for line starting with ...
FNDPFX:	BIN%
	ERJMP	EOF
	CAILE	T2,140		;Is character lower case?
	 SUBI	T2,40		;Yes--Convert to upper case
	ILDB	T4,T3		;Get character from pattern
	CAMN	T4,T2		;Is this the character we are looking for?
	 JUMPN	T4,FNDPFX	;Yes--but let's not be fooled by null
	JUMPN	T4,REJECT	;Reject this line, if ending char wasn't null

	CAIE	T2,"N"		;[1611] Is character the optional "N"
	 JRST	DIFFER		;[1611]No--make sure char doesn't differentiate
				;[1611] FORTRAN from some other program
	BIN%			;[1611] Get character following the "N"
	ERJMP	EOF		;[1611]
	CAILE	T2,140		;[1611] Is character lower case?
	 SUBI	T2,40		;[1611] Yes--Convert to upper case

DIFFER:	CAIN	T2,"-"		;Is character a hyphen
	 JRST	REJECT		;Yes--Reject this line
	CAIGE	T2,"0"		;Is character outside the range of digits?
	 JRST	GETOPT		;Yes--Try and get the option string
	CAIG	T2,"9"		;Is character outside the range of digits?
	 JRST	REJECT		;No--Reject this line
	CAIGE	T2,"A"		;Is character outside the range of letters?
	 JRST	GETOPT		;Yes--Try and get the option string
	CAIG	T2,"Z"		;Is character outside the range of letters?
	 JRST	REJECT		;No--Reject this line

GETOPT:	SKIPN	OPTION		;Is the option string from /OPTION null?
	 JRST	NOCOLON		;Yes--A selected line if it doesn't have colon
	CAIE	T2,":"		;Is this character a colon?
	  JRST	REJECT		;No--Scan line for continuation

	MOVE	T3,[POINT 7,OPTION] ;Look for the option
FNDOPT:	BIN%
	ERJMP	EOF
	CAILE	T2,140		;Is character lower case?
	 SUBI	T2,40		;Yes--Convert to upper case
	ILDB	T4,T3		;Get character from option pattern
	CAMN	T4,T2		;Is this the character we are looking for?
	 JUMPN	T4,FNDOPT	;Yes--but let's not be fooled by null
	JUMPN	T4,REJECT	;Reject this line, if ending char wasn't null

	CAIN	T2,"-"		;Is character a hyphen
	 JRST	REJECT		;Yes-Reject this line
	CAIGE	T2,"0"		;Is character outside the range of digits?
	 JRST	SELECT		;Yes--Select this line
	CAIG	T2,"9"		;Is character outside the range of digits?
	 JRST	REJECT		;No--Reject this line
	CAIGE	T2,"A"		;Is character outside the range of letters?
	 JRST	SELECT		;Yes--Select this line
	CAIG	T2,"Z"		;Is character outside the range of letters?
	 JRST	REJECT		;No--Reject this line

SELECT:
	TRACE	<SELECT:>

	SETO	P3,		;[1611] At least one line has been selected

	MOVE	P1,T2		;Save the unparsed character

	MOVE	T1,P4		;Get JFN of COMND% input
	HRLI	T1,FRMSWI	;Input is coming from SWITCH.INI
	HRL	T2,P4		;COMND% JSYS input comes from SWITCH.INI
	HRRI	T2,.NULIO	;COMND% JSYS output goes to NUL:
	HRROI	T3,[ASCIZ \SWITCH.INI: \] ;[2415] Prompt pointer
	PUSHJ	SREG,CMDINI	;Init COMND% JSYS and its state block

	AOS	STATE+.CMINC	;We have one unparsed character already
	DPB	P1,[POINT 7,BUFF,6] ;Store the character in COMND%'s buffer
	PUSHJ	SREG,SSWITCH	;Scan the switch line
	JUMPE	VREG,NEWLINE	;If all is OK, then look for more lines
	JUMPG	VREG,REJECT	;If an error occured, reject rest of line
	JRST	CLOSE		;If EOF, then close files

NOCOLON:
	CAIE	T2,":"		;Is character a colon?
	 JRST	SELECT		;Yes--This line has been selected

REJECT:
	TRACE	<REJECT:>
	BIN%
	ERJMP	EOF
	CAIN	T2,"!"		;Is character a exclamation point?
	 JRST	EXCL		;Yes--look for end of comment
	CAIN	T2,";"		;Is character a semicolon?
	 JRST	SEMI		;Yes--find end of line
	CAIN	T2,"-"		;Is character a minus sign?
	 JRST	MINUS		;Yes--see if this line is continued
	CAIE	T2,.CHCRT	;Is character a carriage return?
	 JRST	REJECT		;No--Get another character

EATLF:
	BIN%
	ERJMP	EOF
	JRST	NEWLINE		;See if we want this line

EXCL:	BIN%
	ERJMP	EOF
	CAIN	T2,"!"		;Is character an exclamation point?
	 JRST	REJECT		;Yes--comment closed
	CAIE	T2,.CHCRT	;Is character a carriage return?
	 JRST	EXCL		;No--get another character
	JRST	EATLF

SEMI:
	BIN%
	ERJMP	EOF
	CAIE	T2,.CHCRT	;Is character a carriage return?
	 JRST	SEMI		;No--get another character
	JRST	EATLF

MINUS:
	BIN%
	ERJMP	EOF
	CAIE	T2,.CHCRT	;Is character a carriage return?
	 JRST	REJECT		;Nope--continue scanning line
	BIN%			;Eat a linefeed
	ERJMP	EOF
	 JRST	REJECT		;Scan this line as a continuation of the first

EOF:
	TRACE	<EOF>
	MOVE	T1,P4		;Get JFN of SWITCH.INI
	GTSTS%			;Get status of that JFN
	TXNE	T2,GS%EOF	;Did end of file occur?
	 JRST	CLOSE		;Yes--Close up and go home (to get some sleep)
IOERR:	MOVEM	P2,ECHOFLG	;[1645] Restore the /ECHO flag
	MOVX	T1,.FHSLF	;This process
	GETER%			;Get last error in T2
	HRRZ	T2,T2		;Throw away fork handle
	HRROI	T1,[ASCIZ \%FTNCMD \] ;[1672]
	PSOUT%			;[1672]
	MOVX	T1,.PRIOU	;Primary output stream
	HRLOI	T2,.FHSLF	;This process' most recent error
	SETZ	T3,		;Write all of message
	ERSTR%
	 JRST	UNKERR		;Unknown error return
	 JRST	BADCALL		;Bad call to ERSTR% return
	HRROI	T1,[ASCIZ \
Error occurred while processing file SWITCH.INI from your logged-in directory
\]				;[1672]
	PSOUT%			;[1672]
	JRST	RET.ERR		;[1672] Return and signal error

CLOSE:	MOVEM	P2,ECHOFLG	;[1645] Restore the /ECHO flag

	MOVE	T1,P4		;Get JFN of SWITCH.INI
	CLOSF%			;Close file
	ERJMP	IOERR

	JUMPN	P3,RET.OK	;[1611] If at least one line was select, all OK
	SKIPN	OPTION		;[1611]If the user didn't give a /OPTION switch
	 JRST	RET.OK		;[1611] then all is OK
	;The user gave a /OPTION switch but no line from SWITCH.INI martched.
	;Warn user that the option string was probably mistyped.
	HRROI	T1,[ ASCIZ \%FTNCMD No lines from SWITCH.INI matched the /OPTION: specified.
\]
	PSOUT			;[1611]
	JRST	RET.OK		;Return to caller


NOINI:	CAIE	T1,GJFX24	;[1623] Was file not found?
	 CAIN	T1,GJFX18	;[1623] Was there no such filename?
	  JRST	RET.OK		;[1623] Yes--no switch file exits, just return
	CAIN	T1,GJFX19	;[1623] Was there no such filetype?
	 JRST	RET.OK		;[1623] Yes--no switch file exits, just return

	HRROI	T1,[ASCIZ \%FTNCMD Can't read SWITCH.INI -- \] ;[1623]
	PSOUT%			;[1623]
	MOVX	T1,.PRIOU	;[1623] Primary output stream
	HRLOI	T2,.FHSLF	;[1623] This process' most recent error
	SETZ	T3,		;[1623] Write all of message
	ERSTR%			;[1623]
	 NOOP			;[1623] Unknown error return
	 NOOP			;[1623] Bad call to ERSTR% return
	HRROI	T1,[ASCIZ \
\]				;[1623]
	PSOUT%			;[1623]
	JRST	RET.OK		;[1623]Since only a warning, take normal return
	;[2220] This routine rewritten
	;Note that this routine may abort.  If it aborts,
	;VREG will have the value:
	;	-1	if a EOF occured
	;	 1	if an error occured
	;If nothing when wrong, this routine will return and
	;VREG will have the value zero.

SSWITCH:
	PUSH	SREG,P1		;Save P1
	PUSH	SREG,P2		;Save P2
	PUSH	SREG,P3		;Save P3
	PUSH	SREG,P4		;Save P4
	PUSH	SREG,P5		;Save P5
	PUSH	SREG,P6		;Save P6
	PUSH	SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
	PUSH	SREG,OLDSTK	;Save old "old stack pointer"
	MOVEM	SREG,OLDSTK	;Save stack pointer so we can abort

GETSWITCH:
	HRROI	T1,[ASCIZ \FTNCMD \] ;Get pointer to prefix of error messages
	MOVEM	T1,ERRPFX	;Store error message prefix

	MOVEI	T2,COMPSW	;Look for compile switches
	MOVEM	T2,FOLLOW	;Set up follow set for /EXTEND
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,CONFIRM	;Was command confirmed?
	 JRST	RET.OK		;Yes--Take normal return.

	HRRZ	T2,(T2)		;Get action code
	PUSHJ	SREG,@(T2)	;Call routine to process switch
	JRST	GETSWITCH	;Need to get a new switch
	SUBTTL	Command Line Error Routines

USRERR:
	TRACE	<USRERR>
	SETZM	ERRTXT		;[2415] Use ERSTR% to get error string
	JRST	MAYECH		;[2415] See if we need to echo cmd line

SEMERR:	TRACE	<SEMERR>	;[2415] Use the error string suppiled by caller
	MOVEM	T1, ERRTXT	;[2415] Store the pointer to error text

MAYECH:	;[2415] Echo command if the ECHOFLG switch is on ...
	SKIPE	ECHOFLG		;Is this command supposted to be echoed?
	 JRST	DOECHO		;[2415] Yes--echo it

	;[2415] ... or echo command if command came from a TAKE file
	HLRZ	T1,CMDSOU	;[2415] Get source of command
	CAIE	T1,FRMTAK	;[2415] Is source of command a TAKE file?
	 JRST	NOECHO		;[2415] Not a TAKE file, don't echo command

DOECHO:	MOVE	T1,STATE+.CMRTY	;Get pointer to prompt string
	PSOUT%			;Echo on terminal
	HRROI	T1,BUFF		;Get pointer to command buffer
	PSOUT%			;Echo on terminal

NOECHO:
	MOVE	T1,ERRPFX	;Get prefix string of error message
	ESOUT%

	SKIPE	T1,ERRTXT	;[2415] Get ptr to error string; see if valid
	 JRST	USEET		;[2415] Error test ptr is valid, use it

	; No caller supplied error text, so get it from Monitor

	MOVX	T1,.PRIOU	;Primary output stream
	HRLOI	T2,.FHSLF	;This process' most recent error
	SETZ	T3,		;Write all of message
	ERSTR%
	 JRST	UNKERR		;Unknown error return
	 JRST	BADCALL		;Bad call to ERSTR% return
	JRST	PUTBD		;All went OK, write bad part of command

USEET:	PSOUT%			;[2415] Write out caller supplied error text

	; This section of code determines the number of unparsed characters
	; that are in the command buffer minus the number of characters
	; that terminated the command.  The number of terminating chars
	; is one except in the case of line-feed, which may be preceded
	; by a carriage return.  Register P1 will hold the result.

PUTBD:	MOVE	P1,STATE+.CMINC	;[2415] Get number of unparsed chars in buffer
	MOVE	T1,P1		;Copy set up for ADJBP
	SOJ	P1,		;Last char is terminator--don't count it
	ADJBP	T1,STATE+.CMPTR	;Get ptr to last char of text unparsed
	LDB	T3,T1		;Get last char
	CAIE	T3,.CHLFD	;Was character a linefeed?
	 JRST	OUT		;No, we now know length of unparsed string

	SETO	T2,		;T2 gets minus one
	ADJBP	T2,T1		;Backup byte pointer, put it in T2
	LDB	T3,T2		;Get new last char
	CAIN	T3,.CHCRT	;Is character a carriage return?
	 SOJ	P1,		;Yes, don't count it
OUT:
	HRROI	T1,[ASCIZ \ -- "\]
	PSOUT%
	MOVX	T1,.PRIOU	;Type on terminal
	MOVE	T2,STATE+.CMPTR	;Get ptr to text left unparsed
	MOVN	T3,P1		;Get negative count
	CAIE	T3,0		;If there is some error text
	 SOUT%			; then write it out
	HRROI	T1,[ASCIZ \"
\]
	PSOUT%
	HLRZ	T4,CMDSOU	;Get source of command
	CAIN	T4,FRMTTY	;Did the command come from the terminal?
	 JRST	RET.ERR		;Yes--Don't tell user where command came from
	HRROI	T1,[ASCIZ \Error occurred while processing \]
	PSOUT%
	MOVE	T1,FRMTAB-1(T4)	;Get source message
	PSOUT%

	HRRZ	T2,CMDSOU	;Get optional JFN of source
	JUMPE	T2,WRIRET	;If no JFN, then write final return-linefeed

	MOVEI	T1,.PRIOU	;Output goes to terminal
	MOVE	T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF]
	JFNS%

WRIRET:	HRROI	T1,[ASCIZ \
\]
	PSOUT%
	JRST	RET.ERR		;Return and signal error


FRMTAB:	 POINT	7,[ASCIZ \arguments from the EXEC\]
	 POINT	7,[ASCIZ \command file \]		 ;[1657]
	 POINT	7,[ASCIZ \switch file \]
	 POINT	7,[ASCIZ \a TOPS-10 command line\]


MONERR:
	HRROI	T1,[ASCIZ \FTNCMD \]
	ESOUT%
	MOVX	T1,.PRIOU	;Primary output stream
	HRLOI	T2,.FHSLF	;This process' most recent error
	SETZ	T3,		;Write all of message
	ERSTR%
	 JRST	UNKERR		;Unknown error return
	 JRST	BADCALL		;Bad call to ERSTR% return
	PJRST	WRIRET		;Write final CR/LF and return




UNKERR:
	TRACE	<UNKERR>
	HRROI	T1,[ASCIZ \Unknown error
\]
	PSOUT%
	JRST	RET.ERR		;Return and signal error

BADCALL:
	TRACE	<BADCALL>
	HRROI	T1,[ASCIZ \Bad call to ERSTR%
\]
	PSOUT%
	JRST	RET.ERR		;Return and signal error
	SUBTTL	Return Code

RET.ERR: MOVEI	VREG,1		;Return value of 1 means error encountered
	 JRST	RESTOR

RET.OK:	TDZA	VREG,VREG	;RETURN value of 0 means that all is OK
RET.EOF: SETO	VREG,		;Return value of -1 means EOF was encountered
RESTOR:	MOVE	SREG,OLDSTK	;Recover the original stack pointer

	POP	SREG,OLDSTK
	POP	SREG,STATE+.CMFLG ;Restore the Reparse address for COMND% JSYS
	POP	SREG,P6		;Restore P6
	POP	SREG,P5		;Restore P5
	POP	SREG,P4		;Restore P4
	POP	SREG,P3		;Restore P3
	POP	SREG,P2		;Restore P2
	POP	SREG,P1		;Restore P1

	POPJ	SREG,		;Return
	SUBTTL SCAN10 - The TOP-10 Compatibility Command Scanner
;Register Usage:
;	P1	Location to return to after processing a switch
;	P2	Flag--Has an object file been specified?
;	P3	Flag--Has a list file been specified?

SCAN10:
	PUSH	SREG,P1		;Save P1
	PUSH	SREG,P2		;Save P2
	PUSH	SREG,P3		;Save P3
	PUSH	SREG,P4		;Save P4
	PUSH	SREG,P5		;Save P5
	PUSH	SREG,P6		;Save P6
	PUSH	SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
	PUSH	SREG,OLDSTK	;Save old "old stack pointer"

	MOVEM	SREG,OLDSTK	;Save stack pointer so we can abort

	MOVEI	T1,XREP10	;Get address of code to handle a reparse
	HRRM	T1,STATE+.CMFLG	;Store in state block

	JRST	OBJ10

XREP10:
	TRACE	<XREP10>
	MOVE	SREG,OLDSTK	;Restore the stack pointer

	SKIPL	T1,RELFIL	;Get JFN of object file
	 RLJFN%			;Release JFN
	ERJMP	MONERR

	SKIPL	T1,LSTFIL	;Get JFN of list file
	 RLJFN%			;Release JFN
	ERJMP	MONERR

	SKIPGE	T5,FORIDX	;Get index to JFN of last source file
	 JRST	OBJ10		;No source file JFN's
XRL:	MOVE	T1,FORFIL(T5)	;Get JFN of next source file
	RLJFN%			;Release JFN
	ERJMP	MONERR
	SOJGE	T5,XRL		;Loop to release rest of source file JFN's

OBJ10:
	PUSHJ	SREG,INIT	;Clear flags
	SETOM	LSTFIL		;Clear JFN of list file
	SETOM	RELFIL		;Clear JFN of object file
	SETOM	FORIDX		;No source files have JFN's
	SETZM	LSTTYP		;Throw away typescript from /LIST:
	SETZM	OPTECHO		;Don't echo options from SWITCH.INI
	SETZM	NOPTION		;/NOOPTION has not been seen--read SWITCH.INI
	SETZM	OPTION		;No option string has been given
	SETZM	LKAHD		;[2220] Next symbol not scanned yet
	HRROI	T4,[ASCIZ \FTNCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	SETZB	P2,P3		;Assume /NOOBJECT and /NOLIST

	MOVEI	P1,.		;Location to return to if a switch is found

	MOVX	T1,GJ%FOU+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags for object file

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device for object file

	SETZM	CJFNBK+.GJNAM	;No default name for object file

	MOVEI	T1,RELEXT	;[2220] 
	MOVEM	T1,DEFEXT	;[2220] Set default extension for object file

	MOVEI	T2,OFILE	;Look for a filename, comma, equal, or switch
	MOVEM	T2,FOLLOW	;[2220] Setup follow set for /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,COMPSW	;Was a switch found?
	 JRST	DOSW		;Yes--Process the switch
	CAIN	T3,CONFIRM	;Was a carriage return found?
	 JRST	ERR1		;Yes--Give error message
	CAIN	T3,EQUAL	;Was an equal sign found?
	 JRST	SOU10		;Yes--Get source files
	CAIN	T3,COMMA1	;Was a comma found?
	 JRST	LIST10		;Yes--Get listing file

	SETO	P2,		;Got a object file
	HRRZM	T2,RELFIL	;Store its JFN
	MOVX	T1,RELFLG	;Get flag that says a .REL file is being made
	IORM	T1,ONFLG+$F	;Turn on flag that says a .REL file is made
	ANDCAM	T1,OFFFLG+$F	;Turn off the no .REL file flag

	MOVEI	P1,.		;Come back here if switch is found
	MOVEI	T2,COMMA1	;Look for a comma, switch, equals
	MOVEM	T2,FOLLOW	;[2220] Setup follow set for /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,COMPSW	;Was a switch found?
	 JRST	DOSW		;Yes--Process the switch
	CAIN	T3,CONFIRM	;Was a carriage return found?
	 JRST	ERR1		;Yes--Give error message
	CAIN	T3,EQUAL	;Was an equal sign found?
	 JRST	SOU10		;Yes--Get source file

LIST10:
	MOVEI	P1,.		;[2220] Location to return to after switch
	MOVX	T1,GJ%FOU+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags of list file

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device of list file

	SETZM	CJFNBK+.GJNAM	;No default name of list file

	MOVEI	T1,LSTEXT	;[2220] 
	MOVEM	T1,DEFEXT	;[2220] Set default extension of list file

	MOVEI	T2,LFILE	;Look for a file, equal, or switch
	MOVEM	T2,FOLLOW	;[2220] Setup follow set for /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,COMPSW	;Was a switch found?
	 JRST	DOSW		;Yes--Process the switch
	CAIN	T3,CONFIRM	;Was a carriage return found?
	 JRST	ERR1		;Yes--Give error message
	CAIN	T3,EQUAL	;Was a equal sign found?
	 JRST	SOU10		;Yes--Get source file
	
	SETO	P3,		;Got a listing file
	HRRZM	T2,LSTFIL	;Store its JFN
	MOVX	T1,LSTFLG	;Get flag that says a list file is being made
	IORM	T1,ONFLG+$F	;Turn on flag that says a list file is made
	ANDCAM	T1,OFFFLG+$F	;Turn off the no list file flag
	MOVE	T1,[POINT 7,ATMBUF]
	MOVE	T2,[POINT 7,LSTTYP]
L10CPY:	ILDB	T3,T1		;Copy what the user typed . . .
	IDPB	T3,T2		;. . . into the area to hold his typescript
	JUMPN	T3,L10CPY	;Copy until null byte is found


	MOVEI	P1,.		;Come back here if a switch is found
	MOVEI	T2,EQUAL	;Look for a equal sign or switch
	MOVEM	T2,FOLLOW	;[2220] Setup follow set for /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,COMPSW	;Was a switch found?
	 JRST	DOSW		;Yes--Process the switch
	CAIN	T3,CONFIRM	;Was a carriage return found?
	 JRST	ERR1		;Yes--Give error message

SOU10:
	MOVEI	P1,.		;Come back here is a switch is found

	MOVX	T1,GJ%OLD!GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags for source file

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device for source file

	SETZM	CJFNBK+.GJNAM	;No default name for source file

	MOVEI	T1,FOREXT	;[2220] 
	MOVEM	T1,DEFEXT	;[2220] Set default extension for source file

LOOP10:
	MOVEI	T2,SFILE	;Look for a source file or switch
	MOVEM	T2,FOLLOW	;[2220] Setup follow set for /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIN	T3,COMPSW	;Was a switch found?
	 JRST	DOSW		;Yes--Process the switch
	CAIN	T3,CONFIRM	;Was a carriage return found?
	 JRST	ERR1		;Yes--Give error message

	AOS	T1,FORIDX	;Get index to use to store new source file JFN
	CAIL	T1,MAXFILES	;Does index still fit in table
	 JRST	TOOMANY		;No--give an error message
	HRRZM	T2,FORFIL(T1)	;Store JFN of source file

	MOVEI	P1,.		;Come back here if a switch is found
	MOVEI	T2,COMMA2	;Look for a comma, switch, or confirm
	MOVEM	T2,FOLLOW	;[2220] Setup follow set for /EXTEND switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	EOC		;EOF return--Command is done, call compiler

	CAIN	T3,CONFIRM	;Was a carriage return found?
	 JRST	EOC		;Yes--Call compiler

	CAIE	T3,COMPSW	;Was a switch found?
	 JRST	LOOP10		;No--Loop to get source file

DOSW:
	HRRZ	T2,(T2)		;Get action code
	PUSHJ	SREG,@(T2)	;Call routine to process switch
	HRROI	T4,[ASCIZ \FTNCMD \] ;[2220] 
	MOVEM	T4,ERRPFX	;[2220] Store error message prefix
	JRST	(P1)		;Return to processing command line

EOC:
	SETZM	DEFFIL		;The default filename shouldn't be used

	JUMPN	P2,CHKLST	;Was an object file specified?
	MOVX	T3,RELFLG	;No--Get flag object file flag
	ANDCAM	T3,ONFLG+$F	;Turn off bit that might say that flag is true
	IORM	T3,OFFFLG+$F	;Turn on bit that says that flag must be false

CHKLST:	SKIPN	P3		;Was a list file specified?
	 PUSHJ	SREG,.NOLIST	;No--Make sure list flags are turned off
	PUSHJ	SREG,DOCOMPILE	;Compile this program
	JRST	RET.OK

ERR1:	HRROI	T1,[ASCIZ \You may not end a TOPS-10 style command at this point\] ;[2415]
	JRST	SEMERR		;[2220][2415]

OFILE:	FLDDB.	(.CMFIL,,,,,COMMA1)
LFILE:	FLDDB.	(.CMFIL,,,,,EQUAL)
SFILE:	FLDDB.	(.CMFIL,,,,,COMPSW)
EQUAL:	FLDDB.	(.CMTOK,,<POINT 7,[ASCIZ \=\]>,,,COMPSW)
COMMA1:	FLDDB.	(.CMCMA,,,,,EQUAL)
COMMA2:	FLDDB.	(.CMCMA,,,,,PLUS)
PLUS:	FLDDB.	(.CMTOK,,<POINT 7,[ASCIZ \+\]>,,,COMPSW)
	SUBTTL	Flag Mask Definitions
	SALL

;FLAG BITS IN F (SEE IOFLG.BLI and COMMAN.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:

;FLAG BITS IN F2 (SEE IOFLG.BLI and COMMAN.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

;FLAG BITS IN FLAGS2 (SEE IOFLG.BLI and COMMAN.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		;Abort (exit) on fatal errors
	SUBTTL	Default file extension tables for COMND% JSYS
;[2220] These tables created

;These are the tables of the default file extensions to try when
;a filespec is being scanned.  The end of the list is marked by
;a zero word, which means that as a last resort, no particular
;extension default is used.


	;Table of default extensions for source files

FOREXT:	POINT	7,[ASCIZ /FOR/]
	IFN FTUS,<	;A DEC in-house feature
	POINT	7,[ASCIZ /FTP/]
	>		;A DEC in-house feature
	EXP	0		;End of list


	;Table of default extensions for object files

RELEXT:	POINT	7,[ASCIZ /REL/]
	EXP	0


	;Table of default extensions for list files /NOCROSS-REFERENCE

LSTEXT:	POINT	7,[ASCIZ /LST/]
	EXP	0



	;Table of default extensions for list files /CROSS-REFERENCE

CRFEXT:	POINT	7,[ASCIZ /CRF/]
	EXP	0


	;Table of default extensions for TAKE command

CMDEXT:	POINT	7,[ASCIZ /CMD/]
	EXP	0		;End of list



	;Table of default extensions for RUN  command

EXEEXT:	POINT	7,[ASCIZ /EXE/]
	EXP	0		;End of list
	SUBTTL	Function block for the COMND% JSYS
	ABBRIV==CM%FW ! CM%INV ! CM%ABR
	INVIS==CM%FW ! CM%INV

	DEFINE	TBL(STRING,FLAGS,ACTION)<
	IFE	FLAGS, <XWD [ASCIZ \'STRING\],ACTION>
	IFN	FLAGS, <XWD [EXP   FLAGS
			    ASCIZ \'STRING\],ACTION>
>

KEYWD:	FLDDB. (.CMKEY,0,ACTCMD,<Command,>,,CMFIL0) ;[2220] 

CMFIL0:	FLDDB. (.CMFIL,CM%SDH,,<filespec of source file to implicitly begin COMPILE command>,,CMSWI0) ;[2220] 
CMSWI0:	FLDDB. (.CMSWI,0,COMSW,<switch to implicitly begin COMPILE command,>,,ACTNSW) ;[2417] 

COMPSW:	FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>,,CONFIRM)


ACTNSW:	FLDDB. (.CMSWI,CM%SDH,ACTSW) ;[2417]


CONFIRM:
	FLDDB. (.CMCFM)

OFFSET:	FLDDB.	(.CMSWI,0,OFFSX,,,CONFIRM)

OFFSX:	XWD	2,2
	TBL	<OFFSET:>,,0
	TBL	<RUNOFFSET:>,INVIS,0

ECHO:
	FLDDB.	(.CMSWI,0,ECHOX,,,CONFIRM)

ECHOX:
	XWD	2,2		;[1645]
	TBL	<ECHO>,,1
	TBL	<NOECHO>,,0	;[1645]

DB.K1:	FLDDB.	(.CMKEY,0,DT,<a debugging option,>,(ALL),DB.K3)	;[2220] 
DB.K2:	FLDDB.	(.CMKEY,0,DT,<a debugging option,>)	;[2415]
DB.K3:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of debugging options>) ;[2220] 

ET.K1:	FLDDB.	(.CMKEY,0,ET,<an EXTEND keyword,>,(DATA:10000,COMMON,NOCODE,PSECT:.DATA.:.CODE.),ET.K3) ;[2445]
ET.K2:	FLDDB.	(.CMKEY,0,ET,<an EXTEND keyword,>)	;[2415] 
ET.K3:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of EXTEND keywords>) ;[2220] 

EC.K1:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of COMMON block names>,,EC.K3) ;[2343] 
EC.K2:	FLDBK.	(.CMFLD,CM%BRK,,<a COMMON block name>,,EC.BK)	;[2343] 
EC.K3:	FLDBK.	(.CMFLD,CM%BRK,,<a COMMON block name>,,EC.BK,) ;[2415]
EC.BK:	BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<.$_>,<->) ;[4530]

EP.DA:	FLDBK.	(.CMFLD,CM%BRK,,<Name of the data psect>,.DATA.,EP.BK,EP.CL) ;[2445]
EP.CO:	FLDBK.	(.CMFLD,CM%BRK,,<Name of the code psect>,.CODE.,EP.BK) ;[2445]
EP.BK:	BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<.$%>,<->) ;[2445]


CF.K1:	FLDDB.	(.CMKEY,0,CF,<a FLAG keyword,>,(ALL),CF.K3)	;[2320]
CF.K2:	FLDDB.	(.CMKEY,0,CF,<a FLAG keyword,>)	;[2415]
CF.K3:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of FLAG keywords>)	;[2246]

WN.K1:	FLDDB.	(.CMKEY,0,WT,<warning message mnemonic,>,(ALL),WN.K3) ;[2220]
WN.K2:	FLDDB.	(.CMKEY,0,WT,<warning message mnemonic,>) ;[2415]
WN.K3:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of warning mnemonics>) ;[2220]

COMMA:	FLDDB.	(.CMCMA,CM%SDH,,<"," or ")">,,LEFTP)

LEFTP:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \)\]>)
ACTSW:	XWD	ACTSWL,ACTSWL		;Count of number of entries
	TBL	<EXIT>,INVIS,.EXIT	;[2417]
	TBL	<HELP>,INVIS,.HELP	;[2417]
	TBL	<RUN:>,INVIS,.RUN	;[2417]
	TBL	<TAKE:>,INVIS,.TAKE	;[2417]
	ACTSWL==.-ACTSW-1

ACTCMD:	XWD	ACTCML,ACTCML	;[2220] Create this table
	TBL	<COMPILE>,,.COMPILE
	TBL	<EXIT>,,.EXIT
	TBL	<HELP>,,.HELP
	TBL	<RUN>,,.RUN
	TBL	<TAKE>,,.TAKE
	ACTCML==.-ACTCMD-1
	SUBTTL	Compilation Switch Table


COMSW:	XWD	COMSWL,COMSWL		;Count of number of entries
	TBL	<A>,ABBRIV,XXA
XXA:	TBL	<ABORT>,,[EXP SETFLG,SW.ABO,$FLAGS2]
	TBL	<B>,ABBRIV,XXB
XXB:	TBL	<BINARY:>,,[.OBJECT]
	TBL	<BUGOUT:>,INVIS,[.BUGOUT]
	TBL	<C>,ABBRIV,XXC
	TBL	<CR>,ABBRIV,XXC
	TBL	<CREF>,INVIS,[EXP SETFLG,SW.CRF,$F]
	TBL	<CRO>,ABBRIV,XXC
	TBL	<CROS>,ABBRIV,XXC
	TBL	<CROSS>,ABBRIV,XXC
XXC:	TBL	<CROSS-REFERENCE>,,[EXP SETFLG,SW.CRF,$F]
	TBL	<CROSSREFERENCE>,INVIS,[EXP SETFLG,SW.CRF,$F]
	TBL	<D>,ABBRIV,XXD
XXD:	TBL	<DEBUG:>,,[.DEBUG]
	TBL	<DFLOATING>,,[EXP CLRFLG,SW.GFL,$F2]	;[1611]
	TBL	<ECHO-OPTION>,,[.ECHOOP]
	TBL	<ERRORS>,,[EXP CLRFLG,SW.NET,$F]
	TBL	<EXPAND>,,[EXP SETFLG,SW.EXP,$F]
	TBL	<EXTEND:>,,[.EXTEND]			;[2220]
	TBL	<F>,ABBRIV,XXF				;[2320]
	TBL	<F66>,,[EXP CLRFLG,SW.F77,$F2]
	TBL	<F77>,,[EXP SETFLG,SW.F77,$F2]
XXF:	TBL	<FLAG-NON-STANDARD:>,,[.FLAG]		;[2320]
	TBL	<GFLOATING>,,[EXP SETFLG,SW.GFL,$F2]
	TBL	<INCLUDE>,,[EXP SETFLG,SW.IDS,$F]
	TBL	<L>,ABBRIV,XXL
XXL:	TBL	<LISTING:>,,[.LIST]
	TBL	<LNMAP>,,[EXP SETFLG,SW.MAP,$F]
	TBL	<M>,ABBRIV,XXM
	TBL	<MA>,ABBRIV,XXM
	TBL	<MAC>,ABBRIV,XXM
XXM:	TBL	<MACHINE-CODE>,,[EXP SETFLG,SW.MAC,$F]
	TBL	<MACRO>,INVIS,[EXP SETFLG,SW.MAC,$F]
	TBL	<NOABORT>,,[EXP CLRFLG,SW.ABO,$FLAGS2]
	TBL	<NOBINARY>,,[EXP CLRFLG,RELFLG,$F]
	TBL	<NOC>,ABBRIV,XXNOC
	TBL	<NOCR>,ABBRIV,XXNOC
	TBL	<NOCREF>,INVIS,[EXP CLRFLG,SW.CRF,$F]
	TBL	<NOCRO>,ABBRIV,XXNOC
	TBL	<NOCROS>,ABBRIV,XXNOC
	TBL	<NOCROSS>,ABBRIV,XXNOC
XXNOC:	TBL	<NOCROSS-REFERENCE>,,[EXP CLRFLG,SW.CRF,$F]
	TBL	<NOCROSSREFERENCE>,INVIS,[EXP CLRFLG,SW.CRF,$F]
	TBL	<NOD>,ABBRIV,XXNOD
XXNOD:	TBL	<NODEBUG>,,[.NODEBUG]
	TBL	<NOERRORS>,,[EXP SETFLG,SW.NET,$F]
	TBL	<NOEXPAND>,,[EXP CLRFLG,SW.EXP,$F]
	TBL	<NOEXTEND>,,[.NOEXTEND]				;[2220]
	TBL	<NOF>,ABBRIV,XXNOF				;[2320]
	TBL	<NOF77>,,[EXP CLRFLG,SW.F77,$F2]
XXNOF:	TBL	<NOFLAG-NON-STANDARD>,,[.NOFLAG]		;[2320]
	TBL	<NOINCLUDE>,,[EXP CLRFLG,SW.IDS,$F]
	TBL	<NOL>,ABBRIV,XXNOL
XXNOL:	TBL	<NOLISTING>,,[.NOLIST]
	TBL	<NOLNMAP>,,[EXP CLRFLG,SW.MAP,$F]
	TBL	<NOM>,ABBRIV,XXNOM
	TBL	<NOMA>,ABBRIV,XXNOM
	TBL	<NOMAC>,ABBRIV,XXNOM
XXNOM:	TBL	<NOMACHINE-CODE>,,[EXP CLRFLG,SW.MAC,$F]
	TBL	<NOMACRO>,INVIS,[EXP CLRFLG,SW.MAC,$F]
	TBL	<NOOBJECT>,INVIS,[EXP CLRFLG,RELFLG,$F]
	TBL	<NOOPT>,ABBRIV,XXNOOPT				;[1611]
	TBL	<NOOPTIMIZE>,,[EXP CLRFLG,SW.OPT,$F]
XXNOOPT:TBL	<NOOPTION>,,[.NOOPTION]
	TBL	<NOS>,ABBRIV,XXNOS
	TBL	<NOSTATISTICS>,INVIS,[EXP CLRFLG,SW.STA,$F2]
XXNOS:	TBL	<NOSYNTAX>,,[EXP CLRFLG,SW.OCS,$F]
	TBL	<NOW>,ABBRIV,XXNOW
XXNOW:	TBL	<NOWARNINGS:>,,[.NOWARN]
	TBL	<O>,ABBRIV,XXO					;[1711]
	TBL	<OBJECT:>,INVIS,[.OBJECT]
	TBL	<OP>,ABBRIV,XXO
	TBL	<OPT>,ABBRIV,XXO
XXO:	TBL	<OPTIMIZE>,,[EXP SETFLG,SW.OPT,$F]
	TBL	<OPTION:>,,[.OPTION]
	TBL	<S>,ABBRIV,XXS
	TBL	<STATISTICS>,INVIS,[EXP SETFLG,SW.STA,$F2]
XXS:	TBL	<SYNTAX>,,[EXP SETFLG,SW.OCS,$F]
	TBL	<W>,ABBRIV,XXW
XXW:	TBL	<WARNINGS>,,[.WARN]
	COMSWL==.-COMSW-1
	SUBTTL	Warning Message Mnemonic Table

;To add a new warning message mnemonic to the compiler:
;	1) Add it to the end of the list labeled with NWKTB
;	2) Add to the table labeled with WT an entry of the form:
;		TBL	<XXX>,,NW.XXX
;	   where XXX is the three letter mnemonic for the warning.
;	3) Make sure all the entires to WT are in alphabetical
;	   order!


	DEFINE	SIXTAB(L)<
	NWKTBC==0
	IRP L,< SIXBIT \'L\ 
		NW.'L==.-NWKTB
		NWKTBC==NWKTBC+1>
>


; /NOWARN: mnemonic tables.  The three character mnemonics must be
; added to both of the below tables.

;[2305] Added mnemonics AIS through VNF

NWKTB:	SIXTAB	<
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,VKI,
EIR,EID,INC,LDI,ADV> ;[4544]


; Below table must be in alphabetical order!

WT:
	XWD	NWKTBC,NWKTBC
	TBL	<ACB>,,NW.ACB	;[1535]
	TBL	<ADS>,,NW.ADS	;[2430]
	TBL	<ADV>,,NW.ADV	;[4544]
	TBL	<AGA>,,NW.AGA
	TBL	<AIL>,,NW.AIL	;[1535]
	TBL	<AIS>,,NW.AIS	;[2305]
	TBL	<ALL>,,NW.ALL
	TBL	<ANS>,,NW.ANS	;[2305]
	TBL	<CAI>,,NW.CAI
	TBL	<CAO>,,NW.CAO
	TBL	<CAP>,,NW.CAP	;[2305]
	TBL	<CCC>,,NW.CCC	;[2305]
	TBL	<CHO>,,NW.CHO
	TBL	<CIS>,,NW.CIS	;[2305]
	TBL	<CNM>,,NW.CNM
	TBL	<CNS>,,NW.CNS	;[2305]
	TBL	<COS>,,NW.COS	;[2305]
	TBL	<COV>,,NW.COV	;[2305]
	TBL	<CSM>,,NW.CSM	;[2305]
	TBL	<CTR>,,NW.CTR
	TBL	<CUO>,,NW.CUO
	TBL	<DEB>,,NW.DEB	;[2305]
	TBL	<DFN>,,NW.DFN	;[2305]
	TBL	<DGI>,,NW.DGI
	TBL	<DIM>,,NW.DIM
	TBL	<DIS>,,NW.DIS
	TBL	<DOW>,,NW.DOW	;[2305]
	TBL	<DPE>,,NW.DPE	;[2305]
	TBL	<DWE>,,NW.DWE	;[2305]
	TBL	<DWL>,,NW.DWL	;[2305]
	TBL	<DXB>,,NW.DXB
	TBL	<EDD>,,NW.EDD	;[2305]
	TBL	<EDS>,,NW.EDS	;[2305]
	TBL	<EDX>,,NW.EDX	;[2305]
	TBL	<EID>,,NW.EID	;[4530]
	TBL	<EIR>,,NW.EIR	;[4501]
	TBL	<EOC>,,NW.EOC	;[2305]
	TBL	<EXD>,,NW.EXD	;[2305]
	TBL	<FAR>,,NW.FAR	;[2305]
	TBL	<FIF>,,NW.FIF	;[2305]
	TBL	<FIN>,,NW.FIN	;[2305]
	TBL	<FMR>,,NW.FMR
	TBL	<FMT>,,NW.FMT	;[2305]
	TBL	<FNA>,,NW.FNA
	TBL	<FNG>,,NW.FNG	;[2305]
	TBL	<FNS>,,NW.FNS	;[2305]
	TBL	<FOO>,,NW.FOO		;[1750]
	TBL	<HCP>,,NW.HCP	;[2305]
	TBL	<HCU>,,NW.HCU	;[2305]
	TBL	<IAT>,,NW.IAT
	TBL	<ICC>,,NW.ICC
	TBL	<ICD>,,NW.ICD
	TBL	<ICS>,,NW.ICS
	TBL	<IDN>,,NW.IDN
	TBL	<IFL>,,NW.IFL
	TBL	<IMN>,,NW.IMN	;[2473]
	TBL	<INC>,,NW.INC	;[2524]
	TBL	<INS>,,NW.INS	;[2305]
	TBL	<IUA>,,NW.IUA
	TBL	<KWU>,,NW.KWU	;[2305]
	TBL	<KWV>,,NW.KWV	;[2305]
				;[4553]
	TBL	<LID>,,NW.LID
	TBL	<LNC>,,NW.LNC	;[2305]
	TBL	<LNE>,,NW.LNE	;[2305]
	TBL	<LOL>,,NW.LOL	;[2305]
	TBL	<LSP>,,NW.LSP	;[2305]
	TBL	<MBD>,,NW.MBD	;[2374]
	TBL	<MLN>,,NW.MLN	;[2305]
	TBL	<MSL>,,NW.MSL	;[2305]
	TBL	<MVC>,,NW.MVC
	TBL	<NAM>,,NW.NAM	;[2305]
	TBL	<NDP>,,NW.NDP	;[2305]
	TBL	<NEC>,,NW.NEC	;[2305]
	TBL	<NED>,,NW.NED
	TBL	<NIB>,,NW.NIB	;[2305]
	TBL	<NIG>,,NW.NIG	;[2305]
	TBL	<NIK>,,NW.NIK	;[2305]
	TBL	<NIS>,,NW.NIS	;[2305]
	TBL	<NIX>,,NW.NIX	;[2305]
	TBL	<NLC>,,NW.NLC	;[2305]
	TBL	<NLK>,,NW.NLK	;[2305]
	TBL	<NOD>,,NW.NOD
	TBL	<NONE>,,NW.NONE
	TBL	<NPC>,,NW.NPC	;[2305]
	TBL	<NPP>,,NW.NPP	;[2305]
	TBL	<NSC>,,NW.NSC	;[2305]
	TBL	<OCU>,,NW.OCU	;[2305]
	TBL	<OIO>,,NW.OIO	;[2305]
	TBL	<PAV>,,NW.PAV
	TBL	<PPS>,,NW.PPS
	TBL	<PWS>,,NW.PWS	;[2305]
	TBL	<RDI>,,NW.RDI
	TBL	<RIM>,,NW.RIM		;[1652]
	TBL	<RLC>,,NW.RLC	;[2305]
	TBL	<RLX>,,NW.RLX	;[2305]
	TBL	<SBC>,,NW.SBC	;[2305]
	TBL	<SBR>,,NW.SBR
	TBL	<SEP>,,NW.SEP	;[2305]
	TBL	<SID>,,NW.SID
	TBL	<SMD>,,NW.SMD	;[2305]
	TBL	<SNN>,,NW.SNN	;[2305]
	TBL	<SNO>,,NW.SNO
	TBL	<SOD>,,NW.SOD
	TBL	<SOR>,,NW.SOR	;[2305]
	TBL	<SPN>,,NW.SPN	;[2305]
	TBL	<SRO>,,NW.SRO	;[2305]
	TBL	<SVN>,,NW.SVN	;[2305]
	TBL	<TLF>,,NW.TLF	;[2305]
	TBL	<TSI>,,NW.TSI
	TBL	<VAI>,,NW.VAI
	TBL	<VFS>,,NW.VFS	;[2305]
	TBL	<VGF>,,NW.VGF	;[2305]
	TBL	<VIF>,,NW.VIF	;[2305]
	TBL	<VKI>,,NW.VKI	;[4500]
	TBL	<VND>,,NW.VND
	TBL	<VNF>,,NW.VNF	;[2305]
	TBL	<VNG>,,NW.VNG	;[2305]
	TBL	<VNI>,,NW.VNI
	TBL	<VNS>,,NW.VNS	;[2305]
	TBL	<VSD>,,NW.VSD	;[2305]
	TBL	<WDU>,,NW.WDU	;[2305]
	TBL	<WNA>,,NW.WNA
	TBL	<WOP>,,NW.WOP
	TBL	<XCR>,,NW.XCR
	TBL	<XEN>,,NW.XEN	;[2305]
	TBL	<XOR>,,NW.XOR	;[2305]
	TBL	<ZMT>,,NW.ZMT


	RELOC	;Back to low segment
	NWWDCT==<<NWKTBC-1>/^D36>+1 ;Words needed for bits

NWBITS:	BLOCK	NWWDCT		;Holds nowarning bits
NWON:	BLOCK	NWWDCT		;Holds nowarning bits that must be on
NWOFF:	BLOCK	NWWDCT		;Holds nowarning bits that must be off
SNWON:	BLOCK	NWWDCT		;Holds nowarning ON bits from command line
				;during SWITCH.INI processing.
SNWOFF:	BLOCK	NWWDCT		;Holds nowarning OFF bits from command line
				;during SWITCH.INI processing.
	RELOC	;Back to high segment
	SUBTTL	/DEBUG Option Masks
; Note that bit 400000 (1_^D17) is reserved for signaling that a
; mask comes from a NO option.  This implementation allows at most
; 17 debugging options (exclusive of ALL, NONE, and the NO forms
; of the options).

	DB.ALL==377777
	DB.DIM==1_0
	DB.LBL==1_1
	DB.IDX==1_2
	DB.TRA==1_3
	DB.BOU==1_4
	DB.ARG==1_5			;[1613]

DT:	XWD	DTL,DTL		;Count of number of entries
	TBL	<ALL>,,DB.ALL
	TBL	<ARGUMENTS>,,DB.ARG	;[1613]
	TBL	<BOUNDS>,,DB.BOU
	TBL	<DIMENSIONS>,,DB.DIM
	TBL	<INDEX>,,DB.IDX
	TBL	<LABELS>,,DB.LBL
	TBL	<NOARGUMENTS>,,^-DB.ARG	;[1613]
	TBL	<NOBOUNDS>,,^-DB.BOU
	TBL	<NODIMENSIONS>,,^-DB.DIM
	TBL	<NOINDEX>,,^-DB.IDX
	TBL	<NOLABELS>,,^-DB.LBL
	TBL	<NONE>,,^-DB.ALL
	TBL	<NOTRACE>,,^-DB.TRA
	TBL	<TRACE>,,DB.TRA
	DTL==.-DT-1
	SUBTTL	/EXTEND keywords added by edit 2220

ET:	XWD	ETL,ETL		;Count of number of entires
	TBL	<CODE>,,.CODE 		;[2442]
	TBL	<COMMON:>,,.COMMON
	TBL	<DATA:>,,.DATA
	TBL	<NOCODE>,,.NOCODE 	;[2442]
	TBL	<NOCOMMON:>,,.NOCOMMON
	TBL	<NODATA>,,.NODATA
	TBL	<PSECT:>,,.PSECT	;[2445]
	ETL==.-ET-1
	SUBTTL /FLAG keywords

;[2246] Add entire table
CF:	XWD	CFL,CFL			;Count of number of entries
	TBL	<ALL>,,CF.ALL
	TBL	<ANSI>,,CF.STD		;[2322] ANSI flagger
	TBL	<NOANSI>,,CF.NOS	;[2322] ANSI flagger
	TBL	<NONE>,,CF.NON
	TBL	<NOVMS>,,CF.NOV		;[2455]
	TBL	<VMS>,,CF.VMS		;[2455]

	CFL==.-CF-1

	XLIST			;Don't list literals
	LIT
	LIST

	END	FORTRA