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 ", LDB B,[330700,,A] ADDI B.1900. 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