mirror of
https://github.com/PDP-10/its.git
synced 2026-01-15 16:07:01 +00:00
2394 lines
46 KiB
Plaintext
2394 lines
46 KiB
Plaintext
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 <CHAR>,[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 <xuname> MAIL)
|
||
; arg 2 = rename file specification (defaults to <xuname> MAIL,VANISH;<xuname> 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
|
||
|
||
|