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 ). [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 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 "" [NOT] =! "", ;Select variable, ;Type to clear screen, clear screen on startup, undefined options => no value. [21] R. Swick 14-Jun-79 Add ,,, 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 ... ,=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- 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:"" 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 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 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 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, 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. ,,,,,] 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+-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 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 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 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 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 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 //... 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 =<"val1","val2",...) =... ; ; 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 =("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+ 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 [,[,]]=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+ 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: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 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 "" [NOT] =! "" command ; ; Returns +1: error occurred or condition false ; +2: condition true, P1 points to following 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 [] 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 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 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 SOUT% HRROI .AC2,CRLF ;output a 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,,+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 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 //] ;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 //] ;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 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 //] 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 //] 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 //] ;[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 //] 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 //] SETZB .AC3,.AC4 SOUT ;setup name of 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 //] ;[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 //] ;[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 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 "" ; 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,, 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],, 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 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], 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,, 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 PARSE .CMTOK,CM%SDH,B6]>, JRST INIIVN PARSE .CMFLD,CM%SDH,, 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,,,;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,, 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 //] ;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,,, 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 ;STORAGE FOR PROCESSING MCF LINE Z ;OVRFLOW TEST WORD-DO NOT MOVE ANSW1: BLOCK ;WORK AREA FOR LINE MUST BE SAME ; LENGTH AS LINE Z ;OVRFLOW TEST ANSW2: BLOCK ;WORK AREA 2 Z ;OVRFLOW TEST ANSW3: BLOCK ;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 ;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 ;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>