Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0151/setup.mac
There is 1 other file named setup.mac in the archive. Click here to see a list.
	TITLE SETUP  ****** MCF Editor  Version 5(57) ******				
	SUBTTL *** STORAGE DEFINITION ***
	SEARCH MONSYM,MACSYM

	Comment	^

   The SETUP program was originally developed at the University  of  Montana
   and   is   distributed   by   Carnegie-Mellon   University,   Pittsburgh,
   Pennsylvania under the agreement that any modifications  be  communicated
   back  to  C-MU and that no such modified versions be distributed to other
   installations except by C-MU.

	Revision History

[1]	R. Swick 17-Oct-78. Raise lower case to upper case when expecting a
	command, allow .MCF file to be given on EXEC command line and don't
	replace "!" with ";" at beginning of line.

[2]	R. Swick 18-Oct-78. Add line to beginning of .CTL file giving name
	of .MCF file.

[3]	R. Swick 18-Oct-78 Change ";Def spec cons" to ";Def variable",
	make ";Def cons" a real constant (i.e., don't prompt user for value,
	but get value from <text>).

[4]	R. Swick 18-Oct-78 Don't raise terminal input by default.

[5]	R. Swick 19-Oct-78 Change ;! to ;Type and ;? to ;Ask, and use TBLUK
	jsys for parsing commands so whole word will be verified.
	Version 2.

[6]	R. Swick 26-Oct-78 Make ;Opt and ;No-opt check for ;Sel and
	remove ;If ... commands.

[7]	R. Swick 26-Oct-78 Add ;Include command.

[8]	R. Swick 7-Nov-78 Fix bug in ;Select after ;Option or ;No-option,
	Add ;Check-for, ;Abort, and ;Define option commands.

[9]	R. Swick 9-Nov-78 Add /Verify switch to ;Define var and ;Select opt,
	and don't verify by default.

[10]	R. Swick 20-Nov-78 Use COMND wherever possible, remove prompting for
	MCF file, and add /JOB-ID: switch to SETUP command line.
	Version 3.

[11]	R. Swick 21-Nov-78 Allow just @SETUP exec command to enter
	recognition mode with SETUP> prompt.

[12]	R. Swick 7-Dec-78 Fix bug in ;Ask, add /VERIFY option to ;Ask,
	and fix bug in nested false ;Opt and ;No-opt's.

[13]	R. Swick 8-Dec-78 Make SETSRC flag both upper-case and lower-case for
	each character, so that case will be ignored for options and variables.

[14]	R. Swick 2-Feb-79 Add re-parse address for COMND and help message
	for /JOB-ID:.

[15]	R. Swick 23-Mar-79 Add <job-name> pre-defined constant and insert
	CRLF in record for ;Opt, ;No-opt and ;Check-for rather than deleting
	beginning of line.

[16]	R. Swick 16-Apr-79 Add ;File command.

[17]	R. Swick 24-Apr-79 Add /TAG: switch to command line and abort if
	job-id or tag is longer than 6 chars.

[18]	R. Swick  2-May-79 Add /ALLOW and /SAVE switch to ;Define variable
	and ;Select option commands.
	Version 4.

[19]	R. Swick  7-May-79 Major changes to how variables are found in
	a line in REPVAR (formerly DO.FS).

[20]	R. Swick 16-May-79 Remove vestiges of ;Check-for, add ;Get option
	!variable and ;If "<string1>" [NOT] =!<!> "<string2>", ;Select
	variable, ;Type <nul> to clear screen, clear screen on startup,
	undefined options => no value.

[21]	R. Swick 14-Jun-79 Add <current-year>,<current-month>,<current-day>,
	<julian-date> pre-defined constants, give error for invalid and
	ambiguous commands after ; and ;Error command.

[22]	R. Swick 15-Jun-79 Add option for day of week.

[23]	R. Swick 18-Jun-79 Add ;Perform command.

[24]	R. Swick 23-Jul-79 ;Error will use @IF (ERROR) if only one command
	was given in the text.  ;Perform will undefine the variables used so
	that multiple ;Performs may use the same variables. ;Abort on EOF
	if any warning error occurred.  Insert ; SETUP Version 4(24) input from
	... after /TAG: label so that log shows this.  Fix extra garbage from
	;Include when EOF is reached.  Make directory names work in filespecs
	by breaking a word on ">" only when F%VNM is set.  Be sure to check
	for SETUP.BIN file larger than 1 page and provide /RESET switch for
	resetting list interlocks.

[25]	R. Swick 24-Jul-79 Add ;Perform ... <var1>,<var2>=filespec.
	Allow wildcards in ;File ... found|not-found.

[26]	R. Swick 24-Aug-79 Fix looping in ;Include when file not found.

[27]	R. Swick 30-Aug-79 Don't try to write to .CTL file if found a fatal
	error during initialization.

[30]	R. Swick 11-Sep-79 Fix /DELETE switch to store correct block length
	for the value of the thing deleted.  Also, change STOEMP to store
	blocks in increasing order by size.

[31]	R. Swick 11-Sep-79 Add /BEGIN switch to ;Include to allow
	specification of a BEGIN-OF-JOB-PROCEDURE.MCF, or something similar.

[32]	R. Swick 25-Sep-79 When no files match a ;Perform ...=filspec, before
	giving error msg, make sure that user did not specify a later /TAG:.

[33]	R. Swick 2-Oct-79 Define an option Restart-<tagname> to be yes when
	the /TAG: switch is used.

[34]	R. Swick 3-Oct-79 Add line continuation syntax; "-",";+".

[35]	R. Swick 4-Oct-79 Add compile-time parameter (BINMAX) for max # of
	pages in SETUP.BIN and set it to 2 initially.

[36]	R. Swick 9-Oct-79 Add /DEFINE and /NOECHO switches to ;GET and use a
	common routine for parsing all command switches.  Also trap all output errors
	to CTL file (like Disk Full).  Look for file type .SCF in ;Include
	and ;Perform before looking for .MCF.

[37]	R. Swick. 16-Oct-79.  Don't require a space between ">" and hyphen to continue
	a line and don't require spaces for a nul continuation line (";+-").
	Version 5.

[40]	R. Swick. 1-Nov-79.  Fix /DELETE OPTION to not get illegal instr.

[41]	R. Swick. 29-Nov-79. Fix generation of CTL file name to always add NUL
	after the file type.

[42]	R. Swick. 23-Jan-80. Add /DEFAULT:"<text>" switch to ;Define variable
	and ;Select option commands.

[43]	R. Swick. 23-Jan-80. Open SETUP.BIN for restricted access when /RESETing.

[44]	R. Swick. 23-Jan-80. Add [NOT] NUMERIC condition to ;If.

[45]	R. Swick. 30-Jan-80. Add <CURRENT-USER-NAME> system constant.

[46]	R. Swick. 13-Feb-80. Add control-C trapping so SETUP.BIN doesn't
	get blown away.

[47]	R. Swick. 14-Feb-80. Add ;Leave command and use short GTJFN in
	PFMGFL so as not to assume any unfortunate defaults (such as MCF:!).

[50]	R. Swick. 15-Feb-80. Add ;Begin and ;End commands, make ;Leave work
	for blocks also.

[51]	R. Swick. 21-Feb-80. Fix PFMNXT to correctly round value length
	in words so that 4-char values no longer confuse it.

[52]	R. Swick. 25-Feb-80. Remember to check F%FLS in LEAVE so as not
	to leave blocks prematurely.

[53]	R. Swick. 1-Mar-80. Fix ;Performed blocks to not get errors when
	block was really suppressed.  Also fix ;Perform/verify.  Add
	<CURRENT-HOUR> pre-defined constant.

[54]	R. Swick. 21-Mar-80. Add MCFLOG: and MCFTRACE: logical devices
	with logging and tracing functions.

[55]	R. Swick. 22-Mar-80. Add <Current-Month-Name> pre-defined
	constant and align all values in log display.

[56]	R. Swick. 28-Mar-80. Add tag + offset to trace output and fix
	left-justification of lines prior to checking for continuation.

[57]	R. Swick. 24-Sep-80.  Add /SAVE switch to ;DEFINE CONSTANT and ;DEFINE
	OPTION.  Also show old value on SETUP/OPTION, SETUP/VARIABLE and SETUP/DELETE.

	^
	;**** CHANGEABLE PROGRAM PARAMETERS ****

	MAXCHR==^D500		;MAXIMUM # OF CHAR IN MCF LINE
	ANSLNG==^D150		;MAXIMUM # OF CHAR IN ANSWER LINES
	VARSIZ==1K		;# of words to allocate for linked list for variable
				;and contant names and values
	OPTSIZ==400		;# of word to allocate for linked list for option names
	MAXPFM==5		;maximum # of variables in ;Perform command
	PDLEN==200		;SIZE OF STACK
	CMDCHR==";"		;COMMAND CHARACTER- MUST PRECEDE
				;  ANY SETUP COMMAND
	SPECHR=="<"		;SPECIAL CONSTANT CHARACTER- MUST
				;   PRECEDE SPEC. CONSTANT
	EQUAL=="="		;EQUAL SIGN FOR VERIFICATION
	SPACE==" "		;SPACE FOR ANYTHING
	.WRDCNT==0		;#words used in SETUP.BIN
	.VARST==1		;start of linked list for variables
	.OPTST==2		;start of linked list for options
	.EMPST==3		;start of linked list for empty blocks
	WAITIM==^D10		;milliseconds between waits for access
	MAXTRY==^D200		;max # of trys to get access to list
	BINMAX==2		;[35] max # of pages in SETUP.BIN
	FILCOD==1B18		;[50] code to put in BLKLST for ;Include and ;Perform
	BEGCOD==1B19		;[50] code to put in BLKLST for ;Begin and Error block
	SALL			;MAKE TIDY (SHORTER) LISTING


	;ACCUMULATOR USAGE

	F==0			;FOR FLAGS LH is preserved, RH is zeroed for each line
	.AC4==4
	T1==5
	T2==6
	T3==7
	P1==10			;ACCUMULATORS USED MAINLY TO HOLD BYTE
	P2==11			;	POINTERS
	P3==12
	P4==13
	P5==14
	CH==15			;HOLDS A CHARACTER
	X1==16			;USED AS AN INDEX
	P==17			;push-down pointer


		;FLAGS SET IN F BY DIFFERENT ROUTINES
	EOL==1B35		;END OF  LINE - CARRIAGE RETURN
	SLH==1B34		;SLASH ENCOUNTERED
	SPC==1B33		;ENCOUNTERED A SPACE OR TAB
	F%VNM==1B30		;word was delimited by ">" in GETWRD
	D.VAR==1B29		;flag for Define Variable command
	S%VER==1B29		;flag for ;Select/verify variable command
	P%VER==1B28		;verify user's answer
	F%FNF==1B27		;file not found in ;File command
	F%DEF==1B27		;value defaulted in ;Define/allow or ;Select/allow
	F%BEG==1B27		;[31] /BEGIN switch specified on ;Include command
	P%ALW==1B26		;/ALLOW switch on ;Define and ;Select commands
	P%NEC==1B26		;/NOECHO switch on ;Get command
	P%NTR==1B26		;[54] No TRace record for this undefined reference
	P%SAV==1B25		;/SAVE switch on ;Define and ;Select commands
	F%SHW==1B24		;show previous variable/option value? 1=yes
	F%YND==1B23		;defaulting allowed in Y.OR.N
	F%BRK==1B23		;[42] any special char delimits a word in GETWRD
	P%DEF==1B22		;[42] /DEFAULT: switch specified
	F%EOL==1B21		;[47] End of ;Include or ;Perform level via ;Leave
	F%FAT==1B0		;fatal error in init
	F%TAG==1B1		;/TAG: switch seen
	F%BTW==1B2		;between first tag and /TAG: tag
	F%VAC==1B3		;access granted to variable list in SETUP.BIN
	F%OAC==1B4		;access granted to option list in SETUP.BIN
	F%EAC==1B5		;access granted to empty block list in SETUP.BIN
	F%PFM==1B6		;/VERIFY switch given on ;Perform command
	F%CNT==1B7		;[34] current command line was continued
	F%DCC==1B8		;[46] Double Control-C (^C during ^C handler)
	F%CON==1B9		;[50] current line started with CONditional command
	F%SUP==1B10		;[50] suppress everything inside a non-executed block
	F%FLS==1B11		;[50] suppress after a false conditional command
		;SOME MACROS
		;**** ONE TO TYPE A STRING ****
	DEFINE TYPE (ADRS) <
		HRROI .AC1,ADRS
		PSOUT>

		;**** ONE TO TYPE 1 CHAR ****
	DEFINE TYPE1 (CHAR) <
		IFE CHAR,<PRINTX TYPE1 MACRO CALL ERROR>
		MOVEI .AC1,CHAR
		PBOUT>

		;**** ONE TO READ A LINE ****
	DEFINE ACCEPT (ADRS,LENGTH,PROMPT<0>,FLAGS<0>) <
		HRROI	.AC1,ADRS
		MOVE	.AC2,[RD%BEL+FLAGS+LENGTH]
		  IFE PROMPT,< SETZ  .AC3, >
		  IFN PROMPT,< HRROI .AC3,PROMPT >
		RDTTY>

	DEFINE	PARSE(typ,flgs,data,hlpm,def,lst)<
		MOVEI	.AC1,CMBLOK
		MOVEI	.AC2,[FLDDB. <typ>,<flgs>,<data>,<hlpm>,<def>,<lst>]
		COMND
		TDNE	.AC1,[CM%NOP]>

	DEFINE ITEM(text,addr)<
		XWD	[ASCIZ /text/],addr>


	DEFSTR	(VALLEN,,^D5,^D6)	;data structure for # words in value
	DEFSTR	(VALLOC,,^D17,^D12)	;data structure for addr of value
	DEFSTR	(FWDPTR,,^D35,^D18)	;data structure for linked list pntr

	OPDEF	RETSKP[JRST RSKP]	;[40] necessary for latest MACSYM
		SUBTTL ***MAIN PROGRAM***
START:	MOVE	P,[IOWD	PDLEN,PDLIST] ;INITIALIZE stack
	SETZ	F,		;clear all flags
	CALL	INIT		;GO INIT AND GET FILE NAMES
	TXNE	F,F%FAT		;got a fatal error?
	JRST	[MOVE	T1,ERRMES ;yep, then get error msg
		 JRST	FATAL]
	MOVEI	.AC1,FILCOD	;[50] make top block a file type block
	MOVEM	.AC1,BLKTYP	;[50]
	MOVE	.AC2,[ASCIZ /^Top/] ;[50] make up a block name
	MOVEM	.AC2,BLKNAM
	CALL	SETUP		;do everything interesting!
	MOVE	.AC2,[ASCIZ /^Top/] ;[50] check current block name
	CAME	.AC2,BLKNAM	;[50]
	JRST	BLKEND		;[50] unequal, so say block didn't end
	TXNN	F,F%BTW		;still "between" labels?
	TXNE	F,F%TAG		;nope, then was /TAG: given?
	JRST	TAGNFD		;yep, then tag not found
	TXNE	F,F%FAT		;did a warning error occur?
	JRST	[MOVE	P1,[POINT 7,[ASCIZ /Errors in MCF/]] ;yep, then fudge input pointer
		 JRST	CMQUIT]	;and do an ;Abort command
	CALL	LOGPRT		;[54] print log page if MCFLOG: is defined
	CALL	TYCRLF
	MOVEI	.AC1,"["
	PBOUT
	MOVEI	.AC1,.PRIOU	;show on terminal
	MOVE	.AC2,OUTJFN	;name of output file
	MOVE	.AC3,[1B2+1B5+1B8+1B11+1B14+JS%PAF] ;show full file spec
	JFNS
	TYPE	[ASCIZ / complete/]
	MOVEI	.AC1,"]"
	PBOUT
	CALL	RELBIN		;release SETUP.BIN
	MOVNI	.AC1,1		;close all jfns
	CLOSF
	  NOP
	RELD			;RELEASE ALL DEVICES
	  NOP
	HALTF			;stop this fort
	JRST	.-1		;can't guarantee this is continuable
; Main processing routine

SETUP:
	AOS	SLEVEL		;[47] increment nest level
SETUP0:	TXZ	F,F%CON+F%FLS	;[50] reset CONditional and FaLSe flags
	TXZN	F,F%EOL		;[47] skip if end of level reached
	CALL	GETLIN		;get a mcf line
;[47]	  RET			;none there, then return
	  JRST	[SOS	SLEVEL	;[47] decrement nest level
		 RET]		;[47] and goback
	MOVEM	F,SAVFLG	;[50] save current flags
	CALL	REPVAR		;replace any variables
	MOVE	P1,[POINT 7,LINE] ;reset pointer
CONLIN:
	TRZ	F,-1		;clear all flags for new line
	CALL	MOVSPC		;ignore leading spaces
	  NOP			;ignore errors
	MOVEM	P1,SAVPNT	;SAVE CURRENT POINTER
	ILDB	CH,P1		;CHECK FOR POSSIBLE SETUP CMD
	CAIE	CH,CMDCHR	;IS IT RIGHT PRECEDING CHAR ?
	JRST	RESPNT		;NO - WRITE LINE
	MOVE	P2,[POINT 7,ANSW1]
	CALL	GETWRD
	  JRST	RESPNT		;no word, then no SETUP command!
	MOVEI	.AC1,COMTAB	;address of command table
	MOVE	.AC2,[POINT 7,ANSW1] ;pointer to command given
	TBLUK			;find a match
	TXNE	.AC2,TL%NOM	;no match?
	JRST	INVCMD		;invalid command
	TXNE	.AC2,TL%AMB	;ambiguous?
	JRST	AMBCMD		;yep
	HRRZ	T2,(.AC1)	;found command, then get dispatch addr
	CALL	(T2)		;call appropriate command routine
	  SKIPA			;error during processing or no continuation
	JRST	CONLIN		;continue with same line
RESPNT:	MOVE	P1,SAVPNT	;return here to write line
	CALL	WRTLIN		;write line to CTL file
	JRST	SETUP0		;[47] get next line
	SUBTTL	*** COMMAND TABLE ***

COMTAB:	XWD	COMTBL,COMTBL
	ITEM	ABORT,CMQUIT	;Abort routine
	ITEM	ASK,ASKIT	;Ask routine
	ITEM	BEGIN,BEGIN	;[50] Begin a block
	ITEM	DEFINE,DEFINE	;Define routine
	ITEM	END,CMEND	;[50] End a block
	ITEM	ERROR,CMERR	;Error routine
	ITEM	FILE,FILE	;File routine
	ITEM	GET,CMGET	;Get routine
	ITEM	IF,CMIF		;If routine
	ITEM	INCLUDE,INCLUD	;Include routine
	ITEM	LEAVE,LEAVE	;[47] Leave level of nesting prematurely
	ITEM	NO-OPTION,OPT.N	;No-option routine
	ITEM	OPTION,OPT.Y	;Option routine
	ITEM	PERFORM,PERFRM	;Perform routine
	ITEM	SELECT,SELECT	;Select routine
	ITEM	TYPE,TYPEIT	;Type routine

	COMTBL==.-COMTAB-1	;number of commands in table
	SUBTTL *** COMMAND SUBROUTINES ***

; ;Option and ;No-option commands
;
; Returns +1: Condition is false, write entire line
;	  +2: Condition is true, P1 points to following text

OPT.N:	TDZA	T2,T2		;DELETE IF NOT SELECTED
OPT.Y:	MOVNI	T2,1		;DELETE IF SELECTED
	TXO	F,F%CON		;[50] set CONditional flag
	CALL	MOVSPC		;position to option name
	  JRST	OPTNAM		;ERROR- OPTION NAME NOT THERE
	MOVE	P2,[POINT 7,ANSW1] ;SETUP POINTER TO REC. AREA
	CALL	GETWRD		;GET OPTION NAME
	  JRST	OPTLNG		;LENGTH ERROR
	TRNE	F,EOL		;EOL?
	  JRST	OPTSLH		;NO SLASH AS TERMINATOR
	SETZ	.AC1,		;start at head of list
	MOVE	.AC2,[POINT 7,ANSW1]
	MOVEI	.AC3,OPTLST	;option list
	CALL	SRCHLL		;find option in list
	  JRST	[SETZ	T1,	;no value for this option, then false
		 JRST	OPT1]
	MOVE	.AC1,LSTPTR	;addr of option
	LOAD	T1,VALLOC,OPTLST(.AC1) ;get option value
	SKIPE	T1
	MOVNI	T1,1		;extend sign
OPT1:	CAME	T1,T2		;value equal to requested value?
;[50]	  RET			;no, then false
	CALL	SETFLS		;[50] set false condition
	TRNE	F,SLH		;NEED "/" FOR TERMINATOR
	JRST	OPT2		;got one already
	LDB	CH,P1		;look at current char
	CAIE	CH,"/"		;is it slash?
	JRST	[CALL	MOVSPC	;MOVE POINTER TO SLASH
		   JRST	OPTSLH	;MISSED
		 ILDB	CH,P1	;GET IT
		 CAIE	CH,"/"	;MAKE SURE
		 JRST	OPTSLH	;CAUGHT YA!
		 JRST	.+1]
OPT2:	CALL	WRTBEG		;write beginning of line + CRLF
	MOVEM	P1,SAVPNT	;ignore beginning of line
	CALL	REMCNT		;[34] remove any continuation syntax
	CALL	INSLIN		;replace all "//" with CRLFs
RSKP:	AOS	(P)		;skip-return
	RET
; Substitute values for all constants and variables in LINE
; Constants and variables are single words (possibly hypenated) enclosed in
; "<" and ">".  Anything looking like a variable that is not defined in
; VARLST is ignored and no substitution is made.
;
; Returns +1 always

REPVAR:
	MOVE	.AC1,[LINE,,ANSW1] ;first move entire line to ANSW1
	BLT	.AC1,ANSW1+<MAXCHR/5>-1
	MOVE	P3,[POINT 7,ANSW1] ;setup current line pointer
	MOVE	P4,[POINT 7,LINE] ;where to put final line
REPV1:	MOVEM	P3,P1		;save current pointer
	ILDB	CH,P3		;get a char
	CAIN	CH,SPECHR	;likely start of variable?
	JRST	REPV2		;yep
	IDPB	CH,P4		;put char in final line
	SKIPN	CH		;found end of line?
	RET			;yep, then all-done
	JRST	REPV1		;and back for more
REPV2:	MOVE	P2,[POINT 7,ANSW2] ;put variable name here
	TXO	F,F%VNM		;break on ">"
	CALL	GETWRD		;get variable name
	  SKIPA			;if not found, then can't be a <name>
	TXZN	F,F%VNM		;was word delimited by ">"?
	JRST	[MOVEI	CH,SPECHR ;nope, then replace beginning "<"
		 IDPB	CH,P4
		 JRST	REPV1]	;and continue
	SETZ	.AC1,		;start at head of list
	MOVE	.AC2,[POINT 7,ANSW2]
	MOVEI	.AC3,VARLST	;linked list for variable names
	CALL	SRCHLL		;look for variable in list
	  JRST	[MOVEI	CH,SPECHR ;not found, then continue normally
		 IDPB	CH,P4
		 JRST	REPV1]
	MOVNI	P3,1		;first, save new line pointer
	ADJBP	P3,P1		;but backup over word delimiter
	MOVE	.AC1,LSTPTR	;get addr of item
	LOAD	P1,VALLOC,VARLST(.AC1) ;get variable value address
	ADDI	P1,VARLST	;make it absolute
	HLL	P1,[POINT 7,0]	;make it a byte pointer
	ILDB	CH,P1		;get a char
	SKIPN	CH		;reached end of value yet?
	JRST	REPV1		;yep
	IDPB	CH,P4		;put value into "output"
	JRST	.-4		;and back for more
; Execute a ;Type command
;
; Returns +1 always

TYPEIT:
	TXNE	F,F%BTW!F%SUP!F%FLS ;[50] don't bother if between tags
	RET
	LDB	CH,P1		;look at delimiter char
	MOVEI	.AC1,LINTTY	;assume some text to type
	CAIN	CH,15		;end of line?
	MOVEI	.AC1,CLRTTY	;yep, then really wants to clear screen
	CALL	(.AC1)		;call appropriate routine
	RET



CLRTTY:		;Clear terminal screen on VT52 (type 15) or PE1100 (type 16)
		; Returns +1 always

	MOVEI	.AC1,.PRIOU
	RFMOD			;get jfn mode word in AC2
	PUSH	P,.AC2		;save it
	TXZE	.AC2,TT%DAM	;set TERM NO TRANSL
	SFMOD
	GTTYP			;get terminal type in AC2
	HRROI	.AC1,CRLF	;default to blank line only
	CAIE	.AC2,.TTV52	;really a VT52?
	CAIN	.AC2,.TTFOX	;or a PE1100 (FOX)?
	HRROI	.AC1,[BYTE (7)33,"H",33,"J",0] ;yep, then clear screen
	PSOUT			;do it
	MOVEI	.AC1,.PRIOU
	POP	P,.AC2		;retrieve original mode word
	SFMOD			;restore terminal characteristics
	RET
; Execute an ;Ask command
;
; Returns +1 always

ASKIT:
	TXNE	F,F%BTW!F%SUP!F%FLS ;[50] if between tags on restart,
	RET			;then ignore the command
	CALL	MOVSPC		;position to next word
	  JRST	ASKILC		;not there, then invalid
	MOVEI	.AC1,[XWD  1,1	;[36] legal switches for ;Ask
		      ITEM VERIFY,P%VER]
	CALL	GETSWT		;[36] parse the switches
	  RET			;[36] an error
	  JRST	ASKIT		;[36] found one switch, so look again
	PUSH	P,P1		;save current line pointer
	MOVE	P1,SAVPNT	;write output prompt to CTL file
	ILDB	CH,P1		;look for CRLFs followed by more data
	CAIN	CH,15
	JRST	[MOVE	T1,P1	;found CR, is next LF?
		 ILDB	CH,P1
		 CAIE	CH,12
		 JRST	.+1	;nope, then continue
		 ILDB	CH,P1	;is there more after this?
		 SKIPG	CH
		 JRST	.+1
		 MOVEI	CH,"/"	;yep, then replace with "//" again
		 DPB	CH,T1
		 IDPB	CH,T1
		 JRST	.+1]
	SKIPE	CH		;reached end yet?
	JRST	.-4
	MOVE	P1,SAVPNT
	CALL	WRTLIN
	MOVE	P1,(P)		;retrieve line pointer once more
	CALL	INSLIN		;replace all "//" with CRLFs
	POP	P,P1		;restore line pointer
ASK2:	CALL	TYCRLF		;format the TTY
	CALL	LINTTY		;TYPE IT OUT
	ACCEPT	ANSW1, MAXCHR-2	;GET AN ANSWER
	  NOP			;IGNORE ANY ERRORS (HOPEFULLY)
	TLNN	.AC2,(RD%BTM)	;TEST FOR BREAK CHARACTER
	JRST	ANSTL		;NOT THERE- MUST HAVE TYPED TOO MUCH
	TRNN	F,P%VER		;verification needed?
	JRST	ASK3		;nope
	TYPE	ANSW1		;TYPE ANSWER
	TYPE	[ASCIZ/OK? /]
	CALL	Y.OR.N		;EVERYTHING OK?
	  JRST	ASK2		;NO
ASK3:	LDB	CH,[POINT 7,ANSW1,6] ;get first char
	CAIN	CH,15		;end of line?
	JRST	ASKNAG		;no answer given
	MOVE	P1,[POINT 7,ANSW1] ;SETUP POINTER TO WRITE ANSWER OUT
	MOVEM	P1,SAVPNT
	RET
; Execute a ;Define command
;
; Returns +1 always

DEFINE:
	TXNE	F,F%SUP!F%FLS	;[50] suppress this command?
	RET			;[50] yep
	CALL	MOVSPC		;position to next word
	  JRST	DEFINC		;no next word, then illegal
	MOVEI	.AC1,[XWD  4,4	;[42] table of legal switches for ;Define
		      ITEM ALLOW,P%ALW
		      ITEM DEFAULT,P%DEF ;[42]
		      ITEM SAVE,P%SAV
		      ITEM VERIFY,P%VER]
	CALL	GETSWT		;[36] parse any switches
	  RET			;[36] an error
	  JRST	DEFINE		;[36] one switch found, so look again
	TXNE	F,P%ALW!P%SAV	;[42] was /ALLOW or /SAVE specified?
	JRST	[TXNE	F,P%DEF	;[42] yep, then was /DEFAULT: given also?
		 JRST	DEFNOA	;[42] yep, then say this isn't allowed
		 JRST	.+1]	;[42]
	MOVE	P2,[POINT 7,ANSW1]
	CALL	GETWRD			;get the option type
	  JRST	DEFUNK
	MOVEI	.AC1,[XWD  3,3		;table of ;Define options
		      ITEM CONSTANT,DEFCNS
		      ITEM OPTION,DEFOPT
		      ITEM VARIABLE,DEFVAR]
	MOVE	.AC2,[POINT 7,ANSW1] ;pointer to option
	TBLUK			;find a match
	TXNE	.AC2,TL%NOM!TL%AMB ;no match?
	JRST	DEFUNK		;then invalid ;Define command
	HRRZ	.AC1,(.AC1)	;.AC1=0 if cons, =1 if var
	CALL	(.AC1)		;call appropriate define routine
	RET
; Called from DEFINE to define a variable
;
; Returns +1 always

