Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
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>