Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/teco.mid
There is 1 other file named teco.mid in the archive. Click here to see a list.
.SYMTAB 6000.,3000. ;-*-MIDAS-*-
TITLE TECO
.DECSAV
;ACCUMULATOR ASSIGNMENTS
FF=0 ;CONTROL FLAGS
A=1 ;MUST BE 1 FOR ERRMES, CONMES
AA=A+1 ;BYTE POINTER TO COMMAND BUFFER
B=A+2 ;COMMAND BUFFER END ADDRESS
E=B+1 ;B MUST BE LESS THAN 11
C=5
D=6
PF=7
F=10
T=11
TT=12
TT1=TT+1
I=14
OU=I+1
CH=16
P=17
CALL=PUSHJ P,
RET=POPJ P,
;PAGES USED FOR WINDOWS TO INPUT AND OUTPUT DISK FILE
IBFPG==4
IBFPGA==<IBFPG>_9.
OBFPG==IBFPG+1
OBFPGA==<OBFPG>_9.
PROGPG==OBFPG+1
PROGRM==<PROGPG>_9.
;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
RUBCF==400 ;RUBOUT IN OUTPUT TO FILE
FINDR==2000 ;LEFT ARROW SEARCH
RPLFG==4000 ;IN REPLACE COMMAND
NOTF==10000 ;^N SEARCH MODIFIER
TRACEF==20000 ;? SEEN
FSRCDF==100000 ;FAST SEARCH DEFEAT
NFSRCF==200000 ;FAST SEARCH NOT REQUESTED
FORM==400000 ;FORM FEED TERMINATED LAST Y OR A
;LEFT HALF
FINF==100 ;INPUT CLOSED BY EOF
UREAD==200 ;INPUT FILE IS OPEN
UWRITE==400 ;OUTPUT FILE IS OPEN
CISRCH==400000 ;CASE INDEPENDENT SEARCH MODE
CISEQ=20_27. ;CASE INDEPENDENT SEARCH UUO'S
CISNE=24_27. ;EXACT OPCODES ARE CRITICAL!!!
ERROR1=30_27.
ERROR=31_27.
EOL=^_ ;END OF LINE CHARACTER
;PARAMETERS
NFILNM==10 ;LENGTH OF FILENAME BUFFER FOR E COMMANDS
LPDL==1200 ;LENGTH OF MAIN PDL
GCTBL==200 ;MAX NUMB OF STRINGS SAVED DURING A GC
LPF==600 ;LENGTH OF Q-REG PDL
STABL==110 ;LENGTH OF SEARCH TABLE
CBUF==20000 ;MAIN CHARACTER BUFFER
CCLJFN=140 ;JFN OF FILE FOR ;Y IN CCL MODE
INITF=141 ;TECO IS INITIALIZING
MATFLG=142 ;Q-REG @ HAS NEW CONTENTS
SAVP=143 ;SAVED P
SAVPF=144 ;SAVED PF
EOLF=145 ;WHETHER THE BUFFER CONTAINS EOLS
FIRSTV==<ZZ==146>;FIRST VARIABLE TO GET CLEARED
DEFINE U A,B
A=ZZ
ZZ==ZZ+B
TERMIN
;ENTRY VECTOR
LOC PROGRM
EVEC: JRST TECO
JRST REE
JRST CCL
JRST INFO
EVECL==.-EVEC
DEFSYM: 0 ;SAVED SYMBOL POINTER
UDFSYM: 0 ;AND UNDEFINED TABLE
VERSN: 0 ;PUT VERSION NUMBER IN EASY TO FIND PLACE
PATVER: 0 ;MAKE NON-ZERO IF PATCHED TECO
CRDATE: 0 ;ASSEMBLY DATE
BEG ;POINTER TO CELL WITH CHR ADDR OF BUFFER BEG
Z Z ;AND END.
TENEXP: 0 ;NON-ZERO IF TENEX
;TO BE EXECUTED TO CREATE THE SHARE FILE
; 116 IS TO BE CLEARED IF SAVE FILE IS NOT TO INCLUDE SYMBOLS
PRESHR: SKIPGE 1,116 ;IF SYMS EXIST,
SKIPE DEFSYM ;AND NOT ALREADY SAVED...
JRST PRESH1
MOVEM 1,DEFSYM ;COPY POINTERS
MOVE 1,117
MOVEM 1,UDFSYM
PRESH1: MOVEI 1,400000 ;THIS FORK
MOVE 2,[EVECL,,EVEC]
SEVEC ;SET ENTRY VECTOR
MOVE 1,[SIXBIT/LOADTB/]
SYSGT
MOVEM 2,TENEXP ; TENEXP becomes non-zero if Tenex
SKIPE VERSN ; has a version been defined already?
JRST PRESH2 ; yup, don't use source version
MOVSI 1,(1_33.\1_18.) ; old, short string
HRROI 2,[ASCIZ/TECO.MID/]
GTJFN ; try for the source version
JRST PRESH2 ; oh well.
MOVE 2,[1,,7] ; get FDBVER
MOVEI 3,3 ; to AC 3
GTFDB ; yum yum
RLJFN ; give JFN back
JFCL ; ungrateful monitor!
HLRZM 3,VERSN ; groovy, set version from source
PRESH2: MOVSI 1,(1_33.\1_18.) ;OLD, SHORT, STRING
SKIPE TENEXP
SKIPA 2,[-1,,[ASCIZ/<SUBSYS>TECO.SAV/]]
HRROI 2,[ASCIZ /<SUBSYS>TECO.EXE/]
GTJFN
JRST PRESH3 ;NONE, CANNOT SET PATCH VERSION
MOVE 2,[1,,7] ;GET FDBVER
MOVEI 3,3 ;TO 3
GTFDB
RLJFN
JFCL
HLRZS 3 ;GET ACTUAL FILE VERSION NUMBER
IDIVI 3,100. ;SEPARATE INTO VERSN AND PATVER
ADDI 4,1
CAMN 3,VERSN ;MAKING NEW VERSION OF SAME OLD PROGRAM?
MOVEM 4,PATVER ;YES, SAVE INCREMENTED PATVER
PRESH3: GTAD
MOVEM 1,CRDATE ;AND CREATION DATE, THIS ASSEMBLY
MOVE 1,VERSN
IMULI 1,100.
ADD 1,PATVER ;DEFAULT VERSION NUMBER FOR FILE
HRLI 1,(1_35.+1_18.) ;WRITING+SHORT FORM
SKIPE TENEXP
SKIPA 2,[-1,,[ASCIZ/TECO.SAV/]]
HRROI 2,[ASCIZ/TECO.EXE/]
GTJFN
JRST 4,.
HRLI 1,400000 ;THIS FORK
PRESH4: HLRE 2,DEFSYM ;NEG. LENGTH OF SYMS
MOVNS 2
ADD 2,DEFSYM ; 1+TOP OF TABLE
SUBI 2,EVEC-777+1 ;NUMBER OF PAGES USED (WITH ROUNDING)
LSH 2,-9.
ANDI 2,777 ;LEAVE JUST NUMBER OF PAGES
MOVNS 2
HRLZS 2 ;IN PLACE FOR SSAVE
MOVEI 3,EVEC
LSH 3,-9. ;FIRST PAGE NUMBER
HRRI 2,120000(3) ;WITH READ AND EXECUTE BITS
SSAVE ;SHARE SAVE
HALTF
;INFO ENTRY -- RETURN INFORMATION
INFO: MOVEI 1,1 ;CODE 1: BUFFER CONTAINS EOLS
SKIPN EOLF ;CODE 2: BUFFER HAS CRLFS
MOVEI 1,2
MOVE 2,BEG
MOVE 3,Z
HALTF
JRST INFO
;CCL ENTRY. AC1 HAS JFN TO DO ;Y ON.
CCL: MOVEM 1,CCLJFN
JRST TECO1
;STARTUP TIME INITIALIZATION - SUPPORTS TOPS-20 EXEC HAIR
TECO: RESET
SKIPE TENEXP ;ONLY FOR TOPS-20
JRST TECO0
SETZ 1, ;GET RSCAN BUFFER
RSCAN
JRST TECO0
JUMPE 1,TECO0
PBIN ;FIGURE OUT WHAT COMMAND IS
CAIN 1,^J ;THIS SHOULDN'T EVER HAPPEN, BUT...
JRST TECO0
CAIE 1,"E ;EDIT?
CAIN 1,"e
JRST TECO00 ;DEFINITE WINNER
CAIE 1,"C ;MAYBE CREATE?
CAIN 1,"c
JRST TECO01 ;MAYBE...
TECO02: PBIN ;CLEARLY A LOSER. FLUSH COMMAND STRING
CAIE 1,^J
JRST TECO02
JRST TECO0
TECO01: PBIN
CAIN 1,^J ;DEFINITE LOSS?
JRST TECO0
CAIE 1,"R ;LOOK LIKE CREATE?
CAIN 1,"r
JRST TECO00 ;LOOKS GOOD, TAKE IT
JRST TECO02
TECO00: PBIN ;HUNT FOR SPACE - GET AN INPUT BYTE
CAIN 1,^J ;END OF THE LINE?
JRST TECO0 ;(A BAD, BUT NOT COMPLETELY INAPPROPRIATE, PUN)
CAIE 1,<" > ;FOUND THE SPACE YET?
JRST TECO00 ;NO, KEEP ON TRYING
MOVSI 1,3 ;SHORT FORM, FILENAME FROM TERMINAL
MOVE 2,[100,,377777] ;NO OUTPUT
GTJFN
JRST TECO0 ;FAILED SOMEHOW
HRRZM 1,CCLJFN
MOVEI 1,100 ;GET BREAK CHARACTER
BKJFN ;SUCH CROCKISHNESS
JFCL ;???
PBIN
CAIE 1,^J ;LINE FEED YET?
JRST .-2
JRST TECO1
; NON-CCL ENTRY
TECO0: SETOM CCLJFN
MOVEI 1,100
SKIPE VERSN ; meaningless version?
SIBE ;ANYTHING TYPED AHEAD?
JRST TECO1 ;YES, SKIP HEARLD
MOVEI 1,101
HRROI 2,[ASCIZ /TECO./]
SETZ 3,
SOUT
MOVE 2,VERSN ;MAJOR VERSION NUMBER
MOVEI 3,10.
NOUT
JFCL
SKIPN PATVER
JRST TECO1
MOVEI 2,".
BOUT
MOVE 2,PATVER
NOUT
JFCL
TECO1: SETOM INITF ;SAY WE ARE STARTING
SKIPGE MATFLG ;WAS THIS TECO SAVED WITH SOMETHING IN @
JRST GOX ;YES, DON'T CHANGE TECO'S STATE
MOVE A,[FIRSTV,,FIRSTV+1]
SETZM -1(A) ;CLEAR VARIABLES AREA
BLT A,TOP ;NOT INCLUDING CCLJFN, MATFLG
MOVE A,[JSYS [UUOHX,,UUOH]]
MOVEM A,41
SKIPE A,DEFSYM
MOVEM A,116 ;JOBSYM
SKIPE A,UDFSYM
MOVEM A,117 ;JOBUSY
MOVE P,[-LPDL,,PDL-1]
SETZM SFINDF
MOVSI A,(RET)
MOVEM A,TRACS
SETZM COMBUF ;SAY NO DEFAULT COMMENT STRING FOR ;D
MOVEI A,CBUF+200 ;ADR OF TEXT BUFFER
IMULI A,5 ;CHR ADDR OF BEGINNING
MOVEM A,BEG
MOVEM A,PT
MOVEM A,Z
MOVEM A,QRBUF
MOVEI A,CBUF+77
MOVEM A,CBUFH
MOVEI A,CBUF
MOVEM A,LSTCB
MOVEM A,LSTCE
MOVEI A,SYL
MOVEM A,DLIM
MOVE A,[10014,,-1]
MOVEM A,NROOM2
MOVE A,[JRST CNTRS2]
MOVEM A,CNTRS1+1
SETZM PREV.F ;CANCEL DEFAULT FOR S$
SETZM EOLF ;(DEFAULT) SAY BUFFER SHOULD HAVE CRLF'S
MOVSI FF,CISRCH ; initialize flag register(just with
; winning case searches)
JRST GOX
REE: SETOM CCLJFN ;REENTER POINT FROM EXEC
SETZM INITF ;DONT CONSIDER DOING AN M@
GOX: CALL CRR ;TYPE CR LF
MOVEI 1,400000 ;THIS FORK
GPJFN
HRRZS 2 ;LOOK AT OUTJFN
SETZ 3,
CAIE 2,-1 ;NOT REDIRECTED. GUESS TERM TYPE
JRST GOX5 ;REDIRECTED, USE 0 FOR CONHFG
MOVEI 1,101
GTTYP
CAIG 2,24.
MOVE 3,(2)[ 0 ; 0 TTY 33
1 ; 1 TTY 35
1 ; 2 TTY 37
1 ; 3 TI noisy
2 ; 4 ADM-3
2 ; 5 Datamedia
2 ; 6 HP 2645
2 ; 7 Hazeltine
0 ; 8 Terminet
1 ; 9 NVT
2 ;10 VT05
2 ;11 VT50
1 ;12 LA30
2 ;13 GT40
1 ;14 LA36
2 ;15 VT52
2 ;16 VT100
1 ;17 LA38
1 ;18 LA120
1 ;19 TTY 43
2 ;20 TEC
2 ;21 new Hazeltine
2 ;22 Teleray
0 ;23 Tektronix
2] ;24 Ann Arbor
GOX5: MOVEM 3,CONHFG ;SIMULATE A N^H$
MOVEI 1,400000 ;SETUP INTERRUPT STUFF FOR THIS FORK
CIS
MOVE 2,[LEVT,,CHNT]
SIR
MOVE 2,[1_35.\1_24.]
AIC
EIR
MOVSI 1,7. ;bell
ATI ;ASSIGN TO CHN 0
GO: SETZM ABORTF ;CLEAR INTERRUPT FLAGS
SETZM LISNF
MOVEI 1,100 ;ESTABLISH TTY MODES
RFMOD ;READ EXISTING TTY MODES
ANDCMI 2,17_12.+3_10.+17_6. ;WE WILL SPECIFY THESE BITS
IORI 2,14_12.+2_10.+1_6.;AND LEAVE THE OTHERS THE SAME
SFMOD
; @ A B C D E F G H I J K L M N O P Q
MOVE 2,[.BYTE 2?1?0?1?1?1?1?1?1?0?2?0?1?1?2?1?1?1?0]
; R S T U V W X Y Z [ \ ] ^ _
MOVE 3,[.BYTE 2?0?1?1?0?0?0?1?1?1?3?1?1?1?2]
SFCOC
MOVE P,SAVP ;GET OLD STACKS INCASE WE DO M@
MOVE PF,SAVPF ;...
SETZM LFFLG ;SAY NO SAVED LINE FEED FOR TYI
GO1: SKIPGE INITF ;IF INITIALIZING, AND
SKIPL MATFLG ;ARE GOING TO DO AUTO M@,..
SKIPA
JRST CRST ;SKIP REST OF INITIALIZATION
SETZM LEV
MOVE PF,[-LPF,,PFL-1]
MOVE P,[-LPDL,,PDL-1] ;INITIALIZE PUSHDOWN LIST
MOVE T,[JRST SKPSEP] ;INITIALIZE CONTROL S DISPATCH
MOVEM T,CNTRS1
TRZ FF,777777-TRACEF-FORM
JRST CLIS
;INTERRUPT HANDLING ROUTINES
TTYINT: MOVEM 7,IAC+7 ;TTY, I.E. BELL
MOVEI 7,IAC
BLT 7,IAC+6 ;SAVE AC'S
MOVEM 17,IAC17 ;MIGHT HAVE COME OUT OF NROOM
MOVE 17,[-10,,INTSK-1] ;GET LOCAL STACK
MOVEI 1,101
CFOBF ;CLEAR OUTPUT BUFFER ALWAYS
CALL AWAKEN ;SO WE CAN TELL IF 2 BELLS IN A ROW
SETZM INITF ;DON'T TRY TO DO AUTO M@
SKIPN LISNF ;DOING COMMAND INPUT?
JRST TTYI1 ;NO
SKIPE ABORTF ;YES, FIRST INTERRUPT?
JRST [ MOVEI 1,CRST ;NO, RETURN SO AS TO FLUSH INPUT
MOVEM 1,INTP3
MOVEI 1,100
CFIBF
JRST IOER1]
AOS ABORTF ;NOTE INTERRUPT REQUEST
CALL DING
TTYI0: MOVEI 1,100
SIBE
CAIA ;NUMBER OF CHARACTERS OF UNSEEN
MOVEI 2,0 ;TTY: INPUT IN 2
MOVEM 2,TTYCNT ;LOOKED AT AT LI3 ...
JRST IOER1 ;RETURN
U TTYCNT,1
TTYI1: MOVEI 1,100
CFIBF ;CLEAR INPUT BUFFER
SKIPE ABORTF ;FIRST REQUEST?
JRST TTYI2 ;NO, STOP IMMEDIATELY
AOS ABORTF ;YES, NOTE REQUEST
JRST IOER1 ;DEBREAK
ABORT: HRROI 1,[ASCIZ /
^G Abort
/] ;WHEN COMMAND DECODED NOTICES REQUEST
PSOUT
JRST GO
TYOQT: MOVEI 1,101 ;QUIT FROM TYPEOUT, CLEAR OUTPUT BUFFER
CFOBF
CALL DING
CALL CRR
CALL CRR
JRST GO
;IMMEDIATE STOP
TTYI2: MOVEI 1,400000
CIS
JRST GO
;IO ERROR INTERRUPT
IOERR: MOVEM 7,IAC+7 ;SAVE AC'S
MOVEI 7,IAC
BLT 7,IAC+6
MOVEM 17,IAC17
MOVE 17,[-10,,INTSK-1]
HRROI 1,[ASCIZ \
I/O data error, \]
PSOUT
MOVE 2,IAC+1 ;ASSUME JFN IN 1
CAMN 2,INJFN ;THE INPUT ONE?
JRST IOERI ;YES
CAMN 2,OUTJFN ;THE OUTPUT ONE?
JRST IOERO ;YES
HRROI 1,[ASCIZ /in random file
/]
PSOUT
IOER1: MOVSI 7,IAC ;RESTORE AC'S
BLT 7,7
MOVE 17,IAC17 ;RESTORE 17
DEBRK
IOERI: HRROI 1,[ASCIZ /in input file /]
IOER2: PSOUT
MOVEI 1,101
SETZ 3,
JFNS ;TYPE FULL NAME OF FILE
CALL CRR
AOS ABORTF ;REQUEST ABORT
JRST IOER1
IOERO: HRROI 1,[ASCIZ /in output file /]
JRST IOER2
;INTERRUPT TABLES
LEVT: INTP1
INTP2
INTP3
CHNT: 3,,TTYINT ;TTY RUBOUT
REPEAT 10.,0
3,,IOERR ;CHANNEL 11, IO ERROR
REPEAT 24.,0
U INTP1,1 ;INTERRUPT PC'S
U INTP2,1
U INTP3,1
U IAC,10 ;INTERRUPT AC'S
U IAC17,1
U INTSK,10 ;INTERRUPT ROUTINE PDL
U ABORTF,1 ;ABORT REQUESTED IF NOT 0
U LISNF,1 ;DOING COMMAND INPUT IF NOT 0
;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.
TYI: EXCH 1,CH
SKIPN 1,LFFLG ;HAVE SAVED LF FROM PREVIOUS EOL CONVERT
PBIN ;ELSE GET ONE FROM TTY
SKIPN EOLF ;EOL'S ALLOWED IN BUFFER?
CAIE 1,EOL ;OR NOT AN EOL?
JRST TYI9 ;YES OR YES
MOVEI 1,^J ;SAVE LF FOR NEXT TIME
MOVEM 1,LFFLG
TRCA 1,7 ;RETURN A CR THIS TIME
TYI9: SETZM LFFLG ;CANCEL SAVED LF
EXCH 1,CH
RET
U LFFLG,1 ;0 OR 12 DEPENDING IF EOL WAS CONVERTED
;TYPE CHARACTER FROM CH
TYO: EXCH 1,CH
PBOUT
EXCH 1,CH
RET
;DING THE BELL
DING: MOVEI 1,101
RFCOC
PUSH P,2
TLC 2,(3_20.)
SFCOC ;SWITCH FROM ^G TO DING
MOVEI 2,^G
BOUT
POP P,2
SFCOC ;SWITCH BACK TO ^G
RET
;CHANGE WAKE-UP SET TO INCLUDE EVERYTHING
AWAKEN: PUSH P,1
PUSH P,2
MOVEI 1,100
RFMOD
TRO 2,17_12.
SFMOD
POP P,2
POP P,1
RET
;ROUTINE TO TYPE "MESSAGE"
;CALL JSP A,CONMES
; ASCIZ /MESSAGE/
; RETURN
CONMES: HRROS A
PSOUT
JRST 1(A)
;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL CALL CRR
; RETURN
CRR: PUSH P,1 ; save AC 1
MOVEI 1,^M ; CR...
PBOUT
MOVEI 1,^J ; then LF...
PBOUT
POP P,1 ; restore AC 1
RET ; and return
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER AND ERROR IF EMPTY
;CALL CALL SKRCH
; RETURN WITH CHARACTER IN CH
;GOES TO ERR IF COMMAND BUFFER IS EMPTY
SKRCH: SKIPN COMCNT ;COMMAND BUFFER EMPTY?
ERROR [ASCIZ/UTC Unterminated command/]
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL CALL RCH
; RETURN ALWAYS WITH CHARACTER IN CH
RCH: SOSGE COMCNT ;NOW 1 LESS IN COMMAND
;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 [ASCIZ/UTC Unterminated command/]
ILDB CH,CPTR ;YES. GET A CHARACTER.
RET ;RETURN.
; Delete character from screen
DELCH: CAIN CH,^M ; no-op erasing ^M
RET
CAIN CH,^[ ; altmode is special
JRST .+3 ; in that it prints one position
CAIGE CH,<" > ; other control?
PUSH P,[.+1] ; yes, cause extra delete to happen
PUSH P,1
PUSH P,2
PUSH P,3
MOVEI 1,101
RFCOC
PUSH P,2
MOVSI 2,2
SFCOC
HRROI 1,[.BYTE 7 ? ^H ? <" > ? ^H]
PSOUT
MOVEI 1,101
POP P,2
SFCOC
POP P,3
POP P,2
POP P,1
RET
CLIS: HRRZ A,LSTCB ;PREPARE TO SAVE LAST COMMAND STRING
HRRZ AA,LSTCE
CAIG A,CBUF
JRST CSAV1 ;IS ALREADY IN RIGHT PLACE
SUBI AA,0(A) ;NUMBER OF CHARACTERS
CAIG AA,3
JRST CRST1 ;NOT USEFULLY LONG
ADDI AA,CBUF
MOVEI A,CBUF
HRL A,LSTCB
BLT A,-1(AA) ;MOVE TO CBUF
CSAV1: HLL AA,LSTCE
MOVEM AA,LSTCB
JRST CSAV2
CRST: MOVEI 1,101
; @ A B C D E F G H I J K L M N O P Q
MOVE 2,[.BYTE 2?1?0?1?1?1?1?1?1?0?2?2?1?1?2?1?1?1?0]
; R S T U V W X Y Z [ \ ] ^ _
MOVE 3,[.BYTE 2?0?1?1?0?0?0?1?1?1?3?1?1?1?2]
SFCOC ;BE SURE LF IS ON
CALL CRR ;TYPE CR LF
CRST1: MOVE AA,LSTCB ;RESET COMMAND STRING
CSAV2: HRLI AA,440700 ;MAKE BYTE POINTER
MOVEM AA,CPTR
SETOM LISNF ;NOTE NOW DOING COMMAND INPUT
SETZM ABORTF ;CLEAR ABORT FLAG
SETZM DUNFLG ;DON'T PUT OUT HEADING AGAIN
SETZM SAVFLG ;SAY NOT IN ;S
SKIPGE CCLJFN ;CCL?
JRST CSAV3 ;NO
MOVEI 1,101
; @ A B C D E F G H I J K L M N O P Q
MOVE 2,[.BYTE 2?1?1?1?1?1?1?1?1?0?2?2?1?1?2?1?1?1?1]
; R S T U V W X Y Z [ \ ] ^ _
MOVE 3,[.BYTE 2?1?1?1?1?1?1?1?1?1?3?1?1?1?2]
SFCOC ;SET FOR COMMAND EXECUTION
CALL YLOAD
JRST GO ;SHOULD BE OK IF MATFLG AND INITF ARE ON
CSAV3: SETZM COMCNT
SETZM INTDPH
SETZM SYMS
MOVE T,[SYMS,,SYMS+1]
BLT T,SYMEND-1
CALL AWAKEN ;WAKE-UP ON EVERYTHING
SKIPE INITF ;ARE WE INITIALIZING?
AOSE MATFLG ;MAYBE DO M@ ?
CAIA
JRST DOMAT ;YES
LI0: MOVEM P,SAVP ;SAVE IN CASE ;H AND SSAVE HAPPEN
MOVEM PF,SAVPF ;THESE ARE THE RESTART VALUES
SETZM INITF ;DON'T CONSIDER DOING M@ ANYMORE
MOVEI CH,"*
CALL TYO ;TYPE READY CHARACTER
LI0A: PUSH P,1
PUSH P,2
MOVEI 1,100
; @ A B C D E F G H I J K L M N O P Q
MOVE 2,[.BYTE 2?1?0?1?1?1?1?1?1?0?2?0?1?1?2?1?1?1?0]
; R S T U V W X Y Z [ \ ] ^ _
MOVE 3,[.BYTE 2?0?1?1?0?0?0?1?1?1?3?1?1?1?2]
SFCOC
POP P,2
POP P,1
MOVE B,CBUFH
LI1: TRZ FF,ALTF
LI2: CAIG B,(AA) ;COMMAND BUFFER EXCEEDED?
CALL LIXPND ; YES, EXPAND
CALL TYI ;GET A NON-NULL CHARACTER IN CH
CAIE CH,^[ ; altmode?
TRZ FF,ALTF ; no, then clear "preceding alt seen"
SOSGE TTYCNT ;READ TYPE AHEAD PLUS ONE CHR, THEN...
SETZM ABORTF ;CLEAR WAITING ABORT IF CHAR TYPED
SKIPN COMCNT ;IS THIS FIRST CHR IN COMMAND?
JRST LI69 ;YES, CHANGE WAKEUP, CHK FOR LF AND BS
LI79: AOS COMCNT
IDPB CH,AA ;NO. STORE CHARACTER IN COMMAND BUFFER.
CAIN CH,^V ;^V, QUOTE NEXT CHAR
JRST LICV
CAIN CH,^W
JRST CONT.W ;DELETE A WORD
CAIE CH,^H
CAIN CH,^A
JRST LID0
CAIN CH,177 ; rubout also deletes a character
JRST LID0
CAIE CH,^U ; ^U for Twenex fans
CAIN CH,^Q ;CONTROL-Q, DELETE LINE
JRST CONT.Q
CAIN CH,^R ;CONTROL-R, RETYPE LINE
JRST LID3
CAIN CH,^[ ; altmode?
TRON FF,ALTF ; was preceding alt seen?(turn on anyway)
JRST LI2 ; no, get next character
LI89: MOVEI CH,177 ;END OF COMMAND STRING MARKER
AOS A,COMCNT ;MARK END OF COMMAND STRING RUBOUT
IDPB CH,AA
MOVEM A,COMAX
MOVE C,AA ;SAVE END OF THIS COM STRING
IBP C ; FOR POSSIBLE LATER USE
IBP C ;POINTER BEFORE LAST THREE CHARS
HRLI C,-3(A)
MOVEM C,LSTCE
SETZM LISNF ;NO LONGER DOING COMMAND INPUT
CALL CRR ;TYPE CRLF
JRST CD ;DECODE COMMAND
LIXPND: ADDI B,100 ;YES. EXPAND COMMAND BUFFER 100 WORDS.
MOVEM B,CBUFH
MOVE C,Z
IDIVI C,5 ;C:=DATA BUFFER END WORD ADDRESS.
SKIPE C+1 ;CHECK REMAINDER
AOS C ;PART IN NEXT WORD
MOVE D,QRBUF
IDIVI D,5 ;D:=Q-REG BUFFER BASE WORD ADDRESS.
SUBM C,D ;NO. OF WORDS IN Q-REG AND DATA BUFFER.
MOVE CH,(C)
MOVEM CH,100(C) ;MOVE Q-REG AND BUFFER 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
RET
; ^V QUOTES NEXT CHARACTER (INTERRUPT CHRS IF POSSIBLE)
LICV: PUSH P,1
PUSH P,2 ;AA
PUSH P,3
LICV0: MOVEI 1,400000
RPCAP
JUMPGE 2,LICV8 ;^C NOT ALLOWED
PUSH P,2
PUSH P,3
TLO 3,(1_35.) ;^C CAP
EPCAP ;ENABLE CONTROL C
CALL AWAKEN
MOVEI 1,-5 ;SAY JOB TIW
RTIW
PUSH P,2
SETZ 2,
STIW ;MAKE ALL CONT CHRS TYPE-IN-ABLE
MOVEI 1,101
RFCOC
PUSH P,2
PUSH P,3
; @ A B C D E F G H I J K L M N O P Q
MOVE 2,[.BYTE 2?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1?1]
; R S T U V W X Y Z [ \ ] ^ _
MOVE 3,[.BYTE 2?1?1?1?1?1?1?1?1?1?3?1?1?1?1?1?1?1?1]
SFCOC ;indicate all control characters EXCEPT altmode
CALL TYI ;GET QUOTED CHAR
LICV4: DPB CH,-6(P) ;REPLACE ^V
POP P,3
POP P,2
MOVEI 1,101
SFCOC
MOVEI 1,-5
POP P,2
STIW
POP P,3
POP P,2
MOVEI 1,400000
EPCAP ;RESTORE CAPABITLITIES
LICV9: POP P,3
POP P,2
POP P,1
JRST LI1
LICV8: CALL TYI
DPB CH,-1(P) ;REPLACE ^V
JRST LICV9
; Delete a character from the command buffer
; If 0^H (TTY, ugh!), handle as canonical printing console delete (echo back)
; If 1^H (TI, etc.), backspace if ^H, else canonical delete
; If 2^H (glass terminal), erase character from the screen
LID0: ADD AA,[14._30.] ; back up two bytes
TLNE AA,400000
SUB AA,[43_30.+1]
MOVE D,AA
SOSG COMCNT
JRST LIDERR ; NO CHARS TO DELETE
SKIPN CONHFG ;IN 0^H MODE?
JRST LID1 ;YES, HANDLE AS ^A
CAIE CH,^H ; input BS?
JRST [ MOVE CH,CONHFG ; no, get terminal type
CAIN CH,1 ; is this a printing console?
JRST LID1 ; yes, do old deletes
SOS COMCNT ; zap command count
JRST LID0A] ; use new deletes
SOS COMCNT
MOVE CH,CONHFG ; get terminal type
CAIN CH,1 ; printing console?
JRST LID0B ; yes, all done
LID0A: ILDB CH,D ; get character we clobbered
CAIN CH,^I ; tab?
JRST [ CALL WIPTAB
JRST LID0B]
CAIN CH,^J ; line feed?
JRST OLDLIN ; yes, do line hackery
CALL DELCH ; zap character
LID0B: SKIPG COMCNT
JRST LI0A
JRST LI1
;DELETE A CHARACTER FROM THE COMMAND BUFFER.
LID1: ILDB CH,D ;NO. TYPE DELETED CHARACTER
CALL TYO
SOS COMCNT ;REMOVE 2 CHARACTERS FROM COMMAND COUNT.
JRST LID0B ;AND GET ANOTHER COMMAND CHARACTER
; DING IF NO MORE
LIDERR: CALL DING
HRLI AA,440700
HRR AA,LSTCB
MOVEM AA,CPTR
SETZM COMCNT
JRST LI0A
;DELETE WORD FROM COMMAND BUFFER
CONT.W: CALL DECPTR ;DECREMENT COMMAND INPUT POINTER
JRST LIDERR ;NOTHING LEFT
MOVEI CH,"_
SKIPN CONHFG ;MODEL 33 EQUIVALENT?
CALL TYO ;YES. INDICATE THE WORD DELETION
CONTW0: CALL DECPTR ;ALWAYS DELETE SOMETHING
JRST [ CALL WIPEIT
SKIPN CONHFG
JRST CRST
JRST LI0A]
CALL WIPEIT ;AND GET IT OFF THE SCOPE
MOVE CH,AA
ILDB CH,CH ; get character that was flushed
CALL SKPSEP ;WAS IT A SEPARATOR?
CAIA ; no, delete rest of the word
JRST CONTW0 ; yes, keep on deleting
CONTW1: LDB CH,AA ;GET THE CHARACTER ABOUT TO BE DELETED
CALL SKPSEP ;SEE IF A SEPARATOR
CAIA ; no
JRST LID0B
CONTW2: CALL DECPTR
JRST [ SKIPN CONHFG
JRST CRST
CALL WIPEIT
JRST LI0A]
CALL WIPEIT
JRST CONTW1
WIPEIT: SKIPE TT,CONHFG ; TTY?
CAIN TT,1
RET ; printing console; no eraser
MOVE CH,AA ; get a copy of BP
ILDB CH,CH ; get character just deleted
CAIN CH,^I ; tab?
JRST WIPTAB
CAIN CH,^J ; line feed?
JRST OLDLIN ; yeah, do ^R hack...
JRST DELCH ; zap character
DECPTR: ADD AA,[7_30.]
SKIPG AA
SUB AA,[43_30.+1]
SOSLE COMCNT
AOS (P)
RET
WIPTAB: PUSH P,AA
PUSH P,COMCNT
PUSH P,A ; just in case
IBP AA
AOS COMCNT
SETO D,
CALL LIL2
SKIPA A,[1]
SETZ A,
SETCA D,
JUMPE D,WIPTB1
WIPTB2: ILDB CH,AA
ADDI A,1
CAIN CH,^I
JRST [ TRZ A,7
ADDI A,8.
SOJG D,WIPTB2
JRST WIPTB1]
CAIGE CH,<" >
CAIN CH,^[
CAIA
ADDI A,1 ; other controls
SOJG D,WIPTB2
WIPTB1: MOVE D,A
POP P,A
POP P,COMCNT
POP P,AA
ANDI D,7
SUBI D,8.
WPDL: REPEAT 3,PUSH P,1+.RPCNT
MOVEI 1,101
RFCOC
PUSH P,2
MOVSI 2,2
SFCOC
MOVEI 1,^H ; just backspace
PBOUT
AOJL D,.-1
MOVEI 1,101
POP P,2
SFCOC
REPEAT 3,POP P,3-.RPCNT
RET
;TRY FOR AUTOMATIC M@
DOMAT: MOVE A,QTAB+"9+1-"0 ;ENTRY FOR THE @ QREG ("A"-1)
TLNN A,377770
TLNN A,400000
JRST LI0 ;Q@ HAS A NUMBER IN IT
SETZM INITF ;DON'T CONSIDER DOING AUTO M@ AGAIN
MOVE B,CBUFH
MOVE CH,[ASCII / M@/]
JRST LI71 ;GO DO THAT FAKE TYPE-IN
;FIRST CHR IN COMMAND
LI69: PUSH P,1
PUSH P,2
PUSH P,3
MOVEI 1,100
RFMOD
ANDCMI 2,17_12. ;CHANGE WAKEUP SET
IORI 2,16_12. ;TO ALL CONTROLS
SFMOD
MOVEI 1,101
RFCOC
PUSH P,3
TRO 2,1_15. ;TURN ON LINE FEED AGAIN
TLZ 2,(3_18.) ;ASSUME ^H SHOULD BE ECHOED AS NOTHING
MOVE 3,CONHFG
CAIN 3,1
TLO 2,(2_18.)
POP P,3
SFCOC
CAIN CH,^M ; terpri?
CALL CRR ; make sure it is echoed
POP P,3
POP P,2
POP P,1
CAIN CH,^J ;LINE FEED?
JRST LI70 ;YES
CAIN CH,<" > ; space?
JRST [ MOVE CH,[ASCII /0TT/]
JRST LI71]
CAIN CH,177 ; rubout?
JRST LI69A ; equivalent to BS (LOTS hack)
CAIE CH,^H ;BACKSPACE (^H)?
JRST LI79 ;NOT A SPECIAL, BACK TO MAINLOOP
LI69A: SKIPA CH,[ASCII /-LT/]
LI70: MOVE CH,[ASCII /+LT/]
LI71: MOVEM CH,@CPTR ;STORE FAKE COMMAND STRING
MOVEI CH,5
MOVEM CH,COMCNT ;UPDATE COUNT OF COMMAND CHRS
AOJA AA,LI89 ;MAKE BELIEVE ALTMODE SEEN.
U LSTCB,1 ;BEG OF LAST COMMAND STRING
U LSTCE,1 ;END OF LAST COMMAND STRING
;DELETE LINE
CONT.Q: MOVE CH,CONHFG ;CONTROL H FLAG
CAIL CH,2 ;SCOPE?
JRST CONTQS ;YES, GO HANDLE AS SUCH
CALL DECPTR
JRST LIDERR
LID2: CALL DECPTR
JRST CRST
LDB CH,AA
CALL EOLP
JRST LID2
MOVEI CH,"_
CALL TYO
CALL CRR
JRST LID0B
CONTQS: CALL DECPTR ;DECREMENT THE LINE POINTER
JRST LIDERR ;BACKED OFF THE BEGINNING
CONTQ1: CALL DECPTR ;NOW DO REAL CHARACTERS
JRST [ CALL WIPEIT ; make last character go away
JRST LI0A] ; and charge on
CALL WIPEIT ; and erase character from screen.
LDB CH,AA ;GET NEXT CHARACTER
CALL EOLP ;END OF LINE IN CURRENT MODE?
JRST CONTQ1 ;NO
JRST LID0B ;YES. BACK TO MAIN LOOP.
OLDLIN: LDB CH,AA ; get previous character
MOVEI D,^R ; and a phony ^R
CAIE CH,^M ; carriage return?
JRST [ IBP AA ; no, get the frob back
AOS COMCNT ; restore the command counter
JRST .+1] ; now attack.
DPB D,AA ; yeah, shove in CR
LID3: MOVEI CH,^M ; CR first
CALL TYO
MOVE CH,CONHFG ; get terminal type
CAIN CH,2 ; some kind of display?
JRST .+3 ; yes, then overwrite this line
MOVEI CH,^J ; LF next
CALL TYO
CALL LIL1 ;FIND BEGINNING OF IT
JRST [ MOVEI CH,"* ; beginning of buffer,
CALL TYO ; so do a fake prompt
JRST .+1] ; and continue on
MOVE D,AA
LID5: ILDB CH,D
CAIN CH,^R ;TYPE UNTIL CONTROL-R
JRST LID0B
CALL TYO
MOVE AA,D
AOS COMCNT
JRST LID5
LIL1: MOVEI D,0
LIL2: ADD AA,[14._30.]
TLNE AA,400000
SUB AA,[43_30.+1]
ILDB CH,AA
SOSG COMCNT
RET
CALL EOLP
CAIA ;NOT END OF LINE
JRST RSKP
SOJA D,LIL2
RSKP: AOS 0(P)
RET
;COMMAND DECODER
CD: MOVEI 1,101 ;INDICATE ALL CONTROLS
; @ A B C D E F G H I J K L M N O P Q
MOVE 2,[.BYTE 2?1?1?1?1?1?1?1?1?1?2?2?1?1?2?1?1?1?1]
MOVE 3,CONHFG ;CONTROL-H FLAG (TERMINAL TYPE)
CAIE 3,1 ;CHECK TO SEE IF CODE 10 WILL CAUSE
CAIN 3,2 ;PHYSICAL BACKSPACE (SEND IT) OR
TLC 2,(3_18.) ;NOT (INDICATE IT)
; R S T U V W X Y Z [ \ ] ^ _
MOVE 3,[.BYTE 2?1?1?1?1?1?1?1?1?1?3?1?1?1?2]
SKIPN EOLF
TRC 3,3_8. ;MAKE 37'S INDICATE
SFCOC
CRET: TRZ FF,ARG2+ARG+FINDR+PCHFLG
CD1: SETZM NUM
CD2: MOVSI A,(ADD B,)
CD3: HLLM A,DLIM
CD4: SETZM SYL
CD5: SKIPE ABORTF
JRST ABORT ;RUBOUT OR IO ERROR
SETZM SAVFLG ; CLEAR ;S FLAG
AOSN ESTYPE ; do an automatic V?
SKIPA CH,["V] ; yup
CALL RCH ;READ COMMAND CHAR AND CHECK
CAIN CH,177
JRST GO ;END OF COMMAND STRING
CAIE CH,140 ;SOME CODES
CAILE CH,"z
ERROR [ASCIZ/UDC Undefined command/]
CAIL CH,"a ;LOWER CASE IS CONVERTED TO UPPER CASE
SUBI CH,40
CD9: XCT DTB(CH) ;A:=VALUE FLAG,,DISPATCH ADDRESS
;OR DISPATCH DIRECTLY
CD6: MOVE B,NUM
TRZE FF,SYLF ;VALUE OR 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.
CALL (A) ;DISPATCH FOR NON-VALUE RETURN COMMANDS.
JRST CRET
SEMICL: CALL RCH ;SEMICOLON COMMANDS
CAIGE CH,<" >
MOVEI CH,<" >
CAIL CH,140
SUBI CH,40
ADDI CH,SEMTAB-DTB-40 ;OFFSET TABLE
JRST CD9 ;AND DISPATCH
U DLIM,1
U NUM,1
U SYL,1
U SARG,1
;DIGITS FORM DECIMAL INTEGERS.
CDNUM: MOVE A,SYL
IMULI A,10.
ADDI A,-60(CH)
;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET: MOVEM A,SYL
CD7: TRO FF,ARG+SYLF
JRST CD5
;Some routines take an arg and return a value which can be used as an
; arg to the next command. n;N and n;B are examples
VALARG: SETZM NUM
JRST VALRET
;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.
UAR: CALL 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.
SEMI.H: TLZ FF,UREAD+UWRITE+FINF ;INCASE SOMEONE REENTERS
MOVEI 1,7. ;DEASSIGN TTY INTERRUPTS, BELL
DTI
HALTF
JRST REE ;IN CASE A "CONTINUE" IS DONE
; COMMA SEPARATES ARGS
COMMA: MOVEM B,SARG ;SAVE CURRENT ARGUMENT IN SARG.
TRZE FF,ARG ;WAS THERE A CURRENT ARGUMENT?
TROE FF,ARG2 ;ALREADY SEEN ONE ,?
ERROR [ASCIZ/WNA Wrong number of arguments/]
JRST CD1 ;YES. CLEAR CURRENT ARGUMENT.
;LOGICAL AND
CAND: MOVSI A,(AND B,)
JRST CD3
;LOGICAL OR
COR: MOVSI A,(IOR B,)
JRST CD3
;SUBTRACT TAKES ONE OR TWO ARGUMENTS
MINUS: MOVSI A,(SUB B,)
JRST CD3
;MULTIPLY TAKES TWO ARGUMENTS
TIMES: MOVSI A,(IMUL B,)
JRST CD3
;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS
SLASH: MOVSI A,(IDIV B,)
JRST CD3
; 0^H SAYS THE TERMINAL LACKS MECHANICAL BACKSPACE
; 1^H SAYS THE TERMINAL HAS MECHANICAL BACKSPACE
; 2^H SAYS TERMINAL HAS ERASER
UP.H: TRNN FF,ARG2
TRNN FF,ARG
ERROR [ASCIZ/WNA Wrong number of arguments/]
CAIL B,0
CAILE B,2
ERROR [ASCIZ/ITT Invalid terminal type/]
MOVEM B,CONHFG
RET
U CONHFG,1
; ^D OVERIDES THE DEFAULT COMMENT STRING USED BY ;D
; ^D NORMALLY PICKS THE COMMENT CHARACTER ON THE BASIS OF THE
; FILE EXTENTION (; FOR .MAC, // FOR .BCP ETC.).
; IF THE EXTENSION IS UNKNOWN, AND NONE WAS SPECIFIED BY ^D,
; A SEMICOLON WILL BE USED.
;STRING MAY BE UP TO 24. CHARACTERS LONG
UP.D: TRNE FF,ARG\ARG2
ERROR [ASCIZ/ANE Argument given when none expected/]
MOVE A,[440700,,COMBUF]
MOVEI I,5*5-1 ;WILL END IN NULL
UP.D1: SOJL I,UP.DR2
CALL SKRCH
IDPB CH,A
CAIE CH,^[ ;ALTMODE (IE, CONTROL-D)?
JRST UP.D1
UP.D2: MOVEI CH,0
DPB CH,A ;MAKE ASCIZ
RET
UP.DR2: MOVEI CH,0
DPB CH,A
JSP A,CONMES
ASCIZ /^D string truncated to 24. characters/
JRST UP.D2
U COMBUF,5
;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: SETZM SARG ;SET SECOND ARGUMENT TO 0.
TRZN FF,ARG ;ANY ARGS BEFORE H?
TRNE FF,ARG2 ; ..
ERROR [ASCIZ/ANE Argument given when none expected/]
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
; 0^F CLEAR THE "EOL'S IN THE BUFFER" FORMAT FLAG
; 1^F SET THE FLAG
; ^F (NO ARG) JUST RETURNS ITS VALUE (-1 IF SET, 0 OTHERWISE)
UP.F: JUMPE B,.+2
SETO B, ;NORMALIZE THE VALUE
TRNE FF,ARG ;BUT WAS THERE A VALUE?
CALL CVTBUF ;YES, CONVERT BUFFER IF NEEDED
MOVE A,EOLF ;RETURN THE FLAG AS VALUE
JRST VALARG
CVTBUF: CAMN B,EOLF ;BUFFER IS ALREADY IN RIGHT FORMAT?
RET ;YES
PUSH P,COMAX ;PUSH STUFF IN CASE GC HAPPENS
PUSH P,CPTR
PUSH P,COMCNT
PUSH P,PT
MOVE I,BEG
MOVEM I,PT ;START AT BEGINNING OF BUFFER
CVTBU1: MOVE I,PT ;CONTINUE FROM LAST FIND
CVTB11: CAML I,Z ;AT END OF BUFFER?
JRST CVTBU9 ;YES, DONE.
CALL GETINC ;GET A CHARACTER, INCREMENT I
CALL EOLP ;IS IT A PREVIOUS FORMAT EOL?
JRST CVTB11 ;NO. NO CONVERSION NEEDED
CVTBU2: SUBI I,1 ;BACK UP OVER EOL OR LF
SKIPE EOLF ;ADJUST PT BACK OVER CR IF NEEDED
JRST CVTB20 ;EOLS CURRENTLY IN BUFFER
CAMG I,BEG ;CAREFUL ABOUT LF AS 1ST CHR IN BUFFER
CVB201: AOJA I,CVTB11 ;UNDO THE BACK UP, RESUME SEARCH
SUBI I,1
CALL GETCHR ;GET THE CHARACTER AT I
CAIE CH,^M ;REALLY A CR?
AOJA I,CVB201 ;NO. RESUME SEARCH AFTER LF
CVTB20: MOVEM I,PT ;WHERE TO MAKE/TAKE SPACE
MOVEI C,1 ;NEED 1 MORE HOLE IF CONVERTING FROM EOL
SKIPN EOLF ;TO CRLF.
MOVNI C,1 ;ONE LESS IF GOING OTHER WAY
CALL NROOM ;MAKE THAT MUCH ROOM
MOVE OU,PT
SKIPN EOLF
JRST CVTB23 ;CONVERTING TO TENEX EOLS
MOVEI CH,^M
CALL PUTCHR
ADDI OU,1
TRCA CH,7
CVTB23: MOVEI CH,EOL
CALL PUTCHR
JRST CVTBU1 ;LOOK AT REST OF BUFFER
CVTBU9: POP P,PT
SUB P,[3,,3]
SETCMM EOLF ;BUFFER IS NOW IN THE OTHER FORMAT
RET
; 0^S TURN OFF CASE INDEPENDENT SEARCH MODE
; N^S TURN ON CASE INDEPENDENT SEARCH MODE
; ^S (NO ARG) JUST RETURNS ITS VALUE (-1 IF CI SEARCH MODE ON, ELSE 0)
UP.S: TRNN FF,ARG ;WAS AN ARG GIVEN?
JRST UPS1 ;NO, JUST RETURN VALUE
SKIPN B ;CHECK THE ARG
TLZA FF,CISRCH
TLO FF,CISRCH
UPS1: SETZ A,
TLNE FF,CISRCH
SETO A,
JRST VALRET
; ;B has the value of point at the beginning of this page
; n;B has the value of point at the beginning of the n-th page
SEM.B: TRNE FF,ARG2 ;Too many arg's?
ERROR [ASCIZ/TMA Too many arguments/]
TRNN FF,ARG ;Was an arg supplied?
JRST SEM.B2 ;No. Search back on this page.
JUMPLE B,SEM.X ;ERROR
MOVE I,BEG
SOSG B ;If page 1, we are done
SOJA I,SEM.B4 ;Compensate for AOS to follow
CALL FINDFF ;Find the n-1 th form feed
JRST SEM.B4
SEM.B2: MOVE I,PT ;Start at .
SUBI I,1
SEM.B3: SKIPE ABORTF ;Aborting?
JRST TYOQT ;Yes
CAMGE I,BEG ;Back to beg of buffer?
JRST SEM.B4 ;Yes. Done.
CALL GETCHR
CAIE CH,^L ;Is it a FF?
SOJA I,SEM.B3 ;No. Try previous char.
SEM.B4: AOS A,I
CAMLE A,Z ;IN THE BALL PARK?
SEM.X: ERROR [ASCIZ/PNF Page not found/]
SUB A,BEG ;Make relative to beg of buffer
JRST VALARG
; ;Z has the value of point at the bottom of the current page
; This is the same as the top of the next page.
SEM.Z: MOVE I,PT ;Where to start
MOVEI B,1 ;Find first formfeed
CALL FINDFF
AOS A,I ;Include the FF on this page
CAMLE A,Z ;IN BUFFER?
MOVE A,Z ;FORCE IT TO BE SO
SUB A,BEG
JRST VALARG
;subroutine to find the n-th formfeed (in B) after the position in I.
FINDFF: SKIPE ABORTF ;Rubout?
JRST TYOQT ;Yes
CAML I,Z ;Still in buffer?
JRST [ MOVE I,Z
RET]
CALL GETCHR ;Get CHR to CH
CAIE CH,^L
AOJA I, FINDFF ;Not a FF, Try next.
SOJG B,.-1 ;Found all we were told to?
RET ;Yes
;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN
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
PUSH P,A ;PUSH CURRENT OPERATOR.
AOS LEV ;INCREMENT ( LEVEL.
JRST CRET
CLOSE: SOSGE LEV ;IS THERE A (?
ERROR [ASCIZ/UMP Unmatched right parenthesis/]
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 ITER. 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 [ASCIZ/NAE No argument to =/]
PRNT9: MOVEI A,101 ; primary output JFN
PUSH P,2 ; save current ac 2
MOVE 2,B ; get number for NOUT
MOVEI 3,10. ; decimal base
NOUT ; output number
JFCL ; too bad
POP P,2 ; restore AC 2
JRST CRR ;CRLF AND RETURN TO CALLER
;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.
SPTYI: TRNE FF,ARG ; given an argument?
JRST [ TDNE B,[-1,,777600] ; non ASCII?
ERROR [ASCIZ/NAC Not an ASCII character/]
MOVE 1,B
PBOUT ; n^T outputs on console
JRST CRET]
CALL AWAKEN ;CHANGE WAKE-UP SET TO ALL
MOVEI 1,101
RFCOC
PUSH P,2
PUSH P,3
; @ A B C D E F G H I J K L M N O P Q
MOVE 2,[.BYTE 2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2]
; R S T U V W X Y Z [ \ ] ^ _
MOVE 3,[.BYTE 2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2?2]
SFCOC
CALL TYI
POP P,3
POP P,2
MOVEI 1,101
SFCOC
MOVE A,CH
JRST VALRET
;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.
CNTRUP: CALL 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
CALL 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,10.
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.
CAML I,Z ;AT END OF BUFFER?
JRST BEGIN ;YES, RETURN 0 AS VALUE
PICK1: CALL GETCHR ;CHARACTER TO THE RIGHT OF PT.
MOVE A,CH ;RETURN CH AS VALUE.
JRST VALRET
PICKUP: MOVE I,PT ; ;P COMMAND, PICKUP CODE AND INC PNTR
CAML I,Z
JRST BEGIN ;AT END OF BUFFER, RETURN 0
AOS PT
JRST PICK1
; ;N picks up a positive number from the data (base 10)
; n;N picks it up in base n. PT is left at first non-number.
PIKNUM: TRNN FF,ARG
MOVEI B,10.
JUMPLE B,[ERROR [ASCIZ/INB Invalid numeric base/]]
SETZ A,
PIKNML: MOVE I,PT
CAML I,Z
JRST VALARG
CALL GETCHR
CAIGE CH,"0(B)
CAIGE CH,"0
JRST VALARG
AOS PT
IMUL A,B
ADDI A,-"0(CH)
JRST PIKNML
;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I.
USE: TRZN FF,ARG ;DID AN ARGUMENT PRECEED U?
ERROR [ASCIZ/NAU No argument to U/]
CALL QREGVI ;YES. CH:=Q-REGISTER INDEX.
MOVEM B,QTAB-"0(CH) ;STORE ARGUMENT IN SELECTED Q-REG.
JRST CLSBB
;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.
QREG: CALL QREGVI
JRST VALRET ;NUMBER CHECK WOULD MAKE ;T LOSE
;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
;CALL CALL 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: CALL RCH ;GET NEXT COMMAND STRING CHARACTER
CAILE CH,140 ;LC LETTER?
TRZ CH,40 ;MAKE UC
CAIL CH,"0
CAILE CH,"9
CAIA
JRST QREGV5 ;DIGIT
CAIL CH,"@
CAILE CH,"Z
ERROR [ASCIZ/IQN Illegal Q-register name/]
SUBI CH,"@-"9-1 ;TRANSLATE LETTERS DOWN BY NUMBER OF
;CHARACTERS BETWEEN 9 AND @.
QREGV5: MOVE A,QTAB-"0(CH) ;RETURN CONTENTS OF Q-REGISTER
RET
;%I INCREMENTS Q-REGISTER I
PCNT: CALL QREGVI ;CH:=Q-REGISTER INDEX.
TLNN A,377770
TLNN A,400000
CAIA
ERROR [ASCIZ/NUT Numeric use of Q-register containing text/]
AOS A,QTAB-"0(CH) ;INCREMENT Q-REG.
JRST VALRET ;RETURN NEW VALUE.
;M,NXI MOVES CHARS M THRU N INTO Q-REGISTER I.
;NXI CHRS FROM "." THRU N-TH LINE FEED ARE MOVED TO Q-REG I
X: SOS GCCNT ;COUNT TO NEXT GC
CALL GETARG ;1ST ARG TO C, 2ND TO B
CAML C,BEG
CAMLE C,B ;1ST < 2ND AND BOTH INSIDE BUFFER?
ERROR [ASCIZ/ITP Invalid text pointer/]
PUSH P,B ;MUST BE STACKED IN CASE GC HAPPENS
PUSH P,C
EXCH B,C ;YES.
SUB C,B ;LENGTH OF STRING
ADDI C,4 ;PLUS 4 OVERHEAD CHARS
MOVEM C,QLEN ;IS LENGTH OF Q-REGISTER
CALL QREGVI ;GET Q-REG NOW TO BE SURE IT EXISTS
MOVEM CH,XQREG ;SAVE FOR LATER
ADDI C,4 ;CAUSE IDIVI TO ROUND UP
IDIVI C,5
IMULI C,5 ;NUMBER OF CHARACTERS TO MOVE
MOVE D,BEG
MOVEM D,PT ;PT:=BEG
X0: CALL NROOM ;MOVE EVERYTHING UP INTEGRAL NUM OF WRDS
MOVE OU,BEG ;CHR ADDRESS OF Q-REG
ADDM C,BEG ;UPDATE BEG FOR MOVE
ADDM C,(P) ;UPDATE ARGUMENTS TO REFLECT MOVE
ADDM C,-1(P)
X1: IDIVI OU,5 ;WORD ADDR OF Q-REG
MOVE I,QLEN ;LENGTH OF Q-REG, INC, OVRHD
LSH I,10
TLO I,(141_29.) ;INSERT MARK
MOVEM I,0(OU) ;STORE OVERHEAD CHRS IN Q-REG
HRLI OU,100700 ;CONSTRUCT DESTINATION PTR
MOVE C,QLEN ;LENGTH OF QREG
SUBI C,4 ;LENGTH OF CONTENTS
MOVE TT,0(P) ;CONSTRUCT BYTE POINTER FOR SOURCE
IDIVI TT,5 ;GET WORD ADDR
MOVE B,BTAB-1(TT1) ;NOTE: PTR IS INDEXED BY TT
X2: ILDB CH,B ;MOVE STRING TO Q STORAGE
IDPB CH,OU
SOJG C,X2
POP P,C
POP P,B
PUSH P,PT
CALL KLBUF1
POP P,B
SUB B,QRBUF ;ADDRESS RELATIVE TO C(QRBUF)
TLO B,400000
MOVE CH,XQREG ;THE Q-REG WE ARE X-ING INTO
X3: CAIN CH,"9+1 ;X WAS INTO Q-REG "@" ?
SETOM MATFLG ;PERMIT AUTO M@ AT NEXT STARTUP
MOVEM B,QTAB-"0(CH)
JRST CRET
U XQREG,1
U QLEN,1
; M,NG INSERT N-M CHARACTERS, STARTING FROM M, AT THE CURRENT LOCATION
; OF THE POINTER. THIS IS A COPY, NOT A MOVE OPERATION.
; NG MAKES A COPY OF THE NEXT N LINES, LEAVING THE POINTER
; BETWEEN THE COPIES.
;GI THE TEXT IN Q-REGISTER IN 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: TRNN FF,ARG
JRST QGETA ;IF GET IS FROM A Q-REG
CALL GETARG
CAML C,BEG ;CHECK FOR VALID ARGS
;(N>Z IS VALID,THO GARBAGE IS POSSIBLE)
CAMLE C,B
ERROR [ASCIZ/ITP Invalid text pointer/]
PUSH P,C ;FOR THE GC
SUBM B,C
CALL NROOM
POP P,I
CAML I,PT ;ADJUST M IF IT WAS NOT BELOW POINT
ADD I,C
JRST QGETB
QGETA: CALL QREGVI ;A:=QTAB ENTRY, CH:=Q-REG INDEX
MOVE B,A
PUSH P,CH
CALL QGET2 ;GET NUMBER OF CHARS
POP P,B ;Q-REG INDEX
CALL NROOM ;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE I,QTAB-"0(B)
TLZ I,400000
ADD I,QRBUF
ADDI I,4
QGETB: MOVE OU,PT
QGET1: JUMPE C,CRET ;MOVE STRING INTO DATA BUFFER
CALL GETINC
CALL PUTCHR
AOS OU,PT
SOJA C,QGET1
; ;T - TYPE CONTENTS OF Q REG
TPREG: TRNN FF,ARG
JRST COMM ;TYPE LITERAL STRING IF NO ARG
CALL QGET2
JUMPE C,CRET
CALL GETINC
CALL TYO
SKIPE ABORTF ;ABORTING?
JRST TYOQT ;YES
SOJA C,.-5
QGET2: TLZN B,377770 ;DOES Q-REG CONTAIN TEXT?
TLZN B,400000
ERROR [ASCIZ/NTQ No text in Q-register/]
ADD B,QRBUF ;YES
MOVE I,B ;Q-REG CHAR ADDRESS
CALL GETINC ;IS FIRST CHARACTER IN Q-REG 141?
CAIE CH,141
ERROR [ASCIZ/NTQ No text in Q-register/]
CALL GETINC
MOVEM CH,C
CALL GETINC
LSH C,7 ;RECONSTRUCT CHAR COUNT,
IOR C,CH ;MOST SIGNIFICANT CHARS FIRST
CALL GETINC
LSH C,7
IOR C,CH
SUBI C,4 ; "141" AND 3 OF COUNT
RET ;C HAS LEN., I HAS CHR ADDR OF CONTENT
;]I POPS Q-REGISTER IN OFF THE Q-REGISTER PUSHDOWN LIST.
; THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.
CLOSEB: CALL QREGVI
POP PF,QTAB-"0(CH) ;POP THE Q-REG (OLD VALUE STILL IS IN A)
CLSBB: TLNN A,377770
TLNN A,400000
CAIA ;IF OLD VALUE WAS A NUMBER, NO GARBAGE.
SOS GCCNT
RET ;U AND ] DO NOT RETURN VALUES
;[I PUSHES Q-REGISTER IN ONTO THE Q-REGISTER PUSHDOWN LIST.
OPENB: CALL QREGVI
PUSH PF,QTAB-"0(CH) ;C:=Q-REGISTER INDEX.
JRST CD5
;E COMMANDS SELECT AND CONTROL FILE INPUT-OUTPUT MEDIA
ECMD: CALL RCH
TRZ CH,40 ;LC TO UC
CAIN CH,"A
JRST OPNAP ;OPEN AN OUTPUT FILE FOR APPEND
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,"D ;ED ?
JRST DINISH ;EX with ;D(;S) not ;S
CAIN CH,"X ;EX?
JRST FINISH ;YES. DO HPEF<DING>
CAIN CH,"G
JRST GOCCL ;EG, CALL CCL
CAIN CH,"E ; hack error messages?
JRST [ TRNN FF,ARG ; have an argument?
SETZ B, ; default to normal messages
MOVEM B,ERMSGL ; hack the messages
RET] ; and return
CAIN CH,"S ; hack autotypeout on searches?
JRST [ TRNN FF,ARG ; have an argument?
JRST [ MOVE A,ESFLAG
POP P,(P); fix up stack
JRST VALRET]; yes, return current value
MOVEM B,ESFLAG ; else set ES flag
RET] ; and return
CAIN CH,"P ; EP => ENTER INFERIOR EXEC
JRST [ MOVSI 1,200000 ; INFERIOR GETS THIS FORK'S CAPACITIES
CFORK ; CREATE AN INFERIOR
ERROR [ASCIZ/FRK Can't create inferior fork/]
HRL 1 ; SAVE PROCESS HANDLE
MOVSI 1,100001 ; OLD FILE, SHORT FORM
SKIPE TENEXP ; IS THIS ON TENEX?
SKIPA 2,[-1,,[ASCIZ/<SYSTEM>EXEC.SAV/]]
HRROI 2,[ASCIZ/<SYSTEM>EXEC.EXE/]
GTJFN ; GET A JFN FOR THIS GUY
ERROR [ASCIZ/EXC Can't get at EXEC/]
HLL 1, ; GET THE OLD PROCESS HANDLE
HRR 1 ; SAVE THE JFN
GET ; STUFF THE INFERIOR FORK
HLR 1, ; SELECT EXEC FORK
SETZ 2, ; FIRST LOCATION IN ENTRY VECTOR
SFRKV ; START FORK THERE
WFORK ; WAIT FOR IT TO BE DONE
KFORK ; KILL THE BLASTED THING
MOVE 1, ; GET THE JFN WE USED
RLJFN ; AND FREE IT UP
JFCL ; LOSEY
RET] ; NOW RETURN
ERROR [ASCIZ/IEC Invalid E command/]
GOCCL: CALL UNLOAD ; dump out file first
TLZ FF,UREAD+UWRITE+FINF;IN CASE REENTER HAPPENS
MOVEI 1,7.
DTI ;turn off bell
SKIPN TENEXP
JRST [ MOVE 1,[.PRAST,,.FHSLF]
MOVEI 2,[1 ? 400740,,2 ? 0]
MOVEI 3,3
PRARG ; magically tells Twenex EXEC to CCL
HALTF
JRST .-1]
MOVE 1,[1,,['SYS,, ? 'CCL,, ? 0 ? 0 ? 0 ? 0]]
047040,,35 ; 10/50 "RUN" UUO
ERROR [ASCIZ/CNA CCL not available/]
DINISH: SETOM DUNFLG ;Almost like finish
CAIA
FINISH: SETZM DUNFLG
CALL BFSAVE
JRST SEMI.H
; ;S SAME AS ;U BUT DOES NOT CLEAR BUFFER
BFSAVE: SETOM SAVFLG ;SUPPRESS BUFFER CLEARING
JRST UNLD0
; ;D DATE AND UNLOAD
DNLOAD: SETOM DUNFLG ;SAY ;D MODE
SKIPA
; ;U UNLOAD AND CLEAR BUFFER
UNLOAD: SETZM DUNFLG ;SAY ;U MODE
SETZM SAVFLG ;PERMIT CLEARING BUFFER AFTER UNLOAD
UNLD0: TRNE FF,ARG+ARG2 ;ARGUMENT?
ERROR [ASCIZ/ANE Argument given when none expected/]
TLNN FF,UWRITE ;FILE OPEN?
CALL UNLD1 ;NO, GO OPEN ONE
MOVSI B,1 ;A LARGE NUMBER OF PAGES
TRO FF,ARG ;MAKE BELIEVE IT WAS TYPED IN
CALL PUNCH ;PUNCH THOSE PAGES
CALL CLOSEF ;CLOSE AND RENAME FILES
RET
UNLD2: JSP A,CONMES
ASCIZ / ?
/
UNLD1: JSP A,CONMES
ASCIZ /Output file: /
MOVSI 1,(1_35.+1_32.+1_31.) ;OUTPUT+PRNT O/N+CONFIRM
MOVEM 1,OJTB ;GOES IN FIRST WORD OF JFN TABLE
MOVE 1,[100,,101] ;FROM/TO PRIMARY IO
MOVEM 1,OJTB+1 ;SECOND WORD
MOVEI 1,OJTB ;ASSUME OTHERS CORRECT
SETZ 2,
GTJFN
JRST UNLD2
SETZM ABORTF
JRST OPNOUT ;OPEN FILE AND RETURN
U SAVFLG,1 ;0 FOR ;D/;U, -1 FOR ;S
U DUNFLG,1 ; ;D/;U FLAG
U OJTB,11 ;JFN TABLE
U DEFNAM,20 ;DEFAULT FILE NAME AND EXTENSION
;LOAD ENTIRE FILE COMMAND - ;Y
YLOAD: TRNE FF,ARG+ARG2
ERROR [ASCIZ/ANE Argument given when none expected/]
TLNN FF,UREAD ;FILE OPEN?
CALL YLD1 ;NO, GO OPEN ONE
SETZM YCRCNT ;COUNT UP UNMATCHED CR'S AND PRINT BELOW
YLD3: MOVE OU,Z ;APPEND A PAGE
MOVE CH,FBIN
CAIN CH,FBIN1 ;PMAP-ABLE INPUT FILE?
SKIPE EOLF ;AND BUFFER CAN HAVE CRLF'S IN IT?
JRST YLD32 ;NO OR NO.
YLD31: CALL PMAP.Y ;PMAP ALL PAGES INTO THE BUFFER
JRST YLD33
YLD32: CALL YANK2 ;OLD-STYLE INPUT ROUTINES
YLD33: TRNE FF,FORM ;IF ^L WAS NOT READ (BUFFER FULL OR EOF)
SKIPE ABORTF ;ABORTED?
JRST YLD4 ;YES
TLNE FF,UREAD ;FILE STILL OPEN?
JRST YLD3 ;YES, GET ANOTHER PAGE
YLD4: MOVEI 1,101
MOVE 2,Z ;NUMBER OF CHARS NOW IN BUFFER
SUB 2,BEG
MOVEI 3,10.
NOUT ;PRINT IT
JFCL
JSP A,CONMES
ASCIZ / characters
/
SKIPN 2,YCRCNT
RET
MOVEI 1,101
MOVEI 3,10.
NOUT
JFCL
JSP A,CONMES
ASCIZ / isolated carriage returns
/
RET
YLD2: JSP A,CONMES
ASCIZ / ?
/
YLD1: SKIPL 1,CCLJFN ;IF CCL
JRST OPNIN ;WE ALREADY HAVE THE JFN
JSP A,CONMES
ASCIZ /Input file: /
MOVSI 1,(1_33.+1_31.) ;OLD FILE+CONFIRM
MOVEM 1,OJTB ;TO FIRST WORD OF JFN TABLE
MOVE 1,[100,,101] ;PRIMARY
MOVEM 1,OJTB+1 ;TO SECOND WORD
MOVEI 1,OJTB
SETZ 2,
GTJFN
JRST YLD2
SETZM ABORTF
JRST OPNIN ;OPEN FILE AND RETURN
U YCRCNT,1 ;NUMBER OR CAR RET NOT CONVERTED TO EOL
;ER PREPARE TO READ FILE
OPNRD: TLNE FF,UREAD ;FILE NOW OPEN?
CALL CLSINF ;CLOSE INPUT FILE
CALL FILSPC ;GET FILE SPEC
MOVSI 1,(1_33.+1_18.) ;OLD FILE+SHORT FORM
GTJFN
JRST TYINPT
OPNIN: HRRZM 1,INJFN
MOVE 2,[7_30.+1_16.] ;BYTE SIZE+READ
OPENF
JRST TYNOPN
SETOM CCLJFN ;NO LONGER IN CCL MODE
TLO FF,UREAD ;FILE OPEN
TLZ FF,FINF ;NOT EOF
SETZM SAVFCH ;CLEAR SAVED CHARACTER
MOVE 2,INJFN ;FOR POSSIBLE LATER USE AS DEFAULT
CALL SETDEF
MOVE 1,INJFN
DVCHR
TLNN 2,(1_31.) ;MULT DIR DEVICE?
JRST [ MOVEI 1,FBIN0 ;NO, USE REGULAR BIN
MOVEM 1,FBIN
RET]
MOVE 1,INJFN
MOVE 2,[2,,11]
MOVEI 3,3
GTFDB ;GET BYTE SIZE AND COUNT
LDB 3,[300600,,3] ;GET BYTE SIZE
CAIN 3,7 ;SIZE WE WANT?
JRST OPNT1 ;YES, NO CONVERSIN
MOVEI 2,36 ;NO, MUST CONVERT TO 7-BIT EQUIV
IDIVI 2,0(3) ;GIVES N-BIT BYTES PER WORD
IDIVI 4,0(2) ;GIVES WORDS IN FILE
IMULI 4,5 ;GIVES 7-BIT BYTES IN FILE
OPNT1: MOVEM 4,INBYC ;SETUP BYTE COUNT
SETOM INFPG ;START WITH PAGE 0 AFTER AOS
SETZM IBFRC
MOVEI 1,FBIN1
MOVEM 1,FBIN ;FIRST CALL WILL DO THE REST
RET
;SET UP DEFAULTS
SETDEF: HRROI 1,DEFNAM ;GET COMPLETE NAME OF FILE JUST OPENED
MOVE 3,[001100,,1] ;GIVE FILE NAME AND EXTENSION ONLY
JFNS ;GET THE NAME STRING
MOVE 3,[440700,,DEFNAM] ;POINTER TO BEGINNING OF NAME
MOVEM 3,OJTB+4 ;DEFAULT NAME SLOT IN JFN TABLE
ILDB 1,3 ;SEARCH FOR PERIOD DELIMITING NAME
CAIE 1,".
JUMPN 1,.-2 ;STOP ALSO ON END OF STRING (NULL)
MOVEM 3,OJTB+5 ;POINTER TO BEGINNING OF EXTENSION
SETZ 1,
DPB 1,3 ;PUT 0 AFTER END OF FILE NAME
RET
;TYPE INPUT DEVICE ERROR
TYNOPN: SKIPL 2,CCLJFN ;IF CALLED FROM CCL,
JRST [ SETOM CCLJFN ;NO LONGER IN CCL MODE
POP P,(P) ;BUM THE STACK ONE DOWN (CAN'T USE ADJSP ON KA)
HRROI 1,[ASCIZ/[New file]
/]
PSOUT
JRST SETDEF] ;SET DEFINITIONS AND RETURN
MOVE 1,INJFN ;RELEASE JFN
RLJFN
JFCL
TYINPT: SETOM INJFN
ERROR [ASCIZ/FNF File not found/]
;EA OPEN OUTPUT FILE FOR APPEND
OPNAP: TLNE FF,UWRITE ;FILE OPEN FOR OUTPUT NOW?
CALL CLOSEF ;YES. CLOSE IT
CALL FILSPC ;SET DEFAULT STRING
MOVSI 1,(1_33.+1_32.+1_18.) ;OLD, CONFIRM, SHORT
GTJFN
JRST OUTERR
HRRZM 1,OUTJFN
MOVE 2,[7_30.+1_13.] ;7-BIT, APPEND
OPENF
JRST OUTER1
TLO FF,UWRITE ;SAY WE HAVE AN OUTPUT FILE
JRST OPNOT2 ;SETUP FOR BOUT'S, NOT PMAP'S
;EW SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)
OPNWR: TLNE FF,UWRITE ;OUTPUT FILE NOW OPEN?
CALL CLOSEF ;CLOSE IT
CALL FILSPC
MOVSI 1,(1_35.+1_32.+1_18.) ;WRITE+PRINT OLD/NEW+SHRT
GTJFN
JRST OUTERR
OPNOUT: HRRZM 1,OUTJFN
DVCHR
PUSH P,2 ;SAVE FOR LATER TEST
TLNN 2,(1_31.) ;PMAP-ABLE DEVICE?
SKIPA 2,[7_30.+1_15.] ;NO. OPEN ONLY FOR WRITING
MOVE 2,[7_30.+3_15.] ;YES. BLT AND IDPB NEED READ ACCESS
MOVE 1,OUTJFN
OPENF
JRST OUTER1
TLO FF,UWRITE ;SAY WE HAVE OUTPUT FILE OPEN
POP P,2 ;GET BACK DEVICE CHARACTERISTICS
TLNN 2,(1_31.) ;MULT DIR DEVICE?
OPNOT2: JRST [ MOVE 1,OUTJFN
SKIPE DUNFLG ;NO, USE REGULAR BOUT
CALL HEDING ;MAKE ;D HEADING
MOVEI 1,FBOUT0
MOVEM 1,FBOUT ;USE REGULAR BOUT
RET]
SETZM OBFRC ;YES, SETUP FOR PMAP
SETOM OUFPG
MOVNI 1,5*1000 ;1 BUFFERLOAD OF CHARS
MOVEM 1,OUBYC ;WILL BE SET TO 0 ON FIRST CALL
MOVEI 1,FBOUT1
MOVEM 1,FBOUT
SKIPL DUNFLG ; ;D COMMAND?
RET ;NO
CALL FBO1 ;MAKE 1ST FILE PAGE
MOVE 1,OBFRP ;PTR
CALL HEDING ;HEADING TO CORE
MOVEM 1,OBFRP ;UPDATED PTR
MOVE 1,[440700,,OBFPGA] ;INITIAL PTR
OPNOT3: CAMN 1,OBFRP
RET
SOS OBFRC ;SPACES LEFT
IBP 1
JRST OPNOT3
;THIS ROUTINE INSERTS THE ;D HEADING IN THE OUTPUT BUFFER
HEDING: CALL HEDCOM ;PUT OUT THE COMMENT CHARACTER(S)
HRRZ 2,OUTJFN
MOVE 3,[1_30.+1_27.+1_24.+1_21.+1_0.]
JFNS
MOVEI 2,<" >
MOVEI 3,4
BOUT
SOJG 3,.-1
SETO 2,
SETZ 3,
ODTIM
HRROI 2,[ASCIZ / TECO'd by /]
SOUT
PUSH P,1 ;SAVE STRING POINTER
GJINF
MOVE 2,1
POP P,1
DIRST
JFCL
MOVEI 2,^M
BOUT
MOVEI 2,^J
BOUT
RET
OUTER1: MOVE 1,OUTJFN
RLJFN ;RELEASE JFN
JFCL
OUTERR: SETOM OUTJFN
ERROR [ASCIZ/OUT File output failure/]
;OUTPUT THE COMMENT CHARACTER(S) FOR THE HEADING
HEDCOM: LDB 2,[350700,,COMBUF] ;IS THERE A ^D...$ DEFAULT?
JUMPN 2,[ HRROI 2,COMBUF
SETZ 3,
SOUT ;OUTPUT THE DEFAULT
RET]
PUSH P,1
SETOM EXTEN ;INCASE NO EXTENTION
HRROI 1,EXTEN
MOVE 2,OUTJFN
MOVSI 3,(1_24.) ;EXT ONLY
JFNS
HEDCO1: MOVSI 3,-EXTL
HEDCO2: MOVSI 2,440700
HLR 2,EXTTAB(3)
MOVE 1,[440700,,EXTEN]
CALL STRCOM
JRST [ AOBJN 3,HEDCO2 ;NOT EQUAL, TRY NEXT
MOVEI 2,"; ;USE ; IF NOTHING ELSE
POP P,1
BOUT
RET]
HRRO 2,EXTTAB(3)
SETZ 3,
POP P,1
SOUT
RET
;STRING COMPARE
STRCOM: PUSH P,1
PUSH P,2
STRCO1: ILDB 1,-1(P)
ILDB 2,0(P)
CAME 1,2
JRST STRCO2
JUMPN 1,STRCO1 ;HAVEN'T HIT NULL AT END
AOS -2(P) ;SKIP RETURN
STRCO2: SUB P,[2,,2] ;FLUSH ARGS
RET
DEFINE ETAB TRANS,COMCHR
[ASCIZ \TRANS\],,[ASCIZ \COMCHR\]
TERMIN
EXTTAB: ETAB MAC,[;]
ETAB MID,[;]
ETAB FAI,[;]
ETAB PAL,[/]
ETAB BCP,[//]
ETAB B11,[//]
ETAB F4,[C ]
ETAB F40,[C ]
ETAB FOR,[C ]
ETAB F10,[C ]
ETAB STG,[C ]
ETAB P11,[;]
ETAB BLI,[!]
ETAB PPL,[... ]
ETAB HEADBCP,[//]
ETAB CBL,[*]
ETAB COB,[*]
ETAB LO,[.* ]
ETAB RNO,[.!]
ETAB RNB,[.!]
ETAB RNC,[.!]
ETAB RND,[.!]
ETAB RNE,[.!]
ETAB RNH,[.!]
ETAB RNL,[.!]
ETAB RNM,[.!]
ETAB RNP,[.!]
ETAB RNS,[.!]
ETAB CMD,[!]
ETAB CTL,[!]
EXTL==.-EXTTAB
U EXTEN,10 ;EXTENSION BUFFER
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
CLOSEF: TLZN FF,UWRITE
RET
MOVE 1,FBOUT
CAIE 1,FBOUT1 ;PMAP CASE?
JRST CLOS2 ;NO
SETO 1, ;YES, CLEAR OUT LAST PAGE
MOVE 2,[400000,,OBFPG]
PMAP
MOVE 1,OUTJFN
HRLI 1,11
MOVSI 2,(77_24.) ;SET FILE BYTE SIZE TO 7
MOVSI 3,(7_24.) ;SEVEN COME ELEVEN ...
CHFDB
HRLI 1,12
SETO 2,
MOVE 3,OUBYC ;SET FILE BYTE COUNT
ADDI 3,5000 ;LAST BUFFER CONTAINS 5000-OBFRC CHARS
SUB 3,OBFRC
CHFDB
CLOS2: MOVE 1,OUTJFN
CLOSF
JFCL
SETOM OUTJFN
RET
;CLOSE INPUT FILE
CLSINF: PUSH P,1
PUSH P,2
TLZN FF,UREAD
JRST CLSINX
SETO 1,
MOVE 2,[400000,,IBFPG]
PMAP ;UNMAP LAST PAGE IF ANY
MOVE 1,INJFN
CLOSF
JFCL
SETOM INJFN
CLSINX: POP P,2
POP P,1
RET
U INJFN,1
U OUTJFN,1
;GATHER FILE NAME
FILSPC: MOVEI 1,NFILNM*5-2 ;LENGTH OF FILENAME BUFFER
MOVE B,[440700,,FILNAM]
FILS2: CALL SKRCH
CAIN CH,^[ ;ALTMODE?
JRST FILS1 ;YES, END OF NAME
IDPB CH,B ;PUT IN STRING FOR GTJFN
SOJG 1,FILS2 ;GET ANOTHER IF NOT FULL
ERROR [ASCIZ/FTL File name too long/]
FILS1: SETZ CH, ;DEPOSIT NULL BYTE TO MARK END OF STRING
IDPB CH,B
MOVE 2,[440700,,FILNAM]
RET
U FILNAM,NFILNM
;Y RENDER THE BUFFER EMPTY. READ INTO THE BUFFER UNTIL
; (A) A FORM FEED CHARACTER IS READ, OR
; (B) THE BUFFER IS WITHIN ONE THIRTY-SECOND
; OF CAPACITY AND A LINE FEED IS READ, OR
; (C) AN END OF FILE IS READ, OR
; (D) THE BUFFER IS 63/64 FULL.
;THE FORM FEED (IF PRESENT) DOES ENTER THE BUFFER.
YANK: SKIPE ABORTF ;ABORT REQUEST?
RET ;YES, DON'T CLOBBER BUFFER
TLNN FF,UREAD ;IS THERE AN OPEN INPUT FILE?
ERROR [ASCIZ/NFI No file for input/]
MOVE OU,BEG
MOVEM OU,PT
CALL YANK2
RET
;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.
CALL YANK2
JRST CRET
YANK2: TRZ FF,FORM ;RESET THE YANK,APPEND FORM FEED FLAG
YANK3: TLNN FF,UREAD ;HAS AN INPUT FILE BEEN SPECIFIED?
ERROR [ASCIZ/NFI No file for input/]
SETZ CH,
EXCH CH,SAVFCH ;GET SAVED CHARACTER, IF ANY
SKIPN CH
CALL @FBIN
JUMPE CH,YANK3 ;FLUSH NULLS
SKIPE EOLF ;BUFFER IS SUPPOSED TO HAVE EOLS
CAIE CH,^M ;AND WE HAVE A CR?
CAIA
JRST YANCR ;YES, CONVERT TO EOL
YANCR2: CALL PUTCHR ;NO. PUT CHARACTER IN DATA BUFFER.
ADDI OU,1
CAMGE OU,[760000*5] ;ALMOST(31/32) FULL?
JRST YANK4 ;IF NOT FULL YET
CAMGE OU,[770000*5] ;63/64 FULL?
CAIN CH,EOL ; OR EOL JUST READ?
JRST YANK51 ;QUIT EARLY.
YANK4: SKIPE ABORTF ;ABORT REQUEST?
JRST YANK51 ;YES, QUIT WITH WHAT WE HAVE
CAIE CH,^L ;FORM FEED?
JRST YANK3
TRO FF,FORM ;Y OR A TERMINATED ON FORM FEED
YANK51: MOVEM OU,Z ;YES. SET END OF DATA BUFFER AND RETURN
RET
YANCR: CALL @FBIN ;GET FOLLOWING CHARACTER
CAIE CH,^J ;LINE FEED?
JRST [ MOVEM CH,SAVFCH ;NO, SAVE IT
MOVEI CH,^M ;AND USE REAL CR
AOS YCRCNT ;COUNT THIS CASE
JRST YANCR2]
MOVEI CH,EOL ;USE EOL
JRST YANCR2
U SAVFCH,1
YANK59: SUB P,[1,,1] ;FLUSH LOCAL RETURN
TLO FF,FINF ;SAY WE ARE AT EOF
CALL CLSINF ;CLOSE IT
JRST YANK51 ;END INPUT
FBIN0: PUSH P,1
MOVE 1,INJFN ;REGULAR BIN CASE
MOVE CH,2
FBIN2: BIN
JUMPE 2,[ GTSTS ;POSSIBLE EOF
TLNN 2,(1_27.)
JRST FBIN2 ;NULL, TRY AGAIN
EXCH CH,2
POP P,1
JRST YANK59]
EXCH CH,2
POP P,1
RET
FBI1: SKIPG INBYC ;EOF?
JRST YANK59 ;YES, EXIT FROM YANK
MOVEI TT,5*IBFPG*1000 ;WHERE TO MAP PAGE
CALL MAPIN ;SETUP IBFRP, IBFRC, ETC.
FBIN1: SOSGE IBFRC ;FAST CASE, ANY CHARS LEFT?
JRST FBI1 ;NO, GO REFILL PAGE
ILDB CH,IBFRP
RET
;MAP IN A FILE PAGE
; TT HAS CHARACTER ADDRESS OF WHERE TO PUT IT
; INFPG HAS LAST PAGE NUMBER MAPPED
; SETS UP IBFRP AND IBFRC. ADJUSTS INBYC AND INFPG.
MAPIN: PUSH P,TT ;SAVE ARG
PUSH P,1
PUSH P,2
PUSH P,3
AOS 1,INFPG ;NO, MAP IN NEXT PAGE OF FILE
HRL 1,INJFN
MOVSI 2,400000 ;THIS FORK
IDIVI TT,5*1000 ;GET PAGE NUMBER
HRRI 2,0(TT)
MOVSI 3,(1_33.\1_26.) ;READ, COPY ON WRITE
PMAP
LSH 2,9
MOVES 0(2) ;MAKE PAGE PRIVATE
HRLI 2,440700
MOVEM 2,IBFRP ;FRESH BUFFER POINTER
MOVEI 1,5*1000 ;NO. CHARS IN BFR
CAML 1,INBYC ;FULL BUFFER LEFT IN FILE?
MOVE 1,INBYC ;NO, USE ONLY WHATS LEFT
MOVEM 1,IBFRC ;SETUP COUNT FOR THIS BUFFER
MOVN 1,1
ADDM 1,INBYC ;REDUCE REMAINDER IN FILE
POP P,3
POP P,2
POP P,1
POP P,TT
RET
U IBFRC,1 ;NO. CHARS IN BUFFER
U IBFRP,1 ;BYTE PTR TO BUFFER
U INBYC,1 ;REMAINING BYTES IN FILE
U INFPG,1 ;PAGE NUMBER IN FILE
U FBIN,1 ;DISPATCH ADDRESS
;PMAPPED YANK
; FOR EACH PAGE THE BUFFER IS MOVED UP TO THE NEXT PAGE BOUNDARY,
; THE FILE MAPPED IN, AND EXTRANEOUS NULLS REMOVED.
PMAP.Y: SETZM GCDONE ;SENSE GC'S
PMAPY1: SKIPG INBYC ;ANYTHING LEFT IN FILE?
JRST PMAPY9 ;NO. GET OUT.
PMAY11: SKIPE ABORTF
JRST PMAPY4
MOVE C,Z ;CURRENT END OF BUFFER
ADDI C,4777 ;SET TO ROUND TO PAGE BOUNDARY
IDIVI C,5000
CAILE C,776 ;ROOM TO MAP A PAGE AND DO EDITTING?
JRST PMAPY8 ;NO. LEAVE WITH FILE OPEN
IMULI C,5*1000 ;1ST CHR ADDR IN NEXT PAGE
SUB C,Z ;AMOUNT OF MOVE NEEDED
JUMPLE C,PMAPY3 ;IT'S ALREADY OK.
PMAPY2: CALL MOVBUF ;MOVE BUFFER UP C CHRS
JRST PMAY11 ;MAKE SURE GC DID NOT CHANGE Z
PMAPY3: MOVE TT,Z ;WHERE TO MAP IN THE PAGE
CALL MAPIN ;DO IT
SETZ TT,
EXCH TT,IBFRC ;ABSORB ALL THE CURRENT PAGE
ADDM TT,Z ;Z NOW INCLUDES NEW (PARTIAL) PAGE
CALL NULFLS ;FLUSH DEC PADDING NULLS
PMAPY4: MOVE I,Z
SUBI I,1 ;SET TO GET LAST CHARACTER IN BUFFER
CALL GETCHR
CAIE CH,^L ;BUFFER ENDS WITH FORMFEED?
TRZA FF,FORM ;NO
TRO FF,FORM ;YES
SKIPE ABORTF
JRST PMAY95
JRST PMAPY1 ;GET MORE FROM FILE
PMAPY8: SKIPE GCDONE ;HAS A GC BEEN CAUSED?
JRST PMAY95 ;OH WELL. FILE IS STILL OPEN.
SETZB C,GCCNT ;CAUSE A GC
CALL NROOM ;FAKE CALL TO PICK IT UP
JRST PMAPY1
PMAPY9: TLO FF,FINF ;EOF STOPPED THE INPUT
CALL CLSINF ;CLOSE THE INPUT FILE
PMAY95: MOVN A,BEG ;BE SURE BUFFER BEGINS ON WORD BOUNDARY
IDIVI A,5
MOVEI C,5(A+1)
SKIPE A+1
CALL MOVBUF
RET
;SUBR FOR ABOVE
MOVBUF: PUSH P,PT ;SAVE "." IN UNMOVED BUFFER
MOVE A,BEG ;SET TO MAKE SPACE AT BEGINNING
MOVEM A,PT
CALL NROOM
POP P,PT ;RESTORE "."
ADDM C,PT ;MOVE IT
ADDM C,BEG ;AND CUT OFF THE HOLE
SOS GCCNT ;THAT MADE SOME GARBAGE
RET
;NULL FLUSHER ROUTINE
; USES: IBFRP AS SETUP BY MAPIN, Z INCLUDING ALL OR PART OF NEW PAGE
; RETS: NEW UPDATED Z
NULFLS: PUSH P,PT
PUSH P,IBFRP ;WHERE TO BEGIN NEXT WORD SCAN
NULFL1: MOVE TT,Z
IDIVI TT,5 ;WORD CONTAINING LAST CHARACTER
HRRZ I,0(P) ;WHERE THIS SCAN SHOULD START
SUB I,TT ;NEGATIVE NUMBER OF WORDS LEFT
SKIPL I ;HAVE SOME WORDS TO DO?
MOVE I,TT ;NO. ADJUST I
JUMPGE I,NULFL3 ;GO DO PARTIAL WORD AT END
NULFL2: HRLZS I
HRR I,0(P) ;FORM AOBJN PTR TO REST OF BUFFER
CALL NULSRC ;POINT I AT WORD CONTAINING A NULL
HRRZM I,0(P) ;WHERE TO RESUME NEXT TIME
NULFL3: HRRZS A,I
HRLI A,440700 ;BYTE POINTER TO WORD WITH NULL
IMULI I,5 ;CORRESPONDING CHR ADDR
NULF33: CAML I,Z ;OFF THE END OF THE BUFFER?
JRST NULFLX ;YES. DONE.
ILDB CH,A
SKIPE CH ;NULL?
AOJA I,NULF33 ;NO. KEEP LOOKING
NULFL4: MOVEM I,PT ;SAVE WHERE THE NULL WAS FOUND FOR NROOM
ADDI I,1 ;UPDATE TO MATCH A
MOVNI C,1 ;NEG NUMBER OF NULLS SEEN SO FAR
NULF41: CAML I,Z ;STILL IN BUFFER?
JRST NULFL5 ;NO. CHOP NULLS AND GET OUT EVENTUALLY
ILDB CH,A
ADDI I,1
SKIPN CH ;IS THIS A NULL TOO?
SOJA C,NULF41 ;YES. KEEP LOOKING
NULFL5: CALL NROOM ;FLUSH NULLS. UPDATE Z
JRST NULFL1 ;AND LOOK FOR NEXT BLOCK OF THEM.
NULFLX: SUB P,[1,,1]
POP P,PT
RET
;SUBR TO SEARCH FOR A WORD CONTAINING ONE OR MORE NULLS.
;USES I CONTAING AOBJN PTR TO AREA TO SEARCH. RETURNS I UPDATED
NULSRC: JFCL 4,.+1
MOVE C,[.BYTE 7 ?001?001?001?001?001]
NULSR1: SETCM A,0(I)
ADD A,C
XOR A,0(I)
JFCL 4,NULSRX
TDNN A,C
AOBJN I,NULSR1
NULSRX: 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: CALL TAB2 ;INSERT TAB
;ITEXT$ INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
; THE IN 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 C,0 ;COUNT # CHARACTERS TO INSERT IN C
;ENTER HERE FROM REPLACE -- C MAY HAVE NEG. NUM. (DELETION)
RPINS: SKIPE ABORTF ;ABORT REQUEST?
RET ;YES, DON'T START INSERT
MOVE A,S.TERM ;TERMINATOR SET IN REPLACE
TRNE FF,RPLFG
JRST RPINS1 ;USE TERM FROM REPLACE
MOVEI CH,^[ ;USE ALTMODE FOR TERM. UNLESS @I
TRZE FF,SLSL ;DID @ PRECEED I?
CALL SKRCH ;GET TERMINATOR FROM COMMAND STRING
MOVEM CH,A ;SAVE TERMINATOR
;EITHER ALT-MODE OR USER CHOICE.
RPINS1: PUSH P,COMAX
PUSH P,CPTR ;SAVE CURRENT POSITION OF CPTR.
PUSH P,COMCNT
CALL SKRCH ;GET NEXT CHARACTER
CAME CH,A ;IS IT THE TERMINATOR?
AOJA C,.-2 ;NO. TRY AGAIN.
SKIPE C ;SKIP IF NO ROOM NEEDED
CALL NROOM ;MOVE FROM PT THROUGH Z UP C POSITIONS.
MOVE B,-1(P) ;RETRIEVE INPUT POINTER
SUB P,[3,,3]
;MOVE INSERTION INTO DATA BUFFER
INS1B: MOVE OU,PT
INS1C: ILDB CH,B ;CHARACTER FROM COMMAND STRING.
CAMN CH,A ;IS IT THE TERMINATOR?
RET ;YES. DON'T STORE IT.
CALL PUTCHR ;NO. STORE CHAR IN BUFFER
AOS OU,PT
JRST INS1C
; ;G INSERT LAST COMMAND STRING (OF >15 CHARS) INTO BUFFER
GETOB: HLRZ C,LSTCB ;NUMBER OF CHARS
JUMPE C,CRET ;NO SAVED STRING
CALL NROOM
MOVE A,[440700,,CBUF]
GETOB1: MOVE OU,PT
ILDB CH,A
CALL PUTCHR
AOS PT
SOJG C,GETOB1
JRST CRET
;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: MOVE CH,NUM
TDNE CH,[-1,,777600] ;STRAY BITS?
ERROR [ASCIZ/NAC Not an ASCII character/]
;INSERT CH IN DATA BUFFER AT PT
TAB2: MOVEI C,1 ;MOVE FROM PT THROUGH Z UP 1 POSITION.
CALL NROOM
AOS OU,PT
SOJA OU,PUTCHR ;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 ;SAY @ SEEN
JRST CD5
;N\ INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
; EQUAL TO N.
BAKSL1: MOVE T,[700,,BAKTAB-1]
MOVEI C,0 ;COUNT # DIGITS IN C.
CALL DPT ;CONVERT C(B) TO ASCII, STORE IN BAKTAB.
MOVEI A,141 ;MARK END OF STRING
IDPB A,T
CALL NROOM ;MOVE FROM PT THROUGH Z UP C POSITIONS.
MOVE B,[700,,BAKTAB-1]
CALL INS1B ;INSERT STRING INTO DATA BUFFER AT PT.
JRST CRET
;ROUTINE TO OUTPUT DECIMAL INTEGER
;CALL MOVE B, DECIMAL INTEGER
; CALL DPT
; RETURN
DPT: JUMPGE B,DPT1 ;NUMBER > 0?
MOVEI CH,"- ;NO. OUTPUT -
IDPB CH,T ; save - in buffer
ADDI C,1 ; and advance pointer
DPT1: MOVMS B ;B:=ABSOLUTE VALUE OF B
IDIVI B,10. ;E:=DIGIT
HRLM E,(P) ;PUT DIGIT ON LEFT HALF OF TOP OF PDL
JUMPE B,.+2 ;DONE?
CALL .-3 ;NO.
HLRZ CH,(P) ;YES. CH:=DIGIT
ADDI CH,60 ;CONVERT IT TO ASCII.
IDPB CH,T ; save digit in buffer
ADDI C,1 ; save digit in buffer
RET ; and return
;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: MOVEI D,TYO ;ADDRESS OF OUTPUT ROUTINE.
TYPE0: CALL GETARG ;C:=FIRST STRING ARGUMENT ADDRESS.
;B:=SECOND STRING ARGUMENT ADDRESS.
TYPE1: CALL 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 CPOPJ
MOVE TT,I ;NO. GET NEXT CHAR
IDIVI TT,5 ;THIS IS A COPY OF GETINC
LDB CH,BTAB(TT1) ;COPIED TO SPEED IT UP
ADDI I,1
CAIN CH,^H
CAIE D,TYO
CAIA
JRST [ HRROI 1,[ASCIZ/^H/]
PSOUT
JRST .+2]
CALL (D) ;OUTPUT IT
SKIPLE ESFLAG ; ES flag set?
JRST [ CAIN D,TYO ; typing?
CAME I,PT ; I = . ?
JRST .+1 ; no, flush this
REPEAT 2,PUSH P,1+.RPCNT
MOVEI 1,101 ; primary output JFN
RFMOD ; get terminal mode
PUSH P,2
ANDCMI 2,300 ; enter binary mode
SFMOD ; hack the mode
MOVEI 1,^J ; output a line feed
PBOUT
MOVEI 1,101
POP P,2
SFMOD
REPEAT 2,POP P,2-.RPCNT
JRST .+1]
SKIPN ABORTF ;ABORT REQUEST?
JRST TYPE3 ;LOOP
CAIN D,TYO ;YES, DOING TTY OUTPUT?
JRST TYOQT ;YES, QUIT
RET ;NO, STOP BUT JUST RETURN
; V -- View lines surrounding "."
; V types the current line (0tt)
;nV types n-1 lines before "." , the current line, and the n-1 following
;m,nV types m before (including the current line), and n-1 after
VIEW: TRNN FF,ARG ; n specified?
MOVEI B,1 ;No. Default to 1
TRNN FF,ARG2 ; m,n ??
MOVE C,B ;No, default to same as first arg
JUMPL B,VIEWX ;NEG. NOT ALLOWED
JUMPL C,VIEWX ;NEG. NOT ALLOWED
MOVE I,PT ;Start at "."
VIEW1: CAMN I,Z ;At end of buffer?
JRST VIEW2 ;Yes
CALL GETINC ;Get next chr, increment i
CALL EOLP ;END OF LINE IN CURRENT FORMAT?
JRST VIEW1 ;No, keep looking
SOJG B,VIEW1 ;Yes, count it
VIEW2: MOVE B,I ;Save end point of view
MOVE I,PT ;Start at "." again
VIEW3: SOS I ;Back up
CAMGE I,BEG ;At beginning of buffer?
JRST VIEW4 ;Yes
CALL GETINC ;Load CH and bump I
CALL EOLP ;END OF LINE?
SOJA I,VIEW3 ;No. Unbump I and look at previous chr
SOJG C,.-1 ;Yes. Count this line.
VIEW4: MOVE C,I ;Save start of view
CAMGE C,BEG ;Tried to back off beginning?
MOVE C,BEG ;Yes, default to beginning
MOVEI D,TYO ;Select TTY:
JRST TYPE1
VIEWX: ERROR [ASCIZ/MVS Meaningless viewspecs/]
PPA: TLNN FF,UWRITE ;OUTPUT FILE OPEN?
ERROR [ASCIZ/NFO No file for output/]
TRZE FF,RUBCF ;RUBOUT PRECEEDED?
JRST PPA1 ;YES, OUTPUT THIS CHAR LITERALLY
CAIN CH,177 ;THIS A RUBOUT?
TRO FF,RUBCF ;YES, REMEMBER FOR NEXT CHAR
SKIPE EOLF ;BUFFER HAS 037 MEANING EOL?
CAIE CH,EOL ;AND HAVE A TENEX EOL?
PPA1: JRST @FBOUT ;NO, SEND DIRECTLY
PPAEOL: MOVEI CH,^M ;CONVERT TENEX EOL TO CRLF
CALL @FBOUT
MOVEI CH,^J
CALL @FBOUT
MOVEI CH,EOL
RET
FBOUT0: PUSH P,1 ;REGULAR BOUT CASE
MOVE 1,OUTJFN
EXCH CH,2
BOUT
EXCH CH,2
POP P,1
RET
FBOU1A: CALL FBO1
FBOUT1: SOSGE OBFRC ;FAST CASE, CHAR LEFT?
JRST FBOU1A ;NO, REFILL BUFFER PAGE
IDPB CH,OBFRP
RET
FBO1: PUSH P,1
PUSH P,2
PUSH P,3
AOS 1,OUFPG ;MAP NEXT FILE PAGE
HRL 1,OUTJFN
MOVE 2,[400000,,OBFPG]
MOVSI 3,160000
PMAP
MOVE 1,[OBFPGA,,OBFPGA+1]
SETZM -1(1) ;CLEAR PAGE SO NO GARBAGE AT END
BLT 1,OBFPGA+777
MOVEI 1,5*1000 ;FULL PAGE OF CHARACTERS
MOVEM 1,OBFRC ;ROOM COUNT
ADDM 1,OUBYC ;TOTAL BYTES OUTPUT SO FAR
MOVE 1,[440700,,OBFPGA]
MOVEM 1,OBFRP ;FRESH PTR
POP P,3
POP P,2
POP P,1
RET
U OBFRC,1
U OBFRP,1
U OUBYC,1
U OUFPG,1
U FBOUT,1
;P PUNCH THIS BUFFER, YANK THE NEXT
;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: MOVEI D,PPA ;SELECT PPA FOR OUTPUT.
TRZ FF,RUBCF
TRNE FF,ARG2 ;I,JP?
JRST TYPE0 ;YES. GET STRING ARGUMENTS AND OUTPUT.
TRNN FF,ARG
MOVEI B,1
MOVE E,B ;NO. E:=N
JUMPL E,CPOPJ ;IF N<0, IGNORE P.
PUN1: CALL PUNCHR ;PUNCH OUT BUFFER
SKIPE ABORTF ;ABORT?
RET ;YES, DON'T CLOBBER BUFFER
SKIPE SAVFLG ;0 EXCEPT FOR ;S COMMAND
JRST PUN15
MOVE B,BEG ;MAKE BUFFER EMPTY
MOVEM B,PT
MOVEM B,Z
PUN15: TLNE FF,UREAD
TLNE FF,FINF
RET
PUN2: JUMPE E,CPOPJ
CALL YANK ;RENEW BUFFER
SKIPE ABORTF ;ABORT?
RET ;YES
MOVE C,Z
CAMN C,BEG ;EMPTY BUFFER?
TLNN FF,FINF ;YES. QUIT ON EOF
SOJG E,PUN1 ;NO. E:=E-1. DONE?
CPOPJ: RET
PUNCHR: MOVE C,BEG ;OUTPUT DATA BUFFER.
MOVE B,Z
WRBF2: MOVEI D,PPA
TRZ FF,RUBCF
JRST TYPE1
; ;W - WRITE OUT BUFFER AND DELETE
WRBUF: TRNE FF,ARG\ARG2
JRST WRBF1
CALL PUNCHR
JRST KLBUF
WRBF1: CALL GETARG
CALL WRBF2
JRST KLBUF
; R - REPLACE ... BY ...
REPLAC: CALL CHK2
TRO FF,RPLFG
TRZ FF,ARG+ARG2 ;SO AS NOT TO CONFUSE S K AND I
JUMPE B,RPLC5 ;REPETITION COUNT=0, VERY SPECIAL
RPLC3: PUSH P,COMAX ;NEEDED BY GC
PUSH P,CPTR
PUSH P,COMCNT
SKIPE ABORTF ;ABORT?
JRST RPLC4 ;YES, STOP
PUSH P,B ;SAVE ITERATION COUNT
MOVEI B,1 ;WANT 1ST OCCURENCE
SKIPGE 0(P) ;REVERSE REPLACE?
MOVNS B ;YES, SEARCH BACKWARDS
CALL SERCH ;SEARCH AND ADVANCE PT
MOVNI C,0(F) ;GET - NUM OF CHRS IN SEARCH STRING
ADDM C,PT ;BACKUP PT TO BEG OF SEARCH STRING
CALL RPINS
POP P,B ;GET BACK ITERATION COUNT
SKIPL B ;COUNT IT TOWARS 0
SOSA B
AOS B
JUMPE B,RPLC4 ;DONE
POP P,COMCNT ;MORE TO DO, RESTORE COMMAND STRING
POP P,CPTR
POP P,COMAX
JRST RPLC3
RPLC4: SUB P,[3,,3] ;FLUSH JUNK
TRZ FF,RPLFG
JRST CRET
RPLC5: MOVEI CH,^[ ;ALT MODE
TRZE FF,SLSL ;@ SEEN?
CALL SKRCH ;YES, READ THE TERMINATOR
MOVE CH,S.TERM ;SAVE IN GOOD PLACE
CALL SKRCH ;LOOK FOR END OF SEARCH STRING
CAME CH,S.TERM
JRST .-2
CALL SKRCH ;LOOK FOR END OF REPLACEMENT
CAME CH,S.TERM
JRST .-2
TRZ FF,RPLFG
JRST CRET
;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
;NC SAME AS .+NJ. NOTE THAT N MAY BE NEGATIVE.
CHARAC: CALL 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: CALL CHK ;IS C(B) WITHIN DATA BUFFER?
MOVEM B,PT ;YES. PT:=C(B)
JRST CRET
;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 [ASCIZ/TMA Too many arguments/]
CALL GETARG ;NO. C:=FIRST STRING ARGUMENT ADDRESS,
;B:=SECOND STRING ARGUMENT ADDRESS.
XOR B,C
XORM B,PT
JRST CRET
;ROUTINE TO RETURN CURRENT ARGUMENT IN B
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR
;IF THERE IS NO CURRENT ARGUMENT
;CALL CALL CHK2
; RETURN WITH B:=CURRENT ARG.,+1 OR -1
CHK2: TROE FF,ARG ;IS THERE AN ARGUMENT?
RET ;YES. IT'S ALREADY IN B.
;NO
CHK22: LDB B,[340200,,DLIM] ;B:=1 WITH SIGN OF LAST OPERATOR.
MOVNS B
AOJA B,CPOPJ
;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: CALL GETARG ;C:=FIRST STRING ARG. ADDRESS
;B:=SECOND STRING ARG. ADDRESS
CALL CHK1 ;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
KLBUF: MOVEM C,PT ;PT:=C(C)
SUB B,C ;B:=NO. OF CHARACTERS TO KILL.
JUMPE B,DEL2 ;NONE
JRST KLB1
KLBUF1: TRO FF,RPLFG
CALL KLBUF
TRZ FF,RPLFG
RET
;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: TRNE FF,ARG2
ERROR [ASCIZ/TMA Too many arguments/]
CALL CHK2 ;MAKE SURE B CONTAINS AN ARGUMENT
KLB1: SKIPE ABORTF ;ABORT?
JRST DEL2 ;YES
MOVM C,B
MOVNS C ;C:=-ABS(B)
ADD B,PT ;B:=PT+B
CALL CHK ;STILL IN DATA BUFFER?
CAMGE B,PT ;YES. IS N NEGATIVE?
MOVEM B,PT ;YES. MOVE PT BACK FOR DELETION.
CALL NROOM ;MOVE FROM PT+ABS(C) THROUGH Z
;DOWN ABS(C) POSITIONS
DEL2: TRNE FF,RPLFG
RET
JRST CRET
;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL MOVE B,POINTER
; CALL CHK
; RETURN IF B LIES BETWEEN BEG AND Z
CHK: CAMG B,Z
CAMGE B,BEG
ERROR [ASCIZ/NIB Addressing character not in the buffer/]
RET
;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
; CALL 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 [ASCIZ/ITP Invalid text pointer/]
RET ;NO
U ESFLAG,1
U ESTYPE,1
LARR: TROA FF,FINDR ;SAY LEFT ARROW SEARCH
SERCHP: TRO FF,PCHFLG ;SAY N SEARCH
TRNE FF,ARG
JUMPL B,[ERROR [ASCIZ/BSI Backward N and _ searches illegal/]]
SERCH: TRNE FF,ARG2 ;2 ARGS?
ERROR [ASCIZ/TMA Too many arguments/]
TRON FF,ARG ;WAS THERE AN ARG?
CALL CHK22 ;DEFAULT TO + OR - ONE
SKIPN ESFLAG ; in ES mode?
JRST .+3
TRNN FF,COLONF+ITERF ; never if in a colon search
SETOM ESTYPE ; ES and normal search; remember to V
MOVE E,B
SETZM NUM
PUSH P,PT ;SAVE CURRENT . IN CASE S FAILS
TRNE FF,RPLFG+ITERF+PCHFLG+COLONF+FINDR
JRST SERCHW
MOVE CH,PT ;NOTHING FUNNY GOING ON, ...
JUMPL E,[CAMN CH,BEG
MOVE CH,Z ;RING TO END IF BACKWARD SEARCH FROM BEG
JRST SERCHV]
CAMN CH,Z ;. AT END?
MOVE CH,BEG ;YES, RING TO BEG
SERCHV: MOVEM CH,PT
SERCHW: MOVEI CH,^[ ;USE ALT-MODE DELIMITER IF NO @ SEEN
TRZE FF,SLSL ;@ SEEN?
CALL SKRCH ;YES. CH:=USER SPECIFIED DELIMITER.
MOVEM CH,B ;B:=SEARCH STRING DELIMITER
MOVEM CH,S.TERM ;FOR USE IN INSERT PART OF REPLACE
;SET UP SEARCH TABLE
HRLZI F,STAB-STABP ;F:=-LENGTH OF SEARCH TABLE,,0
SERCH2: CALL SKRCH ;CH:=NEXT COMMAND STRING CHARACTER.
CAIN CH,(B) ;DELIMITER?
JRST SERCH0 ;YES. DONE.
CAIN CH,^X
JRST CNTRX
CAIN CH,^N
JRST CNTRN
CAIN CH,^S
JRST CNTRS
CAIN CH,^Q
CALL SKRCH ;^Q TAKES THE NEXT CHARACTER.
CAIL CH,"A
CAILE CH,"Z
CAIA
JRST SERC21 ;UPPER CASE LETTER.
CAIL CH,"a
CAILE CH,"z
JRST SERC23
SERC21: TLNE FF,CISRCH ;IN CASE INDEPENDENT MODE?
TLOA CH,(CISNE) ;YES. SET OPCODE.
SERC23: HRLI CH,(CAIN CH,)
SERC22: TRZE FF,NOTF ;SEARCH SENSE REVERSED?
TLC CH,4000 ;YES. CH:=CAIE CH,CHARACTER
;CALL CNTRS1, JSR CNTRS1, OR CAIA
MOVEM CH,STAB(F) ;SAVE IN SEARCH TABLE
AOBJN F,SERCH2 ;GET NEXT CHARACTER
ERROR [ASCIZ/STL Search string too long/]
U S.TERM,1
;START SEARCHING
SERCH0: TRNE F,-1 ;ANYTHING IN SEARCH TABLE?
JRST SERC02 ;YES, USE IT
SERC01: MOVE I,0(P) ;OLD "PT" FOR FND
SKIPN F,PREV.F ;"F" FOR DEFAULT
JRST FND ;SEARCH FOR NULL STRING WINS
MOVS B,[STAB,,SVSTAB]
BLT B,STAB+STABL-1
SERC02: MOVEM F,PREV.F ;SETUP DEFAULT TABLE FOR NEXT TIME
MOVE B,[STAB,,SVSTAB]
BLT B,SVSTAB+STABL-1
SERC03: HLRZ B,STAB ;SETUP FAST SEARCH STUFF
CAIE B,(CAIN CH,) ;SINGLE CHR EQ COMPARE?
CAIN B,(CISNE) ;FOR EITHER SEARCH MODE.
TRZA FF,FSRCDF ;YES, ENABLE FAST SEARCH
TRO FF,FSRCDF ;NO, DEFEAT FAST SEARCH
HRRZ AA,STAB ;GET THE CHARACTER
IMUL AA,[<.BYTE 7 ?001?001?001?001?001>_-1] ;SPREAD ACROSS WORD
LSH AA,1
MOVE I,PT ;START SEARCHING AT PT
SERC05: JUMPG E,SERCH1 ;SEARCH BACKWARD?
SUBI I,0(F) ;YES, BACKUP BY LENGTH OF KEY STRING
MOVEM I,PT ;SAVE STARTING POINT FOR SRCH5A
SERCH1: SKIPE ABORTF ;ABORT?
JRST NOFND ;YES, MAKE LIKE NO FIND
JUMPE E,FND0 ;STRING SEEN N TIMES?
MOVEI D,STAB
TRZA FF,NFSRCF ;THIS REQUESTS FAST SEARCH
SERCH3: TRO FF,NFSRCF ;NO FAST SEARCH AFTER FIRST CHR
CAIN D,STAB(F) ;END OF SEARCH TABLE?
JRST FND ;YES.
CAML I,BEG ;NO. BACKED OUT OF BUFFER?
CAML I,Z ;OR REACHED TOP OF BUFFER?
JRST NOFND ;YES.
MOVE TT,I ;NO. CH:=NEXT DATA BUFFER CHARACTER.
IDIVI TT,5 ;THIS IS COPY OF GETINC
JUMPL E,[CAIN TT1,4
JRST SERCH7 ;REV: AT WORD BOUNDARY. TRY FAST MODE
JRST SERCH6]
JUMPE TT1,SERCH7 ;FWD: AT WORD BOUNDARY. TRY FAST MODE
SERCH6: LDB CH,BTAB(TT1)
ADDI I,1
XCT (D) ;SKIP IF NO MATCH ON THIS CHR
SERCH5: AOJA D,SERCH3 ;MATCH FOUND. GO TO NEXT TABLE ENTRY.
SRCH5A: SKIPG E ;SEARCH DIRECTION?
SOSA I,PT ;BACKWARDS
AOS I,PT ;FORWARDS
JRST SERCH1 ;KEEP LOOKING
U PREV.F,1 ;AOBJN PTR FOR SAVED SEARCH TABLE
SERCH7: TRNE FF,FSRCDF\NFSRCF ;FAST SEARCH DEFEATED OR NOT REQUESTED?
JRST SERCH6 ;DO IT SLOW WAY
MOVE B,[.BYTE 7 ?001?001?001?001?001] ;OFTEN-USED LITERAL IN FAST S.
TLNE FF,CISRCH ;IN CASE INDEPENDENT SEARCH MODE?
JRST SERCH8 ;YES. GO USE THAT ROUTINE
SERC70: JFCL 4,.+1
SERC71: MOVE C,AA ;CHR SPREAD ACROSS WORD
MOVE T,0(TT) ;5 CHRS FROM BUFFER
EQVB C,T ;MATCHES BECOME 177'S
ADD C,B ;CARRY INTO BYTE TO LEFT ON MATCH
JFCL 4,SERC79 ;FOUND IN LEFTMOST BYTE CHECK REST
EQV C,T ;CARRY AND ADD 1 LEAVE LOW BITS SAME
TDNE C,B ;HAVE FINDS ELSEWHERE IN THIS WORD?
JRST SERC79 ;GO CHECK MORE CAREFULLY
JUMPL E,SERC76 ;BACKWARD SEARCH
SEAR74: ADDI I,5
CAML I,Z
JRST NOFND
AOJA TT,SERC71 ;TRY NEXT WORD
SERC76: SUBI I,5 ;SETS CRY0
CAMGE I,BEG
JRST NOFND
SOJA TT,SERC70 ;CLEAR CRY0 AND TRY NEXT WORD
SERC79: MOVEM I,PT ;OUTSIDE LOOP FOR SPEED
JRST SERCH6 ;BACK TO SLOW MODE FOR EXACT FIND
;CASE INDEPENDENT WORD-AT-A-TIME SEARCH ROUTINE
SERCH8: MOVE A,AA
XOR A,[.BYTE 7 ?040?040?040?040?040] ;CASE FLIPPED EQUIVALENT
MOVEM TT1,TT1SAV
SERC80: JFCL 4,.+1
SERC81: MOVE C,AA ;COPY OF UNFLIPPED CHRS SPREAD OVER WORD
MOVE OU,A ;COPY OF FLIPPED VERSION
MOVE CH,0(TT) ;WORD FROM BUFFER
MOVE TT1,CH ;ANOTHER COPY TOO
SERC82: EQVB CH,C ;MATCHING BYTES BECOME 177'S
EQVB OU,TT1 ;SAME FOR OTHER CASE
ADD CH,B ;GENERATE CARRIES OUT OF MATCHING BYTES
ADD TT1,B
JFCL 4,SERC89 ;MATCH IN HIGH BYTE, GO GET EXACT FIND
EQV CH,C ;FIND WHICH LOW BITS GOT FLIPPED TWICE
EQV TT1,OU
TDNN CH,B
TDNE TT1,B
JRST SERC89 ;MATCH IN ONE OF THE OTHERS
JUMPL E,SERC86 ;BACKWARD SEARCH. BACKUP A WORD.
SERC84: ADDI I,5 ;ADVANCE TO NEXT WORD IN BUFFER
CAML I,Z
JRST NOFND
AOJA TT,SERC81
SERC86: SUBI I,5 ;SETS CRY0
CAMGE I,BEG
JRST NOFND
SOJA TT,SERC80 ;BACKUP BUFFER POINTER AND LOOK AGAIN
SERC89: MOVEM I,PT ;LEFT BYTE OF WORD CONTAINING A FIND
MOVE TT1,TT1SAV ; restore old TT1
JRST SERCH6 ;DO SLOW, PRECISE COMPARE.
U TT1SAV,1
FND: SETOM SFINDF ;VALUE TESTED BY SEMICOLON-SPACE
MOVEM I,PT ;MOVE PT PAST THE STRING
AOJGE E,FND1 ;BUMP REPEAT COUNT TOWARDS 0
SUBI I,1(F) ;BACK OVER STRING JUST FOUND
MOVEM I,PT
JRST SERCH1
FND1: SUBI E,1 ;COMPENSATE FOR THE AOJ ABOVE
SOJG E,SERC05 ;FOUND IT N TIMES?
FND0: SUB P,[1,,1] ;JUNK (OLD .)
TRNE FF,RPLFG
RET
TRZN FF,COLONF ;YES. COLON MODIFIER?
JRST CRET ;NO. DONE
FFOK: MOVNI A,1 ;YES. RETURN VALUE OF -1
JRST VALRET
NOFND: SETZM SFINDF ;SFINDF:=0
TRNE FF,PCHFLG+FINDR ;S SEARCH?
JRST NOFND1 ;NO.
BEGIN1: POP P,PT ;RETURN TO STARTING POINT
TRZN FF,COLONF ;YES. COLON MODIFIER?
JRST NOFND2 ;NO
BEGIN2: TRZ FF,PCHFLG+FINDR ;YES.
TRZN FF,RPLFG ;ARE WE IN A REPLACE?
JRST BEGIN ;NO, RETURN VALUE OF 0
CALL SKRCH ;GET A CHR FROM COMMAND STRING
CAME CH,S.TERM ;REACHED THE END OF THE REPLACEMENT?
JRST .-2 ;NO, KEEP LOOKINT
SUB P,[5,,5] ;FAKE RETFROM RPLAC
JRST BEGIN ;RETURN VALUE OF 0
NOFND1: SKIPN ABORTF ;ABORT?
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?
CALL PUNCH ;YES. PUNCH THIS BUFFER AND REFILL IT.
TRNE FF,FINDR ;LEFT ARROW SEARCH?
CALL YANK ;YES. FILL BUFFER.
POP P,E ;RESTORE SEARCH COUNT.
MOVE I,BEG
MOVEM I,(P) ;CAN'T GO BACK ANYMORE.
MOVE B,[.BYTE 7 ?001?001?001?001?001];RESTORE OFTEN USED LITERAL
JRST SERCH1 ;RESUME SEARCH
NOFND2: TRNN FF,ITERF ;IF INSIDE ITERATION
ERROR [ASCIZ/SFL Search failed/]
TRNE FF,RPLFG
SUB P,[5,,5] ;RET FROM SERCH, ITER CT, + 3 CMD STATE
CALL SR.END
JRST CRET ;CONTINUE ALONG, SFINDF MAY BE TESTED
SR.END: TRNN FF,ITERF ;IF INSIDE <>'S
JRST SR.EN1
MOVSI CH,(1_34.) ; (PLUS INFINITY OVER 2)
TDNE CH,ITERCT ;AND INDEFINITE ITERATE (NO ARG),
SETZM ITERCT ;STOP ITERATING
SR.EN1: TRZN FF,RPLFG ;GET OUT OF REPLACE COMMAND IF NEEDED
RET ;JUST S, NOT R
SR.EN2: CALL SKRCH
CAME CH,S.TERM
JRST SR.EN2
RET
;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)
CNTRS: SKIPA CH,[JSR P,CNTRS1]
;CNTR X MATCHES ANY ARBITRARY CHARACTER
CNTRX: MOVSI CH,(CAI)
JRST SERC22
;HERE ON CNTR S
CNTRS2: MOVE A,[JRST SKPSEP]
MOVEM A,CNTRS1
CALL SKPSEP ;IS CH A SEPARATOR?
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 CNTRS1,2 ;INITIALIZED TO JRST SKPSEP (^N^S)
;INITIALIZED TO JRST CNTRS2 (^S)
;UUO FOR FAST SEARCH TO SKIP IF NOT CASE INDEPENDENT MATCH
;(LIKE A CAIN CH,X IN THE CASE-DEPENDENT ROUTINE)
UCISNE: HRRZ B,40 ;GET THE CHARACTER
XORI B,0(CH)
TRNE B,177-40 ;TEST ALL BUT CASE BIT
AOS UUOHX ;MATCHES. SKIP.
JRST @UUOHX
;REVERSE SKIP FROM ABOVE
UCISEQ: HRRZ B,40
XORI B,0(CH)
TRNN B,177-40
AOS UUOHX
JRST @UUOHX
;SKIP IF SEPARATOR, PRESERVE B FOR FAST SERCH LOOP
SKPSEP: PUSH P,B
CALL DQT2
CAIA
AOS -1(P) ;GIVE SKIP RETURN
POP P,B
RET
COLON: TRO FF,COLONF ;SET COLON FLAG
JRST CD5
;MI PERFORM NOW THE TEXT IN Q-REGISTER IN AS A SERIES OF COMMANDS.
MAC: CALL 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,377770
ERROR [ASCIZ/NTQ No text in Q-register/]
ADD A,QRBUF
MOVE I,A
CALL GETINC ;GET FIRST CHARACTER OF MACRO
CAIE CH,141 ;IT SHOULD BE FLAG
ERROR [ASCIZ/NTQ No text in Q-register/]
CALL GETINC ;GET NUMBER OF CHARACTERS IN MACRO
MOVE A,CH
CALL GETINC
LSH A,7
IOR A,CH
CALL GETCHR
LSH A,7
IOR A,CH
SUBI A,4 ;-FLAG AND COUNT
MOVEM A,COMCNT ;THAT MANY COMMANDS TO COUNT
MOVEM A,COMAX ;AND MAX.
IDIVI I,5
HLL OU,BTAB(OU) ;MAKE A BYTE POINTER
TLZ OU,(17_18.) ;FLUSH XR BITS
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: TRNE FF,ARG
JUMPL B,[ERROR [ASCIZ/NIC Negative iteration count/]]
AOS INTDPH
PUSH P,ITERCT ;SAVE PREVIOUS ITERATION COUNT
PUSH P,COMAX ;NEEDED BY GARBAGE COLLECTOR
PUSH P,CPTR ;SAVE COMMAND STATE
PUSH P,COMCNT
TRZN FF,ARG ;IS THERE AN ARGUMENT?
HRLOI B,377777 ;NO, USE PLUS INFINITY
MOVEM B,ITERCT ;SETUP ITERATION COUNT
JUMPE B,INCMA ; 0<...> DOES NOTHING FEATURE.
JRST LSSTH1
GRTH: SKIPG INTDPH ;IS THERE A LEFT ANGLE BRACKET?
ERROR [ASCIZ/UAB Unmatched right angle bracket/]
SOSG ITERCT ;ITERATION DONE?
JRST INCMA2 ;YES
MOVE A,-1(P) ;NO. RESTORE COMMAND STATE
MOVEM A,CPTR
MOVE A,(P)
MOVEM A,COMCNT
TRNE FF,TRACEF ;TRACING?
CALL CRR ;YES. OUTPUT CRLF
LSSTH1: TRO FF,ITERF
JRST CRET
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.
TCOND: TRNN FF,ITERF ;IN < > ?
ERROR [ASCIZ/SNI Semicolon not in iteration/]
TRNN FF,ARG ;YES. IF NO ARG,
MOVE B,SFINDF ;LAST SEARCH SWITCH
INCMA: JUMPL B,CRET ;IF ARG <0, JUST RET + EXECUTE LOOP
MOVEI A,0 ;INIT COUNT OF <>
INCMA1: CALL 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: SOSN INTDPH ;POP OUT A LEVEL
TRZ FF,ITERF
SUB P,[3,,3]
POP P,ITERCT
JRST CRET
;!TAG! TAG DEFINITION. THE TAG IS A NAME FOR THE LOCATION IT
; APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.
EXCLAM: CALL SKRCH ;EXCLAM JUST INCREMENTS PAST ANOTHER !
CAIE CH,"!
JRST .-2
JRST CRET
;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 ;GC CAN'T HAPPEN
PUSH P,B
MOVEI D,STAB+1
MOVEI A,41
MOVEM A,-1(D) ;STAB_"!"
OGNF1: CALL SKRCH
MOVEM CH,(D) ;STAB+1 ... _ TAG
CAIL D,STAB+STABL ;FILLED BUFFER?
ERROR [ASCIZ/TTL Tag too long/]
CAIE CH,^[
AOJA D,OGNF1
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
CALL 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 CRET
OGFND: MOVE A,VALS(B)
MOVEM A,CPTR
MOVE A,CNTS(B)
MOVEM A,COMCNT
JRST CRET
;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
ERROR [ASCIZ/NAC No argument before conditional/]
CALL RCH
TRZ CH,40
MOVSI A,0
CAIN CH,"G
MOVSI A,(JUMPG B,)
CAIN CH,"L
MOVSI A,(JUMPL B,)
CAIN CH,"N
MOVSI A,(JUMPN B,)
CAIN CH,"E
MOVSI A,(JUMPE B,)
CAIN CH,"C
JRST DQT1
JUMPE A,[ERROR [ASCIZ/UCC Undefined character after conditional/]]
HRRI A,CRET
XCT A
NOGO: MOVEI A,0 ;NOGO INCREMENTS COMMAND POINTER OVER
;A SINGLE QUOTE,SKIPPING PAIRS OF " & '.
CALL SKRCH1
CAIN CH,42 ;DOUBLE QUOTE
AOJA A,.-2
CAIN CH,"' ;SINGLE QUOTE
SOJL A,CRET
JRST .-5
DQT1: CALL DQT3
JRST CRET
JRST NOGO
DQT2: MOVE B,CH
;ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z
;CALL MOVE B,CHARACTER
; CALL DQT3
; RETURN IF $,%,.,0-9,A-Z
; RETURN ON ALL OTHER CHARACTERS
DQT3: CAIE B,"$ ;$ OR %?
CAIN B,"%
RET ;YES
CAIN B,". ;NO. POINT?
RET ;YES.
CAIGE B,"0 ;NO. DIGIT OR LETTER?
JRST POPJ1 ;NO
CAIG B,"9 ;MAYBE. DIGIT?
RET ;YES.
CAIGE B,"A ;NO. LETTER?
JRST POPJ1 ;NO.
CAIG B,"Z
RET ;YES.
CAIL B,"a ;LOWER CASE LETTERS?
CAILE B,"z ;..
POPJ1: AOS 0(P) ;NO.
RET
; Error handler
ERRP: SETZM ESTYPE ; cancel automatic V
CALL DING ; feep!
SKIPE ERMSGL ; long error messages?
JRST [ MOVE B,@40 ; get first word
ANDCMI B,77777 ; mask out last two characters
HRROI 1,B ; load up a pointer to it
JRST .+2] ; and continue
HRRO A,40 ; get error message
PSOUT ; type error message
MOVEI CH,"?
CALL TYO
CALL CRR
MOVE A,COMAX
SKIPLE COMCNT ;COMCNT could have gone negative!
SUB A,COMCNT
MOVEM A,ERR1 ;ERR1:=COMAX-COMCNT
MOVE AA,CPTR ;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
MOVEI B,10.
SUBI AA,2 ;BACK POINTER UP 10 CHARACTERS.
ILDB CH,AA ;GET CHARACTER
CAMG B,ERR1 ;WAS IT IN THE COMMAND BUFFER?
CALL TYO ;YES. TYPE IT.
CAME AA,CPTR ;HAVE WE REACHED THE BAD COMMAND?
SOJA B,.-4 ;NO. DO IT AGAIN.
CALL CRR
JRST GO
U ERMSGL,1
U ERR1,1
ERRA: ERROR [ASCIZ/UDC Undefined command/]
;UUO HANDLER
;HALTS ON UNDEFINED UUO
UUOH: HLRZ B,40
CAIN B,(CISNE)
JRST UCISNE
CAIN B,(CISEQ)
JRST UCISEQ
CAIN B,(ERROR)
JRST ERRP ;YES
CAIE B,(ERROR1)
JRST [ CALL DING
HRROI 1,[ASCIZ/DSI Damn screw infinite/]
PSOUT
CALL CRR
HALTF
JRST GOX]
CALL DING
HRRO 1,40
PSOUT
CALL CRR
JRST GOX
U LISTF5,1 ;OUTPUT DISPATCH
U UUOHX,1
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND
QUESTN: MOVE A,[JRST TYO]
TRCE FF,TRACEF
MOVSI A,(RET)
MOVEM A,TRACS
JRST CRET
COMM: CALL SKRCH ;GET A COMMENT CHAR
SKIPE ABORTF ;ABORT?
JRST TYOQT ;YES, QUIT TYPEOUT
CAIE CH,4 ;IN CASE HE DID A 4I$
CAIN CH,^[ ;ALTMODE
JRST CRET
CALL TYO ;TYPE IT
JRST COMM
;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 CALL 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?
CALL CHK22 ;B:=1 IF LAST ARG FUNCTION WAS +,*,OR /
;B:=-1, IF &,#, OR -
;IE, ASSUME AN ARG OF 1 AND RETAIN SIGN
MOVE I,PT ;I:=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 GETAG7 ;YES.
CALL GETINC ;NO.
CALL EOLP ;SOME SORT OF END OF LINE?
JRST GETAG4 ;NO. TRY AGAIN.
SOJG B,GETAG4 ;YES. NTH LINE FEED?
GETAG1: TRZN FF,COLONF ;WAS : MODIFIER INCLUDED?
JRST GETAG9 ;NO, DONT CONSIDER BACKING UP
SUBI I,1 ;DO -C IF BUFFER HAS EOL'S IN IT
SKIPN EOLF
SUBI I,1 ;DO -2C IF IT HAS CRLF'S
GETAG9: CAMGE I,BEG ;MUST STAY IN BUFFER, HOWEVER
GETAG5: MOVE I,BEG
GETAG7: TRZ FF,COLONF ;TURN OFF THE FLAG IN ANY CASE
MOVE B,I ;YES. RETURN FIRST ARGUMENT IN C
MOVE C,PT ;SECOND IN B.
CAMLE C,B ;ARGS ARE REVERSED IF INPUT WAS <1
EXCH C,B
RET
;M,N
GETAG6: ADD B,BEG ;C:=M+BEG
ADD C,BEG ;B:=N+BEG
RET
;ARG IS POS OF NTH LINE FEED LEFT OF PT.
GETAG0: CAMGE I,BEG ;PASSED BEGINNING OF BUFFER?
JRST GETAG5 ;YES. I:=BEG
CALL GETCHR ;NO.
CALL EOLP ;SOME SORT OF END OF LINE?
GETAG2: SOJA I,GETAG0 ;NO, BACK UP ONE POSITION AND TRY AGAIN.
AOJLE B,GETAG2 ;NTH LINE FEED?
AOJA I,GETAG1 ;CHECK FOR COLON FLAG
;SKIP IF "END OF LINE" IN CURRENT BUFFER FORMAT (EOLF)
EOLP: SKIPN EOLF
JRST EOLP4
CAIN CH,EOL
AOS 0(P)
RET
EOLP4: CAIN CH,^J
AOS 0(P)
RET
;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)
; CALL GETINC
; RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN I.
GETINC: CALL GETCHR
AOJA I,CPOPJ
GETCHR: MOVE TT,I
IDIVI TT,5
TLNE TT,-1
ERROR [ASCIZ/URK TECO grabbing infinite core/]
LDB CH,BTAB(TT1)
RET
PUTCHR: MOVE TT,OU
IDIVI TT,5
TLNE TT,-1
ERROR [ASCIZ/URK TECO grabbing infinite core/]
DPB CH,BTAB(TT1)
RET
;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT
;OF A CHARACTER ADDRESS POINTER
440700,,(TT)
BTAB: 350700,,(TT)
260700,,(TT)
170700,,(TT)
100700,,(TT)
010700,,(TT)
NROOM: MOVEM 17,AC2+15 ;SAVE 17
MOVEI 17,NROOM9 ;ANTICIPATE GARBAGE COLLECTION
MOVEM 17,GCRET ;THIS THE EXIT DISPATCH
NROOM0: MOVE 17,[1,,AC1] ;NO. SAVE ACS 1 THROUGH 16.
BLT 17,AC2+14
JUMPL C,NROOM6 ;MOVE TOP DOWN
SETZM GCDONE ;SAY GC NOT CALLED
U GCRET,1 ;RETURN ADDR FOR GARBAGE COLLECTOR
U GCDONE,1 ;SET NON-ZERO BY GC
;SEE IF GARBAGE COLLECTOR SHOULD BE CALLED
NROOM9: MOVE 16,Z ;GC RETURNS HERE
MOVE C,AC1-1+C ;IN CASE GC CLOBBERED C
ADD 16,C ;NEW END OF BUFFER
IDIVI 16,5 ;WORD WHICH WILL CONTAIN NEW END
TLNE 16,-1 ;IF BIGGER THAN 256K,..
SKIPE GCDONE ;AND GC NOT CALLED..
CAIA
JRST GC ;CALL IT TO GET SPACE BACK
TLNE 16,-1 ;IF STILL OVERFLOW MEMORY,...
ERROR [ASCIZ/URK TECO grabbing infinite core/]
SKIPG GCCNT ;LOTS OF ]'S AND X'S DONE?
JRST GC ;YES. GARBAGE COLLECT.
;MOVE "." THROUGH Z UP C CHARACTERS
MOVE 14,C
JUMPE 14,NROOM5 ;NO MOVEMENT NEEDED
IDIVI 14,5 ;NUMBER OF WORDS TO MOVE UP
IMULI 15,7 ;NUMBER OF BITS IN PARTIAL WORD
MOVN 13,15
MOVEI 15,-43(15) ;NUMBER OF BITS TO MOVE FROM A TO AA
MOVE 11,PT
CAMN 11,Z ;DATA BUFFER EXPANSION?
JRST NROOM1 ;YES, NO MOVING REQUIRED.
IDIVI 11,5 ;WORD ADDR CONTAINING "."
JUMPN 13,NRUM2 ;NOT EVEN NUMBER OF WORDS
NRUM1: MOVE 12,Z
IDIVI 12,5 ;FIRST WORD TO MOVE
MOVE B,12
SKIPN 13 ;Z ON A WORD BOUNDARY?
SOSA 12 ;YES. START XFR WITH LAST FULL WORD
AOS B ;NO. ONE MORE WORD MUST BE MOVED.
SUB B,11 ;PT/5 ROUNDED DOWN
HRLZI 13,(MOVE A,0(12)) ;FETCH A SOURCE WORD
HRLI 14,(MOVEM A,.-.(12)) ;STORE IT MOVED
MOVE 15,[SUBI 12,1] ;MOVE TO NEXT WORD
MOVE 16,[SOJG B,13] ;COUNT DOWN NUMBER MOVED
MOVE 17,[JRST NROOM1] ;RETURN
JRST 13 ;OFF TO AC'S
NRUM2: MOVNI 16,-5(12) ;A WORD'S WORTH OF CHRS MINUS THE EXTRAS
IMULI 16,7 ;NUMBER OF BITS IN PART TO SAVE
DPB 16,[300600,,NROOM2] ;SET SIZE FIELD
ADDI 14,1(11)
MOVE 16,Z
IDIVI 16,5 ;WORD CONTAINING Z
MOVEI B,1(16)
SUB B,11 ;NO. OF WORDS TO MOVE.
NRUM21: HRLI 11,(MOVE A,.-.(B)) ;GET NEXT SOURCE WORD
HRLOI 12,(ROT A,) ;FLUSH BIT-35
HRLI 13,(ROTC A,.-.) ;MOVE N BYTES FROM A TO AA
HRLI 14,(MOVEM AA,.-.(B)) ;STORE TARGET WORD
HRLI 15,(ROTC A,.-.) ;MOVE REMAINING BYTES IN A TO AA
MOVE 16,[SOJGE B,11] ;LOOP IF MORE WORDS TO DO
MOVE 17,[JRST NROOM7] ;RETURN FROM AC'S
SOJGE B,11 ;GO TO AC'S IF ANYTHING TO DO
NROOM7: ROTC A,43(13) ;STORE LAST PARTIAL WORD.
DPB A,NROOM2
NROOM1: ADDM C,Z ;ADJUST Z TO REFLECT MOVE
NROOM5: MOVS 17,[1,,AC1] ;RESTORE ACS AND RETURN.
BLT 17,17
RET
U NROOM2,1 ;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE.
;MOVE "." THROUGH Z DOWN C BYTES (C IS NEGATIVE)
NROOM6: MOVE 14,PT ;INITIALIZE PARTIAL WORD POINTER.
IDIVI 14,5 ;FIRST SOURCE WORD ADDR
MOVEM 14,B ;SAVE FOR LATER
HRRM 14,NROOM4 ;SET ADDR OF HUNK THAT MUST BE SAVED
IMULI 15,7 ;GET NUMBER OF BITS IN THAT HUNK
DPB 15,[300600,,NROOM4] ;PUT INTO POINTER BEING ASSEMBLED
MOVNI 15,-44(15) ;NUMBER OF BITS TO RIGHT OF HUNK
DPB 15,[360600,,NROOM4] ;THATS THE POSTION FOR PTR
MOVE 11,Z ;CHR ADDR OF BUF END
ADDI 11,4 ;ROUND UP
IDIVI 11,5 ;WORD ADDR OF TOP OF BUFFER
MOVE 13,C ;GET NUMBER OF CHRS TO MOVE (NEG. NUM)
IDIVI 13,5 ;NEG. NUM. OF WORDS TO MOVE
JUMPN 14,NRUM66 ;NOT AN EVEN NUMBER OF WORDS TO CRUNCH
NRUM6: ADDM C,Z ;UPDATE Z TO REFLECT MOVE
LDB C,NROOM4 ;SAVE PARTIAL WORD
HRRZ A,NROOM4 ;DESTINATION ADDRESS
HRLI A,0(A) ;TO BOTH HALVES
SUB A,13 ;ADD WORD SIZE OF CRUNCH
MOVSS A ;FORM FROM,,TO FOR BLT
ADDI 13,0(11) ;LAST WORD OF BLT
BLT A,0(13) ;CRUNCH
JRST NROOM3 ;RESTORE PARTIAL WORD AND GET OUT
NRUM66: ADDI 13,-1(11) ;WORD WHERE Z WILL WIND UP
MOVNM 14,12 ;NUM CHRS MOVED FROM AA TO A
IMULI 12,7 ;NUM OF BITS TO SHIFT TO DO IT
MOVNI 15,-43(12) ;NUM. OF SHIFTS TO MOVE REST OF AA TO A
SUBI B,1(13) ;NUMBER OF WORDS TO BE MOVED
NROOM8: HRLI 11,(MOVE AA,.-.(B)) ;GET NEXT FULL SOURCE WORD
HRLI 12,(ROTC A,.-.) ;MOVE N CHRS FROM AA TO A
HRLI 13,(MOVEM A,.-.(B));STORE FULL TARGET WORD
MOVE 14,[ADDM A,@13] ;SHIFT LEFT 1 IN MEMORY
HRLI 15,(ROTC A,.-.) ;MOVE REMAIN BYTES FROM AA TO A
MOVE 16,[AOJLE B,11] ;DO NEXT WORD IF ANY
MOVE 17,[JRST NROOM3] ;DONE.
ADDM C,Z ;ADJUST Z DOWN BY C CHRS
LDB C,NROOM4 ;PICKUP HUNK OF 1ST WRD TARGET TO SAVE
MOVE A,@11 ;GET FIRST SOURCE WORD
ROT A,-1 ;FLUSH GARBAGE BIT
AOJLE B,11 ;OFF TO AC'S IF ANYTHING TO MOVE
NROOM3: DPB C,NROOM4 ;RESTORE SAVED HUNK
JRST NROOM5 ;RESTORE AC'S AND RETURN
U NROOM4,1 ;PARTIAL WORD POINTER FOR DOWNWARD MOVE
GC: MOVE 17,AC2+15 ;RESTORE 17 (PDL)
SETOM GCDONE ;SAY A GC HAS BEEN DONE
MOVEI T,100
MOVEM T,GCCNT ;NUMBER OF X'S TO DO BEFORE NEXT GC
SETOM GCPTR ;YES. GCPTR:=-1
SETZM SYMS ;CLEAR SYMS,VALS AND CNTS TABLES
MOVE T,[SYMS,,SYMS+1]
BLT T,SYMEND-1
MOVEI T,CPTR ;COMMAND STRING, MAYBE A Q-REG
CALL GCMA
HRRZ T,P
CAIL T,PDL ;PUSHDOWN LIST EMPTY?
CALL GCMA ;NO. GARBAGE COLLECT ALL BYTE POINTERS
CAILE T,PDL ;USUALLY THESE ARE PUSHED CPTR'S
SOJA T,.-2
HRRZ T,AC2+PF-2 ;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
CAIL T,PFL
CALL GCM
CAILE T,PFL
SOJA T,.-2
MOVE T,[-45,,QTAB] ;GARBAGE COLLECT Q-REGISTERS.
CALL GCM
AOBJN T,.-1
SKIPGE GCPTR ;ANYTHING TO COLLECT?
JRST @GCRET ;NOPE.
GCS: MOVE I,QRBUF ;BOTTOM OF POSSIBLE GARBAGE
GCS1A: MOVE TT,BEG ;TOP OF GARBAGE+1
MOVE OU,GCPTR ;GO BACKWARDS THROUGH GCTAB
GCS1: MOVE A,GCTAB(OU) ;GET AN ENTRY
ADD A,QRBUF ;FORM ABSOLUTE CHR ADDR
CAMGE A,I ;I HAS CHR ADDR OF UNCOMPACTED AREA STRT
JRST GCS2 ;THIS ONE IS OK
CAMGE A,TT ;SET TT TO CHR ADDR OF
MOVE TT,A ;LOWEST STRING TO SAVE
GCS2: SOJGE OU,GCS1
CAML TT,BEG ;EVERYTHING BELOW TEXT BUFFER DONE?
JRST @GCRET ;YES. GC IS DONE
IDIVI I,5 ;WORD ADDR OF START OF AVAIL. AREA
MOVE F,TT ;CHR ADDR OF LOWEST STRING TO SAVE
IDIVI F,5 ;WORD ADDR OF START OF STRING TO SAVE
MOVS OU,F ;"FROM" ADDR FOR BLT
MOVE T,F ;WORD ADDR OF STRING TO SAVE
SUB T,I ;MINUS WORD ADDR OF GARBAGE
JUMPLE T,GCS4A ;ALREADY IN PLACE
HRR OU,I ;"TO" ADDR FOR BLT
MOVE B,Z ;CHR ADDR OF END OF TEXT
ADDI B,5 ;BE SURE TO TAKE LAST WORD
IDIVI B,5 ;FORM WORD ADDR OF END
SUB B,T ;WHAT NEW END WILL BE
BLT OU,0(B) ;MOVE STUFF DOWN
MOVNS OU,T ;NUMBER OF WORDS FLUSHED
IMULI OU,5 ;NUMBER OF CHRS FLUSHED
ADDM OU,BEG ;ADJUST TO REFLECT MOVE
ADDM OU,PT
ADDM OU,Z
MOVE CH,GCPTR ;UPDATE INSERTER
GCS3: MOVE A,GCTAB(CH) ;CHR ADDR REL TO QRBUF
ADD A,QRBUF ;ABSOLUTE CHR ADDR BEFORE MOVE
CAMGE A,TT ;NEEDS UPDATING??
JRST GCS4 ;NO
ADDM OU,GCTAB(CH) ;ADJUST GCTAB ENTRY FOR BLT
SKIPL TT1,@GCTABA(CH) ;40000N,,N IS Q-REG
TLNN TT1,777770 ;NUMS UP TO 7,,777777 ARE CHR ADDRS
JRST GCS5 ;GO RELOCATE Q-REG OR CHAR POINTER
ADDM T,@GCTABA(CH) ;MAKE BYTE POINTER SEE BLT'D STRING
GCS4: SOJGE CH,GCS3 ;DONE?
ADD TT,OU ;YES. I:=C(TT)-5*NREG
GCS4A: MOVE I,TT ;SHOULD POINT TO BEGINNING
CALL GETINC ;OF Q-REGISTER STRING.
CAIE CH,141 ;DOES IT??
GCERR: JRST [ ERROR1 [ASCIZ/GCE Garbage collector error/]
HALTF]
CALL GETINC
MOVE A,CH
CALL GETINC
LSH A,7 ;GET COUNT OF STRING
IOR A,CH
CALL GETINC
LSH A,7
IOR A,CH
ADD I,A ; A INCLUDES THE +4 NEEDED TO ROUND UP
IDIVI I,5 ;FORCE IT TO POINT AT NEXT WRD BOUNDARY
IMULI I,5 ;I NOW CHR ADDR OF BEG OF NEXT STRING
JRST GCS1A ;OR GARBAGE AREA
GCS5: ADDM OU,@GCTABA(CH) ;MAKE CHR ADDR POINT TO MOVED STRING
JRST GCS4 ;DO NEXT GCTAB ENTRY
;COLLECT STRINGS POINTED TO BY Q-REG POINTERS
GCM: MOVE I,(T)
TLZE I,400000 ;DOES Q-REG CONTAIN TEXT?
TLZE I,377770
RET ;NO. NUMERIC CONTENTS
ADD I,QRBUF ;YES. MAKE ABSOLUTE CHR ADDR
GCM2: CAML I,BEG ;REGION BEFORE TEXT BUFFER?
RET ;NO. (ERROR???)
CALL GETCHR ;YES. CHECK FOR MARK.
CAIE CH,141 ;BEGINNING OF STRING?
RET ;NO. (ERROR IF NOT MAIN COMMAND STRING?)
GCM3: SUB I,QRBUF ;GET RELATIVE ADDR OF STRING TO SAVE
AOS TT,GCPTR ;GET NEXT TABLE SLOT
CAIL TT,GCTBL ;STILL SPACE LEFT?
JRST GCERR ;NO. VERY BAD.
HRRZM T,GCTABA(TT) ;SAVE ADDRESS OF PTR.
MOVEM I,GCTAB(TT) ;PUT IN TABLE
RET ;DONE THIS POINTER
;COLLECT STRINGS UNDER PARTIAL EXECUTION (BYTE POINTERS), RANDOMLY
; PUSHED BYTE POINTERS AND PUSHED CHARACTER ADDRS.
;NOTE: THIS LOSES FOR BYTE POINTERS OF THE FORM 440700,,XXXXXX AND
; FOR NUMBERS LARGE ENOUGH TO BE CONFUSED WITH CHR ADDR.
; FOR INSTANCE 17000<200<X0%A>> WILL FORCE GC'S WHICH WILL FIND
; WHAT'S LEFT OF THE 17000 ON THE PDL AND RELOCATE IT, NOT TO
; MENTION WHAT IT POINTS AT.
GCMA: MOVE I,0(T) ;GET THE POINTER
CAMGE I,BEG
RET ;THIS REJECTS ALL BUT CHR PTRS, BYTE PTRS, & JNK
TLNN I,777770 ;IF ANY BITS ON, NOT CHAR POINTER
JRST GCM3 ;ASSUME IT IS CHR ADDR
LDB TT,[221400,,I] ;BYTE SIZE + XR
CAIE TT,700 ;DOES T PT TO A 7-BIT TEXT BYTE PTR?
RET ;NO. ASSUME IT IS JUNK
HRRZ TT,I
CAMG TT,CBUFH ;MAIN COMMAND STRING??
RET ;YES, FORGET IT.
LDB TT,[360600,,I] ;BYTE POSITION
IDIVI TT,7 ;NO. OF CHARACTERS
HRRZI I,1(I) ;BYTE PTR ADDR +1
IMULI I,5 ;NUM CHRS BELOW THIS IN ALL MEMORY
SUBI I,4(TT) ;MINUS CHRS IN PREVIOUS WRD & 4 OVERHEAD
ADD I,1(T) ;CT (WE HOPE)
SUB I,-1(T) ;MAX
JRST GCM2 ;I HAS CHR ADDR OF BEG OF STRING
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 GCPTR,1
U GCCNT,1 ;COUNT OF X'S TO DO BETWEEN GC'S
;COMMAND DISPATCH TABLE
;DISPATCH IS BY XCT DTB(CH)
;FORMAT:
; MOVEI A,X ;IF X RETURNS A VALUE
; HRROI A,X ;IF X DOESN'T 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,ERRA ;^A
HRROI A,ERRA ;^B
HRROI A,ERRA ;^C
HRROI A,UP.D ;^D
MOVEI A,FFEED ;^E
MOVEI A,UP.F ;^F
HRROI A,ERRA ;^G
HRROI A,UP.H ;^H
HRROI A,TAB ;^I
JRST CD ;^J
HRROI A,ERRA ;^K
HRROI A,ERRA ;^L
JRST CD ;^M
HRROI A,ERRA ;^N
HRROI A,ERRA ;^O
HRROI A,ERRA ;^P
HRROI A,ERRA ;^Q
HRROI A,ERRA ;^R
MOVEI A,UP.S ;^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
JRST CD ;^[
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 ;#
MOVEI A,CRET ;$
MOVEI A,PCNT ;%
MOVEI A,CAND ;&
MOVEI A,CRET ;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 ;:
JRST 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
MOVEI A,SERCHP ;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,REPLAC ;R
MOVEI A,SERCH ;S
HRROI A,TYPE ;T
HRROI A,USE ;U
HRROI A,VIEW ;V
MOVEI A,WRBUF ;W
MOVEI A,X ;X
HRROI A,YANK ;Y
MOVEI A,END1 ;Z
MOVEI A,OPENB ;[
MOVEI A,BAKSL ;BACKSLASH
HRROI A,CLOSEB ;]
MOVEI A,UAR ;^
MOVEI A,LARR ;LEFT ARROW
;SEMICOLON COMMAND TABLE
SEMTAB: MOVEI A,TCOND ;SPACE
REPEAT 37,JRST ERRA
JRST ERRA ;@
JRST ERRA ;A
MOVEI A,SEM.B ;B
HRROI A,CLOSEF ;C
HRROI A,DNLOAD ;D
JRST ERRA ;E
MOVEI A,LARR ;F
MOVEI A,GETOB ;G
MOVEI A,SEMI.H ;H
JRST ERRA ;I
JRST ERRA ;J
JRST ERRA ;K
JRST ERRA ;L
JRST ERRA ;M
MOVEI A,PIKNUM ;N
JRST ERRA ;O
MOVEI A,PICKUP ;P
JRST ERRA ;Q
HRROI A,OPNRD ;R
HRROI A,BFSAVE ;S
MOVEI A,TPREG ;T
HRROI A,UNLOAD ;U
JRST ERRA ;V
HRROI A,OPNWR ;W
JRST ERRA ;X
HRROI A,YLOAD ;Y
MOVEI A,SEM.Z ;Z
JRST ERRA ;[
JRST ERRA ;\
JRST ERRA ;]
JRST ERRA ;^
JRST ERRA ;_
...LIT:
...VAR: VARIAB
IFN .-...VAR,.FATAL If you think you can have variables are you ever going to lose
CONSTA ;LITERALS GO AFTER END OF PROGRAM
;PAGE 0 VARIABLES AREA
U STAB,0 ;SEARCH TABLE
;SERC22+2,OGNF+4,OGNF+6,OGFN+11
U AC1,1
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
;CHECK OVERLAP OF STAB AND OTHER STUFF
IFG STAB+STABL-ZZ,<ZZ==STAB+STABL>
U STABP,0
U SVSTAB,STABL ;SAVED DEFAULT FOR S$
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 GCTABA,GCTBL ;PTR ARRAY PARALLEL TO GCTAB
U QTAB,45 ;Q-REGISTER TABLE
;USEA+1,PCNT+1
U PDL,LPDL
U UAC,17
U TOP,0
IFGE TOP-IBFPGA,.FATAL STAB too long. Make STABL smaller
END EVECL,,EVEC