DEFVAR:
	TXNE	F,F%BTW		;between tags on restart?
	RET
	CALL	MOVSPC		;position to variable name
	  JRST	DEFNO		;no variable name specified
	CAIE	CH,SPECHR	;does it start with magic char?
	JRST	DEFIFC		;illegal first character
	MOVE	P2,[POINT 7,ANSW1] ;put variable name here
	TXO	F,F%VNM		;break on ">"
	CALL	GETWRD
	  JRST	DEFCTL		;ERROR- NAME TOO LONG
	TXZN	F,F%VNM		;was name terminated with ">"?
	JRST	DEFILN		;invalid variable name
	MOVEM	P1,PUTPNT	;SAVE PTR TO INSRT VAL IN LINE
	CALL	MOVSPC		;position to prompting text
	  JRST	DEFNTX		;no text description
	SETZM	ATMBUF		;no second prompt as in ;Select variable
	TXNE	F,P%ALW+P%SAV	;allowing defaults or saving?
	CALL	GETVAR		;get variable value
	TXNE	F,P%DEF		;[42] was a default specified?
	TXO	F,F%SHW		;[42] yep, then show the default value
	CALL	DEFGET		;get all info for variable
	  RET			;got an error, so don't continue
	TXNE	F,P%SAV		;should value be /SAVEd?
	TXNE	F,F%DEF		;yep, then don't save if default was used
	SKIPA
	CALL	DEFSAV
	MOVE	.AC1,[POINT 7,ANSW2] ;variable value is here
	MOVEM	.AC1,PUTVAL	;setup for variable value insertion
	CALL	DEFSTO		;store value in list
	  NOP
	RET
; Called from DEFINE to define a constant
;
; Returns +1 always

DEFCNS:
;[57]	TXNE	F,P%VER!P%ALW!P%SAV!P%DEF ;[42] any switches?
	TXNE	F,P%VER!P%ALW!P%DEF ;[57] any unsupported switches?
	JRST	DEFSWT		;invalid switch
	CALL	MOVSPC		;position to variable name
	  JRST	DEFNO		;no variable name specified
	CAIE	CH,SPECHR	;does it start with magic char?
	JRST	DEFIFC		;illegal first character
	MOVE	P2,[POINT 7,ANSW1] ;put variable name here
	TXO	F,F%VNM		;break on ">"
	CALL	GETWRD
	  JRST	DEFCTL		;ERROR- NAME TOO LONG
	TXZN	F,F%VNM		;was name terminated with ">"?
	JRST	DEFILN		;invalid variable name
	CALL	MOVSPC		;position to prompting text
	  JRST	DEFNTX		;no text description
	MOVE	.AC1,[POINT 7,ANSW2] ;where to put the value
	SETZB	.AC4,CH		;.AC4=count of characters in value
DEFCN1:	ILDB	CH,P1
	CAIE	CH,15		;saw CR?
	CAIN	CH,12		;or LF?
	JRST	.+3		;yep, then end of value
	IDPB	CH,.AC1		;nope, then deposit it
	AOJA	.AC4,DEFCN1	;and back for more
	SETZ	CH,
	IDPB	CH,.AC1		;make it ASCIZ
	ADDI	.AC4,5		;round up +1 for nul char
	IDIVI	.AC4,5		;get # words
	MOVEM	.AC4,ITMLEN	;save it
	TXNE	F,P%SAV		;[57] was /SAVE specified?
	CALL	DEFSAV		;[57] yep, then save it now
	CALL	DEFSTO		;store it as for a variable
	  NOP
	RET
; Called from DEFINE to define an option
;
; Returns +1 always

DEFOPT:
;[57]	TXNE	F,P%VER+P%ALW+P%SAV!P%DEF ;[42] any switches?
	TXNE	F,P%VER!P%ALW!P%DEF ;[57] any unsupported switches?
	  JRST	DEFSWT		;yep, then invalid
	CALL	MOVSPC		;position to next word
	  JRST	DEFNOP		;no next word!
	MOVE	P2,[POINT 7,ANSW1] ;where to put option name
	CALL	GETWRD		;get option name
	  JRST	DEFNOP		;not there
	SETZ	.AC1,		;start at head of option list
	MOVE	.AC2,[POINT 7,ANSW1] ;find option name
	MOVEI	.AC3,OPTLST	;in option list
	CALL	SRCHLL
	  SKIPA			;hope to return here
	JRST	SELOAS		;option already selected
	CALL	MOVSPC		;position to answer
	  JRST	DEFNAN		;no answer
	ILDB	.AC1,P1		;get first char of answer
	CAIL	.AC1,"a"	;lowercase?
	SUBI	.AC1,"a"-"A"	;yep, then raise it
	SETZ	.AC2,		;.AC4=answer
	CAIN	.AC1,"Y"	;"yes"?
	MOVEI	.AC2,1		;yep
	CAIN	.AC1,"N"	;"no"?
	MOVEI	.AC2,2		;yep
	SKIPN	.AC2		;got an answer?
	JRST	INIIVO		;nope, invalid
	SUBI	.AC2,2		;yes=-1, no=0
	MOVEM	.AC2,SVALUE	;setup option value
	TXNE	F,P%SAV		;[57] was /SAVE specified?
	CALL	SELSAV		;[57] yep, then save option now
	CALL	SELSTO		;store option value
	  NOP			;ignore any errors
	RET
; Called from DEFVAR and SELVAR to prompt for a variable and accept its value
;
; Returns +1 if error occurred
;	  +2 if no error, value in ANSW2

DEFGET:
	CALL	TYCRLF		;FORMAT IT
	CALL	LINTTY		;TYPE TEXT
DEFGT1:	TXZ	F,F%DEF		;assume default not used
	TYPE	ATMBUF		;type ;Select variable value list
	TYPE	ANSW1		;type variable name
	TXNE	F,F%SHW		;should previous value be shown?
	JRST	[TMSG	( [)	;yep, then display it
		 HRROI	.AC1,SVALUE ;pointer to default value
		 PSOUT
		 TMSG	(])
		 JRST	.+1]
	TYPE1	EQUAL
	ACCEPT	ANSW2, ANSLNG-2	;read variable's definition
	  JFCL			;IGNORE ERRORS
	TLNN	.AC2,(RD%BTM)	;WAS BREAK CHAR TYPED?
	JRST	DEFLNG		;NO- MUST LENGTH ERROR
	MOVE	T1,.AC1		;SAVE POINTER TO END OF ANSWER
				;   FOR FUTURE ADJUSTMENTS (ADJBP)
	HRRZS	.AC2		;ISOLATE NUMBER OF REMAINING BYTES
	MOVEI	.AC4,ANSLNG-2	;CALCULATE NUMBER OF
	SUBI	.AC4,2(.AC2)	;   BYTES ACTUALLY TYPED
	SKIPG	.AC4		;defaulted?
	JRST	[TXNN	F,P%ALW!P%DEF ;[42] yep, then was defaulting allowed?
		 JRST	DEFNDF	;nope
		 MOVE	.AC1,[SVALUE,,ANSW2]
		 MOVE	.AC2,ITMLEN
		 ADDI	.AC2,ANSW2-1
		 BLT	.AC1,(.AC2) ;move default value to answer
		 TXO	F,F%DEF	;don't bother to save "new" value
		 JRST	.+2]
	MOVEM	.AC4,ITMLEN	;save character count just in case
	TRNN	F,P%VER		;verify answer?
	JRST	DEFGT2		;nope
	TYPE	ANSW1		;type variable's name
	TYPE1	EQUAL
	TYPE	ANSW2		;TYPE IT'S REPLACEMENT
	HRROI	.AC1,CRLF	;prepare to type CRLF if necessary
	TXNE	F,F%DEF		;was default value used?
	PSOUT			;yep, then type CRLF also
	TYPE	[ASCIZ /OK? /]
	CALL	Y.OR.N		;ACCEPTABLE?
	  JRST	DEFGT1		;NO
DEFGT2:
	TXNE	F,F%DEF		;was default used?
	RETSKP			;yep, then no need to compute length
	MOVNI	.AC1,2		;YES- BACKUP POINTER OVER <CR><LF>
	ADJBP	.AC1,T1
	SETZ	CH,
	IDPB	CH,.AC1		;MAKE ASCIZ STRING
	MOVE	.AC1,ITMLEN	;retrieve character count
	ADDI	.AC1,5		;round up + nul char
	IDIVI	.AC1,5		;get # words
	MOVEM	.AC1,ITMLEN	;save for later
	RETSKP
; Called from DEFGET and CMGET to retrieve variable value from SETUP.BIN
;
; Returns +1 always

GETVAR:
	TXO	F,F%SHW		;set "show value" flag
	MOVEI	.AC1,.VARST	;need access to variable list
	CALL	ACCESS		;get it
	MOVEI	.AC1,.VARST	;get start of variable list
	MOVE	.AC2,[POINT 7,ANSW1] ;variable to look for
	MOVEI	.AC3,BINDEF	;want binary file list
	CALL	SRCHLL		;find it
	  JRST	[TXZ	F,P%ALW+F%SHW ;if not found, then same as not /ALLOW
		 CALL	CLRACS	;clear all list access
		 RET]
	MOVE	.AC1,LSTPTR
	LOAD	.AC2,VALLOC,BINDEF(.AC1) ;make a byte pointer to value
	ADDI	.AC2,BINDEF	;make it absolute
	HRL	.AC2,.AC2
	HRRI	.AC2,SVALUE	;move ANSW2 to SVALUE
	LOAD	.AC1,VALLEN,BINDEF(.AC1) ;get word count
	MOVEM	.AC1,ITMLEN	;store it
	MOVEI	.AC3,SVALUE-1(.AC1) ;last word to move
	BLT	.AC2,(.AC3)	;move default value
	CALL	CLRACS
	RET
; Called from DEFVAR and SWVAR to save new variable value in SETUP.BIN
;
; Returns +1 always

DEFSAV:
	MOVE	.AC1,[-1,,.EMPST] ;need access to empty-block list
	CALL	ACCESS		;get it
	MOVE	.AC1,[-1,,.VARST] ;get access to variable list also
	CALL	ACCESS
	MOVEI	.AC1,.EMPST	;get addr of start of empty block list
	MOVE	.AC2,ITMLEN	;get word count in R2
	CALL	SRCHMT		;find an empty block
	PUSH	P,.AC1		;save value address for a bit
	ADDI	.AC1,BINDEF	;get absolute address
	ADDI	.AC2,-1(.AC1)	;get final word
	HRLI	.AC1,ANSW2	;move answer 2 to there
	BLT	.AC1,(.AC2)	;do it
	MOVEI	.AC1,.VARST
	MOVE	.AC2,[POINT 7,ANSW1] ;look for variable in list
	MOVEI	.AC3,BINDEF
	CALL	SRCHLL
	  JRST	DEFSV1		;if not found, then no need to delete old value
	MOVE	.AC1,LSTPTR	;get item pointer
	LOAD	.AC2,VALLEN,BINDEF(.AC1) ;get old value length
	LOAD	.AC1,VALLOC,BINDEF(.AC1) ;get value address
	CALL	STOEMP		;store this empty-cell
	JRST	DEFSV2		;no need to store variable name
DEFSV1:	MOVE	.AC1,[POINT 7,ANSW1] ;byte pointer to variable name
	SETZ	.AC2,		;count of bytes in name
	ILDB	.AC3,.AC1	;get a char
	SKIPE	.AC3		;end reached yet?
	AOJA	.AC2,.-2	;nope
	ADDI	.AC2,5		;round up, including nul
	IDIVI	.AC2,5		;get #words
	AOJ	.AC2,		;plus 1 for header
	MOVEI	.AC1,.EMPST	;start of empty block list
	CALL	SRCHMT		;find a place for it
	MOVEM	.AC1,.AC3	;save address
	ADDI	.AC1,BINDEF	;make an absolute address
	ADD	.AC2,.AC1	;get addr of last word to move
	AOJ	.AC1,		;leave room for header
	HRLI	.AC1,ANSW1	;move name to there
	BLT	.AC1,-1(.AC2)	;move name
	MOVE	.AC1,LSTPTR	;addr of preceeding item
	LOAD	.AC2,FWDPTR,BINDEF(.AC1) ;get old forward pointer
	STOR	.AC3,FWDPTR,BINDEF(.AC1) ;make it point to this one
	STOR	.AC2,FWDPTR,BINDEF(.AC3) ;this one points to next
	SKIPA
DEFSV2:	MOVE	.AC3,LSTPTR	;addr of item in list
	POP	P,.AC1		;retrieve value address
	STOR	.AC1,VALLOC,BINDEF(.AC3) ;store it
	MOVE	.AC1,ITMLEN	;restore value length in words
	STOR	.AC1,VALLEN,BINDEF(.AC3) ;and store it
	CALL	CLRACS
	RET
; Store the empty-cell pointed to by .AC1, length .AC2 in the empty-cell list
;
; Returns +1 always

STOEMP:
	STOR	.AC2,VALLEN,BINDEF(.AC1) ;set block length
	MOVEI	.AC3,.EMPST	;beginning of empty-block list
	PUSH	P,.AC1		;save current block pointer for a bit
	LOAD	.AC4,FWDPTR,BINDEF(.AC3) ;get forward pointer of empty list
	LOAD	.AC1,VALLEN,BINDEF(.AC4) ;get length of this block
	CAMLE	.AC2,.AC1	;if block is larger than size of this one
	JRST	[SKIPG	.AC4	;put this block at end of list in order to
		 JRST	.+1	; reduce fragmentation of long blocks
		 MOVEM	.AC4,.AC3
		 JRST	.-3]	;and check length of next block
	POP	P,.AC1		;restore current block pointer
	STOR	.AC1,FWDPTR,BINDEF(.AC3) ;point to current block
	STOR	.AC4,FWDPTR,BINDEF(.AC1) ;current points to next
	RET
; Store the value of the variable/constant named in ANSW1, value in ANSW2
;
; Returns +1 error occurred
;	  +2 no error, value stored in VARLST

DEFSTO:
	SETZ	.AC1,		;start at head of list
	MOVE	.AC2,[POINT 7,ANSW1] ;look for variable in list already
	MOVEI	.AC3,VARLST	;variable list
	TXO	F,P%NTR		;[54] set No TRace flag
	CALL	SRCHLL
	  SKIPA			;hope to return here
	JRST	DEFIER		;very extraordinary circumstance!
	TXZ	F,P%NTR		;[54] reset No TRace
	MOVE	.AC1,VAREND	;where to put this variable name
	ADDI	.AC1,VARLST	;make it absolute
	HLL	.AC1,[POINT 7,0,35] ;make it a byte pointer
	MOVE	.AC2,[POINT 7,ANSW1] ;variable name
	ILDB	CH,.AC2
	IDPB	CH,.AC1
	SKIPE	CH
	JRST	.-3		;loop 'till nul char is found
	TLZ	.AC1,-1
	ADDI	.AC1,1		;get addr of place for value
	MOVEM	.AC1,.AC3	;save it since BLT won't
	MOVE	.AC2,.AC1	;put in R2 also
	HRLI	.AC1,ANSW2	;value is currently here
	ADD	.AC2,ITMLEN	;last addr needed
	CAILE	.AC2,VARLST+VARSIZ ;reached end of table yet?
	JRST	DEFESP		;yep, then too many variables
	BLT	.AC1,(.AC2)	;move value
	SUBI	.AC3,VARLST	;make address it relative
	SUBI	.AC2,VARLST	;make end address relative
	EXCH	.AC2,VAREND	;update end of list, get old end
	STOR	.AC3,VALLOC,VARLST(.AC2) ;and store value address
	MOVE	.AC1,LSTPTR	;addr of prior variable
	LOAD	.AC3,FWDPTR,VARLST(.AC1) ;get forward pointer
	STOR	.AC2,FWDPTR,VARLST(.AC1) ;store current address there
	STOR	.AC3,FWDPTR,VARLST(.AC2) ;store old forward pointer in new slot
	MOVE	.AC1,ITMLEN
	STOR	.AC1,VALLEN,VARLST(.AC2)
	MOVEM	.AC2,LSTPTR
	SKIPE	.AC1,TRCJFN	;[54] get trace jfn, skip if none defined
	CALL	TRCVAR		;[54] defined, so output a new variable def
	RETSKP
;	Output a trace record giving new variable definition
;
;	Accepts: AC1 = jfn of trace file
;		 ANSW1 = variable name
;		 ANSW2 = variable value
;
;	Returns: +1 always

TRCVAR:
	CALL	LINOUT		;output current line number
	HRROI	.AC2,[ASCIZ /Variable /]
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,ANSW1
	SOUT%			;output name
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / defined as "/]
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,ANSW2
	SOUT%			;output value
	  ERJMP	SYSFAT
	MOVEI	.AC2,42		;output terminating quote
	BOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,CRLF	;output <CR><LF>
	SOUT%
	  ERJMP	SYSFAT
	RET
;Process ;Select option command
;
; Returns +1 always

SELECT:
	TXNE	F,F%BTW!F%SUP!F%FLS ;[50] if between tags on restart
	RET			;then ignore the command
	CALL	MOVSPC		;find next word
	  JRST	SELINC		;not there, then invalid
	MOVEI	.AC1,[XWD  4,4	;[42] table of legal switches for ;Select
		      ITEM ALLOW,P%ALW
		      ITEM DEFAULT,P%DEF ;[42]
		      ITEM SAVE,P%SAV
		      ITEM VERIFY,P%VER]
	CALL	GETSWT		;[36] parse any switches
	  RET			;[36] an error occurred
	  JRST	SELECT		;[36] found one switch, so look again
	TXNE	F,P%ALW!P%SAV	;[42] was /ALLOW or /SAVE specified?
	JRST	[TXNE	F,P%DEF	;[42] yep, then was /DEFAULT: given also?
		 JRST	DEFNOA	;[42] yep, then say this isn't allowed
		 JRST	.+1]	;[42]
	MOVE	P2,[POINT 7,ANSW1]
	CALL	GETWRD
	  JRST	SELUNK
	MOVEI	.AC1,[XWD  2,2	;table of ;Select options
		      ITEM OPTION,SELOPT
		      ITEM VARIABLE,SELVAR]
	MOVE	.AC2,[POINT 7,ANSW1] ;pointer to next word
	TBLUK			;try to match
	TXNE	.AC2,TL%NOM!TL%AMB ;is it valid?
	JRST	SELUNK		;nope, invalid option
	CALL	MOVSPC		;position to next word
	  JRST	SELMIS		;NOT THERE- MISSING OPTION NAME
	HRRZ	.AC1,(.AC1)	;get dispatch address
	CALL	(.AC1)		;execute the command
	RET			;yep, then return+1
; Called from SELECT to select a yes/no option
;
; Returns +1 always

SELOPT:
	TXNN	F,P%DEF		;[42] was a /DEFAULT: switch given?
	JRST	SELOP1		;[42] nope, then don't test the value
	LDB	CH,[POINT 7,SVALUE,6] ;[42] yep, then look at value
	CAIN	CH,"y"		;[42] legal values begin w/"y",
	JRST	SELOP0		;[42]
	CAIN	CH,"Y"		;[42] "Y",
	JRST	SELOP0		;[42]
	CAIN	CH,"n"		;[42] "n",
	JRST	SELOP0		;[42]
	CAIE	CH,"N"		;[42] and "N"
	JRST	INVDEF		;[42] invalid if none of the above
SELOP0:	SETZM	SVALUE		;[42] assume value is "no"
	CAIE	CH,"y"		;[42] is it really "yes"?
	CAIN	CH,"Y"		;[42]
	SETOM	SVALUE		;[42] yep, then change default to say so
SELOP1:	MOVE	P2,[POINT 7,ANSW1] ;[42] SETUP POINTER TO REC. AREA
	CALL	GETWRD		;GET OPTION NAME
	  JRST	SELNG		;ERROR- OPTION NAME TOO LONG
	MOVEM	P1,PUTPNT	;SAVE PNTR TO PUT OPT VAL IN LIN
	SETZ	.AC1,		;start at head of list
	MOVE	.AC2,[POINT 7,ANSW1]
	MOVEI	.AC3,OPTLST	;option list
	CALL	SRCHLL		;look-up option in list
	  SKIPA			;hope to return here
	JRST	SELOAS		;option already selected
	CALL	SELGET		;nope, then get the option value
	  RET			;got an error, so don't do any more
	TXNE	F,P%SAV		;do we need to save new value?
	TXNE	F,F%DEF		;yep, then was default used?
	SKIPA			;don't save if default used or no /save
	CALL	SELSAV		;save option
	CALL	SELSTO		;store new option in list
	  NOP			;don't care about any errors
	RET
; Called from SELECT to select a variable from a list
;
; Returns +1 always

SELVAR:
	CAIE	CH,SPECHR	;does variable begin w/"<"?
	JRST	DEFIFC		;illegal first character
	MOVE	P2,[POINT 7,ANSW1] ;get variable name here
	TXO	F,F%VNM		;break on ">"
	CALL	GETWRD
	  NOP			;return+1 not possible
	TXZN	F,F%VNM		;word terminated on ">"?
	JRST	DEFILN		;invalid name
	CALL	MOVSPC		;position to "("
	  JRST	SELNVL		;no value list
	MOVE	P2,[POINT 7,ATMBUF] ;assemble prompt here
	ILDB	CH,P1		;get left paren
	CAIE	CH,"("		;is it really?
	JRST	SELLPM		;left paren missing
	MOVNI	X1,1		;initialize value index
	CALL	SELRVV		;construct prompt
	  RET			;error occurred, so don't continue
	MOVEM	P1,PUTPNT	;save pointer for inserting value
	CALL	MOVSPC		;position to prompting text
	  JRST	DEFNTX		;no text describing name
	TXNE	F,P%ALW+P%SAV	;allowing defaults or saving?
	CALL	GETVAR		;get variable value
	TXNE	F,P%DEF		;[42] is defaulting allowed?
	TXO	F,F%SHW		;[42] yep, then show default value
	TXZE	F,P%VER		;don't want DEFGET to verify response
	TXO	F,S%VER		;but do want to verify it
SELV1:	CALL	DEFGET		;get a response
	  RET			;error occurred, so don't continue
	TXNE	F,F%DEF		;was default used?
	JRST	.+3		;yep, then already have value
	CALL	SELGVV		;get variable value
	  RET			;error occurred, so don't continue
	TXNE	F,S%VER		;need to verify response?
	JRST	[TYPE	ANSW1	;yep, then type name
		 TYPE1	EQUAL	;delimit w/ "="
		 TYPE	ANSW2	;type replacement value
		 TYPE	CRLF
		 TMSG	(OK? )
		 CALL	Y.OR.N	;get yes/no response
		   JRST	SELV1	;not ok
		 JRST	.+1]	;ok
	TXNE	F,P%SAV		;should value be saved?
	TXNE	F,F%DEF		;yep, then was default used?
	SKIPA			;don't save if default used or no /SAVE
	CALL	DEFSAV		;save this value
	MOVE	.AC1,[POINT 7,ANSW2] ;value is now here
	MOVEM	.AC1,PUTVAL	;setup insertion pointer
	CALL	DEFSTO		;store variable value
	  NOP			;don't care about any errors
	RET
; Called from SELVAR to build a prompt string and a table of value pointers
;
; Returns +1: error occurred
;	  +2: prompt string in ATMBUF, pointers to values in VALTAB

SELRVV:
	CALL	MOVSPC		;skip intervening spaces
	  NOP			;ignore errors here
	ILDB	CH,P1		;get beginning quote
	CAIE	CH,42		;is it really?
	JRST	SELIVV		;invalid variable value
	CAIL	X1,^D26		;already at maximum # of values?
	JRST	SELTMV		;too many values
	AOJ	X1,		;one more value
	MOVEI	CH,"A"(X1)	;get the corresponding letter
	IDPB	CH,P2		;put it in prompt
	MOVEI	CH,"."		;plus some more delimiters
	IDPB	CH,P2
	MOVEI	CH," "
	IDPB	CH,P2
	MOVEM	P2,VALTAB(X1)	;save value byte pointer
SELRV2:	ILDB	CH,P1		;get next char of value
	CAIN	CH,42		;closing quote?
	JRST	SELRV3		;yep, then done
	SKIPG	CH		;end of line?
	JRST	SELIVV		;illegal variable value
	IDPB	CH,P2		;put char into prompt
	JRST	SELRV2		;and back for more
SELRV3:	MOVEI	CH,15		;put CRLF into prompt
	IDPB	CH,P2
	MOVEI	CH,12
	IDPB	CH,P2
	CALL	MOVSPC		;skip intervening spaces
	  NOP			;ignore errors here
	ILDB	CH,P1		;get next char
	CAIN	CH,","		;comma for another value?
	JRST	SELRVV		;yep, then get next value
	CAIE	CH,")"		;closing paren?
	JRST	SELIVV		;illegal variable value
	MOVE	T1,P1		;[36] get line pointer
	ILDB	CH,T1		;[36] look at char after ")"
	CAIE	CH," "		;[36] is it space
	CAIN	CH,11		;[36] or tab?
	MOVEM	T1,P1		;[36] yep, then update line pointer
	SETZ	CH,		;make prompt ASCIZ
	IDPB	CH,P2
	RETSKP
; Called from SELVAR to retrieve an indexed value from an entry in VALTAB
;
; Returns +1: error occurred
;	  +2: value in ANSW2

SELGVV:
	LDB	CH,[POINT 7,ANSW2,13] ;get second char of response
	SKIPE	CH		;single-char response?
	JRST	SELIVR		;invalid response
	LDB	CH,[POINT 7,ANSW2,6] ;get first char of response
	CAIL	CH,"a"		;raise to uppercase if necessary
	CAILE	CH,"z"
	SKIPA
	SUBI	CH,"a"-"A"
	CAIL	CH,"A"		;is response in range A-A(X1)?
	CAILE	CH,"A"(X1)
	JRST	SELIVR		;invalid response
	SUBI	CH,"A"		;make it an index
	MOVE	P2,VALTAB(CH)	;get value byte pointer
	MOVE	P3,[POINT 7,ANSW2] ;move value to here
	SETZ	T1,		;count # chars in value
	ILDB	CH,P2		;get a char
	IDPB	CH,P3		;move to answer
	CAIE	CH,15		;reached end of answer yet?
	AOJA	T1,.-3		;nope, then back for more chars
	SETZ	CH,		;make answer ASCIZ
	DPB	CH,P3		;also overlays CR
	ADDI	T1,5		;round up+NUL
	IDIVI	T1,5		;get # words
	MOVEM	T1,ITMLEN	;save length
	RETSKP
; Called from SELOPT to get an option value
;
; Returns +1: error occurred
;	  +2: option value in SVALUE

SELGET:
	CALL	MOVSPC		;MOVE POINTER TO TEXT
	  JRST	SELNTX		;NOT THERE- ERROR
	CALL	TYCRLF		;LOOK NICE
	CALL	LINTTY		;TYPE TEXT
	TXNE	F,P%ALW!P%SAV	;do we need to type out old value?
	CALL	GETOPT		;yep, then get it
	TXNE	F,P%DEF		;[42] is defaulting allowed?
	TXO	F,F%SHW		;[42] yep, then show default
SEL1:	TXZ	F,F%DEF		;reset "default used" flag
	TYPE	ANSW1		;TYPE OPTION NAME
	TYPE	[ASCIZ / (y or n)/]
	TXNE	F,F%SHW		;show previous value?
	JRST	[TMSG	( [)
		 MOVEI	.AC1,"Y" ;assume "yes"
		 SKIPN	SVALUE	;skip if yes
		 MOVEI	.AC1,"N"
		 PBOUT
		 TMSG	(])
		 JRST	.+1]
	TMSG	(? )
	TXNE	F,P%ALW!P%DEF	;[42] is defaulting allowed?
	TXO	F,F%YND		;yep, then set flag for Y.OR.N
	CALL	Y.OR.N		;GET ANSWER
	  TDZA	.AC4,.AC4	;DELETE IF NO
	MOVNI	.AC4,1		;DELETE IF YES
	TXZ	F,F%YND		;reset this flag
	TRNN	F,P%VER		;verify answer?
	JRST	SEL2		;nope
	TYPE	ANSW1		;MAKE SURE
	TYPE1	SPACE
	TYPE	ANSW3		;TYPE RESPONSE
	TYPE	[ASCIZ /OK? /]
	CALL	Y.OR.N
	  JRST	SEL1		;NOT SURE
SEL2:
	MOVEM	.AC4,SVALUE	;update temporary value
	RETSKP
; Called from SELGET and CMGET to retrieve an option value from SETUP.BIN
;
; Returns +1 always

GETOPT:
	TXO	F,F%SHW		;yes, then set flag
	MOVEI	.AC1,.OPTST	;get access to option list
	CALL	ACCESS
	MOVEI	.AC1,.OPTST	;head of binary file option list
	MOVE	.AC2,[POINT 7,ANSW1]
	MOVEI	.AC3,BINDEF	;want binary file list
	CALL	SRCHLL		;find option name in list
	  JRST	[TXZ	F,P%ALW+F%SHW ;if not found, then don't allow default
		 JRST	GETOP1]
	MOVE	.AC1,LSTPTR
	LOAD	.AC1,VALLOC,BINDEF(.AC1) ;get option value
	SKIPE	.AC1		;value is no?
	MOVNI	.AC1,1		;no, then extend sign
	MOVEM	.AC1,SVALUE	;save it
GETOP1:	CALL	CLRACS
	RET
; Called from SELECT and SWOPT to save an option in SETUP.BIN
;
; Returns +1 always

SELSAV:
	MOVE	.AC1,[-1,,.OPTST]
	CALL	ACCESS
	MOVE	.AC1,.OPTST
	MOVE	.AC2,[POINT 7,ANSW1] ;search for option in list
	MOVEI	.AC3,BINDEF
	CALL	SRCHLL
	  SKIPA			;not found, then store name
	JRST	SELSV2
	MOVE	.AC1,[-1,,.EMPST] ;get access to empty-block list
	CALL	ACCESS
	MOVE	.AC1,[POINT 7,ANSW1] ;byte pointer to option name
	SETZ	.AC2,		;count of bytes in name
	ILDB	.AC3,.AC1	;get a char
	SKIPE	.AC3		;found end of name?
	AOJA	.AC2,.-2	;nope, then loop again
	ADDI	.AC2,5		;round up+nul
	IDIVI	.AC2,5		;get # words needed
	AOS	.AC2		;plus one for header
	MOVEI	.AC1,.EMPST	;start of empty-block list
	CALL	SRCHMT		;find a place for name
	MOVEM	.AC1,.AC3	;save address
	ADDI	.AC1,BINDEF	;make it absolute
	ADD	.AC2,.AC1	;addr of last word to move
	AOJ	.AC1,		;leave room for header
	HRLI	.AC1,ANSW1	;move option name to there
	BLT	.AC1,(.AC2)
	MOVE	.AC1,LSTPTR	;addr of preceeding item
	LOAD	.AC2,FWDPTR,BINDEF(.AC1) ;get old fwd ptr
	STOR	.AC3,FWDPTR,BINDEF(.AC1) ;new one is this addr
	STOR	.AC2,FWDPTR,BINDEF(.AC3) ;this one points to next
	SKIPA
