Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/ante.mac
There are 3 other files named ante.mac in the archive. Click here to see a list.
; A Nother Text Editor
TITLE ANTE
F.SYS==1 ; -1 IF TOPS-10, 1 IF TENEX
IF1,< IFL F.SYS,<PRINTX ANTE for TOPS-10...>
IFG F.SYS,<PRINTX ANTE for TENEX...>>
IF2,<PRINTX ...is halfway>
; Command Input Controls
;
;^A delete the last character
;^E print the command stream
;^G delete the command stream (two in succession)
;^H delete the last character
;^R print the current line
;^U delete the current line
;^W delete the last word
;^V insert the next character into the command stream
;<rubout> delete the last character
;<escape> terminate command stream input (two in succession)
;
;^H and ^ equivalent to -LV$$ if first character
;<lf> and _ equivalent to LV$$ if first character
;^L equivalent to -NV$$ if first character
;^N equivalent to NV$$ if first character
;
; Values
;
;<digits> integer
;. the pointer position
;Z the number of characters in the buffer
;: to the end of the line (equivalent to .UaL-2C.UbQaJ.,Qb)
;H all text (equivalent to 0,Z)
;+<value>{1} unary sign
;-<value>{1} unary sign
;<value>+<value> addition
;<value>-<value> subtraction
; (and the value-producing commands Q,W,FA,FTI,FO,FN)
;
; Prefixes
;
;/ use explicit string delimiters
;@ use the string in the Qreg
;
; Commands
;
;Values may occur wherever n or m occur.
;Integers in braces are default values.
;Strings are normally terminated with an <escape>.
;Valid Qregs are 0 through 9, A through Z, *.
;
;<n>{1}C move pointer n characters
;<n>{1}D delete n characters
;<n>{0}J jump to the nth character
;<n>{1}<,m>K delete n lines (or from characters n to m)
;<n>{1}L move the pointer n lines
;<n>{1}N move the pointer n words
;<n>{1}O delete n words
;<n>{1}<,m>T print n lines (or from characters n to m)
;<n>{1}<,m>V equivalent to -(n-1)T {"~"}FTO nT (m is the print mode)
;
;I[string] insert text (<tab> is equivalent)
;<n>{1}R[string1][string2] replace the nth instance of s1 with s2
; (the first string default is the last given to R or S)
; (a null second string simply deletes the first string)
;<n>{1}S[string] search n times for the string (see R for string default)
;
;A[Qreg] edit the Qreg (initially Qreg *)
;B[Qreg] save the last command in the Qreg
;G[Qreg] get the text from the Qreg
;<n><,m>M[Qreg] execute the text in the Qreg (n and m are passed as arguments)
;<n>{1}<,m>P[Qreg] put n lines into the Qreg (or from characters n to m)
;Q[Qreg] get the value from the Qreg (produces value)
;<n>{0}U[Qreg] put the value into the Qreg
;<n>{1}<,m>X[Qreg] equivalent to <n><,m>P <n><,m>K
;<n>{1}%[Qreg] add n to the value in the Qreg
;
;EG[string] write file, exit and go
;EE exit without writing a file
;EN[string] set the default file name used by EG, EW, EX
;EP[Qreg][string] put the file into the Qreg
;ER[string] read file (default is last file referenced)
;EW[string] write file (default is last file referenced)
;EX[string] write file and exit (default is last file referenced)
;
;<n>{infinity}< iterate n times ({1}[ is equivalent)
;> end the body of an iteration (] is equivalent)
;
;<n>= print n
;W(B|I|S) return the specified saved pointer position (produces value)
; (B: before last search, I: start of insert, S: start of search)
;
;<n,m>FA(D|M|R) perform the given arithmetic operation (produces value)
; (D:divide, M:mulitply, R:remainder)
;<n>{10}FB change the base of numeric input/output
;<n>{0}<,m>{1}FC<E|N|G|L> if n satisfies the given relation
; then exit m iteration levels
; (E:n=0, N:n#0, G:n>0, L:n<0) (the innermost level is 1)
;<n>{1}FD[string] delete n instances of the string
;FG[Qreg] print the text in the Qreg (equivalent to @FTS[Qreg])
;<n>{" "}FI insert n as a character at .
;FM[Qreg][Qreg] copy the contents of the first Qreg into the second Qreg
;<n>{1}FN[string] search (as S) and return value (0 for success)
;FO get the value of the character at . (produces value)
;<n>{1}<,m>FP[Qreg] insert n lines into the Qreg (or from characters n to m)
;FQ list the status of all nonempty Qregs
;<n>{1}FS[string1][string2] replace n instances of s1 with s2
;<n>FTE set echo mode (<0: no echo (by ANTE))
;FTI input a character from the terminal (produces value)
;<n>{1}FTM set the print mode (0:direct, 1:terse, 2:verbose)
;<n>{" "}<,m>FTO output n as a character to the terminal (with print mode m)
;<n>FTS[string] output the string to the terminal (with print mode n)
;<n>{"~"}FV set the pointer indicator character used by the V command
;<n>{0}FW set <n> for the automatically executed V command (window)
;<n>{1}<,m>FX[Qreg] equivalent to <n><,m>FP <n><,m>K
;? print commands as they are executed
;![string] comment
;; accept and discard arguments
; ***DEFINITIONS***
NSIZE==20
SSIZE==40
BSIZE==200
PSIZE==1000
PBLOCK==5 ; POINTER BLOCK LENGTH (CB, BB, SB, QREGS)
Q.B==0 ; BUFFER POINTER OFFSET
Q.A==1 ; ALLOCATED POINTER OFFSET
Q.Z==2 ; Z POINTER OFFSET
Q.P==3 ; . POINTER OFFSET
Q.V==4 ; VALUE POINTER OFFSET
.JBREN==124
; REGISTER DEFINITIONS
R1==1
R2==2
R3==3
R4==4
R5==5
R6==6
R7==7
R10==10
R11==11
R12==12
R13==13
R14==14
R15==15
R16==16
R17==17
; (SCRATCH REGISTERS)
X1==R1
X2==R2
X3==R3
X4==R4
; (COMMONLY USED REGISTERS)
CH==R5
PTR==R6
N==R7
M==R10
V1==R11
V2==R12
UTIL==R13
FLAG==R14
LEVEL==R15
ENVIR==R16
STACK==R17
; MACRO DEFINITIONS
SALL
DEFINE BEGINR(SAVLST,%RETN)
< ..SAVL==0
..SAVC==0
IFIDN <SAVLST><ALL>,<..SAVL==77777>
IFDIF <SAVLST><ALL>,<
IRP SAVLST,<
IFG <SAVLST>-20,<!!
PRINTX SAVLST NOT A REGISTER>
IFLE <SAVLST>-20,<
IFN ..SAVL&1_SAVLST,<!!
PRINTX SAVLST SAVED TWICE>
..SAVL==..SAVL!1_SAVLST
..SAVC==..SAVC+1>>>
IFN ..SAVL,<
..REG==17
REPEAT 20,<
IFN ..SAVL&1_..REG,<PUSH STACK,..REG>
..REG==..REG-1>>
DEFINE .%RETN <%RETN> ; UNIQUE LOCATION FOR RETURN AND ENDR
DEFINE .%RETL <%RETN':!>
..SFLG==0 ; LARGEST SKIP RETURN
>
DEFINE RETURN(S,N)
<<IFB <S>,<<IFE ..SAVC,<POPJ STACK,.%RETN>>+<IFN ..SAVC,<JRST .%RETN>>>>+<IFIDN <S><SKIP>,<<IFG N-..SFLG,<..SFLG==N>>*0+<JRST .%RETN-N>>>>
DEFINE RETN(N)
<<IFB <N>,<<IFE ..SAVC,<.%RETN>>+<IFN ..SAVC,<.%RETN>>>>+<IFNB <N>,<<IFG N-..SFLG,<..SFLG==N>>*0+<.%RETN-N>>>>
DEFINE ENDR(S,N)
< IFB <S>,<..N==0>
IFIDN <S><SKIP>,<..N==N
IFG <..N-..SFLG>,<..SFLG==..N>>
IFN <..SFLG>,<IFN <..N-..SFLG>,<JRST .%RETN-..N>
REPEAT ..SFLG,<
AOS -..SAVC(STACK)>>
.%RETL
..REG==0
REPEAT 20,<
IFN ..SAVL&1_..REG,<POP STACK,..REG
..SAVL==..SAVL-1_..REG>
..REG==..REG+1>
POPJ STACK,>
DEFINE CALLR(ROUTIN)
< PUSHJ STACK,ROUTIN>
DEFINE DBP (REG)
< ADD REG,[070000,,0]
TLNN REG,400000
JRST .+3
HRRI REG,-1(REG)
HRLI REG,010700>
DEFINE LETEST(LETTER,ROUTIN)
< CAIE CH,"LETTER"
CAIN CH,"LETTER"+40
JRST ROUTIN>
DEFINE A$INT(VALUE)
< MOVEI N,VALUE
CALLR EXVALU>
DEFINE A$QREG
< CALLR EXQREG>
DEFINE A$STR(NUMBER)
< CALLR EXSTRI
MOVEM N,EX%S1N
MOVEM M,EX%S1P
IFIDN <NUMBER><2>,< CALLR EXSTRI
MOVEM N,EX%S2N
MOVEM M,EX%S2P>>
DEFINE A$$END
< CALLR EXARGE
JRST EXNEXT>
; POINTER UPDATING DUE TO ALLOCATION AND BUFFER MOVEMENT
; IMMEDIATE (STRING SOURCES)
; I (EXEBIP -- TEXT STRING)
; R (EXSBI -- TEXT STRING AND SEARCH STRING, EXEBIP -- TEXT STRING)
; S (EXSBI -- SEARCH STRING)
; NOTE THAT SOME COMMANDS ARE NOT A PROBLEM
; G (A PBLOCK POINTER INSTEAD OF A TEXT POINTER)
; P (EB SOURCE WITH EXBPE POINTER)
; ER (STRING SOURCE NO LONGER NEEDED)
; FH (A PBLOCK POINTER INSTEAD OF A TEXT POINTER)
; FU (A VALUE INSTEAD OF A STRING)
; DEFERRED (COMMAND POINTER)
; M AND EXCHAR
; < AND >
; ALLOC
DEFINE EXQPTR(REG)
< MOVNI REG,(REG)
ADD REG,@EX%Q
ADDM REG,EX%PTR>
; SYSTEM DEPENDENT DEFINITIONS
; (((TOPS-10)))
IFL F.SYS,<
IFNDEF F.HARV,<F.HARV==0> ; NONZERO IF HARVARD
IFNDEF F.SAIL,<F.SAIL==0> ; NONZERO IF SAIL
IFNDEF F.2SEG,<F.2SEG==0> ; NONZERO IF TWO SEG
IF1,< IFN F.HARV,<PRINTX ... at Harvard>
IFN F.SAIL,<PRINTX ... at SAIL>
IFN F.2SEG,<PRINTX ... with two segments>>
IFE F.HARV,<OPECHO==200> ; NO ECHO
IFN F.HARV,<OPECHO==140> ; FULL CHARACTER SET + ANTE MODE
IFN F.2SEG,<
TWOSEG
RELOC 400000
>; TWOSEG
IOCHAN==1
DEFINE TBIN(REG)
<IFE F.HARV,< INCHRW REG>
IFN F.HARV,< INCHWL REG>
IFN F.SAIL,< CAIN REG,175
MOVEI REG,33>>
DEFINE TBOUT(REG)
< OUTCHR REG>
DEFINE TSOUT(STRING)
< IRP STRING
< OUTSTR STRING>>
.JBREL==44
.JBFF==121
IFE F.SAIL,<.JBINT==134>
IFN F.SAIL,<
.JBINT==71
OPDEF BUFLEN [047000,,400042]
OPDEF DEBREA [047000,,400035]
OPDEF DISMIS [047000,,400024]
OPDEF DSKPPN [047000,,400071]
OPDEF INTENB [047000,,400025]
OPDEF UWAIT [047000,,400034]
>
>
; (((^^^)))
; WAITS differences from TOPS-10
; ^_I (not ^C) interrupt
; Sixbit PPNs
; device buffer size, LOOKUP
; escape, tilda, SNAIL
; (((TENEX)))
IFG F.SYS,<
SEARCH STENEX
DEFINE TBIN(REG)
< PBIN
IFN <X1-REG>,< MOVEI REG,(X1)>>
DEFINE TBOUT(REG)
< IFN <X1-REG>,< MOVEI X1,(REG)>
PBOUT>
DEFINE TSOUT(STRING)
< IRP STRING
< HRROI X1,STRING
PSOUT>>
>
; (((^^^)))
; TENEX fork version
;
; ACs passed down:
; 0: 0 -> EN; -1 -> ER
; 1-N: ASCIZ file name
; ACs passed up:
; 0: >0 -> ^C continue location; =0 -> EH or EX; <0 -> EG
; superior fork JSYSes
; CFORK
; 1> 1B1+1B3
; 2> AC pointer
; 1< handle
; GTJFN
; 1> 1B2+1B17
; 2> ANTE.SAV pointer
; 1< jfn
; GET
; 1> handle,,jfn
; GEVEC
; 1> handle
; 2< entry (start location)
; SFORK
; 1> handle
; 2> entry (GEVEC entry + 1 or ^C continue entry)
; WFORK
; 1> handle
; RFACS
; 1> handle
; 2> AC pointer
; ***INITIALIZATION***
ANTE: JRST START1
JRST START2
REANTE: JRST REENT
START1: SKIPA FLAG,[0] ; REGULAR ENTRY
START2: SETO FLAG, ; INITIAL ARGUMENT ENTRY
MOVEM FLAG,FLAGIF
MOVEI UTIL,REANTE
MOVEM UTIL,.JBREN
MOVE STACK,[IOWD SSIZE,STACKB]
SETZM IONAME
SETZM IOLAST
CALLR FIRSTN ; GET OPTIONAL INITIAL FILE NAME
RESET
SETZM FLAGIF
CALLR FIRSTI ; PERFORM LOW LEVEL INITIALIZATION
MOVE N,ZU
MOVEI PTR,C.B
FIRSTP: MOVEM N,Q.B(PTR) ; INITIALIZE BUFFERS AND QREGS
SETZM Q.A(PTR)
SETZM Q.Z(PTR)
SETZM Q.P(PTR)
SETZM Q.V(PTR)
ADDI PTR,PBLOCK
CAIE PTR,E.B
JRST FIRSTP
MOVEI PTR,<Q.$+Q.B>
MOVEM PTR,E.B
MOVEI PTR,<Q.$+Q.A>
MOVEM PTR,E.A
MOVEI PTR,<Q.$+Q.Z>
MOVEM PTR,E.Z
MOVEI PTR,<Q.$+Q.P>
MOVEM PTR,E.P
SETZM FLAGCC
SETZM FLAGCD
MOVEI N,^D10
MOVEM N,EXBASE
SETZM EXDBUG
MOVEI N,1
MOVEM N,EXPRIM
MOVE PTR,[BSIZE*5,,C.B]
CALLR ALLOC ; ALLOCATE COMMAND BUFFER
JRST QUIT
SKIPE IONAME
CALLR IO$ER
JRST INBEG
JRST INBEG
REENT: MOVE STACK,[IOWD SSIZE,STACKB]
RESET
SETOM FLAGIF
CALLR FIRSTI ; PERFORM LOW LEVEL INITIALIZATION
TSOUT <[ASCIZ/(. is /]>
MOVEI M,^D10
MOVE N,@E.P
CALLR M$I.S
TSOUT <M$I.SR,<[ASCIZ/ and Z is /]>>
MOVE N,@E.Z
CALLR M$I.S
TSOUT <M$I.SR,[ASCIZ/ in /]>
MOVE PTR,E.B
CALLR QNOUT
TSOUT <[ASCIZ/)/],CRLF>
SKIPN FLAGCD
JRST INBEG
SETZM FLAGCC
SETZM FLAGCD
TSOUT <[ASCIZ/ ? Text may be trashed ?/],CRLF>
JRST INBEG
; ***COMMAND INPUT***
INBEG$: TSOUT <CRLF>
INBEG: MOVEI UTIL,"*"
TBOUT <UTIL> ; PROMPT
HRR PTR,C.B
HRLI PTR,440700 ; PREPARE FOR A NEW COMMAND STRING
SETZ N,
MOVE M,C.A
SETZM EX%B
INNEXT: TBIN <CH> ; INPUT A CHAR AND DISPATCH
INNE$0: HLRZ UTIL,DISPCH(CH)
JRST (UTIL)
INSERT: CALLR TERME
CALLR INADD
JRST INNEXT
JRST INNEXT
IN$A%: CALLR INSUB ; ^A AND RUBOUT
JRST INBEG$
MOVEI UTIL,"\"
TBOUT <UTIL>
CALLR TERMO
JRST INNEXT
IN$E: JUMPE N,INBEG$ ; ^E
TSOUT <CRLF>
MOVEI UTIL,"*"
TBOUT <UTIL>
SETZ UTIL,
HRR PTR,C.B
HRLI PTR,440700
IN$E0: ILDB CH,PTR
CALLR TERMO
ADDI UTIL,1
CAIE UTIL,(N)
JRST IN$E0
JRST INNEXT
IN$G: CALLR TERME ; ^G
TBIN <CH>
CAIE CH,"G"-100
JRST INNE$0
CALLR TERME
JRST INBEG$
IN$H%: JUMPE N,IN$H%0 ; ^H AND ^
CAIN CH,"H"-100
JRST IN$A%
JRST INSERT
IN$H%0: SETOM EX%B
MOVE UTIL,[BYTE (7)"-","L","V",33,0]
MOVEM UTIL,@C.B
MOVEI N,4
JRST EXBEG
IN$J%: JUMPN N,INSERT ; <LINE-FEED> AND _
SETOM EX%B
MOVE UTIL,[BYTE (7)"L","V",33,0,0]
MOVEM UTIL,@C.B
MOVEI N,3
IFL F.SYS,<
IFE F.HARV,<
SKIPN FLAGED
JRST EXBEG
>; NOT HARVARD
JRST EXBEG$
>; TOPS-10
IFG F.SYS,<
SKIPE FLAGED
JRST EXBEG$
JRST EXBEG
>; TENEX
IN$L: JUMPN N,INSERT ; ^L
SETOM EX%B
MOVE UTIL,[BYTE (7)"-","N","V",33,0]
MOVEM UTIL,@C.B
MOVEI N,4
JRST EXBEG
IN$N: JUMPN N,INSERT ; ^N
SETOM EX%B
MOVE UTIL,[BYTE (7)"N","V",33,0,0]
MOVEM UTIL,@C.B
MOVEI N,3
JRST EXBEG
IN$R: JUMPE N,INBEG$ ; ^R
LDB UTIL,PTR
PUSH STACK,N
CALLR INSUB
JRST IN$R2
IN$R1: CALLR INSUB
JRST IN$R2
CAIN CH,12
JRST IN$R2
CAIN CH,37
JRST IN$R2
JRST IN$R1
IN$R2: CAIN UTIL,12
JRST IN$R3
CAIN UTIL,37
JRST IN$R3
TSOUT <CRLF>
IN$R3: JUMPN N,IN$R4
MOVEI UTIL,"*"
TBOUT <UTIL>
JRST IN$R5
IN$R4: IBP PTR
AOJ N,
IN$R5: MOVEI UTIL,(N)
POP STACK,N
IN$R6: ILDB CH,PTR
CALLR TERMO
ADDI UTIL,1
CAIE UTIL,(N)
JRST IN$R6
JRST INNEXT
IN$U: JUMPE N,INBEG$ ; ^U
TSOUT <[ASCIZ/^U/],CRLF>
CALLR INSUB
JRST INBEG
IN$U1: CALLR INSUB
JRST INBEG
CAIN CH,12
JRST IN$U2
CAIN CH,37
JRST IN$U2
JRST IN$U1
IN$U2: IBP PTR
AOJA N,INNEXT
IN$V: TBIN <CH> ; ^V
CALLR TERME
CALLR INADD
JRST INNEXT
JRST INNEXT
IN$W: JUMPE N,INBEG$ ; ^W
MOVEI UTIL,"\"
TBOUT <UTIL>
IN$W1: CALLR INSUB ; PASS OVER TRAILING SEPARATOR (IF ANY)
JRST INBEG$
CALLR TERMO
CALLR WORDET
JRST IN$W1
JRST IN$W2
JRST IN$W3
IN$W2: TBOUT <UTIL> ; PUNCTUATION (ONE CHARACTER)
JRST INNEXT
IN$W3: CALLR INSUB ; WORD (MANY CHARACTERS)
JRST INBEG$
CALLR WORDET
JRST IN$W4
JRST IN$W4
CALLR TERMO
JRST IN$W3
IN$W4: TBOUT <UTIL>
IBP PTR
AOJA N,INNEXT
IN$%: CALLR TERME ; <END-OF-LINE>
MOVEI CH,15
CALLR INADD
JRST INNEXT
MOVEI CH,12
CALLR INADD
JRST INNEXT
JRST INNEXT
IN$$: CALLR TERME ; <ESCAPE>
CALLR INADD
JRST INNEXT
TBIN <CH>
CAIE CH,33
JRST INNE$0
CALLR TERME ; <ESCAPE><ESCAPE>
CAIN N,1
JRST IN$$0
CALLR INADD
JRST INNEXT
JRST EXBEG
IN$$0: MOVE UTIL,[BYTE (7)"V",33,0,0,0]
MOVEM UTIL,@C.B
MOVEI N,2
JRST EXBEG
; ADD CH TO COMMAND BUFFER (UPDATE PTR AND N)
;
INADD: BEGINR
ADDI N,1
CAMGE N,M
JRST INADD1
PUSH STACK,PTR
MOVE PTR,[BSIZE*2*5,,C.B]
CALLR ALLOC
JRST INADD0
POP STACK,PTR
ADDI M,<BSIZE*2*5>
JRST INADD1
INADD0: POP STACK,PTR
SOJA N,RETN(0)
INADD1: IDPB CH,PTR
ENDR SKIP,1
; SUBTRACT CH FROM COMMAND BUFFER (UPDATE PTR AND N)
;
INSUB: BEGINR
JUMPE N,RETN(0)
LDB CH,PTR
SOJ N,1
DBP <PTR>
ENDR SKIP,1
; ***COMMAND EXECUTION***
; EXECUTION FLAGS (LEFT HALF)
;
F$EI==400000 ; EXECUTION INHIBIT
F$EM==200000 ; EXECUTING MACRO
;
; ARGUMENT FLAGS (RIGHT HALF)
;
F$V== 700000 ; ALL VALUE FLAGS
F$V1==400000 ; VALUE 1 DEFINED
F$VC==200000 ; , ENCOUNTERED
F$V2==100000 ; VALUE 2 DEFINED
F$P== 070000 ; ALL PREFIX FLAGS
F$PA==040000 ; PREFIX @
F$PC==020000 ; PREFIX :
F$PS==010000 ; PREFIX /
F$O== 006000 ; ALL OPERATOR FLAGS
F$OA==004000 ; OPERATOR -- ADD
F$OS==002000 ; OPERATOR -- SUBTRACT
EXBEG: TSOUT <CRLF>
EXBEG$: MOVEM N,C.Z
EXPAS1: HRR PTR,C.B
HRLI PTR,440700
MOVEM PTR,EX%PTR
MOVE N,C.Z
MOVEM N,EX%N
HRLZI FLAG,F$EI ; PASS 1 IS SYNTAX
SETZ LEVEL,
MOVE ENVIR,[IOWD <2*SSIZE>,ENVIRB]
PUSH ENVIR,[EXPAS2]
JRST EXNEXT
EXPAS2: MOVE PTR,@E.P
MOVEM PTR,EX..
HRR PTR,C.B
HRLI PTR,440700
MOVEM PTR,EX%PTR
MOVE N,C.Z
MOVEM N,EX%N
SETZ FLAG, ; PASS 2 IS SEMANTICS
SETZ LEVEL,
SETZM EX%Q
PUSH ENVIR,[EXEND]
JRST EXNEXT
EXEND: TRNN FLAG,F$V1
JRST EXEND%
MOVE N,V1
MOVE M,EXBASE
CALLR M$I.S
TSOUT <M$I.SR,CRLF>
EXEND%: HRRZI PTR,C.B ; PBLOCK POINTER
HRRZ FLAG,C.B ; DOWN POINTER
EXEND1: MOVE N,Q.Z(PTR)
ADDI N,4
IDIVI N,5 ; NUMBER OF WORDS USED
CAMN FLAG,Q.B(PTR)
JRST EXEND2 ; BUFFER NEED NOT BE MOVED
HRL UTIL,Q.B(PTR)
MOVEM FLAG,Q.B(PTR) ; MOVE Q.B DOWN
JUMPE N,EXEND2
HRRI UTIL,(FLAG)
HRRZI M,(FLAG)
ADDI M,-1(N)
BLT UTIL,(M) ; MOVE BUFFER DOWN
EXEND2: ADDI N,<BSIZE-1>
IDIVI N,BSIZE ; NUMBER OF BLOCKS USED
MOVEI UTIL,(N)
CAILE UTIL,2
ADDI UTIL,2 ; IF MORE THAN 2 BLOCKS USED THEN ALLOW 2 EXTRA
MOVE N,Q.A(PTR)
IDIVI N,<BSIZE*5> ; NUMBER OF BLOCKS ALLOCATED
CAIG N,(UTIL)
JRST EXEND3
IMULI UTIL,<BSIZE*5>
MOVEM UTIL,Q.A(PTR)
EXEND3: MOVE N,Q.A(PTR)
IDIVI N,5
ADDI FLAG,(N) ; INCREMENT DOWN POINTER BY WORDS ALLOCATED
ADDI PTR,PBLOCK
CAIE PTR,E.B
JRST EXEND1
MOVEM FLAG,ZU ; RESET GLOBAL USED POINTER
CAMN FLAG,ZW
JRST EXEND$
MOVE UTIL,ZW
SUBI FLAG,(UTIL)
CALLR GETCOR ; RECLAIM CORE
JRST .+1
EXEND$: MOVE N,EX..
MOVEM N,B.V
SKIPE EX%B
JRST INBEG
MOVE PTR,[C.B,,B.B]
CALLR EXQTOQ
JRST INBEG
JRST INBEG
EXNEXT: CALLR EXCHAR ; GET A CHAR AND DISPATCH
EXNEX0: HRRZ UTIL,DISPCH(CH)
JRST (UTIL)
EX$A: TRNE FLAG,-1
JRST EXER01
A$QREG
JUMPL FLAG,EXNEXT ; -- END PARSING
CAMN PTR,EX%Q
JRST EXER10
MOVEM PTR,E.B
ADDI PTR,1
MOVEM PTR,E.A
ADDI PTR,1
MOVEM PTR,E.Z
ADDI PTR,1
MOVEM PTR,E.P
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$B: TRNE FLAG,-1
JRST EXER01
SETOM EX%B
A$QREG
JUMPL FLAG,EXNEXT ; -- END PARSING
CAMN PTR,EX%Q
JRST EXER10
SKIPG B.Z
JRST EXNEXT
CAME PTR,E.B
JRST EX$B1
HRRZI PTR,B.B
JRST EX$G0
EX$B1: HRLI PTR,B.B
CALLR EXQTOQ
JRST EXERER
MOVE N,B.V
MOVEM N,Q.V(PTR)
JRST EXNEXT
EX$C: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER01
A$INT <1>
A$$END ; -- END PARSING
MOVE N,@E.P
ADD N,V1
CAIGE N,0 ; (IF <N> < 0 THEN . GETS 0)
SETZ N,
CAMLE N,@E.Z ; (IF <N> > Z THEN . GETS Z)
MOVE N,@E.Z
MOVEM N,@E.P ; SET .
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$D: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER01
A$INT <1>
A$$END ; -- END PARSING
JUMPE V1,EXNEXT
JUMPG V1,EX$D2
MOVN N,V1 ; -<N>D
MOVE V1,@E.P
JUMPE V1,EXNEXT
SUB V1,N ; CALCULATE NEW . (OLD - DELETION)
JUMPGE V1,EX$D1
MOVE N,@E.P
SETZ V1, ; (IF <N> > . THEN <N> GETS . AND . GETS 0)
EX$D1: MOVEM V1,@E.P
CALLR EXEBC ; DELETE TEXT
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$D2: MOVE N,V1
MOVE V1,@E.Z
SUB V1,@E.P
CAMLE N,V1
MOVE N,V1 ; (IF <N> > Z-. THEN <N> GETS Z-.)
CALLR EXEBC ; DELETE TEXT
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$E$: CALLR EXCHAR
LETEST (E,HALT)
LETEST (G,EX$EW)
LETEST (N,EX$EN)
LETEST (P,EX$EP)
LETEST (R,EX$ER)
LETEST (W,EX$EW)
LETEST (X,EX$EW)
JRST EXER03
EX$F$: CALLR EXCHAR
LETEST (A,EX$FA)
LETEST (B,EX$FB)
LETEST (C,EX$FC)
LETEST (D,EX$FD)
LETEST (G,EX$FG)
LETEST (I,EX$FI)
LETEST (M,EX$FM)
LETEST (N,EX$FN)
LETEST (O,EX$FO)
LETEST (P,EX$FP)
LETEST (Q,EX$FQ)
LETEST (S,EX$FS)
LETEST (T,EX$FT$)
LETEST (V,EX$FV)
LETEST (W,EX$FW)
LETEST (X,EX$FP)
JRST EXER05
EX$G: TRNE FLAG,-1
JRST EXER01
A$QREG
JUMPL FLAG,EXNEXT ; -- END PARSING
SKIPG Q.Z(PTR)
JRST EXER08
CAMN PTR,E.B
JRST EXER09
EX$G0: MOVE N,@E.P
MOVEM N,EX.I
MOVE N,Q.Z(PTR) ; N GETS LENGTH OF QREG TEXT
JUMPE N,EXNEXT
CALLR ABORTI
CALLR EXEBIS
CALLR EXEBE ; EXPAND EB
HRR M,Q.B(PTR)
HRLI M,440700
CALLR EXEBIT
CALLR ABORTE
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$H: TRNE FLAG,-1
JRST EXER02
TRO FLAG,F$V1!F$V2
SETZ V1,
MOVE V2,@E.Z
JRST EXNEXT
EX$I: TRNE FLAG,F$V!F$PC!F$O
JRST EXER01
A$STR <1>
A$$END ; -- END PARSING
MOVE N,@E.P
MOVEM N,EX.I
MOVE N,EX%S1N ; N GETS SIZE OF INSERT
MOVE M,EX%S1P ; M POINTS TO INSERT TEXT
JUMPE N,EXNEXT
CALLR ABORTI
CALLR EXEBIP
CALLR EXEBE ; EXPAND EB
CALLR EXEBIT
CALLR ABORTE
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$J: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER01
A$INT <0>
A$$END ; -- END PARSING
CAIGE V1,0 ; (IF <N> < 0 THEN . GETS 0)
SETZ V1,
CAMLE V1,@E.Z ; (IF <N> > Z THEN . GETS Z)
MOVE V1,@E.Z
MOVEM V1,@E.P ; SET .
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$K: TRNE FLAG,F$VC!F$PA!F$PS
JRST EXER01
A$INT <1>
A$$END ; -- END PARSING
CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
EX$K0: JUMPE V2,EXNEXT
MOVE M,@E.P
MOVEM V1,@E.P
MOVE N,V2
CALLR EXEBC ; DELETE TEXT
TRNN UTIL,F$V2
JRST EX$K3 ; IF <N>K (LINE-BASED) THEN SKIP . CONCERNS
MOVE N,V1
ADD N,V2
CAMGE M,V1
JRST EX$K1
CAMLE M,N
JRST EX$K2
JRST EX$K3 ; IF V1 <= . <= V1+V2 THEN . GETS V1
EX$K1: MOVEM M,@E.P
JRST EX$K3 ; IF . < V1 THEN . IS UNCHANGED
EX$K2: SUB M,V2
MOVEM M,@E.P ; IF V1+V2 < . THEN . GETS .-V2
EX$K3: CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$L: TRNE FLAG,F$VC!F$V2!F$PA!F$PS
JRST EXER01
A$INT <1>
A$$END ; -- END PARSING
CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
CAML V1,@E.P ; (IF <N> <= 0 THEN MOVE BACK)
ADD V1,V2 ; (IF <N> > 0 THEN MOVE FORWARD)
MOVEM V1,@E.P ; SET .
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$M: A$QREG
JUMPL FLAG,EXNEXT ; -- END PARSING
SKIPG N,Q.Z(PTR)
JRST EXER08
CAMN PTR,E.B
JRST EXER09
HLRO UTIL,ENVIR
CAML UTIL,[-5]
JRST EXER15
PUSH ENVIR,FLAG ; SAVE FLAGS
PUSH ENVIR,LEVEL ; SAVE ITERATION LEVEL
PUSH ENVIR,EX%PTR ; SAVE COMMAND POINTER
PUSH ENVIR,EX%N ; SAVE COMMAND COUNT
PUSH ENVIR,EX%Q ; SAVE INDEX OF OLD EXECUTING QREG (IF ANY)
PUSH ENVIR,@EX%Q ; SAVE TEXT POINTER OF OLD QREG
HRRZM PTR,EX%Q
HRR UTIL,Q.B(PTR)
HRLI UTIL,440700
MOVEM UTIL,EX%PTR
MOVEM N,EX%N
SETZ LEVEL,
TLO FLAG,F$EM ; SET UP NEW EXECUTING QREG
JRST EXNEXT
EX$N: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER01
A$INT <1>
A$$END ; -- END PARSING
JUMPE V1,EXNEXT
CALLR EXWORD ; PRODUCE STARTING POSITION AND LENGTH
CAML V1,@E.P ; (IF <N> < 0 THEN MOVE BACK)
ADD V1,V2 ; (IF <N> > 0 THEN MOVE FORWARD)
MOVEM V1,@E.P ; SET .
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$O: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER01
A$INT <1>
A$$END ; -- END PARSING
JUMPE V1,EXNEXT
CALLR EXWORD ; PRODUCE STARTING POSITION AND LENGTH
JUMPE V2,EXNEXT
MOVEM V1,@E.P
MOVE N,V2
CALLR EXEBC ; DELETE TEXT
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$P: TRNE FLAG,F$VC!F$PA!F$PS
JRST EXER01
EX$P0: MOVEM CH,EX%CH
A$INT <1>
A$QREG
A$$END ; -- END PARSING
CAMN PTR,E.B
JRST EXER09
CAMN PTR,EX%Q
JRST EXER10
CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
JUMPE V2,EXNEXT
TRNE UTIL,F$VC
JRST EX$P1
SETZM Q.P(PTR) ; IF P-X THEN ZERO QREG'S OLD CONTENTS
SETZM Q.Z(PTR)
EX$P1: HRRZI M,(PTR)
MOVE N,V2
ADD N,Q.Z(M) ; N GETS NEW QREG LENGTH
CAMG N,Q.A(M)
JRST EX$P2
MOVE PTR,N ; ALLOCATE QREG SPACE FOR PUT
SUB PTR,Q.A(M)
HRLI PTR,(PTR)
HRRI PTR,(M)
CALLR ALLOC
JRST EXERER
EX$P2: CALLR ABORTI
HRRZI PTR,(M)
MOVN N,V2
CALLR EXEBE ; EXPAND QREG TEXT TO MAKE ROOM FOR PUT
MOVE N,Q.P(M)
HRRZI PTR,(M)
CALLR EXBPQ ; SET UP DESTINATION BYTE POINTER
MOVE N,PTR
MOVE PTR,V1
CALLR EXBPE ; SET UP SOURCE BYTE POINTER
PUSH STACK,V2
EX$P3: ILDB CH,PTR
IDPB CH,N ; MOVE TEXT INTO QREG
SOJG V2,EX$P3
POP STACK,V2
TRNE UTIL,F$VC
ADDM V2,Q.P(M) ; UPDATE . IN QREG
CALLR ABORTE
MOVE CH,EX%CH
LETEST (X,EX$K0)
CALLR EXAV ; (IMPLICIT V FOR P)
JRST EXNEXT
EX$Q: TRNE FLAG,F$P
JRST EXER01
MOVEI UTIL,(CH)
A$QREG
TLNN FLAG,F$EI
MOVE N,Q.V(PTR)
MOVEI CH,(UTIL)
CALLR EXVALS ; PRODUCE VALUE ARG
JRST EXER01
JRST EXNEXT
EX$R: TRNE FLAG,F$VC!F$V2!F$PC
JRST EXER01
EX$R0S: A$INT <1>
A$STR <2>
A$$END ; -- END PARSING
EX$R0D: MOVE N,@E.P
MOVEM N,EX.B
JUMPE V1,EXNEXT
MOVE N,EX%S1N
JUMPN N,EX$R1
MOVE N,S.Z ; USE EXISTING SEARCH STRING
JUMPE N,EX$R2 ; (IF ANY)
SOJA N,EX$R2 ; (ACCOUNT FOR FINAL -1)
EX$R1: MOVE M,EX%S2P
CALLR EXQSB
MOVE V2,PTR
MOVE PTR,EX%S1P
TRNE UTIL,F$PS
IBP PTR
CALLR EXSBI ; MOVE SEARCH STRING INTO SEARCH BUFFER
MOVE PTR,V2
CALLR EXQSA
MOVEM M,EX%S2P
EX$R2: JUMPG V1,EX$R2F
CALLR EXESB ; SEARCH BACKWARD
JRST EX$R3
EX$R2B: TRNE UTIL,F$VC
AOJA V1,EX$R2$
AOJE V1,EX$R4
CALLR EXAV ; (SHOW INTERMEDIATE RESULTS)
SUBM N,@E.P ; (MOVE . BACK TO AVOID STRING JUST FOUND)
MOVNS @E.P
CALLR EXESB
JRST .+2
JRST EX$R2B
ADDM N,@E.P
JRST EX$R3
EX$R2F: CALLR EXESF ; SEARCH FORWARD
JRST EX$R3
TRNE UTIL,F$VC
SOJA V1,EX$R2$
SOJE V1,EX$R4
CALLR EXAV ; (SHOW INTERMEDIATE RESULTS)
JRST EX$R2F
EX$R2$: PUSH STACK,N ; REPLACE EACH INSTANCE (FS AND FS)
JRST EX$R4
EX$R3: JUMPE LEVEL,EXER14
TLO FLAG,F$EI ; SEARCH FAILED
HRLI LEVEL,(LEVEL)
JRST EXNEXT
EX$R4: MOVE V2,@E.P
SUB V2,N
MOVEM V2,@E.P ; . GETS POSITION OF START OF FOUND STRING
MOVE V2,N
MOVE N,@E.P
MOVEM N,EX.I
MOVE N,EX%S2N
MOVE M,EX%S2P
CALLR ABORTI
SUB N,V2
JUMPE N,EX$R6 ; S STRING LENGTH = R STRING LENGTH
JUMPG N,EX$R5
MOVN N,N
CALLR EXEBC ; S STRING LENGTH > R STRING LENGTH (CONTRACT)
JRST EX$R6
EX$R5: CALLR EXEBIP
EX$R5$: CALLR EXEBE ; S STRING LENGTH < R STRING LENGTH (EXPAND)
EX$R6: SKIPE N,EX%S2N
CALLR EXEBIT
CALLR ABORTE
CALLR EXAV ; (IMPLICIT V)
TRNN UTIL,F$VC
JRST EXNEXT
POP STACK,N
JUMPN V1,EX$R2
JRST EXNEXT
EX$S: TRNE FLAG,F$VC!F$V2!F$PC
JRST EXER01
EX$S0: A$INT <1>
A$STR <1>
MOVE UTIL,FLAG
TRZ FLAG,-1 ; S SEARCH LEAVES NO ARGS
TRNE UTIL,F$VC
TRO FLAG,F$V1 ; FN SEARCH PRODUCES VALUE
JUMPL FLAG,EXNEXT ; -- END PARSING
MOVE N,@E.P
MOVEM N,EX.B
JUMPE V1,EXNEXT
MOVE N,EX%S1N ; N GETS SIZE OF STRING
MOVE PTR,EX%S1P ; PTR GETS POINTER TO STRING
TRNE UTIL,F$PS
IBP PTR ; (IGNORE / DELIMITER)
CALLR EXSBI ; MOVE STRING INTO SEARCH BUFFER
JUMPG V1,EX$S2
JUMPN N,EX$S1
SKIPE N,S.Z ; (USE DEFAULT STRING LENGTH FOR MOVING .)
SUBI N,1
EX$S1: SUBM N,@E.P ; (MOVE . BACK TO AVOID REPEATED MATCHING)
MOVNS @E.P
CALLR EXESB ; SEARCH BACKWARD
JRST EX$S1$
CALLR EXAV ; (IMPLICIT V)
AOJE V1,EXNEXT ; <N> TIMES
JRST EX$S1
EX$S1$: ADDM N,@E.P
JRST EX$S3
EX$S2: CALLR EXESF ; SEARCH FORWARD
JRST EX$S3
CALLR EXAV ; (IMPLICIT V)
SOJG V1,EX$S2 ; <N> TIMES
JRST EXNEXT
EX$S3: SETO V1, ; SEARCH FAILED
TRNE UTIL,F$VC
JRST EXNEXT
JUMPE LEVEL,EXER14
TLO FLAG,F$EI ; (IF IN <> THEN INHIBIT FURTHER EXECUTION)
HRLI LEVEL,(LEVEL)
JRST EXNEXT
EX$T: TRNE FLAG,F$VC!F$PA!F$PS
JRST EXER01
A$INT <1>
A$$END ; -- END PARSING
CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
JUMPE V2,EXNEXT
MOVE PTR,V1
CALLR EXBPE
EX$T0: ILDB CH,PTR
CALLR EXBOUT ; OUTPUT TEXT
SOJG V2,EX$T0
JRST EXNEXT
EX$U: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER01
A$INT <0>
A$QREG
A$$END ; -- END PARSING
MOVEM V1,Q.V(PTR) ; SET QREG VALUE
JRST EXNEXT
EX$V: TRNE FLAG,F$VC!F$P!F$O
JRST EXER01
TRZN FLAG,F$V2
MOVE V2,EXPRIM
A$INT <1>
A$$END ; -- END PARSING
JUMPLE V1,EXNEXT
PUSH STACK,EXPRIM
MOVEM V2,EXPRIM
MOVE N,V1
MOVN V1,V1
ADDI V1,1
CALLR EXLINE ; -(N-1)T SUPPLIES POINTER + PARTIAL LENGTH
MOVE PTR,V1
MOVE V1,N
MOVE N,V2
MOVN M,N
CALLR EXLINE ; NT SUPPLIES REMAINDER OF LENGTH
ADD N,V2
ADD M,N
JUMPE N,EX$V3
CALLR EXBPE
EX$V1: CAME N,M
JRST EX$V2
SKIPN CH,EXVPTR
JRST EX$V2
CALLR TERMO ; OUTPUT POINTER SYMBOL
EX$V2: ILDB CH,PTR
CALLR EXBOUT ; OUTPUT TEXT
SOJG N,EX$V1
EX$V3: POP STACK,EXPRIM
JRST EXNEXT
EX$W: TRNE FLAG,F$P
JRST EXER01
MOVEI UTIL,(CH)
CALLR EXCHAR
LETEST (B,EX$WB)
LETEST (I,EX$WI)
LETEST (S,EX$WS)
MOVEI CH,(UTIL)
JRST EXER01
EX$WB: MOVE N,EX.B ; BEFORE-SEARCH VALUE
JRST EX$W0
EX$WI: MOVE N,EX.I ; INSERT-STRING-BEGINNING VALUE
JRST EX$W0
EX$WS: MOVE N,EX.S ; SEARCH-STRING-BEGINNING VALUE
EX$W0: MOVEI CH,(UTIL)
CALLR EXVALS ; PRODUCE VALUE ARG
JRST EXER01
JRST EXNEXT
EX$Z: TRNE FLAG,F$P
JRST EXER02
MOVE N,@E.Z
CALLR EXVALS ; PRODUCE Z VALUE
JRST EXER02
JRST EXNEXT
; @
EX$$A: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER02
TRO FLAG,F$PA
JRST EXNEXT
; ,
EX$$CA: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER02
TRO FLAG,F$VC
JRST EXNEXT
; :
EX$$CN: TRNE FLAG,-1
JRST EXER02
TRO FLAG,F$PC
JRST EXNEXT
; =
EX$$EQ: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER01
TRNN FLAG,F$V1
JRST EXER01
A$$END ; -- END PARSING
MOVE N,V1
MOVE M,EXBASE
CALLR M$I.S
TSOUT <M$I.SR,CRLF> ; OUTPUT VALUE STRING
JRST EXNEXT
; !
EX$$EX: TRNE FLAG,F$V!F$PC!F$O
JRST EXER01
CALLR EXSTRI ; ACCEPT (AND IGNORE) STRING ARG
TRZ FLAG,-1 ; LEAVE NO ARGS
JRST EXNEXT
; (TAB)
EX$$I: TRNE FLAG,F$PA!F$PS
JRST EXER01
MOVE PTR,EX%PTR
DBP <PTR> ; INCLUDE <TAB> IN INSERT STRING
MOVEM PTR,EX%PTR
AOS EX%N
JRST EX$I
; < AND [
EX$$L: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER01
HRLOI N,377777 ; DEFAULT FOR < IS INFINITY
CAIN CH,"[" ; AND FOR [ IS 1
MOVEI N,1
CALLR EXVALU ; ACCEPT VALUE ARG
TRZ FLAG,-1 ; LEAVE NO ARGS
ADDI LEVEL,1 ; INCREMENT ITERATION LEVEL
HLRO UTIL,ENVIR
CAML UTIL,[-4]
JRST EXER15
PUSH ENVIR,EX%PTR ; SAVE COMMAND POINTER
SKIPE UTIL,EX%Q
MOVE UTIL,@EX%Q ; SAVE COMMAND QREG POINTER
PUSH ENVIR,UTIL
PUSH ENVIR,EX%N ; SAVE COMMAND COUNT
PUSH ENVIR,V1 ; SAVE ITERATION COUNT
JUMPL FLAG,EXNEXT ; -- END PARSING
JUMPG V1,EXNEXT ; IF COUNT NOT POSITIVE THEN INHIBIT
TLO FLAG,F$EI ; BY SETTING FLAG
HRLI LEVEL,(LEVEL) ; AND INTERATION LEVEL
JRST EXNEXT
; -
EX$$M: TRNE FLAG,F$P!F$O
JRST EXER02
TRO FLAG,F$OS
JRST EXNEXT
; +
EX$$P: TRNE FLAG,F$P!F$O
JRST EXER01
TRO FLAG,F$OA
JRST EXNEXT
; ?
EX$$Q: TRNE FLAG,-1
JRST EXER01
JUMPL FLAG,EXNEXT
SETO UTIL,
XORM UTIL,EXDBUG
JRST EXNEXT
; > AND ]
EX$$R: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER01
MOVEI V2,(LEVEL)
JUMPE V2,EXER13
SUBI LEVEL,1
JUMPGE FLAG,EX$$R0
POP ENVIR,UTIL ; EXECUTION INHIBITED
POP ENVIR,UTIL
POP ENVIR,UTIL
POP ENVIR,UTIL
HLRZ UTIL,LEVEL
CAIE UTIL,(V2) ; IF PROPER LEVEL THEN
JRST EXNEXT
TLZ FLAG,F$EI ; CLEAR INHIBIT STATUS
TLZ LEVEL,-1 ; AND LEVEL
JRST EXNEXT
EX$$R0: POP ENVIR,V2
POP ENVIR,N
POP ENVIR,M
POP ENVIR,PTR
SOJLE V2,EXNEXT ; ITERATE NO LONGER
PUSH ENVIR,PTR
PUSH ENVIR,M
PUSH ENVIR,N
PUSH ENVIR,V2
MOVEM PTR,EX%PTR
MOVEM N,EX%N
SKIPN EX%Q ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
AOJA LEVEL,EXNEXT
EXQPTR <M>
AOJA LEVEL,EXNEXT ; ITERATE AGAIN
; /
EX$$S: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER02
TRO FLAG,F$PS
JRST EXNEXT
; ;
EX$$$S: TRNE FLAG,F$VC!F$O
JRST EXER01
TRZ FLAG,-1 ; LEAVE NO ARGS
JRST EXNEXT
; 0 THROUGH 9
EX$0: TRNE FLAG,F$P
JRST EXER02
MOVE N,EXBASE
CAIN CH,"0"
MOVEI N,10 ; (INTEGERS THAT BEGIN WITH 0 ARE OCTAL)
MOVE PTR,EX%PTR
MOVEM CH,EX%CH
EX$0$1: CAIL CH,"0" ; PASS OVER INTEGER STRING
CAILE CH,"9"
JRST EX$0$2
CALLR EXCHAR
JRST EX$0$1
EX$0$2: JUMPL FLAG,EX$0$3
MOVE CH,EX%CH
CALLR M$S.I ; ACCEPT INTEGER
JRST EXER12
EX$0$3: CALLR EXVALS ; PRODUCE VALUE
JRST EXER02
JRST EXNEX0
EX$%: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER01
A$INT <1>
A$QREG
A$$END ; -- END PARSING
ADDM V1,Q.V(PTR) ; ADD TO QREG VALUE
JRST EXNEXT
EX$.: TRNE FLAG,F$P
JRST EXER02
MOVE N,@E.P
CALLR EXVALS ; PRODUCE . VALUE
JRST EXER02
JRST EXNEXT
EX$EN: TRNE FLAG,F$V!F$PC!F$O
JRST EXER04
A$STR <1>
A$$END ; -- END PARSING
MOVE N,EX%S1N
JUMPN N,EX$EN1
SETZM IOLAST ; CLEAR LAST NAME
JRST EXNEXT
EX$EN1: MOVE M,EX%S1P
TRNE UTIL,F$PS
IBP M
MOVE FLAG,N
SKIPG N
MOVN N,N
MOVE PTR,[440700,,IOLAST]
EX$EN2: ILDB CH,M
IDPB CH,PTR ; MOVE TEXT INTO LAST NAME BUFFER
SOJG N,EX$EN2
SETZ CH,
IDPB CH,PTR
JRST EXNEXT
EX$EP: TRNE FLAG,F$V!F$PC!F$O
JRST EXER04
A$QREG
MOVEM CH,EX%CH
A$STR <1>
A$$END ; -- END PARSING
MOVE CH,EX%CH
CAMN PTR,EX%Q
JRST EXER10
MOVN N,EX%S1N
MOVE M,EX%S1P
CALLR EXFILE
CAME PTR,E.B
JRST EX$EP0
CALLR IO$ER ; READ FILE INTO QREG CURRENTLY BEING EDITED
JRST EXERER
JRST EXNEXT
EX$EP0: SETZM Q.P(PTR) ; ZERO QREG'S OLD CONTENTS
SETZM Q.Z(PTR)
MOVE UTIL,E.B
MOVEM PTR,E.B ; SET EDIT BUFFER TO QREG
ADDI PTR,1
MOVEM PTR,E.A
ADDI PTR,1
MOVEM PTR,E.Z
ADDI PTR,1
MOVEM PTR,E.P
MOVE PTR,UTIL
CALLR IO$ER ; READ FILE
SETZ UTIL,
MOVEM PTR,E.B ; RESET EDIT BUFFER
ADDI PTR,1
MOVEM PTR,E.A
ADDI PTR,1
MOVEM PTR,E.Z
ADDI PTR,1
MOVEM PTR,E.P
JUMPE UTIL,EXERER
JRST EXNEXT
EX$ER: TRNE FLAG,F$V!F$PC!F$O
JRST EXER04
A$STR <1>
A$$END ; -- END PARSING
MOVE N,EX%S1N
MOVE M,EX%S1P
CALLR EXFILE ; PRODUCE FILE NAME
CALLR IO$ER ; READ FILE
JRST EXERER
JRST EXNEXT
EX$EW: TRNE FLAG,F$V!F$PC!F$O
JRST EXER04
MOVEM CH,EX%CH
A$STR <1>
A$$END ; -- END PARSING
MOVE N,EX%S1N
MOVE M,EX%S1P
CALLR EXFILE ; PRODUCE FILE NAME
CALLR IO$EW ; WRITE FILE
JRST EXERER
MOVE CH,EX%CH
LETEST (G,HALTGO)
LETEST (X,HALT)
JRST EXNEXT
EX$FA: TRNE FLAG,F$VC!F$P!F$O
JRST EXER06
TRNN FLAG,F$V1
JRST EXER06
TRZN FLAG,F$V2
JRST EXER06
MOVEI UTIL,(CH)
CALLR EXCHAR
LETEST (D,EX$FAD)
LETEST (M,EX$FAM)
LETEST (R,EX$FAR)
MOVEI CH,(UTIL)
JRST EXER06
EX$FAD: IDIV V1,V2 ; DIVIDE
JRST EXNEXT
EX$FAM: IMUL V1,V2 ; MULTIPLY
JRST EXNEXT
EX$FAR: IDIV V1,V2
MOVE V1,V2 ; REMAINDER
JRST EXNEXT
EX$FB: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER06
A$INT <^D10>
A$$END ; -- END PARSING
CAIG V1,1 ; (IF <N> < 2 THEN BASE GETS 10)
MOVEI V1,^D10
CAIL V1,^D11 ; (IF <N> > 10 THEN BASE GETS 10)
MOVEI V1,^D10
MOVEM V1,EXBASE ; SET BASE
JRST EXNEXT
EX$FC: TRNE FLAG,F$VC!F$P!F$O
JRST EXER06
TRNN FLAG,F$V1
MOVEI V1,0 ; DEFAULT TEST VALUE IS 0
TRNN FLAG,F$V2
MOVEI V2,1 ; DEFAULT NUMBER OF LEVELS TO RETURN IS 1
TRZ FLAG,-1 ; LEAVE NO ARGS
MOVEI UTIL,(CH)
CALLR EXCHAR
LETEST (E,EX$FCE)
LETEST (N,EX$FCN)
LETEST (G,EX$FCG)
LETEST (L,EX$FCL)
MOVEI CH,(UTIL)
JRST EXER06
EX$FCE: JUMPE V1,EX$FC0 ; <N> = 0
JRST EXNEXT
EX$FCN: JUMPN V1,EX$FC0 ; <N> # 0
JRST EXNEXT
EX$FCG: JUMPG V1,EX$FC0 ; <N> > 0
JRST EXNEXT
EX$FCL: JUMPL V1,EX$FC0 ; <N> < 0
JRST EXNEXT
EX$FC0: JUMPL FLAG,EXNEXT
TLO FLAG,F$EI ; INHIBIT EXECUTION IF TEST SUCCEEDED
MOVEI V1,(LEVEL)
SUBI V1,-1(V2)
SKIPGE V1
MOVEI V1,0
HRLI LEVEL,(V1)
JRST EXNEXT
EX$FD: TRNE FLAG,F$VC!F$V2!F$PC
JRST EXER06
TRO FLAG,F$VC ; INDICATE FD-FS REPLACE
A$INT <1>
A$STR <1>
A$$END ; -- END PARSING
SETZM EX%S2N ; ZERO REPLACE ARGS
SETZM EX%S2P
JRST EX$R0D
EX$FG: TRNE FLAG,-1
JRST EXER06
TRO FLAG,F$PA
JRST EX$FTS
EX$FI: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER06
A$INT <" ">
A$$END ; -- END PARSING
MOVEI N,1
CALLR ABORTI
CALLR EXEBIS
CALLR EXEBE ; EXPAND EB
MOVE PTR,@E.P
AOS @E.P ; INCREMENT .
CALLR EXBPE
IDPB V1,PTR ; INSERT CHARACTER
CALLR ABORTE
CALLR EXAV ; (IMPLICIT V)
JRST EXNEXT
EX$FM: TRNE FLAG,-1
JRST EXER06
A$QREG
HRRZI UTIL,(PTR)
A$QREG
JUMPL FLAG,EXNEXT ; -- END PARSING
CAMN PTR,E.B
JRST EXER09
CAMN PTR,EX%Q
JRST EXER10
HRLI PTR,(UTIL)
CALLR EXQTOQ
JRST EXERER
JRST EXNEXT
EX$FN: TRNE FLAG,F$VC!F$V2!F$PC
JRST EXER06
TRO FLAG,F$VC ; INDICATE FN SEARCH
JRST EX$S0
EX$FO: TRNE FLAG,F$P
JRST EXER06
JUMPL FLAG,EX$FO0
MOVE N,@E.Z
SUB N,@E.P
JUMPE N,EX$FO0
MOVE PTR,@E.P
CALLR EXBPE
ILDB N,PTR ; GET CHAR AT EP+1 FROM EB
EX$FO0: CALLR EXVALS ; PRODUCE CHAR VALUE
JRST EXER06
JRST EXNEXT
EX$FP: TRNE FLAG,F$VC!F$PA!F$PS
JRST EXER06
TRO FLAG,F$VC ; INDICATE FP-FX
JRST EX$P0
EX$FQ: TRNE FLAG,-1
JRST EXER06
JUMPL FLAG,EXNEXT ; -- END PARSING
MOVEI PTR,Q.0
EX$FQ1: CAMN PTR,E.B
JRST EX$FQ2
SKIPN Q.A(PTR)
JRST EX$FQ4
EX$FQ2: TSOUT <[ASCIZ/In /]>
CALLR QNOUT
CAME PTR,E.B
JRST EX$FQ3
TSOUT <[ASCIZ/ (now being edited)/]>
EX$FQ3: TSOUT <[ASCIZ/ . is /]>
MOVEI M,^D10
MOVE N,Q.P(PTR)
CALLR M$I.S
TSOUT <M$I.SR,<[ASCIZ/ and Z is /]>>
MOVE N,Q.Z(PTR)
CALLR M$I.S
TSOUT <M$I.SR,[ASCIZ/./],CRLF>
EX$FQ4: ADDI PTR,PBLOCK
CAIE PTR,E.B
JRST EX$FQ1
JRST EXNEXT
EX$FS: TRNE FLAG,F$VC!F$V2!F$PC
JRST EXER06
TRO FLAG,F$VC ; INDICATE FD-FS REPLACE
JRST EX$R0S
EX$FT$: MOVEI UTIL,(CH)
CALLR EXCHAR
LETEST (E,EX$FTE)
LETEST (I,EX$FTI)
LETEST (M,EX$FTM)
LETEST (O,EX$FTO)
LETEST (S,EX$FTS)
MOVEI CH,(UTIL)
JRST EXER06
EX$FTE: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER06
A$INT <1>
A$$END ; -- END PARSING
JUMPL V1,EX%FTE
SKIPL FLAGED
JRST EXNEXT
SETZM FLAGED
IFL F.SYS,<
OPEN 0,[ OPECHO
SIXBIT /TTY/
0]
JRST EXNEXT
>; TOPS-10
IFG F.SYS,<
MOVEI X1,100
RFMOD
TRZ X2,776000 ; CLEAR WAKE UP AND ECHOING
TRO X2,144300 ; WAKE UP ON ^ CHARS, ECHO, OUTPUT ^ CHARS
SFMOD
SETZ X2,
SETZ X3,
SFCOC ; IGNORE ALL CONTROL CHARACTERS (INPUT ONLY)
>; TENEX
JRST EXNEXT
EX%FTE: SETOM FLAGED
IFL F.SYS,<
RELEAS 0,
>; TOPS-10
IFG F.SYS,<
MOVEI X1,100
MOVE X2,TMOD
CAME V1,[-2]
JRST .+3
TRZ X2,4000
TRO X2,2000
SFMOD
MOVE X2,TCOC1
MOVE X3,TCOC2
SFCOC
>; TENEX
JRST EXNEXT
EX$FTI: TRNE FLAG,F$P
JRST EXER06
JUMPL FLAG,EX%FTI
IFL F.SYS,<
IFE F.HARV,< TBIN <CH>>
IFN F.HARV,< INCHRW CH>
>; TOPS-10
IFG F.SYS,<
MOVEI X1,100
RFMOD
MOVEM X2,UTIL
TRO X2,170000
SFMOD
TBIN <CH>
MOVEI X1,100
MOVE X2,UTIL
SFMOD
>; TENEX
CAIN CH,7
CALLR TERME
CAIN CH,11
CALLR TERME
CAIN CH,12
CALLR TERME
CAIN CH,15
CALLR TERME
CAIN CH,33
CALLR TERME
CAIN CH,37
CALLR TERME
CAIL CH," "
CAIN CH,177
JRST .+2
CALLR TERME
MOVEI N,(CH)
EX%FTI: CALLR EXVALS ; PRODUCE CHAR VALUE
JRST EXER06
JRST EXNEXT
EX$FTM: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER06
A$INT <1>
A$$END ; -- END PARSING
CAILE V1,2
MOVEI V1,2
MOVEM V1,EXPRIM ; SET <N> FOR PRINT MODE
JRST EXNEXT
EX$FTO: TRNE FLAG,F$VC!F$P!F$O
JRST EXER06
TRZN FLAG,F$V2
MOVE V2,EXPRIM
A$INT <" ">
A$$END ; -- END PARSING
MOVE UTIL,EXPRIM
MOVEM V2,EXPRIM
MOVEI CH,(V1)
CALLR EXBOUT ; OUTPUT CHAR
MOVEM UTIL,EXPRIM
JRST EXNEXT
EX$FTS: TRNE FLAG,F$VC!F$V2!F$PC!F$O
JRST EXER06
TRZN FLAG,F$V1
MOVE V1,EXPRIM
A$STR <1>
A$$END ; -- END PARSING
MOVE V2,EXPRIM
MOVEM V1,EXPRIM
MOVE N,EX%S1N
MOVE M,EX%S1P
JUMPE N,EXNEXT
TRNE UTIL,F$PS
IBP M
EX%FTS: ILDB CH,M
CALLR EXBOUT ; OUTPUT STRING
SOJG N,EX%FTS
MOVEM V2,EXPRIM
JRST EXNEXT
EX$FV: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER06
A$INT <"~">
A$$END ; -- END PARSING
MOVEM V1,EXVPTR ; SET POINTER SYMBOL
JRST EXNEXT
EX$FW: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER06
A$INT <0>
A$$END ; -- END PARSING
SKIPGE V1 ; (IF <N> < 0 THEN EXVSIZ GETS 0)
SETZ V1,
MOVEM V1,EXVSIZ ; SET <N> FOR AUTOMATIC V
JRST EXNEXT
EXCHAR: BEGINR
EXCH1: SOSGE EX%N
JRST EXCH2
ILDB CH,EX%PTR
JUMPL FLAG,RETN(0)
SKIPE EXDBUG
CALLR TERMV
RETURN
EXCH2: JUMPN LEVEL,EXER13
TLNN FLAG,F$EM
JRST EXCH3
POP ENVIR,N
POP ENVIR,EX%Q
POP ENVIR,EX%N
POP ENVIR,EX%PTR
POP ENVIR,LEVEL
POP ENVIR,UTIL
HLL FLAG,UTIL
TLNN FLAG,F$EM ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
JRST EXCH1
EXQPTR <N>
JRST EXCH1
EXCH3: MOVE STACK,[IOWD SSIZE,STACKB]
POPJ ENVIR, ; IF NOT EXECUTING A MACRO THEN RETURN
ENDR
; TRANSLATE CHARACTER INTO QREG POINTER
; OUT: CH -- QREG CHARACTER
; PTR -- POINTER TO QREG
;
EXQREG: BEGINR
SKIPE EX%PTR
CALLR EXCHAR
CAIN CH,"*"
JRST EXQRE0
MOVEI PTR,(CH)
CAIGE CH,"0"
JRST EXER07
CAIG CH,"9"
JRST EXQRE1
CAIGE CH,"A"
JRST EXER07
CAIG CH,"Z"
JRST EXQRE3
CAIGE CH,"A"+40
JRST EXER07
CAIG CH,"Z"+40
JRST EXQRE2
JRST EXER07
EXQRE0: MOVEI PTR,Q.$
RETURN
EXQRE1: SUBI PTR,"0" ; NUMBERED QREGS (0-9)
IMULI PTR,PBLOCK
ADDI PTR,Q.0
RETURN
EXQRE2: SUBI PTR,40
EXQRE3: SUBI PTR,"A" ; LETTERED QREGS (10-36)
ADDI PTR,^D10
IMULI PTR,PBLOCK
ADDI PTR,Q.0
ENDR
; PARSE STRING ARGUMENT
; OUT: CH -- TERMINATING CHARACTER
; N -- LENGTH OF STRING
; M -- POINTER TO BEGINNING OF STRING
;
EXSTRI: BEGINR <PTR,UTIL>
TRNE FLAG,F$PA
JRST EXSTR4
SETZ N,
MOVE M,EX%PTR
PUSH STACK,EXDBUG
SETZM EXDBUG
MOVEI UTIL,33 ; DEFAULT TERMINATOR IS ESCAPE
TRNN FLAG,F$PS
JRST EXSTR1
CALLR EXCHAR ; / -- GET EXPLICIT TERMINATOR
CAIN CH,33 ; IF IT IS ESCAPE THEN QUIT
JRST EXSTR3
MOVEI UTIL,(CH)
EXSTR1: TRNE FLAG,F$EM
JRST EXSTR2
SKIPN EX%N
JRST EXER11
EXSTR2: CALLR EXCHAR ; PASS OVER STRING
CAIN CH,(UTIL)
JRST EXSTR3 ; UNTIL TERMINATOR IS REACHED
AOJA N,EXSTR1
EXSTR3: POP STACK,EXDBUG
RETURN
EXSTR4: CALLR EXQREG ; @ -- GET QREG
JUMPL FLAG,RETN(0)
SKIPG Q.Z(PTR)
JRST EXER08
CAMN PTR,E.B
JRST EXER09
HRR M,(PTR) ; SET UP POINTER
HRLI M,440700
MOVE N,2(PTR) ; AND COUNT
ENDR
; USE NUMERIC ARGUMENTS -- SUPPLY DEFAULTS
; IN: N -- DEFAULT VALUE FOR V1
; OUT: V1 IF DEFAULT, FLAG UPDATED
;
EXVALU: BEGINR
TRNE FLAG,F$V1
RETURN
TRNN FLAG,F$V2
JRST EXVAU0
MOVEI CH,","
JRST EXER02
EXVAU0: TRNE FLAG,F$OA
MOVEI V1,1
TRNE FLAG,F$OS
MOVNI V1,1
TRZN FLAG,F$O
MOVE V1,N
TRO FLAG,F$V1
ENDR
; SET NUMERIC ARGUMENTS -- APPLY OPERAND AND OPERATOR TO V1 OR V2
; IN: N -- OPERAND (OPERATOR FROM FLAG)
; OUT: V1 OR V2 UPDATED
; FLAG UPDATED
;
EXVALS: BEGINR
TRNN FLAG,F$V1!F$VC!F$V2
JRST EXVAS1 ; NO VALUE -- INITIALIZE V1
TRNE FLAG,F$VC
JRST EXVAS2 ; COMMA -- INITIALIZE V2
TRNN FLAG,F$O
RETURN ; ERROR IF V1 OR V2 AND NO OPERATOR
JRST EXVAS3
EXVAS1: TRO FLAG,F$V1 ; FIRST V1
SETZ V1,
JRST EXVAS3
EXVAS2: TRZ FLAG,F$VC
TRO FLAG,F$V2 ; FIRST V2
SETZ V2,
EXVAS3: JUMPL FLAG,EXVAS5
TRNE FLAG,F$V2
JRST EXVAS4
TRNN FLAG,F$OS ; OPERATE ON V1
ADD V1,N
TRNE FLAG,F$OS
SUB V1,N
JRST EXVAS5
EXVAS4: TRNN FLAG,F$OS ; OPERATE ON V2
ADD V2,N
TRNE FLAG,F$OS
SUB V2,N
EXVAS5: TRZ FLAG,F$O
ENDR SKIP,1
; EXARGE -- END ARGUMENT PROCESSING
;
EXARGE: BEGINR
MOVE UTIL,FLAG ; SAVE FLAGS
TRZ FLAG,-1 ; LEAVE NO ARGS
JUMPL FLAG,RETN(0) ; -- EXECUTION INHIBITED
ENDR SKIP,1
; LINE FINDER
; IN: UTIL -- FLAGS
; V1
; V2
; OUT: V1 -- FIRST CHARACTER NUMBER
; V2 -- LENGTH OF STRING
;
EXLINE: BEGINR <CH,PTR,N,M>
TRNE UTIL,F$PC
JRST EXLINC ; :
TRNE UTIL,F$V2
JRST EXLINT ; TWO VALUES
JUMPG V1,EXLINF
MOVN M,V1 ; BACKWARD SEARCH
MOVE V1,@E.P
MOVE V2,@E.P ; DEFAULT VALUES ARE .
JUMPE V2,RETN(0)
MOVE PTR,V1
CALLR EXBPE
EXLIB1: LDB CH,PTR
CAIN CH,12
JRST EXLIB3
CAIN CH,37
JRST EXLIB3
EXLIB2: DBP <PTR>
SOJG V1,EXLIB1
RETURN
EXLIB3: SOJGE M,EXLIB2
SUB V2,V1 ; LENGTH IS . - BACKED OVER CHARS
RETURN
EXLINF: MOVE M,V1 ; FORWARD SEARCH
MOVE V1,@E.P
MOVE V2,@E.Z
SUB V2,@E.P ; DEFAULT VALUES ARE . AND Z - .
MOVE N,V2
MOVE PTR,V1
CALLR EXBPE
EXLIF1: SOJLE N,RETN(0)
ILDB CH,PTR
CAIN CH,12
JRST EXLIF2
CAIN CH,37
JRST EXLIF2
JRST EXLIF1
EXLIF2: SOJG M,EXLIF1
SUB V2,N ; LENGTH IS Z - . - NUMBER OF CHARS LEFT
RETURN
EXLINC: MOVE V1,@E.P ; :
MOVE V2,@E.Z
SUB V2,@E.P ; DEFAULT VALUES ARE . AND Z - .
JUMPE V2,RETN(0)
MOVE N,V2
MOVE PTR,V1
CALLR EXBPE
EXLIC1: ILDB CH,PTR
CAIN CH,12
JRST EXLIC2
CAIN CH,15
JRST EXLIC2
CAIN CH,37
JRST EXLIC2
SOJG N,EXLIC1
RETURN
EXLIC2: SUB V2,N ; LENGTH IS Z - . - NUMBER OF CHARS LEFT
RETURN
EXLINT: CAIGE V1,0 ; <M>,<N>
MOVEI V1,0
CAMLE V1,@E.Z
MOVE V1,@E.Z
CAMGE V2,V1
MOVE V2,V1
CAMLE V2,@E.Z
MOVE V2,@E.Z
SUB V2,V1
ENDR
; WORD FINDER
; IN: V1
; OUT: V1 -- FIRST CHARACTER NUMBER
; V2 -- LENGTH OF STRING
;
EXWORD: BEGINR <CH,PTR,N,M,FLAG>
JUMPG V1,EXWOF0
MOVN M,V1 ; BACKWARD SEARCH
MOVE V1,@E.P
MOVE V2,@E.P ; DEFAULT VALUES ARE .
JUMPE V2,RETN(0)
SETZ FLAG,
MOVE PTR,V1
CALLR EXBPE
JRST EXWOB$
EXWOB1: JUMPE V1,RETN(0)
DBP <PTR>
EXWOB$: LDB CH,PTR ; GET A CHAR AND DETERMINE ITS TYPE
CALLR WORDET
JRST EXWOB4
JRST EXWOB2
SETO FLAG, ; PROCESS WORD
SOJA V1,EXWOB1
EXWOB2: JUMPE FLAG,EXWOB3 ; PROCESS PUNCTUATION
SETZ FLAG,
SOJLE M,EXWOB5
EXWOB3: SUBI V1,1
SOJLE M,EXWOB5
JRST EXWOB1
EXWOB4: SKIPN FLAG ; PROCESS SEPARATOR
SOJA V1,EXWOB1
SETZ FLAG,
SOSLE M
SOJA V1,EXWOB1
EXWOB5: SUB V2,V1 ; LENGTH IS . - BACKED OVER CHARS
RETURN
EXWOF0: MOVE M,V1 ; FORWARD SEARCH
MOVE V1,@E.P
MOVE V2,@E.Z
SUB V2,@E.P ; DEFAULT VALUES ARE . AND Z - .
MOVE N,V2
SETZ FLAG,
MOVE PTR,V1
CALLR EXBPE
EXWOF1: JUMPE N,RETN(0)
ILDB CH,PTR ; GET A CHAR AND DETERMINE ITS TYPE
CALLR WORDET
JRST EXWOF4
JRST EXWOF2
SETO FLAG, ; PROCESS WORD
SOJA N,EXWOF1
EXWOF2: JUMPE FLAG,EXWOF3 ; PROCESS PUNCTUATION
SETZ FLAG,
SOJLE M,EXWOF5
EXWOF3: SUBI N,1
SOJLE M,EXWOF5
JRST EXWOF1
EXWOF4: SKIPN FLAG ; PROCESS SEPARATOR
SOJA N,EXWOF1
SETZ FLAG,
SOSLE M
SOJA N,EXWOF1
EXWOF5: SUB V2,N ; LENGTH IS Z - . - NUMBER OF CHARS LEFT
ENDR
; AUTOMATIC V
;
EXAV: BEGINR
SKIPN EXVSIZ ; IF THE NUMBER OF LINES IS ZERO THEN SKIP V
RETURN
MOVE X1,EX%PTR
MOVE X2,EX%N
EXAV0A: JUMPE X2,EXAV0B
ILDB X3,X1
HRRZ X4,DISPCH(X3)
CAIN X4,EXNEXT ; PASS OVER SEPARATORS TO NEXT COMMAND
SOJA X2,EXAV0A
RETURN
EXAV0B: CALLR EXAV$
ENDR
EXAV$: BEGINR <CH,PTR,N,M,V1,V2,UTIL>
SETZ UTIL, ; ZERO EXLINE FLAGS
MOVN V1,EXVSIZ
ADDI V1,1
CALLR EXLINE ; -(N-1)T SUPPLIES POINTER + PARTIAL LENGTH
MOVE PTR,V1
MOVE V1,EXVSIZ
MOVE N,V2
MOVN M,N
CALLR EXLINE ; NT SUPPLIES REMAINDER OF LENGTH
ADD N,V2
ADD M,N
JUMPE N,RETN(0)
CALLR EXBPE
EXAV1: CAME N,M
JRST EXAV2
SKIPN CH,EXVPTR
JRST EXAV2
CALLR TERMO ; OUTPUT POINTER SYMBOL
EXAV2: ILDB CH,PTR
CALLR EXBOUT ; OUTPUT TEXT
SOJG N,EXAV1
ENDR
EXBOUT: BEGINR
MOVE X1,EXPRIM
CAIN X1,1
JRST EXBOU1
CAIL X1,2
JRST EXBOU2
TBOUT <CH>
RETURN
EXBOU1: CALLR TERMO
RETURN
EXBOU2: CALLR TERMV
ENDR
; FILE NAME PREPARATION
; IN: M -- FILE NAME POINTER
; N -- FILE NAME LENGTH (NEGATIVE IF TEMPORARY NAME)
; UTIL -- ARGUMENT FLAGS
; OUT: M, N, IONAME AND IOLAST UPDATED
;
EXFILE: BEGINR <CH,PTR,FLAG>
SETZM IONAME
JUMPN N,EXFIL2
SKIPE IOLAST
JRST EXFIL1
TSOUT <[ASCIZ/ ? No default file name ?/],CRLF>
JRST EXERER
EXFIL1: MOVE PTR,[IOLAST,,IONAME]
BLT PTR,<IONAME+NSIZE-1> ; USE PREVIOUS FILE NAME
RETURN
EXFIL2: TRNE UTIL,F$PS
IBP M
MOVE FLAG,N
SKIPG N
MOVN N,N
MOVE PTR,[440700,,IONAME]
EXFIL3: ILDB CH,M
IDPB CH,PTR ; MOVE TEXT INTO FILE NAME BUFFER
SOJG N,EXFIL3
SETZ CH,
IDPB CH,PTR
JUMPL FLAG,RETN(0)
SETZM IOLAST ; NEW FILE NAME -- FORGET LAST
ENDR
; QREG TO QREG MOVER
; IN: PTR -- FROM POINTER,,TO POINTER
;
EXQTOQ: BEGINR <PTR,N,M,V1,V2>
HLRZ V1,PTR
HRRZI V2,(PTR)
MOVE N,Q.Z(V1)
CAMG N,Q.A(V2)
JRST EXQQ0
MOVEI PTR,(N) ; ALLOCATE QREG SPACE
SUB PTR,Q.A(V2)
HRLI PTR,(PTR)
HRRI PTR,(V2)
CALLR ALLOC
RETURN
EXQQ0: MOVEM N,Q.Z(V2) ; SET QREG USED COUNT
SUBI N,1
IDIVI N,5
ADD N,Q.B(V2)
HRL PTR,(V1) ; MOVE FROM QREG 1
HRR PTR,(V2) ; TO QREG 2
BLT PTR,(N) ; UNTIL (QREG 2 POINTER) + SIZE - 1
SETZM Q.P(V2)
ENDR SKIP,1
; SEARCH BUFFER INITIALIZATION
; IN: PTR -- POINTER TO FIRST CHARACTER OF STRING
; N -- LENGTH OF STRING
; OUT: SB UPDATED
;
EXSBI: BEGINR <CH,PTR,N,M,V1,V2>
JUMPE N,RETN(0) ; USE PREVIOUS STRING
ADDI N,1 ; (ACCOUNT FOR TRAILING RUBOUT)
MOVEI V1,(N)
IMULI V1,5 ; ONE WORD PER CHAR
SUB V1,S.A
JUMPLE V1,EXSBI1
MOVE M,PTR
CALLR EXQSB
MOVE CH,PTR
MOVE PTR,M
HRLI PTR,(V1) ; ALLOCATE SB SPACE FOR STRING
HRRI PTR,S.B
CALLR ALLOC
JRST EXERER
MOVE PTR,CH
CALLR EXQSA
MOVE PTR,M
EXSBI1: MOVEI V1,-1(N)
MOVE V2,S.B
EXSBI2: ILDB CH,PTR
MOVEM CH,(V2) ; MOVE CHARS INTO SB WORD BY WORD
AOJ V2,
SOJG V1,EXSBI2
SETOM CH,(V2) ; END SB STRING WITH A -1
MOVEM N,S.Z
ENDR
; EDIT BUFFER SEARCH FORWARD
; IN: SB
; OUT: EP UPDATED
;
; REGISTER USAGE
; CH -- EB CHAR
; PTR -- EB POINTER
; N -- EB CHAR COUNT
; M -- PTR TEMPORARY
; V1 -- SB CHAR INDEX
; V2 -- SB CHAR
; FLAG -- SB FIRST CHAR
;
EXESF: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
SKIPN S.Z
RETURN SKIP,1 ; EVERYTHING MATCHES THE EMPTY STRING
MOVE N,@E.Z ; N GETS NUMBER OF POSSIBLE FIRST CHARS
SUB N,@E.P ; WHICH DOESN'T INCLUDE THOSE BEFORE .
SUB N,S.Z ; OR THOSE AT END
ADDI N,2 ; (ACCOUNT FOR FIRST CHAR AND FINAL -1)
JUMPLE N,RETN(0) ; OUT OF POSSIBILITIES
SETZ M, ; ZERO COUNT OF CHARS PASSED
MOVE FLAG,@S.B ; FLAG GETS FIRST CHAR OF STRING
MOVE PTR,@E.P
CALLR EXBPE ; PTR GETS .
EXESF1: ADDI M,1 ; INCREMENT PASSED CHAR COUNTER
ILDB CH,PTR
CAIN CH,(FLAG) ; SEARCH FOR FIRST MATCH
JRST EXESF2
SOJG N,EXESF1
RETURN ; OUT OF POSSIBILITIES
EXESF2: MOVE UTIL,PTR
MOVE V1,S.B
ADDI V1,1 ; V1 GETS INDEX FOR COMPLETE SB SCAN
EXESF3: MOVE V2,(V1)
JUMPL V2,EXESF4 ; SUCCESS -- END OF SB
ILDB CH,PTR
CAIN CH,(V2)
AOJA V1,EXESF3
MOVE PTR,UTIL ; FAILURE -- RESTORE PTR AND TRY AGAIN
SOJG N,EXESF1
RETURN ; OUT OF POSSIBILITIES
EXESF4: ADDB M,@E.P ; ADD PASSED CHARS TO .
MOVEM M,EX.S
SOS EX.S
MOVE M,S.Z
SUBI M,2
ADDM M,@E.P ; ADD LENGTH (MINUS FIRST AND FINAL -1)
ENDR SKIP,1
; EDIT BUFFER SEARCH BACKWARD
; IN: SB
; OUT: EP UPDATED
;
; REGISTER USAGE SAME AS EXESF
;
EXESB: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
SKIPN S.Z
RETURN SKIP,1 ; EVERYTHING MATCHES THE EMPTY STRING
MOVE N,@E.P ; N GETS NUMBER OF POSSIBLE FIRST CHARS
MOVE M,@E.Z
SUB M,S.Z ; THE SEARCH MUST START SB CHARS BACK
ADDI M,2 ; (ACCOUNT FOR FIRST CHAR AND FINAL -1)
CAMLE N,M
MOVE N,M
JUMPLE N,RETN(0) ; OUT OF POSSIBILITIES
MOVE FLAG,@S.B ; FLAG GETS FIRST CHAR OF STRING
MOVE PTR,N
CALLR EXBPE
EXESB1: LDB CH,PTR
CAIN CH,(FLAG) ; SEARCH FOR FIRST MATCH
JRST EXESB2
DBP <PTR> ; BACK UP POINTER
SOJG N,EXESB1
RETURN ; OUT OF POSSIBILITIES
EXESB2: MOVE UTIL,PTR
MOVE V1,S.B
ADDI V1,1 ; V1 GETS INDEX FOR COMPLETE SB SCAN
EXESB3: MOVE V2,(V1)
JUMPL V2,EXESB4 ; SUCCESS -- END OF SB
ILDB CH,PTR
CAIN CH,(V2)
AOJA V1,EXESB3
MOVE PTR,UTIL ; FAILURE -- RESTORE PTR AND TRY AGAIN
DBP <PTR>
SOJG N,EXESB1
RETURN ; OUT OF POSSIBILITIES
EXESB4: MOVEM N,EX.S
SOS EX.S
ADD N,S.Z ; ADD LENGTH OF STRING TO CHARS LEFT
SUBI N,2 ; SUBTRACT FIRST CHAR AND FINAL -1
MOVEM N,@E.P ; . GETS NUMBER OF CHARS LEFT
ENDR SKIP,1
; EDIT BUFFER INSERT -- SPACE ALLOCATION WITH POINTER UPDATE
; IN: N -- SIZE OF INSERT IN CHARACTERS
; M -- POINTER TO BE UPDATED
; OUT: M -- POINTER UPDATED
;
EXEBIP: BEGINR <PTR,N,UTIL>
ADD N,@E.Z
CAMG N,@E.A
RETURN
CALLR EXQSB ; CONVERT TEXT POINTER TO PBLOCK POINTER
MOVE UTIL,PTR
HRLI PTR,(N) ; ALLOCATE EB SPACE FOR INSERT
HRRI PTR,@E.B
CALLR ALLOC
JRST EXERER
MOVE PTR,UTIL
CALLR EXQSA ; UPDATE TEXT POINTER WITH PBLOCK POINTER
ENDR
; EDIT BUFFER INSERT -- SPACE ALLOCATION
; IN: N -- SIZE OF INSERT IN CHARACTERS
;
EXEBIS: BEGINR <PTR,N>
ADD N,@E.Z
CAMG N,@E.A
RETURN
HRLI PTR,(N) ; ALLOCATE EB SPACE FOR INSERT
HRRI PTR,@E.B
CALLR ALLOC
JRST EXERER
ENDR
; EDIT BUFFER INSERT -- TEXT MOVEMENT
; IN: N -- SIZE OF INSERT IN CHARACTERS
; M -- POINTER TO TEXT TO BE INSERTED
; UTIL -- FLAGS
;
EXEBIT: BEGINR <CH,PTR,N,M>
MOVE PTR,@E.P
ADDM N,@E.P ; ADVANCE .
CALLR EXBPE
TRNE UTIL,F$PS
IBP M ; (PASS OVER / DELIMITER)
EXEBT0: ILDB CH,M
IDPB CH,PTR ; MOVE IN TEXT
SOJG N,EXEBT0
ENDR
; EDIT BUFFER EXPANSION
; IN: N -- SIZE OF EXPANSION IN CHARACTERS
; PTR -- QREG POINTER (IF N < 0)
; OUT: EZ UPDATED
;
; 1) MOVE CHARS BYTE BY BYTE TO NEW-HIGHEST-WORD BOUNDARY
; 2) MOVE CHARS WORD BY WORD
; 3) MOVE CHARS BYTE BY BYTE TO FILL NEW-LOWEST-WORD
;
EXEBE: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
SKIPL N
SKIPA PTR,E.B
MOVN N,N
CALLR ABORTI
MOVE FLAG,N
HRRZI M,(PTR)
MOVE V1,Q.Z(M)
ADDB N,Q.Z(M) ; Z UPDATED
CALLR EXBPQ
MOVE UTIL,PTR ; UTIL GETS NEW Z POINTER
MOVE N,V1
HRRZI PTR,(M)
CALLR EXBPQ ; PTR GETS OLD Z POINTER
SUB N,Q.P(M) ; N GETS NUMBER OF CHARS TO MOVE
JUMPE N,EXEBE6
MOVE V1,Q.Z(M)
IDIVI V1,5 ; V2: NUMBER OF CHARS IN NEW HIGHEST WORD
JUMPE V2,EXEBE2
EXEBE1: LDB CH,PTR
DPB CH,UTIL ; NEW-HIGHEST-WORD MOVE
DBP <PTR>
DBP <UTIL>
SOJE N,EXEBE6
SOJG V2,EXEBE1
EXEBE2: CAIG N,5
JRST EXEBE4 ; SKIP MASS MOVEMENT IF NO MASS
IDIVI N,5 ; N: WORD MOVES, M: RESIDUAL BYTE MOVES
MOVE V1,FLAG
IDIVI V1,5 ; V2: SIZE OF OFFSET (SIZE OF ROTATE)
JRST @EXEBET(V2)
EXEBE3: MOVEI N,(M)
EXEBE4: JUMPE N,EXEBE6
EXEBE5: LDB CH,PTR
DPB CH,UTIL ; NEW-LOWEST-WORD MOVE
DBP <PTR>
DBP <UTIL> ; BACK UP POINTERS
SOJG N,EXEBE5
EXEBE6: CALLR ABORTE
ENDR
EXEBET: EXEER0
EXEER1
EXEER2
EXEER3
EXEER4
EXEER0: MOVE R1,(PTR) ; SIMPLE WORD MOVES
MOVEM R1,(UTIL)
SUBI PTR,1
SUBI UTIL,1
SOJG N,EXEER0
JRST EXEBE3
EXEER1: MOVE R2,(PTR) ; 4 CHARACTER OFFSET MOVES
SUBI PTR,1
MOVE R1,(PTR)
LSH R1,-1
ROTC R1,^D29
IFG F.SYS,< TRZ R1,1>
MOVEM R1,(UTIL)
SUBI UTIL,1
SOJG N,EXEER1
JRST EXEBE3
EXEER2: MOVE R2,(PTR) ; 3 CHARACTER OFFSET MOVES
SUBI PTR,1
MOVE R1,(PTR)
LSH R1,-1
ROTC R1,^D22
IFG F.SYS,< TRZ R1,1>
MOVEM R1,(UTIL)
SUBI UTIL,1
SOJG N,EXEER2
JRST EXEBE3
EXEER3: MOVE R2,(PTR) ; 2 CHARACTER OFFSET MOVES
SUBI PTR,1
MOVE R1,(PTR)
LSH R1,-1
ROTC R1,^D15
IFG F.SYS,< TRZ R1,1>
MOVEM R1,(UTIL)
SUBI UTIL,1
SOJG N,EXEER3
JRST EXEBE3
EXEER4: MOVE R2,(PTR) ; 1 CHARACTER OFFSET MOVES
SUBI PTR,1
MOVE R1,(PTR)
LSH R1,-1
ROTC R1,^D8
IFG F.SYS,< TRZ R1,1>
MOVEM R1,(UTIL)
SUBI UTIL,1
SOJG N,EXEER4
JRST EXEBE3
; EDIT BUFFER CONTRACTION
; IN: N -- SIZE OF CONTRACTION IN CHARACTERS
; OUT: EZ UPDATED
;
; 1) MOVE CHARS BYTE BY BYTE TO NEW-LOWEST-WORD BOUNDARY
; 2) MOVE CHARS WORD BY WORD
; 3) MOVE CHARS BYTE BY BYTE TO FILL NEW-HIGHEST-WORD
;
EXEBC: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
CALLR ABORTI
MOVE FLAG,N
MOVE PTR,@E.P
CALLR EXBPE
MOVE UTIL,PTR ; UTIL GETS . POINTER
TLNN UTIL,400000
JRST EXEBC0
HRRI UTIL,-1(UTIL) ; UTIL MUST POINT TO PREVIOUS BYTE
HRLI UTIL,010700
EXEBC0: MOVE PTR,@E.P
ADD PTR,FLAG
CALLR EXBPE ; PTR GETS . + CONTRACTION POINTER
MOVE N,@E.Z
SUB N,FLAG
MOVEM N,@E.Z ; EZ GETS NEW Z
SUB N,@E.P ; N GETS NUMBER OF CHARS TO MOVE
JUMPE N,EXEBC6
MOVE V1,@E.P
IDIVI V1,5
JUMPE V2,EXEBC2
SUBI V2,5
MOVN V2,V2 ; V2: NUMBER OF CHARS TO FILL NEW LOWEST WORD
EXEBC1: ILDB CH,PTR
IDPB CH,UTIL ; NEW-LOWEST-WORD MOVE
SOJE N,EXEBC6
SOJG V2,EXEBC1
EXEBC2: CAIG N,5
JRST EXEBC4 ; SKIP MASS MOVEMENT IF NO MASS
IDIVI N,5 ; N: WORD MOVES, M: RESIDUAL BYTE MOVES
MOVE V1,FLAG
IDIVI V1,5 ; V2: SIZE OF OFFSET (SIZE OF ROTATE)
JRST @EXEBCT(V2)
EXEBC3: MOVEI N,(M)
EXEBC4: JUMPE N,EXEBC6
EXEBC5: ILDB CH,PTR
IDPB CH,UTIL ; NEW-HIGEST-WORD MOVE
SOJG N,EXEBC5
EXEBC6: CALLR ABORTE
ENDR
EXEBCT: EXECR0
EXECR1
EXECR2
EXECR3
EXECR4
EXECR0: ADDI PTR,1 ; SIMPLE WORD MOVES
MOVE R1,(PTR)
ADDI UTIL,1
MOVEM R1,(UTIL)
SOJG N,EXECR0
JRST EXEBC3
EXECR1: MOVE R1,(PTR) ; 1 CHARACTER OFFSET MOVES
ADDI PTR,1
MOVE R2,(PTR)
LSH R1,-1
ROTC R1,^D8
IFG F.SYS,< TRZ R1,1>
ADDI UTIL,1
MOVEM R1,(UTIL)
SOJG N,EXECR1
JRST EXEBC3
EXECR2: MOVE R1,(PTR) ; 2 CHARACTER OFFSET MOVES
ADDI PTR,1
MOVE R2,(PTR)
LSH R1,-1
ROTC R1,^D15
IFG F.SYS,< TRZ R1,1>
ADDI UTIL,1
MOVEM R1,(UTIL)
SOJG N,EXECR2
JRST EXEBC3
EXECR3: MOVE R1,(PTR) ; 3 CHARACTER OFFSET MOVES
ADDI PTR,1
MOVE R2,(PTR)
LSH R1,-1
ROTC R1,^D22
IFG F.SYS,< TRZ R1,1>
ADDI UTIL,1
MOVEM R1,(UTIL)
SOJG N,EXECR3
JRST EXEBC3
EXECR4: MOVE R1,(PTR) ; 4 CHARACTER OFFSET MOVES
ADDI PTR,1
MOVE R2,(PTR)
LSH R1,-1
ROTC R1,^D29
IFG F.SYS,< TRZ R1,1>
ADDI UTIL,1
MOVEM R1,(UTIL)
SOJG N,EXECR4
JRST EXEBC3
; QREG SOURCE POINTER BEFORE ALLOCATE -- CONVERT TO PBLOCK
; IN: M -- TEXT POINTER
; OUT: PTR -- CURRENT Q.B,,PBLOCK POINTER
;
EXQSB: BEGINR <UTIL>
HRRZI UTIL,(M)
HRRZI PTR,Q.0
CAMGE UTIL,Q.B(PTR)
RETURN ; IF SOURCE IS BELOW Q.0 THEN DONE
EXQSB1: CAMGE UTIL,<Q.B+PBLOCK>(PTR)
JRST EXQSB2
ADDI PTR,PBLOCK
CAIE PTR,Q.$
JRST EXQSB1
EXQSB2: HRL PTR,Q.B(PTR) ; REMEMBER CURRENT BUFFER POINTER
ENDR
; QREG SOURCE POINTER AFTER ALLOCATE -- UPDATE TEXT POINTER
; IN: PTR -- OLD Q.B,,PBLOCK POINTER
; M -- TEXT POINTER
; OUT: M -- UPDATED TEXT POINTER
;
EXQSA: BEGINR <V1,V2>
HLRZ V1,PTR
JUMPE V1,RETN(0) ; IF SOURCE IS BELOW Q.0 THEN DONE
HRRZ V2,Q.B(PTR)
SUBI V2,(V1) ; CURRENT Q.B - OLD Q.B
ADDI M,(V2)
ENDR
; CHARACTER COUNT TO BYTE POINTER FOR EDIT BUFFER
; IN: PTR -- CHARACTER COUNT
; OUT: PTR -- BYTE POINTER
;
EXBPE: BEGINR <N,M>
JUMPG PTR,EXBPE0
HRR PTR,@E.B
HRLI PTR,440700
RETURN
EXBPE0: MOVE N,PTR
SUBI N,1
IDIVI N,5
HRL PTR,EXBPT(M)
HRR PTR,@E.B
ADDI PTR,(N)
ENDR
; CHARACTER COUNT TO BYTE POINTER FOR QREG
; IN: N -- CHARACTER COUNT
; PTR -- QREG POINTER
; OUT: PTR -- BYTE POINTER
;
EXBPQ: BEGINR <N,M>
JUMPG N,EXBPQ0
HRR PTR,Q.B(PTR)
HRLI PTR,440700
RETURN
EXBPQ0: SUBI N,1
IDIVI N,5
HRL PTR,EXBPT(M)
HRR PTR,Q.B(PTR)
ADDI PTR,(N)
ENDR
EXBPT: 350700
260700
170700
100700
010700
EXER00: TSOUT <[ASCIZ/ ? Unknown command /]>
JRST EXERE1
EXER01: TSOUT <[ASCIZ/ ? Bad argument to /]>
JRST EXERE1
EXER02: TSOUT <[ASCIZ/ ? Bad argument with /]>
JRST EXERE1
EXER03: TSOUT <[ASCIZ/ ? Unknown command E/]>
JRST EXERE1
EXER04: TSOUT <[ASCIZ/ ? Bad argument to E/]>
JRST EXERE1
EXER05: TSOUT <[ASCIZ/ ? Unknown command F/]>
JRST EXERE1
EXER06: TSOUT <[ASCIZ/ ? Bad argument to F/]>
JRST EXERE1
EXER07: TSOUT <[ASCIZ/ ? Nonexistent Q register /]>
JRST EXERE1
EXER08: TSOUT <[ASCIZ/ ? Empty Q register /]>
JRST EXERE1
EXER09: TSOUT <[ASCIZ/ ? Now editing Q register /]>
JRST EXERE1
EXER10: TSOUT <[ASCIZ/ ? Now executing Q register /]>
JRST EXERE1
EXER11: TSOUT <[ASCIZ/ ? Unterminated string/]>
JRST EXERE2
EXER12: TSOUT <[ASCIZ/ ? Improper digit in integer string/]>
JRST EXERE2
EXER13: TSOUT <[ASCIZ/ ? Unbalanced angle brackets/]>
JRST EXERE2
EXER14: TSOUT <[ASCIZ/ ? Cannot find '/]>
MOVE N,S.B
EXERS1: MOVE CH,(N)
JUMPL CH,EXERS2
CALLR TERMV
AOJA N,EXERS1
EXERS2: MOVEI UTIL,"'"
TBOUT <UTIL>
JRST EXERE2
EXER15: TSOUT <[ASCIZ/ ? Stack overflow/]>
JRST EXERE2
EXERE1: CALLR TERMV
EXERE2: TSOUT <[ASCIZ/ ?/],CRLF>
EXERER: MOVE STACK,[IOWD SSIZE,STACKB]
JRST EXEND$
; ***CHARACTER DISPATCH TABLE***
; IN,,EX
;
DISPCH: INSERT,,EXER00 ; ^@
IN$A%,,EXER00 ; ^A
INSERT,,EXER00 ; ^B
INSERT,,EXER00 ; ^C
INSERT,,EXER00 ; ^D
IN$E,,EXER00 ; ^E
INSERT,,EXER00 ; ^F
IN$G,,EXER00 ; ^G
IN$H%,,EXER00 ; ^H
INSERT,,EX$$I ; <TAB>
IN$J%,,EXNEXT ; <LINE-FEED>
INSERT,,EXER00 ; ^K
IN$L,,EXER00 ; ^L
INSERT,,EXNEXT ; <CARRIAGE-RETURN>
IN$N,,EXER00 ; ^N
INSERT,,EXER00 ; ^O
INSERT,,EXER00 ; ^P
INSERT,,EXER00 ; ^Q
IN$R,,EXER00 ; ^R
INSERT,,EXER00 ; ^S
INSERT,,EXER00 ; ^T
IN$U,,EXER00 ; ^U
IN$V,,EXER00 ; ^V
IN$W,,EXER00 ; ^W
INSERT,,EXER00 ; ^X
INSERT,,EXER00 ; ^Y
INSERT,,EXER00 ; ^Z
IN$$,,EXNEXT ; <ESCAPE>
INSERT,,EXER00 ; ^\
INSERT,,EXER00 ; ^]
INSERT,,EXER00 ; ^^
IN$%,,EXNEXT ; <END-OF-LINE>
INSERT,,EXNEXT ; <SPACE>
INSERT,,EX$$EX ; !
INSERT,,EXER00 ; "
INSERT,,EXER00 ; #
INSERT,,EXER00 ; $
INSERT,,EX$% ; %
INSERT,,EXER00 ; &
INSERT,,EXER00 ; '
INSERT,,EXER00 ; (
INSERT,,EXER00 ; )
INSERT,,EXER00 ; *
INSERT,,EX$$P ; +
INSERT,,EX$$CA ; ,
INSERT,,EX$$M ; -
INSERT,,EX$. ; .
INSERT,,EX$$S ; /
INSERT,,EX$0 ; 0
INSERT,,EX$0 ; 1
INSERT,,EX$0 ; 2
INSERT,,EX$0 ; 3
INSERT,,EX$0 ; 4
INSERT,,EX$0 ; 5
INSERT,,EX$0 ; 6
INSERT,,EX$0 ; 7
INSERT,,EX$0 ; 8
INSERT,,EX$0 ; 9
INSERT,,EX$$CN ; :
INSERT,,EX$$$S ; ;
INSERT,,EX$$L ; <
INSERT,,EX$$EQ ; =
INSERT,,EX$$R ; >
INSERT,,EX$$Q ; ?
INSERT,,EX$$A ; @
INSERT,,EX$A ; A
INSERT,,EX$B ; B
INSERT,,EX$C ; C
INSERT,,EX$D ; D
INSERT,,EX$E$ ; E
INSERT,,EX$F$ ; F
INSERT,,EX$G ; G
INSERT,,EX$H ; H
INSERT,,EX$I ; I
INSERT,,EX$J ; J
INSERT,,EX$K ; K
INSERT,,EX$L ; L
INSERT,,EX$M ; M
INSERT,,EX$N ; N
INSERT,,EX$O ; O
INSERT,,EX$P ; P
INSERT,,EX$Q ; Q
INSERT,,EX$R ; R
INSERT,,EX$S ; S
INSERT,,EX$T ; T
INSERT,,EX$U ; U
INSERT,,EX$V ; V
INSERT,,EX$W ; W
INSERT,,EX$P ; X
INSERT,,EXER00 ; Y
INSERT,,EX$Z ; Z
INSERT,,EX$$L ; [
INSERT,,EXER00 ; \
INSERT,,EX$$R ; ]
IN$H%,,EXER00 ; ^
IN$J%,,EXER00 ; _
INSERT,,EXER00 ; `
INSERT,,EX$A ; a
INSERT,,EX$B ; b
INSERT,,EX$C ; c
INSERT,,EX$D ; d
INSERT,,EX$E$ ; e
INSERT,,EX$F$ ; f
INSERT,,EX$G ; g
INSERT,,EX$H ; h
INSERT,,EX$I ; i
INSERT,,EX$J ; j
INSERT,,EX$K ; k
INSERT,,EX$L ; l
INSERT,,EX$M ; m
INSERT,,EX$N ; n
INSERT,,EX$O ; o
INSERT,,EX$P ; p
INSERT,,EX$Q ; q
INSERT,,EX$R ; r
INSERT,,EX$S ; s
INSERT,,EX$T ; t
INSERT,,EX$U ; u
INSERT,,EX$V ; v
INSERT,,EX$W ; w
INSERT,,EX$P ; x
INSERT,,EXER00 ; y
INSERT,,EX$Z ; z
INSERT,,EXER00 ; {
INSERT,,EXER00 ; |
INSERT,,EXER00 ; }
INSERT,,EXER00 ; ~
IN$A%,,EXER00 ; <RUBOUT>
; ***COMMON SUBROUTINES***
; ALLOCATE BUFFER SPACE
; IN: PTR -- # OF CHARS ,, POINTER TO POINTER BLOCK
;
ALLOC: BEGINR <PTR,N,M,UTIL,FLAG>
HLRZ N,PTR
ADDI N,<BSIZE*5-1>
IDIVI N,BSIZE*5 ; ROUND UP TO NEAREST BSIZE
IMULI N,BSIZE
MOVEI FLAG,(N) ; ROUNDED NUMBER OF WORDS
IMULI N,5
HRLI PTR,(N) ; ROUNDED NUMBER OF CHARS
MOVEI UTIL,(FLAG)
ADD UTIL,ZU
CAMG UTIL,ZW
JRST ALLOC1 ; SPACE IS ALLOCATED BUT UNUSED
CALLR GETCOR
JRST .+2
JRST ALLOC1 ; ZW HAS BEEN UPDATED
TSOUT <[ASCIZ/ ? Core exhausted ?/],CRLF>
RETURN
ALLOC1: CALLR ABORTI
ADDM FLAG,ZU ; INCREMENT USED POINTER
HRRZI UTIL,(PTR)
CAIN UTIL,<Q.$>
JRST ALLOC5 ; SKIP MOVE IF LAST BLOCK
HRRZ N,ZU
SUBI N,1 ; SET N TO NEW LAST AVAILABLE WORD
HRRZI M,(N)
SUBI M,(FLAG) ; SET M TO OLD LAST AVAILABLE WORD
ALLOC2: CAMGE M,PBLOCK(PTR)
JRST ALLOC3
MOVE UTIL,(M)
MOVEM UTIL,(N) ; MOVE UP WORDS
SOJ M,
SOJA N,ALLOC2 ; UNTIL M EQUALS OLD BLOCK POINTER
ALLOC3: HRRZI M,(PTR)
SKIPE EX%Q
MOVE N,@EX%Q
ALLOC4: ADDI M,PBLOCK
ADDM FLAG,Q.B(M) ; INCREMENT BLOCK POINTERS
CAIE M,<Q.$>
JRST ALLOC4
SKIPN EX%Q ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
JRST ALLOC5
EXQPTR <N>
ALLOC5: HLRZ UTIL,PTR
ADDM UTIL,Q.A(PTR) ; INCREMENT ALLOCATE COUNT
CALLR ABORTE
ENDR SKIP,1
; ABORT INHIBIT
;
ABORTI: BEGINR
AOS FLAGCD
ENDR
; ABORT ENABLE
ABORTE: BEGINR
SOSE FLAGCD
RETURN
SKIPN FLAGCC
RETURN
SETZM FLAGCC
TSOUT <[ASCIZ/^C/]>
IFL F.SYS,<
IFE F.SAIL,< EXIT 1,>
IFN F.SAIL,<
MOVE STACK,[IOWD SSIZE,STACKB]
JRST INBEG
>; SAIL
>; TOPS-10
IFG F.SYS,<
HRRZI 0,RESUME
CALLR SUSPEN
>; TENEX
ENDR
; QREG NAME OUTPUT
; IN: PTR -- QREG POINTER
;
QNOUT: BEGINR <N,M>
MOVEI N,(PTR)
SUBI N,Q.0
IDIVI N,5
CAIN N,^D36
MOVEI N,"*"
CAIG N,9
ADDI N,"0"
CAIG N,^D35
ADDI N,"A"-^D10
TBOUT <N>
ENDR
TERME: BEGINR
SKIPE FLAGED
RETURN
IFL F.SYS,<IFN F.HARV,<
CAIN CH,177
JRST TERME0
CAIL CH," "
RETURN
>>; HARVARD
IFG F.SYS,<
CAIN CH,177
JRST TERME0
CAIL CH," "
RETURN
>; TENEX ECHO
CAIE CH,7
JRST TERME0
TBOUT <CH>
RETURN
TERME0: CALLR TERMO
ENDR
TERMO: BEGINR <CH,UTIL>
CAIN CH,33
MOVEI CH,"$"
CAIN CH,177
SETO CH,
CAIL CH," "
JRST TERMO0
CAIN CH,11
JRST TERMO0
CAIN CH,12
JRST TERMO0
CAIN CH,15
JRST TERMO0
CAIN CH,37
JRST TERMO0
MOVEI UTIL,"^"
TBOUT <UTIL>
ADDI CH,"@"
CAIGE CH,"@"
MOVEI CH,"?"
TERMO0: TBOUT <CH>
ENDR
TERMV: BEGINR <UTIL>
SETZ UTIL,
CAIN CH,11
MOVEI UTIL,[ASCIZ/<tab>/]
CAIN CH,12
MOVEI UTIL,[ASCIZ/<lf>/]
CAIN CH,15
MOVEI UTIL,[ASCIZ/<cr>/]
CAIN CH,33
MOVEI UTIL,[ASCIZ/<esc>/]
CAIN CH,37
MOVEI UTIL,[ASCIZ/<eol>/]
CAIN CH,177
MOVEI UTIL,[ASCIZ/<rub>/]
JUMPN UTIL,TERMV0
CALLR TERMO
RETURN
TERMV0: TSOUT <(UTIL)>
ENDR
; STRING TO INTEGER
; IN: PTR -- BYTE POINTER TO FIRST CHARACTER
; CH -- FIRST CHARACTER
; N -- BASE
; OUT: PTR -- UPDATED (POINTING TO FIRST NON-DIGIT)
; CH -- FIRST NON-DIGIT
; N -- INTEGER
;
M$S.I: BEGINR <UTIL>
MOVEI UTIL,(N)
SETZ N,
M$S.I0: CAIL CH,"0"
CAILE CH,"9"
RETURN SKIP,1
MOVEI CH,-"0"(CH)
CAIL CH,(UTIL)
RETURN
IMULI N,(UTIL)
ADDI N,(CH)
ILDB CH,PTR
JRST M$S.I0
ENDR SKIP,1
; INTEGER TO STRING
; IN: N -- INTEGER
; M -- BASE
; (RESULT IN M$I.SR AS ASCIZ)
;
M$I.S: BEGINR <PTR,V1,V2,UTIL,FLAG>
JUMPN N,M$I.S1
MOVE UTIL,[ASCIZ/0/]
MOVEM UTIL,M$I.SR
RETURN
M$I.S1: MOVE PTR,[440700,,M$I.ST]
MOVE UTIL,[440700,,M$I.SR]
MOVE V1,N
SETZ FLAG,
JUMPG V1,M$I.S2
MOVN V1,V1
MOVEI V2,"-"
IDPB V2,UTIL
M$I.S2: IDIVI V1,(M)
ADDI V2,"0"
IDPB V2,PTR
SKIPE V1
AOJA FLAG,M$I.S2
M$I.S3: LDB V2,PTR
IDPB V2,UTIL
DBP <PTR>
SOJGE FLAG,M$I.S3
SETZ V2,
IDPB V2,UTIL
ENDR
; WORD DETERMINER
; SPACE OR LESS -- SEPARATOR (RETURN)
; ! TO / AND : TO @ AND [ TO ` AND { TO ~ -- PUNCTUATION (SKIP,1)
; 0 TO 9 AND A TO Z AND a TO z -- WORD (SKIP,2)
;
WORDET: BEGINR
CAIG CH," "
RETURN
CAIGE CH,"0"
RETURN SKIP,1
CAIG CH,"9"
RETURN SKIP,2
CAIGE CH,"A"
RETURN SKIP,1
CAIG CH,"Z"
RETURN SKIP,2
CAIGE CH,"A"+40
RETURN SKIP,1
CAILE CH,"Z"+40
RETURN SKIP,1
ENDR SKIP,2
; ***SYSTEM DEPENDENT ROUTINES***
; (((TOPS-10)))
IFL F.SYS,<
FIRSTI: BEGINR
SKIPE FLAGED
JRST FIRSI1
OPEN 0,[ OPECHO ; TURN OFF TTY ECHOING
SIXBIT /TTY/
0]
JRST FIRSI3
FIRSI1: MOVEI X1,PSIPSI
HRRM X1,.JBINT
IFE F.SAIL,< SETZM PSI$PC>
IFN F.SAIL,<
HRLZI X1,4 ; INTTTI
INTENB X1,
>; SAIL
SKIPE FLAGIF
RETURN
MOVE X1,.JBREL
ADDI X1,1
MOVEM X1,ZW
SKIPE X1,C.B
JRST FIRSI2
MOVE X1,.JBFF
ADDI X1,77
LSH X1,-6
LSH X1,6 ; ROUND OFF FIRST FREE TO NEAREST 100
FIRSI2: MOVEM X1,ZU
RETURN
FIRSI3: OUTSTR [ASCIZ/ ? Cannot initialize ?
/]
EXIT
ENDR
FIRSTN: BEGINR
SKIPE FLAGIF ; CCL ENTRY USED
JRST FIRSN5
RESCAN ; REGULAR ENTRY USED
FIRSN1: INCHRW CH
CAIGE CH," "
JRST FIRSN4
CAIE CH,";"
JRST FIRSN1
MOVE PTR,[440700,,IONAME]
FIRSN2: INCHRW CH
CAIGE CH," "
JRST FIRSN3
IDPB CH,PTR
JRST FIRSN2
FIRSN3: SETZ CH,
IDPB CH,PTR
FIRSN4: CLRBFI
RETURN
;
; CCL ENTRY -- READ DEFAULT FILE NAME FROM TMP FILE
;
FIRSN5: SKIPE C.B
RETURN
MOVSI X1,SIXBIT/ EDT/
MOVEM X1,CCTMP ; TMP: FILE NAME (CORE)
HLRZM X1,IOFILE ; DSK: FILE NAME (###EDT.TMP)
MOVE X1,[440700,,IOIB1+2] ; IOIBUF+1 SERVES AS BYTE PTR BOTH
MOVEM X1,<IOIBUF+1> ; FOR TMP:EDT AND DSK:###EDT.TMP
SUBI X1,1 ; MAKE IOWD PTR TO FIRST FREE WORD
HRLI X1,-BSIZE
MOVEM X1,<CCTMP+1>
SETZM FLAGIF ; ASSUME TMPCOR WILL SUCCEED
MOVE X1,[2,,CCTMP]
TMPCOR X1, ; READ AND DELETE TMP:EDT
SOSA FLAGIF ; FILE NOT FOUND -- TRY DSK:
JRST FIRSN7
MOVEI X4,3
PJOB X1,
FIRSN6: IDIVI X1,12 ; CONVERT JOB # TO SIXBIT
ADDI X2,"0"-40
LSHC X2,-6 ; AND PUT IN LEFT HALF OF X3
SOJG X4,FIRSN6
HLLM X3,IOFILE ; DSK:###EDT
MOVEI X1,SIXBIT/ TMP/ ; .TMP
HRLZM X1,<IOFILE+1>
OPEN IOCHAN,IOCHAS
JRST CCERR
SETZM <IOFILE+3>
LOOKUP IOCHAN,IOFILE
JRST CCERR
IN IOCHAN,
JRST .+2
JRST CCERR
FIRSN7: MOVE PTR,[440700,,IOLAST] ; COPY FILE NAME INTO IOLAST
ILDB CH,IOIBUF+1 ; (IGNORE "S")
FIRSN8: ILDB CH,IOIBUF+1
CAIL CH," " ; IF CONTROL CHAR
CAIN CH,175 ; OR ALTMODE (MEANING "CREATE")
JRST FIRSN9 ; THEN END OF NAME
IDPB CH,PTR
JRST FIRSN8
FIRSN9: SETZ X1,
IDPB X1,PTR
MOVE PTR,[IOLAST,,IONAME]
CAIE CH,175 ; COPY NAME TO IONAME UNLESS
BLT PTR,<IONAME+NSIZE-1> ; TERMINATED BY ALTMODE
SKIPN FLAGIF ; IF TMPCOR SUCCESSFUL THEN DONE
RETURN
SETZM IOFILE ; DELETE DSK:###EDT.TMP
RENAME IOCHAN,IOFILE
JRST CCERR
RELEAS IOCHAN,
ENDR
CCERR: OUTSTR [ASCIZ / ? CCL error ?/]
EXIT
IO$ER: BEGINR <CH,PTR,N,M>
CALLR IOFNC
RETURN
CALLR IOFNP
OPEN IOCHAN,IOCHAS
JRST IO$ERD
IFE F.SAIL,<
MOVEI PTR,IOCHAS
DEVSIZ PTR,
SETZ PTR,
HRRZI PTR,-2(PTR)
>; TOPS-10
IFN F.SAIL,<
MOVE PTR,<IOCHAS+1>
BUFLEN PTR,
JUMPE PTR,IO$ERD
>; SAIL
CAILE PTR,<BSIZE+1>
JRST IO$ERD
HRLM PTR,IOIB1
HRLM PTR,IOIB2
MOVEI N,IOCHAN
DEVCHR N,
TLNN N,000004
JRST IO$ER1 ; SKIP LOOKUP IF NO DIRECTORY
LOOKUP IOCHAN,IOFILE ; OPEN FILE
JRST IO$ERF
IO$ER1: SKIPE IOLAST
JRST .+3
MOVE PTR,[IONAME,,IOLAST]
BLT PTR,<IOLAST+NSIZE-1> ; REMEMBER FILE NAME
MOVE N,[400000,,IOIB1]
MOVEM N,IOIBUF
MOVE N,[000700,,IOIB1+1]
MOVEM N,IOIBUF+1
SETZM IOIBUF+2
IO$ER2: IN IOCHAN, ; READ DATA
JRST IO$ER3
STATO IOCHAN,020000 ; CHECK FOR EOF
JRST IO$ERE
JRST IO$ER6
IO$ER3: MOVE N,@E.Z
ADD N,<IOIBUF+2>
CAMG N,@E.A
JRST IO$ER4
HRLI PTR,PSIZE*5 ; ALLOCATE EDIT BUFFER SPACE
HRRI PTR,@E.B
CALLR ALLOC
JRST IO$ERR
IO$ER4: MOVE PTR,@E.Z
CALLR EXBPE
MOVEM N,@E.Z
IO$ER5: SOSGE <IOIBUF+2>
JRST IO$ER2
ILDB CH,<IOIBUF+1>
IDPB CH,PTR ; MOVE TEXT INTO EDIT BUFFER
JRST IO$ER5
IO$ER6: RELEAS IOCHAN, ; CLOSE FILE
MOVE PTR,@E.Z
JUMPE PTR,IO$ER8
MOVEI N,4
CALLR EXBPE
IO$ER7: LDB CH,PTR ; REMOVE TRAILING ZEROS
JUMPN CH,IO$ER8
SOS @E.Z
DBP <PTR>
SOJG N,IO$ER7
IO$ER8: MOVEI CH," "
OUTCHR CH
MOVE N,@E.Z
MOVEI M,^D10
CALLR M$I.S
OUTSTR M$I.SR
OUTSTR CRLF
RETURN SKIP,1
IO$ERD: OUTSTR [ASCIZ/ ? Device error ?
/]
JRST IO$ERR
IO$ERE: OUTSTR [ASCIZ/ ? Data error ?
/]
JRST IO$ERR
IO$ERF: OUTSTR [ASCIZ/ ? Input file not found ?
/]
IO$ERR: RELEAS IOCHAN,
ENDR
IO$EW: BEGINR <CH,PTR,N,M>
CALLR IOFNC
RETURN
CALLR IOFNP
MOVEI CH," "
OUTCHR CH
MOVE N,@E.Z
MOVEI M,^D10
CALLR M$I.S
OUTSTR M$I.SR
OUTSTR CRLF
OPEN IOCHAN,IOCHAS
JRST IO$EWD
IFE F.SAIL,<
MOVEI PTR,IOCHAS
DEVSIZ PTR,
SETZ PTR,
HRRZI PTR,-2(PTR)
>; TOPS-10
IFN F.SAIL,<
MOVE PTR,<IOCHAS+1>
BUFLEN PTR,
JUMPE PTR,IO$EWD
>; SAIL
CAILE PTR,<BSIZE+1>
JRST IO$EWD
HRLM PTR,IOOB1
HRLM PTR,IOOB2
MOVEI M,IOCHAN
DEVCHR M,
TLNN M,000004
JRST IO$EW5 ; SKIP ENTER IF NO DIRECTORY
MOVE N,IOFILE
MOVE M,<IOFILE+1>
MOVE PTR,<IOFILE+3>
IFE F.SAIL,<
MOVE CH,<IOCHAS+1>
CAME CH,[SIXBIT/DSK/] ; IF DEVICE IS DSK:
JRST IO$EW1
MOVE CH,<IOFILE+3>
MOVEM CH,<IOFINB+1>
MOVEM N,<IOFINB+2>
MOVEM M,<IOFINB+3>
LOOKUP IOCHAN,IOFINB
JRST IO$EW4
RELEAS IOCHAN,
MOVE CH,IOFIND ; THEN GET ACTUAL DEVICE OF OLD FILE
MOVEM CH,<IOCHAS+1>
OPEN IOCHAN,IOCHAS
JRST IO$EWF
>; TOPS-10
IO$EW1: MOVE CH,[SIXBIT/BAK/]
MOVEM CH,<IOFILE+1>
LOOKUP IOCHAN,IOFILE
JRST IO$EW2
SETZM IOFILE
MOVEM PTR,<IOFILE+3>
RENAME IOCHAN,IOFILE ; DELETE .BAK
JRST IO$EWB
MOVEM N,IOFILE
IO$EW2: MOVEM M,<IOFILE+1>
SETZ N,
LOOKUP IOCHAN,IOFILE
JRST IO$EW3
HLLZ N,<IOFILE+2>
TLZ N,000777 ; PRESERVE PROTECTION
MOVE CH,[SIXBIT/BAK/]
HLLM CH,<IOFILE+1>
MOVEM PTR,<IOFILE+3>
RENAME IOCHAN,IOFILE ; RENAME FILE TO .BAK
JRST IO$EWB
IFN F.SAIL,<
CLOSE IOCHAN,
OPEN IOCHAN,IOCHAS
JRST IO$EWD
>; SAIL
IO$EW3: MOVEM M,<IOFILE+1>
MOVEM N,<IOFILE+2>
IO$EW4: ENTER IOCHAN,IOFILE ; OPEN FILE
JRST IO$EWF
IO$EW5: SKIPE IOLAST
JRST .+3
MOVE PTR,[IONAME,,IOLAST]
BLT PTR,<IOLAST+NSIZE-1> ; REMEMBER FILE NAME
MOVE N,[400000,,IOOB1]
MOVEM N,IOOBUF
MOVE N,[000700,,IOOB1+1]
MOVEM N,IOOBUF+1
MOVEI N,BSIZE
MOVEM N,IOOBUF+2
OUT IOCHAN, ; INITIALIZE BUFFER POINTERS
JRST .+2
JRST IO$EWE
MOVE N,@E.Z
SETZ PTR,
CALLR EXBPE
IO$EW6: SOJL N,IO$EW8
SOSL <IOOBUF+2>
JRST IO$EW7
OUT IOCHAN, ; OUTPUT DATA
SOSA <IOOBUF+2>
JRST IO$EWE
IO$EW7: ILDB CH,PTR
IDPB CH,<IOOBUF+1> ; MOVE TEXT INTO OUTPUT BUFFER
JRST IO$EW6
IO$EW8: OUT IOCHAN, ; OUTPUT TRAILING DATA
JRST .+2
JRST IO$EWE
RELEAS IOCHAN, ; CLOSE FILE AND RELEASE CHANNEL
RETURN SKIP,1
IO$EWB: OUTSTR [ASCIZ/ ? Cannot rename .BAK file ?
/]
JRST IO$EWR
IO$EWD: OUTSTR [ASCIZ/ ? Device error ?
/]
JRST IO$EWR
IO$EWE: OUTSTR [ASCIZ/ ? Data error ?
/]
JRST IO$EWR
IO$EWF: OUTSTR [ASCIZ/ ? Cannot write file ?
/]
IO$EWR: RELEAS IOCHAN,
ENDR
; FILE NAME CONVERSION
;
IOFC$D==400000 ; DEVICE FIELD FLAG
IOFC$P==200000 ; PPN FIELD FLAG
;
IOFNC: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
SETZ FLAG,
SETZM IOFILE
SETZM <IOFILE+1>
SETZM <IOFILE+2>
IFE F.SAIL,< GETPPN UTIL,>
IFN F.SAIL,<
SETZ UTIL,
DSKPPN UTIL,
>; SAIL
MOVEM UTIL,<IOFILE+3>
MOVE UTIL,[SIXBIT/DSK/]
MOVEM UTIL,<IOCHAS+1> ; SET DEFAULT ARGUMENTS
MOVE PTR,[440700,,IONAME]
IOFC01: ILDB CH,PTR
JUMPE CH,IOFC04
CAIE CH,":" ; LOOK FOR DEVICE FIELD
JRST IOFC01
TLO FLAG,IOFC$D
MOVE V1,PTR
SETZM <IOFILE+3>
MOVE PTR,[440700,,IONAME]
MOVE M,[440600,,<IOCHAS+1>]
MOVEI N,6
SETZM <IOCHAS+1>
IOFC02: ILDB CH,PTR
CAIN CH," "
JRST IOFC02
CAIN CH,":"
JRST IOFC03
CAIGE CH,"A"+40
ADDI CH,40
IDPB CH,M ; STORE DEVICE FIELD
SOJG N,IOFC02
IOFC03: MOVE UTIL,<IOCHAS+1>
DEVCHR UTIL,
JUMPE UTIL,IOFNCE
TLNN UTIL,000004
RETURN SKIP,1 ; (DONE IF NONDIRECTORY DEVICE)
TLNE UTIL,000100 ; (NO PPN IF DECTAPE)
JRST IOFC06
IOFC04: MOVE PTR,[440700,,IONAME]
IOFC05: ILDB CH,PTR
JUMPE CH,IOFC06
CAIE CH,"[" ; LOOK FOR PPN FIELD
JRST IOFC05
TLO FLAG,IOFC$P
IFE F.SAIL,<
ILDB CH,PTR
MOVEI N,10
CALLR M$S.I
JRST IOFNCE
HRLM N,<IOFILE+3>
ILDB CH,PTR
MOVEI N,10
CALLR M$S.I
JRST IOFNCE
HRRM N,<IOFILE+3>
>; TOPS-10
IFN F.SAIL,<
CALLR IOFCW
HRLM N,<IOFILE+3>
CALLR IOFCW
SKIPE N
HRRM N,<IOFILE+3>
>; SAIL
MOVE V2,PTR
IOFC06: TLNE FLAG,IOFC$D
JRST IOFC07
TLNE FLAG,IOFC$P
JRST IOFC10
MOVE PTR,[440700,,IONAME] ; F.E
JRST IOFC12
IOFC07: TLNE FLAG,IOFC$P
JRST IOFC08
MOVE PTR,V1 ; D:F.E
JRST IOFC12
IOFC08: MOVE PTR,V1
ILDB CH,PTR
CAIN CH,"["
JRST IOFC09
MOVE PTR,V1 ; D:F.E[M,N]
JRST IOFC12
IOFC09: LDB CH,V2
CAIE CH,"]"
JRST IOFNCE
MOVE PTR,V2 ; D:[M,M]F.E
JRST IOFC12
IOFC10: LDB CH,[350700,,IONAME]
CAIN CH,"["
JRST IOFC11
MOVE PTR,[440700,,IONAME] ; F.E[M,N]
JRST IOFC12
IOFC11: LDB CH,V2
CAIE CH,"]"
JRST IOFNCE
MOVE PTR,V2 ; [M,N]F.E
IOFC12: MOVE M,[440600,,IOFILE]
MOVEI N,6
IOFC13: ILDB CH,PTR
CAIN CH," "
JRST IOFC13
JUMPE CH,RETN(1)
CAIN CH,"["
RETURN SKIP,1
CAIN CH,"."
JRST IOFC15
CAIGE CH,"A"+40
ADDI CH,40
IDPB CH,M ; STORE FILE NAME FIELD
SOJG N,IOFC13
IOFC14: ILDB CH,PTR
CAIN CH," "
JRST IOFC14
JUMPE CH,RETN(1)
CAIN CH,"."
JRST IOFC15
JRST IOFC14
IOFC15: MOVE M,[440600,,<IOFILE+1>]
MOVEI N,3
IOFC16: ILDB CH,PTR
CAIN CH," "
JRST IOFC16
JUMPE CH,RETN(1)
CAIN CH,"["
RETURN SKIP,1
CAIGE CH,"A"+40
ADDI CH,40
IDPB CH,M ; STORE EXTENSION FIELD
SOJG N,IOFC16
RETURN SKIP,1
IOFNCE: OUTSTR [ASCIZ/ ? Bad file name '/]
OUTSTR IONAME
OUTSTR [ASCIZ/' ?
/]
ENDR
IFN F.SAIL,<
; SIXBIT PPN CONVERTER
; IN: PTR -- FILENAME STRING POINTER
; CH -- PUNCTUATION CHARACTER
; OUT: PTR -- UPDATED
; CH -- TERMINATING CHARACTER
; N -- SIXBIT PRJ OR PRG RIGHT-JUSTIFIED
;
IOFCW: BEGINR
SETZ N,
CAIGE CH," "
RETURN
CAIN CH,"]"
RETURN
IOFCW0: ILDB CH,PTR
CAIGE CH," "
RETURN
CAIN CH,","
RETURN
CAIN CH,"]"
RETURN
LSH N,6
CAIGE CH,"A"+40
ADDI CH,40
ANDI CH,77
IORI N,(CH)
JRST IOFCW0
ENDR
>; SAIL
; FILE NAME PRINT
;
IOFNP: BEGINR <CH,PTR,N,M>
MOVEI CH," "
OUTCHR CH
MOVE PTR,[440600,,<IOCHAS+1>]
MOVEI N,6
IOFNP1: ILDB CH,PTR
JUMPE CH,IOFNP2
ADDI CH,40
OUTCHR CH
SOJG N,IOFNP1
IOFNP2: MOVEI CH,":"
OUTCHR CH
SKIPN <IOFILE+3>
JRST IOFNP3
MOVEI CH,"["
OUTCHR CH
IFE F.SAIL,<
HLRZ N,IOFILE+3
MOVEI M,10
CALLR M$I.S
OUTSTR M$I.SR
MOVEI CH,","
OUTCHR CH
HRRZ N,IOFILE+3
MOVEI M,10
CALLR M$I.S
OUTSTR M$I.SR
>; TOPS-10
IFN F.SAIL,<
MOVEI M,","
MOVEI N,6
MOVE PTR,[440600,,<IOFILE+3>]
IOFNPW: ILDB CH,PTR
ADDI CH,40
CAIE CH," "
OUTCHR CH
CAIN N,4
OUTCHR M
SOJG N,IOFNPW
>; SAIL
MOVEI CH,"]"
OUTCHR CH
IOFNP3: SKIPN IOFILE
RETURN
MOVE PTR,[440600,,IOFILE]
MOVEI N,6
IOFNP4: ILDB CH,PTR
JUMPE CH,IOFNP5
ADDI CH,40
OUTCHR CH
SOJG N,IOFNP4
IOFNP5: SKIPN <IOFILE+1>
RETURN
MOVEI CH,"."
OUTCHR CH
MOVE PTR,[440600,,<IOFILE+1>]
MOVEI N,3
IOFNP6: ILDB CH,PTR
JUMPE CH,RETN(0)
ADDI CH,40
OUTCHR CH
SOJG N,IOFNP6
ENDR
; ALLOCATE CORE
; IN: FLAG -- NUMBER OF WORDS TO ADD
;
GETCOR: BEGINR <FLAG>
ADD FLAG,.JBREL
CORE FLAG,
RETURN
MOVE FLAG,.JBREL
ADDI FLAG,1
MOVEM FLAG,ZW
ENDR SKIP,1
HALTGO: MOVE UTIL,CCCOMP
RUN UTIL,
JRST HALT
JRST HALT
HALT: EXIT 1,
JRST INBEG
QUIT: EXIT
IFE F.SAIL,<
PSI$CC: SKIPN FLAGCD
JRST PSI$C1
SETOM FLAGCC
PUSH STACK,PSI$PC
SETZM PSI$PC
POPJ STACK,
PSI$C1: PUSH STACK,UTIL
HRRZ UTIL,PSI$PC
CAIL UTIL,EXBEG
JRST PSI$C2
HLLZ UTIL,(UTIL)
CAMN UTIL,[INCHRW]
JRST PSI$C3
PSI$C2: POP STACK,UTIL
OUTSTR [ASCIZ/^C/]
EXIT 1,
PUSH STACK,PSI$PC
SETZM PSI$PC
POPJ STACK,
PSI$C3: POP STACK,UTIL
OUTSTR [ASCIZ/^C/]
EXIT 1,
DDT$G: SETZM PSI$PC
JRST IN$E
>; TOPS-10
IFN F.SAIL,<
PSI$CC: SKIPN FLAGCD
JRST PSI$C0
SETOM FLAGCC
DISMIS
PSI$C0: UWAIT
DEBREA
OUTSTR [ASCIZ/^C/]
EXIT 1,
MOVE PTR,PSI$PC
CAIN PTR,<INNEXT+1>
DDT$G: JRST IN$E
MOVE STACK,[IOWD SSIZE,STACKB]
JRST INBEG
>; SAIL
>
; (((^^^)))
; (((TENEX)))
IFG F.SYS,<
FIRSTI: BEGINR
SKIPE FLAGED
JRST FIRSI1
MOVEI X1,100
RFMOD
MOVEM X2,TMOD
TRZ X2,776000 ; CLEAR WAKE UP AND ECHOING
TRO X2,144300 ; WAKE UP ON ^ CHARS, ECHO, OUTPUT ^ CHARS
SFMOD
RFCOC
MOVEM X2,TCOC1
MOVEM X3,TCOC2
SETZ X2,
SETZ X3,
SFCOC ; IGNORE ALL CONTROL CHARACTERS (INPUT ONLY)
FIRSI1: HRRZI X1,400000
RPCAP
TLO X3,400000
EPCAP ; THIS FORK CAN CAPTURE ^C
HRRI X2,CHNTAB
HRLI X2,LEVTAB
SIR ; SET UP PSI TABLE
MOVE X1,[3,,0]
ATI ; ASSIGN ^C TO CHANNEL 0
MOVE X1,[23,,1]
ATI ; ASSIGN ^S TO CHANNEL 1
HRRZI X1,400000
HRLZI X2,600000
AIC ; ACTIVATE CHANNELS 0 AND 1
EIR ; ENABLE PSI SYSTEM
SKIPE FLAGIF
RETURN
HRLZI X1,400000
FIRSI2: RPACS
TLNE X2,010000 ; TEST FOR FIRST NONEXISTENT PAGE
AOJA X1,FIRSI2
LSH X1,^D9
MOVEM X1,ZW
SKIPE C.B
MOVE X1,C.B
MOVEM X1,ZU
ENDR
FIRSTN: BEGINR
SKIPE FLAGIF
JRST FIRSN0
MOVEI X1,100
BKJFN
RETURN
BIN
CAIE X2," "
RETURN
HRLZI X1,160003
MOVE X2,[100,,101]
GTJFN
RETURN
MOVE X2,X1
HRROI X1,IONAME
SETZ X3,
JFNS ; GET FILE NAME FROM EXEC LINE
HRRZI X1,(X2)
RLJFN
RETURN
RETURN
FIRSN0: MOVEI FLAG,IOLAST
SKIPE 0
MOVEI FLAG,IONAME
HRLI UTIL,1
HRRI UTIL,(FLAG)
BLT UTIL,6(FLAG) ; GET FILE NAME FROM ACS
ENDR
IO$ER: BEGINR <CH,PTR,N,M>
SETZM IOJFN
HRLZI X1,100101
HRROI X2,IONAME
GTJFN
JRST IO$ERF
HRRZM X1,IOJFN
MOVEI X1," "
PBOUT
MOVEI X1,101
HRRZ X2,IOJFN
MOVE X3,[111110,,000001]
JFNS
SKIPE IOLAST
JRST .+4
HRROI X1,IOLAST
MOVE X3,[222200,,000001]
JFNS
HRRZ X1,IOJFN
MOVE X2,[070000,,200000]
OPENF ; OPEN FILE
JRST IO$ERF
MOVE PTR,@E.Z
CALLR EXBPE
IO$ER1: MOVE N,@E.Z
ADDI N,PSIZE*5
CAMG N,@E.A
JRST IO$ER2
MOVE CH,PTR ; ALLOCATE EDIT BUFFER SPACE
HRLI PTR,PSIZE*5
HRRI PTR,@E.B
CALLR ALLOC
JRST IO$ERR
MOVE PTR,CH
IO$ER2: HRRZ X1,IOJFN
MOVE X2,PTR
MOVNI X3,PSIZE*5
SETZ X4,
SIN ; MOVE TEXT INTO EDIT BUFFER
MOVE PTR,X2
ADDI X3,PSIZE*5
ADDM X3,@E.Z
GTSTS
TLNN X2,001000 ; CHECK FOR EOF
JRST IO$ER1
CLOSF ; CLOSE FILE
JRST .+1
MOVE PTR,@E.Z
JUMPE PTR,IO$ER4
MOVEI N,4
CALLR EXBPE
IO$ER3: LDB CH,PTR ; REMOVE TRAILING ZEROS
JUMPN CH,IO$ER4
SOS @E.Z
DBP <PTR>
SOJG N,IO$ER3
IO$ER4: MOVEI X1," "
PBOUT
MOVE N,@E.Z
MOVEI M,^D10
CALLR M$I.S
HRROI X1,M$I.SR
PSOUT
HRROI X1,CRLF
PSOUT
RETURN SKIP,1
IO$ERR: HRRZ X1,IOJFN
CLOSF
RETURN
RETURN
IO$ERF: CALLR IO$EE
ENDR
IO$EW: BEGINR <N,M>
SETZM IOJFN
HRLZI X1,600001
HRROI X2,IONAME
GTJFN
JRST IO$EWF
HRRZM X1,IOJFN
MOVEI X1," "
PBOUT
MOVEI X1,101
HRRZ X2,IOJFN
MOVE X3,[111110,,000001]
JFNS
SKIPE IOLAST
JRST .+4
HRROI X1,IOLAST
MOVE X3,[222200,,000001]
JFNS
MOVEI X1," "
PBOUT
MOVE N,@E.Z
MOVEI M,^D10
CALLR M$I.S
HRROI X1,M$I.SR
PSOUT
HRROI X1,CRLF
PSOUT
HRRZ X1,IOJFN
MOVE X2,[070000,,100000]
OPENF ; OPEN FILE
JRST IO$EWF
SKIPN @E.Z
JRST IO$EW0
HRRO X2,@E.B
MOVN X3,@E.Z
SETZ X4,
SOUT ; OUTPUT DATA
IO$EW0: CLOSF ; CLOSE FILE
RETURN SKIP,1
RETURN SKIP,1
IO$EWF: CALLR IO$EE
ENDR
IO$EE: BEGINR
SKIPE IOJFN
JRST IO$EE1
MOVEI X1," "
PBOUT
HRROI X1,IONAME
PSOUT
HRROI X1,CRLF
PSOUT
JRST IO$EE2
IO$EE1: HRRZ X1,IOJFN
RLJFN
JRST .+1
IO$EE2: HRROI X1,[ASCIZ/ ? /]
PSOUT
MOVEI X1,101
MOVE X2,[400000,,-1]
SETZ X3,
ERSTR
JRST .+2
JRST .+1
HRROI X1,[ASCIZ/ ?
/]
PSOUT
ENDR
GETCOR: BEGINR
SKIPG FLAG
RETURN SKIP,1
MOVE X1,ZW
LSH X1,-^D9
MOVE X3,ZW
MOVE X4,ZW
SUBI X4,1 ; CONVERT FROM FIRST FREE TO LAST USED
ADDI X4,(FLAG) ; AND ADD NEW REQUIREMENT
LSH X4,-^D9
TLO X1,400000
GETCO0: RPACS
TLNE X2,010000 ; TEST FOR EXISTENCE
RETURN
SETZM (X3) ; MAKE PAGE EXIST
ADDI X3,PSIZE
CAIE X4,(X1)
AOJA X1,GETCO0
MOVEM X3,ZW
ENDR SKIP,1
HALTGO: SETO 0,
CALLR SUSPEN
JRST INBEG
HALT: SETZ 0,
CALLR SUSPEN
JRST INBEG
QUIT: SETZ 0,
CALLR SUSPEN
JRST QUIT
SUSPEN: BEGINR <X1,X2,X3,X4>
MOVEI X1,100
RFMOD
MOVEM X2,X4
RFCOC
HALTF
DDT$G:
RESUME: SFCOC
MOVE X2,X4
SFMOD
ENDR
PSI$CC: SKIPN FLAGCD
JRST PSI$C1
SETOM FLAGCC
DEBRK
PSI$C1: PUSH STACK,X1
HRRZ X1,PSI$P2
CAIL X1,EXBEG
JRST PSI$C2
MOVE X1,-1(X1)
CAMN X1,[PBIN]
JRST PSI$C3
PSI$C2: HRROI X1,[ASCIZ/^C/]
PSOUT
HRRZI 0,RESUME
CALLR SUSPEN
POP STACK,X1
DEBRK
PSI$C3: POP STACK,X1
PSI$C4: MOVEI X1,100
SIBE
JRST .+2
JRST PSI$C5
TBIN <CH>
CALLR INADD
JRST PSI$C4
JRST PSI$C4
PSI$C5: HRROI X1,[ASCIZ/^C/]
PSOUT
HRRZI 0,RESUME
CALLR SUSPEN
MOVEI X1,IN$E
MOVEM X1,PSI$P2
DEBRK
PSI$CS: PUSH STACK,X1
HRRZ X1,PSI$P3
MOVE X1,-1(X1)
CAMN X1,[PBIN]
JRST PSI$S0
MOVEI X1,23
DTI ; DEASSIGN ^S
PBIN
CAIE X1,"S"-100 ; WAIT FOR ^S
JRST .-2
MOVE X1,[23,,1]
ATI ; ASSIGN ^S AGAIN
PSI$S0: POP STACK,X1
DEBRK
LEVTAB: PSI$P1
PSI$P2
PSI$P3
CHNTAB: 2,,PSI$CC
3,,PSI$CS
BLOCK 36
>
; (((^^^)))
; ***DATA***
CRLF: BYTE (7)15,12,0,0,0
LIT ; LITERALS GO HERE
; (((TOPS-10)))
IFL F.SYS,<
IFN F.2SEG,< RELOC 0>
IOCHAS: 0 ; ASCII MODE
SIXBIT /DSK/
IOOBUF,,IOIBUF
IOIBUF: BLOCK 3
IOOBUF: BLOCK 3
0 ; FILE STATUS
IOIB1: BSIZE+1,,IOIB2
0 ; BOOKKEEPING
BLOCK BSIZE+1
0 ; FILE STATUS
IOIB2: BSIZE+1,,IOIB1
0 ; BOOKKEEPING
BLOCK BSIZE+1
0 ; FILE STATUS
IOOB1: BSIZE+1,,IOOB2
0 ; BOOKKEEPING
BLOCK BSIZE+1
0 ; FILE STATUS
IOOB2: BSIZE+1,,IOOB1
0 ; BOOKKEEPING
BLOCK BSIZE+1
IOFILE: 0 ; FILE NAME
0 ; EXTENSION
0
0 ; PROJECT,,PROGRAMMER
IFE F.SAIL,<
IOFINB: 16
0 ; PROJECT,,PROGRAMMER
0 ; FILE NAME
0 ; EXTENSION
BLOCK 12
IOFIND: 0 ; LOGICAL DEVICE
>; TOPS-10
CCTMP: SIXBIT /EDT/ ; TMP: (CORE)
0 ; (IOWD BSIZE,BUFFER)
CCCOMP: 1,,[ SIXBIT /SYS/
IFE F.SAIL,< SIXBIT /COMPIL/>
IFN F.SAIL,< SIXBIT /SNAIL/>
0
0
0
0]
IFE F.SAIL,<
PSIPSI: 4,,PSI$CC
0,,000002
PSI$PC: 0
0
>; TOPS-10
IFN F.SAIL,<
PSIPSI: 0 ; JOBCNI
PSI$PC: 0 ; JOBTPC
0,,PSI$CC ; JOBAPR
>; SAIL
>
; (((^^^)))
; (((TENEX)))
IFG F.SYS,<
IOJFN: 0
TMOD: 0
TCOC1: 0
TCOC2: 0
PSI$P1: 0
PSI$P2: 0
PSI$P3: 0
>
; (((^^^)))
; * VARIABLES
FLAGCC: 0 ; ^C CAPTURED
FLAGCD: 0 ; ^C DEFERRED
FLAGIF: 0 ; INITIALIZATION FLAG
FLAGED: 0 ; ECHO-DUPLEX FLAG
EXBASE: ^D10
EXDBUG: 0
EXPRIM: 1
IFL F.SYS,<
IFE F.SAIL,<EXVPTR: "~">
IFN F.SAIL,<EXVPTR: "^">
>; TOPS-10
IFG F.SYS,<EXVPTR: "~">
EXVSIZ: 1
EX..: 0
EX.B: 0
EX.I: 0
EX.S: 0
EX%PTR: 0
EX%N: 0
EX%CH: 0
EX%S1N: 0
EX%S1P: 0
EX%S2N: 0
EX%S2P: 0
EX%Q: 0
EX%B: 0
M$I.SR: BLOCK 3
M$I.ST: BLOCK 3
; FIVE WORD POINTER BLOCK
; POINTER TO FIRST WORD
; NUMBER OF CHARACTERS ALLOCATED
; NUMBER OF CHARACTERS USED
; EDIT POINTER (CHARACTER NUMBER)
; VALUE
C.B: 0 ; COMMAND BUFFER
C.A: 0
C.Z: 0
0
0
B.B: 0 ; BACKUP BUFFER
0
B.Z: 0
0
B.V: 0
S.B: 0 ; SEARCH BUFFER (ONE WORD PER CHARACTER)
S.A: 0
S.Z: 0
0
0
Q.0: BLOCK <PBLOCK*^D36> ; QREGS 0-9 AND A-Z
Q.$: 0 ; QREG *
0
0
0
0
E.B: <Q.$+Q.B> ; EDIT BUFFER POINTER
E.A: <Q.$+Q.A> ; EDIT BUFFER ALLOCATED
E.Z: <Q.$+Q.Z> ; EDIT BUFFER USED (Z)
E.P: <Q.$+Q.P> ; EDIT POINTER (.)
ZU: 0 ; FIRST FREE UNUSED
ZW: 0 ; FIRST FREE UNALLOCATED (IN THE WORLD)
; * BUFFERS
IONAME: BLOCK NSIZE
IOLAST: BLOCK NSIZE
ENVIRB: BLOCK <2*SSIZE>
STACKB: BLOCK SSIZE
END ANTE