Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0145/ante.mac
There are 3 other files named ante.mac in the archive. Click here to see a list.
; A Nother Text Editor -- W.R. Bush
; Version of November 1981
TITLE ANTE
F.SYS==-1 ; -1 IF TOPS-10, 1 IF TENEX, 2 IF TOPS-20
; An executable ANTE is made by
; 1) choosing the operating system ANTE is to run under by
; setting the assembly switch F.SYS for either TOPS-10,
; TENEX, or TOPS-20
; 2) assembling ANTE.MAC with MACRO-10 (no other .MAC files
; are needed, and any version of MACRO-10 may be used)
; 3) loading ANTE.REL with either LOADER or LINK
IF1,< IFL F.SYS,<PRINTX ANTE for TOPS-10...>
IFE <F.SYS-1>,<PRINTX ANTE for TENEX...>
IFE <F.SYS-2>,<PRINTX ANTE for TOPS-20...>>
IF2,<PRINTX ...is halfway>
; Command Input Controls
;
;^A delete the last character
;^E print the command stream
;^F delete and save the command stream (two in succession)
;^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
;<line feed> equivalent to LV$$ if first character
;^L equivalent to -NV$$ if first character
;^N equivalent to NV$$ if first character
;
; Values
;
;<digits> integer
;+<value>{1} unary sign
;-<value>{1} unary sign
;<value>+<value> addition
;<value>-<value> subtraction
;. 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)
; the value-producing commands Q, W, FN, FO, FTI, FZ, F*, F/, #
;
; Commands
;
;Values may occur wherever n or m occur.
;Integers in braces are default values.
;Valid Qregs are 0 through 9, A through Z, and *.
;
; characters, lines, words
;
;<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 FTS~$ nT (m is the print mode)
;
; strings
;
;I[string] insert text (<tab> is equivalent)
;<n>{1}R[string1][string2] replace the nth instance of s1 with s2
; (a null second string simply deletes the first string)
;<n>{1}S[string] search n times for the string
;
; Q-registers
;
;A[Qreg] change the editing context to the Qreg (initially Qreg *)
;B[Qreg] save the last command in the Qreg
; (the command is inserted if the Qreg is the one being edited;
; otherwise the command replaces the Qreg's contents)
;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
;<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
;
; input-output
;
;EG[string] write file, exit and go
;EE exit without writing a file
;EN[string] set the default file name used by EG, ER, EV, EW, EX
;EP[Qreg][string] put the file into the Qreg
;ER[string] read file
;EV[string] verify existence of file -- return value (0 for success)
;EW[string] write file
;EX[string] write file and exit
;
; iteration
;
;<n>{infinity}< iterate n times
;> end the body of an iteration
;<n>{1}[ iterate n times (like < but with default of 1)
;] end the body of an iteration (like >)
;
; other commands
;
;<n>= print n
;W(B|I|S) return the specified saved pointer position
; (B: before last search, I: start of insert, S: start of search)
;FA return to the Qreg last edited
;<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
; (equivalent to <n><R[string]>)
;<n>{1}FE exit n levels of iteration (equivalent to 0,<n>FCE)
;FG[Qreg] print the text in the Qreg (equivalent to @FTS[Qreg])
;FH halt command execution
;<n>{" "}FI insert n as a character at .
;FK[Qreg] eliminate the contents of the Qreg
;FM[Qreg][Qreg] copy the contents of the first Qreg into the second Qreg
;<n>{1}FN[string] search (like S) and return value (0 for success)
;FO get the value of the character at .
;<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>{" "}FR replace n as a character at .
;<n>{1}FS[string1][string2] replace n instances of s1 with s2
; (equivalent to <n><R[string1][string2]>)
;<n>{0}FTE set echo mode (1:monitor, 0:every char, -1:efficient)
;FTI input a character from the terminal
;<n>{" "}<,m>FTO output n as a character to the terminal (with print mode m)
;<n>{0}FTP set the print mode (-1:direct, 0:terse, 1:verbose)
;<n>FTS[string] output the string to the terminal (with print mode n)
;<n>{1000}FU sleep n milliseconds
;FV[string] set the pointer indicator string used by the V command
;<n>{0}FW set <n> as the window size for the automatically executed V
;<n>{1}<,m>FX[Qreg] equivalent to <n><,m>FP <n><,m>K
;FY[Qreg] verify the syntax of the commands in the Qreg
;FZ[Qreg] get the Z value from the Qreg
;<n,m>F* multiply n by m
;<n,m>F/ divide n by m
;#[char] produce the character's value
;? 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, NB, 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,>
IFN ..SAVC,<JRST .%RETN>>
IFIDN <S><SKIP>,<
IFG N-..SFLG,<..SFLG==N>
JRST .%RETN-N>
>
DEFINE RETN(N)
<.%RETN-N
IFNB <N>,<IFG N-..SFLG,<..SFLG==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
HRRZI REG,(REG)
ADDM REG,EX%PTR>
; SYSTEM DEPENDENT DEFINITIONS
; (((TOPS-10)))
IFL F.SYS,<
F.SEGS==2 ; NUMBER OF SEGMENTS (1 OR 2)
IFE <F.SEGS-2>,<IF1,<PRINTX ... with two segments>>
IFE <F.SEGS-2>,<
TWOSEG
RELOC 400000
>; END TWOSEG
IOCHAN==16
TTCHAN==17
DEFINE TBIN(REG)
< SKIPL FLAGEF
INCHRW REG
SKIPGE FLAGEF
INCHWL REG>
DEFINE TBOUT(REG)
< OUTCHR REG>
DEFINE TSOUT(STRING)
< IRP STRING
< OUTSTR STRING>>
.JBREL==44
.JBFF==121
.JBINT==134
DV.DIR==000004
DV.DTA==000100
ER.ICC==000002
IO.EOF==020000
IO.SUP==000200
>
; (((^^^)))
; (((TENEX)))
IFG F.SYS,<
IFE <F.SYS-1>,< SEARCH STENEX> ; IF TENEX
IFE <F.SYS-2>,< SEARCH MONSYM> ; IF TOPS-20
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>>
>
; (((^^^)))
; ECL interpreter in-core CEXPR version (TOPS-10)
;
; ECL definitions and CEXPR head inserted before ANTE
; entry code replaced from START1 to FIRSTI call
; reentry code replaced at REENT
; exit code replaced from STOP to QUIT
; ECL CEXPR tail inserted before END
; 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 -> EE or EX; <0 -> EG
; superior fork JSYSes
; CFORK
; 1> 1B1+1B3
; 2> AC pointer
; 1< handle
; GTJFN
; 1> 1B2+1B17
; 2> ANTE.EXE 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,FLAGIN
MOVE STACK,[IOWD SSIZE,STACKB]
SETZM IONAME
SETOM FLAGIR
CALLR FIRSTN ; GET OPTIONAL INITIAL FILE NAME
RESET
SKIPE FLAGIF
SETOM FLAGIF
CALLR FIRSTI ; PERFORM LOW LEVEL INITIALIZATION
MOVEI UTIL,1
MOVEM UTIL,FLAGIF
MOVEI UTIL,REANTE
MOVEM UTIL,.JBREN
;
; NON-TEXT INITIALIZATION ABOVE, TEXT INITIALIZATION BELOW
;
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
SETZM EXPRIM
MOVE PTR,[BSIZE*5,,C.B]
CALLR ALLOC ; ALLOCATE COMMAND BUFFER
JRST QUIT
;
; INITIAL READ
;
SKIPE UTIL,FLAGIR
JRST FIRSTF
SKIPE IONAME
CALLR EXFIP ; REMEMBER FILE NAME
JRST INBEG
;
; - TEXT
;
FIRSTF: SKIPN IONAME
JRST INBEG
JUMPG UTIL,FIRSTC
CALLR IO$ER ; READ IN TEXT FILE
JRST INBEG
CALLR EXFIP ; AND REMEMBER FILE NAME
JRST INBEG
;
; - COMMAND
;
FIRSTC: MOVEI PTR,C.B ; CHANGE CONTEXT TO COMMAND BUFFER,
MOVEM PTR,E.B
MOVEI PTR,C.A
MOVEM PTR,E.A
MOVEI PTR,C.Z
MOVEM PTR,E.Z
MOVEI PTR,C.P
MOVEM PTR,E.P
CALLR IO$ER ; READ IN COMMAND FILE,
SETZ UTIL,
MOVEI PTR,<Q.$+Q.B> ; CHANGE CONTEXT BACK TO EDIT BUFFER,
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
JUMPE UTIL,INBEG
JRST EXPAS1 ; AND EXECUTE THE COMMANDS.
REENT: RESET
MOVE STACK,[IOWD SSIZE,STACKB]
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 @INHAND(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$F: CALLR TERME ; ^F
TBIN <CH>
CAIE CH,"F"-100
JRST INNE$0
CALLR TERME
MOVEM N,C.Z
HRLI PTR,C.B
HRRI PTR,B.B
CALLR EXQTOQ
JRST INBEG$
JRST INBEG$
IN$G: CALLR TERME ; ^G
TBIN <CH>
CAIE CH,"G"-100
JRST INNE$0
CALLR TERME
JRST INBEG$
IN$H%: JUMPN N,IN$H%1 ; ^H
SETOM EX%B
MOVE UTIL,[BYTE (7)"-","L",33,0,0]
MOVEM UTIL,@C.B
MOVEI N,3
JRST EXBEG
IN$H%1: CAIE CH,"H"-100
JRST INSERT
CALLR INSUB
JRST INBEG$
CAIN CH,11
JRST IN$H%2
CAIN CH,15
JRST IN$H%2
CAIN CH,12
JRST IN$H%3
CAIN CH,37
JRST IN$H%3
TSOUT <BSDEL>
CAIL CH," "
JRST INNEXT
CAIN CH,33
JRST INNEXT
TSOUT <BSDEL>
JRST INNEXT
IN$H%2: MOVEI UTIL,15
TBOUT <UTIL>
MOVEI UTIL,12
JRST IN$R0
IN$H%3: TSOUT <CRLF>
JRST INNEXT
IN$J: JUMPN N,INSERT ; <LINE-FEED>
SETOM EX%B
MOVE UTIL,[BYTE (7)"L",33,0,0,0]
MOVEM UTIL,@C.B
MOVEI N,2
SKIPLE FLAGEF
JRST EXBEG$
JRST EXBEG
IN$L: JUMPN N,INSERT ; ^L
SETOM EX%B
MOVE UTIL,[BYTE (7)"-","N",33,0,0]
MOVEM UTIL,@C.B
MOVEI N,3
JRST EXBEG
IN$N: JUMPN N,INSERT ; ^N
SETOM EX%B
MOVE UTIL,[BYTE (7)"N",33,0,0,0]
MOVEM UTIL,@C.B
MOVEI N,2
JRST EXBEG
IN$R: LDB UTIL,PTR ; ^R
IN$R0: JUMPE N,INBEG$
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>
LDB CH,PTR
CAIN CH,12
JRST INNEXT
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 BSIZE,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
HRRZ UTIL,Q.B(PTR)
CAIN FLAG,(UTIL)
JRST EXEND2 ; BUFFER NEED NOT BE MOVED
HRRM FLAG,Q.B(PTR) ; MOVE Q.B DOWN
JUMPE N,EXEND2
HRLI UTIL,(UTIL)
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
HRLI PTR,C.B
HRRI PTR,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
EX$A0: JUMPL FLAG,EXNEXT ; -- END PARSING
CALLR EXESTS
MOVE UTIL,E.B
MOVEM UTIL,EX%A
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
CALLR EXESTS
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,STOP)
LETEST (G,EX$EW)
LETEST (N,EX$EN)
LETEST (P,EX$EP)
LETEST (R,EX$ER)
LETEST (V,EX$EV)
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 (E,EX$FE)
LETEST (G,EX$FG)
LETEST (H,EX$FH)
LETEST (I,EX$FI)
LETEST (K,EX$FK)
LETEST (M,EX$FM)
LETEST (N,EX$FN)
LETEST (O,EX$FO)
LETEST (P,EX$FP)
LETEST (Q,EX$FQ)
LETEST (R,EX$FR)
LETEST (S,EX$FS)
LETEST (T,EX$FT$)
LETEST (U,EX$FU)
LETEST (V,EX$FV)
LETEST (W,EX$FW)
LETEST (X,EX$FP)
LETEST (Y,EX$FY)
LETEST (Z,EX$FZ)
CAIN CH,"/"
JRST EX$F%D
CAIN CH,"*"
JRST EX$F%M
JRST EXER05
EX$G: TRNE FLAG,-1
JRST EXER01
A$QREG
JUMPL FLAG,EXNEXT ; -- END PARSING
SKIPG Q.Z(PTR)
JRST EXER09
CAMN PTR,E.B
JRST EXER10
EX$G0: MOVE UTIL,FLAG
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
A$$END ; -- END PARSING
SETZ M, ; INDICATE EXECUTION ENABLED (SEE EX$FY)
EX$M0: MOVE FLAG,UTIL
SKIPG UTIL,Q.Z(PTR)
JRST EXER09
CAMN PTR,E.B
JRST EXER10
MOVE N,LEVEL
CALLR EXESAV
HRRZM PTR,EX%Q
MOVEM UTIL,EX%N
HRR UTIL,Q.B(PTR)
HRLI UTIL,440700
MOVEM UTIL,EX%PTR
SETZ LEVEL,
TLO FLAG,F$EM ; SET UP NEW EXECUTING QREG
SKIPE M
TLO FLAG,F$EI ; INHIBIT EXECUTION
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 EXER10
CALLR EXESTS
CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
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: JUMPE V2,EXNEXT
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 EXER16
EX$R2B: TRNE UTIL,F$VC
AOJA V1,EX$R2$
AOJE V1,EX$R3
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 EXER16
EX$R2F: CALLR EXESF ; SEARCH FORWARD
JRST EXER16
TRNE UTIL,F$VC
SOJA V1,EX$R2$
SOJE V1,EX$R3
CALLR EXAV ; (SHOW INTERMEDIATE RESULTS)
JRST EX$R2F
EX$R2$: PUSH STACK,N ; REPLACE EACH INSTANCE (FS AND FS)
EX$R3: 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$R5 ; S STRING LENGTH = R STRING LENGTH
JUMPG N,EX$R4
MOVN N,N
CALLR EXEBC ; S STRING LENGTH > R STRING LENGTH (CONTRACT)
JRST EX$R5
EX$R4: CALLR EXEBIP
EX$R4$: CALLR EXEBE ; S STRING LENGTH < R STRING LENGTH (EXPAND)
EX$R5: 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
JRST EXER16
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
MOVE N,V2
CALLR EXPRIS ; OUTPUT TEXT
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
CALLR EXLINE ; NT SUPPLIES REMAINDER OF LENGTH
MOVE M,N
ADD M,V2
JUMPE M,EX$V0
CALLR EXBPE
CALLR EXPRIS
TSOUT <EXVPTR>
MOVE N,V2
CALLR EXPRIS
EX$V0: 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
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
MOVE N,V1
CALLR EXESAV
JUMPL FLAG,EXNEXT ; -- END PARSING
JUMPG N,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$PC!F$O
JRST EXER02
TRO FLAG,F$OS
JRST EXNEXT
; #
EX$$N: TRNE FLAG,F$P
JRST EXER01
MOVEI UTIL,(CH)
CALLR EXCHAR
MOVEI N,(CH)
MOVEI CH,(UTIL)
CALLR EXVALS ; PRODUCE VALUE ARG
JRST EXER01
JRST EXNEXT
; +
EX$$P: TRNE FLAG,F$PC!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,EXER15
SUBI LEVEL,1
JUMPGE FLAG,EX$$R0
POP ENVIR,UTIL ; EXECUTION INHIBITED
POP ENVIR,UTIL
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 ; GET ITERATION COUNT
POP ENVIR,PTR ; GET COMMAND POINTER
POP ENVIR,N ; GET COMMAND COUNT
POP ENVIR,X1 ; GET FLAGS
POP ENVIR,M ; GET QREG POINTERS
SOJLE V2,EXNEXT ; ITERATE NO LONGER
TRZ FLAG,-1 ; (LEAVE NO ARGS)
PUSH ENVIR,M
PUSH ENVIR,X1
PUSH ENVIR,N
PUSH ENVIR,PTR
PUSH ENVIR,V2
MOVEM PTR,EX%PTR
MOVEM N,EX%N
SKIPN EX%Q ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
AOJA LEVEL,EXNEXT
HLRZ M,M
EXQPTR <M>
AOJA LEVEL,EXNEXT ; ITERATE AGAIN
; /
EX$$S: TRNE FLAG,F$VC!F$V2!F$P
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
MOVEI UTIL,(CH)
MOVE CH,EX%CH
CALLR M$S.I ; ACCEPT INTEGER
JRST EXER14
MOVEI CH,(UTIL)
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 IONAME ; CLEAR NAME BUFFER
JRST EX$EN3
EX$EN1: MOVE M,EX%S1P
TRNE UTIL,F$PS
IBP M
MOVE PTR,[440700,,IONAME]
EX$EN2: ILDB CH,M
IDPB CH,PTR ; MOVE TEXT INTO NAME BUFFER
SOJG N,EX$EN2
SETZ CH,
IDPB CH,PTR
EX$EN3: CALLR EXFIP ; SET FILE NAME
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
CALLR EXESTS
CALLR EXFIG
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)
MOVEI M,(PTR)
MOVE N,E.B
MOVEM M,E.B ; SET EDIT BUFFER TO QREG
ADDI M,1
MOVEM M,E.A
ADDI M,1
MOVEM M,E.Z
ADDI M,1
MOVEM M,E.P
SETZ UTIL,
CALLR IO$ER ; READ FILE
SETO UTIL,
MOVEM N,E.B ; RESET EDIT BUFFER
ADDI N,1
MOVEM N,E.A
ADDI N,1
MOVEM N,E.Z
ADDI N,1
MOVEM N,E.P
JUMPN UTIL,EXERER
JRST EXNEXT
EX$ER: TRNE FLAG,F$V!F$PC!F$O
JRST EXER04
A$STR <1>
A$$END ; -- END PARSING
MOVE PTR,E.B
CALLR EXFIG ; PRODUCE FILE NAME
CALLR IO$ER ; READ FILE
JRST EXERER
CALLR EXFIP
JRST EXNEXT
EX$EV: TRNE FLAG,F$V!F$PC!F$O
JRST EXER04
A$STR <1>
MOVE UTIL,FLAG
TRZ FLAG,-1
TRO FLAG,F$V1
JUMPL FLAG,EXNEXT ; -- END PARSING
SETO V1,
MOVE PTR,E.B
CALLR EXFIG
CALLR IO$EV ; VERIFY EXISTENCE OF FILE
JRST EXNEXT ; IF FAILURE THEN RETURN -1
SETZ V1, ; ELSE RETURN 0
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 PTR,E.B
CALLR EXFIG ; PRODUCE FILE NAME
CALLR IO$EW ; WRITE FILE
JRST EXERER
CALLR EXFIP
MOVE CH,EX%CH
LETEST (G,STOPGO)
LETEST (X,STOP)
JRST EXNEXT
EX$FA: TRNE FLAG,-1
JRST EXER06
MOVE PTR,EX%A
CAIL PTR,Q.0
CAILE PTR,Q.$
JRST EXNEXT ; VERIFY THAT SAVED QREG IS A QREG
JRST EX$A0
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$FE: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER06
TRNN FLAG,F$V1
MOVEI V1,1 ; DEFAULT NUMBER OF LEVELS TO RETURN IS 1
TRZ FLAG,-1 ; LEAVE NO ARGS
JUMPL FLAG,EXNEXT
TLO FLAG,F$EI ; INHIBIT EXECUTION IF TEST SUCCEEDED
MOVEI V2,(LEVEL)
SUBI V2,-1(V1)
SKIPGE V2
MOVEI V2,0
HRLI LEVEL,(V2)
JRST EXNEXT
EX$FG: TRNE FLAG,-1
JRST EXER06
TRO FLAG,F$PA
JRST EX$FTS
EX$FH: TRNE FLAG,-1
JRST EXER06
JUMPL FLAG,EXNEXT ; -- END PARSING
MOVE STACK,[IOWD SSIZE,STACKB]
JRST EXEND
EX$FI: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER06
A$INT <" ">
A$$END ; -- END PARSING
EX$FI0: 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$FK: TRNE FLAG,-1
JRST EXER01
A$QREG
JUMPL FLAG,EXNEXT ; -- END PARSING
CALLR EXESTS
SETZM Q.Z(PTR)
SETZM Q.P(PTR)
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 EXER10
CALLR EXESTS
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: HLRZ N,(PTR)
CAMN PTR,E.B
JRST EX$FQ2
CAMN PTR,EX%A
JRST EX$FQ2
SKIPN Q.A(PTR)
JUMPE N,EX$FQ6
EX$FQ2: TSOUT <[ASCIZ/In /]>
CALLR QNOUT
CAME PTR,E.B
JRST EX$FQ3
TSOUT <[ASCIZ/ (now being edited)/]>
EX$FQ3: CAME PTR,EX%A
JRST EX$FQ4
TSOUT <[ASCIZ/ (last edited)/]>
EX$FQ4: JUMPE N,EX$FQ5
SUBI N,1
IMULI N,NSIZE
ADD N,N.B ; CONVERT FILE NAME INDEX TO POINTER
SKIPN (N)
JRST EX$FQ5
TSOUT <[ASCIZ/ (editing /],(N),[ASCIZ/)/]>
EX$FQ5: 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$FQ6: ADDI PTR,PBLOCK
CAIE PTR,E.B
JRST EX$FQ1
JRST EXNEXT
EX$FR: TRNE FLAG,F$VC!F$V2!F$P!F$O
JRST EXER06
A$INT <" ">
A$$END ; -- END PARSING
MOVE PTR,@E.P
CAML PTR,@E.Z
JRST EX$FI0
CALLR EXBPE
IDPB V1,PTR ; REPLACE CHARACTER
AOS @E.P ; AND INCREMENT .
CALLR EXAV ; (IMPLICIT V)
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 (O,EX$FTO)
LETEST (P,EX$FTP)
LETEST (S,EX$FTS)
MOVEI CH,(UTIL)
JRST EXER06
EX$FTE: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER07
A$INT <0>
A$$END ; -- END PARSING
MOVEM V1,FLAGEF
CALLR ECHOS
JRST EXNEXT
EX$FTI: TRNE FLAG,F$P
JRST EXER07
JUMPL FLAG,EX%FTI
TBIN <CH>
MOVEI N,(CH)
EX%FTI: CALLR EXVALS ; PRODUCE CHAR VALUE
JRST EXER07
JRST EXNEXT
EX$FTO: TRNE FLAG,F$VC!F$P!F$O
JRST EXER07
TRZN FLAG,F$V2
MOVE V2,EXPRIM
A$INT <" ">
A$$END ; -- END PARSING
MOVEI CH,(V1)
JUMPL V2,EX%FTO
SKIPN V2
CALLR TERMO
SKIPE V2
CALLR TERMV
JRST EXNEXT
EX%FTO: TBOUT <CH>
JRST EXNEXT
EX$FTP: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER07
A$INT <0>
A$$END ; -- END PARSING
MOVEM V1,EXPRIM ; SET <N> FOR PRINT MODE
JRST EXNEXT
EX$FTS: TRNE FLAG,F$VC!F$V2!F$PC!F$O
JRST EXER07
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 PTR,EX%S1P
JUMPE N,EXNEXT
TRNE UTIL,F$PS
IBP PTR
CALLR EXPRIS ; OUTPUT STRING
MOVEM V2,EXPRIM
JRST EXNEXT
EX$FU: TRNE FLAG,F$VC!F$V2!F$P
JRST EXER07
A$INT <^D1000>
A$$END ; -- END PARSING
IFL F.SYS,<
IDIVI V1,^D17 ; ~ 17 MILLISECONDS/JIFFY
SETZ X1, ; 0 SECONDS = 1 JIFFY
EX$FU$: SLEEP X1,
SOJG V1,EX$FU$
>; END TOPS-10
IFG F.SYS,<
MOVE X1,V1
DISMS
>; END TENEX
JRST EXNEXT
EX$FV: TRNE FLAG,F$V!F$PC!F$O
JRST EXER06
A$STR <1>
A$$END ; -- END PARSING
MOVE N,EX%S1N
CAIL N,9
JRST EXER13
MOVE M,EX%S1P
MOVE PTR,[440700,,EXVPTR]
JUMPE N,EX$FV2
EX$FV1: ILDB CH,M
IDPB CH,PTR ; STORE POINTER TEXT
SOJG N,EX$FV1
EX$FV2: SETZ CH,
IDPB CH,PTR
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
EX$FY: A$QREG
A$$END ; -- END PARSING
SETO M, ; INDICATE EXECUTION INHIBITED
JRST EX$M0
EX$FZ: TRNE FLAG,F$P
JRST EXER01
MOVEI UTIL,(CH)
A$QREG
TLNN FLAG,F$EI
MOVE N,Q.Z(PTR)
MOVEI CH,(UTIL)
CALLR EXVALS ; PRODUCE VALUE ARG
JRST EXER01
JRST EXNEXT
EX$F%D: TRNE FLAG,F$VC!F$P!F$O
JRST EXER06
TRNN FLAG,F$V1
JRST EXER06
TRZN FLAG,F$V2
JRST EXER06
IDIV V1,V2 ; DIVIDE
JRST EXNEXT
EX$F%M: TRNE FLAG,F$VC!F$P!F$O
JRST EXER06
TRNN FLAG,F$V1
JRST EXER06
TRZN FLAG,F$V2
JRST EXER06
IMUL V1,V2 ; MULTIPLY
JRST EXNEXT
; ***ARGUMENT HANDLING UTILITIES***
; 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 EXER08
CAIG CH,"9"
JRST EXQRE1
CAIGE CH,"A"
JRST EXER08
CAIG CH,"Z"
JRST EXQRE3
CAIGE CH,"A"+40
JRST EXER08
CAIG CH,"Z"+40
JRST EXQRE2
JRST EXER08
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 EXER12
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 EXER09
CAMN PTR,E.B
JRST EXER10
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 EXLIC3
CAIN CH,15
JRST EXLIC2
CAIN CH,37
JRST EXLIC3
SOJG N,EXLIC1
RETURN
EXLIC2: CAIG N,1
RETURN
ILDB CH,PTR
CAIN CH,12
JRST EXLIC3
SUBI N,2
JUMPG N,EXLIC1
RETURN
EXLIC3: 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
; ***SEARCH UTILITIES***
; 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
CAIN FLAG,"X"-100
SETO FLAG,
MOVE PTR,@E.P
CALLR EXBPE ; PTR GETS .
EXESF1: ADDI M,1 ; INCREMENT PASSED CHAR COUNTER
JUMPL FLAG,EXESF2 ; ^X MATCHES ANYTHING
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 V2,"X"-100
AOJA V1,EXESF3 ; ^X MATCHES ANYTHING
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
CAIN FLAG,"X"-100
SETO FLAG,
MOVE PTR,N
CALLR EXBPE
EXESB1: JUMPL FLAG,EXESB2 ; ^X MATCHES ANYTHING
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 V2,"X"-100
AOJA V1,EXESB3 ; ^X MATCHES ANYTHING
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
; ***TEXT MOVEMENT UTILITIES***
; 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
; 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
; QREG SOURCE POINTER BEFORE ALLOCATE -- CONVERT TO PBLOCK
; IN: M -- TEXT POINTER
; OUT: PTR -- CURRENT Q.B,,PBLOCK POINTER
;
EXQSB: BEGINR <V1,V2>
HRRZI V1,(M)
HRRZI PTR,Q.0
HRRZ V2,Q.B(PTR)
CAIGE V1,(V2)
RETURN ; IF SOURCE IS BELOW Q.0 THEN DONE
EXQSB1: HRRZ V2,<Q.B+PBLOCK>(PTR)
CAIGE V1,(V2)
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
; ***MISCELLANEOUS UTILITIES***
EXCHAR: BEGINR
EXCH1: SOSGE EX%N
JRST EXCH2
ILDB CH,EX%PTR
JUMPL FLAG,RETN(0)
SKIPE EXDBUG
CALLR TERMV
RETURN
EXCH2: JUMPN LEVEL,EXER15
CALLR EXERES
JRST .+2
JRST EXCH1
MOVE STACK,[IOWD SSIZE,STACKB]
POPJ ENVIR, ; IF NOT EXECUTING A MACRO THEN RETURN
ENDR
; AUTOMATIC V
;
EXAV: BEGINR
TLNE FLAG,F$EM ; IF EXECUTING MACRO THEN SKIP V
RETURN
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
CALLR EXLINE ; NT SUPPLIES REMAINDER OF LENGTH
MOVE M,N
ADD M,V2
JUMPE M,RETN(0)
CALLR EXBPE
CALLR EXPRIS
TSOUT <EXVPTR>
MOVE N,V2
CALLR EXPRIS
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: SETZM Q.P(V2)
MOVEM N,Q.Z(V2) ; SET QREG USED COUNT
JUMPE N,RETN(1)
SUBI N,1
IDIVI N,5
HRRZ PTR,Q.B(V2)
ADDI N,(PTR)
HRL PTR,(V1) ; MOVE FROM QREG 1
HRR PTR,(V2) ; TO QREG 2
BLT PTR,(N) ; UNTIL (QREG 2 POINTER) + SIZE - 1
ENDR SKIP,1
; FILE NAME GET
; IN: PTR -- POINTER TO QREG
; UTIL -- ARGUMENT FLAGS
;
EXFIG: BEGINR <CH,PTR,N,M>
SETZM IONAME
SKIPE N,EX%S1N
JRST EXFIG3
SKIPN N.V
JRST EXFIG1
HLRZ PTR,(PTR)
JUMPE PTR,EXFIG1
SUBI PTR,1
IMULI PTR,NSIZE
ADD PTR,N.B ; CONVERT FILE NAME INDEX TO POINTER
SKIPE (PTR)
JRST EXFIG2
EXFIG1: TSOUT <[ASCIZ/ ? No default file name ?/],CRLF>
JRST EXERER
EXFIG2: HRLI PTR,(PTR)
HRRI PTR,IONAME
BLT PTR,<IONAME+NSIZE-1> ; USE PREVIOUS FILE NAME
RETURN
EXFIG3: CAIL N,<NSIZE*5>
JRST EXER13
MOVE M,EX%S1P
TRNE UTIL,F$PS
IBP M
MOVE PTR,[440700,,IONAME]
EXFIG4: ILDB CH,M
IDPB CH,PTR ; MOVE TEXT INTO FILE NAME BUFFER
SOJG N,EXFIG4
SETZ CH,
IDPB CH,PTR
ENDR
; FILE NAME PUT
;
EXFIP: BEGINR <PTR,N,M,UTIL>
MOVE PTR,E.B
HLRZ UTIL,(PTR)
JUMPN UTIL,EXFIP4
SKIPN IONAME
RETURN
MOVE N,N.V ; GET NAME SPACE FOR THIS QREG
CAME N,N.P
JRST EXFIP1
MOVEI UTIL,<NSIZE*5>
ADDB UTIL,N.Z
CAMG UTIL,N.A
JRST EXFIP0
MOVE M,PTR
MOVE PTR,[NSIZE*5,,N.B]
CALLR ALLOC ; ALLOCATE NEW NAME SPACE
RETURN
MOVE PTR,M
EXFIP0: ADDI N,1
MOVEM N,N.V ; INCREMENT COUNT OF ALLOCATED NAMES
JRST EXFIP3
EXFIP1: MOVE M,N.B
MOVEI N,1
EXFIP2: SKIPN (M) ; REUSE OLD (ZEROED) NAME SPACE
JRST EXFIP3
ADDI M,NSIZE
AOJA N,EXFIP2
EXFIP3: AOS N.P ; INCREMENT COUNT OF USED NAMES
MOVEI UTIL,(N)
HRLM UTIL,(PTR) ; SET FILE NAME INDEX OF QREG
JRST EXFIP5
EXFIP4: SKIPE IONAME
JRST EXFIP5
SUBI UTIL,1
IMULI UTIL,NSIZE
ADD UTIL,N.B
SETZM (UTIL)
SOS N.P ; ZERO AND DEALLOCATE NAME SPACE
HRRZS (PTR)
RETURN
EXFIP5: IMULI UTIL,NSIZE
ADD UTIL,N.B
HRLI PTR,IONAME
HRRI PTR,-NSIZE(UTIL)
BLT PTR,-1(UTIL) ; COPY FILE NAME TO QREG NAME SPACE
ENDR
; ENVIRONMENT SAVING
; IN: N -- VALUE TO STACK
;
EXESAV: BEGINR <UTIL>
HLRO UTIL,ENVIR
CAML UTIL,[-5]
JRST EXER17
SKIPE UTIL,EX%Q
HRL UTIL,@EX%Q
HRR UTIL,EX%Q
PUSH ENVIR,UTIL ; SAVE MACRO TEXT POINTER,,MACRO QREG POINTER
PUSH ENVIR,FLAG ; AND FLAGS
PUSH ENVIR,EX%N ; AND COMMAND COUNT
PUSH ENVIR,EX%PTR ; AND COMMAND POINTER
PUSH ENVIR,N ; AND VALUE
ENDR
; ENVIRONMENT RESTORING
;
EXERES: BEGINR <PTR,UTIL>
TLNN FLAG,F$EM
RETURN
POP ENVIR,LEVEL ; RESTORE ITERATION LEVEL
POP ENVIR,EX%PTR ; AND COMMAND POINTER
POP ENVIR,EX%N ; AND COMMAND COUNT
POP ENVIR,UTIL
HLL FLAG,UTIL ; AND FLAGS
POP ENVIR,UTIL
HRRZI PTR,(UTIL)
MOVEM PTR,EX%Q ; AND QREG POINTER
JUMPE PTR,RETN(1)
HLRZ PTR,UTIL
EXQPTR <PTR> ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
ENDR SKIP,1
; ENVIRONMENT STACK SCAN
; IN: PTR -- QREG POINTER
;
EXESTS: BEGINR <M,N>
CAMN PTR,EX%Q
JRST EXER11 ; DESTINATION QREG IS BEING EXECUTED
HRRZI M,<ENVIRB+1>
EXESS0: CAIL M,(ENVIR) ; SCAN ENVIRONMENT STACK
RETURN
HRRZ N,(M) ; GETTING EACH QREG POINTER
CAIN PTR,(N)
JRST EXER11 ; DESTINATION QREG IS BEING EXECUTED
ADDI M,5
JRST EXESS0
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
; ***ERRORS***
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/ ? Bad argument to FT/]>
JRST EXERE1
EXER08: TSOUT <[ASCIZ/ ? Nonexistent Q register /]>
JRST EXERE1
EXER09: TSOUT <[ASCIZ/ ? Empty Q register /]>
JRST EXERE1
EXER10: TSOUT <[ASCIZ/ ? Now editing Q register /]>
JRST EXERE1
EXER11: TSOUT <[ASCIZ/ ? Now executing Q register /]>
JRST EXERE1
EXER12: TSOUT <[ASCIZ/ ? Unterminated string/]>
JRST EXERE2
EXER13: TSOUT <[ASCIZ/ ? String too long/]>
JRST EXERE2
EXER14: TSOUT <[ASCIZ/ ? Improper digit in integer string/]>
JRST EXERE2
EXER15: TSOUT <[ASCIZ/ ? Unbalanced angle brackets/]>
JRST EXERE2
EXER16: JUMPN LEVEL,EXERS1
CALLR EXERES
JRST EXERS2
JRST EXER16
EXERS1: TLO FLAG,F$EI ; (IF IN <> THEN INHIBIT FURTHER EXECUTION)
HRLI LEVEL,(LEVEL)
JRST EXNEXT
EXERS2: TSOUT <[ASCIZ/ ? Cannot find '/]>
MOVE N,S.B
EXERS3: MOVE CH,(N)
JUMPL CH,EXERS4
CALLR TERMV
AOJA N,EXERS3
EXERS4: MOVEI UTIL,"'"
TBOUT <UTIL>
JRST EXERE2
EXER17: 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: 000,,EXER00 ; ^@
01,,EXER00 ; ^A
000,,EXER00 ; ^B
000,,EXER00 ; ^C
000,,EXER00 ; ^D
02,,EXER00 ; ^E
03,,EXER00 ; ^F
04,,EXER00 ; ^G
05,,EXER00 ; ^H
000,,EX$$I ; <TAB>
06,,EXNEXT ; <LINE-FEED>
000,,EXER00 ; ^K
07,,EXER00 ; ^L
000,,EXNEXT ; <CARRIAGE-RETURN>
10,,EXER00 ; ^N
000,,EXER00 ; ^O
000,,EXER00 ; ^P
000,,EXER00 ; ^Q
11,,EXER00 ; ^R
000,,EXER00 ; ^S
000,,EXER00 ; ^T
12,,EXER00 ; ^U
13,,EXER00 ; ^V
14,,EXER00 ; ^W
000,,EXER00 ; ^X
000,,EXER00 ; ^Y
000,,EXER00 ; ^Z
15,,EXNEXT ; <ESCAPE>
000,,EXER00 ; ^\
000,,EXER00 ; ^]
05,,EXER00 ; ^^
16,,EXNEXT ; <END-OF-LINE>
000,,EXNEXT ; <SPACE>
000,,EX$$EX ; !
000,,EXER00 ; "
000,,EX$$N ; #
000,,EXER00 ; $
000,,EX$% ; %
000,,EXER00 ; &
000,,EXER00 ; '
000,,EXER00 ; (
000,,EXER00 ; )
000,,EXER00 ; *
000,,EX$$P ; +
000,,EX$$CA ; ,
000,,EX$$M ; -
000,,EX$. ; .
000,,EX$$S ; /
000,,EX$0 ; 0
000,,EX$0 ; 1
000,,EX$0 ; 2
000,,EX$0 ; 3
000,,EX$0 ; 4
000,,EX$0 ; 5
000,,EX$0 ; 6
000,,EX$0 ; 7
000,,EX$0 ; 8
000,,EX$0 ; 9
000,,EX$$CN ; :
000,,EX$$$S ; ;
000,,EX$$L ; <
000,,EX$$EQ ; =
000,,EX$$R ; >
000,,EX$$Q ; ?
000,,EX$$A ; @
000,,EX$A ; A
000,,EX$B ; B
000,,EX$C ; C
000,,EX$D ; D
000,,EX$E$ ; E
000,,EX$F$ ; F
000,,EX$G ; G
000,,EX$H ; H
000,,EX$I ; I
000,,EX$J ; J
000,,EX$K ; K
000,,EX$L ; L
000,,EX$M ; M
000,,EX$N ; N
000,,EX$O ; O
000,,EX$P ; P
000,,EX$Q ; Q
000,,EX$R ; R
000,,EX$S ; S
000,,EX$T ; T
000,,EX$U ; U
000,,EX$V ; V
000,,EX$W ; W
000,,EX$P ; X
000,,EXER00 ; Y
000,,EX$Z ; Z
000,,EX$$L ; [
000,,EXER00 ; \
000,,EX$$R ; ]
000,,EXER00 ; ^
000,,EXER00 ; _
000,,EXER00 ; `
000,,EX$A ; a
000,,EX$B ; b
000,,EX$C ; c
000,,EX$D ; d
000,,EX$E$ ; e
000,,EX$F$ ; f
000,,EX$G ; g
000,,EX$H ; h
000,,EX$I ; i
000,,EX$J ; j
000,,EX$K ; k
000,,EX$L ; l
000,,EX$M ; m
000,,EX$N ; n
000,,EX$O ; o
000,,EX$P ; p
000,,EX$Q ; q
000,,EX$R ; r
000,,EX$S ; s
000,,EX$T ; t
000,,EX$U ; u
000,,EX$V ; v
000,,EX$W ; w
000,,EX$P ; x
000,,EXER00 ; y
000,,EX$Z ; z
000,,EXER00 ; {
000,,EXER00 ; |
000,,EXER00 ; }
000,,EXER00 ; ~
01,,EXER00 ; <RUBOUT>
; INPUT HANDLER DISPATCH TABLE (INDEXED BY LH OF CHARACTER DISPATCH TABLE)
;
INHAND: INSERT ; 000
IN$A% ; 01
IN$E ; 02
IN$F ; 03
IN$G ; 04
IN$H% ; 05
IN$J ; 06
IN$L ; 07
IN$N ; 10
IN$R ; 11
IN$U ; 12
IN$V ; 13
IN$W ; 14
IN$$ ; 15
IN$% ; 16
; ***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
HRRZ UTIL,<PBLOCK+Q.B>(PTR)
ALLOC2: CAIGE M,(UTIL)
JRST ALLOC3
MOVE X1,(M)
MOVEM X1,(N) ; MOVE UP WORDS UNTIL THE SOURCE POINTER (M)
SUBI M,1 ; EQUALS THE BLOCK POINTER OF THE QREG ABOVE
SOJA N,ALLOC2 ; THE ONE FOR WHICH SPACE IS BEING ALLOCATED
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/]>
IFG F.SYS,<
HRRZI 0,RESUME
>; END TENEX
CALLR SUSPEN
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
SKIPN FLAGEF
JRST TERME1 ; IF 0 THEN ECHO ALL
SKIPL FLAGEF ; IF - THEN ECHO SOME
RETURN ; IF + THEN ECHO NONE
CAIN CH,177
JRST TERME2
CAIL CH," "
RETURN
TERME1: CAIE CH,7
JRST TERME2
TBOUT <CH>
RETURN
TERME2: 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
SKIPLE FLAGIF
JRST FIRSIR
SKIPE FLAGIF
JRST FIRSIS
;
; ** ONE-TIME INITIALIZATION
;
; -- IO BUFFERS
;
HRRZ X1,.JBFF
HRRZI X2,BUFLIS
FIRSI1: SKIPN X3,(X2) ; LOOP THROUGH BUFFER LIST (NOW BUFFER SIZE --
JRST FIRSI2 ; CONVERTED BY ALL THIS CODE TO BUFFER PTR)
ADDI X1,3(X3) ; COMPUTING TOTAL SPACE NEEDED
AOJA X2,FIRSI1 ; FOR ALL IO BUFFERS
FIRSI2: HRRZ X2,.JBREL
CAILE X2,(X1) ; IF THERE IS NOT ENOUGH CORE
JRST FIRSI3
CORE X1, ; THEN ALLOCATE MORE
JRST QUIT
FIRSI3: HRRZ X1,.JBFF ; INITIALIZE
ADDI X1,1 ; PTR TO IO BUFFERS
HRRZI X2,BUFLIS ; PTR TO BUFFER SIZE/PTR LIST
FIRSI4: SKIPN X3,(X2) ; GET SIZE OF IO BLOCK
JRST FIRSI5 ; (DONE IF ZERO)
MOVEM X1,(X2) ; SAVE BUFFER HEADER ADDRESS IN BUFFER SIZE/PTR
SETZM -1(X1) ; ZERO FIRST WORD OF HEADER
HRLI X4,(X3) ; SECOND HEADER WORD IS
HRRI X4,(X1) ; SIZE,,NEXT PTR
ADDI X4,3(X3)
MOVEM X4,(X1)
SETZM 1(X1) ; ZERO THIRD WORD OF HEADER
ADDI X1,3(X3) ; MOVE TO NEXT BUFFER IN PAIR
ADDI X2,1 ; AND NEXT BUFFER SIZE/PTR
MOVEM X1,(X2) ; SAVE BUFFER HEADER ADDRESS
SETZM -1(X1) ; ZERO FIRST WORD OF HEADER
HRLI X4,(X3) ; SECOND HEADER WORD IS
HRRI X4,(X1) ; SIZE,,NEXT PTR
SUBI X4,3(X3)
MOVEM X4,(X1)
SETZM 1(X1) ; ZERO THIRD WORD OF HEADER
ADDI X1,3(X3) ; MOVE TO NEXT BUFFER
ADDI X2,1 ; AND NEXT BUFFER SIZE/PTR
JRST FIRSI4
;
; -- ROUND OFF FIRST FREE
;
FIRSI5: ADDI X1,<77-1> ; (-1 -- BUFFER PTR POINTS TO SECOND FREE)
LSH X1,-6
LSH X1,6 ; ROUND OFF FIRST FREE TO NEAREST 100
MOVEM X1,TEXTFF
;
; ** START
;
; -- SET ECHO MODE TO EFFICIENT
;
FIRSIS: SETOM FLAGEF
;
; -- INITIALIZE ZW TO JOBREL
;
MOVE X1,.JBREL
ADDI X1,1
MOVEM X1,ZW
;
; -- INITIALIZE ZU TO TEXT FIRST FREE
;
MOVE X1,TEXTFF
MOVEM X1,ZU
;
; ** REENTER
;
; -- SET ECHO MODE
;
FIRSIR: CALLR ECHOS
;
; -- INITIALIZE ^C TRAP
;
MOVEI X1,PSIPSI
HRRM X1,.JBINT
SETZM PSI$PC
ENDR
; The command line can be in one of four forms
; CREATE <filename> (CCL)
; EDIT <filename> (CCL)
; R ANTE -<filename> (OR ;<filename>) (text file)
; R ANTE !<filename> (command file)
;
FIRSTN: BEGINR
SKIPE FLAGIN ; CCL ENTRY USED
JRST FIRSN5
RESCAN ; REGULAR ENTRY USED
MOVE PTR,[440700,,IONAME]
FIRSN1: INCHRW CH
CAIGE CH," "
JRST FIRSN4
CAIN CH,"-" ; TEXT FILE
JRST FIRSN2
CAIN CH,";" ; TEXT FILE
JRST FIRSN2
CAIE CH,"!" ; COMMAND FILE
JRST FIRSN1
HRRZS FLAGIR
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,CCLTMP ; TMP: FILE NAME (CORE)
HLRZM X1,IOFILE ; DSK: FILE NAME (###EDT.TMP)
MOVE X1,[440700,,ENVIRB] ; 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,<CCLTMP+1>
SETZM FLAGIN ; ASSUME TMPCOR WILL SUCCEED
MOVE X1,[2,,CCLTMP]
TMPCOR X1, ; READ AND DELETE TMP:EDT
SOSA FLAGIN ; 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 CCLERR
SETZM <IOFILE+3>
LOOKUP IOCHAN,IOFILE
JRST CCLERR
IN IOCHAN,
JRST .+2
JRST CCLERR
FIRSN7: MOVE PTR,[440700,,IONAME] ; GET FILE NAME
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
CAIN CH,175 ; IF CREATE THEN DO NOT PERFORM INITIAL READ
SETZM FLAGIR
SKIPN FLAGIN ; IF TMPCOR SUCCESSFUL THEN DONE
RETURN
SETZM IOFILE ; DELETE DSK:###EDT.TMP
RENAME IOCHAN,IOFILE
JRST CCLERR
RELEAS IOCHAN,
ENDR
CCLERR: OUTSTR [ASCIZ / ? CCL error ?/]
EXIT
ECHOS: BEGINR <UTIL>
SKIPLE FLAGEF
JRST ECHOS2
SKIPL FLAGEF
JRST ECHOS1
; MOVEI UTIL,2100
; MOVEM UTIL,TTCHAS
; OPEN TTCHAN,TTCHAS ; PROGRAM AND MONITOR ECHO
; JRST .+2
; JRST ECHOS3
SETZM FLAGEF ; OPTIMAL ECHOING IS DISABLED
ECHOS1: MOVEI UTIL,IO.SUP
MOVEM UTIL,TTCHAS
OPEN TTCHAN,TTCHAS ; PROGRAM ECHOS
JRST .+2 ; (CAPTURING ^T IS DONE BY TRMOP)
JRST ECHOS3
HLLOS FLAGEF
ECHOS2: SETZM TTCHAS
OPEN TTCHAN,TTCHAS ; MONITOR ECHOS
EXIT
ECHOS3: HRLI UTIL,400000
HRR UTIL,TTOB1
MOVEM UTIL,TTOBUF
HRLI UTIL,000700
ADDI UTIL,1
MOVEM UTIL,TTOBUF+1
MOVEI UTIL,20
MOVEM UTIL,TTOBUF+2
OUT TTCHAN,
RETURN
EXIT
ENDR
; PRINT STRING
; IN: PTR -- POINTER TO FIRST CHAR
; N -- NUMBER OF CHARS
; OUT: PTR -- UPDATED
EXPRIS: BEGINR <CH,N>
JUMPE N,RETN(0)
SKIPG EXPRIM
JRST EXPRI2
EXPRI1: ILDB CH,PTR
CALLR TERMV
SOJG N,EXPRI1
JRST EXPRI6
EXPRI2: ILDB CH,PTR
SKIPE EXPRIM
JRST EXPRI4
CAIN CH,33
MOVEI CH,"$"
CAIN CH,177
SETO CH,
CAIL CH," "
JRST EXPRI4
CAIN CH,11
JRST EXPRI4
CAIN CH,12
JRST EXPRI4
CAIN CH,15
JRST EXPRI4
MOVEI UTIL,"^"
SOSL <TTOBUF+2>
JRST EXPRI3
OUT TTCHAN, ; OUTPUT DATA
SOS <TTOBUF+2>
EXPRI3: IDPB UTIL,<TTOBUF+1>
ADDI CH,"@"
CAIGE CH,"@"
MOVEI CH,"?"
EXPRI4: SOSL <TTOBUF+2>
JRST EXPRI5
OUT TTCHAN, ; OUTPUT DATA
SOS <TTOBUF+2>
EXPRI5: IDPB CH,<TTOBUF+1>
SOJG N,EXPRI2
OUT TTCHAN, ; OUTPUT TRAILING DATA
JRST .+1
EXPRI6: SKPINC ; CLEAR CONTROL-O
RETURN
ENDR
IO$ER: BEGINR <CH,PTR,N,M>
CALLR IOFNC
RETURN
CALLR IOFNP
OPEN IOCHAN,IOCHAS
JRST IO$ERD
MOVEI PTR,IOCHAS
DEVSIZ PTR,
SETZ PTR,
HRRZI PTR,-2(PTR)
CAILE PTR,<BSIZE+1>
JRST IO$ERD
HRLM PTR,@IOIB1
HRLM PTR,@IOIB2
MOVEI N,IOCHAN
DEVCHR N,
TLNN N,DV.DIR
JRST IO$ER1 ; SKIP LOOKUP IF NO DIRECTORY
LOOKUP IOCHAN,IOFILE ; OPEN FILE
JRST IO$ERF
IO$ER1: HRLI N,400000
HRR N,IOIB1
MOVEM N,IOIBUF
HRLI N,000700
ADDI N,1
MOVEM N,IOIBUF+1
SETZM IOIBUF+2
IO$ER2: IN IOCHAN, ; READ DATA
JRST IO$ER3
STATO IOCHAN,IO.EOF ; 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$EV: BEGINR <N>
CALLR IOFNC
RETURN
OPEN IOCHAN,IOCHAS
JRST IO$EVD
MOVEI N,IOCHAN
DEVCHR N,
TLNN N,DV.DIR
RETURN SKIP,1
LOOKUP IOCHAN,IOFILE
JRST IO$EVR
RELEAS IOCHAN,
RETURN SKIP,1
IO$EVD: OUTSTR [ASCIZ/ ? Device error ?
/]
IO$EVR: 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
MOVEI PTR,IOCHAS
DEVSIZ PTR,
SETZ PTR,
HRRZI PTR,-2(PTR)
CAILE PTR,<BSIZE+1>
JRST IO$EWD
HRLM PTR,@IOOB1
HRLM PTR,@IOOB2
MOVEI M,IOCHAN
DEVCHR M,
TLNN M,DV.DIR
JRST IO$EW5 ; SKIP ENTER IF NO DIRECTORY
MOVE N,IOFILE
MOVE M,<IOFILE+1>
MOVE PTR,<IOFILE+3>
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
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
IO$EW3: MOVEM M,<IOFILE+1>
MOVEM N,<IOFILE+2>
IO$EW4: ENTER IOCHAN,IOFILE ; OPEN FILE
JRST IO$EWF
IO$EW5: HRLI N,400000
HRR N,IOOB1
MOVEM N,IOOBUF
HRLI N,000700
ADDI N,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>
GETPPN UTIL,
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
CAIG 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,DV.DIR
RETURN SKIP,1 ; (DONE IF NONDIRECTORY DEVICE)
TLNE UTIL,DV.DTA ; (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
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>
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
JUMPE CH,RETN(1)
CAIG CH," "
JRST IOFC13
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
JUMPE CH,RETN(1)
CAIG CH," "
JRST IOFC14
CAIN CH,"."
JRST IOFC15
JRST IOFC14
IOFC15: MOVE M,[440600,,<IOFILE+1>]
MOVEI N,3
IOFC16: ILDB CH,PTR
JUMPE CH,RETN(1)
CAIG CH," "
JRST IOFC16
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
; 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
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
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
STOP: CALLR SUSPEN
JRST INBEG
STOPGO: MOVE UTIL,CCLRUN
RUN UTIL,
EXIT
QUIT: EXIT
SUSPEN: BEGINR
RELEAS TTCHAN, ; CLEAR ECHO CHARACTERISTICS
EXIT 1,
DDT$G: CALLR ECHOS ; SET ECHO CHARACTERISTICS
ENDR
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/]
CALLR SUSPEN
PUSH STACK,PSI$PC
SETZM PSI$PC
POPJ STACK,
PSI$C3: POP STACK,UTIL
OUTSTR [ASCIZ/^C/]
CALLR SUSPEN
SETZM PSI$PC
JRST IN$E
>
; (((^^^)))
; (((TENEX)))
IFG F.SYS,<
FIRSTI: BEGINR
SKIPLE FLAGIF
JRST FIRSI1
MOVEI X1,100
RFMOD
MOVEM X2,TMOD
RFCOC
MOVEM X2,TCOC1
MOVEM X3,TCOC2
SETOM FLAGEF
FIRSI1: CALLR ECHOS
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
SKIPLE 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 FLAGIN
JRST FIRSNF
MOVE X1,[SIXBIT/LOADTB/]
SYSGT
JUMPE X2,FIRSN1
;
; TENEX -- CONTINUE COMMAND LINE INPUT
;
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
;
; The command line can be in one of four forms
; CREATE <filename> (CCL)
; EDIT <filename> (CCL)
; R ANTE ;<filename> (text file)
; R ANTE !<filename> (command file)
;
RSCAN==104000,,500 ; THE TOPS-20 RESCAN JSYS
;
FIRSN1: SETZ X1,
RSCAN
RETURN
FIRSN2: PBIN ; PASS OVER LEADING SPACES
CAIGE X1," "
JRST FIRSN9
CAIN X1," "
JRST FIRSN2
CAIE X1,"C" ; CREATE -- NO READ
CAIN X1,"C"+40
JRST FIRSN4
CAIE X1,"E" ; EDIT
CAIN X1,"E"+40
JRST FIRSN5
CAIE X1,"A" ; ANTE
CAIN X1,"A"+40
JRST FIRSN5
FIRSN3: PBIN ; PASS OVER EVERYTHING UP TO ; OR !
CAIGE X1," "
JRST FIRSN9
CAIN X1,";"
JRST FIRSN$
CAIE X1,"!"
JRST FIRSN3
HRRZS FLAGIR
FIRSN$: MOVE UTIL,[440700,,IONAME]
PBIN
JRST FIRSN7
FIRSN4: SETZM FLAGIR
FIRSN5: PBIN ; PASS OVER COMMAND
CAIGE X1," "
JRST FIRSN9
CAIE X1," "
JRST FIRSN5
FIRSN6: PBIN ; PASS OVER TRAILING SPACES
CAIGE X1," "
JRST FIRSN9
CAIN X1," "
JRST FIRSN6
MOVE UTIL,[440700,,IONAME]
FIRSN7: CAIGE X1," "
JRST FIRSN8
IDPB X1,UTIL
PBIN
JRST FIRSN7
FIRSN8: CAIN X1,15
PBIN
SETZ X1,
IDPB X1,UTIL
RETURN
FIRSN9: CAIN X1,15
PBIN
RETURN
;
; INFERIOR FORK ANTE -- GET FILE NAME FROM REGISTERS
;
FIRSNF: MOVEM 0,FLAGIR
MOVEI FLAG,IONAME
HRLI UTIL,1
HRRI UTIL,(FLAG)
BLT UTIL,6(FLAG) ; GET FILE NAME FROM ACS
ENDR
ECHOS: BEGINR
; MOVEI X1,1 ; NSW
; MOVEM X1,FLAGEF ; NSW
SKIPLE FLAGEF
JRST ECHOS2
SKIPL FLAGEF
JRST ECHOS1
SETZM FLAGEF
JRST ECHOS1 ; OPTIMAL ECHOING IS DISABLED
; MOVEI X1,100
; RFMOD
; TRZ X2,776300 ; CLEAR WAKE UP, ECHOING, OUTPUT MODE
; TRO X2,144300 ; WAKE UP ON ^ CHARS, ECHO, OUTPUT ^ CHARS
; SFMOD
; SETZ X2,
; SETZ X3,
; SFCOC ; IGNORE ALL CONTROL CHARACTERS (INPUT ONLY)
; RETURN
ECHOS1: MOVEI X1,100
MOVE X2,TMOD
TRZ X2,006000 ; (1B24+1B25) TURN OFF ECHOING
SFMOD
MOVE X2,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
MOVE X3,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2]
SFCOC ; PASS ALL CONTROL CHARACTERS
RETURN
ECHOS2: MOVEI X1,100
MOVE X2,TMOD
SFMOD ; RESTORE INITIAL CHARACTERISTICS
MOVE X2,TCOC1
MOVE X3,TCOC2
SFCOC
ENDR
; PRINT STRING
; IN: PTR -- POINTER TO FIRST CHAR
; N -- NUMBER OF CHARS
; OUT: PTR -- UPDATED
EXPRIS: BEGINR <CH,N>
JUMPE N,RETN(0)
SKIPG EXPRIM
JRST EXPRI2
EXPRI1: ILDB CH,PTR
CALLR TERMV ; VERBOSE OUTPUT
SOJG N,EXPRI1
RETURN
EXPRI2: SKIPE EXPRIM
JRST EXPRI3
MOVEI X1,101
RFMOD
TRZ X2,000300
TRO X2,000100 ; NORMAL OUTPUT MODE
SFMOD
MOVE X2,[BYTE (2) 1,1,1,1,1,1,1,1,1,2,2,1,1,2,1,1,1,1]
MOVE X3,[BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,1]
SFCOC
MOVE X2,PTR
MOVN X3,N
SOUT ; TERSE OUTPUT
MOVE PTR,X2
CALLR ECHOS
RETURN
EXPRI3: MOVEI X1,101
MOVE X2,PTR
MOVN X3,N
SOUT ; DIRECT OUTPUT
MOVE PTR,X2
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
HRROI X1,IONAME
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$EV: BEGINR
HRLZI X1,100101
HRROI X2,IONAME
GTJFN
RETURN
RLJFN
RETURN SKIP,1
ENDR SKIP,1
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
HRROI X1,IONAME
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
; TOPS-20 COMPIL DEFINITIONS
;
.PRAST==2 ; SET ARGUMENT
.FHSLF==400000 ; FORK HANDLE -- SELF
PRARG==104000,,545
;
STOPGO: SKIPE FLAGIN
JRST STOPOP ; NO GO -- INFERIOR FORK
MOVE X1,[SIXBIT/LOADTB/]
SYSGT
JUMPN X2,STOPOP ; NO GO -- TENEX
MOVE X1,[.PRAST,,.FHSLF] ; FUNCTION CODE
MOVEI X2,[1 ; ARGUMENT BLOCK
400740,,2 ; (THESE ARE ALL MAGIC NUMBERS)
0]
MOVEI X3,3 ; LENGTH OF ARGUMENT BLOCK
PRARG
HALTF
JRST .-1
STOPOP: SETO 0,
CALLR SUSPEN
JRST INBEG
STOP: SETZ 0,
CALLR SUSPEN
JRST INBEG
QUIT: SETZ 0,
CALLR SUSPEN
JRST QUIT
SUSPEN: BEGINR <X1,X2,X3,X4>
MOVE X4,FLAGEF
MOVEI X1,1
MOVEM X1,FLAGEF ; CLEAR ECHO CHARACTERISTICS
CALLR ECHOS
MOVEM X4,FLAGEF
HALTF
RESUME: MOVEI X1,100
RFMOD ; GET TERMINAL CHARACTERISTICS
MOVEM X2,TMOD
RFCOC
MOVEM X2,TCOC1
MOVEM X3,TCOC2
DDT$G: CALLR ECHOS ; SET ECHO CHARACTERISTICS
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
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
BSDEL: BYTE (7)10,40,10,0,0
LIT ; LITERALS GO HERE
; (((TOPS-10)))
IFL F.SYS,<
IFE <F.SEGS-2>,< RELOC 0>
TTCHAS: 0 ; ASCII MODE
SIXBIT /TTY/
TTOBUF,,0
TTOBUF: BLOCK 3
IOCHAS: 0 ; ASCII MODE
SIXBIT /DSK/
IOOBUF,,IOIBUF
IOIBUF: BLOCK 3
IOOBUF: BLOCK 3
; BUFFER ADDRESS LIST -- INITIALIZED IN FIRSTI
; DESIRED BUFFER SIZES ARE CONVERTED INTO POINTERS TO IO BUFFERS
BUFLIS:
TTOB1: <NSIZE+1>
TTOB2: <NSIZE+1>
IOIB1: <BSIZE+1>
IOIB2: <BSIZE+1>
IOOB1: <BSIZE+1>
IOOB2: <BSIZE+1>
0 ; LIST TERMINATION
IOFILE: 0 ; FILE NAME
0 ; EXTENSION
0
0 ; PROJECT,,PROGRAMMER
IOFINB: 16
0 ; PROJECT,,PROGRAMMER
0 ; FILE NAME
0 ; EXTENSION
BLOCK 12
IOFIND: 0 ; LOGICAL DEVICE
CCLTMP: SIXBIT /EDT/ ; TMP: (CORE)
0 ; (IOWD BSIZE,BUFFER)
CCLRUN: 1,,CCLCOM
CCLCOM: SIXBIT /SYS/
SIXBIT /COMPIL/
0
0
0
0
PSIPSI: 4,,PSI$CC
0,,ER.ICC
PSI$PC: 0
0
TEXTFF: 0 ; PTR TO FIRST FREE TEXT (AFTER IO BUFFERS)
>
; (((^^^)))
; (((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 ; INIT FLAG (0:INIT, -1:START, 1: REENTER)
FLAGIN: 0 ; INITIAL FILE NAME (0:NO, -1:YES)
FLAGIR: 0 ; INITIAL READ (0 NONE, - TEXT, + COMMAND)
FLAGEF: 0 ; ECHO FLAG
EXBASE: ^D10
EXDBUG: 0
EXPRIM: 0
EXVPTR: ASCIZ /~/
0
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
EX%A: 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
C.P: 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
N.B: 0 ; FILE NAME BUFFER
N.A: 0
N.Z: 0
N.P: 0 ; NUMBER OF FILE NAME SPACES USED
N.V: 0 ; NUMBER OF FILE NAME SPACES ALLOCATED
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
ENVIRB: BLOCK BSIZE
STACKB: BLOCK SSIZE
END ANTE