SELSV2:	MOVE	.AC3,LSTPTR	;addr of item in list
	MOVE	.AC4,SVALUE	;value of option
	STOR	.AC4,VALLOC,BINDEF(.AC3) ;store it
	CALL	CLRACS		;clear any list access
	RET
; Called from SELECT to store an option name and value into linked list
;
; Returns +1: error occurred
;	  +2: option name and value stored in OPTLST

SELSTO:
	MOVE	.AC4,SVALUE
	MOVNM	.AC4,PUTVAL	;SAVE VAL FOR LINE INSERT
	SETZ	.AC1,
	MOVE	.AC2,[POINT 7,ANSW1]
	MOVEI	.AC3,OPTLST
	TXO	F,P%NTR		;[54] set No TRace flag
	CALL	SRCHLL		;find a place for this option
	  SKIPA
	JRST	[MOVE	.AC1,LSTPTR ;option already there,
		 STOR	.AC4,VALLOC,OPTLST(.AC1) ;so just store value
		 TXZ	F,P%NTR	;[54] reset No TRace
		 RETSKP]
	TXZ	F,P%NTR		;[54] reset No TRace
	MOVE	.AC1,OPTEND	;where to put this option
	STOR	.AC4,VALLOC,OPTLST(.AC1) ;store option value there also
	ADDI	.AC1,OPTLST	;make it absolute
	HLL	.AC1,[POINT 7,0,35] ;make it a byte pointer
	MOVE	.AC2,[POINT 7,ANSW1] ;option name
	ILDB	CH,.AC2
	IDPB	CH,.AC1		;copy option name into list
	SKIPE	CH
	JRST	.-3		;loop till nul char found
	TLZ	.AC1,-1
	ADDI	.AC1,1		;address for next option
	CAIL	.AC1,OPTLST+OPTSIZ ;reached end of table yet?
	JRST	SELESP		;exceeded storage space
	SUBI	.AC1,OPTLST	;make it relative again
	EXCH	.AC1,OPTEND
	MOVE	.AC2,LSTPTR
	LOAD	.AC3,FWDPTR,OPTLST(.AC2) ;get old forward pointer
	STOR	.AC1,FWDPTR,OPTLST(.AC2) ;update to point to new item
	STOR	.AC3,FWDPTR,OPTLST(.AC1) ;current item points to old forward
	SKIPE	.AC1,TRCJFN	;[54] get trace jfn, skip if none defined
	CALL	TRCOPT		;[54] output option trace record
	RETSKP
;	Output a trace record giving new option definition
;
;	Accepts: AC1 = jfn of trace file
;		 ANSW1 = option name
;		 SVALUE = option value
;
;	Returns: +1 always

TRCOPT:
	CALL	LINOUT		;output current line number
	HRROI	.AC2,[ASCIZ /Option /]
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,ANSW1
	SOUT%			;output name
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / defined as /]
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ /No/] ;assume value is NO
	SKIPE	SVALUE		;is it really YES?
	HRROI	.AC2,[ASCIZ /Yes/] ;yep
	SOUT%			;output value
	  ERJMP	SYSFAT
	HRROI	.AC2,CRLF	;output <CR><LF>
	SOUT%
	  ERJMP	SYSFAT
	RET
; Execute an ;Include command
;
; Returns +1 always

INCLUD:			;Include command
	TXNE	F,F%SUP!F%FLS	;[50] need to suppress this command?
	RET			;[50] yep
	CALL	MOVSPC		;position to next word (=filespec)
	  JRST	INCINC		;no next word
	MOVEI	.AC1,[XWD  1,1	;[31] table of legal switches for ;Include
		      ITEM BEGIN,F%BEG]	;[31]
	CALL	GETSWT		;[36] parse any switches
	  RET			;[36] an error occurred
	  JRST	INCLUD		;[31] found one, so look for more
	MOVE	P2,[POINT 7,ANSW1] ;move filespec to here
	CALL	GETWRD
	  JRST	INCINC		;something went wrong (like long filespec?)
	MOVE	.AC1,[.NULIO,,.NULIO]
	MOVEM	.AC1,GJFBLK+.GJSRC ;no jfns for GTJFN long form
	MOVX	.AC1,GJ%OLD
	MOVEM	.AC1,GJFBLK+.GJGEN
	HRROI	.AC1,[ASCIZ /SCF/] ;[36] look for .SCF type
	MOVEM	.AC1,GJFBLK+.GJEXT ;[36]
	MOVEI	.AC1,GJFBLK
	HRROI	.AC2,ANSW1	;byte pointer to filespec
	GTJFN			;find the file
	  JRST	[HRROI	.AC1,[ASCIZ /MCF/] ;[36] couldn't find .SCF,
		 MOVEM	.AC1,GJFBLK+.GJEXT ;[36] so look for .MCF
		 MOVEI	.AC1,GJFBLK ;[36]
		 HRROI	.AC2,ANSW1 ;[36]
		 GTJFN%		;[36]
		   JRST	INCFNF	;not there
		 JRST	.+1]	;[36] found it!
	MOVE	.AC2,[7B5+OF%RD] ;open for reading
	OPENF
	  JRST	INCCOF		;can't open
	PUSH	P,INJFN		;save current jfn
	MOVEM	.AC1,INJFN	;new input jfn
	TXNE	F,F%BEG		;[31] /BEGIN specified?
	JRST	[SKIPE	.AC1,BEGJFN ;[31] yep, then get any previous jfn
		 CLOSF		;[31] and close it
		   NOP		;[31] ignore errors
		 SETOM	BEGJFN	;[31] then set flag for later
		 JRST	.+1]	;[31]
	MOVEI	CH," "		;replace filespec delimiter w/space
	DPB	CH,P1
	MOVEM	P1,PUTPNT	;insert full filespec into command here
	MOVEI	CH,15		;end command line w/CRLF
	IDPB	CH,P1
	MOVEI	CH,12
	IDPB	CH,P1
	SETZ	CH,
	IDPB	CH,P1
	MOVE	.AC1,[POINT 7,ANSW1] ;put filespec here
	MOVEM	.AC1,PUTVAL	;insertion value is byte pointer
	MOVE	.AC2,INJFN	;new input jfn
	MOVE	.AC3,[1B2+1B5+1B8+1B11+1B14+JS%PAF] ;whole filespec
	JFNS			;print entire filespec of included file
	MOVE	P1,SAVPNT	;get pointer to beginning of line
	CALL	WRTLIN		;write out this MCF line
	SKIPE	.AC1,TRCJFN	;[54] need to trace the ;Include?
	CALL	TRCFIL		;[54] yep, then write trace record now
	MOVEI	.AC1,FILCOD	;[50] new block is a file block, position 0
	MOVE	.AC2,[POINT 7,ANSW1] ;[50] use filename as block name
	JSP	T1,PSHBLK	;[50] save new block name on stack
	CALL	SETUP		;SETUP the INCLUDEd file
	JSP	T1,POPBLK	;[50] pop my own block name off stack
	MOVE	.AC1,INJFN
	SKIPGE	BEGJFN		;[31] /BEGIN specified?
	JRST	[MOVEM	.AC1,BEGJFN ;[31] yep, then save the jfn
		 SETZ	.AC2,	;[31] "rewind" the file
		 SFPTR%		;[31]
		   ERJMP SYSFAT	;[31]
		 JRST	.+3]	;[31] and don't close it
	CLOSF			;close the file
	  CALL	SYSWRN
	POP	P,INJFN		;restore original JFN
	MOVE	P1,[POINT 7,[0]] ;fudge line pointer
	MOVEM	P1,SAVPNT
	RET
;	Output file trace record - [54]
;
;	Accepts: AC1 = trace file jfn
;		 PUTVAL = byte ptr to full file name
;
;	Returns: +1 always

TRCFIL:
	CALL	LINOUT		;output current line number
	HRROI	.AC2,[ASCIZ /Reading file /]
	SOUT%
	  ERJMP	SYSFAT
	MOVE	.AC2,PUTVAL	;output file name
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,CRLF	;plus <CR><LF>
	SOUT%
	  ERJMP	SYSFAT
	RET



;	Output file return trace record - [54]
;
;	Accepts: AC1 = trace file jfn
;
;	Returns: +1 always

TRCRET:
	CALL	LINOUT		;output current line number
	HRROI	.AC2,[ASCIZ /Return from /]
	SOUT%
	  ERJMP	SYSFAT
	MOVE	.AC2,INJFN	;jfn of included file
	MOVE	.AC3,[1B2+1B5+1B8+1B11+1B14+JS%PAF]
	JFNS%			;type whole filespec of included file
	  ERJMP	SYSFAT
	HRROI	.AC2,CRLF
	SETZ	.AC3,
	SOUT%
	  ERJMP	SYSFAT
	RET
; Execute an ;Error <text>//<text>... command
;
; Returns +1: always

CMERR:
;[50]	CALL	WRTBEG		;write the SETUP command to the CTL
	CALL	MOVSPC		;skip intervening spaces
	  JRST	ERRNTX		;no text in command
	PUSH	P,P1		;[50] save current line pointer
	MOVE	P2,[POINT 7,ANSW1] ;[50] check for ;Error BLOCK
	CALL	GETWRD		;[50]
	  JRST	ERRNTX		;[50]
	MOVEI	.AC1,[XWD  1,1	;[50] is second field "block"?
		      ITEM BLOCK,0] ;[50]
	HRROI	.AC2,ANSW1	;[50]
	TBLUK%			;[50]
	TXNN	.AC2,TL%NOM!TL%AMB ;[50] found a match?
	JRST	CMERR2		;[50] yep
	POP	P,P1		;[50] restore line pointer
	TXNE	F,F%SUP!F%FLS	;[50] otherwise, suppress this command?
	RET			;[50] yep, then quit now
	CALL	WRTBEG		;[50] write ;Error now
	MOVEM	P1,SAVPNT	;save this line pointer
	CALL	REMCNT		;[34] remove any continuation syntax
	TXZ	F,SLH		;reset "/" flag
	CALL	INSLIN		;replace "//" with CRLFs
	TXNE	F,SLH		;found "//"?
	JRST	CMERR1		;yep, then skip next test
	MOVE	T1,P1		;check for CRLFs in case // was already done
	ILDB	CH,T1		;get next char
	CAIE	CH,12		;found LF?
	JRST	.-2		;nope, then look some more
	ILDB	CH,T1		;is LF followed by nul?
	SKIPE	CH
	TXO	F,SLH		;nope, then set flag for multiple lines
CMERR1:	TXNN	F,SLH		;found more than one command (//)?
	JRST	[MOVE	P1,[POINT 7,[ASCIZ /@If (error) /]]
		 CALLRET WRTLIN] ;only one command
	CALL	ERRINS		;[50] insert the @If (noerror) @Goto ...
	MOVE	P1,SAVPNT	;get line pointer
	CALL	WRTLIN		;[50] write out the commands
;[50]	ILDB	CH,P1		;get a char
;[50]	SKIPE	CH		;found end of line yet?
;[50]	JRST	.-2		;nope
;[50]	MOVEI	CH,"X"		;setup for tag name also
;[50]	DPB	CH,P1
;[50]	IDPB	CH,P1
;[50]	SETZ	CH,
;[50]	IDPB	CH,P1
;[50]	MOVE	P1,SAVPNT	;restore line pointer yet again
;[50]	CALL	WRTLIN		;write out the command
;[50]	HRROI	.AC1,ANSW1	;convert tag to ascii here
	MOVE	.AC2,TAGCNT	;[50] get current tag number
	CALLRET	ERRTAG		;[50] write tag name now

CMERR2:				;[50] - execute an ;Error block command
	POP	P,.AC1		;[50] discard saved line ptr
	CALL	MOVSPC		;position to block name
	  JRST	.+3		;un-named block
	MOVE	P2,[POINT 7,ANSW2] ;get block name
	CALL	GETWRD
	  SETZM	ANSW2		;make an un-named block
	MOVE	P1,SAVPNT	;copy current line to CTL file
	CALL	WRTLIN
	CALL	ERRINS		;insert @If (noerror) ...
	MOVE	.AC1,TAGCNT	;block parameter is tag number
	TXO	.AC1,BEGCOD	;block type is ;Begin block
	MOVE	.AC2,[POINT 7,ANSW2] ;new block name
	JSP	T1,PSHBLK	;prepare for a new block
	CALL	SETUP		;setup new block
	HRRZ	P3,BLKTYP	;get tag name for this block
	JSP	T1,POPBLK	;restore my own block
	MOVE	.AC2,P3		;get tag number for this block
	TXZ	.AC2,BEGCOD	;delete block type code
	CALLRET	ERRTAG		;and go insert the tag name
; ERRINS - Called from CMERR to insert "@If (noerror) @Goto XXnnnn"
;
; Returns +1 always after incrementing TAGCNT and writing text to CTL file

ERRINS:				;[50] - made this a called routine
	MOVE	P1,[POINT 7,[ASCIZ /@If (noerror) @Goto XX/]]
	CALL	WRTLIN		;write out a real batch command
	HRROI	.AC1,ANSW1	;put tag number here
	AOS	.AC2,TAGCNT	;get a new tag name
	MOVX	.AC3,NO%LFL+NO%ZRO+4B17+12
	NOUT			;convert tag number to ASCII
	  CALL	SYSWRN
	MOVEI	CH,15		;add CRLF
	IDPB	CH,.AC1
	MOVEI	CH,12
	IDPB	CH,.AC1
	SETZ	CH,
	IDPB	CH,.AC1		;ASCIZ, of course
	MOVE	P1,[POINT 7,ANSW1]
	CALLRET	WRTLIN		;write tag name to CTL

; ERRTAG - write .AC2 to CTL file as a tag name ("XXnnnn::")
;
; Returns +1 always after writing to CTL file

ERRTAG:				;[50] - write TAGCNT to CTL file as a tagname
	MOVE	.AC1,[POINT 7,ANSW1] ;setup a tag name here
	MOVEM	.AC1,SAVPNT	;new line pointer is this
	MOVEI	CH,"X"		;starts w/"XX"
	IDPB	CH,.AC1
	IDPB	CH,.AC1
	MOVX	.AC3,NO%LFL+NO%ZRO+4B17+12
	NOUT
	  CALL	SYSWRN
	MOVEI	CH,":"		;make it look like a tag
	IDPB	CH,.AC1
	IDPB	CH,.AC1
	MOVEI	CH,15		;plus CRLF also
	IDPB	CH,.AC1
	MOVEI	CH,12
	IDPB	CH,.AC1
	SETZ	CH,
	IDPB	CH,.AC1		;and ASCIZ
	RET			;all done
; Perform filespec <var1>=<"val1","val2",...) <var2>=...
;
; Returns +1: always

PERFRM:	TXZ	F,F%PFM		;[50] reset /VERIFY flag
	CALL	MOVSPC		;position to filespec
	  JRST	PFMNFN		;no file name
	MOVEI	.AC1,[XWD  1,1	;[36] table of legal switches
;[53]		      ITEM VERIFY,F%PFM_-^d18] ;[36]
		      ITEM VERIFY,P%VER] ;[53]
	CALL	GETSWT		;[36] parse any switches
	  RET			;[36] got an error
	  JRST	PERFRM		;got one, so try for another!
	TXNE	F,P%VER		;[53] was /VERIFY specified?
	TXO	F,F%PFM		;[53] yep, then set PerForM flag
	MOVE	P2,[POINT 7,ANSW1] ;move filespec to here
	CALL	GETWRD
	  JRST	PFMIFN		;invalid file name (maybe too long)
	MOVEI	.AC1,[XWD  1,1	;[50] is it a keyword?
		      ITEM BLOCK,0] ;[50]
	MOVE	.AC2,[POINT 7,ANSW1] ;[50]
	TBLUK%			;[50]
	TXNE	.AC2,TL%NOM!TL%AMB ;[50] did it match?
	JRST	PERFMF		;[50] nope, then must be a file
	HRROI	.AC1,ANSW1	;[50] get a new jfn for current MCF
	MOVE	.AC2,INJFN	;[50]
	SETZ	.AC3,		;[50]
	JFNS%			;[50]
	MOVX	.AC1,GJ%SHT+GJ%OLD ;[50]
	HRROI	.AC2,ANSW1	;[50]
	GTJFN%			;[50]
	  JRST	SYSFAT		;[50] a very unusual error
	MOVX	.AC2,7B5+OF%RD	;[50] open for read
	OPENF%			;[50]
	  JRST	SYSFAT		;[50]
	MOVEM	.AC1,ANSW3	;[50] save new jfn
	PUSH	P,P1		;[50] save current line ptr
	CALL	MOVSPC		;[50] position to next field
	  JRST	[CALL	PFMNVN	;[50] no variable names
		 POP	P,P1	;[50] discard line ptr
		 MOVE	.AC1,ANSW3 ;[50] close new jfn
		 CLOSF%		;[50]
		   CALL	SYSWRN	;[50]
		 RET]		;[50]
	POP	P,P1		;[50] restore line ptr
	CAIN	CH,SPECHR	;[50] is it a variable name?
	JRST	[HRROI	.AC1,ANSW3+1 ;[50] yep, then use file name as block name
		 MOVE	.AC2,ANSW3 ;[50]
		 SETZ	.AC3,	;[50]
		 JFNS%		;[50]
		 JRST	.+2]	;[50]
	JRST	[MOVE	P2,[POINT 7,ANSW3+1] ;[50] use given block name
		 CALL	GETWRD	;[50]
		   JRST	INVBKN	;[50] invalid block name
		 JRST	.+1]	;[50]
	MOVE	.AC1,INJFN	;[50] read current file position
	RFPTR%			;[50]
	  CALL	SYSFAT		;[50]
	MOVEM	.AC2,P4		;[50] save current position
	MOVE	.AC1,ANSW3	;[50] set position for new jfn
	SFPTR%			;[50]
	  CALL	SYSFAT		;[50]
	TXNE	F,F%BTW		;[53] between tags on restart?
	TXO	F,F%FLS		;[53] yep, then treat as FaLSe condition
	JRST	PERVAR		;[50] now get variables

PERFMF:	TXNE	F,F%SUP!F%FLS	;[50] suppress this command?
	RET			;[50] yep, then bug out now
	MOVE	.AC1,[.NULIO,,.NULIO]
	MOVEM	.AC1,GJFBLK+.GJSRC ;no jfns for GTJFN long form
	MOVX	.AC1,GJ%OLD
	MOVEM	.AC1,GJFBLK+.GJGEN
	HRROI	.AC1,[ASCIZ /SCF/] ;[36] look for .SCF type
	MOVEM	.AC1,GJFBLK+.GJEXT ;[36]
	MOVEI	.AC1,GJFBLK
	HRROI	.AC2,ANSW1	;byte pointer to filespec
	GTJFN			;get a JFN for it
	  JRST	[HRROI	.AC1,[ASCIZ /MCF/] ;[36] couldn't find .SCF,
		 MOVEM	.AC1,GJFBLK+.GJEXT ;[36] so look for .MCF
		 MOVEI	.AC1,GJFBLK
		 HRROI	.AC2,ANSW1 ;[36]
		 GTJFN%		;[36]
		   JRST	PFMFNF	;file not found
		 JRST	.+1]	;[36]
	MOVX	.AC2,7B5+OF%RD
	OPENF			;open for read
	  JRST	PFMRAR		;read access required
	MOVEM	.AC1,ANSW3	;save jfn here for a moment
	MOVEM	P1,PUTPNT	;insert full filespec into command here
	MOVE	.AC1,[POINT 7,ANSW3+1] ;insertion value is here
	MOVEM	.AC1,PUTVAL	;value to insert into command
	MOVE	.AC2,ANSW3	;new input jfn
	MOVX	.AC3,1B2+1B5+1B8+1B11+1B14+JS%PAF ;output whole filespec
	JFNS			;write full filespec to CTL
	SKIPE	.AC1,TRCJFN	;[54] get trace jfn; skip if not defined
	CALL	TRCFIL		;[54] if defined, then output trace record
	SETZM	P4		;[50] set file position to beginning of file

