diff --git a/README.md b/README.md index 99c27af0..3a34e43c 100644 --- a/README.md +++ b/README.md @@ -93,6 +93,7 @@ There's a [DDT cheat sheet](doc/DDT.md) for Unix users. - HSNAME, displays user's HSNAME. - HSNDEV, HSNAME device. - IDLE, list idle users. + - INIT, a helper program for LOGIN, LOGOUT, and other script files. - INLINE, reads line from TTY and adds to JCL (for DDT init files) - INQUIR, user account database. - INQUPD, processes INQUIR change requests. diff --git a/build/build.tcl b/build/build.tcl index fc92691b..ba87e1ea 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -715,6 +715,10 @@ respond "*" ":link .info.;its ttyvar,sysdoc;ttyvar >\r" respond "*" ":midas sys2;ts inline_sysen1;inline\r" expect ":KILL" +# init +respond "*" ":midas sys3;ts init_sysen2;init\r" +expect ":KILL" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" respond "*" ":link kshack;ddt bin,.;@ ddt\r" diff --git a/doc/info/init.4 b/doc/info/init.4 new file mode 100644 index 00000000..58338157 --- /dev/null +++ b/doc/info/init.4 @@ -0,0 +1,462 @@ +INIT & MUDDLE'S INIT PACKAGE + +File: INIT Node: Top Next: Built-in Up: (DIR) + + INIT is a new DDT INIT program which is much faster and +considerably more versatile than the old :INIT (now :OINIT). + Basically, INIT will allow the user to print any text, +ask any true/false type question, and perform any of a wide +range of commands (including most useful file hacking commands). +In addition, the control structure of INIT allows for the use +of nested AND, OR, and PROG-type operations, using the various +commands as predicates. + +* Menu: Table of Contents + +* Order: Order + All existing Commands and Special Characters + +* Built-in Functions: PRE + Predefined Functions for Mail-reading, file saving, etc. + +* Commands: CMDS + Format of INIT commands + +* Nested Structures: NEST + INIT's control structures and "expression format" + +* Questions: QUE + How INIT asks (and you answer) questions + +* File names: FNMS + How INIT handles File name defaulting + +* Q-registers: QREGS + Setting and reading variables + +* Again and Return: AGNRET + Non-local transfer of control + +* Function Creation and Calling: FCNS + Defining and calling your own functions + +* Odds and Ends: ODDS + +* MUDDLE's INIT Package: MUDINIT + Writing and editing INIT programs in MUDDLE + + +File: INIT Node: PRE Next: CMDS Up: Top + +I. Built-in Functions + + As will become clear from reading the remainder of this +document, it is possible in INIT to define 'functions' which +perform specified operations (mostly on files). + However, there are a few built in functions which may be +called by users which do some of the more commonly performed +rituals. Functions in INIT are called with the APPLY command, +which is [@ .....], where name is a single +character function name (names other than A-Z are illegal). +Arguments to these functions (where applicable) must be strings +surrounded by double quotes. + The following functions exist 'preloaded' into INIT: + + a. M -- simple mail command + If a mail file exists, INIT will ask whether or not to + print it. If the answer is yes (Y or y), INIT will + print the file and rename the MAIL file to OMAIL. + No arguments + b. T -- teco safety file + If a file named _ > exists, print + 'You have a TECO safety file.' + No arguments + c. S -- hairy mail command (with Saving of files) + If a mail fle exists, INIT will ask whether or not to + print it. If the answer is yes, INIT will print the + file and ask whether or not to save it. If the answer + is yes, it will rename the mail file. If no, it will append + the mail file to VANISH; OMAIL and delete the mail file. + Two arguments (both optional) + 1. File where mail exists (default to ; MAIL) + 2. File that mail should be renamed to (default to ;OMAIL >) + + Other preloaded functions may appear in the future. + +File: INIT Node: CMDS Next: NEST Previous: PRE Up: TOP + +II. Commands + + All INIT commands are single characters which are mnemonic +for the actions performed. + Some commands (e.g. O(utput) and Q(uestion)) take an optional +prefix (;) which alters the meaning of the command. + Arguments to commands take one of the following formats: + Type Description + "FILE" File name within double quotes + "FILE1,FILE2" Two file names separated by a comma + "STRING" A character string within double quotes + A single character + With a few exceptions, all commands 'return' a value, +which is usually either 'true' or 'false'. These values may +be used in conditional statements, as described below. + A table of commands and arguments is Appendix I. + +File: INIT Node: NEST Next: QUE Previous: CMDS Up: TOP + +III. Nested Structures + + Nesting is accomplished by the use of square-brackets +delimiting sets of commands. + The following structures (with descriptions) are allowed: +Command Operation +[& AND Executes arguments until logical AND of results + is 'false'. +[\ OR Executes arguments until the logical OR of + results is 'true'. +[? COND Executes the first argument (PROG) in which + the first expression within that argument + evaluates to 'true'. +[ PROG Executes the arguments in turn +( BIND Executes arguments like PROG but cannot be AGAIN/RETURNed to +[* REPEAT Executes the arguments in turn, restarting + from the beginning when finished. +[# NOT Logical NOT of the argument. + + The following three are included for completeness although +they are described more completely below. + +[: DEFINE Define a function +[@ APPLY Apply a function +[! MAP MAP down structures + +Examples: + a. ... [& E"_SAFE_ MARC" O"You have a TECO safety file."] ... + will print the message if the file _SAFE_ MARC exists. + + b. ... [\ E"BETTER BEHERE" O"Important file is missing"] ... + will print the message if the file BETTER BEHERE does not exist. + + c. ... [\ E"FOO BAR" [O"Foo Bar is missing" L ...]] ... + will do everything in the PROG if FOO BAR does not exist + + d. ... [& Q"Print mail? " P"MARC MAIL"] ... + will print MARC MAIL if the answer to the question is yes. + +File: INIT Node: QUE Next: FNMS Previous: NEST Up: TOP + +IV. Questions + + The facility exists in INIT for questions to be asked and +the answer used as the "value" of that command. The default +acceptable answers are Y (y) and N (n). Any other character +will cause INIT to repeatedly ask the same question until you +comply. Using the % command, this default can be changed to + and . + +File: INIT Node: FNMS Next: QREGS Previous: QUE Up: TOP + +V. File Names + + INIT keeps its own file name defaults and updates them +with whatever is read from file name arguments. The only +exception to this is that commands which take two file names +only set the default from the first one. + The initial default is DSK:; MAIL. + When nesting is done, the file name defaults are saved +and restored upon return to that level. +Examples: + a. ... P"FOO BAR" .... + will set the defaults to FOO BAR, so that + .... W"" ... + will print the creation date of FOO BAR. + + b. ... [& E"FOO BAR" C",FOO COPY" W""] + will initially set the defaults to FOO BAR and never reset + them (since the second file name doesn't set defaults). + + c. ... [& E"FOO BAR" [& E"MUMBLE BAR" P""] P""] + will set the default to FOO BAR, push the defaults and reset + them to MUMBLE bar, and restore them when the second AND + returns. Thus, the second P"" will print FOO BAR. + + Two special characters may be used within file name +arguments. These are: + ^X (control-X) -- get the XUNAME + ^U (control-U) -- get the UNAME + Thus a file argument of "^X;^X MAIL" gets translated into +; MAIL. + +File: INIT Node: QREGS Next: AGNRET Previous: FNMS Up: TOP + +VI. Q-Registers + + The user may SET (:) and READ (=) the values of the +various Q-registers, which are labelled from A to Z. In the +case of the SET operation, the Q-register will be set to the +value of the last executed command which returns a value. +The SET operation does not itself return a value. The READ +operation will either return 'true' or 'false' depending +on the specification from the SET command. +Examples: + a. ... E"FOO BAR" :A ... + SET A to the value of the EXIST command. + b. ... [? [=A .....] [+ .....]] ... + do a COND using the READ value of A. + +File: INIT Node: AGNRET Next: FCNS Previous: QREGS Up: TOP + +VII. Again and Return + + The commands AGAIN (@<) and RETURN (@>) are commands which +allow one to restart or return from PROGs and REPEATs. The AGAIN +command will cause processing to restart at the beginning of the +nearest PROG or REPEAT. The RETURN command will cause evaluation +of the nearest PROG or REPEAT to stop. Note that the only exit +from a REPEAT is with a RETURN. Additionally, MAPFs can be RETURNed +from. This is like MAPLEAVE in MUDDLE. + +Example: + ... .X [& D"FOO >" @X] ... + and + ... [* [\ D"FOO >" @>]] ... + are equivalent statements which delete all FOO >'s. + +File: INIT Node: FCNS Next: ODDS Previous: AGNRET Up: TOP + +VIII. Function Creation/Function Calls/MAPing + + The facility exists for the creation of 'function's which +can be applied to arguments (which are strings). + The following commands perform these actions: + + a. [: -- DEFINE + The DEFINE command must be followed by the name of a Q-register + which will be the name of the function. + The rest of the structure to matching square brackets may be + any group of legal INIT commands. + + Symbolic arguments are supplied numbers from 1-9 (i.e. the + first-ninth arguments) and are used as arguments in the form + !N (excl-N) where N is the number of the argument. + With the exceptions of + and - (True and False), all arguments + must be strings. Arguments which are + and - must obviously + be passed to something which can understand them. I'm not sure, + but I think the set is limited to the AND, OR, COND, ... type + of construction. + Optional arguments may be defaulted through the use of + ;!N (semi-excl-N-argument). In this case, + will be used if the Nth argument is not given. + + Examples: + [:A [? ([&E!1 ;O!2]) (+ ;O;!3"Zork!")]] + defines a function, 'A', which takes (at least) two + arguments. If the first exists, it prints its second argument. + Otherwise, it prints its third argument (which is optional, + defaulting to "Zork!"). + + [:A [? (;!1- O"Winnage") (O"Lossage")]] + defines a function of any number of arguments. If none are + given, the ;!1- will default to false. This is one use of + passing a + or - as an argument. + + b. [@ -- APPLY + The APPLY command must be followed by the name of a 'function' + followed by the arguments to be applied to that function. + Example: + [@A "FOO BAR" "FOO BAR EXISTS" "FOO BAR IS MISSING"] + uses the function defined in the example above and calls it + with three strings. Extra arguments are ignored. Attempts + to reference arguments not supplied (unless optional and + defaulted) is an ERROR. + + c. [! -- MAP + The MAP command takes a structure (PROG/REPEAT/AND/OR, etc.) which + may contain any number of commands to be executed and any number + of additional arguments which must be BIND(LIST)s of string arguments. + The MAPper will go down these latter BINDs in parallel supplying + arguments to the BIND which was the first argument (MAP function). + When any of the argument BINDs is empty, the MAP returns. + MAPs can be RETURNed from with RETURN. + +File: INIT Node: ODDS Previous: FCNS Up: TOP + +IX. Odds and Ends + + 1. Spaces at top level within a AND/OR/PROG are ignored. + 2. Syntax errors are reported if possible. More likely + INIT will barf obscenely. + 3. Other error checking is fairly primitive and may + improve in the future. + +File: INIT Node: ORDER Up: TOP + +Appendix I. + + The following commands have been implemented. In the +following table, FILE (and FILE1 and FILE2) should be file +names (e.g. "MARC;FOO BAR") and where two file names are +required, they should be separated by a comma. STRING +refers to any text surrounded by quotes. + The returns column indicates what kind of values the +command may return (note that some commands always succeed). + +Command Description Argument Returns + + A Append "FILE1,FILE2" T/F + C Copy "FILE1,FILE2" T/F + D Delete "FILE" T/F + E Exist "FILE" T/F + F File defaults "FILE" T + G Is console program? "STRING" T/F +;G Is console program not? "STRING" T/F + I IMAGE to TTY "FILE" T/F + J Jump to new line (^PA) T + L Line to TTY (i.e. CRLF) T + M Make file (no dump bit) "FILE" T/F + N Name to TTY "FILE" T/F + O Output to TTY "STRING" T +;O Output on new line "STRING" T + P Print file to TTY "FILE" T/F +;P Print in paged mode "FILE" T/F + Q Question "STRING" T/F +;Q Question on new line "STRING" T/F + R Rename "FILE1,FILE2" T/F + S SSVMOD "STRING" T + T TPL "FILE" T/F + U User name to TTY T + V Valret "STRING" T + W When created "FILE" T/F + + + NOOP T + - NOOP F + +: SET Q-register += READ Q-register T/F + +@< AGAIN +@> RETURN + +! Symbolic Argument + +**Special Notes** + +a. The ;P command prints a file in paged mode (a la :PR). In + this mode, INIT will --MORE-- after every control-L and + control-underbar. This mode is somewhat useful for printing + mail files. +b. The ;O and ;Q commands do a ^PA first before printing the + string/question. This puts the question at the beginning + of the line. +c. The V command has included an implicit control-W at the + start and a :VP at the end (control-V + alt-P). The + control-W can be defeated with a control-V at the start of + the valret string. +d. The G command expects as argument the name of an IMLAC console + program, ("SSV", "SST", "SSV37", "SST20", or whatever. It evals + to T if that is the program currently loaded into your IMLAC. + ;G is T if your console program is NOT the one given. Both are + FALSE if your console is not an IMLAC. + +**Special Characters** + +( BIND (= LIST) +[ PROG +[* REPEAT +[? COND +[& AND +[\ OR +[# NOT +[! MAP +[@ APPLY +[: DEFINE +] END (AND/OR/NOT/COND/REPEAT/PROG/MAP) +) END (BIND) + +^Q Quote the next character + **NOTE** All square brackets in strings must be quoted! +% Use space/rubout instead of Y/N for questions + +File: INIT Node: MUDINIT Up: TOP Next: LOAD + +MUDDLE's INIT package. + + The INIT package contains two basic programs which manhandle +DDT INIT files. With these functions and EDIT, one can create +his calls to INIT without actually writing the sometimes obscene +JCL by hand. + +* Menu: How to load, edit and dump .DDT. (INIT) files in MUDDLE + +* Loading INITs and MUDDLE translated INIT format: LOAD + What your invocation of INIT looks like in MUDDLE + +* Dumping your INIT: DUMP + +* Difference between INIT forms and real MUDDLE: DIFFS + + +File: INIT Node: LOAD Next: DUMP Previous: MUDINIT Up: MUDINIT + +I. > + + INIT-LOAD reads the file specified (or ;.DDT. (INIT)) +and attempts to find a call to INIT. If it succeeds, it parses +the JCL into MUDDLE readable format. Otherwise, it returns #FALSE (). + The MUDDLE INIT format is similar to MUDDLE format in the use +of AND, OR, and NOT. PROGs and RETURNs differ in that they do not +take an binding list. + + Other commands are given as calls to "functions" which start +with the letter of the INIT command followed by the argument +(if necessary). +Example: + The INIT JCL - [&E"MARC MAIL" P"MARC MAIL" L [\ E"FOO BAR" O"BLETCH"]] + is parsed to + + + + + >> + + Any ATOM starting with the letter which is the name of the +command will work when editing INIT-LOAD FORMs. For example, the +above example might as well be, + + + + + + >> + + INIT-LOAD returns either #FALSE () if no call to INIT occurs +in the INIT file, or a FORM (as above). This form becomes the +LVAL of the atom INIT (in ROOT). + The form may be edited as necessary to create the proper init file. + +File: INIT Node: DUMP Next: DIFFS Previous: LOAD Up: MUDINIT + +II. > + + The form defaults to .INIT and the file name defaults to +;.DDT. (INIT). + INIT-DUMP takes any form and attempts to "unparse" it into +a INIT JCL format. + If successful, it reconstructs the INIT file using this +"unparsed" JCL. + +File: INIT Node: DIFFS Previous: DUMP Up: MUDINIT + +Differences between INIT FORMs and MUDDLE structures + +a. PROG, REPEAT, and DEFINE do not take argument lists +b. MAPF does not take a final loop function and may be RETURNed from. +c. Symbolic arguments are specified > where n is 1-9. +d. APPLY takes an ATOM (Q-register) instead of a function + +**NOTE** + + INIT-DUMP must!!! follow an INIT-LOAD!!! + It will not suffice to create a random form and try to INIT-DUMP +it. This is tantamount to taking the back cover off your INIT package. + If necessary, put a dummy :INIT in your INIT file first! diff --git a/src/sysen2/init.230 b/src/sysen2/init.230 new file mode 100644 index 00000000..2097f177 --- /dev/null +++ b/src/sysen2/init.230 @@ -0,0 +1,2393 @@ +TITLE TASTEFUL INIT + +A=1 +B=2 +C=3 +D=4 +E=5 +F=6 ; A-F ARE SCRATCH AC'S + +FNM=11 ; FILE NAME 1 OR 0 +RET=12 ; JSP AC +RET1=13 ; JSP AC +RET2=14 ; JSP AC +JCLPTR=15 ; BYTE POINTER TO JCL + +AP=16 ; AND'ING STACK +P=17 ; PROCESS STACK + +OUTCHN==1 ; CURRENT OUTPUT CHANNEL +DSKCHN==2 ; PRIMARY DISK CHANNEL +D2CHAN==4 ; SECONDARY DISK CHANNEL +TTYI==3 +TTYO==1 + +$STOP=400000 ; DON'T CONTINUE THIS LEVEL +$AND=200000 ; AND CONSTRUCTION +$OR=100000 ; OR CONSTRUCTION +$COND=40000 ; COND CONSTRUCTION +$CLAUSE=20000 ; ONCE ONLY CLAUSE FLAG +$NOT=10000 ; NOT CONSTRUCTION +$REPEAT=4000 ; REPEAT CONSTRUCTION +$BIND=2000 ; BIND HACK FOR CONDS +$MAPF=1000 ; MAPF CONSTRUCTION +$ARG=400 ; ARGUMENT ON STACK +$FCN=200 ; FUNCTION ON STACK +$MAPARG=100 ; LAST ARGUMENT TO MAPF (HACK) +$BLOCK=40 ; TOP OF ARGUMENT BLOCK +$NOFRM=$COND+$ARG+$CLAUSE+$NOT+$OR+$AND+$BIND + ; THESE DON'T HACK AGAIN & REPEAT + +LOC 40 + 0 + JSR UUOH + JSR TSINT +LOC 100 + + +SUBTTL VARIABLES + +IMGFLG: 0 ; -1 IF TTY IS IN IMAGE MODE +PRTFLG: 0 ; -1 IF FILE IS BEING PRINTED +STRFLS: 0 ; -1 IF AN ARGUMENT IS FLUSHED +DSKFLG: 0 ; -1 IF CHANNEL OPEN +ENDSW: 0 ; -1 IF FILE NAME TERMINATED +LSTOUT: 0 ; -1 IF LAST OUT IS FALSE +PAGFLG: 0 ; -1 IF IN PAGED MODE +MODFLG: 0 ; -1 IS MODIFIER FLAG +RQUOTE: 0 ; -1 IF QUOTE SEEN IN READER +PUSHSW: 0 ; -1 IF JCL IO PUSH IN EFFECT +IMLAC: 0 ; 0 IF IMLAC, -1 ELSE + +PRMPT1: 0 ; PROMPT FOR READER +FRMCNT: 0 ; FRAME COUNTER +AFFIRM: "Y ; AFFIRMATION CHARACTER +NEGATE: "N ; NEGATION CHARACTER +FFMAP: 0 ; POINTER TO DIR BUFFER +JCLSAV: 0 ; SAVED JCL POINTER +JCLPSH: 0 ; SAVED JCL POINTER FOR IO PUSH +EXCLHK: 0 ; SAVED JCL POINTER FOR ARGUMENT HACKS +CTRLJ: 0 ; SAYS OUTPUT CONTRL-J RIGHT +HPOS: 0 ; HORIZONTAL POSITION (FOR OHPOS) +UUOD: 0 ; UUO +UUOE: 0 ; UUO +BASE: 0 ; UUO +TTYOPT: 0 ; TTYOPT VARIABLE FOR TTY +XCTRUB: 0 ; RUBOUT HANDLER +NAMESV: 0 ; TEMPORARY FOR CTRL-X AND CTRL-U +NAME: 0 ; TEMPORARY FOR FILE NAME PARSER + +DEVICE: 0 ; BLOCK FOR FILE NAMES + 0 +DIRECT: 0 + 0 +FNAME1: 0 + 0 +FNAME2: 0 + 0 + +SYSDEV: SIXBIT /DSK/ ; BLOCK FOR SYSTEM DEFAULTS +SYSDIR: 0 +SYSFN1: 0 +SYSFN2: SIXBIT /MAIL/ + +APDLLN==400 +INPBLN==50 +QREGLN==6 + +INPBUF: BLOCK 2000 ; BUFFER FOR FILE PRINTING +DIRBUF: BLOCK 200. ; BLOCK FOR FILE NAMES +JCLBUF: BLOCK 400. ; BUFFER FOR JCL + 0 +APDL: BLOCK APDLLN ; AND/OR/PROG STACK +GLOTOP: BLOCK <26.*QREGLN> ; Q-REGISTERS (FOR HYSTERICAL REASONS) +STRBUF: BLOCK INPBLN ; INPUT BUFFER +PDL: BLOCK 30 ; PROCESS STACK +VALBUF: BLOCK 20 ; BLOCK FOR VALRETS + + +SUBTTL MACROS + +DEFINE DBP X ;DECREMENT BYTE POINTER + ADD X,[070000,,0] + JUMPGE X,.+3 + SOS X + HRLI X,010700 +TERMIN + +DEFINE PREDEF NM,VAL +ZZZ==. +LOC GLOTOP+<6*<"NM-101>> + $FCN,,0 + 440700,,[ASCIZ /!VAL!/] +LOC ZZZ +TERMIN + +DEFINE COMMAND CHR,LOC + CHR,,LOC +TERMIN + +DEFINE CHOMP LOSSAGE\ + OASCR [0] + OASCR [ASCIZ /!LOSSAGE!/] + JRST NERROR +TERMIN + +DEFINE ERROR LOSSAGE\ + ERRUUO [ASCIZ /!LOSSAGE!/] +TERMIN + +DEFINE LOSE + .LOSE 1000 +TERMIN + +DEFINE FATINS LOSS\ + .VALUE [ASCIZ /: FATAL ERROR !LOSS!  +/] +TERMIN + + +SUBTTL MAIN PROGRAM LOOP + +START: MOVE P,[-30,,PDL-1] + .BREAK 12,[5,,JCLBUF] + .SUSET [.RXUNAM,,A] + MOVEM A,SYSFN1 + MOVEM A,SYSDIR + MOVE JCLPTR,[440700,,JCLBUF] ; SET UP JCL BUFFER POINTER + MOVE AP,[-APDLLN,,APDL+1] + MOVEM JCLPTR,-1(AP) + PUSHJ P,TTYOPN + +INIT: JSP RET,GETCHR ; GET THE NEXT CMD + JRST QUIT ; DONE + CAIL B,"a + CAILE B,"z + CAIA ; UPPER CASE + TRZ B,40 + SUBI B,FSTCOM ; CREATE TABLE POINTER + JUMPL B,NONE ; ILOPR + CAILE B,LSTCOM-FSTCOM + JRST NONE ; ILOPR + HRRZ B,JCLCOM(B) ; TABLE ENTRY +DISPAT: PUSHJ P,(B) ; EXECUTE THE CMD +INLOSE: SKIPA B,LOSINS ; COME HERE IF CMD LOSES +INWIN: MOVE B,WININS ; COME HERE IF CMD WINS + SETZM MODFLG ; CLEAR MODIFIER FLAG + SETOM LSTOUT ; SET LAST OUT + CAME B,LOSINS + SETZM LSTOUT + MOVE A,(AP) + TLNE A,$CLAUSE ; IS THE FIRST CLAUSE OF A COND? + JRST CLSHAK + TLNE A,$NOT ; OR A NOT? + JSP RET1,NOTHAK + XCT B ; CONTINUE? + JRST INIT ; YES +INSTOP: MOVSI A,$STOP + IORM A,(AP) ; SET THE STOP FLAG + PUSHJ P,LEVFLS ; FLUSH JCL TO END OF THIS FRAME + JRST FINIS ; TERMINATE TASTEFULLY + +NOTHAK: MOVSI C,$STOP+$AND ; SET UP 'AND' WHICH HAS FAILED + CAME B,WININS + MOVSI C,$STOP+$OR ; SET UP 'PROG' WHICH HAS WON (TAA/EBM 9/12) + HLLM C,(AP) + JRST (RET1) + +CLSHAK: TLZ A,$CLAUSE ; TURN OFF THE CLAUSE BIT + MOVEM A,(AP) ; AND SAVE THIS (NOW A PROG) + CAME B,WININS ; DID WE SUCCEED? + JRST INSTOP ; NO. STOP THIS CLAUSE + MOVSI A,$STOP ; STOP THE COND, I WANT TO GET OFF + IORM A,-6(AP) ; TO STOP THE COND CLAUSE + JRST INIT ; WIN. CONTINUE + +LOSINS: TLNN A,$AND ; INSTRUCTION TO XCT FOR LOSER +WININS: TLNN A,$OR ; INSTRUCTION TO XCT FOR WINNER + + +SUBTTL CONTROL STRUCTURE + +; HERE TO HANDLE OPEN BRACKETS OF ANY KIND +; FRAMES ARE CREATED, AND SPECIAL HACKS ARE PERFORMED +; TO HANDLE SPECIAL CASES (I.E. MAPF, DEFINE, ETC.) + +PUSHSP: MOVSI C,$BIND + CAIA +PUSHIT: SETZ C, + POP P, + SKIPGE (AP) + JRST [PUSHJ P,LEVFLS + JRST FLGCLR] + MOVE A,JCLPTR + ILDB B,A ; DO A NXTCHR + JSP RET1,MKFRAM ; MAKE A FRAME FOR THIS + CAIN B,"* ; CHECK NEXT CHARACTER AND SET FLAGS + MOVSI C,$REPEAT + CAIN B,"! + MOVSI C,$MAPF+$BLOCK + CAIN B,"? + MOVSI C,$COND + CAIN B,"# + MOVSI C,$NOT + TLNE C,$BIND + JRST .+3 + CAIN B,"@ + JRST APPLY + CAIN B,"& + MOVSI C,$AND + CAIN B,"\ + MOVSI C,$OR + CAIN B,": + MOVSI C,$FCN + TLNE C,$BIND + JRST PUSHT1 ; DON'T READ CHARACTER FOR BIND + SKIPE C + ILDB B,JCLPTR ; DO A READCHR TO FLUSH IT +PUSHT1: MOVEM JCLPTR,-1(AP) ; SAVE JCL POINTER + MOVE D,-6(AP) ; LAST FRAME + TLNE D,$COND + JRST CNDCHK ; SPECIAL HACK IF LAST WAS COND + TLNE C,$FCN + JRST DEFIN ; SPECIAL HACK FOR DEFINE + TLNE D,$MAPARG + TLO C,$FCN+$REPEAT ; SPECIAL HACK FOR MAPF'AGE + TLNE C,$MAPF + JRST MAPFHK ; SPECIAL HACK FOR MAPF'AGE +PUSHT2: HLLM C,(AP) ; MOVE THE SPECIAL BITS +FLGCLR: SETZM DSKFLG ; AND CLEAR FLAGS + .CLOSE DSKCHN, + JRST INIT + +; MAKE SURE COND IS GIVEN CORRECT ARGUMENTS + +CNDCHK: JUMPE C,CNDCK1 ; CONDS MUST TAKE PROGS OR BINDS + TLNN C,$BIND + JRST CNDERR ; ELSE ERROR +CNDCK1: TLO C,$CLAUSE ; SET THE CLAUSE BIT + JRST PUSHT2 ; AND CONTINUE + +; HERE TO HACK THE INITIAL CALL TO MAPF +; CREATE ARGUMENT BLOCK ON THE STACK +; AND FIX UP POINTERS TO THE FIRST SET OF ARGUMENTS + +MAPFHK: HLLM C,(AP) + PUSH P,JCLPTR + JSP RET,GETCHR ; GET A CHARACTER + JRST UNEXP + CAIE B,"( + CAIN B,"[ + JRST MPGARG + JRST NOARG +MPGARG: PUSHJ P,LEVFLS ; CLEAR A PATH TO THE ARGS + JSP RET,GETCHR ; GET A CHARACTER + JRST UNEXP + CAIE B,"( ; DO WE HAVE AN ARGUMENT? + JRST [MOVSI B,$MAPARG + IORM B,(AP) + POP P,JCLPTR + JRST FLGCLR] ; RETURN + JSP RET1,MKFRAM + MOVEM JCLPTR,-1(AP) ; SAVE JCL POINTER + MOVSI B,$ARG + HLLM B,(AP) ; AND BITS + JRST MPGARG + +; COME HERE TO DEFINE A FUNCTION +; SAVE THE JCL POINTER IN THE CORRECT Q-REGISTER + +DEFIN: JSP RET1,GETQRG ; GET THE REGISTER + JUMPL B,ILLATM + MOVEM C,GLOTOP(B) ; SAVE BITS + MOVEM JCLPTR,GLOTOP+1(B) ; AND POINTER + PUSHJ P,LEVFLS ; FLUSH JCL FOR THIS FRAME + JRST FINIS + +; COME HERE TO APPLY A FUNCTION +; CREATE THE ARGUMENT FRAMES AND RUN + +APPLY: MOVEM JCLPTR,-1(AP) + ILDB JCLPTR ; FLUSH THE @ + JSP RET1,GETQRG ; GET A REGISTER + JUMPL B,ILLATM ; ILLEGAL REGISTER + PUSH P,B + MOVE A,GLOTOP(B) ; GET THE TYPE WORD + TLNN A,$FCN + JRST NONAPP ; NON FUNCTION? + MOVSI C,$BLOCK + HLLM C,(AP) ; CALL THIS A BLOCK FRAME + MOVEM JCLPTR,-1(AP) ; AND SAVE JCL POINTER +APPLP: PUSHJ P,GETARG ; GET THE NEXT ARGUMENT + JRST APPDON + JSP RET1,MKFRAM ; AND PUT IT ON THE STACK + MOVSI C,$ARG + HLLM C,(AP) + MOVEM A,-1(AP) + JRST APPLP ; KEEP GOING + +APPDON: JSP RET1,MKFRAM ; NO MORE ARGUMENTS + POP P,B + MOVE C,GLOTOP+1(B) ; PUT THE FCN ON THE STACK + MOVEM C,-1(AP) + MOVE JCLPTR,C ; SET JCL POINTER TO HERE + MOVSI C,$FCN + HLLM C,(AP) ; MAKE THIS A FCN + JRST INIT ; AND RUN + +; PUSHJ P,GETARG +; RETRIEVE AN ARGUMENT FROM A FUNCTION CALL +; ARGUMENT IS IN A + +GETARG: MOVEM JCLPTR,JCLSAV ; SAVE JCL POINTER AWAY + JSP RET,GETCHR + JRST UNEXP + CAIE B,"+ + CAIN B,"- + JRST GETRG2 + CAIN B,"" + JRST GETRG1 ; ARGUMENTS MUST BE IN QUOTES + DBP JCLPTR ; RESTORE THE JCL POINTER + POPJ P, + +GETRG1: PUSHJ P,SKPSTR +GETRG2: MOVE A,JCLSAV ; DONE. RESTORE THE JCL POINTER +POPJ1: AOS (P) +CPOPJ: POPJ P, + +; HERE TO HANDLE CLOSED BRACKETS OF ANY KIND +; FLUSH THE FRAME AND RETURN THE CORRECT VALUE + +POPIT: POP P, +FINIS: SETZM DSKFLG ; CLEAR FLAGS + .CLOSE DSKCHN, + POP AP,A ; RESTORE THE SPECIAL BITS + TLNE A,$REPEAT ; MAPFs AND REPEATS END UP WINNING + JRST RAGAIN ; THIS IS REPEAT. HACK SPECIALLY + TLNE A,$FCN + JRST POPFCN ; THIS IS FCN. FLUSH TASTEFULLY + POP AP,C ; SAVED JCL POINTER + POP AP,SYSFN2 ; AND FILE DEFAULTS + POP AP,SYSFN1 + POP AP,SYSDIR + POP AP,SYSDEV + MOVE B,[SKIPGE LSTOUT] ; FOR MOST, RETURN LAST OUT + TLNE A,$AND + MOVE B,[JUMPGE A,INWIN] ; FOR AND, CONTINUE IF WINNING + TLNE A,$OR + MOVE B,[JUMPL A,INWIN] ; FOR OR, CONTINUE IF LOSING + XCT B + JRST INLOSE ; REPORT LOSSAGE + JRST INWIN ; REPORT WINNAGE + +; HERE TO FLUSH FUNCTION CALLS + +POPFCN: PUSH AP,A ; REPUSH THE POPPED BITS +POPFC1: SUB AP,[6,,6] ; POP OFF DOWN TO THE $BLOCK + MOVE A,(AP) + TLNN A,$BLOCK + JRST POPFC1 + MOVE JCLPTR,-1(AP) ; RESTORE THE JCL POINTER FROM HERE + PUSHJ P,LEVFLS ; FLUSH JCL FOR THIS FRAME + JRST FINIS ; AND RETURN + +; HERE TO AGAIN AFTER A REPEAT IS TERMINATED + +RAGAIN: PUSH AP,A ; RESAVE + TLNE A,$FCN + JRST MAGAIN ; MAPF HACK + MOVE JCLPTR,-1(AP) ; RESTORE THE JCL POINTER + JRST INIT + +; HERE TO RESTART A MAPF AND RESET THE ARGUMENTS + +MAGAIN: PUSH P,AP ; SAVE STACK POINTER +MAGLP: SUB AP,[6,,6] ; WALK UP THE STACK + MOVE A,(AP) + TLNE A,$BLOCK ; BLOCK MARKS TOP OF ARGUMENTS + JRST MAGDON ; MUST BE DONE + MOVE JCLPTR,-1(AP) ; GET THE POINTER + JSP RET,GETCHR + JRST UNEXP + CAIE B,"" ; ARGUMENT HERE? + JRST NOARG ; NO. TERMINATE THE MAPF + PUSHJ P,SKPSTR ; SKIP OVER THIS STRING + MOVEM JCLPTR,-1(AP) ; AND SAVE THE POINTER + JSP RET,GETCHR + JRST UNEXP + CAIE B,"" ; ARE WE DONE YET? + JRST MFINIS ; YES. FINALLY. + JRST MAGLP ; I.E. REST THE 'LIST' + +MAGDON: POP P,AP ; RESTORE THE STACK + MOVE JCLPTR,-1(AP) ; AND JCL POINTER + JRST INIT ; AND AGAIN ... + +; HERE IF ARGUMENTS ARE EXHAUSTED. RETURN FROM THE MAPF + +MFINIS: SUB AP,[6,,6] ; FLUSH ALL FRAMES BACK TO BLOCK + MOVE A,(AP) + TLNN A,$BLOCK ; BLOCK IS REALLY THE MAPF FRAME + JRST MFINIS + MOVE JCLPTR,-1(AP) ; GET BACK JCL POINTER + PUSHJ P,LEVFLS ; FLUSH THE MAPF + JRST FINIS + +; HERE TO AGAIN/RETURN +; C HAS THE CHARACTER > OR < WHICH DECIDES WHAT TO DO + +AGAIN: JSP RET1,GETQRG + JUMPGE B,AGNACT +AGAIN1: MOVE A,(AP) ; GET LAST SPECIAL BIT WORD + TLNE A,$NOFRM + JRST [SUB AP,[6,,6] + JUMPGE AP,NOTPRG + JRST AGAIN1] + MOVE JCLPTR,-1(AP) ; RESTORE JCL POINTER + MOVSI A,-5(AP) ; RESTORE FILE DEFAULTS + HRRI A,SYSDEV + MOVE D,A + BLT D,3(A) + POP P, + CAIE C,"> ; WHAT FORM OF OBSCENITY? + JRST INIT +GOAWAY: SUB AP,[2,,2] + POP AP,SYSFN2 ; AND FILE + POP AP,SYSFN1 + POP AP,SYSDIR + POP AP,SYSDEV + PUSHJ P,LEVFLS + JRST FLGCLR + +AGNACT: CHOMP UNIMPLEMENTED FEATURE + + +SUBTTL CONTROL STRUCTURE UTILITY ROUTINES + +; PUSHJ P,SKPSTR +; TO SKIP OVER A STRING + +SKPSTR: ILDB A,JCLPTR ; SKIP PAST THE ARGUMENT + CAIN A,^Q + JRST [ILDB A,JCLPTR + JRST SKPSTR] + CAIE A,"" + JRST SKPSTR + POPJ P, + +; JSP RET2,ARGH +; HERE TO REQUEST AN ARGUMENT. CHECKS WHETHER THE ARGUMENT +; IS SYMBOLIC AND IF SO, GETS HOLD OF IT + +ARGH: JSP RET,GETCHR ; GET A CHARACTER + JRST UNEXP + SETZM EXCLHK ; CLEAR THE EXCL FLAG + CAIN B,73 ; HANDLE OPTIONALS + JRST [SETOM MODFLG + ILDB B,JCLPTR + JRST .+1] + CAIN B,"! + JSP RET1,EXCLER ; GET THE ARGUMENT + CAIN B,"= + PUSHJ P,INPUSH + POPJ P, + +; PUSHJ P,INPUSH +; HERE TO DO AN INPUSH + +INPUSH: JSP RET1,GETQRG + MOVEM JCLPTR,EXCLHK + MOVE JCLPTR,GLOTOP(B) + JSP RET,GETCHR + JRST UNEXP + POPJ P, + +; HERE FOR OCCURANCES OF ! AT TOP LEVEL +; THESE MUST BE NON-STRING ARGUMENTS (T OR FALSE) + +EXCLCM: JSP RET1,EXCLER + CAME JCLPTR,[-1] + AOS (P) + MOVE JCLPTR,EXCLHK + POPJ P, + +; JSP RET1,EXCLER +; GET A SYMBOLIC ARGUMENT + +EXCLER: ILDB C,JCLPTR ; READ THE SYMBOLIC ARGUMENT + CAIGE C,"9 + CAIGE C,"0 + JRST UNBOUND ; BETTER BE 0-9 + MOVEM JCLPTR,EXCLHK ; SAVE REAL POINTER + PUSH P,AP ; SAVE STACK POINTER +EXCLLP: SUB AP,[6,,6] ; MARCH DOWN STACK + MOVE A,(AP) ; LOOKING FOR A $BLOCK + TLNN A,$BLOCK + JRST EXCLLP + SUBI C,"0 + JUMPE C,UNBOUND ; MUST BE 1-9, REALLY + SETZ D, +EXLLP2: ADDI D,1 ; D IS COUNTER OF ARGUMENTS + ADD AP,[6,,6] ; LOOK FOR CORRECT ARGUMENT NUMBER + MOVE A,(AP) + TLNN A,$ARG + JRST EXCLR2 ; END OF ARGUMENTS. LOST? + CAME C,D + JRST EXLLP2 + JSP RET,GETCHR ; GET THE NEXT CHARACTER + JRST UNEXP + CAIN B,"" ; IS IT A STRING? + JRST [PUSHJ P,SKPSTR ; YES. THIS IS OPTIONAL ARGUMENT + MOVEM JCLPTR,EXCLHK ; FLUSH THE STRING AND SAVE NEW POINTER + JRST .+1] + CAIE B,"+ ; FLUSH THE DEFAULT IF GIVEN + CAIN B,"- + IBP EXCLHK + MOVE JCLPTR,-1(AP) ; FOUND THE ARGUMENT. POINT TO IT + JSP RET,GETCHR + JRST UNEXP + CAIN B,"+ + JRST EXCLR3 + CAIN B,"- + JRST EXCLF1 + POP P,AP ; RESTORE THE STACK + JRST (RET1) ; AND RETURN POINTING CORRECTLY + +EXCLR2: SKIPN MODFLG ; DEFAULT ARGUMENT SUPPLIED? + JRST UNBOUND ; NO. CHOMPER. + JSP RET,GETCHR ; NEXT CHARACTER BETTER BE QUOTE! + JRST UNEXP + MOVEM JCLPTR,EXCLHK + CAIN B,"+ + JRST EXCLR3 + CAIN B,"- + JRST EXCLF1 + SETZM EXCLHK ; NOT HACKED +EXCLR3: POP P,AP ; RESTORE STACK + JRST (RET1) ; FINGERS CROSSED + +EXCLF1: SETOM JCLPTR + JRST EXCLR3 + +; CREATE AN EMPTY FRAME AND PUT IT ON THE STACK + +MKFRAM: PUSH AP,SYSDEV ; DEVICE + PUSH AP,SYSDIR ; SNAME + PUSH AP,SYSFN1 ; FILE NAME 1 + PUSH AP,SYSFN2 ; FILE NAME 2 + PUSH AP,[0] ; SLOT FOR JCL POINTER + AOS RET2,FRMCNT ; UNIQUE FRAME COUNTER + PUSH AP,RET2 ; MAKE A FRAME + JRST (RET1) + +; COME HERE TO FLUSH ALL BETWEEN MATCHED SQUARE BRACKETS +; THIS IS USED TO SKIP AN ENTIRE CONSTRUCTION + +LEVFLS: SETZ A, +LEVFL1: ILDB B,JCLPTR + JUMPE B,CPOPJ + CAIN B,^Q ; ALLOW FOR QUOTING + ILDB B,JCLPTR + CAIE B,"( + CAIN B,"[ + AOJ A, + CAIE B,"] + CAIN B,") + JRST [SOJGE A,LEVFL1 + JRST CPOPJ] + JRST LEVFL1 + +; GET THE NEXT CHARACTER AND TURN IT INTO A Q-REGISTER POINTER +; FATAL IF ILLEGAL NAME (ILLEGAL ATOM) + +GETQRG: ILDB B,JCLPTR ; GET THE CHAR + CAIE B,"> ; SPECIAL HACK FOR > AND < + CAIN B,"< ; IS RETURN AND AGAIN + JRST [MOVE C,B + SETO B, ; RETURN -1 FOR THESE + JRST (RET1)] + TRZ B,40 + SUBI B,"A + JUMPL B,ILLATM + CAILE B,26. + JRST ILLATM + IMULI B,QREGLN ; RETURN POINTER TO Q-REGISTER + JRST (RET1) + + +SUBTTL COMMANDS + +FSTCOM="! +JCLCOM: COMMAND "!,EXCLCM + COMMAND "",NONE + COMMAND "#,NONE + COMMAND "$,NONE + COMMAND "%,YNSET ; SET THE YES/NO DEFAULT + COMMAND "&,NONE ; RESERVED FOR [& + COMMAND "',NONE + COMMAND "(,PUSHSP ; BIND PARENS + COMMAND "),POPIT ; BIND PARENS + COMMAND "*,NONE ; REPEAT CONSTRUCTION + COMMAND "+,POPJ1 ; RETURN T IMMEDIATE + COMMAND "!,NONE ; DONT USE THIS ONE + COMMAND "-,CPOPJ ; RETURN FALSE IMMEDIATE + COMMAND ".,NONE ; SET A TAG + COMMAND "/,NONE + COMMAND "0,NONE ; SYMBOLIC ARG + COMMAND "1,NONE ; SYMBOLIC ARG + COMMAND "2,NONE ; SYMBOLIC ARG + COMMAND "3,NONE ; SYMBOLIC ARG + COMMAND "4,NONE ; SYMBOLIC ARG + COMMAND "5,NONE ; SYMBOLIC ARG + COMMAND "6,NONE ; SYMBOLIC ARG + COMMAND "7,NONE ; SYMBOLIC ARG + COMMAND "8,NONE ; SYMBOLIC ARG + COMMAND "9,NONE ; SYMBOLIC ARG + COMMAND ":,SETG ; SET A Q-REGISTER + COMMAND 73,MODIFY ; MODIFICATION + COMMAND "<,NONE ; WITH @< + COMMAND "=,GVAL ; READ A Q-REGISTER + COMMAND ">,NONE ; WITH @> + COMMAND "?,NONE ; COND CONSTRUCTION + COMMAND "@,AGAIN ; GO SOMEWHERE + COMMAND "A,APPEND ; APPEND "FILE1,FILE2" + COMMAND "B,READER ; CHECK READER FILES + COMMAND "C,COPY ; COPY "FILE1,FILE2" + COMMAND "D,DELETE ; DELETE "FILE" + COMMAND "E,EXIST ; EXIST "FILE" + COMMAND "F,DEFAUL ; SET DDT DEFAULTS + COMMAND "G,CNSCHK ; CONSOLE PRGM "XXX"? + COMMAND "H,HSTYQ ; T IF ON STY + COMMAND "I,IMAGE ; PRINT "FILE" IN IMAGE MODE + COMMAND "J,NLOUT ; LIKE O, BUT NEW LINE FIRST + COMMAND "K,CLRSCR ; CLEAR SCREEN + COMMAND "L,CRLF ; CR + COMMAND "M,MAKFIL ; MAKE "FILE" + COMMAND "N,FNAME ; FILE NAME OF "FILE" + COMMAND "O,OUTPUT ; OUTPUT "STRING" + COMMAND "P,PRINT ; PRINT "FILE" + COMMAND "Q,ASKME ; ASK "STRING" + COMMAND "R,RENAME ; RENAME "FILE1,FILE2" + COMMAND "S,SSVMOD ; SSVMOD "STRING" + COMMAND "T,TPL ; TPL "FILE" + COMMAND "U,USER ; PRINT MY USER NAME + COMMAND "V,VALRET ; VALRET "STRING" + COMMAND "W,CDATE ; WHEN? "FILE" + COMMAND "X,READCH ; READ CHARACTER FROM TTY + COMMAND "Y,READST ; READSTRING FROM TTY + COMMAND "Z,EQSTR ; EQUALSTRING + COMMAND "[,PUSHIT ; OPEN BRACKET + COMMAND "\,NONE ; DO NOT USE + COMMAND "],POPIT ; CLOSE BRACKET + +LSTCOM="] + + +SUBTTL USER COMMANDS + +; H COMMAND: WIN IF ON STY +HSTYQ: .CALL [SETZ + SIXBIT /CNSGET/ + MOVEI TTYI + MOVEM A + MOVEM A + MOVEM B ; TCTYP + MOVEM A + MOVEM A + SETZM A] ; TTYTYP VARIABLE + .LOSE %LSSYS + CAIN B,%TNSFW ; SKIP IF NOT SOFTWARE (-->SUPDUP OR LOCAL) + POPJ P, + TRNN A,%TYSTY ; SKIP IF ON STY + POPJ P, + JRST POPJ1 + +; U COMMAND +; PRINT XUNAME + +USER: .SUSET [.RXUNAM,,A] + OSIX A + JRST POPJ1 + +; K COMMAND +; CLEAR THE SCREEN + +CLRSCR: OCTLP "C + JRST POPJ1 + +; L COMMAND +; CRLF TO THE TTY + +CRLF: OASCR [0] + JRST POPJ1 + +; F COMMAND +; SET THE DDT FILE NAME DEFAULTS + +DEFAUL: JSP RET2,FSTARN + MOVE A,DEVICE + MOVE B,DIRECT + MOVE C,FNAME1 + MOVE D,FNAME2 + .BREAK 12,[..SPFILE,,A] + JRST POPJ1 + +; V COMMAND +; VALRET TO DDT + +VALRET: MOVE F,[440700,,VALBUF] +;; MODFIED V COMMAND STUFF BY EBM, 7/23/77 + SKIPE MODFLG + JRST VALRT1 + MOVEI A,^W + IDPB A,F +VALRT1: JSP RET,GETCHR + JRST UNEXP + CAIE B,"" + JRST NOARG +VALLP: ILDB A,JCLPTR + CAIN A,^Q + JRST [ILDB A,JCLPTR + JRST VALOUT] + CAIN A,"^ + JRST [ILDB A,JCLPTR + TRZ A,140 + JRST VALOUT] + CAIN A,"" + JRST VALGO +VALOUT: IDPB A,F + JRST VALLP + +VALGO: SKIPE MODFLG + JRST [MOVE A,[440700,,[ASCIZ / +P/]] + JRST VALADD] + MOVE A,[440700,,[ASCIZ / +:VP +/]] +VALADD: ILDB B,A + IDPB B,F + JUMPN B,VALADD + .VALUE VALBUF + JRST POPJ1 + +; : COMMAND +; HANDLE SETG'ING Q-REGISTERS + +SETG: JSP RET1,GETQRG ; GET A Q-REGISTER + MOVE A,LSTOUT + MOVEM A,GLOTOP(B) ; STORE LAST-OUT + SETZM GLOTOP+1(B) ; CLEAR JCL POINTER WORD + JRST HKEXIT + +; = COMMAND +; HANDLE GVAL'ING Q-REGISTERS + +GVAL: JSP RET1,GETQRG ; GET THE Q-REGISTER + SKIPL GLOTOP(B) ; IS IT FALSE + AOS (P) ; YES. RETURN T + POPJ P, ; RETURN <> + +; J COMMAND +; GO TO THE NEXT LINE ON THE TTY + +NLOUT: JSP RET1,NEWLIN + JRST POPJ1 + +NEWLIN: ;;;SKIPE IMLAC + ;;;JRST [OASCR [0] ; PRINT CRLF IF NOT IMLAC + ;;;JRST (RET1)] (CHOMP, CHOMP) + .IOT TTYO,[^P] ; DO NEW LINE + .IOT TTYO,["A] + JRST (RET1) + +; O COMMAND +; PRINT THE FOLLOWING CRUFT TO THE TTY + +OUTPUT: PUSHJ P,ARGH + SKIPE MODFLG ; NEW LINE IF MODIFIED + JSP RET1,NEWLIN +OUTLP: ILDB A,JCLPTR + CAIN A,^Q + JRST [ILDB A,JCLPTR + JRST OUTOUT] + JUMPE A,UNEXP + CAIN A,"^ + JRST [ILDB A,JCLPTR + TRZ A,140 + JRST OUTOUT] + CAIN A,"" + JRST [SKIPE EXCLHK + MOVE JCLPTR,EXCLHK + JRST POPJ1] +OUTOUT: .IOT TTYO,A + AOS HPOS + JRST OUTLP + +; EQUALSTRING COMMAND +; SKIP RETURN IF STRING IN Q-REG EQUALS STRING ARGUMENT + +EQSTR: JSP RET1,GETQRG + JUMPL B,ILLATM + MOVE A,GLOTOP(B) ; BYTE POINTER TO STRING + JSP RET,GETCHR + JRST UNEXP + CAIE B,"" + JRST NOARG +EQLOOP: ILDB C,JCLPTR ; NEXT CHARACTER + ILDB D,A + CAIN C,"" + JRST EQUAL1 + CAME C,D + JRST EQFLS + JRST EQLOOP + +EQUAL1: JUMPN D,.+2 + AOS (P) + POPJ P, + +EQFLS: ILDB C,JCLPTR + CAIE C,"" + JRST EQFLS + POPJ P, + +; READCH COMMAND +; READ CHARACTER FROM TTY AND PUT IT IN Q-REG + +READCH: JSP RET1,GETQRG + JUMPL B,ILLATM + PUSH P,B + MOVEM JCLPTR,JCLSAV + MOVEI F,. + MOVE JCLPTR,JCLSAV + PUSHJ P,OUTPUT + JFCL + .RESET TTYI, + .IOT TTYI,D + POP P,B + MOVE A,[440700,,STRBUF] + MOVEM A,GLOTOP(B) + SETZM STRBUF + IDPB D,A + JRST POPJ1 + +; READSTRING COMMAND +; READ INPUT FROM TTY AND PUT THE POINTER IN Q-REG + +READST: JSP RET1,GETQRG ; GET Q-REGISTER + PUSH P,B ; SAVE POINTERS + MOVEM JCLPTR,JCLSAV ; SAVE JCL POINTER + MOVEI F,. ; MAKE ACTIVATION + MOVE JCLPTR,JCLSAV + PUSHJ P,OUTPUT ; OUTPUT PROMPT + JFCL ; HUH + PUSHJ P,GETLIN ; READ A LINE + POP P,B + JUMPE C,CPOPJ + MOVE A,[440700,,STRBUF] + MOVEM A,GLOTOP(B) ; SAVE BUFFER POINTER + JRST POPJ1 + +; Q COMMAND +; ASK THE FOLLOWING QUESTION AND WIN + +ASKME: MOVEM JCLPTR,JCLSAV + MOVEI F,. + MOVE JCLPTR,JCLSAV + PUSHJ P,OUTPUT + POPJ P, + PUSHJ P,YESNO + POPJ P, + JRST POPJ1 + +; MODIFY COMMAND +; TURN ON MODIFY BIT + +MODIFY: SETOM MODFLG + JRST HKEXIT + +; % SWITCH +; COMPLEMENT (Y/N)/(SPACE/RUBOUT) "SWITCH" FOR QUESTION ANSWERS + +YNSET: MOVEI A,40 ; SEE IF WAS SPACE/RUBOUT + CAME A,AFFIRM + JRST [MOVEM A,AFFIRM ; IF NOT, SET TO SPACE/RUBOUT + MOVEI A,177 + MOVEM A,NEGATE + JRST HKEXIT] + MOVEI A,"Y ; IF WAS, SET TO Y/N + MOVEM A,AFFIRM + MOVEI A,"N + MOVEM A,NEGATE +HKEXIT: POP P, + JRST INIT + +; E COMMAND +; TELL IF A FILE EXISTS OR NOT + +EXIST: SKIPN MODFLG + JRST EXIST1 + JSP RET2,FSTARH ; TEST WITH BIT 1.5 (DON'T CHASE LINKS) SET + JRST POPJ1 + +EXIST1: JSP RET2,FSTARI + JRST POPJ1 + +; M COMMAND +; MAKE A FILE + +MAKFIL: SETZM DSKFLG + JSP RET2,FSTARO + .CALL SDMPBT + LOSE + JRST POPJ1 + +SDMPBT: SETZ + SIXBIT /SDMPBT/ + MOVEI DSKCHN + SETZI 1 + +; N COMMAND +; PRINT THE REAL FILE NAME OF A FILE + +FNAME: JSP RET2,FSTARI + .CALL RCHST + LOSE ; NO EXCUSE FOR THIS + SETZ FNM, + PUSHJ P,PFNAME + JRST POPJ1 + +RCHST: SETZ + SIXBIT /RCHST/ + MOVEI DSKCHN + MOVEM DEVICE(FNM) + MOVEM FNAME1(FNM) + MOVEM FNAME2(FNM) + SETZM DIRECT(FNM) + +; D COMMAND +; DELETES A FILE + +DELETE: JSP RET2,FSTARI ; GET THE FILE + JFCL + .CLOSE DSKCHN, + .CALL DELBLK + POPJ P, ; FILE DIDN'T EXIST OR SOMETHING + JRST POPJ1 + +DELBLK: SETZ + SIXBIT /DELETE/ + DEVICE + FNAME1 + FNAME2 + SETZ DIRECT + +; R COMMAND +; RENAMES A FILE + +RENAME: JSP RET2,FSTARI + .CLOSE DSKCHN, + .CALL RNMBLK + POPJ P, + JRST POPJ1 + +RNMBLK: SETZ + SIXBIT /RENAME/ + DEVICE + FNAME1 + FNAME2 + DIRECT + FNAME1+1 + SETZ FNAME2+1 + +; A COMMAND +; APPEND A FILE TO ANOTHER FILE + +APPEND: JSP RET2,FSTARI + MOVEI .BII + .CALL D2OPEN ; OPEN THE FILE FOR READING + JRST [MOVEI .BIO ; DOESN'T EXIST. OPEN FOR WRITING + .CALL D2OPEN + ERROR CAN'T OPEN APPEND FILE + JRST APPND2] + .CALL FILLEN ; GET THE FILE LENGTH + ERROR CAN'T GET FILE LENGTH + PUSH P,C + JUMPE C,APPND1 + SUBI C,2 ; SUB OFF TWO WORDS?? + MOVEM C,(P) + .ACCESS D2CHAN,C ; AND GO THERE + MOVE D,[-2,,A] + .IOT D2CHAN,D ; READ IN THE WORDS INTO A AND B + MOVE D,[440700,,A] ; GET A BP TO THESE + MOVEI C,10. + ILDB E,D ; NOW CHECK FOR ^C OR ^@ + CAILE E,^C + SOJG C,.-2 + JUMPE C,APPND1 ; IF HERE, NO PADDING AT ALL + MOVEI E,40 ; PAD NULLS WITH SPACES + DPB E,D + IBP D + SOJG C,.-2 +APPND1: .CLOSE D2CHAN, ; CLOSE THE OUTPUT FILE + MOVEI 100000+.BIO + .CALL D2OPEN ; OPEN IT IN WRITE-OVER MODE + ERROR CAN'T OPEN APPEND FILE +APPN1A: POP P,C ; RESTORE THE CORRECT ACCESS + JUMPE C,APPND2 + .ACCESS D2CHAN,C ; GO THERE + MOVE C,[-2,,A] + .IOT D2CHAN,C ; OUTPUT FIXED UP LAST WORDS +APPND2: MOVE A,[-2000,,INPBUF] + .IOT DSKCHN,A ; READ IN A BLOCK + JUMPGE A,APPND3 + HLRE A,A + ADDI A,2000 ; GET WORDS TRANSFERRED + MOVNS A + HRLS A ; INTO LEFT HALF + HRRI A,INPBUF + .IOT D2CHAN,A + .CLOSE D2CHAN, + JRST POPJ1 + +APPND3: MOVE A,[-2000,,INPBUF] ; BLAT IT OUT + .IOT D2CHAN,A + JRST APPND2 ; AND AGAIN + +D2OPEN: SETZ + SIXBIT /OPEN/ + MOVS + MOVEI D2CHAN + DEVICE+1 + FNAME1+1 + FNAME2+1 + SETZ DIRECT+1 + +FILLEN: SETZ + SIXBIT /FILLEN/ + MOVEI D2CHAN + SETZM C + +; C COMMAND +; COPY A FILE + +COPY: JSP RET2,FSTARI + MOVEI .BIO + .CALL D2OPEN + ERROR CAN'T OPEN COPY FILE + JRST APPND2 + +; T COMMAND +; TPL A FILE + +TPL: JSP RET2,FSTARI + .CALL TPLOPN + ERROR CAN'T OPEN TPL FILE + JRST APPND2 + +TPLOPN: SETZ + SIXBIT /OPEN/ + MOVSI .BIO + MOVEI D2CHAN + SETZ [SIXBIT /TPL/] + +; I COMMAND +; PRINT A FILE (IN IMAGE MODE) + +IMAGE: JSP RET2,FSTARI + SKIPE IMLAC + POPJ P, + .OPEN TTYO,[SIXBIT / ETTY/] ; OPEN THE TTY IN IMAGE MODE + ERROR CAN'T OPEN TTY IN IMAGE MODE + SETOM IMGFLG + PUSHJ P,FILPRT ; PRINT THE FILE + SETZM IMGFLG + .CALL TTYRST ; REOPEN THE TTY NORMALLY + ERROR CAN'T OPEN OUTPUT TTY + OCTLP "C + JRST POPJ1 + +SCPOS: SETZ + SIXBIT /SCPOS/ + MOVEI TTYO + [0] + SETZ [0] + +; HERE TO PRINT A FILE +; PGFLAG SAYS WHETHER WE ARE IN PAGED MODE + +FILPRT: OASCR [0] + SKIPE PAGFLG + OCTLP "C +FILPR1: MOVE A,[-2000,,INPBUF] + SETOM PRTFLG + .IOT DSKCHN,A + MOVEI C,<5*2000> + JUMPGE A,PROUT + .CLOSE DSKCHN, + SETZM (A) + HRRZ D,A + SUBI D,INPBUF + IMULI D,5 ; max in this buffer + MOVEI B,-2(A) + CAIGE B,INPBUF-1 + MOVEI B,INPBUF ; beginning of buffer + MOVE C,B + SUBI C,INPBUF + IMULI C,5 + HRLI B,440700 +PRCTRL: SKIPE IMGFLG + JRST PRIMG + ILDB 0,B + CAIE 0,^C + CAIN 0,^L + SKIPA + JUMPN 0,PRAOS + JRST PROUT +PRAOS: CAME C,D + AOJA C,PRCTRL + +PROUT: MOVE E,C + MOVE B,[440700,,INPBUF] + SKIPE PAGFLG + JRST PAGPRT + .CALL [SETZ + SIXBIT /SIOT/ + MOVSI %TJDIS + MOVEI TTYO + B + SETZ E] + JRST PREXIT +PROUT1: JUMPGE A,FILPR1 + JRST PREXIT + +PRIMG: SETZ E, +PRIMG1: CAMN C,D + JRST [ JUMPE E,PROUT + SUB C,E + JRST PROUT] + ILDB 0,B + CAIN 0,^C + AOJA E,PRIMG2 + SETZ E, +PRIMG2: AOJA C,PRIMG1 + +PRFLXT: OASCR [0] +PREXIT: .CLOSE DSKCHN, + SETZM PRTFLG + OASCR [0] + POPJ P, + +; HERE TO PRINT A FILE IN PAGED MODE + +PAGPRT: ILDB C,B + CAMN B,[10700,,INPBUF+1777] + PUSHJ P,PROUT2 + CAIE C,0 + CAIN C,^C + JRST PREXIT + CAIE C,^L + CAIN C,^_ + JRST PAGPR1 + .CALL [SETZ ? SIXBIT /IOT/ ? MOVSI %TJDIS ? MOVEI TTYO ? SETZ C] + JRST PREXIT + JRST PAGPRT +PAGPR1: ILDB C,B + CAMN B,[10700,,INPBUF+1777] + PUSHJ P,PROUT2 + CAIE C,0 + CAIN C,^C + JRST PREXIT + CAIE C,^M + CAIN C,^J + JRST PAGPR1 + CAIN C," + JRST PAGPR1 + PUSHJ P,MORAGE + JRST PREXIT + OCTLP "T + OCTLP "L + JRST PAGPRT+1 +PROUT2: JUMPGE A,FILPR2 + POP P,A + JRST PREXIT +FILPR2: MOVE A,[-2000,,INPBUF] + SETOM PRTFLG + .IOT DSKCHN,A + MOVE B,[440700,,INPBUF] + CAIL A, + POPJ P, + .CLOSE DSKCHN, + SETZM (A) + POPJ P, + +; P COMMAND +; PRINT A FILE (IN NORMAL MODE) + +PRINT: SETZM PAGFLG + SKIPE MODFLG + SETOM PAGFLG ; MODIFIER ==> PAGE MODE + JSP RET2,FSTARI + PUSHJ P,FILPRT + JRST POPJ1 + +; B COMMAND +; INTERPRET READER OUTPUT FILE +; AC -> VALUE +; A -> POINTER TO BUFFER +; B -> CHARACTER +; C -> NUMBER OF INBOX MESSAGES +; D -> NUMBER OF OUTBOX MESSAGES +; E -> CURRENT MESSAGE NUMBER +; F -> LAST MESSAGE NUMBER + +READER: JSP RET2,FSTARI + MOVE A,[-2000,,INPBUF] + .IOT DSKCHN,A + .CLOSE DSKCHN, + SETZM (A) + SETZB C,D + SETZ F, + MOVE A,[440700,,INPBUF] + OCTLP "A +RDLP: ILDB B,A + CAIE B,3 + CAIN B,0 + JRST RDEOF + CAIE B,^I + CAIN B,^J + JRST RDLP + CAIE B,^M + CAIN B,40 + JRST RDLP + CAIN B,"- + JRST [SETZ E, + AOJA D,RDNXT] + CAIG B,"9 + CAIGE B,"0 + JRST RDCHMP + SETZ E, + AOJA C,RDNXT0 + +RDNXT: ILDB B,A + CAIG B,"9 + CAIGE B,"0 + JRST RDNXT1 +RDNXT0: IMULI E,10. + ADDI E,-"0(B) + JRST RDNXT + +RDNXT1: CAIE B,3 + CAIN B,0 + JRST RDEOF + CAIE B,^J + JRST RDNXT + CAMN E,F + SUBI D,1 + MOVE F,E + JRST RDLP + +RDEOF: OASC [ASCIZ /You have /] + JUMPE C,RDOUT + ODEC C + OASC [ASCIZ / new message/] + CAIE C,1 + OASCI "s + JUMPE D,RDEOF1 + OASC [ASCIZ / and /] +RDOUT: ODEC D + OASC [ASCIZ / outbox message/] + CAIE D,1 + OASCI "s +RDEOF1: OASC [ASCIZ /./] + JRST POPJ1 + +RDCHMP: OASC [ASCIZ /READER file in bad format?/] + POPJ P, + +; W COMMAND +; PRINT THE CREATION DATE OF A FILE + +CDATE: JSP RET2,FSTARI + .CALL RFDATE + ERROR CAN'T READ CREATION DATE + PUSHJ P,PRDATE + OASCR [0] + JRST POPJ1 + +RFDATE: SETZ + SIXBIT /RFDATE/ + MOVEI DSKCHN + SETZM A + +; G COMMAND +; GET CONSOLE PROGRAM TYPE AND CHECK AGAINST ARG + +CNSCHK: JSP RET,GETCHR + JRST UNEXP + CAIE B,"" + JRST NOARG + SKIPE IMLAC + JRST SKPSTR ; snarf rest of useless command + .OPEN TTYO,[SIXBIT / ETTY/] + ERROR CAN'T OPEN TTY IN IMAGE MODE +; here snarf arg, usually "SSV" or "SST" + MOVE B,[440700,,C] + SETZB C,D +CNSLUP: ILDB A,JCLPTR + CAIN A,"" + JRST CNSLPX + CAIL A,"0 + CAILE A,"9 + SKIPA + JRST CNSNUM + IDPB A,B +;; CHANGED CAIE TO TLNE + TLNE B,760000 + JRST CNSLUP + ILDB A,JCLPTR + CAIE A,"" + JRST .-2 + JRST CNSLPX +; here for version number if given +CNSNLP: ILDB A,JCLPTR + CAIL A,"0 + CAILE A,"9 + JRST CNSLPX + CAIN A,"" + JRST CNSLPX +CNSNUM: IMULI D,10. + ADDI D,-60(A) + JRST CNSNLP +; ask console program who he his +CNSLPX: .RESET TTYI, ; flush any random chars hanging around + .IOT TTYO,[^A] + .IOT TTYO,[^M] + .IOT TTYI,A ; reply char 1 + .IOT TTYI,B ; reply char 2 + SETZ E, + CAME C,[ASCIZ "SSV"] + JRST .+3 + TRNN B,1_4 ; pxmit bit distinguishes + SETO E, + CAME C,[ASCIZ "STV"] + JRST .+3 + TRNE B,1_2 + MOVNI E,1 + CAME C,[ASCIZ "SST"] + JRST .+3 + TRNE B,1_4 + SETO E, + CAME C,[ASCIZ "MSE"] + JRST .+3 + TRNE B,1_5 + SETO E, + CAME C,[ASCIZ "MDL"] + JRST .+3 + TRNE B,1_6 + SETO E, +; now check version number + JUMPE D,CNSRST + CAIE D,-40(A) ; sent +40 + SETZ E, +CNSRST: .CALL TTYRST + ERROR CAN'T RESET REAL TTY + SKIPE MODFLG ; if modified, its NOT G etc. + JRST CNSNOT + SKIPE E + AOS (P) + POPJ P, + +CNSNOT: SKIPN E + AOS (P) + POPJ P, + +; S COMMAND +; DO WHAT :SSVMOD DOES + +SSVMOD: JSP RET,GETCHR + JRST UNEXP + CAIE B,"" + JRST NOARG + SKIPE IMLAC + JRST SKPSTR + .OPEN TTYO,[SIXBIT / ETTY/] + ERROR CAN'T OPEN TTY IN IMAGE MODE + SETZ B, + MOVE C,[TRO B,(D)] + +SSLOOP: ILDB A,JCLPTR + CAIN A,"" + JRST SSLOPX + CAIGE A,40 + JRST SSLOPX + CAIN A,40 + JRST SSLOOP + CAIN A,"+ + JRST [MOVE C,[TRO B,(D)] + JRST SSLOOP] + CAIN A,"- + JRST [MOVE C,[TRZ B,(D)] + JRST SSLOOP] + + TRZ A,40 ; flush case distinctions + MOVE D,MODPTR +BLOOP: CAMN A,(D) + JRST BITTER + ADD D,[1,,1] + AOBJN D,BLOOP + OASC [ASCIZ /BAD SSVMOD COMMAND/] + JRST QUIT + +SSLOPX: .IOT TTYO,[^A] + .IOT TTYO,[^O] + IORI B,100 ; make sure 100 bit is on + .IOT TTYO,B + .CALL TTYRST ; REOPEN THE REAL TTYO + ERROR CAN'T OPEN OUTPUT TTY + JRST POPJ1 + +TTYGET: SETZ + SIXBIT /TTYGET/ + MOVEI TTYI + MOVEM A + MOVEM A + MOVEM A + MOVEM A + SETZM A ; last one is TCTYP, which we want! + +BITTER: MOVE D,1(D) + XCT C + JRST SSLOOP + +MODTAB: "C ; case + 1 + "A ; auto-mode + 2 + "T ; teco cursor + 4 + "B ; blinking cursor + 10 + "M ; clear macro buffer + 20 +MODPTR: -<.-MODTAB>,,MODTAB + + +SUBTTL UTILITY ROUTINES + +QMARK: ASCIZ / ? / + +; COMMAND READER. +; PUSHJ P,GETLIN READS TO AN ALTMODE AND FILLS IN THE INPUT BUFFER +; ACCORDINGLY + +GETLIN: SETZM STRBUF ; CLEAR THE INPUT BUFFER + .RESET TTYI, +RCMD: MOVE B,[440700,,STRBUF] + MOVEI C,0 ; COUNT OF CHARACTERS +RCMD1: .IOT TTYI,A + SKIPE RQUOTE ; IN QUOTE MODE? + JRST [SETZM RQUOTE + JRST RCMDL] + CAIN A,"\ + JRST [SETOM RQUOTE + JRST RCMD1] + CAIN A,177 + JRST RUB + JUMPE A,RSTBUF + CAIN A,^D ; DISPLAY BUFFER + JRST RREPEA + CAIN A,^L ; CLEAR SCREEN AND DISPLAY BUFFER + JRST RCLEAR + CAIE A,^M + CAIN A,33 ; TERMINATE ON ALTMODE + JRST RCMDX1 +RCMDL: .IOT TTYO,A + IDPB A,B ; DEPOSIT THE CHARACTER + CAMGE B,[350700,,STRBUF+INPBLN] + AOJA C,RCMD1 ; AND MAKE SURE NOT BUFFER FULL + FATINS PDL OVERFLOW ON NON-EXPANDABLE PDL + +RCMDX: IDPB A,B ; TERMINATE GETLIN +RCMDX1: MOVEI A,0 ; DEPOSIT ZERO + IDPB A,B + POPJ P, ; EXIT + +RSTBUF: .IOT TTYO,A ; ECHO THE CHAR AND CLEAR THE BUFFER + OASCR [0] + SETZ C, + SETZM STRBUF + MOVE B,[440700,,STRBUF] + JRST REPPER + +PPRMPT: MOVE JCLPTR,JCLSAV + PUSH P,B + PUSHJ P,OUTPUT + JFCL + POP P,B + POPJ P, + +RREPEA: .IOT TTYO,A + OASCR [0] ; RETYPE LINE + JRST REPPER +RCLEAR: OCTLP "C +REPPER: PUSHJ P,PPRMPT + OASC STRBUF + JRST RCMD1 + +RUB: PUSHJ P,RUBBER + JRST RCMD + JRST RCMD1 + +RUBBER: SOJL C,CPOPJ + LDB D,B ; CHAR TO BE DELETED + MOVEI A,0 + DPB A,B ; PUT A 0 IN THE BUFFER + XCT XCTRUB ; XCT THE RUBOUT COMMAND + ADD B,[070000,,] + TLNE B,400000 + ADD B,[347777,,-1] + AOS (P) ; DECREMENT THE BP + POPJ P, ; SKIP RETURN + +RUBECH: CAIN D,177 ; ECHO A RUBOUT + JRST [OASC [ASCIZ /^?/] + POPJ P,] + OASCI (D) + POPJ P, + +RUBFLS: MOVE TTYOPT + TLNE %TOSAI + JRST RUBONE + CAIN D,177 + JRST RUBTWO + CAIL D,40 + JRST RUBONE + CAIE D,33 + CAIN D,10 + JRST RUBONE + CAIE D,^I + CAIN D,^L + JRST RUBONE +RUBTWO: OCTLP "X ; DO THE RUBOUT(S) +RUBONE: OCTLP "X + POPJ P, + +; PUSHJ P,YESNO +; IN F, A RETURN ADDRESS FOR REPRINTING PROMPT +; SKIP RETURNS IF ANSWER IS AFFIRMATIVE? + +YESNO: .RESET TTYI, + .IOT TTYI,A + CAIE A,177 + .IOT TTYO,A + CAIN A,^L + JRST [OCTLP "C + JRST YESNO1] + CAMN A,AFFIRM + JRST POPJ1 + CAMN A,NEGATE + POPJ P, + TRZ A,40 + CAMN A,AFFIRM + JRST POPJ1 + CAMN A,NEGATE + POPJ P, + OASCI "? +YESNO1: OASCR [0] + HRRM F,(P) + POPJ P, + +; JSP RET,GETCHR +; GET THE NEXT NON-SPACE(OR TAB) CHARACTER FROM JCLBUF IN B + +GETCHR: ILDB B,JCLPTR ;FIND NEXT NON-EMPTY CHARACTER + JUMPE B,(RET) + CAIN B,3 + JRST (RET) + CAIE B,40 + CAIN B,^I + JRST GETCHR + CAIN B,^M + JRST GETCHR + JRST 1(RET) + +; JRST DECOUT +; DECREMENT THE JCL BUFFER POINTER AND RETURN + +DECOUT: DBP JCLPTR + POPJ P, + +; PUSHJ P,PRDATE +; PRINTS DATE IN DISK FORMAT + +PRDATE: LDB B,[270400,,A] + OASC @MONTHS-1(B) ; MONTH + OASCI 40 + LDB B,[220500,,A] + ODEC B ; DATE + OASCI ", + ODEC [19.] + LDB B,[330700,,A] + ODEC B ; YEAR + OASC [ASCIZ / at /] + HRRZ A,A + LSH A,-1 ; SECONDS FROM MIDNIGHT + IDIVI A,3600. + MOVE E,[ASCIZ / AM/] + CAIL A,12. + MOVE E,[ASCIZ / PM/] + CAIL A,12. + SUBI A,12. + JUMPN A,PRDAT1 + MOVEI A,12. +PRDAT1: ODEC A ; HOUR + OASCI ": + IDIVI B,60. + CAIGE B,10. + OASCI "0 + ODEC B ; MINUTES + OASCI ": + CAIGE C,10. + OASCI "0 + ODEC C ; SECONDS + OASC E + POPJ P, + +MONTHS: [ASCIZ /January/] + [ASCIZ /February/] + [ASCIZ /March/] + [ASCIZ /April/] + [ASCIZ /May/] + [ASCIZ /June/] + [ASCIZ /July/] + [ASCIZ /August/] + [ASCIZ /September/] + [ASCIZ /October/] + [ASCIZ /November/] + [ASCIZ /December/] + +; PUSHJ P,PFNAME +; PRINTS FILE NAME TO TTY + +PFNAME: MOVE DEVICE(FNM) + CAMN [SIXBIT /DSK/] + JRST PFNAM1 + OSIX DEVICE(FNM) + OASCI ": +PFNAM1: OSIX DIRECT(FNM) + OASCI "; + OSIX FNAME1(FNM) + OASCI 40 + OSIX FNAME2(FNM) + POPJ P, + +; JSP RET2,FSTARI/FSTARO/FSTARN +; FIRST, PARSES THE FILE NAME AND CHECKS FOR CONTIN +; THEN DOES FILE OPENING (I=INPUT, O=OUTPUT, N=NONE) +; WILL POPJ IF ANY LOSSAGE OCCURS + +FSTARN: PUSH P,[-1] + JRST FSTAR1 + +FSTARO: PUSH P,[.BIO] + JRST FSTAR1 + +FSTARH: PUSH P,[.BII+20] ; DON'T CHASE LINKS + JRST FSTAR1 + +FSTARI: PUSH P,[.BII] +FSTAR1: PUSHJ P,FPARSE + JRST POPAJ + POP P, + JUMPL (RET2) + SKIPE DSKFLG ; IS THE FILE OPEN FLAG SET + JRST (RET2) ; YES. LEAVE + PUSH P,A + MOVE A,FNAME2 + CAMN A,[SIXBIT /*/] + PUSHJ P,FMAP ; SPECIAL HACK FOR * SECOND NAME + POP P,A + .CALL DSKOPN ; NO. OPEN IT + POPJ P, + SETOM DSKFLG ; SET FILE OPEN + JRST (RET2) + +; COME HERE TO GET THE NEXT FNAME2 FOR * MODE + +FMAP: SKIPE A,FFMAP ; POINTER TO BLOCK WITH SAME FNAME1 + JRST FMAP1 ; NO? CREATE ONE + PUSH P,B ; SOME SCRATCH AC'S + PUSH P,C + PUSH P,D + MOVE B,AP +FMAPL: HLRZ C,(B) + TRNN C,$REPEAT+$FCN + JRST [SUB B,[6,,6] + SKIPE (B) + JRST FMAPL + JRST FERR] + HRRZ C,(B) + HRLZM C,FFMAP + SETZM DIRBUF ; CLEAR THE DIRECTORY BUFFER + MOVE B,[DIRBUF,,DIRBUF+1] + BLT B,DIRBUF+177 + .CALL DIROPN ; OPEN THE DIRECTORY + LOSE + MOVE B,[-2000,,INPBUF] + .IOT DSKCHN,B ; AND GET IT + MOVE B,INPBUF+1 ; START OF NAME AREA + SUBI B,1777 + HRLZS B ; BUILD AOBJN POINTER TO DIRECTORY + HRRI B,INPBUF + ADD B,INPBUF+1 ; IN B NOW, THE AOBJN POINTER + MOVEI D,DIRBUF ; IN D, POINTER TO DIR BUFFER + +FSTMAP: MOVE C,(B) ; FILE NAME ONE + CAME C,FNAME1 ; IF THIS IS A MATCH + JRST FSTMP1 + MOVE C,1(B) ; GET FNAME2 + MOVEM C,(D) ; AND SAVE IT IN DIR BUFFER + AOJ D, +FSTMP1: ADD B,[4,,4] ; MAP THROUGH THE DIRECTORY + AOBJN B,FSTMAP + MOVEI B,DIRBUF + HRRM B,FFMAP ; SAVE POINTER TO DIR BUFFER + MOVE B,(B) + MOVEM B,FNAME2 ; FIXUP THIS FNAME2 + MOVEM B,SYSFN2 + POP P,D + POP P,C + POP P,B + POPJ P, ; AND RETURN + +FMAP1: AOS A,FFMAP ; IF BUFFER EXISTS + PUSH P,B + PUSH P,C + PUSH P,D + HLRZ D,FFMAP + MOVE B,AP +FMAP1L: HRRZ C,(B) + CAME C,D + JRST [SUB B,[6,,6] + SKIPE (B) + JRST FMAP1L + JRST .+2] + SKIPN A,(A) ; UPDATE THE POINTER AND GET FNAME2 + JRST [SUB P,[4,,4] ; IF 0, END OF DIR BUFFER + SETZM FFMAP + JRST POPAJ] ; SO RETURN + MOVEM A,FNAME2 ; SET THE NEW FNAME1 + MOVEM A,SYSFN2 + SUB P,[3,,3] + POPJ P, ; AND RETURN + +DIROPN: SETZ + SIXBIT /OPEN/ + MOVSI .BII + MOVEI DSKCHN + DEVICE + [SIXBIT /.FILE./] + [SIXBIT /(DIR)/] + SETZ DIRECT + +DSKOPN: SETZ + SIXBIT /OPEN/ + MOVS + MOVEI DSKCHN + DEVICE + FNAME1 + FNAME2 + SETZ DIRECT + +; PUSHJ P,FPARSE +; JCLBUF HAS POINTER TO JCL BUFFER +; SKIP RETURN UNLESS NO FILE NAME FOUND +; ^Q IS THE QUOTE CHARACTER +; ^X SAYS USE MY XUNAME +; ^U SAYS USE MY UNAME + +FPARSE: PUSHJ P,ARGH + CAIE B,"" + JRST DECOUT + MOVE C,JCLPTR + ILDB B,C + CAIE B,"" + SETZM DSKFLG + SETZ FNM, +FPARS1: SETZM DEVICE(FNM) + SETZM DIRECT(FNM) + SETZM FNAME1(FNM) + SETZM FNAME2(FNM) + SETZM ENDSW + +FPARSS: SKIPE ENDSW + JRST FPEND + ILDB B,JCLPTR + SKIPE PUSHSW + JUMPE B,[MOVE JCLPTR,JCLPSH + SETZM PUSHSW + ILDB B,JCLPTR + JRST .+1] + SETZM NAME ; CLEAR NAME SLOT + MOVE F,[440600,,NAME] + +FIELD: CAIE B,40 ; HERE TO GET A NAME + CAIN B,^I + JRST FNAM ; SPACE AND TAB MAKE FNAME1 AND 2 + CAIN B,", + JRST FNAM ; , --> NEXT FILE NAME + JUMPE B,CPOPJ + CAIN B,"# + JRST [JSP RET1,GETQRG + MOVEM JCLPTR,JCLPSH + MOVE JCLPTR,GLOTOP(B) + SKIPE PUSHSW + ERROR ATTEMPT TO PUSH JCL IO RECURSIVELY + SETOM PUSHSW + ILDB B,JCLPTR + JRST FIELD] + CAIN B,^X ; USE MY XUNAME + JRST [.SUSET [.RXUNAM,,NAMESV] + JRST FPARSX] + CAIN B,^U ; USE MY UNAME + JRST [.SUSET [.RUNAME,,NAMESV] + JRST FPARSX] + CAIN B,"" + JRST FTERM ; TERMINATE + CAIN B,": + JRST DEV ; DEVICE NAME + CAIN B,"; + JRST DIR ; SNAME + CAIN B,^Q + ILDB B,JCLPTR ; QUOTE THE NEXT CHARACTER + SUBI B,40 + CAIL B,100 + SUBI B,40 ; CASE CONVERSION + TLNE F,770000 ; IGNORE MORE THAN 6 CHARACTERS + IDPB B,F +FPARS2: ILDB B,JCLPTR + SKIPE PUSHSW + JUMPE B,FPARS3 + JRST FIELD + +FPARS3: MOVE JCLPTR,JCLPSH + ILDB B,JCLPTR + SETZM PUSHSW + JRST FIELD + +FPARSX: MOVE B,[440600,,NAMESV] + MOVEI D,6 +FPARSY: ILDB C,B + TLNE F,770000 + IDPB C,F + SOJN D,FPARSY + JRST FPARS2 + +DEV: MOVE A,NAME + MOVEM A,DEVICE(FNM) + JRST FPARSS + +DIR: MOVE A,NAME + MOVEM A,DIRECT(FNM) + JRST FPARSS + +FTERM: SETOM ENDSW +FNAM: MOVE A,NAME + JUMPE A,FNAM1 + SKIPE FNAME1(FNM) ; DOES HE HAVE AN FNAME1 ALREAD? + JRST [MOVEM A,FNAME2(FNM) + JRST FNAM1] + MOVEM A,FNAME1(FNM) ; NO - TRY IT AS FNAME1 +FNAM1: CAIE B,", + JRST FPARSS + MOVEI FNM,1 + JRST FPARS1 + +; COME HERE TO DO DEFAULT HACKING (WHICH IS GROSS AND DISGUSTING) +; BASICALLY, IF THE ITEM IS NOT SPECIFIED, GET IT FROM THE SYSTEM DEFAULT +; OTHERWISE, 1) IF THIS IS THE FIRST FILE, SET THE SYSTEM DEFAULT +; 2) OTHERWISE, WIN IMMEDIATE + +FPEND: SKIPE EXCLHK + MOVE JCLPTR,EXCLHK + SKIPN A,DEVICE + SKIPA A,SYSDEV + MOVEM A,SYSDEV + MOVEM A,DEVICE + SKIPN A,DIRECT + SKIPA A,SYSDIR + MOVEM A,SYSDIR + MOVEM A,DIRECT + SKIPN A,FNAME1 + SKIPA A,SYSFN1 + MOVEM A,SYSFN1 + MOVEM A,FNAME1 + SKIPN A,FNAME2 + SKIPA A,SYSFN2 + MOVEM A,SYSFN2 + MOVEM A,FNAME2 + JUMPE FNM,POPJ1 + SKIPN A,DEVICE+1 + MOVE A,SYSDEV + MOVEM A,DEVICE+1 + SKIPN A,DIRECT+1 + MOVE A,SYSDIR + MOVEM A,DIRECT+1 + SKIPN A,FNAME1+1 + MOVE A,SYSFN1 + MOVEM A,FNAME1+1 + SKIPN A,FNAME2+1 + MOVE A,SYSFN2 + MOVEM A,FNAME2+1 + SETZ FNM, + JRST POPJ1 + +; COME HERE TO OPEN UP THE INPUT AND OUTPUT TTY'S +; THE CONSOLE TYPE IS READ AND IS USED TO DETERMINE +; THE RUBOUT PROCEDURE + +TTYOPN: .CALL [SETZ + SIXBIT /OPEN/ + MOVEI TTYI + SETZ [SIXBIT /TTY/]] + ERROR CAN'T OPEN INPUT TTY + .CALL TTYRST + ERROR CAN'T OPEN OUTPUT TTY + .SUSET [.SMSK2,,[<1_TTYI>#<1_TTYO>]] + .SUSET [.SMASK,,[%PIPDL]] + .CALL CNSGET + LOSE + .CALL TTYSET ; SET UP TTY TO TAKE CONTROL CHARACTERS + LOSE + .CALL TTYGET + LOSE + SETZM IMLAC + .CALL [SETZ + 'TTYVAR + MOVEI TTYI + ['SMARTS] + SETZM B] + JRST TTYRUB ; ASSUME IMLAC + SETOM IMLAC + TLNE B,%TQIM1 + SETZM IMLAC +TTYRUB: MOVE [PUSHJ P,RUBECH] + TLNE A,%TOERS + MOVE [PUSHJ P,RUBFLS] + MOVEM XCTRUB + POPJ P, + +CNSGET: SETZ + SIXBIT /CNSGET/ + MOVEI TTYO + MOVEM + MOVEM + MOVEM + MOVEM + SETZM TTYOPT + +TTYRST: SETZ + SIXBIT /OPEN/ + [4001,,TTYO] + SETZ [SIXBIT /TTY/] + +TTYSET: SETZ + SIXBIT /TTYSET/ + MOVEI TTYI + [030303,,030303] + SETZ [030303,,030303] + + +SUBTTL VARIOUS LOSSAGES + +FERR: CHOMP FILE NAME * MODE NOT IN REPEAT? + +UNEXP: CHOMP UNEXPECTED TERMINATION OF JCL + +NOARG: CHOMP TOO FEW ARGUMENTS SUPPLIED + +CNDERR: CHOMP COND CLAUSE NOT A BIND OR PROG + +ILLATM: CHOMP ILLEGAL ATOM + +ILLFRM: CHOMP ILLEGAL FRAME + +NOTPRG: CHOMP AGAIN NOT IN PROG OR REPEAT + +UNBOUN: CHOMP UNBOUND VARIABLE + +NONAPP: CHOMP NON APPLICABLE TYPE + +NONE: CAIN B,"|-FSTCOM + JRST INIT + OASC [ASCIZ /ILLEGAL COMMAND READ - /] + TRO B,40 + ADDI B,"A + OASCI (B) + +NERROR: LDB A,JCLPTR + JUMPE A,NERR1 + DBP JCLPTR + LDB A,JCLPTR + JUMPE A,NERR1 + DBP JCLPTR +NERR1: OASC [ASCIZ / --> /] + OBPTR JCLPTR ; TRY TO PRINT THE REMAINING JCL + +QUIT: MOVE A,(AP) + TLNE A,$FCN + JRST FINIS ; THIS IS THE END OF A FUNCTION CALL + .RESET TTYI, + .CLOSE DSKCHN, + .BREAK 16,140000 + + +SUBTTL UUO HANDLERS + +; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL) + +UUOCT==0 +UUOTAB: FATINS ILLEGAL UUO + IRPS X,,[ODEC OBPTR OHPOS OCTLP OALIGN OSIX OASC OASCI OASCR OSIXS ERRUUO] + UUOCT==UUOCT+1 + X=UUOCT_33 + JRST U!X + TERMIN + +UUOMAX==.-UUOTAB + +TSINT: 0 + 0 + PUSH P,A + PUSH P,B + SKIPG A,TSINT + JRST TSINTM + TRZE A,%PIPDL + FATINS PDL OVERFLOW ON NON-EXPANDABLE PDL +TSDIS: POP P,B + POP P,A + .DISMIS TSINT+1 + +TSIN: MOVEI A,TTYI + .ITYIC A, + JFCL + CAIN A,^S + JRST TSFLS + JRST TSDIS + +TSFLS: SKIPN PRTFLG + JRST TSDIS + MOVE A,[440700,,[ASCIZ / Flushed/]] + MOVEI B,8. ; FLUSH FILE PRINTING + PUSHJ P,MESIOT + SUB P,[2,,2] + .DISMIS [PRFLXT] + +TSINTM: TRNN A,1_TTYO ; more only on output channel + JRST TSIN ; spurious interrupt? + PUSHJ P,MORAGE + JRST TSMSTP + JRST TSDIS + +MORAGE: PUSH P,A + PUSH P,B + MOVE A,[440700,,[ASCIZ /--More--/]] + MOVEI B,8. + PUSHJ P,MESIOT + .CALL [SETZ + SIXBIT /IOT/ + MOVEI TTYI + SETZ A] + LOSE + POP P,B + CAIE A,^S ; ^S is also stop + CAIN A,177 ; not rubout is continue + JRST POPAJ + .IOT TTYO,[^M] + .IOT TTYO,[^J] + POP P,A + JRST POPJ1 + +TSMSTP: MOVE A,[440700,,[ASCIZ /Flushed/]] + MOVEI B,7 + PUSHJ P,MESIOT + .CLOSE DSKCHN, + SUB P,[2,,2] + .DISMIS [CPOPJ] + +MESIOT: .CALL MESCAL + LOSE + .CALL [SETZ ? SIXBIT /FLUSH/ ? SETZI TTYO] + LOSE + POPJ P, + +MESCAL: SETZ + SIXBIT /SIOT/ + MOVEI TTYO + A + SETZ B + +UUOH: 0 + PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,RET1 + MOVEI @40 ; GET EFF ADDR. OF UUO + MOVEM UUOE + MOVE @0 + MOVEM UUOD ; CONTENTS OF EFF ADR + MOVE B,UUOE ; EFF ADR + LDB A,[270400,,40] ; GET UUO AC, + LDB C,[330600,,40] ; OP CODE + CAIL C,UUOMAX + MOVEI C,0 ; GRT=>ILLEGAL + JSP RET1,@UUOTAB(C) ; GO TO PROPER ROUT + +UUORET: POP P,RET1 + POP P,D + POP P,C + POP P,B + POP P,A ; RESTORE AC'S + JRST 2,@UUOH + +UOBPTR: MOVEI C,0 + MOVE B,UUOD + JRST UOASC1 + +UOASCR: SKIPA C,[^M] ; CR FOR END OF TYPE +UOASC: MOVEI C,0 ; NO CR + HRLI B,440700 ; MAKE ASCII0 POINTER +UOASC1: ILDB A,B ; GET CHAR + JUMPE A,UOASC2 ; FINISH? + PUSHJ P,IOTA + JRST UOASC1 ; AND GET ANOTHER +UOASC2: SKIPE A,C ; GET SAVED CR? + PUSHJ P,IOTA + JRST (RET1) ; HO HO + +UOASCC: HRLI B,440700 ; MAKE ASCII POINTER +UOAS1C: ILDB A,B ; GET CHAR + CAIN A,^C + JRST UUORET + PUSHJ P,IOTA + JRST UOAS1C ; AND GET ANOTHER + +UOCTLP: ;;;SKIPE IMLAC ; ONLY PRINT CTRL-P CODES FOR IMLAC + ;;;JRST UOASCI (HOW NARROW-MINDED CAN YOU GET!) + MOVEI A,^P + PUSHJ P,IOTA1 + +UOASCI: MOVE A,B ; PRT ASCII IMMEDIATE + PUSHJ P,IOTA + JRST UUORET + +UOSIX: MOVE B,UUOD +USXOOP: JUMPE B,UUORET + LDB A,[360600,,B] + ADDI A,40 + PUSHJ P,IOTA + LSH B,6 + JRST USXOOP + +UOSIXS: MOVE A,[440600,,UUOD] +USLOOP: ILDB C,A + ADDI C,40 + PUSHJ P,IOTC + TLNE A,770000 + JRST USLOOP + JRST UUORET + +UOHPOS: SUB B,HPOS + JUMPLE B,UOASCI +UOHPO1: MOVEI A,40 + PUSHJ P,IOTA + SOJG B,UOHPO1 + JRST UUORET + +POWER: 0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000. + +UOALIG: MOVE D,UUOD + ANDI A,7 + MOVE A,POWER(A) + MOVEI C,40 +UOALI1: CAMLE A,D + PUSHJ P,IOTC + IDIVI A,10. + CAIE A,1 + JRST UOALI1 + SETZ A, + +UODEC: SKIPA C,[10.] ; GET BASE FOR DECIMAL +UOOCT: MOVEI C,8. ; OCTAL BASE + MOVE B,UUOD ; GET ACTUAL WORD TO PRT + JRST .+3 ; JOIN CODE +UODECI: SKIPA C,[10.] ; DECIMAL +UOOCTI: MOVEI C,8. + MOVEM C,BASE + SKIPN A + HRREI A,-1 ; A=DIGIT COUNT + PUSHJ P,UONUM ; PRINT NUMBR + JRST UUORET + +UONUM: IDIV B,BASE + HRLM C,(P) ; SAVE DIGIT + SOJE A,UONUM1 ; DONE IF 0 + SKIPG A ; + => MORE + SKIPE B ; - => B=0 => DONE + PUSHJ P,UONUM ; ELSE MORE +UONUM1: HLRZ C,(P) ; RETREIVE DIGITS + ADDI C,"0 ; MAKE TO ASCII + CAILE C,"9 ; IS IT GOOD DIG + ADDI C,"A-"9-1 ; MAKE HEX DIGIT + PUSHJ P,IOTC + POPJ P, ; RET + +UERRUU: JSP RET1,UOASCR + MOVEI A,CPOPJ + MOVEM A,UUOH + JRST UUORET + +IOTC: PUSH P,A + MOVE A,C + PUSHJ P,IOTA + JRST POPAJ + +IOTA: CAIN A,^P + JRST IOTAP +IOTA1: SKIPN CTRLJ + JRST [CAIN A,^J + POPJ P, + JRST .+1] + .IOT OUTCHN,A + CAIN A,^I + JRST [MOVE A,HPOS + ADDI A,10 + ANDI A,7770 + MOVEM A,HPOS + POPJ P,] + AOS HPOS + CAIE A,^M + POPJ P, + SETZM HPOS + POPJ P, +IOTAP: .IOT OUTCHN,["^] + ADDI A,100 + JRST IOTA1 + +POPAJ: POP P,A + POPJ P, + +; HERE TO PRINT THE STACK. THIS MUST BE DONE MANUALLY +; TRY PUSHJ P,PRSTAK + +PRSTAK: PUSH P,AP + PUSH P,JCLPTR + SETZM HPOS +PRSTKL: MOVE A,(AP) + TLZE A,400000 + OASCI !"* + JFFO A,.+1 + CAIL B,STTBLN + MOVEI B,STTBLN + JUMPE A,PRSTGO + HRRZ C,(AP) + ODEC C + OHPOS 6. + OASC STKTBL(B) + TLNE A,$ARG + JRST [OHPOS 15. + OASCI "" + MOVE JCLPTR,-1(AP) + JSP RET,GETCHR + JFCL + PUSHJ P,OUTLP + JFCL + OASCI "" + JRST .+1] + SUB AP,[6,,6] + SETZ C, +PRFMK: ADD AP,[1,,1] + MOVE A,(AP) + MOVEM A,DEVICE(C) + CAIN C,6 + JRST PRFMK1 + AOJ C, + AOJA C,PRFMK +PRFMK1: OHPOS 40. + OASCI "" + PUSHJ P,PFNAME + OASCI "" + OASCR [0] + SUB AP,[4,,4] + JRST PRSTKL + +PRSTGO: OASC [ASCIZ / TOPLEVEL/] + POP P,JCLPTR + POP P,AP + POPJ P, + +STKTBL: ASCIZ /STOP/ + ASCIZ /AND/ + ASCIZ /OR/ + ASCIZ /COND/ + ASCIZ /BIND/ + ASCIZ /NOT/ + ASCIZ /RPT/ + ASCIZ /BIND/ + ASCIZ /MAPF/ + ASCIZ /ARG/ + ASCIZ /FCN/ + ASCIZ /ARG/ + ASCIZ /BLK/ + ASCIZ /PROG/ +STTBLN==.-STKTBL-1 + +SUBTTL PREDEFINED FUNCTIONS + +; PREDEFINED FUNCTIONS ARE CREATED THROUGH CALLS TO PREDEF +; THE SEQUENCE IS ,[THE STUFF YOU WANT] +; THE FOLLOWING ARE FAIRLY STRAIGHTFORWARD + +; B FUNCTION -- DO READER OUTPUT INTERPRETATION WITH OPTIONAL ARGS + +BFCN: PREDEF B,[[B"; READER"]] + +; M FUNCTION -- PRINT MAIL AND RENAME TO OMAIL +; no arguments + +MFCN: PREDEF M,[[? [E"; MAIL" [& ;Q"Print mail? " P"" R", OMAIL"]]]] + +; T FUNCTION -- PRINT IF HAVE A SAFETY FILE +; no arguments + +TFCN: PREDEF T,[[& E"_ >" ;O"You have a TECO safety file."]] + +; S FUNCTION -- HAIRY 'SAVE' ADDITION TO M FUNCTION +; arg 1 = mail file (defaults to MAIL) +; arg 2 = rename file specification (defaults to MAIL,VANISH; OMAIL) + +SFCN: PREDEF S,[[? [E;!1" MAIL" [& ;Q"Print mail? " P"" [? (;Q"Save mail? " R;!2",OMAIL >") (A",VANISH; OMAIL")]]]]] + +; C FUNCTION -- COMB FILES +; arg 1 = file, must be FOO;BAR * (no default) +; arg 2 = what to print between files (default "Next file? ") + +CFCN: PREDEF C,[[* [? (E!1 K N"" P"" [\ ;Q;!2"Next file? " @>]) (@>)]]] + +; P FUNCTION -- PRUNE FILES (comb + offer to delete) +; arg 1 = file, must be FOO;BAR * (no default) +; arg 2 = what to print between files (default "Next file? ") +; arg 3 = what to print for deletion (default "Delete? ") + +PFCN: PREDEF P,[[* [? (E!1 K N"" P"" [& ;Q;!3"Delete? " D""] [\ ;Q;!2"Next file? " @>]) (@>)]]] + +; D FUNCTION -- DELETE ALL FILES WITH FIRST FILE NAME +; arg 1 = file name (default PCOMP) + +DFCN: PREDEF D,[[*[\D;!1"PCOMP >"@>]]] + + END START + +