Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0033/qed.old
There is 1 other file named qed.old in the archive. Click here to see a list.
TITLE TECO V.014 - 20 FEB 69 - RC CLEMENTS
SUBTTL TEXT EDITOR AND CORRECTOR
VTECO=14
;SWITCH FOR SHARED OR UNSHARED VERSION OF TECO
R=1
;SWITCH FOR INCLUSION OF CCL CODE
CCL=0
;DEFINITION OF SAVE EXTENSION (SHOULD BE SAV OR DMP)
IFNDEF SAVEXT,<SAVEXT=SIXBIT / SAV/>
IF2,<IFN R,<SUBTTL SHARED VERSION>>
;ACCUMULATOR ASSIGNMENTS
FF=0 ;CONTROL FLAGS
P=1 ;PUSH DOWN POINTER
;*** A, AA AND B MUST BE CONTIGUOUS AND IN THAT ORDER ***
A=2
AA=3 ;BYTE POINTER TO COMMAND BUFFER
;*** B AND E MUST BE ADJACENT AND B<11 ***
B=4 ;COMMAND BUFFER END ADDRESS
E=5
C=6
D=7
F=10
T=11
;*** TT AND TT1 MUST BE ADJACENT ***
TT=12
TT1=13
I=14
OU=15
CH=16
PF=17
;MODIFIED TO NEW JOBDAT SYMBOLS BY PAUL T. ROBINSON, 15 AUG 1980
;DECUS LIBRARY CONVERSION PROGRAMMER
;JOBXXX BECOMES .JBXXX, DEFINED IN JOBDAT.UNV
;EXTERN JOBREL,JOBSYM,JOBDDT,JOBFF,JOB41,JOBREN,JOBSA
SEARCH JOBDAT
INTERN VTECO
.JBVER=137
INTERN .JBVER
LOC .JBVER ;.JB VERSION #
EXP VTECO
RELOC
;CONTROL FLAGS
;RIGHT HALF
ALTF=1 ;ALT-MODE SEEN
ARG2=2 ;THERE IS A SECOND ARGUMENT
ARG=4 ;THERE IS AN ARGUMENT
ITERF=10 ;INSIDE AN ITERATION
SLSL=20 ;@ SEEN
PCHFLG=40 ;N SEARCH
COLONF=100 ;COLON SEEN
SYLF=200 ;SYLLABLE FLAG
FINDR=2000 ;LEFT ARROW SEARCH
QMFLG=4000
NOTF=10000 ;^N SEARCH MODIFIER
TRACEF=20000 ;? SEEN
SEQF=40000 ;SEQUENCE NUMBER
BELLF=100000 ;^G SEEN
DDTMF=200000 ;NEED TO TYI IN DDT MODE
FORM=400000 ;A FORM FEED TERMINATED THE LAST YANK OR APPEND COMMAND
;LEFT HALF
FINF=100 ;INPUT CLOSED BY EOF
UREAD=200 ;INPUT FILE IS OPEN
UWRITE=400 ;OUTPUT FILE IS OPEN
FILWD=2000 ;FILE WORD BEING ASSEMBLED.
FEXTF=4000 ;FILE EXT EXPECTED (.TYPED).
FCSF=10000 ;1 FOR BELIEVE LC LTRS
UBAK=20000 ;EB IN EFFECT
GKTLKF=40000 ;MESSAGE TYPE OUT IN GRABAK?
TYOF=100000 ;NEED TO OUTPUT A BUFFER
OPDEF TYPR1 [30B8]
OPDEF ERROR [31B8]
;CALLI UUOS
RESET=0
DDTIN=1
DDTOUT=3
DEVCHR=4
CORE=11
EXIT=12
TIMER=22
SWITCH=20
UTPCLR=13
PJOB=30
REMAP=37
INCHN=2
OUTCHN=3
TTY=4 ;CHANNEL FOR TTY IO
CCLCHN=5 ;CHANNEL FOR THE CCL TMP FILE
LPDL=75
GCTBL=100
LPF=200
BUFSIZ=203
INTERN .JBCOR
.JBCOR=133
IFE <R>,< .ZZ=0
DEFINE U(A,B)
< A: BLOCK B
.ZZ=.ZZ+B>
STARTA=TECO
LOC .JBCOR
EXP 7777
RELOC
>
IFN <R>,
< ZZ=140
LOSIZ=4000 ;IMPURE AREA AT LOAD TIME
HISIZ=4000 ;SIZE OF PURE HALF OF TECO
DEFINE U(A,B)< A=ZZ
ZZ=ZZ+B>
HISEG ;FOR THE LOADER
STARTA=TECO ;TRY TO DO IT WITHOUT SPECIAL INITLZN
>
;PSEUDO RUN UUO IF NEEDED
;STARTUP TIME INITIALIZATION
INTERNAL TECO
TECO: CALLI RESET ;INITIALIZE ALL IO
MOVEI A,DEBUT ;QED MODIFICATION ********************
HRRM A,.JBSA ;QED MODIFICATION ********************
IFN <R>,<
HRRZ A,.JBREL ;SEE IF RUN IN AT LEAST 2K
CAIGE A,LOSIZ-1 ;ENOUGH?
MOVEI A,LOSIZ-1 ;NO.
CALLI A,CORE ;INSURE SPACE FOR VARIABLES
CALLI EXIT ;NO CORE
SETZM 140
MOVE A,[XWD 140,141]
BLT A,@.JBREL
>
MOVE A,LOC41 ;SETUP UUO TRAP .JB41:=JSR ETYPER
MOVEM A,.JB41
MOVE P,[XWD -LPDL,PDL-1]
HRRZ A,.JBREL ;IF .JBDDT=0, .JBFF:=C(.JBREL)-202
SKIPA ;QED MOD **************
HRRZ A,.JBSYM
MOVEM A,.JBFF
SETZM SFINDF
MOVEI A,DEBUT ;QED MODIFICATION ********************
MOVEM A,.JBREN
MOVSI A,263000+P*40
MOVEM A,TRACS ;TRACS:=POPJ P,
SETZM OPNR1 ;CLEAR INPUT DEVICE NAME
MOVEI A,CBUF+200
IMULI A,5
MOVEM A,BEG ;BEG:=(CBUF+200)*5
MOVEM A,PT ;PT:=(CBUF+200)*5
MOVEM A,Z ;Z:=(CBUF+200)*5
MOVEM A,QRBUF ;QRBUF:=(CBUF+200)*5
CALLI A,PJOB
MOVEM A,JOBN
;COMPUTE A VALUE WHICH IS 2/3 THE SIZE OF THE CHARACTER BUFFER.IF
;1/3 IS LESS THAN 128 CHARACTERS, THE BUFFER WILL BE 2/3 FILLED ON
;A "Y" OR "A" COMMAND,OTHERWISE, THE BUFFER WILL BE FILLED TO THE
;TOTAL AVAILABLE BUFFER - 128 CHARACTERS. PAYING ATTENTION TO THE
;FORM FEED AND LF OPERATORS.
;IT SHOULD BE NOTED THAT IN THE CASE OF AUTOMATIC
;MEMORY EXPANSION, THESE INSTRUCTIONS MUST BE RE-EXECUTED
;TO INSURE PROPER MEMORY BOUNDS.
PUSH P,INITG ;FOR IN LINE CODING POPJ
CRE23: PUSH P,FF ;SAVE FLAGS
MOVE A,BEG ;GET LATEST BASE VALUE
MOVEM A,M23 ;BASE VALUE FOR 2/3 FULL
MOVE A,.JBFF ;LATEST VALUE OF FF
HRLM A,.JBCOR ;QED MOD *******************
IMULI A,5 ;5 CHARACTERS PER MEM WORD
MOVEM A,MEMSIZ ;MEMSIZ:=C(.JBFF)*5
MOVEM A,M23PL ;TO BECOME THE UPPER LIMIT OF FILL
SUB A,BEG ;THIS THE TOTAL BUFFER AVAILABILITY
IDIVI A,3 ;GET 1/3 LENGTH
ADDM A,M23 ;FOR YANK AND APPEND SUBROUTINES
ADDM A,M23 ;WHICH WILL CONDUCT LF SEARCH AFTER 2/3
MOVNI FF,^D128 ;ANTICIPATE LONG BUFFER
CAIG A,^D128 ;IS 1/3 GREATER THAN 128 CHARACTERS?
MOVNI FF,(A) ;NO,THE REMAINING 1/3 WILL BE STOPPER
ADDM FF,M23PL ;SETTLE TOP BOUND OF BUFFER FILL ROUTINE
POP P,FF ;RESTORE THE FLAGS
INITG: POPJ P,.+1 ;EXIT OR CONTINUE
MOVEI A,CBUF+77
MOVEM A,CBUFH ;CBUFH:=CBUF+77
MOVEI A,SYL
MOVEM A,DLIM ;DLIM:=SYL
MOVE A,[XWD 10014,-1]
MOVEM A,NROOM2 ;NROOM2:=XWD 10014,-1
MOVE A,[JRST CNTRB2] ;CNTRB1+1:=JRST CNTRB2
MOVEM A,CNTRB1+1
MOVEI FF,0 ;CLEAR FLAG REGISTER
GOX:
GO: MOVE P,[XWD -LPDL,PDL-1] ;INITIALIZE PUSHDOWN LIST
MOVE T,[JRST DQT2] ;INITIALIZE CONTROL B DISPATCH
MOVEM T,CNTRB1 ;CNTRB1:=JRST DQT2
GO1: CLEARM,LEV
MOVE PF,[XWD -LPF,PFL-1]
TRZ FF,777777-TRACEF-QMFLG-FORM
JRST CLIS
LOC41: IFE R,<JSR UUOH>
IFN R,<JSP T,UUOH>
;THIS PAGE CONTAINS THE COMMAND READER FOR THE CCL SYSTEM
;FROM REE COMMAND DISTRIBUTION IN THE MONITOR
;HERE IS THE ROUTINE FOR RESTORING THE ACCUMULATORS IN CASE OF
;THE SAVE COMMAND (WHICH DESTROYED THEM) IS COMPLEMENTED BY THE
;GET COMMAND.ALSO TO BE RESTORED IS THE UUO TRAP.
REE: HRLZI PF,SAVE ;RESTORE THE AC'S AFTER REE
BLT PF,PF ;CAUSE SAVE DESTROYS THEM
JRST GO ;GO AND LISTEN FOR INPUT
QEDDBT: MOVE AA,[XWD 700,CBUF-1] ;QED MOD ***************
MOVEI CH,11 ;QED MOD *****************
MOVEM CH,QEDCNT ;QED MOD ******************
MOVEI CH,"-" ;QED MOD ***************
IDPB CH,AA ;QED MOD ******************
MOVEI CH,"1" ;QED MOD *****************
IDPB CH,AA ;QED MOD ****************
MOVEI CH,"U" ;QED MOD ****************
IDPB CH,AA ;QED MOD ******************
MOVEI CH,"J" ;QED MOD ********************
IDPB CH,AA ;QED MOD *********************
JRST QEDDEB ;QED MOD ********************
DEBUT: HRLZI PF,SAVE ;QED MODIFICATION ********************
BLT PF,PF ;QED MODIFICATION ********************
MOVE P,LOC41 ;QED MOD ********************
MOVEM P,.JB41 ;QED MOD *********************
MOVE P,[XWD -LPDL,PDL-1] ;QED MODIFICATION ************
MOVE T,[JRST DQT2] ;QED MODIFICATION ********************
MOVEM T,CNTRB1 ;QED MODIFICATION ********************
CLEARM,LEV ;QED MODIFICATION ********************
MOVE PF,[XWD -LPF,PFL-1] ;QED MODIFICATION ************
TRZ FF,777777-TRACEF-QMFLG-FORM ;QED MODIFICATION ************
PUSHJ P,TTOPEN ;QED MODIFICATION ********************
MOVEI CH,5 ;QED MOD ********************
MOVEM CH,QEDCNT ;QED MOD *********************
MOVE AA,[XWD 700,CBUF-1] ;QED MODIFICATION ************
QEDDEB: MOVEI CH,"M" ;QED MODIFICATION ********************
IDPB CH,AA ;QED MODIFICATION ********************
MOVEI CH,"Q" ;QED MODIFICATION ********************
IDPB CH,AA ;QED MODIFICATION ********************
MOVEI CH,"}" ;QED MODIFICATION ********************
IDPB CH,AA ;QED MODIFICATION ********************
MOVEI CH,"}" ;QED MODIFICATION ********************
IDPB CH,AA ;QED MODIFICATION ********************
MOVEI CH,141 ;QED MODIFICATION ********************
IDPB CH,AA ;QED MODIFICATION ********************
MOVE A,QEDCNT ;QED MODIFICATION ********************
MOVEM A,COMCNT ;QED MODIFICATION ********************
JRST LI4+7 ;QED MODIFICATION ********************
TYI:
;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.
;CALL PUSHJ PDP,TYI
; RETURN
TYI: TLZE FF,TYOF ;NEED A TYO?
OUTPUT TTY,0 ;YES. DO SO.
TYI0: SOSG TIB+2 ;CHARS IN NORMAL MODE?
JRST TYI1 ;NONE LEFT
TYI2: ILDB CH,TIB+1 ;YES. GET ONE
JUMPE CH,TYI0 ;FLUSH NULLS
TYI3: POPJ P,0 ;RETURN.
TYI1: TRNE FF,DDTMF ;SHOULD TYI BE DDT STYLE?
JRST TYIDDT ;YES
INPUT TTY,0 ;NO. ORDINARY.
STATO TTY,20000 ;END OF FILE?
JRST TYI2
PUSHJ P,TTOPEN ;CLEAR EOF THE HARD WAY
JRST TYI0 ;^Z WAS SEEN ALREADY. GET ANOTHER CH
TYIDDT: ILDB CH,TYIPT ;DDT CHAR LEFT?
JUMPN CH,TYI3 ;YES. RETURN VIA LC FILTER
MOVE T,TTYPT ;NO. GET POINTER
MOVEM T,TYIPT ;SET FOR FIRST CH
CALLI T,DDTIN ;GET CHARS
JRST TYIDDT ;GET THE CHARS FROM BUFFER
TTOPEN: MOVEI T,TTYBFS
EXCH T,.JBFF ;SET .JBFF AND SAVE IT
INIT TTY,100 ;INIT THE CONSOLE
SIXBIT /TTY/
XWD TOB,TIB ;SHOULD BE
JRST .-3 ;I REALLY WANT TTY
INBUF TTY,1
OUTBUF TTY,1 ;KEEP IT SMALL
MOVEM T,.JBFF ;RESTORE .JBFF
SETZM TYIPT ;SIGNAL DDT BUFFER EMPTY
POPJ P,0
;ROUTINE TO TYPE A CHARACTER.
;CALL MOVE CH,CHARACTER
; PUSHJ P,TYO
; RETURN
;CONTROL CHARACTERS ARE TYPED WITH "^" FOLLOWED BY THE CORRESPONDING
;PRINTING CHARACTER.
TYO: PUSH P,CH ;NULL/IDLE,START OF MESSAGE,END OF ADDRESS, END OF
;TRANSMISSION,WRU,ARE YOU OR BELL?
CAIGE CH,7
JRST TYO1 ;YES.
CAIG CH,15 ;NO. HORIZONTAL TAB,LINE FEED,VERTICAL TAB
;FORM FEED OR CARRIAGE RETURN?
JRST TYOB ;YES. TYPE IT AND RETURN
CAIGE CH,40 ;NO. ANY OTHER CONTROL CHARACTER?
JRST TYO1 ;YES.
CAIN CH,175 ;NO. ALT-MODE?
MOVEI CH,"$" ;YES. CONVERT IT TO $.
TYOB: PUSHJ P,TYOA ;TYPE CH.
POP P,CH ;RESTORE CH
POPJ P,0 ;RETURN
TYOA: TLO FF,TYOF ;MARK WILL NEED TO OUTPUT
SOSG TOB+2 ;OUTPUT SPACE AVAIL?
OUTPUT TTY,0 ;NO. OUTPUT.
IDPB CH,TOB+1
CAILE CH,14 ;FORCE OUTPUT ON LF,FF ETC
POPJ P,0 ;NO
OUTPUT TTY,0
TLZ FF,TYOF ;NO LONGER NEED TO OUTPUT
POPJ P,0
TYO1: PUSH P,CH ;TYPE CONTROL CHARACTER IN FORM "^CH"
MOVEI CH, "^"
PUSHJ P,TYOA ;TYPE ^
POP P,CH
ADDI CH,100 ;CONVERT TO PRINTING CHARACTER
JRST TYOB ;AND TYPE IT.
TTYPT: XWD 440700,TTYBUF
U TYIPT,1
U TTYBFS,46 ;100 MODE TTY BFRS
U TIB,3 ;BUFFER HEADER
U TOB,3 ;DITTO
U TTYBUF,22
U JOBN,1
;ROUTINE TO TYPE "? ERROR MESSAGE"
;CALL JSP A,ERRMES
; ASCIZ /ERROR MESSAGE/
; RETURN
ERRMES: MOVEI CH,"?"
PUSHJ P,TYO
;ROUTINE TO TYPE "MESSAGE"
;CALL JSP A,CONMES
; ASCIZ /MESSAGE/
; RETURN
CONMES: HRLI A,440700
ILDB CH,A
JUMPE CH,1(A)
PUSHJ P,TYO
JRST .-3
;ROUTINE TO TYPE C(A) IN SIXBIT
;CALL MOVE A,[SIXBIT /MESSAGE/]
; PUSHJ P,SIXBMS
; RETURN
SIXBMS: MOVNI B,6
MOVE E,[XWD 440600,A]
ILDB CH,E
JUMPE CH,CPOPJ
ADDI CH,40
PUSHJ P,TYO
AOJL B,.-4
POPJ P,0
U IBUF,3
U OBF,3
U OUTBUF,3
U IBUF1,2*BUFSIZ
U OBUF1,2*BUFSIZ
;ROUTINE TO OUTPUT DECIMAL INTEGER
;CALL MOVE B, DECIMAL INTEGER
; MOVEI A,ADDRESS OF OUTPUT ROUTINE
; HRRM A,LISTF5
; PUSHJ P,DPT
; RETURN
DPT: JUMPGE B,.+3 ;NUMBER > 0?
MOVEI CH,"-" ;NO. OUTPUT -
PUSHJ P,@LISTF5
MOVMS B ;B:=ABSOLUTE VALUE OF B
IDIVI B,12 ;E:=DIGIT
HRLM E,(P) ;PUT DIGIT ON LEFT HALF OF TOP OF PUSH DOWN LIST
JUMPE B,.+2 ;DONE?
PUSHJ P,.-3 ;NO. PUSH THIS DIGIT AND PRINT RETURN ADDRESS.
HLRZ CH,(P) ;YES. CH:=DIGIT
ADDI CH,60 ;CONVERT IT TO ASCII.
JRST @LISTF5 ;PRINT IT
;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL PUSHJ P,CRR
; RETURN
CRR: MOVEI CH,TYO ;SET OUTPUT DISPATCH TO TTY AND
HRRM CH,LISTF5
CRR1: MOVEI CH,15 ;OUTPUT CRLF
PUSHJ P,@LISTF5
MOVEI CH,12
JRST @LISTF5
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER AND ERROR IF EMPTY.
;CALL PUSHJ P,SKRCH
; RETURN WITH CHARACTER IN CH
;GOES TO ERR IF COMMAND BUFFER IS EMPTY
SKRCH: SKIPN COMCNT ;COMMAND BUFFER EMPTY?
ERROR ^D1
;YES. SKRCH SHOULDN'T RUN OUT.
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL PUSHJ P,RCH
; RETURN ALWAYS WITH CHARACTER IN CH
RCH: SOSGE COMCNT ;DECREMENT COMMAND BUFFER CHARACTER COUNT
;IS COMMAND BUFFER EMPTY?
JRST RCH2 ;YES. POP UP TO HIGHER MACRO LEVEL.
ILDB CH,CPTR ;NO. GET COMMAND CHARACTER IN CH
XCT TRACS ;RETURN OR JRST TYO IN TRACE MODE
RCH2: POP P,CH ;SAVE RETURN FOR POPJ IN CH
POP P,COMCNT ;GET COUNT FROM NEXT MACRO LEVEL
POP P,CPTR ;POINTER TOO.
POP P,COMAX ;NUMBER OF COMMANDS.
PUSH P,CH ;GET RETURN BACK ON PDL.
JRST RCH ;TRY AGAIN.
U TRACS,1
SKRCH1: SOSGE COMCNT ;ANY CHARACTERS LEFT?
ERROR ^D2
;NO. SUPPOSEDLY CAN'T RUN OUT OF
;COMMANDS AT THIS ROUTINE.
ILDB CH,CPTR ;YES. GET A CHARACTER.
POPJ P, ;RETURN.
CLIS: PUSHJ P,TTOPEN ;GET TELETYPE
LIS: MOVEI CH,"*"
LIS0: PUSHJ P,TYO ;TYPE *
TRNE FF,QMFLG
TRO FF,DDTMF ;NEED DDT MODE FOR "?"
CLEARM COMCNT ;COMCNT:=0
CLEARM INTDPH ;INTDPH:=0
CLEARM SYMS
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVE AA,[XWD 700,CBUF-1]
MOVE B,CBUFH
LI1: TRZ FF,ALTF+BELLF
LI2: CAILE B,(AA) ;COMMAND BUFFER EXCEEDED?
JRST LI3 ;NO
;TO SEE IF TECO WILL NEED MORE CORE FOR COMMAND
;BUFFER EXPANSION. IF SO, GET IT
MOVE C,Z ;GET THE NUMBER OF CHARACTERS NOW
ADDI C,100 ;WILL WE OVERFLOW IF THIS IS REQUESTED?
CAIG C,MEMSIZ ;WILL THIS OVERFLOW?
JRST .+5 ;NO, FORGET THIS EVER HAPPENED
PUSH P,17 ;WILL OVERFLOW, THEREFORE, SAVE AC#17
MOVE 17,C ;THIS IS THE REQUEST FOR MEMORY
PUSHJ P,GRABKQ ;GET THE NECESSARY CORE
POP P,17 ;RESTORE AC#17
;OK, EXPAND THE COMMAND BUFFER CONFIDENTLY
ADDI B,100 ;YES. EXPAND COMMAND BUFFER 100 WORDS.
MOVE C,Z
IDIVI C,5 ;C:=DATA BUFFER END WORD ADDRESS.
MOVE D,QRBUF
IDIVI D,5 ;D:=Q-REG BUFFER BASE WORD ADDRESS.
SUBM C,D ;D:=NO. OF WORDS IN Q-REG BUFFER AND DATA BUFFER.
MOVE CH,(C)
MOVEM CH,100(C) ;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
SOS C
SOJGE D,.-3
MOVEI C,500
ADDM C,BEG ;BEG:=C(BEG)+500
ADDM C,PT ;PT:=C(PT)+500
ADDM C,Z ;Z:=C(Z)+500
ADDM C,QRBUF ;QRBUF:=C(QRBUF)+500
MOVE D,Z
LI3: MOVEM B,CBUFH ;NO. RESET HIGH END OF COMMAND BUFFER.
PUSHJ P,TYI ;GET A NON-NULL CHARACTER IN CH
CAIE CH,33 ;IS IT AN OLD ALT-MODE CODE?
CAIN CH,176
MOVEI CH,175 ;YES. CONVERT TO NEW ALT-MODE CODE.
TRZE FF,QMFLG ;CLEAR ? FLAG. WAS IT ON?
CAIE CH,"?" ;YES. IS THIS A "?"?
AOSA COMCNT ;NO. INCREMENT COMMAND CHARACTER COUNT
JRST ERRTYP ;YES. TYPE BAD STRING
IDPB CH,AA ;NO. STORE CHARACTER IN COMMAND BUFFER.
CAIE CH,177 ;IS IT A RUBOUT?
JRST LI4 ;NO.
;DELETE A CHARACTER FROM THE COMMAND BUFFER.
IBP AA ;YES. BACKUP BYTE POINTER TWO BYTES
IBP AA
IBP AA
SOS D,AA
CAMN AA,[XWD 100700,CBUF-1] ;DID IT GO PAST THE BEGINNING
;OF THE BUFFER
JRST CLIS1 ;YES. TYPE CRLF *
ILDB CH,D ;NO. TYPE DELETED CHARACTER
PUSHJ P,TYO
SOS COMCNT ;REMOVE TWO CHARACTERS FROM COMMAND COUNT.
SOS COMCNT
JRST LI1 ;AND GET ANOTHER COMMAND CHARACTER
LI4: CAIE CH,175 ;ALT-MODE?
JRST LI5 ;NO
TRON FF,ALTF ;YES. SET ALT-MODE FLAG. WAS IT ON?
JRST LI2 ;NO
MOVEI CH,141 ;YES. TWO SUCCESSIVE ALT-MODES. END OF COMMAND.
AOS A,COMCNT ;MARK END OF COMMAND STRING WITH ASCII 141
IDPB CH,AA
MOVE AA,[XWD 700,CBUF-1] ;INITIALIZE COMMAND BYTE POINTER
MOVEM AA,CPTR
PUSHJ P,CRR ;TYPE CRLF
MOVEM A,COMAX ;SET COMMAND CHARACTER ADDRESS UPPER BOUND
MOVEM PF,SAV17 ;TO SAVE AC'S IN CASE OF A
MOVEI PF,SAVE ;SNEEK SAVE
BLT PF,SAV16 ;WHICH WILL DESTROY THEM
MOVE PF,.JBFF ;GET CONTENTS OF FIRST FREE
HRLM PF,.JBSA ;FOR .JBSA. MONITOR OR LOADER SHOULD DO THIS
HRLM PF,.JBCOR ;QED MOD ***********************
;BUT UNTILL IT DOES, THIS IS NEC
;ESSARY FOR THE SAVE TO WORK
MOVE PF,SAV17 ;RESTORE THE AC#17, GO TO WORK
JRST CD ;DECODE COMMAND
CLIS1: PUSHJ P,CRR ;TYPE CRLF
JRST CLIS ;AND GO TYPE *.
LI5: CAIE CH,7 ;BELL?
JRST LI1 ;NO. GET MORE CHARACTERS.
TRON FF,BELLF ;YES. SET BELL FLAG. TWO SUCCESSIVE BELLS?
JRST LI2 ;NO.
PUSHJ P,CRR ;YES. TYPE A CRLF
JRST GOX ;AND CLEAR COMMAND BUFFER.
CD:
RET: TRZ FF,ARG2+ARG+FINDR+PCHFLG
CD1: CLEARM NUM
;ADD TAKES ONE OR TWO ARGUMENTS
CD2: MOVSI A,270000+B*40 ;DELIM:=ADD B,
CD3: HLLM A,DLIM
CD4: CLEARM SYL
CD5:
PUSHJ P,RCH
CD9: XCT DTB(CH) ;A:=XWD VALUE FLAG,DISPATCH ADDRESS
;OR DISPATCH DIRECTLY
CD6: MOVE B,NUM
TRZE FF,SYLF ;DID LAST CHARACTER RETURN A VALUE OR WAS IT A DIGIT?
XCT DLIM ;YES. NUM:=NUM (DLIM OPERATOR) SYL
MOVEM B,NUM
MOVE C,SARG ;SAVE SECOND ARGUMENT IN C.
TRZ FF,NOTF
JUMPGE A,(A) ;DISPATCH IF VALUE RETURN COMMAND.
PUSHJ P,(A) ;DISPATCH FOR NON-VALUE RETURN COMMANDS.
JRST RET
U DLIM,1
U NUM,1
U SYL,1
U SARG,1
;DIGITS FORM DECIMAL INTEGERS.
CDNUM: MOVE A,SYL
IMULI A,12
ADDI A,-60(CH)
;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET: MOVEM A,SYL
CD7: TRO FF,ARG+SYLF
JRST CD5
ALTMOD: MOVE T,CPTR ;IF NEXT COMMAND CHARACTER IS ALT-MODE,
;OR END OF COMMAND BUFFER, GO;ELSE CD.
ILDB CH,T
CAIE CH,175
CAIN CH,141
JRST GO
JRST CD
;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.
UAR: PUSHJ P,SKRCH ;GET NEXT COMMAND CHARACTER.
TRZ CH,140 ;CHANGE IT TO CONTROL CHARACTER
JRST CD9 ;DISPATCH
;FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.
DECDMP: TLZ FF,UREAD+UWRITE+FINF+UBAK ;INCASE SOMEONE REENTERS
CALLI EXIT
;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM
COMMA: MOVEM B,SARG ;SAVE CURRENT ARGUMENT IN SARG.
TRZE FF,ARG ;WAS THERE A CURRENT ARGUMENT?
TROE FF,ARG2 ;YES. WAS THERE ALREADY A SECOND ARGUMENT?
ERROR ^D3
;NO. EITHER NO ARGUMENT OR MORE THAN TWO ARGUMENTS.
JRST CD1 ;YES. CLEAR CURRENT ARGUMENT.
;LOGICAL AND
CAND: MOVSI A,404000+B*40 ;DLIM:=AND B,
JRST CD3
;LOGICAL OR
COR: MOVSI A,434000+B*40 ;DLIM:=OR B,
JRST CD3
;SUBTRACT TAKES ONE OR TWO ARGUMENTS
MINUS: MOVSI A,274000+B*40 ;DLIM:=SUB B,
JRST CD3
;MULTIPLY TAKES TWO ARGUMENTS
TIMES: MOVSI A,220000+B*40 ;DLIM:=IMUL B,
JRST CD3
;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS
SLASH: MOVSI A,230000+B*40 ;DLIM:=IDIV B,
JRST CD3
;RETURNS THE VALUE OF THE FORM FEED FLAG
FFEED: TRNE FF,FORM ;IS IT SET?
JRST FFOK ;YES, RETURN A -1
;NO, DO BEGIN ROUTINE
;RETURNS THE NUMERIC VALUE 0.
BEGIN: MOVEI A,0
JRST VALRET
;AN ABBREVIATION FOR B,Z
HOLE: CLEARM SARG ;SET SECOND ARGUMENT TO 0.
TRZN FF,ARG ;ANY ARGS BEFORE H?
TRNE FF,ARG2 ; ..
ERROR ^D3 ;THATS TOO BAD
TROA FF,ARG2
;.=NUMBER OF CHARACTERS TO THE LEFT OF THE POINTER
PNT: SKIPA A,PT
;Z=NUMBER OF CHARACTERS IN THE BUFFER
END1: MOVE A,Z
SUB A,BEG
JRST VALRET
;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN FOR +,-,*,/,& AND #.
OPEN: PUSH P,NUM ;PUSH CURRENT ARGUMENT.
HLLZ A,DLIM ;GET CURRENT OPERATOR.
TRZE FF,ITERF ;ARE WE INSIDE AN ITERATION?
IORI A,1 ;YES. MARK OPERATOR AS BEING WITHIN AN ITERATION.
PUSH P,A ;PUSH CURRENT OPERATOR.
AOS LEV ;INCREMENT ( LEVEL.
JRST RET
CLOSE: SOSGE LEV ;IS THERE A (?
ERROR ^D4
;NO.
MOVEM B,SYL ;YES. SAVE CURRENT ARGUMENT.
POP P,CH ;RESTORE OPERATOR.
HLLM CH,DLIM
TRZ FF,ITERF
TRNE CH,1
TRO FF,ITERF ;RESTORE ITERATION FLAG FOR THIS OPERATOR.
POP P,NUM ;RESTORE ARGUMENT.
JRST CD7
U LEV,1
;N= CAUSES THE VALUE OF N TO BE TYPED OUT.
PRNT: TRNN FF,ARG ;HERE ON "=" COMMAND
ERROR ^D5
;MUST HAVE ARG
PRNT9: MOVEI A,TYO
HRRM A,LISTF5 ;CONSOLE
JRST DPT
;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER
;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN.
QEDIN: SETZM QED ;QED MOD ****************
POPJ P, ;QED MOD ******************
QEDOUT: SETOM QED ;QED MOD *****************
POPJ P, ;QED MOD ******************
QEDTYP: MOVEM T,QEDT ;QED MOD *******************
MOVEI T,">" ;QED MOD ********************
TTCALL 13,0 ;QED MOD ***********************
TTCALL 1,T ;QED MOD *********************
MOVE T,QEDT ;QED MOD ********************
POPJ P, ;QED MOD **********************
SPTYI: TRO FF,DDTMF ;NEED DDT MODE FOR THIS
PUSHJ P,TYI
SKIPE 0,QED
JRST DUHELB
SKIPN QED1 ;QED MODIFICATION ********************
JRST DUHEL ;QED MODIFICATION ********************
SETO A, ;QED MODIFICATION ********************
TTCALL 6,A ;QED MODIFICATION ********************
TLZ A,4 ;QED MODIFICATION ********************
TTCALL 7,A ;QED MODIFICATION ********************
SETZM QED1 ;QED MODIFICATION ********************
DUHEL: CAIN CH,22 ;QED MODIFICATION ********************
JRST .+3 ;QED MODIFICATION ********************
CAIE CH,31 ;QED MODIFICATION ********************
JRST DUHELA ;QED MODIFICATION ********************
SETO A, ;QED MODIFICATION ********************
TTCALL 6,A ;QED MODIFICATION ********************
TLO A,4 ;QED MODIFICATION ********************
TTCALL 7,A ;QED MODIFICATION ********************
SETOM QED1 ;QED MODIFICATION ********************
DUHELA: CAIE CH,21 ;QED MODIFICATION ********************
JRST DUHELB ;QED MODIFICATION ********************
SETO A, ;QED MODIFICATION ********************
TTCALL 6,A ;QED MODIFICATION ********************
TLZ A,2 ;QED MODIFICATION ********************
TTCALL 7,A ;QED MODIFICATION ********************
DUHELB: SKIPA A,CH ;QED MODIFICATION ********************
;HAS THE VALUE OF ELAPSED TIME, IN 60THS OF A SECOND, SINCE MIDNITE.
GTIME: CALLI A,TIMER
JRST VALRET
;HAS THE VALUE OF THE CONSOLE DATA SWITCHES.
LAT: CALLI A,SWITCH
JRST VALRET
;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.
CNTRUP: PUSHJ P,RCH ;^^ HAS VALUE OF CHAR FOLLOWING IT
MOVE A,CH
JRST VALRET
;HAS THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS (OR MINUS SIGN)
;FOLLOWING THE POINTER IN THE BUFFER. THE SCAN TERMINATES ON ANY OTHER
;CHARACTER. THE POINTER IS MOVED OVER THE NUMBER FOUND (IF ANY).
BAKSL: TRZE FF,ARG ;WHICH KIND OF BACKSLASH?
JRST BAKSL1 ;ARG TO MEMORY
MOVE I,PT ;MEMORY TO VALRET
BAKSLA: CAML I,Z ;OVERDID IT ?
JRST BAKSL3 ;YES. EXIT
PUSHJ P,GETINC ;NO. GET A CHAR
CAIN CH,"-" ;MINUS SIGN?
JRST BAKSLM ;YES. GO MARK IT.
CAIG CH,"9" ;DIGIT?
CAIGE CH,"0" ;DIGIT?
SOJA I,BAKSL2 ;NOT A DIGIT. BACKUP AND LEAVE LOOP
SUBI CH,"0" ;CONVERT TO NUMBER
EXCH CH,SYL
IMULI CH,12
ADDM CH,SYL ;SYL:= 10.*SYL+CH
JRST BAKSLA ;LOOP
BAKSL3: MOVE I,Z ;HERE ON OVERFLOW
BAKSL2: TRZE FF,ARG ;MINUS SIGN SEEN?
MOVNS SYL ;YES. NEGATE
MOVEM I,PT ;MOVE POINTER PAST #
JRST CD7 ;DONE
BAKSLM: TRO FF,ARG
JRST BAKSLA
;NA (WHERE N IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE
;CHARACTER TO THE RIGHT OF THE POINTER.
ACMD: TRNN FF,ARG ;DOES AN ARGUMENT PRECEED A?
JRST APPEND ;NO. THIS IN AN APPEND COMMAND.
MOVE I,PT ;YES.
PUSHJ P,GET ;CH:=CHARACTER TO THE RIGHT OF PT.
MOVE A,CH ;RETURN CH AS VALUE.
JRST VALRET
;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I.
USE: TRNN FF,ARG ;DID AN ARGUMENT PRECEED U?
ERROR ^D6
;NO.
USEA: PUSHJ P,QREGVI ;YES. CH:=Q-REGISTER INDEX.
MOVEM B,QTAB-"0"(CH) ;STORE ARGUMENT IN SELECTED Q-REG.
JRST RET
;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.
QREG: PUSH P,USE1 ;SET RETURN ADDRESS TO VALRET AND FALL INTO QREGVI.
;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
;CALL PUSHJ P,QREGVI
; RETURN
;ASSUMES COMCNT,CPTR AND COMAX ARE SET UP.
;IF NEXT CHARACTER IN COMMAND STRING IS NOT A LETTER OR A DIGIT, DOES NOT RETURN.
;FROM USEA,PCNT,OPENB+1,MAC,QGET
QREGVI: PUSHJ P,RCH ;CH:=NEXT COMMAND STRING CHARACTER.
CAIL CH,140 ;LC LETTER?
TRZ CH,40 ;MAKE UC
CAIL CH,"0" ;LETTER OR DIGIT?
CAILE CH,"Z"
ERROR ^D7
;NO
CAIL CH,1+"9" ;YES. DIGIT?
SUBI CH,"A"-"9"-1 ;NO. TRANSLATE LETTERS DOWN BY NUMBER OF
;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q REG'S
MOVE A,QTAB-"0"(CH) ;A:=CONTENTS OF Q-REGISTER.
USE1: POPJ P,VALRET
;%I ADDS 1 TO THE QUANTITY IN Q-REGISTER I AND STANDS FOR THE
; NEW VALUE
PCNT: PUSHJ P,QREGVI ;CH:=Q-REGISTER INDEX.
AOS A,QTAB-"0"(CH) ;INCREMENT Q-REG.
JRST VALRET ;RETURN NEW VALUE.
;M,NXI COPIES A PORTION OF THE BUFFER INTO Q-REGISTER I.
; IT SETS Q-REGISTER I TO A DUPLICATE OF THE (M+1)TH
; THROUGH NTH CHARACTERS IN THE BUFFER. THE BUFFER IS UNCHANGED.
;NXI INTO Q-REGISTER I IS COPIED THE STRING OF CHARACTERS STARTING
; IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
; THE NTH LINE FEED.
X: PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS
;B:=SECOND STRING ARGUMENT ADDRESS.
CAMLE C,B ;IS SECOND ARG. ADDR. > FIRST ARG. ADDR.?
ERROR ^D8
;NO.
EXCH B,C ;YES.
SUBI C,-3(B) ;C:=LENGTH OF STRING+3.
ADD B,C ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3
PUSH P,PT
ADDM C,(P) ;(P):=PT + LENGTH OF STRING + 3.
MOVE D,BEG
MOVEM D,PT ;PT:=BEG
PUSHJ P,NROOM ;INSERT STRING AT BEG
MOVE OU,RREL ;RREL CONTAINS RELOCATION CONSTANT IF
;GARBAGE COL. OCCURRED.
ADDM OU,(P) ;RELOCATE TOP OF STRING POINTER.
ADD B,OU ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 + RREL
MOVE OU,BEG ;OU:=ADDRESS OF Q-REG BUFFER
ADDM C,BEG ;BEG:=C(BEG)+LENGTH OF STRING + 3
MOVEI CH,141 ;FIRST CHARACTER OF BUFFER := 141
PUSHJ P,PUT
AOS OU
MOVE CH,C ;SECOND CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS
;OF LENGTH OF STRING + 3
PUSHJ P,PUT
ROT CH,-7
MOVE I,B ;THIRD CHAR OF BUFFER := MOST SIGNIFICANT 7 BITS
;OF LENGTH OF STRING + 3
AOS OU
X1: PUSHJ P,PUT ;MOVE STRING TO Q-REG BUFFER.
AOS OU
CAIN C,3
JRST X2
PUSHJ P,GETINC
SOJA C,X1
X2: MOVE B,PT ;QTAB ENTRY :=XWD 400000,Q-REG BUFFER
;ADDRESS RELATIVE TO C(QRBUF)
SUB B,QRBUF
TLO B,400000
POP P,PT ;MOVE PT PAST STRING.
JRST USEA ;MAKE QTAB ENTRY.
;GI THE TEXT IN Q-REGISTER I IS INSERTED INTO THE BUFFER AT THE
; CURRENT LOCATION OF THE POINTER. THE POINTER IS THEN PUT JUST
; TO THE RIGHT OF THE INSERTION. THE Q-REGISTER IS NOT CHANGED.
QGET: PUSHJ P,QREGVI ;A:=QTAB ENTRY, CH:=Q-REG INDEX
MOVE B,A
TLZN B,377777 ;DOES Q-REG CONTAIN TEXT?
TLZN B,400000
ERROR ^D9
;NO
ADD B,QRBUF ;YES
MOVE I,B ;IN:=Q-REG BUFFER ADDRESS
MOVE B,CH ;SAVE INDEX
PUSHJ P,GETINC ;IS FIRST CHARACTER IN BUFFER 141?
CAIE CH,141
ERROR ^D10
;NO
PUSHJ P,GETINC ;C:=LENGTH OF STRING
MOVEM CH,C
PUSHJ P,GETINC
ROT CH,7
IORM CH,C
SUBI C,3
PUSHJ P,NROOM ;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE OU,PT
HRRZ I,QTAB-"0"(B)
ADD I,QRBUF
ADDI I,3
QGET1: JUMPE C,RET ;MOVE STRING INTO DATA BUFFER
PUSHJ P,GETINC
PUSHJ P,PUT
AOS OU,PT
SOJA C,QGET1
;]I POPS Q-REGISTER I OFF THE Q-REGISTER PUSHDOWN LIST.
; THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.
CLOSEB: SKIPA C,[POP PF,]
;[I PUSHES Q-REGISTER I ONTO THE Q-REGISTER PUSHDOWN LIST.
OPENB: MOVSI C,261000+PF*40
PUSHJ P,QREGVI
HRRI C,QTAB-"0"(CH) ;C:=Q-REGISTER INDEX.
XCT C ;PUSH OR POP Q-REGISTER.
TRNE FF,ARG ;IS THERE AN ARGUMENT?
JRST CD2 ;YES. DON'T DESTROY IT.
JRST RET ;NO. CLEAR FLAGS.
;E COMMANDS SELECT AND CONTROL FILE INPUT-OUTPUT MEDIA
ECMD: PUSHJ P,RCH
TRZ CH,40 ;LC TO UC
CAIN CH,"R" ;NO. ER?
JRST OPNRD ;YES. NEW INPUT FILE.
CAIN CH,"W" ;NO. EW?
JRST OPNWR ;YES. NEW OUTPUT FILE.
CAIN CH,"F" ;NO. EF?
JRST CLOSEF ;YES. CLOSE OUTPUT FILE.
CAIN CH,"Z" ;NO. EZ?
JRST ZERDIR ;YES. CLEAR DIRECTORY.
CAIN CH,"M" ;NO. EM?
JRST EMTAPE ;YES. EXECUTE MTAPE UUO.
CAIN CH,"B" ;NO. EB?
JRST EBAKUP ;YES. BACKUP SYSTEM
CAIN CH,"X" ;EX?
JRST FINISH ;YES. DO 69000PEF<DING>
ERROR ^D11
;NO. COMMAND ERROR.
U FILDEV,1 ;FILSPC+1(0),FILSP1+1
U FILNAM,4 ;NAME IN SIXBIT. FILSPC+2(0),FILLS1+5
;(EXT)BLK #. FILSPC+3(0),FILLS1+2
;PROT,DATE. FILSPC+4(0)
;(PROJ)PROG. FILSPC+5(0),FILSPS,FILSP6
U BAKNAM,2 ;FOR THE BACKUP NAME
FINIS1: TRNE FF,ARG+ARG2 ;ARGUMENT?
ERROR ^D46 ;SHOULDNT BE.
TLON FF,UREAD ;SAY READING A FILE. TRUE?
TLO FF,FINF ;NO, SO ALSO SAY EOF.
MOVSI B,1 ;A LARGE NUMBER OF PAGES
PUSHJ P,PUNCH ;PUNCH THOSE PAGES
JRST CLOSEF ;CLOSE AND RENAME FILES
;RETURN FROM FINIS1
FINISH: PUSHJ P,FINIS1 ;FINISH UP.
JRST DECDMP ;AND CALL EXIT
;ER PREPARE TO READ FILE
OPNRD: TLZ FF,FINF ;NOT EOF
TLOE FF,UREAD ;SET INPUT FILE OPEN FLAG. WAS IT ON?
RELEAS INCHN,0 ;YES. RELEASE IT BEFORE OPENING NEW FILE.
PUSHJ P,FILSPC ;GET FILE SPEC
MOVEI E,1
MOVEM E,OPNRI
MOVE E,FILDEV ;INITIALIZE OPEN UUO ARGUMENTS
MOVEM E,OPNR1
MOVEI E,IBUF
MOVEM E,OPNRB
OPEN INCHN,OPNRI ;OPEN INPUT FILE
JRST ININER
MOVE T,.JBFF
MOVEI E,IBUF1
MOVEM E,.JBFF
INBUF INCHN,2
MOVEM T,.JBFF
LOOKUP INCHN,FILNAM
JRST TYINPT
POPJ P,
EBAKUP: PUSHJ P,OPNRD ;READ THE SPECIFIED FILE
MOVE E,FILNAM ;SAVE IT
MOVEM E,BAKNAM ;IN BACKUP STORE
HLLZ E,FILNAM+1 ;AND THE EXTENSION
MOVEM E,BAKNAM+1
MOVE E,JOBN
LSH E,3
IOR E,JOBN
TRZ E,70
TRO E,2020
IOR E,[SIXBIT /TECO/] ;MAGIC NAME
MOVEM E,FILNAM
MOVEM E,BAKTMP ;SAVE FOR DTA RENAME
MOVSI E,(SIXBIT /TMP/)
MOVEM E,FILNAM+1
SETZM FILNAM+2
PUSHJ P,OPNW4 ;WRITE THE TMP FILE
PUSHJ P,OPNW2
TLO FF,UBAK
POPJ P,0
U OPNRI,1 ;INPUT FILE OPEN ARGUMENTS. OPNRD+4(1)
U OPNR1,1 ;INPUT DEVICE. INIT+27(0),OPNRD+6
U OPNRB,1 ;INITIALIZE TO XWD 0,INBUF. OPNRD+10
U BAKTMP,1 ;FOR DECTAPE TEMP NAME
;TYPE INPUT DEVICE ERROR
TYINPT: JSP A,ERRMES
ASCIZ /INPUT ERROR.../
JRST ERRMG2
;TYPE OUTPUT ERROR
ENTERR: JSP A,ERRMES
ASCIZ /OUTPUT ERROR.../
;SELECT AND TYPE THE ERROR CONDITION GIVEN BY THE
;MONITOR IN RESPONSE TO ERRORS IN LOOKUP AND ENTER.
;TYPE 6 HAS NOT BEEN INVENTED YET, BUT MAY BE ENTERED
;INTO THE DISPATCH TABLE BELOW
ERRMG2: MOVE E,FILNAM+1 ;GET ERROR NUMBER PROVIDED
ANDI A,-1 ;INPUT OR OUTPUT SWITCH
ANDI E,7 ;ISOLATE THE NUMBER FOR FURTHER OPERATIONS
CAIN A,ERRMG2-1 ;WAS THIS AN OUTPUT ERROR?
JUMPE E,IOFN ;YES,TYPE 0 ERROR,ILL NAME
HRRZ A,EDSP(E) ;ANTICIPATE RIGHT BANK
CAILE E,3 ;BE SURE THIS IS SO
HLRZ A,EDSP-4(E) ;BLUNDER
JRST @A ;PERFORM THE DISPATCHED ROUTINE
;UPDATE THIS DISPATCH TABLE IF 6 INVENTED
EDSP: XWD RNFAIL,NTFD ;RENAME.......NOT FOUND
XWD RNFAIL,IPP ;RENAME.......INCORRECT PP#
XWD USP,FPR ;UNDEFINED....FILE PROTECT FAILURE
XWD NDV,FBM ;NO DEVICE....FILE BEING MODIFIED
;;TYPE 0 ERROR ON INPUT ONLY
NTFD: PUSHJ P,LKUPER ;TYPE NAME.EXT
JSP A,CONMES
ASCIZ / FILE NOT FOUND
/
ERROR ^D12
;TYPE 0 ERROR ON OUTPUT ONLY
IOFN: SKIPE FILNAM
JRST DIF
JSP A,CONMES
ASCIZ / ILLEGAL NAME FORMAT
/
ERROR ^D13
;TYPE 1 ERROR, ILLEGAL PROJECT PROGRAMMER NUMBER
IPP: PUSHJ P,LKUPER ;TYPE NAME.EXT
JSP A,CONMES
ASCIZ / INCORRECT PROJECT-PROGRAMMER NUMBER
/
ERROR ^D14
;TYPE 2 ERROR, FILE PROTECT FAILURE
FPR: PUSHJ P,LKUPER ;TYPE NAME.EXT
JSP A,CONMES
ASCIZ / FILE PROTECT FAILURE
/
ERROR ^D15
;TYPE 3 ERROR, FILE BEING MODIFIED
FBM: PUSHJ P,LKUPER ;TYPE NAME.EXT
JSP A,CONMES
ASCIZ / FILE BEING MODIFIED
/
ERROR ^D16
;TYPE 6 NOT YET INVENTED
USP: PUSHJ P,LKUPER ;TYPE NAME.EXT
JSP A,CONMES
ASCIZ % UNDEFINED I/O ERROR
%
ERROR ^D17
;TYPE 7 ERROR, NO DEVICE
NDV: JSP A,CONMES
ASCIZ / NO DEVICE ASSIGNED
/
ERROR ^D18
;DIRECTORY FULL MESSAGE
DIF: JSP A,CONMES
ASCIZ /DIRECTORY IS FULL
/
ERROR ^D19
ININER: JSP A,ERRMES
ASCIZ /DEVICE /
MOVE A,FILDEV
PUSHJ P,SIXBMS
JSP A,CONMES
ASCIZ / NOT AVAILABLE
/
ERROR ^D20
LKUPER: MOVE A,FILNAM
PUSHJ P,SIXBMS
HLLZ A,FILNAM+1
JUMPE A,LKUPE1
MOVEI CH,"."
PUSHJ P,TYO
PUSHJ P,SIXBMS
LKUPE1: POPJ P,
ERROR ^D21
RNFAIL: PUSHJ P,LKUPER ;TYPES 4,5
JSP A,CONMES
ASCIZ /RENAME FAILURE
/
ERROR ^D45
;EW SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)
OPNWR: PUSHJ P,OPNW1
OPNW2: ENTER OUTCHN,FILNAM
JRST ENTERR
POPJ P,
OPNW1: TLNE FF,UBAK
ERROR ^D22
PUSHJ P,FILSPC
OPNW4: TLOE FF,UWRITE ;CALL HERE FROM EB
RELEAS OUTCHN,0
MOVEI E,1
MOVEM E,OPNWI
MOVE E,FILDEV
MOVEM E,OPNWD
MOVSI E,OBF
MOVEM E,OPNWB
OPEN OUTCHN,OPNWI
JRST ININERR
MOVE T,.JBFF
MOVEI E,OBUF1
MOVEM E,.JBFF
OUTBUF OUTCHN,2
MOVEM T,.JBFF
POPJ P,0
U OPNWI,1 ;OUTPUT FILE OPEN ARGUMENTS. OPNW1+4(1)
U OPNWD,1 ;OUTPUT DEVICE. OPNW1+6
U OPNWB,1 ;OUTBUT BUFFER HEADER ADDRESS. OPNW1+10(OUTBUF)
;EZ SELECTS THE OUTPUT DEVICE, ISSUES A REWIND COMMAND TO IT,
; ISSUES A COMMAND TO ZERO ITS DIRECTORY, AND OPENS THE FILE
; SPECIFIED (IF ANY).
ZERDIR: PUSHJ P,OPNW1 ;DETERMINE OUTPUT DEVICE
CALLI OUTCHN, UTPCLR ;CLEAR DIRECTORY OF OUTPUT DEVICE
MTAPE OUTCHN,1 ;REWIND OUTPUT DEVICE
JRST OPNW2 ;ENTER FILE
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
CLOSEF: TLNE FF,UBAK
PUSHJ P,BAKCLS
TLZN FF,UWRITE
POPJ P,
CLOSE OUTCHN,2
STATZ OUTCHN,740000
JRST OUTERR
TLZN FF,UBAK
JRST CLSF1
PUSH P,FILNAM
PUSH P,FILNAM+1 ;DECTAPE NEEDS A SECOND LOOKUP
MOVE A,BAKTMP ;TEMP NAME
MOVEM A,FILNAM
MOVSI A,(SIXBIT /TMP/) ;.TMP
MOVEM A,FILNAM+1
SETZM FILNAM+3
LOOKUP OUTCHN,FILNAM
JFCL ;CANT POSSIBLY FAIL
POP P,FILNAM+1
POP P,FILNAM ;RESTORE REAL FILE NAME
CLOSE OUTCHN,2 ;CLOSE OUTPUT FOR RENAME
RENAME OUTCHN,FILNAM
JRST ENTERR
CLSF1: RELEAS OUTCHN,0
POPJ P,
;EM EXECUTE MTAPE UUO.
EMTAPE: TLNN FF,UREAD
ERROR ^D23
PUSHJ P,CHK2
CAIGE B,20
CAIGE B,1
ERROR ^D24
MTAPE INCHN,0(B)
POPJ P,
;THIS ROUTINE IS CALLED AT EF IF AN EB WAS DONE. IT DOES
;THE WORK OF MAKING THE INPUT FILE HAVE THE EXTENSION .BAK ,
;DELETING ANY PREVIOUS FILE.BAK, AND RENAMING THE NEW OUTPUT
;FILE AS THE ORIGINAL FILE.EXT
BAKCLS: TLNN FF,UREAD+FINF
ERROR ^D25
CLOSE INCHN,0
MOVE E,BAKNAM
MOVEM E,FILNAM
MOVSI E,(SIXBIT /BAK/)
MOVEM E,FILNAM+1
SETZM FILNAM+2
LOOKUP INCHN,FILNAM
JRST BKCLS1
CLOSE INCHN,0
SETZM FILNAM
SETZM FILNAM+1
RENAME INCHN,FILNAM
JRST ENTERR
BKCLS1: MOVE E,BAKNAM
MOVEM E,FILNAM
HLLZ E,BAKNAM+1
MOVEM E,FILNAM+1
LOOKUP INCHN,FILNAM
JRST ENTERR
CLOSE INCHN,0
MOVSI E,(SIXBIT /BAK/)
MOVEM E,FILNAM+1
RENAME INCHN,FILNAM
JRST ENTERR
MOVE E,BAKNAM+1
MOVEM E,FILNAM+1
POPJ P,0
;ROUTINE TO PARSE FILE DESIGNATOR
FILSPC: TLZ FF,FILWD
SETZM FILDEV ;CLEAR FILE DESIGNATOR ARGUMENTS.
SETZM FILNAM
SETZM FILNAM+1
SETZM FILNAM+2
SETZB E,FILNAM+3
;FROM FILSPL+21,FILSP1+3,FILSP3+3,FILSP6+1
FILSPL: PUSHJ P,SKRCH ;GET NEXT COM CHARACTER. ERROR IF COMMAND BUFFER EMPTY.
CAIN CH,175
JRST FILSP2 ;ALT MODE
CAIL CH,140 ;LC TO UC
TRZ CH,40
CAIN CH,":"
JRST FILSP1 ;DEVICE
CAIN CH,"."
JRST FILSP3 ;EXTENSION MARK
CAIN CH,"["
JRST FILSP4 ;PROJ PROG PAIR
PUSHJ P,DQT2 ;LETTER OR DIGIT?
TRZA B,777700 ;YES. DQT2 LEAVES CHARACTER IN B AND CH.
ERROR ^D26 ;NO
TRC B,40 ;CONVERT TO SIXBIT.
ROT B,-6
TLNN E,770000 ;SIX CHARACTERS YET?
ROTC B,6 ;NO. PACK IT INTO E
TLO FF,FILWD ;YES.
JRST FILSPL
;END OF DESIGNATOR. STORE FILE NAME OR EXTENSION AND RETURN
;THROW IN DSK IF NEEDED
FILSP2: PUSHJ P,FILLSH
MOVSI E,(SIXBIT /DSK/)
SKIPN FILDEV
MOVEM E,FILDEV
POPJ P,0
;ROUTINE TO LEFT JUSTIFY E AND STORE IN FILE NAME OR FILE EXTENSION.
;CALL MOVE E,SIXBIT NAME RIGHT JUSTIFIED
; SET FILWD OR FEXTF FLAG
; PUSHJ P,FILLSH
; RETURN
;FROM FILSP1,FILSP3,FILSP4
FILLSH: SKIPE E ;NULL NAME?
TLNE E,770000 ;NO. LEFT JUSTIFIED?
JRST FILLS1 ;YES.
LSH E,6 ;NO.
JRST .-3
FILLS1: TLZN FF,FEXTF ;EXTENSION?
JRST .+3 ;NO.
HLLZM E,FILNAM+1 ;YES. STORE IT.
TLZ FF,FILWD
TLZE FF,FILWD ;FILE NAME?
MOVEM E,FILNAM ;YES. STORE IT.
POPJ P,0 ;NO. RETURN.
;DEVICE NAME
FILSP1: TLZ FF,FILWD+FEXTF ;RESET THESE FLAGS FOR DEVICE LOAD
PUSHJ P,FILLSH ;LEFT JUSTIFY IT.
MOVEM E,FILDEV
FILS1A: MOVEI E,0
JRST FILSPL
;FILE NAME EXTENSION FOLLOWS
FILSP3: PUSHJ P,FILLSH ;STORE FILE NAME.
TLO FF,FEXTF ;GET EXTENSION.
JRST FILS1A
;PROJECT-PROGRAMMER PAIR
FILSP4: PUSHJ P,FILLSH ;STORE NAME OR EXTENSION.
MOVEI B,"," ;SCAN FOR ,
PUSHJ P,FILSPP
FILSP5: HRLZM E,FILNAM+3 ;STORE PROJECT NUMBER.
MOVEI B,"]" ;SCAN FOR ]
PUSHJ P,FILSPP
FILSP6: HRRM E,FILNAM+3
JRST FILSPL
FILSPP: MOVEI E,0
FILS4L: PUSHJ P,SKRCH ;GET NEXT COMMAND CHARACTER.
CAIN CH,(B) ;DELIMITER?
POPJ P, ;YES
PUSHJ P,FILSOC
JRST FILS4L
FILSOC: XORI CH,60
CAIL CH,12
ERROR ^D27
LSH E,3
ADDI E,(CH)
POPJ P,
;Y RENDER THE BUFFER EMPTY. READ INTO THE BUFFER UNTIL
; (A) A FORM FEED CHARACTER IS READ, OR
; (B) THE BUFFER IS WITHIN ONE THIRD OR
;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, OR
; (C) AN END OF FILE IS READ, OR
; (D) THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES NOT ENTER THE BUFFER.
YANK:
YANK1: MOVE OU,BEG
MOVEM OU,PT ;PT:=BEG
YANK2: TRZ FF,FORM ;RESET THE YANK,APPEND FORM FEED FLAG
;MAINTAIN AT LEAST A MINIMUM SIZE BUFFER OF 5000
;CHARACTERS AT ALL TIMES, WHEN TECO ASKS FOR INPUT FROM
;ANYTHING BUT THE CONSOLE.
PUSH P,17 ;SAVE AC#17
MOVE 17,MEMSIZ ;TOTAL CHARACTERS AVAILABLE
SUB 17,OU ;THIS IS TOTAL IN BUFFER FOR Y (OR P),
; OR ABOVE BUFFER IF "A" COMMAND
CAIG 17,^D3000 ;HAVE WE 3000 CHARACTERS?
PUSHJ P,GRABAK ;NO, GET 1 K OF CORE
POP P,17 ;RESTORE AC#17
JRST YANK4 ;PRE-CHECK FOR SPACE
YANK3: TLNN FF,UREAD ;HAS AN INPUT FILE BEEN SPECIFIED?
JRST YANK09 ;NO.
SOSLE IBUF+2 ;YES. IS DEVICE BUFFER EMPTY?
JRST YANK5 ;NO.
INPUT INCHN,0 ;YES. FILL IT.
STATZ INCHN,740000 ;ERROR?
JRST INERR ;YES.
STATO INCHN,20000 ;NO. END OF FILE?
JRST YANK5 ;NO.
TLZ FF,UREAD ;YES. DE-SELECT INPUT FILE.
TLO FF,FINF
JRST YANK51 ;CLEAR BUFFER AND RETURN.
YANK5: ILDB CH,IBUF+1 ;CH:=NEXT CHARACTER.
JUMPE CH,YANK3 ;IF NULL, IGNORE IT.
MOVE T,@IBUF+1
TRNE T,1 ;SEQUENCE NUMBER?
JRST YNKSEQ ;YES. IGNORE THEM.
PUSHJ P,PUT ;NO. PUT CHARACTER IN DATA BUFFER.
CAIE CH,14 ;FORM FEED?
AOJA OU,YANK4 ;NO. UPDATE DATA BUFFER POINTER AND CHECK FOR OVERFLOW.
TRO FF,FORM ;YANK AND/OR APPEND TERMINATED ON A LFORM FEED
YANK51: MOVEM OU,Z ;YES. SET END OF DATA BUFFER AND RETURN
POPJ P,0
YANK09: SKIPE OPNR1 ;INPUT DEVICE SPECIFIED?
JRST YANK51 ;YES. CLEAR BUFFER.
JSP A,ERRMES ;NO.
ASCIZ /NO FILE FOR INPUT
/
ERROR ^D28
YNKSEQ: MOVNI T,5 ;IGNORE SEQ. NO. AND FOLLOWING TAB
ADDM T,IBUF+2 ;DECREASE CHAR COUNT BY 5
AOS IBUF+1 ;INCREMENT POINTER OVER SEQ. NO., & TAB
JRST YANK3
INERR: JSP A,ERRMES
ASCIZ /ERROR ON INPUT DEVICE
/
ERROR ^D29
YANK4: MOVE T,M23
CAIL T,(OU) ;WITHIN 128 CHARACTERS FROM TOP OF MEMORY?
JRST YANK3 ;NO. GET MORE.
MOVE T,M23PL ;!!!!!!!!!!!!!!TEST!!!!!!!!!
CAILE T,0(OU) ;YES. FULL?
CAIN CH,12 ;NO. LINE FEED?
JRST YANK51 ;YES. THAT'S ALL.
JRST YANK3 ;NO. GET MORE.
;A APPEND TO THE END OF THE BUFFER FROM THE SELECTED INPUT
; TERMINATING THE READ IN THE SAME MANNER AS Y. THE POINTER
; IS NOT MOVED BY A.
APPEND: MOVE OU,Z ;STORE DATA AT END OF BUFFER.
PUSHJ P,YANK2
JRST RET
;^ITEXT$ INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB)
; AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE
; ALT MODE. THE POINTER IS PUT TO THE RIGHT OF THE INSERTED
; MATERIAL.
TAB: PUSHJ P,TAB2 ;INSERT TAB
;ITEXT$ INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
; THE I UP TO BUT NOT INCLUDING THE FIRST ALT. MODE. THE
; POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.
INSERT: TRNE FF,ARG ;IS THERE AN ARGUMENT?
JRST INS1A ;YES. NI COMMAND.
MOVEI CH,175 ;NO. CH:=ALT-MODE.
TRZE FF,SLSL ;DID @ PRECEED I?
PUSHJ P,RCH ;YES. CH:=USER SELECTED TERMINATOR.
MOVEM CH,A ;A:=INSERTION TERMINATOR.
;EITHER ALT-MODE OR USER CHOICE.
MOVE B,CPTR ;SAVE CURRENT POSITION OF CPTR.
MOVEI C,0 ;COUNT # CHARACTERS TO INSERT IN C AND
;MOVE CPTR TO END OF STRING.
PUSHJ P,SKRCH ;GET NEXT CHARACTER
CAME CH,A ;IS IT THE TERMINATOR?
AOJA C,.-2 ;NO. TRY AGAIN.
PUSHJ P,NROOM ;YES. MOVE FROM PT THROUGH Z UP C POSITIONS.
ADD B,CRREL ;RELOCATE INITIAL VALUE OF CPTR IN CASE OF GARB. COL.
;MOVE INSERTION INTO DATA BUFFER
INS1B: MOVE OU,PT
ILDB CH,B ;CH:=CHARACTER FROM COMMAND STRING.
CAMN CH,A ;IS IT THE TERMINATOR?
POPJ P, ;YES. DON'T STORE IT.
PUSHJ P,PUT ;NO. STORE CHARACTER IN DATA BUFFER TO RIGHT OF PT.
AOS PT ;PT:=PT+1
JRST INS1B ;LOOP
;NI INSERT AT THE POINTER A CHARACTER WHOSE 7-BIT ASCII CODE IS N
; (BASE 10). THE POINTER IS MOVED TO THE RIGHT OF THE NEW CHARACTER.
INS1A:
TAB1: MOVE CH,NUM ;CH:=NUM
;INSERT CH IN DATA BUFFER AT PT
TAB2: MOVEI C,1 ;MOVE FROM PT THROUGH Z UP 1 POSITION.
PUSHJ P,NROOM
AOS OU,PT ;PT:=PT+1
SOJA OU,PUT ;STORE CH AT PT-1
;@IJTEXTJ INSERT, AT THE CURRENT POINTER POSITION, THE TEXT
; SURROUNDED BY THE INSTANCES OF THE TERMINATOR J, WHICH MAY BE AT
; THE USER'S CHOICE ANY CHARACTER NOT APPEARING IN THE TEXT.
; THE POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.
ATSIGN: TRO FF,SLSL ;SLSL:=1
JRST RET
;NBACKSLASH INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
; EQUAL TO N.
BAKSL1: MOVE T,[XWD 700,BAKTAB-1]
MOVEI C,0 ;COUNT # DIGITS IN C.
MOVEI CH,BAKSL4 ;SET DPT TO RETURN TO BAKSL4
HRRM CH,LISTF5
PUSHJ P,DPT ;CONVERT C(B) TO ASCII AND STORE STRING IN BAKTAB.
MOVEI A,141 ;MARK END OF STRING IN BAKTAB
IDPB A,T
MOVE B,[XWD 700,BAKTAB-1]
PUSHJ P,NROOM ;MOVE FROM PT THROUGH Z UP C POSITIONS.
PUSHJ P,INS1B ;INSERT STRING IN BAKTAB INTO DATA BUFFER AT PT.
JRST RET
BAKSL4: IDPB CH,T ;STORE DIGIT IN BAKTAB
AOJA C,CPOPJ ;C:=C+1. RETURNS TO DPT CALL + 1 ON COMPLETION.
;NT TYPE OUT THE STRING OF CHARACTERS STARTING AT THE RIGHT OF THE
; POINTER AND CONTINUING THROUGH THE NTH LINE FEED ENCOUNTERED.
; IF N IS NEGATIVE, N LINES TO THE LEFT OF THE POINTER ARE TYPED.
;T SAME AS 1T.
;I,JT TYPE OUT THE (I+1)TH THROUGH THE JTH CHARACTER OF THE BUFFER.
TYPE:
TYPE4: MOVEI D,TYO ;D:=ADDRESS OF OUTPUT ROUTINE.
TYPE0: PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS.
;B:=SECOND STRING ARGUMENT ADDRESS.
TYPE1: PUSHJ P,CHK1 ;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
MOVE I,C ;START GETTING CHARACTERS AT C.
TYPE3: CAML I,B ;DONE?
JRST TYPE5 ;YES.
MOVE TT,I ;NO. GET NEXT CHAR
IDIVI TT,5 ;THIS IS A COPY OF GETINC
HLL TT,BTAB(TT1) ;..
LDB CH,TT ;COPIED TO SPEED IT UP
ADDI I,1 ;..
PUSHJ P,(D) ;OUTPUT IT
JRST TYPE3 ;LOOP
TYPE5: MOVEI A,PPA
MOVEI CH,14 ;IF PUNCHING, APPEND FF.
CAIE A,(D) ;D=PPA?
POPJ P, ;NO
TRNN FF,PCHFLG ;IS THIS AN "N" SEARCH?
JRST PPA ;NO, APPEND A FORM FEED
TRNN FF,FORM ;DID LAST Y,A TERMINATE ON A FORM FEED?
POPJ P, ;NO,DO NOT APPEND ONE
CPPA: JRST PPA ;YES. APPEND FF.
PPA: TLNN FF,UWRITE ;OUTPUT FILE OPEN?
JRST PPA09 ;NO.
SOSLE OBF+2 ;YES. IS OUTPUT BUFFER FULL?
JRST PPA01 ;NO.
OUTPUT OUTCHN,0 ;YES. WRITE IT
STATZ OUTCHN,740000 ;ERROR?
JRST OUTERR ;YES.
PPA01: IDPB CH,OBF+1 ;NO. CH TO OUTPUT BUFFER.
POPJ P,0 ;RETURN
PPA09: JSP A,ERRMES
ASCIZ /NO FILE FOR OUTPUT
/
ERROR ^D30
OUTERR: JSP A,ERRMES
ASCIZ /ERROR ON OUTPUT DEVICE; FILE CLOSED
/
RELEAS OUTCHN,0 ;CLOSE FILE AND RELEASE OUTPUT DEVICE.
TLZ FF,UWRITE ;CLEAR OUTPUT FILE OPEN INDICATOR.
JRST GOX ;CLEAR COMMAND BUFFER AND WAIT FOR NEXT COMMAND.
;PW OUTPUT THE ENTIRE BUFFER, FOLLOWED BY A FORM FEED CHARACTER.
; TO THE SELECTED OUTPUT DEVICE. BUFFER IS UNCHANGED AND POINTER
; IS UNMOVED.
;P IS IDENTICAL TO PWY.
;NP IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER. NO FORM
; FEED IS PUT AT THE END. BUFFER UNCHANGED; POINTER UNMOVED.
PUNCH:
PUNCHA: MOVEI D,CPPA ;SELECT PPA FOR OUTPUT.
TRNE FF,ARG2 ;I,JP?
JRST TYPE0 ;YES. GET STRING ARGUMENTS AND OUTPUT.
MOVE E,B ;NO. E:=N
MOVE B,CPTR
ILDB T,B ;T:=COMMAND CHARACTER FOLLOWING P.
TRZ T,40 ;FILTER L.C.
JUMPL E,CPOPJ ;IF N<0, IGNORE P.
PUN1: PUSHJ P,PUNCHR ;PUNCH OUT BUFFER
TLNE FF,FINF ;DONT TRY TO READ IF NO DATA LEFT
POPJ P,0 ;PREVENTS ERROR IF NO INPUT FILE AND EB
SKIPE COMCNT ;IF NO COMMANDS LEFT
CAIE T,"W" ;OR COMMAND IS NOT W
PUSHJ P,YANK1 ;RENEW BUFFER
MOVE C,Z
CAMN C,BEG ;EMPTY BUFFER?
TLNN FF,FINF ;NO. QUIT ON EOF
SOJG E,PUN1 ;YES. E:=E-1. DONE?
;YES
CPOPJ: POPJ P,0
PUNCHR: MOVE C,BEG ;OUTPUT DATA BUFFER.
MOVE B,Z
MOVEI D,PPA
JRST TYPE1
;NJ MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE
; BUFFER. (I.E., GIVE "." THE VALUE N.)
;J SAME AS 0J.
JMP: ADD B,BEG ;PT:=N+BEG
JRST JMP1
;NR SAME AS .-NJ.
REVERS: PUSHJ P,CHK2 ;MAKE SURE THERE IS AN ARGUMENT
MOVNS B ;B:=-C(B)
SKIPA
;NC SAME AS .+NJ. NOTE THAT N MAY BE NEGATIVE.
CHARAC: PUSHJ P,CHK2 ;MAKE SURE THERE IS AN ARGUMENT
ADD B,PT ;B:=PT+C(B)
;IF B LIES BETWEEN BEG AND Z, STORE IT IN PT.
JMP1: PUSHJ P,CHK ;IS C(B) WITHIN DATA BUFFER?
MOVEM B,PT ;YES. PT:=C(B)
JRST RET
;NL IF N>0: MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
; PASSED OVER N LINE FEEDS.
; IF N<0: MOVE POINTER TO THE LEFT; STOP WHEN IT HAS PASSED
; OVER N+1 LINE FEEDS AND THEN MOVE IT TO THE RIGHT OF
; THE LAST LINE FEED PASSED OVER.
;L SAME AS 1L.
LINE: TRNE FF,ARG2 ;IS THERE A SECOND ARGUMENT?
ERROR ^D31 ;YES. TOUGH
PUSHJ P,GETARG ;NO. C:=FIRST STRING ARGUMENT ADDRESS,
;B:=SECOND STRING ARGUMENT ADDRESS.
XOR B,C
XORM B,PT
JRST RET
;ROUTINE TO RETURN CURRENT ARGUMENT IN B
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR IF THERE IS NO CURRENT ARGUMENT
;CALL PUSHJ P,CHK2
; RETURN WITH B:=CURRENT ARG.,+1 OR -1
CHK2: TROE FF,ARG ;IS THERE AN ARGUMENT?
POPJ P, ;YES. IT'S ALREADY IN B.
;NO
CHK22: LDB B,[XWD 340200,DLIM] ;B:=1 WITH SIGN OF LAST OPERATOR.
MOVNS B
AOJA B,CPOPJ
;CD9(K)
;NK PERFORM NL BUT DELETE EVERYTHING THE POINTER MOVES OVER.
;M,NK DELETE THE (M+1)TH THROUGH THE NTH CHARACTER FROM THE BUFFER.
; THE POINTER IS THEN PUT WHERE THE DELETION TOOK PLACE.
;K SAME AS 1K
KILL: PUSHJ P,GETARG ;C:=FIRST STRING ARG. ADDRESS
;B:=SECOND STRING ARG. ADDRESS
PUSHJ P,CHK1 ;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
MOVEM C,PT ;PT:=C(C)
SUB B,C ;B:=NO. OF CHARACTERS TO KILL.
JUMPE B,RET ;IF NONE, RETURN. OTHERWISE, FALL INTO DELETE
;ND DELETE N CHARACTERS FROM THE BUFFER: IF N IS POSITIVE, DELETE
; THEM JUST TO THE RIGHT OF THE POINTER; IF N IS NEGATIVE, DELETE
; THEM JUST TO ITS LEFT.
;D SAME AS 1D
DELETE: PUSHJ P,CHK2 ;MAKE SURE B CONTAINS AN ARGUMENT
MOVM C,B
MOVNS C ;C:=-ABS(B)
ADD B,PT ;B:=PT+B
PUSHJ P,CHK ;STILL IN DATA BUFFER?
CAMGE B,PT ;YES. IS N NEGATIVE?
MOVEM B,PT ;YES. MOVE PT BACK FOR DELETION.
PUSHJ P,NROOM ;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
DEL2:
JRET: JRST RET
;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL MOVE B,POINTER
; PUSHJ P,CHK
; RETURN IF B LIES BETWEEN BEG AND Z
CHK: CAMG B,Z
CAMGE B,BEG
ERROR ^D32
POPJ P,
;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL MOVE C,FIRST STRING ARGUMENT ADDRESS
; MOVE B,SECOND STRING ARGUMENT ADDRESS
; PUSHJ P,CHK1
; RETURN
;C:=MAX*_xC),BEG), B:=MIN(C(B),Z)
;IF C>B, DOES NOT RETURN.
CHK1: CAMG C,BEG ;C:=MAX(C(C),BEG)
MOVE C,BEG
CAML B,Z ;B:=MIN(C(B),Z)
MOVE B,Z
CAMLE C,B ;C>B?
ERROR ^D33 ;YES.
POPJ P, ;NO
LARR: TROA FF,FINDR ;FINDR:=1 FOR LEFT ARROW SEARCH
SERCHP: TRO FF,PCHFLG ;PCHFLG:=1 FOR N SEARCH
;CD9(S)
JRST SERCH
SQCB: MOVE TT,PT
MOVEM TT,Q1
JRST SQCBBB
SQCBB: MOVE TT,Q1
SQCBBB: IDIVI TT,5
HLL TT,BTAB(TT1)
LDB CH,TT
AOS Q1
CAIE CH,12
JRST SQCBB
SOS Q1
MOVE TT,Q1
MOVEM TT,QZ
JRST SERCH2
SQCC: SETOM QCCFLG
JRST SERCH2
SQCP: MOVE TT,PT
ADDI TT,1
MOVEM TT,QZ
JRST SERCH2
SERCH: SETZM QCCFLG
MOVE E,PT
MOVEM E,SQPT
MOVE E,Z
MOVEM E,QZ
MOVE E,B ;E:=ARGUMENT (IF ANY)
CLEARM NUM ;NUM:=0
MOVEI CH,175 ;USE ALT-MODE DELIMITER IF NO @ SEEN
TRZE FF,SLSL ;@ SEEN?
PUSHJ P,RCH ;YES. CH:=USER SPECIFIED DELIMITER.
MOVEM CH,B ;B:=SEARCH STRING DELIMITER
HRLZI F,STAB-STABP ;F:=XWD -LENGTH OF SEARCH TABLE,0
;SET UP SEARCH TABLE
SERCH2: PUSHJ P,SKRCH ;CH:=NEXT COMMAND STRING CHARACTER.
CAIN CH,(B) ;DELIMITER?
JRST SERCH1 ;YES. DONE.
SKIPE 0,QED
JRST SERCHQ
CAIN CH,2
JRST SQCB
CAIN CH,3
JRST SQCC
CAIN CH,20
JRST SQCP
SERCHQ: CAIN CH,30 ;NO. ^X?
JRST CNTRX ;YES
CAIN CH,16 ;NO. ^N?
JRST CNTRN ;YES.
CAIN CH,23 ;NO. ^S?
JRST CNTRB ;YES
CAIN CH,21 ;NO. ^Q?
PUSHJ P,SKRCH ;YES. ^Q TAKES THE NEXT CHARACTER.
HRLI CH,306000+CH*40 ;CH:=CAIN CH,CHARACTER
SERCH4: TRZE FF,NOTF ;SEARCH SENSE REVERSED?
TLC CH,4000 ;YES. CH:=CAIE CH,CHARACTER
;PUSHJ P,CNTRB1, OR CAIA
MOVEM CH,STAB(F) ;SAVE IN SEARCH TABLE
AOBJN F,SERCH2 ;GET NEXT CHARACTER
ERROR ^D34 ;SEARCH TABLE IS FULL
;START SEARCHING
SERCH1: MOVE I,PT ;START SEARCHING AT PT
MOVEM I,QI
TRNE FF,ARG ;IS THERE AN ARGUMENT?
JUMPLE E,FND ;YES. SEEN STRING N TIMES?
CAML I,QZ ;NO. REACHED TOP OF BUFFER?
JRST NOFND ;YES.
MOVEI D,STAB
SERCH3: CAIN D,STAB(F) ;END OF SEARCH TABLE?
JRST FND ;YES.
MOVE TT,I ;NO. CH:=NEXT DATA BUFFER CHARACTER.
IDIVI TT,5 ;THIS IS COPY OF GETINC
HLL TT,BTAB(TT1) ;COPIED FOR SPEED
LDB CH,TT
ADDI I,1
XCT (D)
SERCH5: AOJA D,SERCH3 ;MATCH FOUND. GO TO NEXT TABLE ENTRY.
SRCH5A: AOS PT ;NO MATCH. PT:=PT+1
JRST SERCH1 ;KEEP LOOKING
FND: CAMLE I,QZ ;REACH TOP OF BUFFER?
JRST NOFND ;YES. SEARCH FAILED.
SETOM SFINDF ;NO. SFINDF:=-1
SKIPE QCCFLG
MOVE I,QI
MOVEM I,PT ;MOVE PT PAST THE STRING
SOJG E,SERCH1 ;FIND IT N TIMES?
TRZN FF,COLONF ;YES. COLON MODIFIER?
JRST RET ;NO. DONE
FFOK: MOVNI A,1 ;YES. RETURN VALUE OF -1
JRST VALRET
NOFND: MOVE I,SQPT
SKIPE 0,QED
MOVE I,BEG ;SEARCH FAILED
MOVEM I,PT ;PT:=BEG
CLEARM SFINDF ;SFINDF:=0
TRNE FF,PCHFLG+FINDR ;S SEARCH?
JRST NOFND1 ;NO.
BEGIN1: TRZN FF,COLONF ;YES. COLON MODIFIER?
JRST NOFND2 ;NO
BEGIN2: TRZ FF,PCHFLG+FINDR ;YES.
JRST BEGIN ;RETURN VALUE OF 0
NOFND1: TLNN FF,UREAD ;INPUT FILE SELECTED?
JRST BEGIN1 ;NO. DONE.
PUSH P,E ;YES. SAVE SEARCH COUNT
MOVEI B,1 ;PUNCH 1 PAGE ONLY
TRNE FF,PCHFLG ;N SEARCH?
PUSHJ P,PUNCHA ;YES. PUNCH THIS BUFFER AND REFILL IT.
TRNE FF,FINDR ;LEFT ARROW SEARCH?
PUSHJ P,YANK1 ;YES. FILL BUFFER.
POP P,E ;RESTORE SEARCH COUNT.
JRST SERCH1 ;RESUME SEARCH
NOFND2: TRNE FF,ITERF ;IN AN ITERATION?
JRST BEGIN2 ;YES. RETURN VALUE OF 0
JSP A,ERRMES
ASCIZ /SEARCH/
ERROR ^D35
;NO. SEARCH FAILED.
;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)
CNTRB: SKIPA CH,[JSR P,CNTRB1] ;CH:=JSR P,CNTRB1
;CNTR X MATCHES ANY ARBITRARY CHARACTER
CNTRX: MOVSI CH,300000 ;CH:=CAI
JRST SERCH4
;HERE ON CNTR N CNTR S
CNTRB2: MOVE A,[JRST DQT2] ;CNTRB1:=JRST DQT2
MOVEM A,CNTRB1
PUSHJ P,DQT2 ;IS CH A TERMINATOR?
JRST SRCH5A ;NO
JRST SERCH5 ;YES
;CNTR N REVERSES THE SENSE OF THE SEARCH FOR THE NEXT CHARACTER
CNTRN: TRO FF,NOTF
JRST SERCH2
U CNTRB1,2 ;INITIALIZE TO JRST DQT2
;INITIALIZE TO JRST CNTRB2
COLON: TRO FF,COLONF
JRST RET
;MI PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS.
MAC: PUSHJ P,QREGVI ;A:=C(Q-REG)
PUSH P,COMAX ;SAVE CURRENT COMMAND STATE
PUSH P,CPTR
PUSH P,COMCNT
TLZE A,400000 ;MAKE SURE Q-REG CONTAINS TEXT
TLZE A,377777
ERROR ^D36 ;Q-REG DOES NOT CONTAIN TEXT
ADD A,QRBUF
MOVE I,A
PUSHJ P,GETINC ;GET FIRST CHARACTER OF MACRO
CAIE CH,141 ;IT SHOULD BE FLAG
ERROR ^D37 ;OOPS
PUSHJ P,GETINC ;GET NUMBER OF CHARACTERS IN MACRO
MOVE A,CH
PUSHJ P,GET
ROT CH,7
IOR A,CH
SUBI A,3 ;-FLAG AND COUNT
MOVEM A,COMCNT ;THAT MANY COMMANDS TO COUNT
MOVEM A,COMAX ;AND MAX.
IDIVI I,5
MOVE OU,BTAB(OU) ;MAKE A BYTE POINTER
HRR OU,I
MOVEM OU,CPTR ;PUT IT IN CPTR
JRST CD5 ;DON'T FLUSH ANY ARGUMENTS
;<> ITERATION BRACKETS. COMMAND INTERPRETATION IS SENT
; BACK TO THE < WHEN THE > IS ENCOUNTERED.
LSSTH: AOS INTDPH
PUSH P,ITERCT ;SAVE ITERATION COUNT
PUSH P,CPTR ;SAVE COMMAND STATE
PUSH P,COMCNT
SETOM ITERCT ;ITERCT:=-1
TRZE FF,ARG ;IS THERE AN ARGUMENT?
MOVEM B,ITERCT ;YES. ITERCT:=ARGUMENT
JRST LSSTH1
GRTH: SKIPG INTDPH ;IS THERE A LEFT ANGLE BRACKET?
ERROR ^D38 ;NO.
TRZ FF,ITERF ;YES
SOSN ITERCT ;ITERCT:=ITERCT-1. DONE?
JRST INCMA2 ;YES
MOVE A,-1(P) ;NO. RESTORE COMMAND STATE TO START OF ITERATION.
MOVEM A,CPTR
MOVE A,(P)
MOVEM A,COMCNT
TRNE FF,TRACEF ;TRACING?
PUSHJ P,CRR ;YES. OUTPUT CRLF
LSSTH1: TRO FF,ITERF
JRST RET
U ITERCT,1
U INTDPH,1
U SFINDF,1
;; IF NOT IN AN ITERATION, GIVES ERROR. IF IN AN ITERATION AND
; IF THE MOST RECENT SEARCH FAILED, SEND COMMAND TO FIRST UNMATCHED
; > TO THE RIGHT. OTHERWISE, NO EFFECT.
SEMICL: TRNN FF,ITERF ;IN < > ?
ERROR ^D39 ;NO. LOSE.
TRNN FF,ARG ;YES. IF NO ARG,
MOVE B,SFINDF ;USE LAST SEARCH SWITCH (0 OR -1).
SKIPN 0,QED
MOVEI B,0
INCMA: JUMPL B,CD ;IF ARG <0, JUST RET + EXECUTE LOOP
MOVEI A,0 ;INIT COUNT OF <>
INCMA1: PUSHJ P,SKRCH1 ;GET A CHAR
CAIN CH,"<" ;<?
AOJA A,INCMA1 ;YES. COUNT AND LOOP.
CAIE CH,">" ;>?
JRST INCMA1 ;NO. LOOP.
SOJGE A,INCMA1 ;YES. LOOP IF MORE TO GO. COUNT.
INCMA2: SOS INTDPH ;POP OUT A LEVEL
SUB P,[XWD 2,2]
POP P,ITERCT
JRST RET
;!TAG! TAG DEFINITION. THE TAG IS A NAME FOR THE LOCATION IT
; APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.
EXCLAM: PUSHJ P,SKRCH ;EXCLAM JUST INCREMENTS PAST ANOTHER !
CAIE CH,"!"
JRST .-2
JRST RET
;OTAG$ GO TO THE TAG NAMED TAG. THE TAG MUST APPEAR IN THE
; CURRENT MACRO OR COMMAND STRING.
OG: MOVE A,CPTR
MOVE AA,A
IDIVI AA,17
CAMN A,SYMS(B)
JRST OGFND
SKIPN SYMS(B)
JRST OGNF
CAMN A,SYMS+1(B)
ES1: AOJA B,OGFND
SKIPN SYMS+1(B)
ES2: AOJA B,OGNF
CAMN A,SYMS+2(B)
AOJA B,ES1
SKIPN SYMS+2(B)
ADDI B,2
OGNF: PUSH P,CPTR
PUSH P,B
MOVEI D,STAB+1
MOVEI A,41
MOVEM A,-1(D) ;STAB_"!"
PUSHJ P,SKRCH
MOVEM CH,(D) ;STAB+1 ... _ TAG
CAIE CH,175
AOJA D,.-3
MOVEM A,(D) ;ALTMODE: STAB+N_"!"
MOVE B,COMCNT
SUB B,COMAX ;# REMAINING COMMANDS
IDIVI B,5
ADD B,CPTR ;MAKE A COMMAND POINTER
JUMPE E,OG2
SOS B
MOVMS E
JRST .(E)
IBP B
IBP B
IBP B
IBP B
OG2: MOVE AA,COMAX ;ALL COMMANDS
OG4: MOVEM B,CPTR
MOVEM AA,COMCNT
MOVEI E,STAB ;INIT SEARCH STRING TO "!"
OG5: CAIN E,1(D) ;OVER STRING?
JRST OG3 ;YES
PUSHJ P,SKRCH1 ;NO. GET A CHAR
CAMN CH,(E) ;MATCH ?
AOJA E,OG5 ;YES. MOVE ON.
IBP B ;NO. TRY A NEW STARTING PT
SOJA AA,OG4 ;COUNT DOWN COMMANDS
OG3: POP P,A
POP P,SYMS(A)
MOVEM AA,CNTS(A)
MOVEM B,VALS(A)
JRST RET
OGFND: MOVE A,VALS(B)
MOVEM A,CPTR
MOVE A,CNTS(B)
MOVEM A,COMCNT
JRST RET
;N"G HAS NO EFFECT IF N IS GREATER THAT 0. OTHERWISE,
; SEND COMMAND INTERPRETATION TO NEXT MATCHING '.
; THE " AND ' MATCH SIMILAR TO ( AND ).
;N"L SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"N SEND COMMAND TO MATCHING ' UNLESS N NOT = 0.
;N"E SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"C SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS A LETTER, NUMBER, PERIOD (.), DOLLAR SIGN ($),
; OR PER CENT (%).
DQUOTE: TRNN FF,ARG
DQE: ERROR ^D40
PUSHJ P,RCH
TRZ CH,40
MOVSI A,0
CAIN CH,"G"
MOVSI A,327000+B*40 ;A:=JUMPG B,
CAIN CH,"L"
MOVSI A,321000+B*40 ;A:=JUMPL B,
CAIN CH,"N"
MOVSI A,326000+B*40 ;A:=JUMPN B,
CAIN CH,"E"
MOVSI A,322000+B*40 ;A:=JUMPE B,
CAIN CH,"C"
JRST DQT1
JUMPE A,DQE
HRRI A,RET
XCT A
NOGO: MOVEI A,0 ;NOGO INCREMENTS COMMAND POINTER OVER
;A SINGLE QUOTE,SKIPPING PAIRS OF " & '.
PUSHJ P,SKRCH1
CAIN CH,42 ;DOUBLE QUOTE
AOJA A,.-2
CAIN CH,"'" ;SINGLE QUOTE
SOJL A,RET
JRST .-5
DQT1: PUSHJ P,DQT3
JRST RET
JRST NOGO
DQT2: MOVE B,CH
;ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z
;CALL MOVE B,CHARACTER
; PUSHJ P,DQT3
; RETURN IF $,%,.,0-9,A-Z
; RETURN ON ALL OTHER CHARACTERS
DQT3: CAIE B,"$" ;$ OR %?
CAIN B,"%"
POPJ P, ;YES
CAIN B,"." ;NO. POINT?
POPJ P, ;YES.
CAIGE B,"0" ;NO. DIGIT OR LETTER?
JRST POPJ1 ;NO
CAIG B,"9" ;MAYBE. DIGIT?
POPJ P, ;YES.
CAIGE B,"A" ;NO. LETTER?
JRST POPJ1 ;NO.
CAIG B,"Z"
POPJ P, ;YES.
CAIL B,141 ;LOWER CSE LETTERS?
CAIL B,173 ;..
POPJ1: AOS 0(P) ;NO.
POPJ P,0
REPEAT 0,<
XIII. ERRORS
IT IS CONCEDED THAT TECO'S ERROR MESSAGES ARE NOT OVERLY
INFORMATIVE. FOR ALL ILLEGAL OR MEANINGLESS COMMANDS TECO TYPES OUT
? AND IGNORES THE REMAINDER OF THE COMMAND STRING, RETURNING TO THE
IDLE STATE. AT THIS POINT THE USER MAY TYPE ? BACK IN, AND TECO
WOULD THEN RESPOND BY TYPING OUT 10 CHARACTERS OF THE COMMAND STRING,
ENDING WITH THE BAD COMMAND. SEARCH COMMANDS ARE "BAD" IF THEY FAIL AND
THE : MODIFIER WAS NOT USED.
>
ERRTYP: MOVE AA,ERR2 ;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
MOVEI B,12
SUBI AA,2 ;BACK POINTER UP 10 CHARACTERS.
ILDB CH,AA ;GET CHARACTER
CAMG B,ERR1 ;WAS IT IN THE COMMAND BUFFER?
PUSHJ P,TYO ;YES. TYPE IT.
CAME AA,ERR2 ;HAVE WE REACHED THE BAD COMMAND?
SOJA B,.-4 ;NO. DO IT AGAIN.
ERROR ^D41 ;YES. TYPE ? CRLF AND WAIT FOR NEXT COMMAND.
ERRP: HRRZ B,40 ;GET ERROR NUMBER
ERR: MOVEI CH,"?" ;TYPE ? CRLF
PUSHJ P,TYO
PUSHJ P,PRNT9 ;PRINT ERROR NUMBER
TRO FF,QMFLG ;SET ? FLAG.
MOVE A,COMAX
SUB A,COMCNT
MOVEM A,ERR1 ;ERR1:=COMAX-COMCNT
MOVE A,CPTR
MOVEM A,ERR2 ;ERR2:=CPTR
JRST QEDDBT ;GET NEXT COMMAND
U ERR1,1
U ERR2,1
ERRA: ERROR ^D42
;UUO HANDLER
;HALTS ON UNDEFINED UUO
;CALL TYPR1 X
;PRINTS STRING AT X TERMINATED BY ! AND REINITIALIZES AT GOZ.
UUOH: IFE <R>,<0>
HLRZ B,40
CAIN B,31000 ;ERROR UUO?
JRST ERRP ;YES
CAIE B,30000 ;TYPR1?
JRST 4,. ;NO. OOPS
HRLZI B,440700 ;YES. ADDRESS POINTS TO MESSAGE TERMINATED BY !
HRR B,40
ILDB CH,B
CAIN CH,"!" ;END OF MESSAGE?
JRST GOX ;YES. REINITIALIZE
PUSHJ P,TYO ;NO. PRINT A CHARACTER
JRST .-4
U LISTF5,1 ;OUTPUT DISPATCH
XXTY02: ASCII /GC ERROR
!/
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND
QUESTN: MOVE A,[JRST TYO]
TRCE FF,TRACEF
MOVSI A,263000+P*40 ;TRACS:=POPJ P,
MOVEM A,TRACS
JRST RET
COMMEN: PUSHJ P,SKRCH ;GET A COMMENT CHAR
CAIN CH,1 ;^A
POPJ P,0 ;DONE
PUSHJ P,TYO ;TYPE IT
JRST COMMENT
CALDDT: SKIPE T,.JBDDT
JRST (T)
ERROR ^D43
;ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL PUSHJ P,GETARG
; RETURN WITH FIRST ARGUMENT ADDRESS IN C, SECOND IN B.
GETARG: TRNE FF,ARG2 ;IS THERE A SECOND ARGUMENT?
JRST GETAG6 ;YES
;N SIGN INDICATES DIRECTION RELATIVE TO PT.
TRON FF,ARG ;NO. IS THERE AN ARGUMENT?
PUSHJ P,CHK22 ;NO. B:=1 IS LAST ARGUMENT FUNCTION WAS +,*,OR /
;B:=-1, IF &,#, OR -
;IE, ASSUME AN ARGUMENT OF 1 AND RETAIN SIGN
MOVE I,PT ;IN:=PT
GETAG4: JUMPLE B,GETAG2 ;WAS LAST ARGUMENT FUNCTION -?
CAMN I,Z ;NO. ARGUMENT IS LOCATION OF NTH LINE
;FEED FORWARD FROM PT.
;IS PT AT END OF BUFFER?
JRST GETAG1 ;YES.
PUSHJ P,GETINC ;NO. CH:=NEXT DATA BUFFER CHARACTER, IN:=IN+1
CAIE CH,12 ;LINE FEED?
JRST GETAG4 ;NO. TRY AGAIN.
SOJG B,GETAG4 ;YES. NTH LINE FEED?
GETAG1: MOVE B,I ;YES. RETURN FIRST ARGUMENT IN C
MOVE C,PT ;SECOND IN B.
POPJ P,
;M,N
GETAG6: ADD B,BEG ;C:=M+BEG
ADD C,BEG ;B:=N+BEG
POPJ P,
GETAG2: SOS I ;ARGUMENT IS POSITION OF NTH LINE FEED TO LEFT OF PT.
;N:=N-1
CAMG I,BEG ;PASSED BEGINNING OF BUFFER?
JRST GETAG3 ;YES. IN:=BEG
PUSHJ P,GETINC ;NO. CH:=NEXT DATA BUFFER CHARACTER. IN:=IN+1
CAIE CH,12 ;LINE FEED?
SOJA I,GETAG2 ;NO. BACK UP ONE POSITION AND TRY AGAIN.
AOJLE B,.-1 ;YES. NTH LINE FEED?
GETAG3: CAMGE I,BEG ;YES. PASSED BEGINNING OF BUFFER?
MOVE I,BEG ;YES. RESET TO BEGINNING.
MOVE C,I ;NO. RETURN FIRST ARGUMENT IN C.
MOVE B,PT ;SECOND IN B
POPJ P,
;ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER
;AND INCREMENT THE POINTER.
;CALL MOVE I,POINTER (AS A CHARACTER ADDRESS)
; PUSHJ P,GETINC
; RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN IN.
GETINC: PUSHJ P,GET
AOJA I,CPOPJ
GET: MOVE TT,I
IDIVI TT,5
HLL TT,BTAB(TT1)
LDB CH,TT
POPJ P,
PUT: MOVE TT,OU
IDIVI TT,5
HLL TT,BTAB(TT1)
DPB CH,TT
POPJ P,
;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT OF A CHARACTER ADDRESS POINTER
BTAB: XWD 350700,0
XWD 260700,0
XWD 170700,0
XWD 100700,0
XWD 10700,0
TYOM: PUSH P,C ;TYO TO MEMORY
PUSH P,OU
PUSH P,TT
PUSH P,TT1
PUSHJ P,TAB2
POP P,TT1
POP P,TT
POP P,OU
POP P,C
POPJ P,
NROOM: MOVEM 17,AC2+15 ;SAVE 17
MOVEI 17,NROOM9 ;ANTICIPATE GARBAGE COLLECTION
MOVEM 17,GCRET ;THIS THE EXIT DISPATCH
MOVE 17,PT
CAMN 17,Z ;PT=Z? I.E., DATA BUFFER EXPANSION?
JRST NROOM1 ;YES.
NROOM0: MOVE 17,[XWD 2,AC2] ;NO. SAVE ACS 2 THROUGH 16.
BLT 17,AC2+14
JUMPL C,NROOM6 ;DELETION?
SETOM GCFLG ;NO.
CLEARM CRREL
CLEARM RREL
;MOVE STRING STORAGE UP C CHARACTERS STARTING AT PT.
NROOM9: MOVE 17,Z
ADD 17,C
CAML 17,MEMSIZ ;WILL REQUEST OVERFLOW MEMORY?
JRST GC ;YES. GARBAGE COLLECT.
;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE 14,C ;NO.
IDIVI 14,5 ;AC14:=Q(REQ/5), AC15:=REM(REQ/5)
IMULI 15,7 ;AC15:=(REM(REQ/5))*7
MOVN 13,15 ;AC13:=-(REM(REQ/5))*7
MOVEI 15,-43(15) ;AC15:=(REM(REQ/5))*7-43
MOVE 11,PT
IDIVI 11,5 ;AC11:=Q(PT/5), AC12:=REM(PT/5)
MOVNI 16,-5(12)
IMULI 16,7 ;AC16:=-(REM(PT/5)-5)*7
DPB 16,[XWD 300600,NROOM2] ;SET SIZE FIELD OF LAST PARTIAL WORD POINTER.
ADDI 14,1(11) ;AC14:=Q(REQ/5)+Q(PT/5)+1
MOVE 16,Z
IDIVI 16,5 ;AC16:=Q(Z/5)
MOVEI B,1(16)
SUB B,11 ;B:=Q(Z/5)+1-Q(PT/5)=NO. OF WORDS TO MOVE.
;PUT MOVE ROUTINE IN FAST ACS
HRLI 11,200000+B+A*40 ;AC11:=MOVE A,[Q(PT/5)](B)
HRLOI 12,241000+A*40 ;AC12:=ROT A,-1
HRLI 13,245000+A*40 ;AC13:=ROTC A,-(REM(REQ/5))*7
HRLI 14,202000+B+AA*40 ;AC14:=MOVEM AA,[Q(PT/5)+1](B)
HRLI 15,245000+A*40 ;AC15:=ROTC A,(REM(REQ/5))*7-43
MOVE 17,[JRST,NROOM7] ;AC16:=SOJGE B,11
MOVE 16,.+1 ;AC17:=JRST NROOM7
SOJGE B,11 ;B:=B-1. DONE?
NROOM7: ROTC A,43(13) ;YES. STORE LAST PARTIAL WORD.
DPB A,NROOM2
ADDM C,Z ;Z:=Z+REQ
NROOM5: MOVE 17,[XWD 2,AC2] ;RESTORE ACS AND RETURN.
MOVSS 17
BLT 17,17
POPJ P,
U NROOM2,1 ;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE.
;A CALL FOR A BUFFER EXPANSION, WHERE PT=Z. IF
;THERE IS NOT ENOUGH ROOM, PERFORM THE GARBAGE COLLECTION ROUTINE
;IF THERE IS STILL NO ROOM, GET THE NECESSARY CORE FROM THE
;MONITOR TO SATISFY THIS REQUEST
NROOM1: ADD 17,C ;TOTAL SPACE REQUIREMENT
CAMG 17,MEMSIZ ;IS THERE ENOUGH?
JRST .+4 ;YES, THEREFORE, UPDATE Z AND EXIT
MOVEI 17,GCRETA ;EXIT DISPATCH FOR THE
MOVEM 17,GCRET ;GARBAGE COLLECTION ROUTINE
JRST NROOM0 ;GO DO THE GARBAGE COLLECTION
ADDM C,Z ;UPDATE Z, SIZE IS OK
MOVE 17,AC2+15 ;RESTORE AC#17
POPJ P, ;EXIT OUT
;NOT ENOUGH ROOM FOR THE EXPANSION, GARBAGE COLLECTION HAS BEEN
;PERFORMED, IF NEED BE, GRAB A K FROM THE MONITOR (OR MORE)
GCRETA: MOVE 17,Z ;GET TOTAL SO FAR
ADD 17,C ;ADD IN THE REQUEST
CAML 17,MEMSIZ ;STILL IN NEED OF CORE?
PUSHJ P,GRABAK ;YES, GET THE REQUIRED CORE FROM THE MONITOR
ADDM C,Z ;UPDATE Z AND EXIT
JRST NROOM5 ;RESTORE ALL AC'S AND RETURN TO SEQUENCE
U GCRET,1 ;GC EXIT DISPATCH
;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
NROOM6: MOVE 14,PT ;INITIALIZE PARTIAL WORD POINTER.
IDIVI 14,5 ;AC14:=Q(PT/5), AC15:=REM(PT/5)
MOVEM 14,B ;B:=Q(PT/5)
HRRM 14,NROOM4
IMULI 15,7
DPB 15,[XWD 300600,NROOM4] ;SIZE:=(REM(PT/5))*7
MOVNI 15,-44(15)
DPB 15,[XWD 360600,NROOM4] ;POSITION:=44-(REM(PT/5))*7
MOVE 11,Z
IDIVI 11,5 ;AC11:=Q(Z/5)+1, AC12:=REM(Z/5)
ADDI 11,1
MOVE 13,C
IDIVI 13,5
ADDI 13,-1(11) ;AC13:=Q(Z/5)-Q(REQ/5)
MOVNM 14,12 ;AC12:=(REM(REQ/5))*7
IMULI 12,7
MOVNI 15,-43(12) ;AC15:=43-(REM(REQ/5))*7
SUBI B,1(13) ;B:=Q(PT/5)+Q(REQ/5)-Q(Z/5)-1:=# WORDS TO MOVE
NROOM8: HRLI 11,200000+B+AA*40 ;AC11:=MOVE AA,[Q(Z/5)+1](B)
HRLI 12,245000+A*40 ;AC12:=ROTC A,(REM(REQ/5))*7
HRLI 13,202000+B+A*40 ;AC13:=MOVEM A,[Q(Z/5)-Q(REQ/5)](B)
MOVE 14,[ADDM A,@13] ;AC14:=ADDM A,@13
HRLI 15,245000+A*40 ;AC15:=ROTC A,43-(REM(REQ/5))*7
MOVE 17,[JRST NROOM3] ;AC16:=AOJLE B,11
ADDM C,Z ;AC17:=JRST NROOM3
LDB C,NROOM4
MOVE A,@11 ;Z:=C(Z)-REQ
ROT A,-1 ;A:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED.
MOVE 16,.+1
AOJLE B,11 ;B:=B+1. DONE?
NROOM3: DPB C,NROOM4 ;YES. DEPOSIT PARTIAL WORD.
JRST NROOM5
U NROOM4,1 ;PARTIAL WORD POINTER FOR DOWNWARD MOVE
GC: AOSE GCFLG ;FIRST ATTEMPT?
GC1: JRST PRENR9 ;TRY TO EXPAND MEMORY
SETOM GCPTR ;YES. GCPTR:=-1
CLEARM SYMS ;CLEAR SYMS,VALS AND CNTS TABLES
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVEI T,CPTR ;COMMAND BUFFER
PUSHJ P,GCMA
HRRZ T,P
SUBI T,
CAIL T,PDL ;PUSHDOWN LIST EMPTY?
PUSHJ P,GCMA ;NO. GARBAGE COLLECT ALL BYTE POINTERS ON IT.
CAILE T,PDL
SOJA T,.-2
HRRZ T,AC2+PF-2 ;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
CAIL T,PFL
PUSHJ P,GCM
CAILE T,PFL
SOJA T,.-2
MOVE T,[XWD -44,QTAB] ;GARBAGE COLLECT Q-REGISTERS.
PUSHJ P,GCM
AOBJN T,.-1
SKIPGE GCPTR ;ANYTHING TO COLLECT?
JRST @ GCRET ;NOPE.
GCS: MOVE I,QRBUF
GCS1A: MOVSI TT,1*5 ;TT>MAX. NO. CHARACTERS IN WORLD
MOVE OU,GCPTR ;GO BACKWARDS THROUGH GCTAB
GCS1: HRRZI A,GCTAB(OU) ;RELOCATE
HRRZ A,@A
ADD A,QRBUF
CAMGE A,I
JRST GCS2
CAMGE A,TT ;SET TT TO HIGHEST CHARACTER POSITION
MOVE TT,A
GCS2: SOJGE OU,GCS1
TRNN TT,-1 ;ANYTHING TO COLLECT?
JRST @ GCRET ;NOPE.
MOVE F,TT ;HIGHEST CHARACTER.
IDIVI I,5 ;C(QRBUF)/5
IDIVI F,5 ;HIGH CHAR/5
AOS I ;C(QRBUF)/5+1
MOVS OU,F
MOVE T,F
SUB T,I ;HIGH CHAR/5-C(QRBUF)/5+1
JUMPLE T,GCS4A ;ANYTHING TO GET?
HRR OU,I ;XWD HIGH CH/5,HIGH CH/5-C(QRBUF)/5+1=NREG
MOVE B,Z
IDIVI B,5
SUB B,T ;Z/5-NREG
HRLI B,0
BLT OU,@B ;MOVE STUFF DOWN
MOVNS OU,T
IMULI OU,5 ;OUT:=-5*NREG
ADDM OU,BEG ;BEG:=C(BEG)-5*NREG
ADDM OU,PT ;PT:=C(PT)-5*NREG
ADDM OU,Z ;Z:=C(Z)-5*NREG
ADDM OU,RREL ;RREL:=C(RREL)-5*NREG
MOVE CH,GCPTR ;UPDATE INSERTER
GCS3: HRRZI TT1,GCTAB(CH)
HRRZ A,@TT1
ADD A,QRBUF
CAMGE A,TT
JRST GCS4
ADDM OU,@TT1
HLRZ A,@TT1
CAIN A,CPTR ;IN COMMAND BUFFER?
ADDM OU,CRREL ;YES. UPDATE COMMAND POINTER RELOCATION
HRLI A,0
SKIPL @A ;Q-REG?
ADDM T,@A ;NO
SKIPGE @A ;Q-REG?
ADDM OU,@A ;YES. RELOCATE BASE POINTER.
GCS4: SOJGE CH,GCS3 ;DONE?
ADD TT,OU ;YES. IN:=C(TT)-5*NREG
GCS4A: MOVE I,TT ;I SHOULD POINT TO AN END OF STRING FLAG (141)
PUSHJ P,GETINC
CAIE CH,141
GCERR: TYPR1 XXTY02 ;STRANGE LOSS
PUSHJ P,GETINC
MOVE A,CH
PUSHJ P,GETINC
ROT CH,7
IOR A,CH
ADDI I,-3(A)
JRST GCS1A
GCM: MOVE I,(T)
TLZE I,400000 ;DOES Q-REG CONTAIN TEXT?
TLZE I,377777
POPJ P, ;NO
ADD I,QRBUF ;YES. ENTER POINTER IN GCTAB
GCM2: CAML I,BEG ;REGION BEFORE TEXT BUFFER?
POPJ P, ;NO. FORGET IT.
PUSHJ P,GET ;YES. CHECK FOR MARK.
CAIE CH,141 ;END OF STRING?
POPJ P, ;NO.
SUB I,QRBUF ;YES. IN:=# CHARACTERS TO RETREIVE.
; IN Q-REG BUFFER AREA?
JUMPL I,CPOPJ ;NO. FORGET IT.
AOS TT,GCPTR ;YES. TO BE GRABBED.
CAIL TT,GCTBL ;AM I WINNING?
JRST GCERR ;NO. VERY BAD.
HRL I,T ;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS
ADDI TT,GCTAB ;RELOCATE
HRLI TT,0
MOVEM I,@TT ;SAVE DATA
POPJ P, ;DONE THIS POINTER
;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMA: HRRZ TT1,T
LDB TT,[XWD 221420,TT1] ;BYTE SIZE + XR
TRC TT,700 ;DOES T POINT TO A TEXT BYTE POINTER?
TRCE TT,700
POPJ P, ;NO
SOS TT1
MOVE I,@TT1 ;MAYBE. GET WORD BEFORE POINTER. (MAX)
ADDI TT1,2
SUB I,@TT1 ;MAX-CT
SOS TT1
LDB TT,[XWD 360620,TT1] ;BYTE POSITION
IDIVI TT,7 ;NO. OF CHARACTERS
MOVEI TT1,4-3+1 ;2
SUB TT1,TT ;2-NO. OF CHARACTERS
HRRZ TT,(T) ;POINTER WORD ADDRESS (UNRELOCATED)
IMULI TT,5 ;5*ADDRESS
ADD TT,TT1
SUBM TT,I ;5*ADDRESS-NO. CHARS+2+MAX-CT
JRST GCM2
;**********AUTOMATIC MEMORY EXPANSION*********
;MEMORY WILL BE EXPANDED UNDER ONE OF THESE CONDITIONS.
; 1.AN INTERNAL BUFFER EXPANSION CANNOT BE PERFORMED,
; TO DO SO WOULD OVERFLOW THE PRESENT MEMORY
; CAPACITY. THE INTERNAL OPERATIONS WHICH DESCOVER
; THE NEED FOR EXPANSION ARE:
; A.COMMAND BUFFER EXPANDING
; B.THE Q-REG GET (GI)
; C.THE Q-REG LOAD (NXI)
; D.ANY OF THE INSERTS
; E.COMMAND ACCEPTANCE ROUTINE
; 2.THE DATA BUFFER WILL BE MAINTAINED AT A MINIMUM
; NUMBER OF 5000 CHARACTERS BEFORE NEW DATA IS LOADED
; FROM AN INPUT DEVICE OTHER THAN THE CONSOLE. Q-REG
; USAGE SHORTENS THE NUMBER OF AVAILABLE CHARACTERS
; DIRECTLY, AND NORMAL TECO COMMANDS ARE GREATLY IMPARED
; OTHERWISE.
;SAVE THE ACCUMULATORS
GRABAK: TLOA FF,GKTLKF ;TALKATIVE GRAB
GRABKQ: TLZ FF,GKTLKF ;GRAB A K QUIETLY
MOVEM CH,SAV16 ;TO SAVE THE ACCUMULATORS
MOVEI CH,SAVE ;WHILE WE SCOOT ALL OVER THE
BLT CH,SAV16-1 ;THE PLACE
;COUNT THE NUMBER OF BLOCKS NEEDED TO FILL THE REQUEST
MOVEI F,^D1024 ;1 BLOCK OF CORE
MOVEI B,1 ;WE WILL NEED AT LEAST ONE BLOCK
ADDM F,.JBFF ;UP THE FIRST FREE COUNT
PUSHJ P,CRE23 ;COMPUTE A NEW MEMSIZ AND 2/3 VALUE
CAML 17,MEMSIZ ;WILL THIS BE ENOUGH CORE?
AOJA B,.-3 ;NO, COMPUTE ANOTHER BLOCK
;NUMBER OF BLOCKS HAVE BEEN FOUND
;OBTAIN THE NEEDED CORE FROM THE MONITOR
MOVE B,.JBFF ;TO HELP OUT THE MONITOR
CALLI B,CORE ;MAKE THE CALL TO THE MONITOR
JRST NOTANY ;NO CORE (OR NOT ENOUGH) AVAILABLE
TLNN FF,GKTLKF ;MESSAGE DESIRABLE?
JRST EXITZ ;NO
MOVEI CH,"["
PUSHJ P,TYO
MOVEI A,TYO
HRRM A,LISTF5 ;SET OUTPUT TO TTY
MOVE B,.JBREL ;SIZE OF CORE NOW
ADDI B,1
ASH B,-12
PUSHJ P,DPT
JSP A,CONMES
ASCIZ / K CORE]
/
;RESTORE THE AC'S AND EXIT FROM THIS COR GET ROUTINE
EXITZ: MOVSI CH,SAVE ;FROM TO
BLT CH,CH ;ALL AC'S AS THEY WERE
POPJ P,0 ;AND EXIT
;NO CORE AVAILABLE (OR NOT ENOUGH)
NOTANY: JSP A,CONMES ;INFORM THE OUTSIDE WORLD THAT THEY LOOSE
ASCIZ /STORAGE CAPACITY EXCEEDED
/
HLRZ A,.JBSA ;GET LAST FIGURE OF CORE BOUND
MOVEM A,.JBFF ;AND STORE IT
PUSHJ P,CRE23 ;COMPUTE THE MEMSIZE VALUES AGAIN
MOVSI CH,SAVE ;RESTORE THE ACCUMULATORS AS THEY WERE
BLT CH,CH ;BEFORE THE ERROR EXIT
ERROR ^D44 ;TYPE THE ? MARK
;THIS IS AN AUXILARY SPOT FOR ENTRANCE FROM GC2
;GET THE REQUIRED CORE TO SAVE THE .JB IF POSSIBLE
PRENR9: PUSHJ P,GRABAK ;GET THE REQUIRED CORE
JRST NROOM9 ;GO TRY THE INSERT AGAIN
U QEDCNT,1 ;QED MOD ******************
U QED,1 ;QED MOD *****************
U QED1,1 ;QED MOD *****************
U QEDT,1 ;QED MOD ***************
U QCCFLG,1 ;QED MOD ****************
U Q1,1 ;QED MOD ******************
U QI,1 ;QED MOD ********************
U QZ,1 ;QED MOD *******************
U SQPT,1
U BEG,1
U PT,1
U Z,1
U QRBUF,1
;*** DO NOT SEPARATE ***
U COMAX,1
U CPTR,1
U COMCNT,1
;*** DO NOT SEPARATE ***
U CBUFH,1
U MEMSIZ,1
U GCPTR,1
U CRREL,1
U GCFLG,1
U RREL,1
;CORRECT FOR 2/3 BUFFER FILLING ERROR.M23 IS 2/3'S AND M23PL IS 2/3
;PLUS THE OTHER THIRD-128 CHARACTERS.
U M23,1
U M23PL,1
;COMMAND DISPATCH TABLE
;DISPATCH IS BY XCT DTB(CH)
;FORMAT:
; MOVEI A,X ;IF X RETURNS A VALUE
; HRROI A,X ;IF X DOES NOT RETURN A VALUE AND EXITS WITH POPJ
; JRST X ;IF X DOES NOT RETURN A VALUE AND EXITS TO A
; ;FIXED LOCATION.
DTB:
HRROI A,ERRA ;^@
HRROI A,COMMENT ;^A
HRROI A,QEDIN ;QED MOD **************
HRROI A,QEDOUT ;QED MOD ****************
MOVEI A,CALDDT ;^D
MOVEI A,FFEED ;^E
MOVEI A,LAT ;^F
MOVEI A,DECDMP ;^G
MOVEI A,GTIME ;^H
HRROI A,TAB ;^I
MOVEI A,CD ;^J
HRROI A,ERRA ;^K
HRROI A,TYO ;^L
MOVEI A,CD ;^M
HRROI A,ERRA ;^N
HRROI A,QEDTYP ;QED MOD ***************
HRROI A,ERRA ;^P
HRROI A,ERRA ;^Q
HRROI A,ERRA ;^R
HRROI A,ERRA ;^S
MOVEI A,SPTYI ;^T
HRROI A,ERRA ;^U
HRROI A,ERRA ;^V
HRROI A,ERRA ;^W
HRROI A,ERRA ;^X
HRROI A,ERRA ;^Y
HRROI A,ERRA ;^Z
HRROI A,ERRA ;^[
HRROI A,ERRA ;^BACKSLASH
HRROI A,ERRA ;^]
MOVEI A,CNTRUP ;^^
HRROI A,ERRA ;^LEFT ARROW
MOVEI A,CD2 ;SPACE
MOVEI A,EXCLAM ;!
MOVEI A,DQUOTE ;"
MOVEI A,COR ;#
HRROI A,ERRA ;$
MOVEI A,PCNT ;%
MOVEI A,CAND ;&
MOVEI A,CD ;SINGLE QUOTE
MOVEI A,OPEN ;(
MOVEI A,CLOSE ;)
MOVEI A,TIMES ;*
MOVEI A,CD2 ;+
MOVEI A,COMMA ;,
MOVEI A,MINUS ;-
MOVEI A,PNT ;.
MOVEI A,SLASH ;/
JRST CDNUM ;0
JRST CDNUM ;1
JRST CDNUM ;2
JRST CDNUM ;3
JRST CDNUM ;4
JRST CDNUM ;5
JRST CDNUM ;6
JRST CDNUM ;7
JRST CDNUM ;8
JRST CDNUM ;9
MOVEI A,COLON ;:
MOVEI A,SEMICL ;;
MOVEI A,LSSTH ;<
HRROI A,PRNT ;=
MOVEI A,GRTH ;>
MOVEI A,QUESTN ;?
MOVEI A,ATSIGN ;@
JRST ACMD ;A
MOVEI A,BEGIN ;B
MOVEI A,CHARAC ;C
MOVEI A,DELETE ;D
HRROI A,ECMD ;E
JRST RET ;F
MOVEI A,QGET ;G
MOVEI A,HOLE ;H
HRROI A,INSERT ;I
MOVEI A,JMP ;J
MOVEI A,KILL ;K
MOVEI A,LINE ;L
JRST MAC ;M
MOVEI A,SERCHP ;N
MOVEI A,OG ;O
HRROI A,PUNCH ;P
MOVEI A,QREG ;Q
MOVEI A,REVERS ;R
MOVEI A,SERCH ;S
HRROI A,TYPE ;T
MOVEI A,USE ;U
HRROI A,ERRA ;V
MOVEI A,CD ;W
MOVEI A,X ;X
HRROI A,YANK ;Y
MOVEI A,END1 ;Z
MOVEI A,OPENB ;[
MOVEI A,BAKSL ;BACKSLASH
MOVEI A,CLOSEB ;]
MOVEI A,UAR ;^
MOVEI A,LARR ;LEFT ARROW
;137-1 175 THESE THE LITTLE CHARACTERS ON THE MODEL 37
MOVEI A,CD ;IGNORE "LC AT"
JRST ACMD ;A
MOVEI A,BEGIN ;B
MOVEI A,CHARAC ;C
MOVEI A,DELETE ;D
HRROI A,ECMD ;E
JRST RET ;F
MOVEI A,QGET ;G
MOVEI A,HOLE ;H
HRROI A,INSERT ;I
MOVEI A,JMP ;J
MOVEI A,KILL ;K
MOVEI A,LINE ;L
JRST MAC ;M
MOVEI A,SERCHP ;N
MOVEI A,OG ;O
HRROI A,PUNCH ;P
MOVEI A,QREG ;Q
MOVEI A,REVERS ;R
MOVEI A,SERCH ;S
HRROI A,TYPE ;T
MOVEI A,USE ;U
HRROI A,ERRA ;V
MOVEI A,CD ;W
MOVEI A,X ;X
HRROI A,YANK ;Y
MOVEI A,END1 ;Z
MOVEI A,OPENB ;[
MOVEI A,BAKSL ;BACKSLASH
MOVEI A,ALTMOD ;ALT MODE
HRROI A,ERRA
HRROI A,ERRA
U STAB,0 ;SEARCH TABLE
;SERCH4+2,OGNF+4,OGNF+6,OGFN+11
U AC2,16 ;SAVE AC2-AC17 IN NROOM ROUTINE
;NROOM,NROOM5
U BAKTAB,40-3-16 ;RECEIVES ASCII CONVERSION OF NUMERICAL ARGUMENT
;BAKSL4
CFIL1=STAB
CFIL2=STAB+1
U STABP,0
U SYMS,22 ;LIS+4(0),OG3+1,GC+3(0)
U VALS,22 ;LIS+4(0),OG3+3,GC+3(0)
U CNTS,22 ;LIS+4(0),OG3+2,GC+3(0)
U SYMEND,0
U PFL,LPF
U GCTAB,GCTBL ;GCS3+4,GCM2+13
U QTAB,45 ;Q-REGISTER TABLE
;USEA+1,PCNT+1
U PDL,LPDL
U UAC,17
PATCH: BLOCK 10
;HERE IS STORED THE AC'S FOR THE SAVE ROUTINE
U SAVE,16
U SAV16,1
U SAV17,1
LIT
U CBUF,0
U TOP,0
ZZZZZZ: END STARTA