PERVAR:	SKIPG	X1,VARCNT	;any variables already? (i.e. nested ;Pfm's)
	JRST	.+4		;nope, then no need to save pointer stack
	PUSH	P,PFMLST-1(X1)	;save current variable list pointer stack
	SOJG	X1,.-1		;make sure to save every element
	PUSH	P,VALCNT	;save current count of values for each var
	PUSH	P,VARCNT	;save variable count
	SETZM	VALCNT		;initialize count of values to zero
	SETZM	VARCNT		;same for count of variables
	TXNE	F,F%SUP!F%FLS	;[53] suppress the block?
	JRST	PFMVL1		;[53] yep, then always do value-list version
	CALL	PFMGET		;get a variable name
	  JRST	PERERR		;some kind of error
	MOVE	T1,P1		;get input pointer
	ILDB	CH,T1		;look at char after variable name
	CAIN	CH,","		;is it a comma?
	JRST	PERFM0		;yep, then file flavor of ;perf
	CAIE	CH,"="
	JRST	[CALL	PFMNEQ	;no equals sign
		 JRST	PERERR]
	ILDB	CH,T1		;get next char
	CAIE	CH," "		;skip spaces
	CAIN	CH,11		;and tabs
	JRST	.-3
	CAIE	CH,"("		;is it left paren?
	JRST	PERFM0		;nope, then do a filespec flavor
	TXNE	F,F%PFM		;[50] was a switch given?
	JRST	PFMIVS		;[36] yep, then invalid switch
	MOVEM	T1,P1		;else, do a value list flavor of ;Perform
	JRST	PFMVLS		;  and be sure to use updated pointer
PERFM0:	CALL	PFMFIL
	  JRST	PERERR		;an error happened
	MOVE	.AC1,ANSW3	;get input jfn
	CLOSF			;close the file
	  CALL	SYSWRN
	JRST	PERFM3		;everything was successful
; Perform filespec <variable>=("value",...)

PFMVLS:
	CALL	PFMVAR		;load all variables&values into variable list
	  JRST	PERERR		;an error occurred
PFMVL1:				;[53]
	MOVE	P1,SAVPNT	;restore pointer to beginning of command
	CALL	WRTLIN		;write command to CTL
	PUSH	P,INJFN		;save current input JFN
	MOVE	T1,ANSW3	;get new JFN
	MOVEM	T1,INJFN	;new JFN becomes current JFN
	MOVE	.AC1,P4		;[50] get FILCOD+<position> in R1
	TXO	.AC1,FILCOD	;[50]
	MOVE	.AC2,[POINT 7,ANSW3+1] ;[50] use filename as block name
	JSP	T1,PSHBLK	;[50] prepare for a new block
	TXNE	F,F%FLS		;[50] after a false condition?
	TXO	F,F%SUP		;[50] yep, then suppress this block
PERFM1:	CALL	SETUP		;SETUP this new file
	TXNN	F,F%SUP		;[50] skip if suppress flag was set
	SOSG	VALCNT		;skip if more values
	JRST	PERFM2		;no more, then done
	MOVE	X1,VARCNT	;initialize index to # of variables
	CALL	PFMNXT		;modify values of all variables
	MOVE	.AC1,INJFN	;open input file again
;[50]	SETZ	.AC2,		;"rewind" the input file
	HRRZ	.AC2,BLKTYP	;[50] else reset file position
	TXZ	.AC2,FILCOD	;[50] remove block type code
	SFPTR
	  JRST	SYSWRN		;something bad happened
	JRST	PERFM1		;SETUP the file again
PERFM2:	HRRZ	P1,BLKTYP	;[50] get file position of new block
	JSP	T1,POPBLK	;[50] restore my block name
	TRNN	P1,377777	;[50] if file position = 0
	JRST	PERF22		;[50] then don't set file ptr for this block
	MOVE	.AC1,INJFN	;[50] read current file pointer
	RFPTR%			;[50]
	  JRST	SYSFAT		;[50]
	MOVE	.AC1,(P)	;[50] set current level file pointer
	SFPTR%			;[50]
	  JRST	SYSFAT		;[50]
PERF22:	MOVE	P1,[POINT 7,[0]] ;[50] fudge a nul line
	MOVEM	P1,SAVPNT	;[50]
	MOVE	.AC1,INJFN	;close the input file
	CLOSF
	  CALL	SYSWRN
	POP	P,INJFN		;restore old input jfn
	JRST	PERFM3		;skip over next error recovery code
PERERR:
	MOVE	.AC1,ANSW3	;error, then close new jfn
	CLOSF
	  CALL	SYSWRN
	SETZM	PUTPNT		;don't insert filespec into command line
PERFM3:	MOVE	X1,VARCNT	;initialize name index
	SKIPE	X1		;don't call if no variables named
	CALL	PFMDEL		;delete the variable names from the list
	POP	P,VARCNT	;restore any old variable count for ;Perform
	SKIPG	X1,VARCNT	;any there?
	JRST	.+4		;nope, then no pointers to restore
	POP	P,VALCNT	;restore count of values first
	POP	P,PFMLST-1(X1)	;restore old variable pointer
	SOJG	X1,.-1		;make sure to do all of them!
;[50]	TXZ	F,F%PFM		;reset /Verify flag
	RET
; Called from PERFRM to parse a variable name
;
; Accepts: P1=pointer to input MCF line
;
; Returns: +1:	some kind of error, message already displayed
;	   +2:  success, P1=updated to next field
;			 ANSW1=variable name

PFMGET:
	CALL	MOVSPC		;position to first variable name
	  JRST	PFMNVN		;no variable name
	CAIE	CH,SPECHR	;starts w/"<"?
	JRST	PFMIVN		;invalid variable name
	MOVE	P2,[POINT 7,ANSW1] ;move variable name to here
	TXO	F,F%VNM		;break on ">"
	CALL	GETWRD
	  SKIPA			;no variable name, or name too long
	TXZN	F,F%VNM		;found a variable name?
	JRST	PFMIVN		;invalid variable name
	MOVNI	T1,1		;decrement byte pointer
	ADJBP	T1,P1
	MOVEM	T1,P1
	CALL	MOVSPC		;skip some more spaces
	  JRST	PFMNVV		;no variable value
	RETSKP
; Called from PERFRM to retrieve variables and value lists
;
; Returns +1: error
;	  +2: success, variables defined in VARLST
;	      count of variables in VARCNT
;	      count of values for each variable in VALCNT
;	      list pointers to each variable in PFMLST

PFMVAR:
	MOVE	P2,[POINT 7,ANSW2] ;initialize value pointer
	SETZB	P3,.AC1		;P3=# of words in value, AC1=count of values
	CALL	PFMGVV		;get values for this variable
	  RET			;error
	SKIPN	VALCNT		;skip if not first variable
	MOVEM	.AC1,VALCNT	;store count of values for first variable
	CAME	.AC1,VALCNT	;does count of values = count of values for #1?
	JRST	PFMVCM		;value count do not match
	CALL	DEFSTO		;store this variable+value
	  JRST	DEFIER		;multiply defined variable
	AOS	X1,VARCNT	;increment variable count
	CAILE	X1,MAXPFM	;greater than max allowed?
	JRST	PFMTMV		;too many variables
	MOVE	T1,LSTPTR	;get linked list pointer for this variable
	MOVEM	T1,PFMLST-1(X1)	;save it in stack
	CALL	MOVSPC		;position to next variable name
	  RETSKP		;not there, then done
	CAIE	CH,SPECHR	;begins w/"<"?
	JRST	PFMIVN		;invalid variable name
	CALL	PFMGET		;get the variable name
	  RET			;an error occurred
	ILDB	CH,P1		;is name followed w/"="?
	CAIE	CH,"="
	JRST	PFMNEQ		;no equals sign
	ILDB	CH,P1		;skip spaces
	CAIE	CH," "
	CAIN	CH,11		;and tabs
	JRST	.-3
	CAIE	CH,"("		;does value list begin w/"("?
	JRST	PFMNLP		;no left paren
	JRST	PFMVAR		;loop back for this variable
; Called from PFMVLS to retrieve variable value list
;
; Returns +1: error
;	  +2: success, value list in ANSW2

PFMGVV:	CALL	MOVSPC		;position to next value
	  JRST	PFMNVV		;no variable value
	ILDB	CH,P1		;is first char the leading quote?
	CAIE	CH,42
	JRST	PFMIVV		;invalid variable value
	AOS	.AC1		;increment count of values
	ILDB	CH,P1		;get value char
	IDPB	CH,P2		;move to value area
	CAIE	CH,42		;ending quote seen?
	AOJA	P3,.-3		;nope, then back for more
	SETZ	CH,		;make value ASCIZ
	DPB	CH,P2
	AOS	P3		;increment count of bytes in value yet again
	MOVE	.AC2,P3		;get length of value
	IDIVI	.AC2,5		;convert to words
	SKIPN	.AC3		;any remainder?
	JRST	.+5		;nope, then don't need to pad
	SUBI	.AC3,5		;get -(#bytes need to pad to next word)
	IDPB	CH,P2		;pad value to next word boundary
	AOS	P3		;remember to increment value length
	AOJL	.AC3,.-2
	CALL	MOVSPC		;position to next value
	  JRST	PFMCMA		;comma missing
	ILDB	CH,P1		;is first char a ","
	CAIN	CH,","
	JRST	PFMGVV		;yep, then retrieve another value
	CAIE	CH,")"		;found the closing paren?
	JRST	PFMRPM		;right paren missing
	MOVEI	.AC2,4(P3)	;get count of bytes in value, rounded up
	IDIVI	.AC2,5		;convert to #words
	MOVEM	.AC2,ITMLEN	;save as length of value
	RETSKP
; Called from PFMVLS to update variables to next value(s) in list
;
; Returns: +1 always

PFMNXT:	MOVE	T1,PFMLST-1(X1)	;get linked list pointer for this variable
	LOAD	P2,VALLOC,VARLST(T1) ;get value location
	ADDI	P2,VARLST	;make it absolute
	HLL	P2,[POINT 7,0]	;and convert to a byte pointer
	MOVEI	T2,1		;initialize length to 1
	ILDB	CH,P2		;search through value,
	SKIPE	CH		;until a NUL is reached
	AOJA	T2,.-2		;updating value length all the while
	IDIVI	T2,5		;convert length to #words
;[51]	SKIPN	T3		;any remainder?
;[51]	JRST	.+4		;nope, then already aligned
;[51]	SUBI	T3,5		;get -(#padding bytes)
;[51]	IBP	P2		;increment byte pointer to next value
;[51]	AOJL	T3,.-1
;[51]	IBP	P2		;make sure byte pointer contains word address
	TLZ	P2,-1		;[51] mask address only
	SKIPE	T3		;[51] any remainder from the length?
	AOS	T2		;[51] yep, then increment word wount
	AOS	P2		;[51] increment word addr to next value
	LOAD	.AC1,VALLOC,VARLST(T1) ;destination of BLT is value location
	ADDI	.AC1,VARLST	;make address absolute
	LOAD	.AC2,VALLEN,VARLST(T1) ;get old value length
	SUB	.AC2,T2		;subtract length of first value
;[51]	SOS	.AC2		;really one less due to remaindering
	STOR	.AC2,VALLEN,VARLST(T1) ;which becomes new value length
	ADD	.AC2,.AC1	;and an address to stop BLT
	SOS	.AC2		;really stop at one less!
	HRL	.AC1,P2		;source is addr of next value
	BLT	.AC1,(.AC2)	;bump up all values
	SOJG	X1,PFMNXT	;loop back for all variables in stack
	RET
; ;Perform filespec <var1>[,<var2>[,<var3>]]=filespec[,filespec]...

PFMFIL:
	SETZM	ANSW2		;dummy value for variable
	CALL	DEFSTO		;store the variable name in the list
	  JRST	DEFIER		;something happened
	AOS	X1,VARCNT	;get name index
	CAILE	X1,3		;already have two variables?
	JRST	PFMTMV		;too many variables
	MOVE	T1,LSTPTR	;get current variable list pointer
	MOVEM	T1,PFMLST-1(X1)	;save in ;perform list
	ILDB	CH,P1		;get next char of input
	CAIN	CH,","		;if it is a comma then another variable follows
	JRST	[CALL	PFMGET	;get another variable name
		   RET		;got an error
		 JRST	PFMFIL]	;and back to store this name
	CAIE	CH,"="		;last variable followed with "="?
	JRST	PFMNEQ		;nope, no equals sign
	CALL	MOVSPC		;skip spaces and tabs
	  JRST	PFMNVV		;no variable values
	MOVE	.AC1,P4		;[50] set block type to FILCOD+<position>
	TXO	.AC1,FILCOD	;[50]
	MOVE	.AC2,[POINT 7,ANSW3+1] ;[50] block name is here
	JSP	T1,PSHBLK	;[50]
	TXO	F,F%FNF		;set no such file flag
	CALL	PFMGFL		;get filespecs and define variables
;[50]	  RET			;something happened
	  JRST	[JSP	T1,POPBLK ;[50] error, so discard new block
		 RET]		;[50] and quit
	MOVE	P1,SAVPNT	;restore input line pointer
	CALL	WRTLIN		;write line to CTL file
;[53]	TXNE	F,F%FLS		;[50] after a flase condition?
;[53]	TXZ	F,F%PFM		;[50] yep, then don't verify files
;[53]	TXNE	F,F%FLS		;[50]
;[53]	TXO	F,F%SUP		;[50] and suppress the block
PFMFL1:	PUSH	P,INJFN		;save current input JFN
	MOVE	T1,ANSW3	;new input JFN
	MOVEM	T1,INJFN
	TXNE	F,F%PFM		;should this file be verified?
	JRST	[MOVEI	.AC1,.PRIOU ;output filespec to primary output
;[53]		 MOVE	.AC2,INJFN ;[50] get input jfn
		 HRRZ	.AC2,-1(P) ;[53] get jfn of file found
		 SETZ	.AC3,	;default format
		 JFNS		;show filespec
		 TMSG	(? )
		 CALL	Y.OR.N	;get confirmation
;[53]		   JRST	PFMFL2	;no, don't do this file
;[53]		 JRST	.+1]	;or do it
		   SKIPA	;[53] more to decide if not doing the file
		 JRST	.+1	;[53] else continue if YES
		 MOVE	.AC1,BLKTYP ;[53] what kind of block is this?
		 TRNN	.AC1,377777 ;[53] ;Perform BLOCK?
		 JRST	PFMFL2	;[53] nope, then just skip the perform
		 TXO	F,F%SUP	;[53] have to set suppress flag for BLOCKs
		 JRST	.+1]	;[53] and then analysize the block
	MOVE	T1,VARCNT
	CAIL	T1,3		;was a third variable specified?
	JRST	[MOVE	X1,PFMLST+2 ;yep, then give it the sequence number
		 LOAD	.AC1,VALLOC,VARLST(X1) ;get the value address
		 ADDI	.AC1,VARLST ;make it absolute
		 TLO	.AC1,-1	;and make it a byte pointer
		 AOS	.AC2,PFMCNT ;get the sequence number
		 MOVX	.AC3,NO%LFL+NO%ZRO+3B17+12 ;left zeroes, 3 digits
		 NOUT		;get the value
		   CALL	SYSWRN
		 JRST	.+1]
	CALL	SETUP		;do everything here!
PFMFL2:	MOVE	T1,INJFN	;get input jfn
	MOVEM	T1,ANSW3	;and save it
	POP	P,INJFN		;restore old input jfn
;[53]	TXNN	F,F%SUP		;[50] don't repeat block if suppress flag was set
	CALL	PFMFNX		;try for another filespec
;[50]	  RETSKP
	  JRST	PFMFL3		;go pop block stack
	MOVE	.AC1,ANSW3	;save for later too
;[50]	SETZ	.AC2,		;rewind input file
	HRRZ	.AC2,BLKTYP	;[50] reset file position
	TXZ	.AC2,FILCOD	;[50] remove block type
	SFPTR
	  JRST	[POP	P,P1	;error occurred, so get return address
		 POP	P,T1	;discard indexable file handle
		 POP	P,X1	;restore ANSW1 word count
		 MOVN	X1,X1	;will decrement stack pointer
		 ADJSP	P,(X1)	;fudge stack pointer to discard ANSW1
		 JSP	T1,POPBLK ;[50] discard new block
		 PUSH	P,P1	;and add return address back
		 CALLRET SYSWRN] ;got an error
	TXZ	F,F%SUP		;[53] reset SUPpress flag
	JRST	PFMFL1
PFMFL3:	MOVE	P1,BLKTYP	;[50] get file position of current block
	JSP	T1,POPBLK	;[50] pop block name off stack
	TRNN	P1,377777	;[50] skip if this is an in-line block
	RETSKP			;[50] else quit now
	MOVE	.AC1,ANSW3	;[50] read file position
	RFPTR%			;[50]
	  JRST	SYSFAT		;[50]
	MOVE	.AC1,INJFN	;[50] and set position for current level
	SFPTR%			;[50]
	  JRST	SYSFAT		;[50]
	MOVE	.AC1,[POINT 7,[0]] ;[50] fudge a nul line
	MOVEM	.AC1,SAVPNT	;[50]
	RETSKP			;[50]
; Called from PFMFIL and PFMFNX to define variable to be first filespec
;
; Moves filespec list to ANSW1 and saves it on push-down stack
;	Puts an indexable file handle on stack-1 from the first
;	filespec in ANSW1, and saves the remainder of ANSW1 on the stack

PFMGFL:
	MOVE	P2,[POINT 7,ANSW2] ;move first filespec to here
PFMGF1:	ILDB	CH,P1		;get a char
	IDPB	CH,P2		;put into ANSW2
	CAIN	CH," "		;found a filespec delimiter?
	MOVEI	CH,15		;yep, then fudge for next test
	CAIE	CH,15		;found a delimiter?
	CAIN	CH,","		;space, comma, or EOL?
	SKIPA			;yep, then skip
	JRST	PFMGF1		;else continue with filespec
	SETZ	CH,		;make filespec ASCIZ
	DPB	CH,P2
	MOVX	.AC1,GJ%SHT+GJ%OLD+GJ%IFG+GJ%FLG ;[47] allow wildcards
;[47]	MOVEM	.AC1,GJFBLK+.GJGEN
;[47]	MOVEI	.AC1,GJFBLK
	HRROI	.AC2,ANSW2	;filespec is here
	GTJFN%			;try for a JFN
	  JRST	[LDB	CH,P1	;no such JFN, so test if at end of line
		 CAIE	CH,15	;skip if end of line
		 JRST	PFMGFL	;try next entry in list
		 TXNE	F,F%FNF	;no files found at all?
		 JRST	PFMNSF	;no such file
		 RET]		;found at least one, so just return
	TXZ	F,F%FNF		;found a file, so reset no such file flag
	MOVE	P2,[POINT 7,ANSW1] ;gather rest of filespec
	SETZ	T1,		;count # chars here
	ILDB	CH,P1		;get a char
	IDPB	CH,P2		;move it
	SKIPE	CH		;found end of line?
	AOJA	T1,.-3		;nope, then continue with string
	ADDI	T1,5		;round char count up
	IDIVI	T1,5		;get word count of string
	MOVE	X1,T1		;initialize index
	POP	P,P1		;get return address from stack
	PUSH	P,ANSW1-1(X1)	;save the filespec string on the push-down list
	SOJG	X1,.-1		;be sure to save all words
	PUSH	P,T1		;save word count there also
	PUSH	P,.AC1		;save indexable jfn on stack
	PUSH	P,P1		;and save return address after it
	CALLRET PFMDEF		;define the variables
; Called from PFMGFL and PFMFNX to define the variable(s) from the filespecs

PFMDEF:
	HRRZ	.AC2,-1(P)	;get actual filespec w/o flags
	HRROI	.AC1,ANSW1	;output filespec back to here
	MOVE	.AC3,[2B2+2B5+1B8+1B11+JS%PAF] ;output dev:<dir>nam.typ if not
	SETZ	.AC4,		;  equal to system default values
	JFNS
	MOVE	P2,[POINT 7,ANSW1] ;where the filespec is now
	MOVE	T1,PFMLST	;variable list address of first variable name
	MOVE	P3,VAREND	;where the variable value will be put
	STOR	P3,VALLOC,VARLST(T1) ;setup the value pointer
	ADDI	P3,VARLST	;make address absolute
	HLL	P3,[POINT 7,0]	;make a byte pointer to the value location
	ILDB	CH,P2		;move chars from filespec
	IDPB	CH,P3		;to value
	SKIPE	CH		;terminate on NUL
	JRST	.-3
	TLZ	P3,-1		;get address only
	SUBI	P3,VARLST	;make it relative again
	MOVEM	P3,VAREND	;update end of list address
	AOS	VAREND		;which should really be one greater
	MOVE	T1,VARCNT	;is there a second variable name?
	CAIG	T1,1
	RETSKP			;nope, then all done defining
	MOVE	.AC1,[POINT 7,ANSW1] ;output original filespec to here
	MOVE	.AC2,-1(P)	;get GTJFN flags
	MOVX	.AC3,JS%PAF	;punctuate all fields
	TXNE	.AC2,GJ%DEV	;wildcards in device?
	TXO	.AC3,JS%DEV	;yep, then output device
	TXNE	.AC2,GJ%DIR	;wildcards in directory?
	TXO	.AC3,JS%DIR	;yep, then output directory
	TXNE	.AC2,GJ%NAM	;wildcards in name?
	TXO	.AC3,JS%NAM	;yep, then output name
	TXNE	.AC2,GJ%EXT	;wildcards in type?
	TXO	.AC3,JS%TYP	;yep, then output type
	TXNE	.AC2,GJ%VER	;wildcards in generation?
	TXO	.AC3,JS%GEN	;yep, then output generation
	SETZ	.AC4,
	JFNS			;get original filespec
	MOVEM	.AC1,P1		;save byte ptr to end of filespec
	MOVE	.AC1,[POINT 7,ANSW2] ;output actual filespec to here
	TLZ	.AC2,-1		;drop flags
	JFNS
	MOVEM	.AC1,P2		;get ptr to end of filespec
	LDB	T1,P1		;get a char of the orginal filespec
	LDB	CH,P2		;and a char of the actual filespec
	SKIPE	CH		;skip if actual filespec is nul
	CAME	CH,T1		;skip if equal
	SKIPA			;right-to-left test is done
	JRST	[MOVNI	.AC1,1	;decrement byte ptr
		 ADJBP	.AC1,P1
		 MOVEM	.AC1,P1
		 MOVNI	.AC1,1	;decrement this one too
		 ADJBP	.AC1,P2
		 MOVEM	.AC1,P2
		 JRST	.-5]
	SETZ	CH,		;mark end of actual filespec
	IDPB	CH,P2
	MOVE	P1,[POINT 7,ANSW1] ;pointer to beginning of filespec
	MOVE	P2,[POINT 7,ANSW2] ;same for actual filespec
	ILDB	T1,P1		;get a char
	ILDB	CH,P2		;  of both filespecs
	SKIPE	CH		;skip if end of actual filespec reached
	CAME	CH,T1		;skip if equal
	SKIPA
	JRST	.-5		;else loop back for more
	MOVE	T1,PFMLST+1	;get variable list pointer to 2nd variable
	MOVE	P1,VAREND	;get a place to put the variable's value
	STOR	P1,VALLOC,VARLST(T1) ;store the value pointer
	ADDI	P1,VARLST	;make address absolute
	HLL	P1,[POINT 7,0]	;make a byte ptr to the value location
	IDPB	CH,P1		;move a char
	ILDB	CH,P2		;get another
	SKIPE	CH		;skip when done
	JRST	.-3
	IDPB	CH,P1		;be sure value is ASCIZ
	TLZ	P1,-1		;get address only
	SUBI	P1,VARLST	;make it relative again
	MOVEM	P1,VAREND	;update end of list address
	AOS	VAREND		;really is addr of next free word
	RETSKP
; Called from PFMFIL to get another filespec

PFMFNX:
	MOVE	.AC1,-1(P)	;get file handle
	GNJFN			;get next filespec
	  SKIPA			;skip if none there
	JRST	[CALLRET PFMDEF]
	POP	P,P1		;get return address from stack
	POP	P,T1		;discard indexable file handle
	POP	P,X1		;restore count of words in filespec
	MOVN	X1,X1		;make it negative
	HRLZ	X1,X1		;make an AOBJ index
	POP	P,ANSW1(X1)	;restore the file list
	AOBJN	X1,.-1		;restore all words
	PUSH	P,P1		;and put return address back on stack
	MOVE	P1,[POINT 7,ANSW1] ;get a byte ptr to the file list
	ILDB	CH,P1		;get a char
	CAIE	CH," "		;skip spaces
	CAIN	CH,11		;and tabs
	JRST	.-3
	CAIE	CH,15		;found end of line?
	CAIN	CH,12		;might be this also
	RET			;yep, then done
	MOVE	P1,[POINT 7,ANSW1] ;get a byte ptr to the file list
	CALLRET PFMGFL		;else get a new filespec
; Called from PERFRM to delete variable names from list (i.e. undefine them)

; Returns +1 always

PFMDEL:
	MOVE	T1,PFMLST-1(X1)	;get addr of this variable
	SETZB	.AC1,P2		;reset address pointers
	CAME	.AC1,T1		;does forward pointer point to this variable?
	JRST	[MOVEM	.AC1,P2	;nope, then fwd ptr=current ptr
		 LOAD	.AC1,FWDPTR,VARLST(P2) ;and get next fwd ptr
		 JRST	.-1]
	LOAD	.AC1,FWDPTR,VARLST(.AC1) ;get fwd ptr of this variable
	STOR	.AC1,FWDPTR,VARLST(P2) ;make it fwd ptr of previous variable
	SOJG	X1,PFMDEL	;loop through all variables for this ;Perform
	RET
; Execute a ;File ... found | not-found command
;
; Returns +1: error or condition false
;	  +2: condition true, continue with scan

FILE:				;File ... found!not-found command
	TXO	F,F%CON		;[50] set CONditional flag
	TXZ	F,F%FNF		;say file found at start
	CALL	MOVSPC		;position to next word (=filespec)
	  JRST	FILFNM		;no filename
	MOVE	P2,[POINT 7,ANSW1] ;move file name to here
	CALL	GETWRD
	  JRST	FILFNM		;don't really expect to get here
	MOVX	.AC1,GJ%OLD+GJ%SHT+GJ%IFG ;must be existing file, w/wildcards
	HRROI	.AC2,ANSW1	;byte pointer to filespec
	GTJFN			;look for file
	  TXOA	F,F%FNF		;file not found
	RLJFN			;release jfn
	  NOP			;ignore errors
	CALL	MOVSPC		;position to next word
	  JRST	FILOPM		;not there, then invalid
	MOVE	P2,[POINT 7,ANSW1]
	CALL	GETWRD		;get FOUND!NOT-FOUND option
	  JRST	FILOPM		;option missing
	MOVEI	.AC1,[XWD  2,2	;set TBLUK table pointer
		      ITEM FOUND,0
		      ITEM NOT-FOUND,F%FNF]
	MOVE	.AC2,[POINT 7,ANSW1]
	TBLUK			;try to find a match
	TXNE	.AC2,TL%NOM!TL%AMB	;found one?
	JRST	FILILO		;nope, invalid option
	HRRZ	.AC1,(.AC1)	;value of option
	XOR	F,.AC1		;nifty way to combine flags!
	TXNE	F,F%FNF		;want to execute command?
;[50]	RET			;nope, then ignore rest of line
	CALL	SETFLS		;[50] set false condition
	TXNE	F,SLH		;was "/" already seen?
	JRST	FIL1		;yep, then don't look for it again
	CALL	MOVSPC		;position to "/"
	  JRST	FILSLH		;not there!
	ILDB	.AC1,P1		;get next char
	CAIE	.AC1,"/"	;a slash?
	JRST	[CAIN	.AC1,15	;end of line?
		 JRST	FILSLH	;yep
		 JRST	.-2]	;back for more
FIL1:	CALL	WRTBEG		;write beginning of line + CRLF
	MOVEM	P1,SAVPNT	;update "beginning" of line
	CALL	REMCNT		;[34] remove any continuation syntax
	CALL	INSLIN		;replace all "//" with CRLFs
	RETSKP			;and continue
; Execute a ;Get option | variable command
;
; Returns +1 always

CMGET:			;Get option!variable <name>
	TXNE	F,F%SUP!F%FLS	;[50] suppress this command?	
	RET			;[50] yep, then quit now
	CALL	MOVSPC		;position to next word
	  JRST	GETILC		;illegal command
	MOVEI	.AC1,[XWD  2,2	;[36] table of legal switches for ;Get
		      ITEM DEFINE,F%DEF	;[36]
		      ITEM NOECHO,P%NEC] ;[36]
	CALL	GETSWT		;[36] parse the switches
	  RET			;[36] an error occurred
	  JRST	CMGET		;[36] found one, so look for another
	MOVE	P2,[POINT 7,ANSW1]
	CALL	GETWRD		;get OPTION!VARIABLE
	  JRST	GETIVO		;invalid option
	MOVEI	.AC1,[XWD  2,2
		      ITEM OPTION,0
		      ITEM VARIABLE,1]
	MOVE	.AC2,[POINT 7,ANSW1]
	TBLUK			;match type
	TXNE	.AC2,TL%NOM!TL%AMB ;found a match?
	JRST	GETIVO		;nope
	HRRZ	.AC1,(.AC1)
	SKIPE	.AC1
	TXO	F,D.VAR		;set this flag if ;Get variable
	CALL	MOVSPC		;position to name
	  JRST	GETNAM		;name missing
	TXNE	F,D.VAR		;if ;Get variable
	JRST	[CAIE	CH,SPECHR
		 JRST	GETIVN	;then name must begin w/"<"
		 JRST	.+1]
	MOVE	P2,[POINT 7,ANSW1]
	TXO	F,F%VNM		;break on ">"
	CALL	GETWRD		;get the option!variable name
	  JRST	GETNAM
	TXNN	F,D.VAR		;Get variable?
	JRST	CMGET1		;nope, then get option
	TXZN	F,F%VNM		;did GETWRD terminate due to ">"?
	JRST	GETIVN		;nope
	CALL	GETVAR		;get the value
	TXNN	F,F%SHW		;was the value there?
	JRST	GETVND		;variable not defined
	CALL	CMGET3		;[36] do /DEFINE switch stuff
	  RET			;[36] an error occurred
	MOVEM	P1,PUTPNT	;setup pointer to insert value into line
	MOVE	.AC1,[SVALUE,,ANSW2]
	MOVE	.AC2,ITMLEN
	ADDI	.AC2,ANSW2-1
	BLT	.AC1,(.AC2)	;move default to answer
	CALL	DEFSTO		;store it
	  RET			;error occurred, so quit
	MOVE	P1,[POINT 7,ANSW2]
	MOVEM	P1,PUTVAL	;setup pointer for insertion value
	JRST	CMGET2
CMGET1:
	TXZ	F,F%VNM		;reset variable name break flag
	CALL	GETOPT		;get option value
	TXNN	F,F%SHW		;was the option there?
	JRST	GETOND		;option not defined
	CALL	CMGET3		;[36] do /DEFINE switch stuff
	  RET			;[36] an error occurred
	MOVEM	P1,PUTPNT	;setup pointer to insert value into line
	CALL	SELSTO		;store the option and value
	  RET			;error occurred, so quit
	MOVE	.AC1,[ASCIZ /Yes/]
	SKIPN	SVALUE
	MOVE	.AC1,[ASCIZ /No/]
	MOVEM	.AC1,ANSW2	;setup to look like a response was given
CMGET2:
	TXNE	F,P%NEC		;[36] was /NOECHO switch given?
	RET			;[36] yep, then quit now
	TYPE	ANSW1		;type option!variable name
	TYPE1	EQUAL
	TYPE	ANSW2		;type value
	TYPE	CRLF
	RET

CMGET3:				;[36] - get a new name if /DEFINE switch given
	TXNN	F,F%DEF		;was /DEFINE specified?
	JRST	CMGET4		;nope, then check for end of line
	MOVE	P2,[POINT 7,ANSW1] ;read new name into ANSW1
	TXO	F,F%VNM		;break on ">" or space
	CALL	GETWRD		;get the next name
	  JRST	GETNSN		;no second name
	TXNE	F,D.VAR		;skip if not Get variable
	TXNE	F,F%VNM		;skip if not terminated with ">"
	SKIPA			;all is ok
	JRST	GETIVN		;invalid variable name
CMGET4:	CALL	MOVSPC		;skip to end of line
	  SKIPA			;OK if found end of line
	JRST	GETTMF		;too many fields
	MOVEI	CH," "		;change delimiter to space
	DPB	CH,P1
	MOVE	T1,P1		;get current line pointer
	MOVEI	CH,15		;add CRLF at current position
	IDPB	CH,T1
	MOVEI	CH,12
	IDPB	CH,T1
	SETZ	CH,
	IDPB	CH,T1		;and make it still ASCIZ
	RETSKP			;done now
; Execute an ;If "<string1>" [NOT] =!<!> "<string2>" command
;
; Returns +1: error occurred or condition false
;	  +2: condition true, P1 points to following <text>

CMIF:
	TXO	F,F%CON		;[50] set CONditional flag
	CALL	MOVSPC		;position to start of first string
	  JRST	CIFNST		;no string
	ILDB	CH,P1		;get first char
	CAIE	CH,42		;it is quote?
	JRST	CIFIST		;invalid string
	MOVEM	P1,P2		;hold string1 pointer for later
	SETZ	P3,		;hold the condition here
CMIF1:	ILDB	CH,P1		;get next char of string
	CAIN	CH,42		;found another quote?
	JRST	CMIF2		;yep
	CAIN	CH,15		;found end of line?
	JRST	CIFICM		;incomplete command
	JRST	CMIF1		;and loop back for more
CMIF2:	CALL	MOVSPC		;skip any intervening spaces
	  JRST	CIFICM		;incomplete command
	ILDB	CH,P1		;get the condition
	CAIN	CH,"="		;equals condition?
	HRRI	P3,1		;yep, then code 1
	CAIN	CH,SPECHR	;less-than condition?
	HRRI	P3,2		;yep, then code 2
	CAIN	CH,">"		;greater-then condition?
	HRRI	P3,4		;yep, then code 4
	CAIE	CH,"N"		;not condition?
	CAIN	CH,"n"		;allow lower-case also
	JRST	[ILDB	CH,P1	;yep, then check for whole word
		 CAIE	CH,"O"
		 CAIN	CH,"o"
		 SKIPA
		 JRST	CMIFN	;[44] not "NOT", then check for "NUMERIC"
		 ILDB	CH,P1
		 CAIE	CH,"T"
		 CAIN	CH,"t"
		 SKIPA
		 JRST	CIFCON
		 TLO	P3,-1	;set left half of code to -1
		 JRST	CMIF2]	;and find real condition
	TRNN	P3,-1		;found a condition?
	JRST	CIFCON		;nope, invalid condition
	CALL	MOVSPC		;skip intervening spaces
	  JRST	CIFICM		;incomplete command if EOL
	ILDB	CH,P1		;does string begin w/ quote?
	CAIE	CH,42
	JRST	CIFIST		;nope, invalid string
CMIF3:	ILDB	CH,P1		;get a char of string2
	ILDB	T1,P2		;get a char of string1
	CAIN	CH,42		;found ending quote?
	JRST	CMIF4		;yep
	CAIN	CH,15		;found end of line?
	JRST	CIFICM		;incomplete command
	CAMN	T1,CH		;are chars equal?
	JRST	CMIF3		;yep, then loop back for more
	CAIL	CH,"a"		;raise lowercase to uppercase
	CAILE	CH,"z"
	SKIPA
	SUBI	CH,"a"-"A"
	CAIL	T1,"a"		;raise string1 char also
	CAILE	T1,"z"
	SKIPA
	SUBI	T1,"a"-"A"
	CAMN	T1,CH		;equal now?
	JRST	CMIF3		;yep
CMIF4:	SETZ	P2,		;hold actual condition here
	CAMN	T1,CH		;are last chars equal?
	MOVEI	P2,1		;yep, then condition 1
	CAMGE	T1,CH		;is string1 < string2?
	MOVEI	P2,2		;yep, then code 2
	CAMLE	T1,CH		;is string1 > string2?
	MOVEI	P2,4		;yep, then code 4
	TDNN	P2,P3		;compare actual with requested condition
	JRST	[TLNN	P3,-1	;conditions not equal, but check for NOT
;[50]		 RET		;NOT not requested, so conditions false
		 CALL	SETFLS	;[50] set flase condition
		 JRST	CMIF5]
	TLNE	P3,-1		;conditions are equal, but was NOT requested?
;[50]	RET			;yep, then really false
	CALL	SETFLS		;[50] set false condition
CMIF5:	MOVEM	P1,P2		;save current pointer
	ILDB	CH,P1		;condition is satisfied, so look for "/"
	CAIN	CH,"/"
	JRST	CMIF6
	SKIPE	CH		;found end of line instead?
	JRST	CMIF5		;nope
	JRST	CIFSLH		;slash not found
CMIF6:	CALL	WRTBEG		;output beginning of line +CRLF
	MOVEM	P1,SAVPNT	;update pointer
	CALL	REMCNT		;[34] remove any continuation syntax
	CALL	INSLIN		;replace all "//" with CRLFs
	RETSKP			;and continue to process line

CMIFN:	CAIE	CH,"U"		;[44] is condition "NUMERIC"?
	CAIN	CH,"u"		;[44]
	SKIPA			;[44]
	JRST	CIFCON		;[44]
	ILDB	CH,P1		;[44]
	CAIE	CH,"M"		;[44]
	CAIN	CH,"m"		;[44]
	SKIPA			;[44]
	JRST	CIFCON		;[44]
	ILDB	CH,P1		;[44]
	CAIE	CH,"E"		;[44]
	CAIN	CH,"e"		;[44]
	SKIPA			;[44]
	JRST	CIFCON		;[44]
	ILDB	CH,P1		;[44]
	CAIE	CH,"R"		;[44]
	CAIN	CH,"r"		;[44]
	SKIPA			;[44]
	JRST	CIFCON		;[44]
	ILDB	CH,P1		;[44]
	CAIE	CH,"I"		;[44]
	CAIN	CH,"i"		;[44]
	SKIPA			;[44]
	JRST	CIFCON		;[44]
	ILDB	CH,P1		;[44]
	CAIE	CH,"C"		;[44]
	CAIN	CH,"c"		;[44]
	SKIPA			;[44]
	JRST	CIFCON		;[44]
CMIFN0:	ILDB	CH,P2		;[44] get a char of the string
	CAIN	CH,42		;[44] found the terminating quote?
	JRST	CMIFN1		;[44] yep, then is NUMERIC
	CAIL	CH,"0"		;[44] in range 0-9?
	CAILE	CH,"9"		;[44]
	JRST	[TLNN	P3,-1	;[44] nope, then was it NOT NUMERIC?
;[50]		 RET		;[44] nope, then done
		 CALL	SETFLS	;[50] set false condition
		 JRST	CMIFN2]	;[44] else ok
	JRST	CMIFN0		;[44] still numeric so far, so look further
CMIFN1:	TLNE	P3,-1		;[44] was condition NOT NUMERIC?
;[50]	RET			;[44] yep, then test is false
	CALL	SETFLS		;[50] set false condition
CMIFN2:	CALL	MOVSPC		;[44] skip spaces
	  JRST	CIFSLH		;[44] slash missing
	ILDB	CH,P1		;[44] look at delimiter
	CAIE	CH,"/"		;[44] is it slash?
	JRST	CIFSLH		;[44] nope
	JRST	CMIF6		;[44] everything is ok
; Execute an ;Abort [<text>] command
;
; Returns +1 if F%BTW set (between tags on restart)
; Cleans up and quits otherwise

CMQUIT:
	TXNE	F,F%BTW!F%SUP!F%FLS ;[50] processing between tags?
	RET			;then ignore command
	CALL	TYCRLF
	HRROI	.AC1,[ASCIZ /?SETUP aborted/]
	PSOUT
	CALL	MOVSPC		;position to message
	  JRST	CMQT1		;ignore if not there
	HRROI	.AC1,[ASCIZ /; /]
	PSOUT
	CALL	LINTTY		;type message if there
CMQT1:
	CALL	CLRACS		;clear any list access
	CALL	RELBIN		;release SETUP.BIN
	MOVE	.AC1,OUTJFN
	SKIPE	.AC1
	JRST	[TDO	.AC1,[CZ%ABT] ;abort output
		 CLOSF
		   CALL	SYSWRN
		 JRST	.+1]
	MOVNI	.AC1,1		;close all files
	CLOSF
	  CALL	SYSWRN
	HALTF			;quit
	JRST	START		;if CONTINUE'd
; Execute ;Leave command - edit 47
;
; Returns +1 with F%EOL set if block name stack is not empty
;	  Jumps to FATAL (LEVTPL) if block stack is empty
;	  Jumps to FATAL (LEVNAM) if name mismatch is found
;	  Jumps to FATAL (LEVENF) if end-of-file reached before ;End
;	  Jumps to FATAL (AMBCMD) if searching for ;End & found ambiguous cmd
;	  Jumps to FATAL (INVBKN) if invalid block name found

LEAVE:
	MOVE	.AC1,SLEVEL	;get current level of SETUP
	CAIG	.AC1,1		;at level 1?
	JRST	LEVTPL		;yep, then cannot leave top level
	CALL	EQUBLK		;[50] compare block names
	  JRST	LEVNAM		;[50] mis-match
	TXNE	F,F%FLS		;[52] after a false condition?
	RET			;[52] yep, then quit now
	MOVE	P1,SAVPNT	;[50] copy current line to CTL file
	CALL	WRTLIN		;[50]
	MOVE	P1,[POINT 7,[0]] ;[50] fudge a nul line
	MOVEM	P1,SAVPNT	;[50]
	HRRZ	.AC2,BLKTYP	;[50] look at block type
	TXNN	.AC2,FILCOD	;[50] is this a ;Perform block?
	JRST	.+3		;[50] nope, then must be a normal block
	TRNN	.AC2,377777	;[50] is file position zero (i.e. ;Perform file)?
	JRST	LEAV0		;[50] yep, then do EOF processing
	TXO	F,F%SUP		;[50] else set SUPpress flag
	RET			;[50] and now done

LEAV0:	TXO	F,F%EOL		;[50] exit this level
	CALLRET	CKEOF		;[50] after saying ; end of ...
; EQUBLK - called from LEAVE, END to compare current block name (in SVALUE)
;	   to block name in MCF command line (after P1).
;
; Returns: +1 names do not match
;	   +2 names match or MCF line gave no name

EQUBLK:
	CALL	MOVSPC		;position to block name
	  RETSKP		;none there, so treat it as a match
	MOVE	P2,[POINT 7,ANSW1] ;copy block name to ANSW1
	CALL	GETWRD
	  JRST	INVBKN		;invalid block name
	MOVE	P2,[POINT 7,BLKNAM] ;compare BLKNAM and ANSW1
	MOVE	P3,[POINT 7,ANSW1]
EQUBK0:	ILDB	T1,P2
	ILDB	T2,P3
	SKIPN	T1		;at end of SVALUE?
	JRST	EQUBK1		;yep
	CAMN	T1,T2		;are these chars equal?
	JRST	EQUBK0		;yep, then look some more
	CAIL	T1,"a"		;raise lowercase to uppercase
	CAILE	T1,"z"
	SKIPA
	SUBI	T1,"a"-"A"
	CAIL	T2,"a"
	CAILE	T2,"z"
	SKIPA
	SUBI	T2,"a"-"A"
	CAMN	T1,T2		;equal now?
	JRST	EQUBK0		;yep, then continue
	RET			;else name mis-match
EQUBK1:	SKIPE	T2		;at end of ANSW1 also?
	RET			;nope, then names don't match
	RETSKP
; ;Begin a block
;
; Calls SETUP recursively after saving current block type and name
;
; Returns +1

BEGIN:				;[50] - entire routine
	CALL	MOVSPC		;position to block name
	  JRST	.+3		;un-named block
	MOVE	P2,[POINT 7,ANSW1] ;get block name
	CALL	GETWRD
	  SETZM	ANSW1		;make an un-named block
	MOVEI	.AC1,BEGCOD	;block type is ;Begin block
	MOVE	.AC2,[POINT 7,ANSW1] ;new block name
	JSP	T1,PSHBLK	;prepare for a new block
	MOVE	P1,SAVPNT	;copy current line to CTL file
	CALL	WRTLIN
	TXNE	F,F%FLS		;after a FaLSe condition?
	TXO	F,F%SUP		;yep, then SUPpress this block
	CALL	SETUP		;setup new block
	JSP	T1,POPBLK	;restore my own block
	MOVE	P1,[POINT 7,[0]] ;make a nul line
	MOVEM	P1,SAVPNT
	RET
; Push and Pop the current BLKTYP and BLKNAM onto the stack and setup
; (restore) a new one from the pointers in AC1 and AC2

PSHBLK:				;push BLKTYP and BLKNAM on stack
				;AC1 contains new BLKTYP, AC2 points to new name
	PUSH	P,BLKTYP	;save current block type
	MOVEM	.AC1,BLKTYP	;store new type
	HLLM	F,BLKTYP	;save block flags too
	MOVE	.AC1,[POINT 7,BLKNAM] ;get byte ptr to current name
	ILDB	CH,.AC1		;search to end of name
	SKIPE	CH
	JRST	.-2
	TLZ	.AC1,-1		;compute # words in name
	SUBI	.AC1,BLKNAM-1
	MOVN	X1,.AC1		;copy to index & negate
	HRLZ	X1,X1		;make left half of AOBJN pointer
	PUSH	P,BLKNAM(X1)	;save this word of the name
	AOBJN	X1,.-1		;else save more words
	HLL	.AC1,SAVFLG	;save state of world at beginning of line too
	PUSH	P,.AC1		;otherwise save word count also
	HRROI	.AC1,BLKNAM	;move new block name to BLKNAM
	SETZ	.AC3,
	SOUT%
	JRST	(T1)		;and return


POPBLK:				;pop block name off stack into BLKNAM and BLKTYP
	POP	P,X1		;pop flags & # of words in block name
	TXNN	X1,F%SUP	;reset SUPpress flag if necessary
	TXZ	F,F%SUP
	TXNN	X1,F%PFM	;/VERIFY set for ;Perform in this block?
	TXZ	F,F%PFM		;nope, then reset it now
	TLZ	X1,-1		;mask word count only
	POP	P,BLKNAM-1(X1)	;restore the block name
	SOJG	X1,.-1
	POP	P,BLKTYP	;restore old block type
	JRST	(T1)		;and return
; ;End a block
;
; Returns +1 if names matches current block name
;	  Sets F%EOL if current block is a ;Perform block
;	  Jumps to FATAL (ENDBLK) if not inside a block
;	  Jumps to FATAL (ENDNAM) if names do not match
;	  Jumps to FATAL (INVBKN) if invalid block name found

CMEND:				;[50] - entire routine
	TXNE	F,F%CON		;did this line start with a conditional?
	JRST	ENDNCA		;yep, then say no conditionals allowed
	MOVE	.AC1,SLEVEL	;look at current level
	CAIG	.AC1,1		;>1?
	JRST	ENDNIB		;nope, then not in block
	CALL	EQUBLK		;compare block names
	  JRST	LEVNAM		;mis-match
	MOVE	.AC1,BLKTYP	;look at block type
	TXZN	.AC2,FILCOD	;is this a ;Perform block?
	JRST	.+3		;nope, then don't check file position
	TRNN	.AC1,-1		;is file position zero (i.e. ;Perform file)?
	JRST	ENDFIL		;yep, then cannot ;End an ;Include or ;Perform
	TXNN	.AC1,F%SUP	;is SUPpress flag set for this block?
	TXZ	F,F%SUP		;nope, then reset it now
	TXO	F,F%EOL		;set End Of Level
	RET
	SUBTTL *** UTILITY SUBROUTINES ***

; Write MCF line to CTL file.  If PUTPNT is non-zero, then it is a byte
; pointer to a place for an insertion value and PUTVAL is either a byte
; pointer to the value or 0 for a "no" option or 1 for a "yes" option
;
; Returns +1 always

WRTLIN:
	TXNE	F,F%SUP!F%FLS	;[50] suppress this line?
	RET			;[50] yep
	MOVE	.AC1,OUTJFN
	SETZB	.AC3,.AC4	;terminates on nul byte
	SKIPN	PUTPNT		;any insertions?
	JRST	WRTLN1		;nope
	MOVE	P2,PUTPNT	;where to insert
	ILDB	CH,P2		;get the character currently there
	PUSH	P,CH		;save it
	SETZ	CH,
	DPB	CH,P2		;make it a nul
	MOVE	.AC2,P1
	SOUT			;output line
	  ERJMP	SYSFAT		;[36]
	  ERJMP	SYSFAT		;[36]
	MOVEI	.AC2,"\"	;insertion delimiter
	BOUT
	  ERJMP	SYSFAT		;[36]
	MOVM	T1,PUTVAL	;pointer to insertion value
	MOVE	.AC2,PUTVAL	;assume a byte pointer
	CAIG	T1,1		;really a byte pointer?
	JRST	[HRROI	.AC2,[ASCIZ /Y/] ;nope, then point to option value
		 SKIPN	T1
		 HRROI	.AC2,[ASCIZ /N/]
		 JRST	.+1]
	SOUT			;output insertion value
	  ERJMP	SYSFAT		;[36]
	MOVEI	.AC2,"\"	;another delimiter
	BOUT
	  ERJMP	SYSFAT		;[36]
	MOVEI	.AC2," "	;and another separator
	  ERJMP	SYSFAT		;[36]
	BOUT
	POP	P,CH		;restore the char
	DPB	CH,P2		;replace it
	MOVE	P1,PUTPNT	;update pointer to output remainder of line
	SETZM	PUTPNT		;and clear insertion pointer
WRTLN1:	MOVE	.AC2,P1		;get line pointer
	SOUT			;output line
	RET
;WRITE MCF LINE (OR PART OF IT) TO TTY

TYCRLF:	CALL	ENABLE		;CLEAR CONTROL O FIRST
	HRROI	.AC1,CRLF
	PSOUT
	RET

;[34] LINTTY:	CALL	ENABLE		;CLEAR ^O
;[34]	MOVE	.AC1,P1		;MOVE POINTER FOR JSYS
;[34]	PSOUT			;TYPE THE LINE
;[34]	RET

ENABLE:	MOVEI	.AC1,.PRIIN	;SETUP TERMINALS JFN
	RFMOD			;READ JFN MODE WORD
	TLZE	.AC2,(TT%OSP)	;DO WE NEED TO CLEAR CNTRL/O
	SFMOD			;YES- DO IT
	RET

WRTBEG:				;Output line from SAVPNT w/CRLF
	TXNE	F,F%FLS!F%SUP	;[50] suppress output?
	RET			;[50] yep
	MOVE	.AC1,P1
	ILDB	.AC2,.AC1
	PUSH	P,.AC2		;want to make it ASCIZ, so save char
	PUSH	P,.AC1		;and byte pointer
	SETZ	.AC2,
	DPB	.AC2,.AC1	;ASCIZ
	MOVE	.AC1,OUTJFN	;.CTL file
	MOVE	.AC2,SAVPNT	;beginning of record
	SETZB	.AC3,.AC4
	SOUT			;output record
	  ERJMP	SYSFAT		;[36]
	HRROI	.AC2,CRLF
	SOUT			;add this also
	  ERJMP	SYSFAT		;[36]
	POP	P,.AC1		;restore byte pointer
	POP	P,.AC2		;and char
	DPB	.AC2,.AC1	;replace it
	RET

; Copy current line to CTL file and set false flag

SETFLS:				;[50] - entire routine
	PUSH	P,P1		;save current line ptr
	MOVE	P1,SAVPNT	;copy current line to CTL file
	CALL	WRTLIN
	POP	P,P1		;restore current line ptr
	TXO	F,F%FLS		;set FaLSe flag
	RET
; Replace all double slashes ("//") following P1 with CRLFs

INSLIN:
	ILDB	CH,P1		;get a char
	CAIN	CH,"/"		;one slash?
	JRST	[MOVEM	P1,.AC1	;yep, then save pointer
		 ILDB	CH,P1	;does another slash follow?
		 CAIE	CH,"/"
		 JRST	.+1	;nope
		 TXO	F,SLH	;set flag that multiple lines were found
		 MOVEI	CH,15	;replace "//" with CRLF
		 DPB	CH,.AC1
		 MOVEI	CH,12
		 DPB	CH,P1
		 JRST	INSLIN]	;and continue with search
	SKIPE	CH		;end of line yet?
	JRST	INSLIN		;nope, then look some more
	MOVE	P1,SAVPNT	;restore line pointer
	RET

LINOUT:				;[54] output "Line nnnn: " to trace file
	HRROI	.AC2,[ASCIZ /Line /]
	SETZ	.AC3,
	SOUT%
	  ERJMP	SYSFAT
	MOVE	.AC2,LINCNT	;get current line number
	MOVX	.AC3,NO%LFL+4B17+12 ;in 4 columns, right justified
	NOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / [/] ;[56]
	SETZ	.AC3,		;[56]
	SOUT%			;[56]
	  ERJMP	SYSFAT		;[56]
	MOVE	.AC3,[POINT 6,NEWTAG] ;[56] get ptr to last tag
	MOVEI	.AC4,6		;[56] max of 6 bytes long
LINOT0:	ILDB	.AC2,.AC3	;[56] get a char
	SKIPG	.AC2		;[56] found space?
	JRST	LINOT1		;[56] yep, then done
	ADDI	.AC2,40		;[56] make it ASCII
	BOUT%			;[56] output it
	  ERJMP	SYSFAT		;[56]
	SOJG	.AC4,LINOT0	;[56] loop thru all chars
LINOT1:	HRROI	.AC2,[ASCIZ / + /] ;[56]
	SETZ	.AC3,		;[56]
	SOUT%			;[56]
	  ERJMP	SYSFAT		;[56]
	MOVE	.AC2,TAGOFF	;[56] show offset
	MOVEI	.AC3,12		;[56]
	NOUT%			;[56]
	  ERJMP	SYSFAT		;[56]
	HRROI	.AC2,[ASCIZ /]: /] ;[56]
	SETZ	.AC3,
	SOUT%
	  ERJMP	SYSFAT
	RET
;	GETSWT - Parses zero or more switches after a command
;
; Accepts: AC1 = pointer to legal switch table in TBLUK format
;	   P1  = pointer to input buffer
;
; Returns: +1 if no switches found or invalid switch
;	   +2 if a valid switch was found
;
;	   P1  = updated to next field
;	   F   = flag bits set according to switch table
;[42]	   SVALUE = ASCIZ string if a switch terminated with a colon
;[42]		    followed by a quoted string is found w/ITMLEN holding
;[42]		    count of words in string

GETSWT:				;[36] - entire routine
	TRNN	F,SLH			;already found a switch?
	JRST	[MOVE	.AC2,P1		;get byte pointer
		 ILDB	CH,.AC2		;look at next char
		 CAIE	CH,"/"		;a slash?
		 JRST	.+1		;nope
		 TRO	F,SLH		;else set flag
		 MOVEM	.AC2,P1		;and update pointer
		 JRST	.+1]
	TRNE	F,SLH			;any switches?
	JRST	[MOVE	P2,[POINT 7,ANSW1] ;yep, then get the switch
		 TXO	F,F%BRK	;[42] set to terminate on special characters
		 CALL	GETWRD		
		   JRST SWTMIS		;switch is missing
		 MOVE	.AC2,[POINT 7,ANSW1] ;addr of switch table is in AC1
		 TBLUK			;look for match
		 TXNE	.AC2,TL%NOM!TL%AMB ;found one?
		 JRST	INVSWT		;nope, then invalid
		 HRRZ	.AC1,(.AC1)	;get flag
		 TDO	F,.AC1		;set the proper bit
		 LDB	CH,P1	;[42] look at terminating char
		 CAIN	CH,":"	;[42] was it a colon?
		 JRST	GETSW0	;[42] yep, then have to eat quoted text too
		 RETSKP]		;skip return to parse some more
	AOS	(P)			;two-skip return if all switches parsed
	RETSKP
GETSW0:	CALL	MOVSPC		;[42] skip any spaces
	  JRST	SWTVAL		;[42] found end of line before a value
	ILDB	CH,P1		;[42] look at next char
	CAIE	CH,42		;[42] quote-char?
	JRST	SWTDEL		;[42] nope, then invalid value
	MOVE	P2,[POINT 7,SVALUE] ;[42] else move value to safe place
GETSW1:	ILDB	CH,P1		;[42] get a char
	IDPB	CH,P2		;[42] copy it
	CAIN	CH,12		;[42] end of line?
	JRST	SWTDEL		;[42] yep, then missing delimiter
	CAIE	CH,42		;[42] terminating quote?
	JRST	GETSW1		;[42] nope, then back for more
	SETZ	CH,		;[42] done, so make it ASCIZ
	DPB	CH,P2		;[42]
	TLZ	P2,-1		;[42] get last addr used
	SUBI	P2,SVALUE-1	;[42] compute word count
	MOVEM	P2,ITMLEN	;[42] and save as item length
	RETSKP			;[42]
;	LINTTY - Write formatted line from buffer to terminal

;Accepts: P1 = buffer pointer

;Returns: +1 always after typing line

LINTTY:				;[34] - entire routine
	CALL	ENABLE		;clear ^O
	TXNN	F,F%CNT		;was line continued?
	JRST	LINTT3		;nope, then simply display it
	PUSH	P,P2		;save pointer#2
	MOVE	P2,[POINT 7,ANSW3] ;construct prompt here
LINTT1:	ILDB	CH,P1		;get a char
	IDPB	CH,P2		;move it
	SKIPN	CH		;found end of buffer yet?
	JRST	LINTT2		;yep, then done
	CAIE	CH,"-"		;is it hyphen?
	JRST	LINTT1		;nope, then continue
	ILDB	CH,P1		;get char after hyphen
	CAIE	CH,15		;is it return?
	JRST	LINTT1+1	;nope, then continue
	DPB	CH,P2		;put into prompt
	ILDB	CH,P1		;get LF
	IDPB	CH,P2		;and put into prompt also
	IBP	P1		;skip over semi-colon
	IBP	P1		;and plus-sign
	ILDB	CH,P1		;get next char
	CAIE	CH," "		;is it a space
	CAIN	CH,11		;or TAB?
	ILDB	CH,P1		;yep, then skip it too
;[37]	IDPB	CH,P2		;put next char into prompt
;[37]	JRST	LINTT1		;and look some more
	JRST	LINTT1+1	;[37] and check this char for hyphen
LINTT2:	POP	P,P2		;restore pointer#2
	HRROI	.AC1,ANSW3	;get pointer to prompt
	SKIPA			;and skip
LINTT3:	MOVE	.AC1,P1		;get buffer pointer
	PSOUT%			;output line
	RET
	;GET WORD
; P1 - POSITIONED IN FRONT OF WORD TO BE GATHERED
; P2 - POINTS TO WHERE WORD WILL BE DEPOSITED
; T3 - RETURNS LENGTH OF GATHERED WORD
; GIVES SKIP RETURN FOR NORMAL OR SUCCESSFUL GATHERING
; GIVES REGULAR RETURN IF T3=0, OR T3 > 36
;  A SPACE, TAB, SLASH, OR EOL WILL TERMINATE GATHERING
;  AND SET APPROPRIATE TERMINATOR FLAGS IN F
; ">" also terminates a word if F%VNM is set (variable name)
;[42] terminates on not A-Z,a-z,"-" if F%BRK is set and resets F%BRK

GETWRD:
	SETZ	T3,		;SET LENGTH TO ZERO
	TRZ	F,SPC!SLH!EOL	;CLEAR DELIMITER FLAGS
GETCON:	ILDB	CH,P1		;GET CHAR
	CAIE	CH," "		;DO WE HAVE A SPACE CHAR?
	CAIN	CH,11
	TROA	F,SPC		;YES- SET FLAG
	SKIPA			;NO- SKIP TO CHECK FOR OTHERS
	JRST	GETRET		;GO CHECK RETURN
	CAIN	CH,"/"		;SLASH?
	TRO	F,SLH		;YES
	CAIN	CH,15		;EOL?
	TROA	F,EOL		;YES
	TRNE	F,SLH!EOL	;ANY DELIMITERS?
	JRST	GETRET		;YES - CHECK RETURN
	TXNE	F,F%BRK		;[42] special chars allowed?
	JRST	[CAIN	CH,"-"	;[42] nope, then is it hyphen?
		 JRST	.+1	;[42] yep, then still legal
		 CAIL	CH,"A"	;[42] else is it in range A-z?
		 CAILE	CH,"z"	;[42]
		 JRST	GETRET	;[42] nope, then done
		 CAIG	CH,"Z"	;[42] is it A-Z?
		 JRST	.+1	;[42] yep, then continue
		 CAIL	CH,"a"	;[42] else in range a-z?
		 CAILE	CH,"z"	;[42]
		 JRST	GETRET	;[42] nope, then done
		 JRST	.+1]	;[42] else continue copying chars
	IDPB	CH,P2		;NO - DEPOSIT CHAR
	CAIN	CH,">"		;likely end of variable name?
	JRST	[TXNN	F,F%VNM	;yep, then is flag set
		 JRST	.+1	;nope, then continue
		 IBP	P1	;increment past delimiter
		 AOJ	T3,	;increment char count
		 JRST	GETRET]
	AOJA	T3,GETCON	;INCREMENT LENGTH
GETRET:	TXNE	F,F%CNT		;[34] skip if line was not continued
	TXNN	F,EOL		;[34] saw end of line?
	JRST	.+4		;[34] nope, then continue
	LDB	CH,P2		;[34] get last char of word
	CAIN	CH,"-"		;[34] is it a hyphen?
	JRST	[SETZ	CH,	;[34] yep, then delete it
		 DPB	CH,P2	;[34]
		 SOJA	T3,.+1]	;[34] and reduce char count
	SKIPE	T3		;GIVE FAIL RET IF LNG IS 0
	CAILE	T3,^D36		;<37 ?
	RET			;NO - ERROR RETURN
	CAIE	CH,">"		;did word break on ">"?
	TXZ	F,F%VNM		;nope, then reset variable name flag
	SETZ	CH,		;NOW MAKE A ASCIZ STRING
	IDPB	CH,P2
	TXZ	F,F%BRK		;[42] reset special char flag
	RETSKP
; Skip over zero or more spaces and/or tabs starting at P1
;
; Returns +1: found end of line
;	  +2: P1 points to first char after spaces,
;	      CH contains that char

MOVSPC:
	TRO	F,SPC		;have at least one delimiter already
	SKIPA	T1,P1		;COPY CURRENT BYTE POINTER
MOV0:	MOVE	P1,T1		;UPDATE LINE BYTE POINTER
	ILDB	CH,T1		;GET NEXT CHAR LINE
	CAIE	CH," "		;SPACE CHAR?
	CAIN	CH,11
	TROA	F,SPC		;YES- SET THE FLAG
	SKIPA			;NO- MUST CHECK FOR EOL
	JRST	MOV0		;GET NEXT CHAR
	CAIE	CH,15		;CHECK FOR EOL?
	CAIN	CH,12
;[37]	RET			;YES - FAIL RETURN
	JRST	[TXNN	F,F%CNT	;[37] was line continued?
		 RET		;[37] nope, then don't bother to check hyphen
		 MOVNI	T3,1	;[37] backup two chars
		 ADJBP	T3,P1	;[37] get the byte ptr
		 CAIE	CH,12	;[37] just saw LF?
		 MOVE	T3,P1	;[37] nope, then only look back 1 char
		 LDB	CH,T3	;[37] get the char before CR
		 CAIE	CH,"-"	;[37] was it hyphen?
		 RET		;[37] nope, then just quit now
		 ILDB	CH,T1	;[37] skip LF
		 CAIE	CH,";"	;[37] skip if already got semi-colon
		 IBP	T1	;[37] skip semi-colon
		 IBP	T1	;[37] and plus-sign
		 JRST	MOV0]	;[37] then continue w/move
	CAIN	CH,"-"		;[34] is the break char a hyphen?
	JRST	[TXNN	F,F%CNT	;[34] was line continued?
		 RET		;[34] nope, then failure return
		 MOVEI	CH,4	;[34] skip past continuation chars
		 ADJBP	CH,T1	;[34]
		 MOVEM	CH,T1	;[34]
		 JRST	MOV0]	;[34] and continue skipping
	TRNE	F,SPC		;END OF SPACES
	RETSKP			;YES SUCCESSFUL RETURN
	JRST	MOV0		;NO - HAVEN'T FOUND ANY YET
;	REMCNT - Remove line continuation syntax
;
;Accepts: P1 = pointer to line 
;
;Returns: +1 always, with hyphen, CRLF, semi-colon, plus-sign, space or tab removed

REMCNT:				;[34] remove continuation syntax
	TXNN	F,F%CNT		;was line continued?
	RET			;nope, then nothing to do!
	PUSH	P,.AC1		;save AC1
	PUSH	P,.AC2		;save AC2
	MOVE	.AC1,P1		;get the current buffer pointer
REMCT1:	ILDB	CH,.AC1		;get a char
	SKIPN	CH		;found end of buffer?
	JRST	REMCT5		;yep, then quit
	CAIE	CH,"-"		;found hyphen?
	JRST	REMCT1		;nope, then look again
	ILDB	CH,.AC1		;get char after hyphen
	CAIE	CH,15		;is it return?
	JRST	REMCT1		;nope, then look again
	MOVNI	.AC2,1		;get a pointer to the hyphen
	ADJBP	.AC2,.AC1	;   which is where to move the remaining chars
REMCT2:	IBP	.AC1		;skip LF
	IBP	.AC1		;semi-colon
	IBP	.AC1		;and plus-sign
REMCT3:	MOVNI	CH,1		;backup dest pointer
	ADJBP	CH,.AC2
	MOVEM	CH,.AC2
	LDB	CH,.AC2		;get char before hyphen
	CAIE	CH," "		;is it a space
	CAIN	CH,11		;or a tab?
	JRST	REMCT3		;yep, then skip it too
	ILDB	CH,.AC1		;get next char of buffer
	CAIE	CH," "		;is it space
	CAIN	CH,11		;or tab?
	ILDB	CH,.AC1		;yep, then skip it too
REMCT4:	IDPB	CH,.AC2		;copy the char
	SKIPN	CH		;found end of buffer?
	JRST	REMCT5
	CAIE	CH,"-"		;was it a hyphen?
	JRST	REMCT4-1	;nope, then continue
	ILDB	CH,.AC1		;get next char
	CAIN	CH,15		;is it return?
	JRST	REMCT2		;yep, then back to skipping CRLF;+
	JRST	REMCT4		;and continue looking
REMCT5:	POP	P,.AC2		;restore AC2
	POP	P,.AC1		;and AC1
	RET			;all done
; Read an MCF line and search it for a BATCH label
;
; Returns +1 always, line in LINE, F%BTW set if tag in TAGNAM found on line

GETLIN:
	TXZ	F,F%CNT		;[34] reset line continued flag
	MOVE	.AC1,INJFN	;SOURCE DESIGNATOR
	HRROI	.AC2,LINE	;DESTINATION POINTER
	MOVEI	.AC3,MAXCHR+1	;MAXIMUM NUMBER OF CHARS TO READ
	MOVEI	.AC4,12		;OR TERMINATE ON A <LF>
	SIN
	  ERJMP	[MOVEI	.AC1,.FHSLF
		 GETER		;get last error number
		 TLZ	.AC2,-1	;right half only
		 CAIN	.AC2,IOX4 ;end-of-file?
		 JRST	CKEOF	;yep
		 JRST	SYSFAT]	;not eof, then fatal
	AOS	LINCNT		;[54] increment line count
	AOS	TAGOFF		;[56] increment tag offset
	SETZ	CH,
	IDPB	CH,.AC2		;make line ASCIZ
	LDB	CH,[POINT 7,LINE,6] ;[50] look at 1st char
	CAIE	CH,11		;[50] tab?
	CAIN	CH," "		;[50] or space?
	SKIPA			;[50] yep, then left-justify
	JRST	GETLN0		;[50] otherwise skip
	MOVE	.AC1,[POINT 7,LINE] ;[50] start at beginning of line
	MOVEM	.AC1,.AC2	;[50] save current position
	ILDB	CH,.AC1		;[50] look at next char
	CAIE	CH,11		;[50] tab?
	CAIN	CH," "		;[50] or space?
	JRST	.-4		;[50] yep, then look further
;[56]	MOVE	.AC1,[POINT 7,LINE] ;[50] copy remainder to beginning of LINE
;[56]	PUSH	P,.AC3		;[50] save char count
;[56]	SETZ	.AC3,		;[50]
;[56]	SOUT%			;[50]
;[56]	IDPB	.AC3,.AC1	;[50] and make it still ASCIZ
;[56]	POP	P,.AC3		;[50] restore char count
	MOVE	.AC1,.AC2	;[56] get current line position
	MOVE	.AC2,[POINT 7,LINE] ;[56] get ptr to new position
	MOVEI	.AC3,MAXCHR+1	;[56] max # chars to move
	MOVEI	.AC4,12		;[56] terminate on <LF>
	SIN%			;[56] move it
	SETZ	CH,		;[56] make it ASCIZ
	IDPB	CH,.AC2		;[56]
GETLN0:	CALL	CHKEOL		;[34] check for continuation
	JUMPE	.AC3,LINTL	;IF REMAINING COUNT=0 THEN LINE TOO LONG
;[56]	TXNN	F,F%TAG		;processing a /TAG: switch?
;[56]	RETSKP			;nope, then done
	MOVE	P1,[POINT 7,LINE] ;point to input line
;[56]	MOVE	P2,[POINT 6,NEWTAG] ;point to test tag
	MOVE	P2,[POINT 6,.AC3] ;[56] pointer to place for test tag
	MOVEI	.AC1,6		;max length of tag
;[56]	SETZM	NEWTAG		;initialize test tag
	SETZ	.AC3,		;[56] init test tag to spaces
GETTAG:	ILDB	.AC2,P1		;get a char
	CAIN	.AC2,":"	;found end-of-tag?
	JRST	GETCOL		;yep
	CAIL	.AC2,"a"	;if lowercase
	CAILE	.AC2,"z"
	SKIPA
	SUBI	.AC2,"a"-"A"	;then raise to uppercase
	CAIGE	.AC2,"0"	;must be 0-9, A-Z
	RETSKP			;not a tag, so done right now
	CAILE	.AC2,"Z"
	RETSKP			;not a tag, so done right now
	CAILE	.AC2,"9"
	CAIL	.AC2,"A"
	SKIPA
	RETSKP			;not a tag, so done right now
	SUBI	.AC2,40		;convert to sixbit
	IDPB	.AC2,P2		;save this char in NEWTAG
	SOJG	.AC1,GETTAG
	ILDB	.AC2,P1		;if looked at 6 chars, then test delim
	CAIE	.AC2,":"	;if proper, then continue
	RETSKP			;tag can't be > 6 chars, so done
GETCOL:				;found the colon
	ILDB	.AC2,P1		;does another colon follow?
	CAIE	.AC2,":"
	RETSKP			;nope, then done
	TXNE	F,F%TAG		;[56] don't set flag if no /TAG: switch
	TXO	F,F%BTW		;assume "between tags" now
;[56]	MOVE	.AC1,NEWTAG
;[56]	CAME	.AC1,TAGNAM	;are we at the desired tag?
	MOVEM	.AC3,NEWTAG	;[56] save new tag name
	SETZM	TAGOFF		;[56] reset line offset
	TXNE	F,F%TAG		;[56] skip if no /TAG: switch given
	CAME	.AC3,TAGNAM	;[56] reached tag specified on /TAG:?
	RETSKP
	TXZ	F,F%BTW+F%TAG ;yep, then no more tag processing
	MOVE	P1,[POINT 7,LINE]
	CALL	WRTLIN	;write out tag line
	SETZM	LINE	;dummy input line
	CALL	INIIDN		;insert identification
	SKIPG	BEGJFN		;is there an INCLUDE/BEGIN file?
	RETSKP			;nope, then done now
	MOVE	.AC1,OUTJFN	;add pseudo-;Include command to CTL
	MOVEI	.AC2,CMDCHR	;preceeded by "; "
	BOUT
	  ERJMP	SYSFAT		;[36]
	HRROI	.AC2,[ASCIZ / Including /]
	SETZ	.AC3,
	SOUT
	  ERJMP	SYSFAT		;[36]
	MOVE	.AC2,BEGJFN	;get the jfn of the included file
	MOVX	.AC3,1B2+1B5+1B8+1B11+1B14+JS%PAF
	JFNS			;show entire filespec of file
	  ERJMP	SYSFAT		;[36]
	HRROI	.AC2,CRLF
	SETZ	.AC3,
	SOUT
	  ERJMP	SYSFAT		;[36]
	PUSH	P,INJFN		;save current input jfn
	EXCH	.AC3,BEGJFN	;get and reset included jfn
	MOVEM	.AC3,INJFN	;make it the primary input
	CALL	SETUP		;do the include
	MOVE	.AC1,INJFN
	CLOSF			;close it
	  CALL	SYSWRN
	POP	P,INJFN		;restore the primary input
	MOVE	P1,[POINT 7,[0]] ;fudge a nul line
	MOVEM	P1,SAVPNT
	RETSKP
; Check for line continuation syntax and read additional lines
;
;Accepts: AC2 = Byte ptr to next char of input buffer
;	  AC3 = count of chars remaining in input buffer
;Returns: same, with possible more chars in buffer

CHKEOL:				;[34] - entire routine
	LDB	CH,[POINT 7,LINE,6] ;look at first char of line
	CAIE	CH,CMDCHR	;is it a semi-colon?
	RET			;nope, then ignore the line
	MOVNI	.AC1,3		;backup byte ptr to last chr on line
	ADJBP	.AC1,.AC2
	LDB	CH,.AC1		;get the last char
	CAIE	CH,"-"		;is it hyphen?
	RET			;nope, then done
	TXO	F,F%CNT		;line is continued, so set flag
	MOVNI	.AC1,1		;backup buffer pointer
	ADJBP	.AC1,.AC2
	MOVEM	.AC1,.AC2
	MOVE	.AC1,INJFN	;get input jfn
	PUSH	P,.AC2		;save current buffer pointer
	BIN%			;[56] get next char of file
	  ERJMP	SYSFAT		;[56]
	CAIE	.AC2,11		;[56] is it TAB
	CAIN	.AC2," "	;[56] or space?
	JRST	.-4		;[56] yep, then throw it away
	MOVEM	.AC2,CH		;[56] save it
	MOVE	.AC2,(P)	;[56] restore previous line ptr
	IDPB	CH,.AC2		;[56] add this byte
	SOS	.AC3		;[56] reduce byte count
	SIN%			;read another line
	  ERJMP	SYSFAT		;all errors are fatal
	AOS	LINCNT		;[54] increment lines read
	SETZ	CH,		;make buffer ASCIZ again
	IDPB	CH,.AC2
	POP	P,.AC1		;restore pointer to beginning of line
	ILDB	CH,.AC1		;get first char
	CAIE	CH,CMDCHR	;is it the semi-colon?
	JRST	CNTNCC		;No Continuation Chars
	ILDB	CH,.AC1		;look at second char
	CAIE	CH,"+"		;is it the plus sign?
	JRST	CNTNCC		;nope
	JRST	CHKEOL		;check end of this line also
; Prompt for a YES or NO answer; checks first char of answer only
; Uses answ3 for tty input gives skip return if answer is yes.
;
; If F%YND is set, then answer may be defaulted by typing CR
; and value in SVALUE will be used.

Y.OR.N:
	ACCEPT	ANSW3,5,,RD%RAI	;get Yes or No
	  NOP			;IGNORE ERRORS (HOPEFULLY)
	TLNN	.AC2,(RD%BTM)	;WAS BREAK CHAR TYPED?
	  JRST	Y.5		;NO- GIVE MESSAGE
	LDB	CH,[POINT 7,ANSW3,6] ;GET FIRST CHAR.
	CAIN	CH,"Y"		;AFFIRMATIVE ?
	  RETSKP		;YES- GIVE SKIP RETURN
	CAIN	CH,"N"		;NEGATIVE ?
	  RET			;YES- GIVE REGULAR RETURN
	CAIE	CH,15		;defaulted?
	JRST	Y.3		;nope, then give message
	TXNN	F,F%YND		;is y/n defaulting allowed?
	JRST	Y.3		;nope, then give message
	TXO	F,F%DEF		;say default used
	SKIPE	SVALUE		;skip-return if val=yes
	JRST	[MOVEI	CH,"Y"	;set answer to YES
		 MOVE	.AC1,[ASCIZ /Y
/]
		 MOVEM	.AC1,ANSW3
		 RETSKP]
	MOVEI	CH,"N"		;value is no
	MOVE	.AC1,[ASCIZ /N
/]
	MOVEM	.AC1,ANSW3	;setup answ3 for /VERIFY
	RET
Y.3:	TYPE	[ASCIZ /Y or N only please
? /]
	JRST	Y.OR.N		;LOOP BACK TO GET ANOTHER ANSWER
Y.5:
	CALL	TYCRLF
	MOVEI	.AC1,.PRIIN	;SETUP TTY JFN
	CFIBF			;CLEAR ANY EXTRA GARBAGE
	JRST	Y.3		;GO GIVE MESSAGE
	SUBTTL	Linked-list search routine

;	Accepts: AC1 = address of start of list
;		 AC2 = byte pointer to ASCIZ item to be found
;		 AC3 = base address of list to which all pointers are relative
;
;	Returns: +1 Item not found: LSTPTR = address of item preceeding this one in list
;
;		 +2 Item found:     LSTPTR = adress of item in list

SRCHLL:
	PUSH	P,.AC1		;save current list pointer
	ADD	.AC1,.AC3	;make pointer absolute
	LOAD	.AC1,FWDPTR,(.AC1) ;get forward pointer
	SKIPG	.AC1		;end of list reached yet?
	JRST	SRCHL3		;yep
	MOVE	T1,.AC1		;get new pointer
	ADD	T1,.AC3		;make forward pointer absolute
	HLL	T1,[POINT 7,0,35] ;make it a byte pointer to item
	MOVEM	T1,LSTPTR	;save it
	MOVEM	.AC2,ITMPTR	;save byte pointer to search value
SRCHL1:	ILDB	T1,LSTPTR	;get a char of the list item
	ILDB	CH,ITMPTR	;and one from the value
	SKIPN	CH		;end of value?
	JRST	SRCHL2		;yep
	CAMN	T1,CH		;equal so far?
	JRST	SRCHL1		;yep
	CAIL	T1,"a"		;raise lowercase to uppercase if possible
	CAILE	T1,"z"
	SKIPA
	SUBI	T1,"a"-"A"
	CAIL	CH,"a"		;here too
	CAILE	CH,"z"
	SKIPA
	SUBI	CH,"a"-"A"
	CAMN	T1,CH		;equal now?
	JRST	SRCHL1		;yep
	CAML	T1,CH		;list item still less?
	JRST	SRCHL3		;nope
	POP	P,LSTPTR	;discard prior pointer
	JRST	SRCHLL		;and try next item
SRCHL2:	SKIPN	T1		;end of list item reached also?
	JRST	[POP	P,LSTPTR ;discard old forward pointer
		 JRST	SRCHL4]
SRCHL3:	SKIPE	.AC1,TRCJFN	;[54] get the trace jfn, skip if not defined
	CALL	TRCUDF		;[54] output an undefined message
	POP	P,LSTPTR	;restore old forward pointer
	RET
SRCHL4:	MOVEM	.AC1,LSTPTR	;update list pointer
	RETSKP			;give successful return
	SUBTTL	Output undefined reference to trace file - [54]

;	Accepts: AC1 = jfn of trace file
;		 AC2 = byte pointer to undefined option or variable
;
;	Returns: +1 always after writing message

TRCUDF:
	TXNE	F,P%NTR		;was No TRace set?
	RET			;yep, then don't show garbage
	PUSH	P,.AC2		;save name pointer
	CALL	LINOUT		;output current line number
	HRROI	.AC2,[ASCIZ /Undefined reference to /]
	SOUT%
	  ERJMP	SYSFAT
	POP	P,.AC2		;output name
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / :: /] ;output delimiter
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,LINE	;output current MCF line
	MOVEI	.AC3,MAXCHR	;maximum line length
	MOVEI	4,15		;output thru first <CR>
	SOUT%
	HRROI	.AC2,CRLF	;output a <CR><LF>
	SETZ	.AC3,
	SOUT%
	RET
	SUBTTL	Search linked list of empty cells

; Find an empty block to store a new variable/option name or a variable value
;
; Accepts:	AC1=Addr of start of list
;		AC2=#words needed
;
; Returns:	AC1=Addr of block
;		AC2 preserved

SRCHMT:
	MOVEM	.AC1,.AC4	;save current pointer
	LOAD	.AC1,FWDPTR,BINDEF(.AC1) ;get the address of the next block
	SKIPG	.AC1		;end of list?
	JRST	[MOVE	.AC1,BINDEF+.WRDCNT ;yep then put it at the end
;[35]		 ADDB	.AC2,BINDEF+.WRDCNT ;and increase word count
;[35]		 CAIL	.AC2,1K ;more than 512 words in .BIN file?
		 MOVEM	.AC2,.AC3 ;[35] get word count
		 ADDB	.AC3,BINDEF+.WRDCNT ;[35] compute # words in .BIN file
		 CAIL	.AC3,BINMAX*1K-1 ;[35] has .BIN file grown too large?
		 JRST	SAVFIL	;yep, then file too large
		 IDIVI	.AC3,1K+1 ;[35] compute # pages in .BIN file
		 CAMLE	.AC3,BINSIZ ;[35] less than or equal to current count?
		 JRST	SRCHM1	;[35] nope, then map another page
		 RET]
	LOAD	.AC3,VALLEN,BINDEF(.AC1) ;get length of block
	CAMLE	.AC2,.AC3	;will this answer fit here?
	JRST	SRCHMT		;nope, then try again
	CAME	.AC2,.AC3	;is there any extra left?
	JRST	[SUB	.AC3,.AC2 ;yep, then get #words remaining
		 STOR	.AC3,VALLEN,BINDEF(.AC1) ;update block length
		 ADD	.AC1,.AC3 ;and increment pointer
		 RET]
	LOAD	.AC3,FWDPTR,BINDEF(.AC1) ;get addr of next block
	STOR	.AC3,FWDPTR,BINDEF(.AC4) ;and update previous block
	RET
SRCHM1:	PUSH	P,.AC1		;[35] save list addr
	PUSH	P,.AC2		;[35] save word count
	MOVE	.AC1,.AC3	;[35] get file page
	MOVEM	.AC1,BINSIZ	;[35] save new page count
	HRL	.AC1,BINJFN	;[35] plus jfn
	ADDI	.AC2,BINDEF/1K	;[35] compute fork page
	TXO	.AC2,PM%RD+PM%WR ;[35] for read and write
	SETZ	.AC3,		;[35] map only one page
	PMAP%			;[35] map it
	POP	P,.AC2		;[35] restore word count
	POP	P,.AC1		;[35] restore list addr
	RET			;[35]
	SUBTTL	Get access to a linked list

; Accepts:	AC1=RH=addr of start of list, LH=0: read access, -1: write access
;
; Returns:	+1 always, access granted
; Uses:		AC1, AC2, AC3, AC4, left-half of list address as access flag

ACCESS:
	SKIPN	BINJFN		;has SETUP.BIN been mapped yet?
	CALL	ACCMAP		;nope, then map it now
	MOVEM	.AC1,.AC2	;move list addr to R2
	TLZ	.AC1,-1		;mask out left half
	CAIN	.AC1,.VARST	;access desired to variable list?
	JRST	[TXNE	F,F%VAC	;yep, then already accessing?
		 RET		;yep then do nothing
		 JRST	.+1]	;no, then continue
	CAIN	.AC1,.OPTST	;access desired to option list?
	JRST	[TXNE	F,F%OAC	;yep, then already accessing options?
		 RET		;yep then do nothing
		 JRST	.+1]	;no, then continue
	CAIN	.AC1,.EMPST	;access desired to empty-cell list?
	JRST	[TXNE	F,F%EAC	;yep, then already accessing list?
		 RET		;yep, then do nothing
		 JRST	.+1]	;no, then continue
	MOVEI	.AC1,MAXTRY
	MOVEM	.AC1,WAITRY	;set access trial count
	MOVEI	.AC1,.FHSLF	;[46] defer ^C interrupts
	DIR%			;[46]
	MOVEI	.AC1,1		;dismiss to get a whole time-slice
	DISMS
ACCES2:	SKIPGE	BINDEF(.AC2)	;does someone already have write access?
	JRST	ACCES4		;yep
	TLNE	.AC2,-1		;read or write access?
	JRST	ACCES3		;write
	HLRZ	.AC1,BINDEF(.AC2) ;get read count
	AOJ	.AC1,		;increment it
	HRLM	.AC1,BINDEF(.AC2) ;and store again
	JRST	ACCES5
ACCES3:	HLRZ	.AC1,BINDEF(.AC2) ;get read count
	SKIPE	.AC1		;=zero?
	JRST	ACCES4		;nope, then wait 'till it is
	MOVNI	.AC1,1
	HRLM	.AC1,BINDEF(.AC2) ;set write access
	JRST	ACCES5
ACCES4:	SOSG	WAITRY		;list in use, so try again later
	JRST	ACCNGR		;cannot grant access
	MOVEI	.AC1,WAITIM	;how much later?
	DISMS
	JRST	ACCES2		;try again!
ACCES5:	TLZ	.AC2,-1		;mask out left half of R2
	CAIN	.AC2,.VARST	;accessing variable list?
	TXO	F,F%VAC		;set flag
	CAIN	.AC2,.OPTST	;accessing option list?
	TXO	F,F%OAC		;set flag
	CAIN	.AC2,.EMPST	;accessing empty-cell list?
	TXO	F,F%EAC		;set flag
	RET
; Map SETUP.BIN for use by SRCHLL

ACCMAP:
	PUSH	P,.AC1
	MOVE	.AC1,[GJ%OLD+GJ%SHT]
	HRROI	.AC2,[ASCIZ /SETUP.BIN/]
	GTJFN
	  JRST	[SKIPE	BINJFN	;on error skip if not set already
		 JRST	BINUNC	;cannot create SETUP.BIN
		 SETOM	BINJFN	;avoid looping here!
		 MOVE	.AC1,[GJ%SHT]
		 JRST	.-2]
	MOVE	.AC2,[OF%RD+OF%WR+OF%THW]
	OPENF
	  JRST	BINOPN
	SKIPA			;[43] skip over alternate entry
ACCMP0:	PUSH	P,.AC1		;[43] save R1 at this entry too
	MOVEM	.AC1,.AC4	;save jfn here for a while
	HRLZ	.AC1,.AC1
	MOVE	.AC2,[.FHSLF,,BINDEF/1K]
	MOVE	.AC3,[PM%RD+PM%WR]
	PMAP
	MOVEI	.AC1,.EMPST+1	;#words min in SETUP.BIN
	EXCH	.AC4,BINJFN	;jfn=>binjfn,binjfn=>4
	SKIPE	.AC4		;do we need to initialize SETUP.BIN?
	MOVEM	.AC1,BINDEF	;yep
	MOVE	.AC1,BINDEF	;[35] get word count
	IDIVI	.AC1,1K+1	;[35] compute page count-1
	MOVEM	.AC1,BINSIZ	;[35] save the page count
	SKIPG	.AC1		;[35] skip if  more than 1 page
	JRST	ACCMP1		;[35] else done
	MOVEM	.AC1,.AC3	;[35] move page count remaining to AC3
	MOVEI	.AC1,1		;[35] start mapping w/page 1 now
	HRL	.AC1,BINJFN	;[35] get file jfn
	MOVE	.AC2,[.FHSLF,,<BINDEF/1K>+1] ;[35] map rest of pages after the first
	TXO	.AC3,PM%RD+PM%WR+PM%CNT ;[35]
	PMAP%			;[35] map the rest of the file
ACCMP1:				;[35]
	POP	P,.AC1		;restore list address
	RET
	SUBTTL	Clear access to a linked list

;Accepts:	AC1=RH=addr of start of list
;
;Returns:	+1 always, access grated
;
;Uses:		AC1, AC2
;		left-half of list address as accesss flag

CLRACS:
	MOVEI	.AC1,.VARST	;clear variable list access
	TXZE	F,F%VAC		;skip if not accessing it
	CALL	CLRAC1		;clear access
	MOVEI	.AC1,.OPTST	;clear option list access
	TXZE	F,F%OAC		;skip if not accessing it
	CALL	CLRAC1		;clear access
	MOVEI	.AC1,.EMPST	;clear empty-cell list access
	TXZE	F,F%EAC		;skip if not accessing it
	CALL	CLRAC1		;clear access
	MOVEI	.AC1,.FHSLF	;[46] enable ^C interrupts again
	EIR%			;[46]
	RET

CLRAC1:
	SKIPG	.AC2,BINDEF(.AC1) ;skip if read-only access
	JRST	[HRRZM	.AC2,BINDEF(.AC1) ;clear write access
		 RET]
	HLRZ	.AC2,BINDEF(.AC1) ;get read count
	SOJ	.AC2,		;decrement it
	HRLM	.AC2,BINDEF(.AC1) ;and store
	RET
	SUBTTL	LOGPRT - Print log of defined variables and options

LOGPRT:
	MOVE	.AC1,[.NULIO,,.NULIO] ;no jfns for GTJFN long form
	MOVEM	.AC1,GJFBLK+.GJSRC
	SETZM	GJFBLK+.GJGEN	;no special flags (create file if not there)
	HRROI	.AC1,[ASCIZ /SETUP/]
	MOVEM	.AC1,GJFBLK+.GJNAM ;default name is SETUP
	HRROI	.AC1,[ASCIZ /LOG/]
	MOVEM	.AC1,GJFBLK+.GJEXT ;default type is LOG
	MOVEI	.AC1,GJFBLK
	HRROI	.AC2,[ASCIZ /MCFLOG:/] ;look for logical device MCFLOG:
	GTJFN%			;is logical device defined?
	  RET			;nope, then just quit now
	MOVX	.AC2,7B5+OF%APP	;open for append
	OPENF%
	  CALLRET SYSWRN	;display error message
	MOVEI	.AC2,14		;output form-feed
	BOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,VER	;output SETUP version
	SETZ	.AC3,
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / input from /] ;nice words
	SOUT%
	  ERJMP	SYSFAT
	MOVE	.AC2,INJFN	;jfn of .MCF file
	MOVE	.AC3,[1B2+1B5+1B8+1B11+1B14+JS%PAF]
	JFNS%			;add full spec of .MCF file
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / on /]
	SETZ	.AC3,
	SOUT%
	  ERJMP	SYSFAT
	MOVE	.AC2,CURTIM	;get current time
	ODTIM%			;output it
	HRROI	.AC2,CRLF	;next line
	SOUT%
	  ERJMP	SYSFAT
	CALL	LOGVAR		;output variables
	CALL	LOGOPT		;output options
	RET			;all done!
;	Write all defined variables to log file - [54]

LOGVAR:
	HRROI	.AC2,[ASCIZ /
Defined Variables: 
/]
	SOUT%
	  ERJMP	SYSFAT
	SETZ	T1,		;start at beginning of list
LOGVR0:	LOAD	T1,FWDPTR,VARLST(T1) ;get pointer to next variable
	SKIPN	T1		;reached end of list?
	RET			;yep, then done
	MOVEI	.AC2,11
	BOUT%			;preceed w/tab
	  ERJMP	SYSFAT
	MOVEI	.AC2,VARLST+1(T1)
	HLL	.AC2,[POINT 7,0] ;make a byte pointer to the name
	MOVEI	.AC3,^D40	;max len of name = 40 chars
	SETZ	.AC4,		;terminated w/NUL
	SOUT%			;output name
	  ERJMP	SYSFAT
	IDIVI	.AC3,10		;compute # TABs needed
	MOVN	.AC3,.AC3	;output exactly this many tabs
	SOS	.AC3		;plus one
	HRROI	.AC2,[BYTE (7)11,11,11,11,11]
	SOUT%			;output the separator
	  ERJMP	SYSFAT
	MOVEI	.AC2,42		;plus a leading quote
	BOUT%
	  ERJMP	SYSFAT
	LOAD	.AC2,VALLOC,VARLST(T1) ;get list pointer to value
	ADDI	.AC2,VARLST
	HLL	.AC2,[POINT 7,0] ;make a byte pointer to the value
	SETZ	.AC3,
	SOUT%			;output value
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ /"
/]				;followed by <CR><LF>
	SOUT%
	  ERJMP	SYSFAT
	JRST	LOGVR0
;	Write defined options to MCFLOG: - [54]

LOGOPT:
	HRROI	.AC2,[ASCIZ /
Defined Options:
/]
	SOUT%
	  ERJMP	SYSFAT
	SETZ	T1,		;start at beginning of list
LOGOP0:	LOAD	T1,FWDPTR,OPTLST(T1) ;get next pointer
	SKIPN	T1		;at end of list?
	RET			;yep, then done
	MOVEI	.AC2,11
	BOUT%			;preceed w/tab
	  ERJMP	SYSFAT
	MOVEI	.AC2,OPTLST+1(T1)
	HLL	.AC2,[POINT 7,0] ;make a byte pointer to option name
	MOVEI	.AC3,^D40	;max len of name = 40 bytes
	SETZ	.AC4,		;terminated w/NUL
	SOUT%
	  ERJMP	SYSFAT
	IDIVI	.AC3,10		;compute # tabs needed
	AOS	.AC3		;plus one more
	MOVN	.AC3,.AC3	;output exactly this many
	HRROI	.AC2,[BYTE (7)11,11,11,11,11]
	SOUT%
	  ERJMP	SYSFAT
	LOAD	T2,VALLOC,OPTLST(T1)
	HRROI	.AC2,[ASCIZ /No
/]
	SKIPE	T2		;is value NO?
	HRROI	.AC2,[ASCIZ /Yes
/]
	SETZ	.AC3,
	SOUT%
	  ERJMP	SYSFAT
	JRST	LOGOP0
	SUBTTL	Initialization

INIT:				;returns +1 always
	RESET
	CALL	CCTRAP		;[46] turn on control-C trapping
	CALL	ENABLE		;CLEAR CONTROL/O
	TYPE	VER
	CALL	INIMEM		;initialize memory
	CALL	PARSER		;parse the EXEC command
	CALL	INIFIL		;initialize MCF and CTL files
	TXNN	F,F%FAT		;skip if found a fatal error
	CALL	INIVAR		;initialize pre-defined constants
	CALL	CLRTTY		;blank terminal screen if possible
	CALL	TRCOPN		;[54] open trace file if it exists
	TRZ	F,-1		;clear flags
	RET
;	CCTRAP - Enable for control-C trapping


CCTRAP:				;[46] - entire routine
	MOVEI	.AC1,.FHSLF	;this process
	RPCAP%			;get capabilities
	OR	.AC3,[SC%CTC]	;enable control-C trapping
	EPCAP%
	HRLZI	.AC1,.TICCC	;assign to channel 0
	ATI%
	  ERJMP	[MOVEI	.AC1,.FHSLF ;get error code
		 GETER%
		 TLZ	.AC2,-1	;mask code only
		 CAIN	.AC2,ATIX2 ;do we need ^C capability?
		 RET		;yep, then just forget it
		 JRST	SYSWRN]	;else give warning
	MOVEI	.AC1,.FHSLF
	MOVE	.AC2,[LEVTAB,,CHNTAB]
	SIR%			;set interrupt table addresses
	MOVX	.AC2,1B0+1B9	;activate channels 0 and 9
	AIC%
	EIR%			;enable interrupts
	RET

CNTRLC:				;[46] - come here on control-C
	TXZE	F,F%DCC		;was Double Control-C set by .CONTI?
	DEBRK%			;yep, then just continue now
	PUSH	P,.AC1		;save all regs used by COMND
	PUSH	P,.AC2
	PUSH	P,.AC3
	CALL	ENABLE		;else clear ^O
	MOVE	.AC1,CMBLK1+.CMBFP ;get line buffer pointer
	MOVEM	.AC1,CMBLK1+.CMPTR ;and copy to current buffer pointer
	MOVEI	.AC1,50		;reset buffer size
	MOVEM	.AC1,CMBLK1+.CMCNT
CTRLC1:	MOVEI	.AC1,CMBLK1	;COMND state block for interrupt handler
	MOVEI	.AC2,[FLDDB. .CMINI] ;init COMND
	COMND%
CTRLC2:	MOVEI	.AC1,CMBLK1	;re-parse address
	MOVEI	.AC2,[FLDDB. .CMKEY,CM%SDH,[XWD  2,2
					    ITEM ABORT,.ABORT
					    ITEM CONTINUE,.CONTI],<

Type	ABORT - abort SETUP, deleting .CTL file
or	CONTINUE - continue normally, ignoring control-C

>]
	COMND%			;get a keyword
	TXNE	.AC1,CM%NOP	;unable to parse?
	JRST	[CALL	TYCRLF	;nope, then give msg & try again
		 TMSG	(?Invalid option - please reenter)
		 JRST	CTRLC1]
	HRRZ	.AC2,(.AC2)	;get handler address
	PUSH	P,.AC2		;and save it
	MOVEI	.AC2,[FLDDB. .CMCFM] ;confirm it
	COMND%
	TXNE	.AC1,CM%NOP	;not confirmed?
	JRST	[CALL	TYCRLF
		 TMSG	(?Not confirmed - please reenter)
		 POP	P,.AC1	;throw away handler address
		 JRST	CTRLC1]	;try again
	POP	P,.AC1		;restore handler address
	POP	P,.AC3		;restore R3 now
	JRST	(.AC1)		;go to it!

.ABORT:				;[46] - abort after ^C
	TMSG	(?Setup aborted via ^C)
	POP	P,.AC2		;restore R1 & R2 now
	POP	P,.AC1
	JRST	CMQT1		;and go cleanup

.CONTI:				;[46] - continue after (ignore) ^C
	MOVEI	.AC1,.FHSLF	;read my waiting channel word
	RWM%
	TXNE	.AC1,1B0	;is there another ^C next?
	TXO	F,F%DCC		;yep, then set Double Control-C flag
	POP	P,.AC2		;restore R1 & R2 now
	POP	P,.AC1
	DEBRK%			;done w/ this interrupt
; Initialize memory
;
; Returns +1 always

INIMEM:
	CALL	TYCRLF
	SETZ	.AC1,
	RSCAN			;make EXEC command line available to COMND
	  JFCL			;don't expect errors
	SETZM	FSTMEM		;CLEAR STORAGE
	MOVE	T1,[FSTMEM,,FSTMEM+1]
	BLT	T1,LSTMEM
	MOVE	.AC1,[XWD	.PRIIN,.PRIOU]
	MOVEM	.AC1,CMBLOK+.CMIOJ ;setup COMND jfns
	HRROI	.AC1,[0]	;no prompt for now
	MOVEM	.AC1,CMBLOK+.CMRTY
	HRROI	.AC1,LINE
	MOVEM	.AC1,CMBLOK+.CMBFP ;COMND buffer pointer
	MOVEM	.AC1,CMBLOK+.CMPTR ;next input to be parsed
	MOVEI	.AC1,MAXCHR
	MOVEM	.AC1,CMBLOK+.CMCNT ;size of input buffer
	MOVEI	.AC1,1
	MOVEM	.AC1,VAREND	;initialize variable/constant list
	MOVEM	.AC1,OPTEND	;initialize option list
	RET
; Parse the command line
;
; Returns +1 always

PARSER:
	PARSE	.CMINI		;initialize COMND
	  JFCL
REPARS:	PARSE	.CMKEY,,[XWD	1,1
			 ITEM	SETUP,0]
	  JRST	INIERR		;couldn't parse this
	PARSE	.CMFIL,,,,,SWTCH2 ;get MCF file or switch
	  JRST	[PARSE	.CMCFM	;no file name, then try crlf
		   JRST	INIMCF	;not crlf, then bad MCF file
		 HRROI	.AC1,[ASCIZ /SETUP>/]
		 MOVEM	.AC1,CMBLOK+.CMRTY ;new prompt char
		 JRST	PARSER]	;try again
	TLZ	.AC3,-1
	CAIN	.AC3,SWTCH2	;got a switch instead of a file?
	JRST	[HRRZ	.AC1,(.AC2) ;yep, then do the switch instead
		 CALL	(.AC1)	;execute the appropriate switch
		 JRST	CMQT1]	;and quit
	SETZM	ANSW2		;no job-id for now
	MOVEM	.AC2,INJFN	;save the jfn
PARSE2:	PARSE	.CMCFM,,,,,SWTCH1
	  JRST	INICFM		;not confirmed or invalid switch
	TLZ	.AC3,-1
	CAIE	.AC3,SWTCH1	;saw a switch?
	RET
	HRRZ	.AC2,(.AC2)	;address of handler
	CALL	(.AC2)		;go do it
	JRST	PARSE2
; Initialize MCF and CTL files
;
; Returns +1 always

INIFIL:
	MOVE	.AC1,INJFN	;get input jfn
	MOVE	.AC2,[7B5+OF%HER+OF%RD]
	OPENF			;BYTE SIZE=7,HALT ON ERROR,READ ACCESS
	  JRST	SYSFAT

	;**** NOW GET CTL FILE ALL SETUP ****
	HRROI	.AC1,ANSW1	;DESTINATION POINTER
	MOVE	.AC2,INJFN
	MOVE	.AC3,[1B^D8+JS%PAF] ;OUTPUT FILENAME WITH PUNCTUATION
	JFNS
	SKIPE	ANSW2		;any job-id?
	JRST	[MOVEI	.AC2,"-" ;yep, then append it
		 IDPB	.AC2,.AC1
		 HRROI	.AC2,ANSW2	
		 SETZB	.AC3,4	;whole string
		 SOUT
		 JRST	.+1]
;[41]
	MOVEI	.AC4,5		;APPEND ".CTL" TO FILE NAME
	MOVE	.AC3,[POINT 7,[ASCIZ /.CTL/]]
INIT4:	ILDB	.AC2,.AC3	;DO IT
	IDPB	.AC2,.AC1
	SOJG	.AC4,INIT4
	HRLZI	.AC1,(GJ%FOU+GJ%SHT) ;SET NEXT GENER., SHORT FORM
	HRROI	.AC2,ANSW1	;SETUP POINTER TO FILE ASCIZ STRING
	GTJFN			;GET CTL JFN
	  JRST	SYSFAT
	HRRZM	.AC1,OUTJFN	;SAVE CTL JFN
	MOVEI	.AC2,0		;save no previous generations
	DELNF			;delete the .CTL file
	  CALL	SYSWRN		;error occurred
	TXNE	F,F%FAT		;did we have a fatal error?
	JRST	[RLJFN%		;yep, then release output jfn
		   CALL	SYSWRN
		 SETZM	OUTJFN	;no output jfn now
		 RET]
	HRRZS	.AC1		;CLEAR LEFT HALF FOR OPEN
	MOVE	.AC2,[7B5+OF%HER+OF%WR]
	OPENF			;BYTE SIZE=7,HALT ON ERROR,WRITE ACCESS
	  JRST	SYSFAT
	RET
; Initialize pre-defined variables
;
; Returns +1 always

INIVAR:
	CALL	INIIDN		;insert identification
	SKIPN	ANSW2		;any job-id?
	JRST	[DMOVE	.AC1,[ASCIZ /<Job-Id>/]	;nope, then define a nul value
		 DMOVEM	.AC1,ANSW1
		 SETZM	ANSW2
		 MOVEI	.AC1,1
		 MOVEM	.AC1,ITMLEN
		 CALL	DEFSTO	;store the nul value
		   NOP		;don't expect any errors
		 JRST	.+1]
	DMOVE	.AC1,[ASCII /<Job-Name>/] ;setup constant name
	DMOVEM	.AC1,ANSW1
	SETZM	ANSW1+2		;has to be ASCIZ
	HRROI	.AC1,ANSW2	;put constant value here
	MOVE	.AC2,INJFN
	MOVE	.AC3,[JS%NAM]
	JFNS			;get only name of MCF
	MOVE	P1,[POINT 7,ANSW2]
	SETZ	.AC1,
	ILDB	CH,P1		;count #chars in value
	SKIPE	CH		;found end yet?
	AOJA	.AC1,.-2
	ADDI	.AC1,5		;round up+1 for nul
	IDIVI	.AC1,5		;# words
	MOVEM	.AC1,ITMLEN
	TRZ	F,-1
	CALL	DEFSTO		;do a ;Define constant <job-name>
	  NOP			;don't expect any errors
	MOVNI	.AC2,1		;get current date
	SETZ	.AC4,		;no special flags
	ODCNV
	PUSH	P,.AC3		;save day of month
	PUSH	P,.AC2		;save month
	HLRZ	.AC1,.AC2	;get year
	IDIVI	.AC1,^D100	;right two digits only
	HRROI	.AC1,ANSW2	;convert to ascii here
	MOVX	.AC3,NO%LFL+NO%ZRO+2B17+12
	NOUT
	  CALL	SYSWRN
	HRROI	.AC1,ANSW1	;setup name of this constant
	HRROI	.AC2,[ASCIZ /<Current-Year>/]
	SETZB	.AC3,.AC4
	SOUT
	MOVEI	.AC1,1		;value is one word long
	MOVEM	.AC1,ITMLEN
	CALL	DEFSTO		;store the constant in the table
	  NOP
	POP	P,.AC2		;get month
	TLZ	.AC2,-1		;right half only
	PUSH	P,.AC2		;[55] now save it again
	AOJ	.AC2,		;jan=0, so make it 1
	HRROI	1,ANSW2		;convert to ascii here
	MOVX	.AC3,NO%LFL+NO%ZRO+2B17+12
	NOUT
	  CALL	SYSWRN
	HRROI	.AC1,ANSW1	;name of constant goes here
	HRROI	.AC2,[ASCIZ /<Current-Month>/]
	SETZB	.AC3,.AC4
	SOUT
	CALL	DEFSTO		;store this constant also
	  NOP
	POP	P,.AC2		;[55] restore month again
	MOVE	.AC2,MTHNAM(.AC2) ;[55] get byte ptr to proper month name
	HRROI	.AC1,ANSW2	;[55] copy to here
	SETZ	.AC3,		;[55]
	SOUT%			;[55]
	HRROI	.AC1,ANSW1	;[55]
	HRROI	.AC2,[ASCIZ /<Current-Month-Name>/] ;[55]
	SOUT%			;[55] set constant name
	CALL	DEFSTO		;[55] store this one
	  NOP			;[55]
	HLRZ	.AC2,(P)	;get day of month from left half
	AOJ	.AC2,		;add 1 so 1st of month=1
	HRROI	.AC1,ANSW2	;value goes here
	MOVX	.AC3,NO%LFL+NO%ZRO+2B17+12
	NOUT
	  CALL	SYSWRN
	HRROI	.AC1,ANSW1	;name of next constant
	HRROI	.AC2,[ASCIZ /<Current-Day>/]
	SETZB	.AC3,.AC4
	SOUT
	CALL	DEFSTO		;store this one too
	  NOP
	MOVNI	.AC2,1		;get current date
	MOVX	.AC4,IC%JUD	;in julian format
	ODCNV
	TLZ	.AC2,-1		;right half only
	HRROI	.AC1,ANSW2	;convert to ascii here
	MOVX	.AC3,NO%LFL+NO%ZRO+3B17+12
	NOUT
	  CALL	SYSWRN
	HRROI	.AC1,ANSW1	;name of constant goes here
	HRROI	.AC2,[ASCIZ /<Julian-Date>/]
	SETZB	.AC3,.AC4
	SOUT			;setup name of <julian-date>
	CALL	DEFSTO		;store it too
	  NOP
	POP	P,.AC1		;restore day of week
	TLZ	.AC1,-1		;right half only
	MOVE	.AC2,WKDPTR(.AC1) ;get byte pointer to weekday
	HRROI	.AC1,ANSW1	;move day name to here
	SETZB	.AC3,.AC4
	SOUT
	SETOM	SVALUE		;option value yes
	CALL	SELSTO		;store this option
	  NOP
	GJINF%			;[45] get user number
	MOVEM	.AC1,.AC2	;[45] copy to R2
	HRROI	.AC1,ANSW2	;[45] convert to user name
	DIRST%			;[45]
	  SETZM	ANSW2		;[45] use nul string on error
	HRROI	.AC1,ANSW1	;[45] variable name
	HRROI	.AC2,[ASCIZ /<Current-User-Name>/] ;[45] is this
	SETZB	.AC3,.AC4	;[45]
	SOUT%			;[45]
	CALL	DEFSTO		;[45]
	  NOP			;[45]
	HRROI	.AC1,ANSW2	;[53] output hour and minutes
	MOVNI	.AC2,1		;[53] from current time
	MOVX	.AC3,OT%NDA+OT%NSC+OT%NCO ;[53]
	ODTIM%			;[53]
	MOVNI	.AC2,1		;[53] backup to 1st digit of minutes
	ADJBP	.AC2,.AC1	;[53]
	SETZ	.AC1,		;[53]
	DPB	.AC1,.AC2	;[53] and delete minutes
	HRROI	.AC1,ANSW1	;[53]
	HRROI	.AC2,[ASCIZ /<Current-Hour>/] ;[53] define constant name
	SETZB	.AC3,.AC4	;[53]
	SOUT%			;[53]
	CALL	DEFSTO		;[53] store this constant
	  NOP			;[53]
	RET
; Open the trace file if logical name MCFTRACE: is defined - [54]

TRCOPN:
	GTAD%			;get current date and time
	MOVEM	.AC1,CURTIM	;and save it
	MOVE	.AC1,[.NULIO,,.NULIO] ;no jfns for GTJFN long form
	MOVEM	.AC1,GJFBLK+.GJSRC
	SETZM	GJFBLK+.GJGEN	;no special flags (create file if not there)
	HRROI	.AC1,[ASCIZ /SETUP/]
	MOVEM	.AC1,GJFBLK+.GJNAM ;default name is SETUP
	HRROI	.AC1,[ASCIZ /TRACE/]
	MOVEM	.AC1,GJFBLK+.GJEXT ;default type is TRACE
	MOVEI	.AC1,GJFBLK
	HRROI	.AC2,[ASCIZ /MCFTRACE:/] ;look for logical device MCFTRACE:
	GTJFN%			;is logical device defined?
	  RET			;nope, then just quit now
	MOVX	.AC2,7B5+OF%APP	;open for append
	OPENF%
	  CALLRET SYSWRN	;display error message
	MOVEM	.AC1,TRCJFN	;now save trace jfn
	MOVEI	.AC2,14		;output form-feed
	BOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,VER	;output SETUP version
	SETZ	.AC3,
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / input from /] ;nice words
	SOUT%
	  ERJMP	SYSFAT
	MOVE	.AC2,INJFN	;jfn of .MCF file
	MOVE	.AC3,[1B2+1B5+1B8+1B11+1B14+JS%PAF]
	JFNS%			;add full spec of .MCF file
	  ERJMP	SYSFAT
	HRROI	.AC2,[ASCIZ / on /]
	SETZ	.AC3,		;[56] ASCIZ string
	SOUT%
	  ERJMP	SYSFAT
	MOVE	.AC2,CURTIM	;get current time
	ODTIM%			;output it
	HRROI	.AC2,CRLF	;next line
	SOUT%
	  ERJMP	SYSFAT
	HRROI	.AC2,CRLF	;blank line
	SOUT%
	  ERJMP	SYSFAT
	RET
SWDEL:				;SETUP/DELETE OPTION!VARIABLE <name>
	MOVE	P1,[POINT 7,ANSW1] ;assemble name here
	SETZM	ATMBUF		;initizlize in case of un-parseable name
	PARSE	.CMKEY,,[XWD  2,2
			 ITEM OPTION,.OPTST
			 ITEM VARIABLE,.VARST]
	  JRST	INIIDO		;invalid /DELETE option
	HRR	P2,(.AC2)	;get list address
	CALL	PRSOPT		;parse an option name
	  JRST	ININAM		;invalid variable!option name
	PARSE	.CMCFM		;confirm it
	  JRST	INICFM		;not confirmed
	MOVEI	.AC1,GETVAR	;[57] read the existing value (if any)
	CAIE	P2,.VARST	;[57]
	MOVEI	.AC1,GETOPT	;[57]
	CALL	(.AC1)		;[57] now contained in SVALUE
	MOVE	.AC1,P2		;get access to list
	CALL	ACCESS
	MOVE	.AC1,P2		;get list pointer
	MOVE	.AC2,[POINT 7,ANSW1] ;find this name in list
	MOVEI	.AC3,BINDEF	;start here
	CALL	SRCHLL		;find name in list
	  JRST	ININDV		;no default value
	MOVE	.AC1,LSTPTR
	LOAD	.AC4,FWDPTR,BINDEF(.AC1) ;get forward pointer
	MOVE	.AC1,P2		;get list address again
	LOAD	.AC2,FWDPTR,BINDEF(.AC1) ;get next fwd pointer
	CAME	.AC2,LSTPTR	;found this item yet?
	JRST	[MOVEM	.AC2,.AC1 ;nope, then look some more
		 JRST	.-2]
	STOR	.AC4,FWDPTR,BINDEF(.AC1) ;update it's fwd pointer
	SETZ	.AC2,		;count of chars in name
	MOVE	P1,LSTPTR	;get list pointer
	ADDI	P1,BINDEF	;make it absolute
	HLL	P1,[POINT 7,0,35] ;make it a byte pointer to the name
	ILDB	CH,P1		;get a char
	SKIPE	CH		;reached end of name yet?
	AOJA	.AC2,.-2	;nope, loop 'till NUL
	ADDI	.AC2,5		;round up + NUL
	IDIVI	.AC2,5		;convert to words
	AOJ	.AC2,		;plus one for header
	MOVE	.AC1,LSTPTR	;item pointer
	LOAD	T1,VALLEN,BINDEF(.AC1) ;save value length in case
	PUSH	P,T1		; on the stack
	CALL	STOEMP		;store this empty-cell
	POP	P,.AC2		;[40] restore length of block
	CAIN	P2,.VARST	;deleting a variable?
	JRST	[LOAD	.AC1,VALLOC,BINDEF(.AC1) ;get value pointer
;[40]		 POP	P,.AC2	;restore length of block
		 CALL	STOEMP	;store this empty-cell also
		 JRST	.+1]
	CALL	CLRACS		;clear list access
	HRROI	.AC1,[ASCIZ /[Option /]	;[43] type a confirmation message
	CAIN	P2,.VARST	;[43] really deleted a variable?
	HRROI	.AC1,[ASCIZ /[Variable /] ;[43] yep, then say so
	PSOUT%			;[43]
	HRROI	.AC1,ANSW1	;[43] show name
	PSOUT%			;[43]
;[57]	TMSG	( deleted])	;[43]
	TMSG	( deleted; value was ) ;[57]
	CAIN	P2,.VARST	;[57] variable or option?
	JRST	[		;[57] show variable value
		TMSG	(")	;[57] enclosed in quotes
		HRROI	.AC1,SVALUE ;[57]
		PSOUT%		;[57]
		TMSG	("])	;[57]
		RET]		;[57]
	HRROI	.AC1,[ASCIZ /No/] ;[57] show option value
	SKIPE	SVALUE		;[57]
	HRROI	.AC1,[ASCIZ /Yes/] ;[57]
	PSOUT%			;[57]
	TMSG	(])		;[57]
	RET
; Parse an option name since options may look like "(foo)" or "<foo>"

; Accepts:	P1 is a byte pointer to a place to put the parsed name
;
; Return+1:	No valid option name
; Return+2:	Option name is in place pointed to by P1

PRSOPT:
	PARSE	.CMFLD,CM%SDH,,<name>
	  RET			;invalid name
	SKIPN	ATMBUF		;saw a name?
	JRST	[ILDB	CH,CMBLOK+.CMPTR ;get the char COMND wasn't able to parse
		 CAIN	CH,15	;end of line?
		 RET		;yep, then return+1
		 CAIN	CH,12
		 RET
		 IDPB	CH,P1	;put it into ANSW1
		 SOS	CMBLOK+.CMINC ;decrement COMND state block for monitor
		 JRST	PRSOPT]
	MOVE	.AC1,P1
	HRROI	.AC2,ATMBUF
	SETZB	.AC3,.AC4
	SOUT			;move option name to ANSW1
PRSOP1:	SKIPN	CMBLOK+.CMINC	;any more characters input?
	JRST	PRSOP2		;nope
	ILDB	CH,CMBLOK+.CMPTR ;get char that terminated COMND
	CAIN	CH," "		;terminated by space
	JRST	PRSOP2
	CAIN	CH,15		;or end of line?
	JRST	PRSOP2
	CAIN	CH,12
	JRST	PRSOP2
	CAIE	CH,11		;or tab?
	JRST	[IDPB	CH,.AC1	;nope, then a part of the name
		 SOS	CMBLOK+.CMINC ;one less char for COMND to parse
		 JRST	PRSOP1]	;look some more
PRSOP2:	SETZ	CH,		;make name ASCIZ
	IDPB	CH,.AC1
	MOVNI	.AC1,1
	ADJBP	.AC1,CMBLOK+.CMPTR ;backup COMND pointer
	MOVEM	.AC1,CMBLOK+.CMPTR
	RETSKP
; SETUP/LIST routine

SWLST:				;SETUP/LIST [ALL!EMPTY!OPTIONS!VARIABLES]
	PARSE	.CMKEY,,[XWD  4,4
			 ITEM ALL,17
			 ITEM EMPTY,1
			 ITEM OPTIONS,2
			 ITEM VARIABLES,4],,<ALL>
	  JRST	INIIVL
	HRR	F,(.AC2)	;get flags
	PARSE	.CMCFM
	  JRST	INICFM
	TRNN	F,4		;list variables?
	JRST	SWLST1		;nope
	HRROI	.AC1,[ASCIZ /Variables:
/]
	TRNE	F,10		;don't print heading if not ALL
	PSOUT
	CALL	LSTVAR		;list all variables
SWLST1:	TRNN	F,2		;list options?
	JRST	SWLST2		;nope
	HRROI	.AC1,[ASCIZ /Options:
/]
	TRNE	F,10		;don't print heading if not ALL
	PSOUT
	CALL	LSTOPT		;list all options
SWLST2:	TRNE	F,1		;list empty cells?
	CALL	LSTEMP		;yep
	RET
; Called by SWLST to list all variables in SETUP.BIN

LSTVAR:
	MOVEI	.AC1,.VARST	;get access to variables list
	CALL	ACCESS
	MOVEI	.AC2,.VARST
LSTV1:	LOAD	.AC2,FWDPTR,BINDEF(.AC2) ;get pointer to next variable
	SKIPN	.AC2		;reached end of list?
	JRST	[CALL	CLRACS	;yep, then clear access
		 RET]		;and return
	MOVEI	.AC1,11
	TRNE	F,10		;listing ALL?
	PBOUT			;yep, then preceed w/tab
	MOVEI	.AC1,BINDEF+1(.AC2)
	HLL	.AC1,[POINT 7,0] ;make a byte pointer to the name
	PSOUT			;output name
	MOVEI	.AC1,"="
	PBOUT			;output the separator
	LOAD	.AC1,VALLOC,BINDEF(.AC2) ;get list pointer to value
	ADDI	.AC1,BINDEF
	HLL	.AC1,[POINT 7,0] ;make a byte pointer to the value
	PSOUT			;output value
	HRROI	.AC1,CRLF	;followed by CRLF
	PSOUT
	JRST	LSTV1
; Called by SWLST to list all options in SETUP.BIN

LSTOPT:
	MOVEI	.AC1,.OPTST
	CALL	ACCESS		;get access to options list
	MOVEI	.AC2,.OPTST
LSTO1:	LOAD	.AC2,FWDPTR,BINDEF(.AC2) ;get next pointer
	SKIPN	.AC2		;at end of list?
	JRST	[CALL	CLRACS	;clear access to list
		 RET]		;and return
	MOVEI	.AC1,11
	TRNE	F,10
	PBOUT			;preceed w/tab if ALL mode
	MOVEI	.AC1,BINDEF+1(.AC2)
	HLL	.AC1,[POINT 7,0] ;make a byte pointer to option name
	PSOUT
	MOVEI	.AC1,"="
	PBOUT
	LOAD	.AC3,VALLOC,BINDEF(.AC2)
	HRROI	.AC1,[ASCIZ /No
/]
	SKIPE	.AC3		;is value NO?
	HRROI	.AC1,[ASCIZ /Yes
/]
	PSOUT
	JRST	LSTO1
; Called by SWLST to count and list # of empty words

LSTEMP:
	MOVEI	.AC1,.EMPST
	CALL	ACCESS		;get access to empty cell list
	MOVEI	.AC1,.EMPST
	SETZ	.AC2,		;count of empty cells
LSTE1:	LOAD	.AC1,FWDPTR,BINDEF(.AC1)
	SKIPN	.AC1		;reached end of list?
	JRST	LSTE2		;yep, then print count
	LOAD	.AC3,VALLEN,BINDEF(.AC1) ;get block length
	ADD	.AC2,.AC3	;accumulate lengths
	JRST	LSTE1
LSTE2:	SKIPG	.AC2		;any empty cells?
	JRST	[TMSG	(No empty words)
		 JRST	LSTE3]
	MOVEI	.AC1,.PRIOU
	MOVEI	.AC3,12		;output in decimal
	NOUT
	  CALL	SYSWRN
	TMSG	( empty word)
	MOVEI	.AC1,"s"
	CAILE	.AC2,1		;be clever on plurals
	PBOUT
LSTE3:	CALL	CLRACS		;clear list access
	TMSG	( out of )
	MOVEI	.AC1,.PRIOU
	MOVE	.AC2,BINDEF	;type word count also
	MOVEI	.AC3,12
	NOUT
	  CALL	SYSWRN
	RET
; SETUP/OPTION routine; defines an option and stores it in SETUP.BIN

SWOPT:				;SETUP/OPTION <option-name> YES!NO
	MOVE	P1,[POINT 7,ANSW1] ;setup pointer in case of non-parseable name
	SETZM	ATMBUF		;initialze in case of bad name
	CALL	PRSOPT		;parse an option name
	  JRST	ININAM		;invalid option name
	PARSE	.CMKEY,CM%SDH,[XWD  2,2
			       ITEM NO,0
			       ITEM YES,1],<YES or NO>
	  JRST	INIIVO
	HRRZ	.AC4,(.AC2)	;get option value
	SKIPE	.AC4
	MOVNI	.AC4,1		;extend sign
	MOVEM	.AC4,SVALUE
	PARSE	.CMCFM
	  JRST	INICFM
	PUSH	P,SVALUE	;[57] save new value
	CALL	GETOPT		;[57] and try to retrieve current value
	MOVE	.AC1,SVALUE	;[57] get old value
	EXCH	.AC1,(P)	;[57] exchange with new value
	MOVEM	.AC1,SVALUE	;[57]
	CALL	SELSAV		;store it
	TMSG	([Option )	;[43] show option name and value
	HRROI	.AC1,ANSW1	;[43]
	PSOUT%			;[43]
;[57]	TMSG	( defined as )	;[43]
	POP	P,.AC2		;[57] retrieve old value
	TXNE	F,F%SHW		;[57] was there actually one?
	JRST	[		;[57] yep, then show it
		TMSG	( changed from ) ;[57]
		HRROI	.AC1,[ASCIZ /No/] ;[57]
		SKIPE	.AC2	;[57]
		HRROI	.AC1,[ASCIZ /Yes/] ;[57]
		PSOUT%		;[57]
		TMSG	( to )	;[57]
		JRST	.+2]	;[57]
	JRST	[		;[57] else just define it
		TMSG	( defined as ) ;[57]
		JRST	.+1]	;[57]
	HRROI	.AC1,[ASCIZ /No/] ;[43] assume no
	SKIPE	SVALUE		;[43] really yes?
	HRROI	.AC1,[ASCIZ /Yes/] ;[43] yep, then say so
	PSOUT%			;[43]
	TMSG	(])		;[43]
	RET
; SETUP/RESET (DEFAULT FILE INTERLOCKS)

SWREST:
	PARSE	.CMNOI,,<POINT 7,[ASCIZ /DEFAULT FILE INTERLOCKS/]>
	  NOP
	PARSE	.CMCFM
	  JRST	INICFM
	MOVE	.AC1,[GJ%OLD+GJ%SHT] ;[43]
	HRROI	.AC2,[ASCIZ /SETUP.BIN/] ;[43] find default file
	GTJFN%			;[43]
	  JRST	[CALL	TYCRLF	;[43] couldn't find it
		 TMSG	([No SETUP.BIN file in your connected directory]) ;[43]
		 RET]		;[43]
	MOVX	.AC2,OF%RD+OF%WR+OF%RTD ;[43] want to be the only user
	OPENF%			;[43]
	  JRST	[CALL	TYCRLF	;[43] unable to open it
		 TMSG	(?Unable to open SETUP.BIN - possibly in use by another job) ;[43] 
		 RET]		;[43]
	CALL	ACCMP0		;[43] map SETUP.BIN file
	SETZ	.AC1,
	HRLM	.AC1,BINDEF+.VARST ;clear interlock for variable list
	HRLM	.AC1,BINDEF+.OPTST ;clear interlock for option list
	HRLM	.AC1,BINDEF+.EMPST ;clear interlock for empty cell list
	TMSG	([Interlocks reset]) ;[43]
	RET
; SETUP/VARIABLE routine; defines and saved a variable in SETUP.BIN

SWVAR:				;SETUP/VARIABLE <variable-name> <variable-value>
	PARSE	.CMTOK,CM%SDH,<POINT 7,[<SPECHR>B6]>,<variable name>
	  JRST	INIIVN
	PARSE	.CMFLD,CM%SDH,,<variable name>
	  JRST	INIIVN
	MOVE	.AC1,[POINT 7,ANSW1]
	MOVEI	CH,SPECHR
	IDPB	CH,.AC1
	HRROI	.AC2,ATMBUF
	SETZB	.AC3,.AC4
	SOUT			;move variable name to ANSW1
	PUSH	P,.AC1		;save byte pointer
	PARSE	.CMTOK,,<POINT 7,[76B6]>,<variable name>;look for ">" to terminate name
	  JRST	INIIVN
	POP	P,.AC1		;where name left off
	MOVEI	CH,">"
	IDPB	CH,.AC1
	SETZ	CH,
	IDPB	CH,.AC1
	PARSE	.CMTXT,CM%SDH,,<value of variable to be stored>
	  NOP
	CALL	GETVAR		;[57] try to retrieve current value
	MOVE	P1,[POINT 7,ATMBUF]
	MOVE	P2,[POINT 7,ANSW2]
	SETZ	.AC1,		;count of bytes in value
	ILDB	CH,P1
	IDPB	CH,P2
	SKIPE	CH		;done when found a nul
	AOJA	.AC1,.-3
	ADDI	.AC1,5		;round up +nul
	IDIVI	.AC1,5		;get # words
	MOVEM	.AC1,ITMLEN
	CALL	DEFSAV		;save value in SETUP.BIN
	TMSG	([Variable )	;[43]
	HRROI	.AC1,ANSW1	;[43] show variable name and value
	PSOUT%			;[43]
;[57]	TMSG	( defined as ")	;[43]
	TXNE	F,F%SHW		;[57] was there an old value?
	JRST	[		;[57] yep, then show it
		TMSG	( changed from ") ;[57]
		HRROI	.AC1,SVALUE ;[57]
		PSOUT%		;[57]
		TMSG	(" to ") ;[57]
		JRST	.+2]	;[57]
	JRST	[		;[57] else just define it
		TMSG	( defined as ") ;[57]
		JRST	.+1]	;[57]
	HRROI	.AC1,ANSW2	;[43]
	PSOUT%			;[43]
	TMSG	("])		;[43]
	RET
; Insert SETUP version and input MCF filespec into CTL file

INIIDN:
	MOVE	.AC1,OUTJFN	;jfn of .CTL file
	MOVEI	.AC2,CMDCHR	;currently ";"
	BOUT			;output to .CTL file
	  ERJMP	SYSFAT		;[36]
	MOVEI	.AC2,SPACE	;add a space so won't look
	BOUT			;like SETUP command
	  ERJMP	SYSFAT		;[36]
	HRROI	.AC2,VER	;print SETUP version
	SETZ	.AC3,
	SOUT
	  ERJMP	SYSFAT		;[36]
	HRROI	.AC2,[ASCIZ / input from /] ;nice words
	SOUT
	  ERJMP	SYSFAT		;[36]
	MOVE	.AC2,INJFN	;jfn of .MCF file
	MOVE	.AC3,[1B2+1B5+1B8+1B11+1B14+JS%PAF]
	JFNS			;add full spec of .MCF file
	  ERJMP	SYSFAT		;[36]
	HRROI	.AC2,CRLF
	SETZ	.AC3,
	SOUT			;skip to new line
	  ERJMP	SYSFAT		;[36]
	RET

CKEOF:
	HRRZ	.AC1,BLKTYP	;[50] look at block type
	TXNN	.AC1,FILCOD	;[50] is it an ;Include or ;Perform?
	JRST	BLKEND		;[50] nope, then block didn't end
	TRNE	.AC1,377777	;[50] is this an in-line block?
	JRST	BLKEND		;[50] skip if give name of block that didn't end
	MOVE	.AC1,OUTJFN	;jfn of .CTL file
	HRROI	.AC2,[ASCIZ /; end of /]
	SETZ	.AC3,		;output whole string
	SOUT
	  ERJMP	SYSFAT		;[36]
	MOVE	.AC2,INJFN	;jfn of included file
	MOVE	.AC3,[1B2+1B5+1B8+1B11+1B14+JS%PAF]
	JFNS			;type whole filespec of included file
	  ERJMP	SYSFAT		;[36]
	HRROI	.AC2,CRLF
	SETZ	.AC3,
	SOUT
	  ERJMP	SYSFAT		;[36]
	SKIPE	.AC1,TRCJFN	;[54] get the trace jfn, skip if none defined
	CALL	TRCRET		;[54] output return from file trace record
	RET


RELBIN:				;un-map, close, and release SETUP.BIN
	SKIPG	.AC1,BINJFN	;was SETUP.BIN mapped?
	RET			;nope, then don't un-map it!
	HRLI	.AC1,.FBSIZ	;modify byte count in FDB
	MOVNI	.AC2,1
	MOVE	.AC3,BINDEF	;to be word count
	CHFDB
	HRLI	.AC1,.FBBYV	;make sure byte size is 36
	MOVE	.AC2,[77B11]
	MOVE	.AC3,[44B11]
	CHFDB
	MOVNI	.AC1,1
	MOVE	.AC2,[.FHSLF,,BINDEF/1K]
;[35]	SETZ	.AC3,
	SKIPE	.AC3,BINSIZ	;[35] get page count, skip if only one page
	JRST	[TXO	.AC3,PM%CNT ;[35] else unmap all pages
		 AOJA	.AC3,.+1] ;[35]
	PMAP
	RET
	SUBTTL	/JOB-ID: switch

.JOBID:				;/JOB-ID: switch
	PARSE	.CMFLD,,,<1-word identifier for this job> ;get the job-id
	  JRST	[HRROI	.AC1,[ASCIZ /Invalid job-id switch given/]
		 MOVEM	.AC1,ERRMES
		 TXO	F,F%FAT	;set fatal error flag
		 RET]
	DMOVE	.AC1,[ASCIZ /<JOB-ID>/]	;setup constant name
	DMOVEM	.AC1,ANSW1
	DMOVE	.AC1,ATMBUF	;setup constant value
	DMOVEM	.AC1,ANSW2
	MOVE	P1,[POINT 7,ATMBUF] ;source
	MOVEI	.AC1,7		;max of 6 chars
	ILDB	.AC2,P1		;get a char
	SKIPN	.AC2		;found nul?
	JRST	.JOBI1		;yep, then done
	SOJG	.AC1,.-3
	JRST	[HRROI	.AC1,[ASCIZ /Job identifier is longer than 6 characters/]
		 MOVEM	.AC1,ERRMES ;setup message address
		 TXO	F,F%FAT	;set fatal error flag	
		 RET]
.JOBI1:	MOVN	.AC1,.AC1
	ADDI	.AC1,14		;get # chars + nul, round up
	IDIVI	.AC1,5
	MOVEM	.AC1,ITMLEN
	TRZ	F,-1
	CALL	DEFSTO		;internal ;Define constant command
	  NOP			;don't care about errors
	RET
	SUBTTL	/TAG: Switch

.TAG:				;/TAG: switch
	PARSE	.CMFLD,,,<batch label at which to resume prompting>
	  JRST	[HRROI	.AC1,[ASCIZ /Invalid tag switch given/]
		 MOVEM	.AC1,ERRMES
		 TXO	F,F%FAT	;set fatal error flag
		 JRST	FATAL]
	MOVE	P1,[POINT 7,ATMBUF] ;pointer to /TAG: value
	MOVE	P2,[POINT 6,TAGNAM] ;store it here
	MOVEI	.AC1,6		;6 chars or less
	SETZM	TAGNAM		;initialize tag name to spaces
.TAG1:	ILDB	.AC2,P1		;get a char
	SKIPN	.AC2		;found end of tag?
	JRST	.TAG2
	CAIL	.AC2,"a"	;if lowercase
	CAILE	.AC2,"z"
	SKIPA
	SUBI	.AC2,"a"-"A"	;then raise to uppercase
	SUBI	.AC2,40		;make it sixbit
	IDPB	.AC2,P2		;store char
	SOJG	.AC1,.TAG1	;loop 'till done
	ILDB	.AC2,P1		;look at next char
	SKIPE	.AC2		;is next char nul?
	JRST	[HRROI	.AC1,[ASCIZ /Tag name is longer than six characters/]
		 MOVEM	.AC1,ERRMES
		 TXO	F,F%FAT	;set fatal error flag
		 RET]
.TAG2:	TXO	F,F%TAG		;set /TAG: flag
	DMOVE	.AC1,[ASCIZ /Restart/]
	DMOVEM	.AC1,ANSW1	;re-define this option as yes
	SETOM	SVALUE
	CALL	SELSTO
	  NOP			;don't care about errors
	MOVE	.AC1,[POINT 7,ANSW1+1,13] ;[33] add "-tag"
	MOVEI	.AC2,"-"	;[33] to option name
	IDPB	.AC2,.AC1	;[33]
	MOVE	.AC2,[POINT 7,ATMBUF] ;[33] plus tag name
	SETZ	.AC3,		;[33] terminated on nul
	SOUT%			;[33]
	CALL	SELSTO		;[33] store this option in the table
	  NOP			;[33] shouldn't be any errors
	RET
	;**** ERROR TYPE OUT ROUTINES
WARN:	CALL	TYCRLF		;FORMAT & CLEAT CONTROL/O
	MOVEI	.AC1,.PRIIN
	CFIBF			;CLEAR ANY LEFT OVER JUNK
	TYPE	[ASCIZ /% /]
	TYPE	<(T1)>		;TYPE ERROR MESSAGE
	CALL	TYCRLF
	TYPE	LINE
	MOVE	P1,[POINT 7,LINE] ;restore line pointer
	MOVEM	P1,SAVPNT	;to beginning of line
	TXO	F,F%FAT		;set flag to abort on end of MCF
	RET

FATAL:	CALL	TYCRLF		;FORMAT & CLEAR CONTROL/O
	TYPE	[ASCIZ /? /]	;FATAL ERROR
	TYPE	<(T1)>		;TYPE MESSAGE
	CALL	TYCRLF
	TYPE	LINE		;TYPE ERROR LINE
	JRST	CMQT1

	;**** SYSTEM GENERATED ERROR MESSAGES ****

SYSWRN:	HRROI	.AC1,[ASCIZ /
% /]				;WARNINGS GET '%'
ERROR:	PSOUT
	MOVEI	.AC1,.PRIOU	;DESTINATION IS TTY
	HRLOI	.AC2,.FHSLF	;OWN PROCESS,,MOST RECENT ERROR
	SETZ	.AC3,		;FULL MESSAGE
	ERSTR			;TYPE ERROR MESSAGE
	 JFCL			;IGNORE THESE
	 JFCL			;  BAD RETURNS
	RET			;GOOD RETURN

SYSFAT:	HRROI	.AC1,[ASCIZ /
? /]				;FATAL ERRORS GET '?'
	CALL	ERROR		;PRINT ERROR
SYSHLT:	HALTF			;THEN STOP
	HRROI	.AC1,[ASCIZ /? Can't continue!!/]
	PSOUT
	JRST	SYSHLT
	SUBTTL *** ERROR MESSAGES AND ROUTINES ***
		;ERROR ROUTINES FOR "D"EFINE COMMAND
DEFNO:	MOVEI	T1,[ASCIZ /No name specified in DEFINE command/]
	JRST	WARN
DEFIFC:	MOVEI	T1,[ASCIZ /Illegal first character in constant or variable/]
	JRST	WARN
DEFCTL:	MOVEI	T1,[ASCIZ /Name is too long/]
	JRST	WARN
DEFNTX:	MOVEI	T1,[ASCIZ /No text describing name/]
	JRST	WARN
DEFINC:	MOVEI	T1,[ASCIZ /Incomplete DEFINE command/]
	JRST	WARN
DEFUNK:	MOVEI	T1,[ASCIZ /Unknown DEFINE command/]
	JRST	WARN
DEFILN:	MOVEI	T1,[ASCIZ /Invalid variable or constant name: does not end with ">"/]
	JRST	WARN
DEFIER:	MOVEI	T1,[ASCIZ /Internal error: probably due to variable value looking like another variable/]
	JRST	FATAL
DEFESP:	MOVEI	T1,[ASCIZ /Exceeded variable and constant storage space/]
	JRST	FATAL
DEFLNG:	CALL	TYCRLF
	TYPE	[ASCIZ /% The value may not be longer than 150 characters; please re-enter
/]
	MOVEI	.AC1,.PRIIN	;clear tty input
	CFIBF
	JRST	DEFGT1
DEFNDF:	TYPE	[ASCIZ /%A value must be entered for this variable
/]
	MOVEI	.AC1,.PRIIN	;clear tty input
	CFIBF				;CLEAR ANY LEFT OVER GARBAGE
	JRST	DEFGT1
GETILC:	MOVEI	T1,[ASCIZ /Incomplete ;GET command/]
	JRST	WARN
GETIVO:	MOVEI	T1,[ASCIZ /Type is not OPTION or VARIABLE in ;GET command/]
	JRST	WARN
GETNAM:	MOVEI	T1,[ASCIZ /Name is missing in ;GET command/]
	JRST	WARN
GETIVN:	MOVEI	T1,[ASCIZ /Variable name must be enclosed in "<" and ">"/]
	JRST	WARN
GETVND:	CALL	CLRACS
	SETZM	PUTPNT
	MOVEI	T1,[ASCIZ /Variable does not have a default value/]
	JRST	WARN
GETOND:	CALL	CLRACS
	SETZM	PUTPNT
	MOVEI	T1,[ASCIZ /Option does not have a default value/]
	JRST	WARN
		;ERROR ROUTINE FOR "?" COMMAND
ANSTL:	TYPE	[ASCIZ/% Answer may not be longer than 150 characters; please re-enter
/]
	MOVEI	.AC1,.PRIIN	;clear tty input
	CFIBF				;CLEAR ANY EXTRA GARBAGE
	JRST	ASK2

		;ERROR MESSAGES FOR "O" AND "N" COMMANDS
OPTNAM:	MOVEI	T1,[ASCIZ /OPTION name not specified/]
	JRST	WARN			;TYPE WARNING THEN RETURN
OPTLNG:	MOVEI	T1,[ASCIZ /OPTION name too long/]
	JRST	WARN
OPTSLH:	MOVEI	T1,[ASCIZ \No slash '/' following OPTION name\]
	JRST	WARN


		;ERROR MESSAGES FOR ';S'ELECT OPTION
SELINC:	MOVEI	T1,[ASCIZ /Incomplete SELECT command/]
	JRST	WARN
SELUNK:	MOVEI	T1,[ASCIZ /Unknown SELECT command/]
	JRST	WARN
SELMIS:	MOVEI	T1,[ASCIZ /Option or variable name missing in SELECT command/]
	JRST	WARN
SELNTX:	MOVEI	T1,[ASCIZ /No text to describe SELECT option name/]
	JRST	WARN
SELNG:	MOVEI	T1,[ASCIZ/Option name too long in SELECT command/]
	JRST	WARN
SELESP:	MOVEI	T1,[ASCIZ /Exceeded option storage space/]
	JRST	FATAL
SELOAS:	MOVEI	T1,[ASCIZ /Option has already been selected/]
	JRST	WARN


		;***ERROR MESSAGE FOR GET MCF LINE ROUTINE
LINTL:	MOVEI	T1,[ASCIZ /MCF line too long/]
	JRST	FATAL
INVCMD:	MOVEI	T1,[ASCIZ /Invalid SETUP command/]
	CALL	WARN
	JRST	RESPNT
AMBCMD:	MOVEI	T1,[ASCIZ /Ambiguous SETUP command/]
	CALL	WARN
	JRST	RESPNT
ERRNTX:	MOVEI	T1,[ASCIZ /No text in ;Error command/]
	JRST	WARN
INCCOF:	MOVEI	T1,[ASCIZ /Cannot open ;Include file/]
	JRST	WARN
INCFNF:	MOVEI	T1,[ASCIZ /;Include file not accessible/]
	JRST	WARN
INCINC:	MOVEI	T1,[ASCIZ /Incomplete ;Include command/]
	JRST	WARN
DEFNOP:	MOVEI	T1,[ASCIZ /No option name found after ;Define option command/]
	JRST	WARN
DEFNAN:	MOVEI	T1,[ASCIZ /No option value found in ;Define option command/]
	JRST	WARN
INVSWT:	MOVEI	T1,[ASCIZ /Invalid switch modifying SETUP command/]
	JRST	WARN
DEFSWT:	MOVEI	T1,[ASCIZ /Switch in ;Define command is only valid for ;Define Variable/]
	JRST	WARN
INIERR:	MOVEI	T1,[ASCIZ /Error initializing command line parse/]
	JRST	FATAL
INIMCF:	MOVEI	T1,[ASCIZ /MCF file not found/]
	JRST	FATAL
INICFM:	MOVEI	T1,[ASCIZ /Unrecognized parameters at end of command/]
	JRST	FATAL
ININAM:	MOVEI	T1,[ASCIZ /Invalid or missing option or variable name/]
	JRST	FATAL
INIIVO:	MOVEI	T1,[ASCIZ /Option value is not YES or NO/]
	JRST	FATAL
INIIVN:	MOVEI	T1,[ASCIZ /Invalid or missing variable name/]
	JRST	FATAL
INIIVL:	MOVEI	T1,[ASCIZ /Invalid LIST option/]
	JRST	FATAL
ININDV:	MOVEI	T1,[ASCIZ \No default value for this option/variable\]
	JRST	FATAL
INIIDO:	MOVEI	T1,[ASCIZ \Invalid option after /DELETE switch\]
	JRST	FATAL
ASKILC:	MOVEI	T1,[ASCIZ /No text found following ;ASK command/]
	JRST	WARN
FILFNM:	MOVEI	T1,[ASCIZ /File name missing in ;File command/]
	JRST	WARN
FILOPM:	MOVEI	T1,[ASCIZ /Option missing in ;File command/]
	JRST	WARN
FILILO:	MOVEI	T1,[ASCIZ /Invalid option in ;File command/]
	JRST	WARN
FILSLH:	MOVEI	T1,[ASCIZ \No "/" following option in ;File command\]
	JRST	WARN
TAGNFD:	MOVEI	T1,[ASCIZ /Specified tag not found in file/]
	JRST	FATAL
BINUNC:	MOVEI	T1,[ASCIZ /Unable to create SETUP.BIN/]
	JRST	FATAL
ACCNGR:	MOVEI	T1,[ASCIZ /SETUP.BIN file is in use by another job/]
	JRST	FATAL
BINOPN:	MOVEI	T1,[ASCIZ /Cannot open SETUP.BIN/]
	JRST	FATAL
CIFNST:	MOVEI	T1,[ASCIZ /String missing in ;If command/]
	JRST	WARN
CIFIST:	MOVEI	T1,[ASCIZ /Closing quotation missing on string in ;If command/]
	JRST	WARN
CIFICM:	MOVEI	T1,[ASCIZ /Incomplete ;If command/]
	JRST	WARN
CIFCON:	MOVEI	T1,[ASCIZ /Invalid condition type in ;If command/]
	JRST	WARN
CIFSLH:	MOVEI	T1,[ASCIZ /Slash missing to delimit text in ;If command/]
	JRST	WARN
SELNVL:	MOVEI	T1,[ASCIZ /No value list for variable/]
	JRST	WARN
SELLPM:	MOVEI	T1,[ASCIZ /Left paren missing in value list/]
	JRST	WARN
SELIVV:	MOVEI	T1,[ASCIZ /Invalid variable value in list/]
	JRST	WARN
SELTMV:	MOVEI	T1,[ASCIZ /Too many values in list: cannot be more than 26/]
	JRST	WARN
SELIVR:	TMSG	(% Response must be a single character in the range A to )
	MOVEI	.AC1,"A"(X1)
	PBOUT
	TMSG	(; please re-enter)
	MOVEI	.AC1,.PRIIN	;clear tty input
	CFIBF
	CALL	DEFGET		;get another response
	  RET			;if error, then quit
	JRST	SELGVV		;return this a-way
ASKNAG:	TMSG	(% No answer given; please give a response)
	CALL	TYCRLF
	MOVEI	.AC1,.PRIIN	;clear tty input
	CFIBF
	JRST	ASK2		;and try again
;	;Perform command error messages

PFMNFN:	MOVEI	T1,[ASCIZ /Filespec was not given/]
	JRST	WARN
PFMIFN:	MOVEI	T1,[ASCIZ /Invalid filespec/]
	JRST	WARN
PFMFNF:	MOVEI	T1,[ASCIZ /;Perform file not accessible/]
	JRST	WARN
PFMRAR:	MOVEI	T1,[ASCIZ /Read access required to ;Perform file/]
	JRST	WARN
PFMNVN:	MOVEI	T1,[ASCIZ /No variable name(s) given for ;Perform command/]
	JRST	WARN
PFMIVN:	MOVEI	T1,[ASCIZ /Invalid variable name specified in ;Perform command/]
	JRST	WARN
PFMNVV:	MOVEI	T1,[ASCIZ /No variable value list specified in ;Perform command/]
	JRST	WARN
PFMNEQ:	MOVEI	T1,[ASCIZ /Equals sign missing in ;Perform command/]
	JRST	WARN
PFMVCM:	MOVEI	T1,[ASCIZ /Variable value lists are not the same length/]
	JRST	WARN
PFMTMV:	MOVEI	T1,[ASCIZ /Too many variables specified for replacement/]
	JRST	WARN
PFMCMA:	MOVEI	T1,[ASCIZ /Comma to delimit values is missing/]
	JRST	WARN
PFMRPM:	MOVEI	T1,[ASCIZ /Right parenthesis missing at end of value list/]
	JRST	WARN
PFMNLP:	MOVEI	T1,[ASCIZ /Left parenthesis missing before value list/]
	JRST	WARN
PFMIVV:	MOVEI	T1,[ASCIZ /Invalid variable value; beginning or ending quote missing/]
	JRST	WARN
SAVFIL:	MOVEI	T1,[ASCIZ /Default value file has grown too large/]
	JRST	FATAL
PFMNSF:	TXNE	F,F%BTW		;[32] between tags on a restart?
	RET			;[32] yep, then ignore error
	MOVEI	T1,[ASCIZ /No files match filespec in ;Perform command/]
	JRST	WARN
PFMIFL:	MOVEI	T1,[ASCIZ /Invalid file list in ;Perform command/]
	JRST	WARN
PFMIVS:	MOVEI	T1,[ASCIZ /No switches permitted in this form of ;Perform/] ;[36]
	CALL	WARN		;[36]
	JRST	PERERR		;[36]
CNTNCC:	MOVEI	T1,[ASCIZ /No continuation chars on continuation line (";+")/] ;[34]
	JRST	WARN		;[34]
SWTMIS:	MOVEI	T1,[ASCIZ /Switch missing after SETUP command/]	;[36]
	JRST	WARN		;[36]
GETNSN:	MOVEI	T1,[ASCIZ \No second option or variable name in ;Get/define command\] ;[36]
	JRST	WARN		;[36]
GETTMF:	MOVEI	T1,[ASCIZ \Too many fields in ;Get command (missing "/define"?)\] ;[36]
	JRST	WARN		;[36]
DEFNOA:	MOVEI	T1,[ASCIZ \/DEFAULT: switch not allowed in combination with /ALLOW and /SAVE\] ;[42]
	JRST	WARN		;[42]
INVDEF:	MOVEI	T1,[ASCIZ \Default value must be Y or N\] ;[42]
	JRST	WARN		;[42]
SWTVAL:	MOVEI	T1,[ASCIZ \Value is required after this switch\] ;[42]
	JRST	WARN		;[42]
SWTDEL:	MOVEI	T1,[ASCIZ \Missing quote to delimit switch value\] ;[42]
	JRST	WARN		;[42]
LEVTPL:	MOVEI	T1,[ASCIZ /Cannot ;Leave top level of MCF/] ;[47]
	JRST	FATAL		;[47]
BLKEND:	HRROI	.AC1,ANSW1	;[50] construct error message here
	HRROI	.AC2,[ASCIZ /Block "/] ;[50]
	SETZ	.AC3,		;[50]
	SOUT%			;[50]
	HRROI	.AC2,BLKNAM	;[50] copy block name
	SOUT%			;[50]
	HRROI	.AC2,[ASCIZ /" does not end/] ;[50]
	SOUT%			;[50]
	IDPB	.AC3,.AC1	;[50] make it ASCIZ
	MOVEI	T1,ANSW1	;[50] message is now here
	JRST	FATAL		;[50]
LEVNAM:	HRROI	.AC1,ANSW1	;[50] construct error message here
	HRROI	.AC2,[ASCIZ /Cannot end or leave this block from block "/] ;[50]
	SETZ	.AC3,		;[50]
	SOUT%			;[50]
	HRROI	.AC2,BLKNAM	;[50] copy block name
	SOUT%			;[50]
	MOVEI	.AC2,42		;[50]
	IDPB	.AC2,.AC1	;[50]
	IDPB	.AC3,.AC1	;[50] make it ASCIZ
	MOVEI	T1,ANSW1	;[50] message is now here
	JRST	FATAL		;[50] 
INVBKN:	MOVEI	T1,[ASCIZ /Invalid block name/]	;[50]
	JRST	FATAL		;[50]
PDLOVF:	MOVEI	T1,[ASCIZ /Push-down overflow: Too many levels of nesting/] ;[50]
	MOVE	P,[IOWD PDLEN,PDLIST] ;[50] reset stack ptr to not get interrupt again!
	JRST	FATAL		;[50]
ENDNIB:	MOVEI	T1,[ASCIZ /No block to ;End/] ;[50]
	JRST	FATAL		;[50]
ENDNCA:	MOVEI	T1,[ASCIZ /;End command may not follow a conditional command/] ;[50]
	JRST	FATAL		;[50]
ENDFIL:	MOVEI	T1,[ASCIZ /May not ;End an ;Include or ;Perform of a file/] ;[50]
	JRST	FATAL		;[50]
	SUBTTL	Variable storage

	FSTMEM==.		;WHERE TO START CLEAR MEMORY

				;STORAGE FOR SELECT OPTION STUFF
VAREND:	0			;holds address of end of VARLST
VARLST:	BLOCK	VARSIZ		;linked list for variables and constants
OPTEND:	0			;holds address of end of OPTLST
OPTLST:	BLOCK	OPTSIZ		;linked list for options
				;PROCESSING STORAGE
LINE:	BLOCK <MAXCHR/5>	;STORAGE FOR PROCESSING MCF LINE
	Z			;OVRFLOW TEST WORD-DO NOT MOVE
ANSW1:	BLOCK <MAXCHR/5>	;WORK AREA FOR LINE MUST BE SAME
				;  LENGTH AS LINE
	Z			;OVRFLOW TEST
ANSW2:	BLOCK <MAXCHR/5>	;WORK AREA 2
	Z			;OVRFLOW TEST
ANSW3:	BLOCK <MAXCHR/5>	;WORK AREA 3 - FOR YES OR NO
	Z			;OVRFLOW TEST
SVALUE:	BLOCK	MAXCHR/5	;place to save default/old value
SAVPNT:	Z			;WORD TO SAVE CURRENT BEGINNING
				;   OF MCF LINE
PUTPNT:	Z			;POINTER WHERE TO INSERT VALUE
				;   OF OPTION OR CONSTANT
PUTVAL:	Z			;IF PUTPNT REFERS TO AN OPTION
				;   PUTVAL=0 OR 1 FOR 'N' OR 'Y'
				;IF PUTPNT REFERS TO A CONSTANT
				;   PUTVAL IS PTR TO REPLACE.
ATMBUF:	BLOCK	<MAXCHR/5>	;COMND atom buffer
BEGJFN:	0			;[31] jfn for ;Include/begin file
INJFN:	Z			; MCF JOB FILE NUMBER
OUTJFN:	Z			; CTL FILE JOB FILE NUMBER
BINJFN:	0			;jfn of SETUP.BIN if needed
LINCNT:	0			;[54] count of lines read in GETLIN
NEWTAG:	0			;[56] last tag name encountered
PFMCNT:	0			;sequence counter for ;Perform =filespec
SLEVEL:	0			;[47] nest level for ;Includ, ;Perform, ;Block
TAGCNT:	0			;generated tag number for ;Error command
TAGOFF:	0			;[56] offset past last tag name
TRCJFN:	0			;[54] jfn for MCFTRACE: file
VARCNT:	0
	LSTMEM== .-1		;LAST LOCATION TO BE CLEARED
BINSIZ:	0			;[35] page count of SETUP.BIN
BLKNAM:	BLOCK	30		;[50] current block name
BLKTYP:	0			;[50] block parameter,,block type
CHNTAB:	BLOCK	36		;[46] software interrupt channel table
	.ORG	CHNTAB		;[46] channel 0 is control-C
	2,,CNTRLC		;[46]
	.ORG	CHNTAB+^D9	;[50] channel 9 is push-down overflow
	1,,PDLOVF		;[50]
	.ORG	CHNTAB+^D36
CMBLK1:	CTRLC2			;[46] COMND state block for control-C handler
	.PRIIN,,.PRIOU		;[46] i/o jfns
	-1,,[ASCIZ /Yes? /]	;[46] prompt
	-1,,CMBUF1		;[46] line buffer
	0			;[46]
	0			;[46]
	0			;[46]
	-1,,ATBUF1		;[46] atom buffer
	24			;[46] size of atom buffer
	0			;[46]
CMBUF1:	BLOCK	10		;[46] command buffer for ^C
ATBUF1:	BLOCK	4		;[46] atom buffer for ^C
CURTIM:	0			;[54] time and date of SETUP invocation
ENTVEC:	JRST	START
	JRST	START		;for REENTER command
	EXP	3B2+5B11+57	;SETUP version 5(57)-3
LEVTAB:	.+3			;[46] software interrupt level table
	.+3			;[46]
	.+3			;[46]
	BLOCK	3		;[46]
PDLIST:	BLOCK <PDLEN>		;PUSH-DOWN STORAGE
SAVFLG:	0			;[50] place to save flags
SWTCH1:	FLDDB.	.CMSWI,,SWBLK1
SWBLK1:	XWD	SWLEN1,SWLEN1
	ITEM	JOB-ID:,.JOBID
	ITEM	TAG:,.TAG

	SWLEN1==.-SWBLK1-1
SWTCH2:	FLDDB.	.CMSWI,,SWBLK2
SWBLK2:	XWD	SWLEN2,SWLEN2
	ITEM	DELETE,SWDEL
	ITEM	LIST,SWLST
	ITEM	OPTION,SWOPT
	ITEM	RESET,SWREST
	ITEM	VARIABLE,SWVAR

	SWLEN2==.-SWBLK2-1
CRLF:	BYTE	(7) 15,12,0
VER:	ASCIZ	/SETUP version 5(57)/
ERRMES:	0			;address of fatal error message
MTHNAM:	-1,,[ASCIZ /Jan/]	;[55] table of month names
	-1,,[ASCIZ /Feb/]	;[55]
	-1,,[ASCIZ /Mar/]	;[55]
	-1,,[ASCIZ /Apr/]	;[55]
	-1,,[ASCIZ /May/]	;[55]
	-1,,[ASCIZ /Jun/]	;[55]
	-1,,[ASCIZ /Jul/]	;[55]
	-1,,[ASCIZ /Aug/]	;[55]
	-1,,[ASCIZ /Sep/]	;[55]
	-1,,[ASCIZ /Oct/]	;[55]
	-1,,[ASCIZ /Nov/]	;[55]
	-1,,[ASCIZ /Dec/]	;[55]
;[56]NEWTAG:	0			;a place for an .MCF tag
TAGNAM:	0			;value of /TAG: switch
PFMLST:	BLOCK	MAXPFM
ITMLEN:	0			;length of variable value in chars&words
ITMPTR:	0			;a byte pointer to item to be found
LSTPTR:	0			;a byte pointer to item in list
VALCNT:	0
VALTAB:	BLOCK	^D26		;table of value pointers for ;Select variable
WAITRY:	0			;number of tries for list access
WKDPTR:	-1,,[ASCIZ /Monday/]	;table of byte pointers to week day names
	-1,,[ASCIZ /Tuesday/]
	-1,,[ASCIZ /Wednesday/]
	-1,,[ASCIZ /Thursday/]
	-1,,[ASCIZ /Friday/]
	-1,,[ASCIZ /Saturday/]
	-1,,[ASCIZ /Sunday/]
CMBLOK:	REPARS			;block for COMND
	BLOCK	6
	-1,,ATMBUF		;atom buffer
	MAXCHR			;size of atom buffer
	.+1			;GTJFN block
GJFBLK:	GJ%OLD			;want old file
	0
	-1,,[ASCIZ /MCF:/]	;DEF TO  LOGICAL MCF:
	0			;DEF TO CONNECTED DIRECTORY
	0			;NO DEFAULT FILE NAME
	-1,,[ASCIZ /MCF/]	;DEF EXTENSION
	0			;DEF PROTECTION CODE
	0			;LOGGED IN ACCOUNT NUMBER
	0			;NO SPECIFIC JFN
	0
	BLOCK	4		;extended argument block

	XLIST			;don't list literals
	LIT
	LIST
BINDEF=.!777+1+2K		;a place to map SETUP.BIN

	END	<3,,ENTVEC>