Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0145/ante.mac
There are 3 other files named ante.mac in the archive. Click here to see a list.
00100 ; A Nother Text Editor -- W.R. Bush
00200
00300 TITLE ANTE
00400
00500 F.SYS==1 ; -1 IF TOPS-10, 1 IF TENEX/TOPS-20
00600
00700 ; An executable ANTE is made by
00800 ; 1) choosing the operating system ANTE is to run under by
00900 ; a) setting the assembly switch F.SYS for either
01000 ; TOPS-10 or TENEX/TOPS-20
01100 ; b) selecting the universal file for TENEX/TOPS-20
01200 ; (STENEX or MONSYM, below)
01300 ; 2) assembling ANTE.MAC with MACRO-10 (no other .MAC files
01400 ; are needed, and any version of MACRO-10 may be used)
01500 ; 3) loading ANTE.REL with either LOADER or LINK
01600
01700 IF1,< IFL F.SYS,<PRINTX ANTE for TOPS-10...>
01800 IFG F.SYS,<PRINTX ANTE for TENEX and TOPS-20...>>
01900 IF2,<PRINTX ...is halfway>
02000
02100 ; Command Input Controls
02200 ;
02300 ;^A delete the last character
02400 ;^E print the command stream
02500 ;^F delete and save the command stream (two in succession)
02600 ;^G delete the command stream (two in succession)
02700 ;^H delete the last character
02800 ;^R print the current line
02900 ;^U delete the current line
03000 ;^W delete the last word
03100 ;^V insert the next character into the command stream
03200 ;<rubout> delete the last character
03300 ;<escape> terminate command stream input (two in succession)
03400 ;
03500 ;^H and ^^ equivalent to -LV$$ if first character
03600 ;<line feed> equivalent to LV$$ if first character
03700 ;^L equivalent to -NV$$ if first character
03800 ;^N equivalent to NV$$ if first character
03900 ;
04000 ; Values
04100 ;
04200 ;<digits> integer
04300 ;+<value>{1} unary sign
04400 ;-<value>{1} unary sign
04500 ;<value>+<value> addition
04600 ;<value>-<value> subtraction
04700 ;. the pointer position
04800 ;Z the number of characters in the buffer
04900 ;: to the end of the line (equivalent to .UaL-2C.UbQaJ.,Qb)
05000 ;H all text (equivalent to 0,Z)
05100 ; the value-producing commands Q, W, FN, FO, FTI, FZ, F*, F/, #
05200 ;
05300 ; Commands
05400 ;
05500 ;Values may occur wherever n or m occur.
05600 ;Integers in braces are default values.
05700 ;Valid Qregs are 0 through 9, A through Z, and *.
05800 ;
05900 ; characters, lines, words
06000 ;
06100 ;<n>{1}C move pointer n characters
06200 ;<n>{1}D delete n characters
06300 ;<n>{0}J jump to the nth character
06400 ;<n>{1}<,m>K delete n lines (or from characters n to m)
06500 ;<n>{1}L move the pointer n lines
06600 ;<n>{1}N move the pointer n words
06700 ;<n>{1}O delete n words
06800 ;<n>{1}<,m>T print n lines (or from characters n to m)
06900 ;<n>{1}<,m>V equivalent to -(n-1)T FTS~$ nT (m is the print mode)
07000 ;
07100 ; strings
07200 ;
07300 ;I[string] insert text (<tab> is equivalent)
07400 ;<n>{1}R[string1][string2] replace the nth instance of s1 with s2
07500 ; (a null second string simply deletes the first string)
07600 ;<n>{1}S[string] search n times for the string
07700 ;
07800 ; Q-registers
07900 ;
08000 ;A[Qreg] change the editing context to the Qreg (initially Qreg *)
08100 ;B[Qreg] save the last command in the Qreg
08200 ; (the command is inserted if the Qreg is the one being edited;
08300 ; otherwise the command replaces the Qreg's contents)
08400 ;G[Qreg] get the text from the Qreg
08500 ;<n><,m>M[Qreg] execute the text in the Qreg (n and m are passed as arguments)
08600 ;<n>{1}<,m>P[Qreg] put n lines into the Qreg (or from characters n to m)
08700 ;Q[Qreg] get the value from the Qreg
08800 ;<n>{0}U[Qreg] put the value into the Qreg
08900 ;<n>{1}<,m>X[Qreg] equivalent to <n><,m>P <n><,m>K
09000 ;<n>{1}%[Qreg] add n to the value in the Qreg
09100 ;
09200 ; input-output
09300 ;
09400 ;EG[string] write file, exit and go
09500 ;EE exit without writing a file
09600 ;EN[string] set the default file name used by EG, ER, EW, EX
09700 ;EP[Qreg][string] put the file into the Qreg
09800 ;ER[string] read file
09900 ;EW[string] write file
10000 ;EX[string] write file and exit
10100 ;
10200 ; iteration
10300 ;
10400 ;<n>{infinity}< iterate n times
10500 ;> end the body of an iteration
10600 ;<n>{1}[ iterate n times (like < but with default of 1)
10700 ;] end the body of an iteration (like >)
10800 ;
10900 ; other commands
11000 ;
11100 ;<n>= print n
11200 ;W(B|I|S) return the specified saved pointer position
11300 ; (B: before last search, I: start of insert, S: start of search)
11400 ;FA return to the Qreg last edited
11500 ;<n>{10}FB change the base of numeric input/output
11600 ;<n>{0}<,m>{1}FC<E|N|G|L> if n satisfies the given relation
11700 ; then exit m iteration levels
11800 ; (E:n=0, N:n#0, G:n>0, L:n<0) (the innermost level is 1)
11900 ;<n>{1}FD[string] delete n instances of the string
12000 ; (equivalent to <n><R[string]>)
12100 ;FG[Qreg] print the text in the Qreg (equivalent to @FTS[Qreg])
12200 ;<n>{" "}FI insert n as a character at .
12300 ;FK[Qreg] eliminate the contents of the Qreg
12400 ;FM[Qreg][Qreg] copy the contents of the first Qreg into the second Qreg
12500 ;<n>{1}FN[string] search (like S) and return value (0 for success)
12600 ;FO get the value of the character at .
12700 ;<n>{1}<,m>FP[Qreg] insert n lines into the Qreg (or from characters n to m)
12800 ;FQ list the status of all nonempty Qregs
12900 ;<n>{1}FS[string1][string2] replace n instances of s1 with s2
13000 ; (equivalent to <n><R[string1][string2]>)
13100 ;<n>{0}FTE set echo mode (1:monitor, 0:every char, -1:efficient)
13200 ;FTI input a character from the terminal
13300 ;<n>{" "}<,m>FTO output n as a character to the terminal (with print mode m)
13400 ;<n>{0}FTP set the print mode (-1:direct, 0:terse, 1:verbose)
13500 ;<n>FTS[string] output the string to the terminal (with print mode n)
13600 ;FV[string] set the pointer indicator string used by the V command
13700 ;<n>{0}FW set <n> as the window size for the automatically executed V
13800 ;<n>{1}<,m>FX[Qreg] equivalent to <n><,m>FP <n><,m>K
13900 ;FZ[Qreg] get the Z value from the Qreg
14000 ;<n,m>F* multiply n by m
14100 ;<n,m>F/ divide n by m
14200 ;#[char] produce the character's value
14300 ;? print commands as they are executed
14400 ;![string] comment
14500 ;; accept and discard arguments
14600
14700
14800 ; ***DEFINITIONS***
14900
15000 NSIZE==20
15100 SSIZE==40
15200 BSIZE==200
15300 PSIZE==1000
15400
15500 PBLOCK==5 ; POINTER BLOCK LENGTH (CB, BB, SB, NB, QREGS)
15600 Q.B==0 ; BUFFER POINTER OFFSET
15700 Q.A==1 ; ALLOCATED POINTER OFFSET
15800 Q.Z==2 ; Z POINTER OFFSET
15900 Q.P==3 ; . POINTER OFFSET
16000 Q.V==4 ; VALUE POINTER OFFSET
16100
16200 .JBREN==124
16300
16400 ; REGISTER DEFINITIONS
16500
16600 R1==1
16700 R2==2
16800 R3==3
16900 R4==4
17000 R5==5
17100 R6==6
17200 R7==7
17300 R10==10
17400 R11==11
17500 R12==12
17600 R13==13
17700 R14==14
17800 R15==15
17900 R16==16
18000 R17==17
18100
18200 ; (SCRATCH REGISTERS)
18300 X1==R1
18400 X2==R2
18500 X3==R3
18600 X4==R4
18700
18800 ; (COMMONLY USED REGISTERS)
18900 CH==R5
19000 PTR==R6
19100 N==R7
19200 M==R10
19300 V1==R11
19400 V2==R12
19500 UTIL==R13
19600 FLAG==R14
19700 LEVEL==R15
19800 ENVIR==R16
19900 STACK==R17
20000
20100
20200 ; MACRO DEFINITIONS
20300
20400 SALL
20500
20600 DEFINE BEGINR(SAVLST,%RETN)
20700 < ..SAVL==0
20800 ..SAVC==0
20900 IFIDN <SAVLST><ALL>,<..SAVL==77777>
21000 IFDIF <SAVLST><ALL>,<
21100 IRP SAVLST,<
21200 IFG <SAVLST>-20,<!!
21300 PRINTX SAVLST NOT A REGISTER>
21400 IFLE <SAVLST>-20,<
21500 IFN ..SAVL&1_SAVLST,<!!
21600 PRINTX SAVLST SAVED TWICE>
21700 ..SAVL==..SAVL!1_SAVLST
21800 ..SAVC==..SAVC+1>>>
21900 IFN ..SAVL,<
22000 ..REG==17
22100 REPEAT 20,<
22200 IFN ..SAVL&1_..REG,<PUSH STACK,..REG>
22300 ..REG==..REG-1>>
22400 DEFINE .%RETN <%RETN> ; UNIQUE LOCATION FOR RETURN AND ENDR
22500 DEFINE .%RETL <%RETN':!>
22600 ..SFLG==0 ; LARGEST SKIP RETURN
22700 >
22800
22900 DEFINE RETURN(S,N)
23000 <
23100 IFB <S>,<
23200 IFE ..SAVC,<POPJ STACK,>
23300 IFN ..SAVC,<JRST .%RETN>>
23400 IFIDN <S><SKIP>,<
23500 IFG N-..SFLG,<..SFLG==N>
23600 JRST .%RETN-N>
23700 >
23800
23900 DEFINE RETN(N)
24000 <.%RETN-N
24100 IFNB <N>,<IFG N-..SFLG,<..SFLG==N>>>
24200
24300 DEFINE ENDR(S,N)
24400 < IFB <S>,<..N==0>
24500 IFIDN <S><SKIP>,<..N==N
24600 IFG <..N-..SFLG>,<..SFLG==..N>>
24700 IFN <..SFLG>,<IFN <..N-..SFLG>,<JRST .%RETN-..N>
24800 REPEAT ..SFLG,<
24900 AOS -..SAVC(STACK)>>
25000 .%RETL
25100 ..REG==0
25200 REPEAT 20,<
25300 IFN ..SAVL&1_..REG,<POP STACK,..REG
25400 ..SAVL==..SAVL-1_..REG>
25500 ..REG==..REG+1>
25600 POPJ STACK,>
25700
25800 DEFINE CALLR(ROUTIN)
25900 < PUSHJ STACK,ROUTIN>
26000
26100 DEFINE DBP (REG)
26200 < ADD REG,[070000,,0]
26300 TLNN REG,400000
26400 JRST .+3
26500 HRRI REG,-1(REG)
26600 HRLI REG,010700>
26700
26800 DEFINE LETEST(LETTER,ROUTIN)
26900 < CAIE CH,"LETTER"
27000 CAIN CH,"LETTER"+40
27100 JRST ROUTIN>
27200
27300 DEFINE A$INT(VALUE)
27400 < MOVEI N,VALUE
27500 CALLR EXVALU>
27600
27700 DEFINE A$QREG
27800 < CALLR EXQREG>
27900
28000 DEFINE A$STR(NUMBER)
28100 < CALLR EXSTRI
28200 MOVEM N,EX%S1N
28300 MOVEM M,EX%S1P
28400 IFIDN <NUMBER><2>,< CALLR EXSTRI
28500 MOVEM N,EX%S2N
28600 MOVEM M,EX%S2P>>
28700
28800 DEFINE A$$END
28900 < CALLR EXARGE
29000 JRST EXNEXT>
29100
29200 ; POINTER UPDATING DUE TO ALLOCATION AND BUFFER MOVEMENT
29300 ; IMMEDIATE (STRING SOURCES)
29400 ; I (EXEBIP -- TEXT STRING)
29500 ; R (EXSBI -- TEXT STRING AND SEARCH STRING, EXEBIP -- TEXT STRING)
29600 ; S (EXSBI -- SEARCH STRING)
29700 ; NOTE THAT SOME COMMANDS ARE NOT A PROBLEM
29800 ; G (A PBLOCK POINTER INSTEAD OF A TEXT POINTER)
29900 ; P (EB SOURCE WITH EXBPE POINTER)
30000 ; ER (STRING SOURCE NO LONGER NEEDED)
30100 ; FH (A PBLOCK POINTER INSTEAD OF A TEXT POINTER)
30200 ; FU (A VALUE INSTEAD OF A STRING)
30300 ; DEFERRED (COMMAND POINTER)
30400 ; M AND EXCHAR
30500 ; < AND >
30600 ; ALLOC
30700
30800 DEFINE EXQPTR(REG)
30900 < MOVNI REG,(REG)
31000 ADD REG,@EX%Q
31100 HRRZI REG,(REG)
31200 ADDM REG,EX%PTR>
31300
31400
31500 ; SYSTEM DEPENDENT DEFINITIONS
31600
31700 ; (((TOPS-10)))
31800 IFL F.SYS,<
31900 F.SEGS==2 ; NUMBER OF SEGMENTS (1 OR 2)
32000 IF1,< IFE <F.SEGS-2>,<PRINTX ... with two segments>>
32100
32200 IFE <F.SEGS-2>,<
32300 TWOSEG
32400 RELOC 400000
32500 >; TWOSEG
32600
32700 TTCHAN==0
32800 IOCHAN==1
32900
33000 DEFINE TBIN(REG)
33100 < SKIPL FLAGEF
33200 INCHRW REG
33300 SKIPGE FLAGEF
33400 INCHWL REG>
33500
33600 DEFINE TBOUT(REG)
33700 < OUTCHR REG>
33800
33900 DEFINE TSOUT(STRING)
34000 < IRP STRING
34100 < OUTSTR STRING>>
34200
34300 .JBREL==44
34400 .JBFF==121
34500 .JBINT==134
34600
34700 >
34800 ; (((^^^)))
34900
35000 ; (((TENEX)))
35100 IFG F.SYS,<
35200 ; SEARCH STENEX ; IF TENEX
35300 SEARCH MONSYM ; IF TOPS-20
35400
35500 DEFINE TBIN(REG)
35600 < PBIN
35700 IFN <X1-REG>,< MOVEI REG,(X1)>>
35800
35900 DEFINE TBOUT(REG)
36000 < IFN <X1-REG>,< MOVEI X1,(REG)>
36100 PBOUT>
36200
36300 DEFINE TSOUT(STRING)
36400 < IRP STRING
36500 < HRROI X1,STRING
36600 PSOUT>>
36700 >
36800 ; (((^^^)))
36900
37000 ; TENEX fork version
37100 ;
37200 ; ACs passed down:
37300 ; 0: 0 -> EN; -1 -> ER
37400 ; 1-N: ASCIZ file name
37500 ; ACs passed up:
37600 ; 0: >0 -> ^C continue location; =0 -> EH or EX; <0 -> EG
37700 ; superior fork JSYSes
37800 ; CFORK
37900 ; 1> 1B1+1B3
38000 ; 2> AC pointer
38100 ; 1< handle
38200 ; GTJFN
38300 ; 1> 1B2+1B17
38400 ; 2> ANTE.SAV pointer
38500 ; 1< jfn
38600 ; GET
38700 ; 1> handle,,jfn
38800 ; GEVEC
38900 ; 1> handle
39000 ; 2< entry (start location)
39100 ; SFORK
39200 ; 1> handle
39300 ; 2> entry (GEVEC entry + 1 or ^C continue entry)
39400 ; WFORK
39500 ; 1> handle
39600 ; RFACS
39700 ; 1> handle
39800 ; 2> AC pointer
39900
40000
40100
40200 ; ***INITIALIZATION***
40300
40400 ANTE: JRST START1
40500 JRST START2
40600 REANTE: JRST REENT
40700
40800 START1: SKIPA FLAG,[0] ; REGULAR ENTRY
40900 START2: SETO FLAG, ; INITIAL ARGUMENT ENTRY
41000 MOVEM FLAG,FLAGIF
41100 MOVEI UTIL,REANTE
41200 MOVEM UTIL,.JBREN
41300 MOVE STACK,[IOWD SSIZE,STACKB]
41400 SETZM IONAME
41500 SETOM FLAGIR
41600 CALLR FIRSTN ; GET OPTIONAL INITIAL FILE NAME
41700 RESET
41800 SETZM FLAGIF
41900 CALLR FIRSTI ; PERFORM LOW LEVEL INITIALIZATION
42000 MOVE N,ZU
42100 MOVEI PTR,C.B
42200 FIRSTP: MOVEM N,Q.B(PTR) ; INITIALIZE BUFFERS AND QREGS
42300 SETZM Q.A(PTR)
42400 SETZM Q.Z(PTR)
42500 SETZM Q.P(PTR)
42600 SETZM Q.V(PTR)
42700 ADDI PTR,PBLOCK
42800 CAIE PTR,E.B
42900 JRST FIRSTP
43000 MOVEI PTR,<Q.$+Q.B>
43100 MOVEM PTR,E.B
43200 MOVEI PTR,<Q.$+Q.A>
43300 MOVEM PTR,E.A
43400 MOVEI PTR,<Q.$+Q.Z>
43500 MOVEM PTR,E.Z
43600 MOVEI PTR,<Q.$+Q.P>
43700 MOVEM PTR,E.P
43800 SETZM FLAGCC
43900 SETZM FLAGCD
44000 MOVEI N,^D10
44100 MOVEM N,EXBASE
44200 SETZM EXDBUG
44300 SETZM EXPRIM
44400 MOVE PTR,[BSIZE*5,,C.B]
44500 CALLR ALLOC ; ALLOCATE COMMAND BUFFER
44600 JRST QUIT
44700 SKIPE FLAGIR
44800 SKIPN IONAME
44900 JRST .+3
45000 CALLR IO$ER
45100 JRST INBEG
45200 CALLR EXFIP
45300 JRST INBEG
45400 REENT: MOVE STACK,[IOWD SSIZE,STACKB]
45500 RESET
45600 SETOM FLAGIF
45700 CALLR FIRSTI ; PERFORM LOW LEVEL INITIALIZATION
45800 TSOUT <[ASCIZ/(. is /]>
45900 MOVEI M,^D10
46000 MOVE N,@E.P
46100 CALLR M$I.S
46200 TSOUT <M$I.SR,<[ASCIZ/ and Z is /]>>
46300 MOVE N,@E.Z
46400 CALLR M$I.S
46500 TSOUT <M$I.SR,[ASCIZ/ in /]>
46600 MOVE PTR,E.B
46700 CALLR QNOUT
46800 TSOUT <[ASCIZ/)/],CRLF>
46900 SKIPN FLAGCD
47000 JRST INBEG
47100 SETZM FLAGCC
47200 SETZM FLAGCD
47300 TSOUT <[ASCIZ/ ? Text may be trashed ?/],CRLF>
47400 JRST INBEG
47500
47600
47700 ; ***COMMAND INPUT***
47800
47900 INBEG$: TSOUT <CRLF>
48000 INBEG: MOVEI UTIL,"*"
48100 TBOUT <UTIL> ; PROMPT
48200 HRR PTR,C.B
48300 HRLI PTR,440700 ; PREPARE FOR A NEW COMMAND STRING
48400 SETZ N,
48500 MOVE M,C.A
48600 SETZM EX%B
48700 INNEXT: TBIN <CH> ; INPUT A CHAR AND DISPATCH
48800 INNE$0: HLRZ UTIL,DISPCH(CH)
48900 JRST (UTIL)
49000
49100 INSERT: CALLR TERME
49200 CALLR INADD
49300 JRST INNEXT
49400 JRST INNEXT
49500
49600 IN$A%: CALLR INSUB ; ^A AND RUBOUT
49700 JRST INBEG$
49800 MOVEI UTIL,"\"
49900 TBOUT <UTIL>
50000 CALLR TERMO
50100 JRST INNEXT
50200
50300 IN$E: JUMPE N,INBEG$ ; ^E
50400 TSOUT <CRLF>
50500 MOVEI UTIL,"*"
50600 TBOUT <UTIL>
50700 SETZ UTIL,
50800 HRR PTR,C.B
50900 HRLI PTR,440700
51000 IN$E0: ILDB CH,PTR
51100 CALLR TERMO
51200 ADDI UTIL,1
51300 CAIE UTIL,(N)
51400 JRST IN$E0
51500 JRST INNEXT
51600
51700 IN$F: CALLR TERME ; ^F
51800 TBIN <CH>
51900 CAIE CH,"F"-100
52000 JRST INNE$0
52100 CALLR TERME
52200 MOVEM N,C.Z
52300 MOVE PTR,[C.B,,B.B]
52400 CALLR EXQTOQ
52500 JRST INBEG$
52600 JRST INBEG$
52700
52800 IN$G: CALLR TERME ; ^G
52900 TBIN <CH>
53000 CAIE CH,"G"-100
53100 JRST INNE$0
53200 CALLR TERME
53300 JRST INBEG$
53400
53500 IN$H%: JUMPE N,IN$H%0 ; ^H
53600 CAIN CH,"H"-100
53700 JRST IN$A%
53800 JRST INSERT
53900 IN$H%0: SETOM EX%B
54000 MOVE UTIL,[BYTE (7)"-","L","V",33,0]
54100 MOVEM UTIL,@C.B
54200 MOVEI N,4
54300 JRST EXBEG
54400
54500 IN$J: JUMPN N,INSERT ; <LINE-FEED>
54600 SETOM EX%B
54700 MOVE UTIL,[BYTE (7)"L","V",33,0,0]
54800 MOVEM UTIL,@C.B
54900 MOVEI N,3
55000 SKIPLE FLAGEF
55100 JRST EXBEG$
55200 JRST EXBEG
55300
55400 IN$L: JUMPN N,INSERT ; ^L
55500 SETOM EX%B
55600 MOVE UTIL,[BYTE (7)"-","N","V",33,0]
55700 MOVEM UTIL,@C.B
55800 MOVEI N,4
55900 JRST EXBEG
56000
56100 IN$N: JUMPN N,INSERT ; ^N
56200 SETOM EX%B
56300 MOVE UTIL,[BYTE (7)"N","V",33,0,0]
56400 MOVEM UTIL,@C.B
56500 MOVEI N,3
56600 JRST EXBEG
56700
56800 IN$R: JUMPE N,INBEG$ ; ^R
56900 LDB UTIL,PTR
57000 PUSH STACK,N
57100 CALLR INSUB
57200 JRST IN$R2
57300 IN$R1: CALLR INSUB
57400 JRST IN$R2
57500 CAIN CH,12
57600 JRST IN$R2
57700 CAIN CH,37
57800 JRST IN$R2
57900 JRST IN$R1
58000 IN$R2: CAIN UTIL,12
58100 JRST IN$R3
58200 CAIN UTIL,37
58300 JRST IN$R3
58400 TSOUT <CRLF>
58500 IN$R3: JUMPN N,IN$R4
58600 MOVEI UTIL,"*"
58700 TBOUT <UTIL>
58800 JRST IN$R5
58900 IN$R4: IBP PTR
59000 AOJ N,
59100 IN$R5: MOVEI UTIL,(N)
59200 POP STACK,N
59300 IN$R6: ILDB CH,PTR
59400 CALLR TERMO
59500 ADDI UTIL,1
59600 CAIE UTIL,(N)
59700 JRST IN$R6
59800 JRST INNEXT
59900
60000 IN$U: JUMPE N,INBEG$ ; ^U
60100 TSOUT <[ASCIZ/^U/],CRLF>
60200 CALLR INSUB
60300 JRST INBEG
60400 IN$U1: CALLR INSUB
60500 JRST INBEG
60600 CAIN CH,12
60700 JRST IN$U2
60800 CAIN CH,37
60900 JRST IN$U2
61000 JRST IN$U1
61100 IN$U2: IBP PTR
61200 AOJA N,INNEXT
61300
61400 IN$V: TBIN <CH> ; ^V
61500 CALLR TERME
61600 CALLR INADD
61700 JRST INNEXT
61800 JRST INNEXT
61900
62000 IN$W: JUMPE N,INBEG$ ; ^W
62100 MOVEI UTIL,"\"
62200 TBOUT <UTIL>
62300 IN$W1: CALLR INSUB ; PASS OVER TRAILING SEPARATOR (IF ANY)
62400 JRST INBEG$
62500 CALLR TERMO
62600 CALLR WORDET
62700 JRST IN$W1
62800 JRST IN$W2
62900 JRST IN$W3
63000 IN$W2: TBOUT <UTIL> ; PUNCTUATION (ONE CHARACTER)
63100 JRST INNEXT
63200 IN$W3: CALLR INSUB ; WORD (MANY CHARACTERS)
63300 JRST INBEG$
63400 CALLR WORDET
63500 JRST IN$W4
63600 JRST IN$W4
63700 CALLR TERMO
63800 JRST IN$W3
63900 IN$W4: TBOUT <UTIL>
64000 IBP PTR
64100 AOJA N,INNEXT
64200
64300 IN$%: CALLR TERME ; <END-OF-LINE>
64400 MOVEI CH,15
64500 CALLR INADD
64600 JRST INNEXT
64700 MOVEI CH,12
64800 CALLR INADD
64900 JRST INNEXT
65000 JRST INNEXT
65100
65200 IN$$: CALLR TERME ; <ESCAPE>
65300 CALLR INADD
65400 JRST INNEXT
65500 TBIN <CH>
65600 CAIE CH,33
65700 JRST INNE$0
65800 CALLR TERME ; <ESCAPE><ESCAPE>
65900 CAIN N,1
66000 JRST IN$$0
66100 CALLR INADD
66200 JRST INNEXT
66300 JRST EXBEG
66400 IN$$0: MOVE UTIL,[BYTE (7)"V",33,0,0,0]
66500 MOVEM UTIL,@C.B
66600 MOVEI N,2
66700 JRST EXBEG
66800
66900 ; ADD CH TO COMMAND BUFFER (UPDATE PTR AND N)
67000 ;
67100 INADD: BEGINR
67200 ADDI N,1
67300 CAMGE N,M
67400 JRST INADD1
67500 PUSH STACK,PTR
67600 MOVE PTR,[BSIZE*2*5,,C.B]
67700 CALLR ALLOC
67800 JRST INADD0
67900 POP STACK,PTR
68000 ADDI M,<BSIZE*2*5>
68100 JRST INADD1
68200 INADD0: POP STACK,PTR
68300 SOJA N,RETN(0)
68400 INADD1: IDPB CH,PTR
68500 ENDR SKIP,1
68600
68700 ; SUBTRACT CH FROM COMMAND BUFFER (UPDATE PTR AND N)
68800 ;
68900 INSUB: BEGINR
69000 JUMPE N,RETN(0)
69100 LDB CH,PTR
69200 SOJ N,1
69300 DBP <PTR>
69400 ENDR SKIP,1
69500
69600
69700 ; ***COMMAND EXECUTION***
69800
69900
70000 ; EXECUTION FLAGS (LEFT HALF)
70100 ;
70200 F$EI==400000 ; EXECUTION INHIBIT
70300 F$EM==200000 ; EXECUTING MACRO
70400 ;
70500 ; ARGUMENT FLAGS (RIGHT HALF)
70600 ;
70700 F$V== 700000 ; ALL VALUE FLAGS
70800 F$V1==400000 ; VALUE 1 DEFINED
70900 F$VC==200000 ; , ENCOUNTERED
71000 F$V2==100000 ; VALUE 2 DEFINED
71100 F$P== 070000 ; ALL PREFIX FLAGS
71200 F$PA==040000 ; PREFIX @
71300 F$PC==020000 ; PREFIX :
71400 F$PS==010000 ; PREFIX /
71500 F$O== 006000 ; ALL OPERATOR FLAGS
71600 F$OA==004000 ; OPERATOR -- ADD
71700 F$OS==002000 ; OPERATOR -- SUBTRACT
71800
71900 EXBEG: TSOUT <CRLF>
72000 EXBEG$: MOVEM N,C.Z
72100
72200 EXPAS1: HRR PTR,C.B
72300 HRLI PTR,440700
72400 MOVEM PTR,EX%PTR
72500 MOVE N,C.Z
72600 MOVEM N,EX%N
72700 HRLZI FLAG,F$EI ; PASS 1 IS SYNTAX
72800 SETZ LEVEL,
72900 MOVE ENVIR,[IOWD BSIZE,ENVIRB]
73000 PUSH ENVIR,[EXPAS2]
73100 JRST EXNEXT
73200 EXPAS2: MOVE PTR,@E.P
73300 MOVEM PTR,EX..
73400 HRR PTR,C.B
73500 HRLI PTR,440700
73600 MOVEM PTR,EX%PTR
73700 MOVE N,C.Z
73800 MOVEM N,EX%N
73900 SETZ FLAG, ; PASS 2 IS SEMANTICS
74000 SETZ LEVEL,
74100 SETZM EX%Q
74200 PUSH ENVIR,[EXEND]
74300 JRST EXNEXT
74400
74500 EXEND: TRNN FLAG,F$V1
74600 JRST EXEND%
74700 MOVE N,V1
74800 MOVE M,EXBASE
74900 CALLR M$I.S
75000 TSOUT <M$I.SR,CRLF>
75100 EXEND%: HRRZI PTR,C.B ; PBLOCK POINTER
75200 HRRZ FLAG,C.B ; DOWN POINTER
75300 EXEND1: MOVE N,Q.Z(PTR)
75400 ADDI N,4
75500 IDIVI N,5 ; NUMBER OF WORDS USED
75600 CAMN FLAG,Q.B(PTR)
75700 JRST EXEND2 ; BUFFER NEED NOT BE MOVED
75800 HRL UTIL,Q.B(PTR)
75900 HRRM FLAG,Q.B(PTR) ; MOVE Q.B DOWN
76000 JUMPE N,EXEND2
76100 HRRI UTIL,(FLAG)
76200 HRRZI M,(FLAG)
76300 ADDI M,-1(N)
76400 BLT UTIL,(M) ; MOVE BUFFER DOWN
76500 EXEND2: ADDI N,<BSIZE-1>
76600 IDIVI N,BSIZE ; NUMBER OF BLOCKS USED
76700 MOVEI UTIL,(N)
76800 CAILE UTIL,2
76900 ADDI UTIL,2 ; IF MORE THAN 2 BLOCKS USED THEN ALLOW 2 EXTRA
77000 MOVE N,Q.A(PTR)
77100 IDIVI N,<BSIZE*5> ; NUMBER OF BLOCKS ALLOCATED
77200 CAIG N,(UTIL)
77300 JRST EXEND3
77400 IMULI UTIL,<BSIZE*5>
77500 MOVEM UTIL,Q.A(PTR)
77600 EXEND3: MOVE N,Q.A(PTR)
77700 IDIVI N,5
77800 ADDI FLAG,(N) ; INCREMENT DOWN POINTER BY WORDS ALLOCATED
77900 ADDI PTR,PBLOCK
78000 CAIE PTR,E.B
78100 JRST EXEND1
78200 MOVEM FLAG,ZU ; RESET GLOBAL USED POINTER
78300 CAMN FLAG,ZW
78400 JRST EXEND$
78500 MOVE UTIL,ZW
78600 SUBI FLAG,(UTIL)
78700 CALLR GETCOR ; RECLAIM CORE
78800 JRST .+1
78900 EXEND$: MOVE N,EX..
79000 MOVEM N,B.V
79100 SKIPE EX%B
79200 JRST INBEG
79300 MOVE PTR,[C.B,,B.B]
79400 CALLR EXQTOQ
79500 JRST INBEG
79600 JRST INBEG
79700
79800 EXNEXT: CALLR EXCHAR ; GET A CHAR AND DISPATCH
79900 EXNEX0: HRRZ UTIL,DISPCH(CH)
80000 JRST (UTIL)
80100
80200 EX$A: TRNE FLAG,-1
80300 JRST EXER01
80400 A$QREG
80500 EX$A0: JUMPL FLAG,EXNEXT ; -- END PARSING
80600 CALLR EXESTS
80700 MOVE UTIL,E.B
80800 MOVEM UTIL,EX%A
80900 MOVEM PTR,E.B
81000 ADDI PTR,1
81100 MOVEM PTR,E.A
81200 ADDI PTR,1
81300 MOVEM PTR,E.Z
81400 ADDI PTR,1
81500 MOVEM PTR,E.P
81600 CALLR EXAV ; (IMPLICIT V)
81700 JRST EXNEXT
81800
81900 EX$B: TRNE FLAG,-1
82000 JRST EXER01
82100 SETOM EX%B
82200 A$QREG
82300 JUMPL FLAG,EXNEXT ; -- END PARSING
82400 CALLR EXESTS
82500 SKIPG B.Z
82600 JRST EXNEXT
82700 CAME PTR,E.B
82800 JRST EX$B1
82900 HRRZI PTR,B.B
83000 JRST EX$G0
83100 EX$B1: HRLI PTR,B.B
83200 CALLR EXQTOQ
83300 JRST EXERER
83400 MOVE N,B.V
83500 MOVEM N,Q.V(PTR)
83600 JRST EXNEXT
83700
83800 EX$C: TRNE FLAG,F$VC!F$V2!F$P
83900 JRST EXER01
84000 A$INT <1>
84100 A$$END ; -- END PARSING
84200 MOVE N,@E.P
84300 ADD N,V1
84400 CAIGE N,0 ; (IF <N> < 0 THEN . GETS 0)
84500 SETZ N,
84600 CAMLE N,@E.Z ; (IF <N> > Z THEN . GETS Z)
84700 MOVE N,@E.Z
84800 MOVEM N,@E.P ; SET .
84900 CALLR EXAV ; (IMPLICIT V)
85000 JRST EXNEXT
85100
85200 EX$D: TRNE FLAG,F$VC!F$V2!F$P
85300 JRST EXER01
85400 A$INT <1>
85500 A$$END ; -- END PARSING
85600 JUMPE V1,EXNEXT
85700 JUMPG V1,EX$D2
85800 MOVN N,V1 ; -<N>D
85900 MOVE V1,@E.P
86000 JUMPE V1,EXNEXT
86100 SUB V1,N ; CALCULATE NEW . (OLD - DELETION)
86200 JUMPGE V1,EX$D1
86300 MOVE N,@E.P
86400 SETZ V1, ; (IF <N> > . THEN <N> GETS . AND . GETS 0)
86500 EX$D1: MOVEM V1,@E.P
86600 CALLR EXEBC ; DELETE TEXT
86700 CALLR EXAV ; (IMPLICIT V)
86800 JRST EXNEXT
86900 EX$D2: MOVE N,V1
87000 MOVE V1,@E.Z
87100 SUB V1,@E.P
87200 CAMLE N,V1
87300 MOVE N,V1 ; (IF <N> > Z-. THEN <N> GETS Z-.)
87400 CALLR EXEBC ; DELETE TEXT
87500 CALLR EXAV ; (IMPLICIT V)
87600 JRST EXNEXT
87700
87800 EX$E$: CALLR EXCHAR
87900 LETEST (E,HALT)
88000 LETEST (G,EX$EW)
88100 LETEST (N,EX$EN)
88200 LETEST (P,EX$EP)
88300 LETEST (R,EX$ER)
88400 LETEST (W,EX$EW)
88500 LETEST (X,EX$EW)
88600 JRST EXER03
88700
88800 EX$F$: CALLR EXCHAR
88900 LETEST (A,EX$FA)
89000 LETEST (B,EX$FB)
89100 LETEST (C,EX$FC)
89200 LETEST (D,EX$FD)
89300 LETEST (G,EX$FG)
89400 LETEST (I,EX$FI)
89500 LETEST (K,EX$FK)
89600 LETEST (M,EX$FM)
89700 LETEST (N,EX$FN)
89800 LETEST (O,EX$FO)
89900 LETEST (P,EX$FP)
90000 LETEST (Q,EX$FQ)
90100 LETEST (S,EX$FS)
90200 LETEST (T,EX$FT$)
90300 LETEST (V,EX$FV)
90400 LETEST (W,EX$FW)
90500 LETEST (X,EX$FP)
90600 LETEST (Z,EX$FZ)
90700 LETEST (/,EX$F%D)
90800 LETEST (*,EX$F%M)
90900 JRST EXER05
91000
91100 EX$G: TRNE FLAG,-1
91200 JRST EXER01
91300 A$QREG
91400 JUMPL FLAG,EXNEXT ; -- END PARSING
91500 SKIPG Q.Z(PTR)
91600 JRST EXER09
91700 CAMN PTR,E.B
91800 JRST EXER10
91900 EX$G0: MOVE N,@E.P
92000 MOVEM N,EX.I
92100 MOVE N,Q.Z(PTR) ; N GETS LENGTH OF QREG TEXT
92200 JUMPE N,EXNEXT
92300 CALLR ABORTI
92400 CALLR EXEBIS
92500 CALLR EXEBE ; EXPAND EB
92600 HRR M,Q.B(PTR)
92700 HRLI M,440700
92800 CALLR EXEBIT
92900 CALLR ABORTE
93000 CALLR EXAV ; (IMPLICIT V)
93100 JRST EXNEXT
93200
93300 EX$H: TRNE FLAG,-1
93400 JRST EXER02
93500 TRO FLAG,F$V1!F$V2
93600 SETZ V1,
93700 MOVE V2,@E.Z
93800 JRST EXNEXT
93900
94000 EX$I: TRNE FLAG,F$V!F$PC!F$O
94100 JRST EXER01
94200 A$STR <1>
94300 A$$END ; -- END PARSING
94400 MOVE N,@E.P
94500 MOVEM N,EX.I
94600 MOVE N,EX%S1N ; N GETS SIZE OF INSERT
94700 MOVE M,EX%S1P ; M POINTS TO INSERT TEXT
94800 JUMPE N,EXNEXT
94900 CALLR ABORTI
95000 CALLR EXEBIP
95100 CALLR EXEBE ; EXPAND EB
95200 CALLR EXEBIT
95300 CALLR ABORTE
95400 CALLR EXAV ; (IMPLICIT V)
95500 JRST EXNEXT
95600
95700 EX$J: TRNE FLAG,F$VC!F$V2!F$P!F$O
95800 JRST EXER01
95900 A$INT <0>
96000 A$$END ; -- END PARSING
96100 CAIGE V1,0 ; (IF <N> < 0 THEN . GETS 0)
96200 SETZ V1,
96300 CAMLE V1,@E.Z ; (IF <N> > Z THEN . GETS Z)
96400 MOVE V1,@E.Z
96500 MOVEM V1,@E.P ; SET .
96600 CALLR EXAV ; (IMPLICIT V)
96700 JRST EXNEXT
96800
96900 EX$K: TRNE FLAG,F$VC!F$PA!F$PS
97000 JRST EXER01
97100 A$INT <1>
97200 A$$END ; -- END PARSING
97300 CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
97400 EX$K0: JUMPE V2,EXNEXT
97500 MOVE M,@E.P
97600 MOVEM V1,@E.P
97700 MOVE N,V2
97800 CALLR EXEBC ; DELETE TEXT
97900 TRNN UTIL,F$V2
98000 JRST EX$K3 ; IF <N>K (LINE-BASED) THEN SKIP . CONCERNS
98100 MOVE N,V1
98200 ADD N,V2
98300 CAMGE M,V1
98400 JRST EX$K1
98500 CAMLE M,N
98600 JRST EX$K2
98700 JRST EX$K3 ; IF V1 <= . <= V1+V2 THEN . GETS V1
98800 EX$K1: MOVEM M,@E.P
98900 JRST EX$K3 ; IF . < V1 THEN . IS UNCHANGED
99000 EX$K2: SUB M,V2
99100 MOVEM M,@E.P ; IF V1+V2 < . THEN . GETS .-V2
99200 EX$K3: CALLR EXAV ; (IMPLICIT V)
99300 JRST EXNEXT
99400
99500 EX$L: TRNE FLAG,F$VC!F$V2!F$PA!F$PS
99600 JRST EXER01
99700 A$INT <1>
99800 A$$END ; -- END PARSING
99900 CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
00100 CAML V1,@E.P ; (IF <N> <= 0 THEN MOVE BACK)
00200 ADD V1,V2 ; (IF <N> > 0 THEN MOVE FORWARD)
00300 MOVEM V1,@E.P ; SET .
00400 CALLR EXAV ; (IMPLICIT V)
00500 JRST EXNEXT
00600
00700 EX$M: A$QREG
00800 A$$END ; -- END PARSING
00900 MOVE FLAG,UTIL
01000 SKIPG UTIL,Q.Z(PTR)
01100 JRST EXER09
01200 CAMN PTR,E.B
01300 JRST EXER10
01400 MOVE N,LEVEL
01500 CALLR EXESAV
01600 HRRZM PTR,EX%Q
01700 MOVEM UTIL,EX%N
01800 HRR UTIL,Q.B(PTR)
01900 HRLI UTIL,440700
02000 MOVEM UTIL,EX%PTR
02100 SETZ LEVEL,
02200 TLO FLAG,F$EM ; SET UP NEW EXECUTING QREG
02300 JRST EXNEXT
02400
02500 EX$N: TRNE FLAG,F$VC!F$V2!F$P
02600 JRST EXER01
02700 A$INT <1>
02800 A$$END ; -- END PARSING
02900 JUMPE V1,EXNEXT
03000 CALLR EXWORD ; PRODUCE STARTING POSITION AND LENGTH
03100 CAML V1,@E.P ; (IF <N> < 0 THEN MOVE BACK)
03200 ADD V1,V2 ; (IF <N> > 0 THEN MOVE FORWARD)
03300 MOVEM V1,@E.P ; SET .
03400 CALLR EXAV ; (IMPLICIT V)
03500 JRST EXNEXT
03600
03700 EX$O: TRNE FLAG,F$VC!F$V2!F$P
03800 JRST EXER01
03900 A$INT <1>
04000 A$$END ; -- END PARSING
04100 JUMPE V1,EXNEXT
04200 CALLR EXWORD ; PRODUCE STARTING POSITION AND LENGTH
04300 JUMPE V2,EXNEXT
04400 MOVEM V1,@E.P
04500 MOVE N,V2
04600 CALLR EXEBC ; DELETE TEXT
04700 CALLR EXAV ; (IMPLICIT V)
04800 JRST EXNEXT
04900
05000 EX$P: TRNE FLAG,F$VC!F$PA!F$PS
05100 JRST EXER01
05200 EX$P0: MOVEM CH,EX%CH
05300 A$INT <1>
05400 A$QREG
05500 A$$END ; -- END PARSING
05600 CAMN PTR,E.B
05700 JRST EXER10
05800 CALLR EXESTS
05900 CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
06000 TRNE UTIL,F$VC
06100 JRST EX$P1
06200 SETZM Q.P(PTR) ; IF P-X THEN ZERO QREG'S OLD CONTENTS
06300 SETZM Q.Z(PTR)
06400 EX$P1: JUMPE V2,EXNEXT
06500 HRRZI M,(PTR)
06600 MOVE N,V2
06700 ADD N,Q.Z(M) ; N GETS NEW QREG LENGTH
06800 CAMG N,Q.A(M)
06900 JRST EX$P2
07000 MOVE PTR,N ; ALLOCATE QREG SPACE FOR PUT
07100 SUB PTR,Q.A(M)
07200 HRLI PTR,(PTR)
07300 HRRI PTR,(M)
07400 CALLR ALLOC
07500 JRST EXERER
07600 EX$P2: CALLR ABORTI
07700 HRRZI PTR,(M)
07800 MOVN N,V2
07900 CALLR EXEBE ; EXPAND QREG TEXT TO MAKE ROOM FOR PUT
08000 MOVE N,Q.P(M)
08100 HRRZI PTR,(M)
08200 CALLR EXBPQ ; SET UP DESTINATION BYTE POINTER
08300 MOVE N,PTR
08400 MOVE PTR,V1
08500 CALLR EXBPE ; SET UP SOURCE BYTE POINTER
08600 PUSH STACK,V2
08700 EX$P3: ILDB CH,PTR
08800 IDPB CH,N ; MOVE TEXT INTO QREG
08900 SOJG V2,EX$P3
09000 POP STACK,V2
09100 TRNE UTIL,F$VC
09200 ADDM V2,Q.P(M) ; UPDATE . IN QREG
09300 CALLR ABORTE
09400 MOVE CH,EX%CH
09500 LETEST (X,EX$K0)
09600 CALLR EXAV ; (IMPLICIT V FOR P)
09700 JRST EXNEXT
09800
09900 EX$Q: TRNE FLAG,F$P
10000 JRST EXER01
10100 MOVEI UTIL,(CH)
10200 A$QREG
10300 TLNN FLAG,F$EI
10400 MOVE N,Q.V(PTR)
10500 MOVEI CH,(UTIL)
10600 CALLR EXVALS ; PRODUCE VALUE ARG
10700 JRST EXER01
10800 JRST EXNEXT
10900
11000 EX$R: TRNE FLAG,F$VC!F$V2!F$PC
11100 JRST EXER01
11200 EX$R0S: A$INT <1>
11300 A$STR <2>
11400 A$$END ; -- END PARSING
11500 EX$R0D: MOVE N,@E.P
11600 MOVEM N,EX.B
11700 JUMPE V1,EXNEXT
11800 MOVE N,EX%S1N
11900 JUMPN N,EX$R1
12000 MOVE N,S.Z ; USE EXISTING SEARCH STRING
12100 JUMPE N,EX$R2 ; (IF ANY)
12200 SOJA N,EX$R2 ; (ACCOUNT FOR FINAL -1)
12300 EX$R1: MOVE M,EX%S2P
12400 CALLR EXQSB
12500 MOVE V2,PTR
12600 MOVE PTR,EX%S1P
12700 TRNE UTIL,F$PS
12800 IBP PTR
12900 CALLR EXSBI ; MOVE SEARCH STRING INTO SEARCH BUFFER
13000 MOVE PTR,V2
13100 CALLR EXQSA
13200 MOVEM M,EX%S2P
13300 EX$R2: JUMPG V1,EX$R2F
13400 CALLR EXESB ; SEARCH BACKWARD
13500 JRST EX$R3
13600 EX$R2B: TRNE UTIL,F$VC
13700 AOJA V1,EX$R2$
13800 AOJE V1,EX$R4
13900 CALLR EXAV ; (SHOW INTERMEDIATE RESULTS)
14000 SUBM N,@E.P ; (MOVE . BACK TO AVOID STRING JUST FOUND)
14100 MOVNS @E.P
14200 CALLR EXESB
14300 JRST .+2
14400 JRST EX$R2B
14500 ADDM N,@E.P
14600 JRST EX$R3
14700 EX$R2F: CALLR EXESF ; SEARCH FORWARD
14800 JRST EX$R3
14900 TRNE UTIL,F$VC
15000 SOJA V1,EX$R2$
15100 SOJE V1,EX$R4
15200 CALLR EXAV ; (SHOW INTERMEDIATE RESULTS)
15300 JRST EX$R2F
15400 EX$R2$: PUSH STACK,N ; REPLACE EACH INSTANCE (FS AND FS)
15500 JRST EX$R4
15600 EX$R3: JUMPE LEVEL,EXER16
15700 TLO FLAG,F$EI ; SEARCH FAILED
15800 HRLI LEVEL,(LEVEL)
15900 JRST EXNEXT
16000 EX$R4: MOVE V2,@E.P
16100 SUB V2,N
16200 MOVEM V2,@E.P ; . GETS POSITION OF START OF FOUND STRING
16300 MOVE V2,N
16400 MOVE N,@E.P
16500 MOVEM N,EX.I
16600 MOVE N,EX%S2N
16700 MOVE M,EX%S2P
16800 CALLR ABORTI
16900 SUB N,V2
17000 JUMPE N,EX$R6 ; S STRING LENGTH = R STRING LENGTH
17100 JUMPG N,EX$R5
17200 MOVN N,N
17300 CALLR EXEBC ; S STRING LENGTH > R STRING LENGTH (CONTRACT)
17400 JRST EX$R6
17500 EX$R5: CALLR EXEBIP
17600 EX$R5$: CALLR EXEBE ; S STRING LENGTH < R STRING LENGTH (EXPAND)
17700 EX$R6: SKIPE N,EX%S2N
17800 CALLR EXEBIT
17900 CALLR ABORTE
18000 CALLR EXAV ; (IMPLICIT V)
18100 TRNN UTIL,F$VC
18200 JRST EXNEXT
18300 POP STACK,N
18400 JUMPN V1,EX$R2
18500 JRST EXNEXT
18600
18700 EX$S: TRNE FLAG,F$VC!F$V2!F$PC
18800 JRST EXER01
18900 EX$S0: A$INT <1>
19000 A$STR <1>
19100 MOVE UTIL,FLAG
19200 TRZ FLAG,-1 ; S SEARCH LEAVES NO ARGS
19300 TRNE UTIL,F$VC
19400 TRO FLAG,F$V1 ; FN SEARCH PRODUCES VALUE
19500 JUMPL FLAG,EXNEXT ; -- END PARSING
19600 MOVE N,@E.P
19700 MOVEM N,EX.B
19800 JUMPE V1,EXNEXT
19900 MOVE N,EX%S1N ; N GETS SIZE OF STRING
20000 MOVE PTR,EX%S1P ; PTR GETS POINTER TO STRING
20100 TRNE UTIL,F$PS
20200 IBP PTR ; (IGNORE / DELIMITER)
20300 CALLR EXSBI ; MOVE STRING INTO SEARCH BUFFER
20400 JUMPG V1,EX$S2
20500 JUMPN N,EX$S1
20600 SKIPE N,S.Z ; (USE DEFAULT STRING LENGTH FOR MOVING .)
20700 SUBI N,1
20800 EX$S1: SUBM N,@E.P ; (MOVE . BACK TO AVOID REPEATED MATCHING)
20900 MOVNS @E.P
21000 CALLR EXESB ; SEARCH BACKWARD
21100 JRST EX$S1$
21200 CALLR EXAV ; (IMPLICIT V)
21300 AOJE V1,EXNEXT ; <N> TIMES
21400 JRST EX$S1
21500 EX$S1$: ADDM N,@E.P
21600 JRST EX$S3
21700 EX$S2: CALLR EXESF ; SEARCH FORWARD
21800 JRST EX$S3
21900 CALLR EXAV ; (IMPLICIT V)
22000 SOJG V1,EX$S2 ; <N> TIMES
22100 JRST EXNEXT
22200 EX$S3: SETO V1, ; SEARCH FAILED
22300 TRNE UTIL,F$VC
22400 JRST EXNEXT
22500 JUMPE LEVEL,EXER16
22600 TLO FLAG,F$EI ; (IF IN <> THEN INHIBIT FURTHER EXECUTION)
22700 HRLI LEVEL,(LEVEL)
22800 JRST EXNEXT
22900
23000 EX$T: TRNE FLAG,F$VC!F$PA!F$PS
23100 JRST EXER01
23200 A$INT <1>
23300 A$$END ; -- END PARSING
23400 CALLR EXLINE ; PRODUCE STARTING POSITION AND LENGTH
23500 JUMPE V2,EXNEXT
23600 MOVE PTR,V1
23700 CALLR EXBPE
23800 MOVE N,V2
23900 CALLR EXPRIS ; OUTPUT TEXT
24000 JRST EXNEXT
24100
24200 EX$U: TRNE FLAG,F$VC!F$V2!F$P!F$O
24300 JRST EXER01
24400 A$INT <0>
24500 A$QREG
24600 A$$END ; -- END PARSING
24700 MOVEM V1,Q.V(PTR) ; SET QREG VALUE
24800 JRST EXNEXT
24900
25000 EX$V: TRNE FLAG,F$VC!F$P!F$O
25100 JRST EXER01
25200 TRZN FLAG,F$V2
25300 MOVE V2,EXPRIM
25400 A$INT <1>
25500 A$$END ; -- END PARSING
25600 JUMPLE V1,EXNEXT
25700 PUSH STACK,EXPRIM
25800 MOVEM V2,EXPRIM
25900 MOVE N,V1
26000 MOVN V1,V1
26100 ADDI V1,1
26200 CALLR EXLINE ; -(N-1)T SUPPLIES POINTER + PARTIAL LENGTH
26300 MOVE PTR,V1
26400 MOVE V1,N
26500 MOVE N,V2
26600 CALLR EXLINE ; NT SUPPLIES REMAINDER OF LENGTH
26700 MOVE M,N
26800 ADD M,V2
26900 JUMPE M,EX$V0
27000 CALLR EXBPE
27100 CALLR EXPRIS
27200 TSOUT <EXVPTR>
27300 MOVE N,V2
27400 CALLR EXPRIS
27500 EX$V0: POP STACK,EXPRIM
27600 JRST EXNEXT
27700
27800 EX$W: TRNE FLAG,F$P
27900 JRST EXER01
28000 MOVEI UTIL,(CH)
28100 CALLR EXCHAR
28200 LETEST (B,EX$WB)
28300 LETEST (I,EX$WI)
28400 LETEST (S,EX$WS)
28500 MOVEI CH,(UTIL)
28600 JRST EXER01
28700 EX$WB: MOVE N,EX.B ; BEFORE-SEARCH VALUE
28800 JRST EX$W0
28900 EX$WI: MOVE N,EX.I ; INSERT-STRING-BEGINNING VALUE
29000 JRST EX$W0
29100 EX$WS: MOVE N,EX.S ; SEARCH-STRING-BEGINNING VALUE
29200 EX$W0: MOVEI CH,(UTIL)
29300 CALLR EXVALS ; PRODUCE VALUE ARG
29400 JRST EXER01
29500 JRST EXNEXT
29600
29700 EX$Z: TRNE FLAG,F$P
29800 JRST EXER02
29900 MOVE N,@E.Z
30000 CALLR EXVALS ; PRODUCE Z VALUE
30100 JRST EXER02
30200 JRST EXNEXT
30300
30400 ; @
30500 EX$$A: TRNE FLAG,F$VC!F$V2!F$P
30600 JRST EXER02
30700 TRO FLAG,F$PA
30800 JRST EXNEXT
30900
31000 ; ,
31100 EX$$CA: TRNE FLAG,F$VC!F$V2!F$P!F$O
31200 JRST EXER02
31300 TRO FLAG,F$VC
31400 JRST EXNEXT
31500
31600 ; :
31700 EX$$CN: TRNE FLAG,-1
31800 JRST EXER02
31900 TRO FLAG,F$PC
32000 JRST EXNEXT
32100
32200 ; =
32300 EX$$EQ: TRNE FLAG,F$VC!F$V2!F$P!F$O
32400 JRST EXER01
32500 TRNN FLAG,F$V1
32600 JRST EXER01
32700 A$$END ; -- END PARSING
32800 MOVE N,V1
32900 MOVE M,EXBASE
33000 CALLR M$I.S
33100 TSOUT <M$I.SR,CRLF> ; OUTPUT VALUE STRING
33200 JRST EXNEXT
33300
33400 ; !
33500 EX$$EX: TRNE FLAG,F$V!F$PC!F$O
33600 JRST EXER01
33700 CALLR EXSTRI ; ACCEPT (AND IGNORE) STRING ARG
33800 TRZ FLAG,-1 ; LEAVE NO ARGS
33900 JRST EXNEXT
34000
34100 ; (TAB)
34200 EX$$I: TRNE FLAG,F$PA!F$PS
34300 JRST EXER01
34400 MOVE PTR,EX%PTR
34500 DBP <PTR> ; INCLUDE <TAB> IN INSERT STRING
34600 MOVEM PTR,EX%PTR
34700 AOS EX%N
34800 JRST EX$I
34900
35000 ; < AND [
35100 EX$$L: TRNE FLAG,F$VC!F$V2!F$P!F$O
35200 JRST EXER01
35300 HRLOI N,377777 ; DEFAULT FOR < IS INFINITY
35400 CAIN CH,"[" ; AND FOR [ IS 1
35500 MOVEI N,1
35600 CALLR EXVALU ; ACCEPT VALUE ARG
35700 TRZ FLAG,-1 ; LEAVE NO ARGS
35800 ADDI LEVEL,1 ; INCREMENT ITERATION LEVEL
35900 MOVE N,V1
36000 CALLR EXESAV
36100 JUMPL FLAG,EXNEXT ; -- END PARSING
36200 JUMPG N,EXNEXT ; IF COUNT NOT POSITIVE THEN INHIBIT
36300 TLO FLAG,F$EI ; BY SETTING FLAG
36400 HRLI LEVEL,(LEVEL) ; AND INTERATION LEVEL
36500 JRST EXNEXT
36600
36700 ; -
36800 EX$$M: TRNE FLAG,F$PC!F$O
36900 JRST EXER02
37000 TRO FLAG,F$OS
37100 JRST EXNEXT
37200
37300 ; #
37400 EX$$N: TRNE FLAG,F$P
37500 JRST EXER01
37600 MOVEI UTIL,(CH)
37700 CALLR EXCHAR
37800 MOVEI N,(CH)
37900 MOVEI CH,(UTIL)
38000 CALLR EXVALS ; PRODUCE VALUE ARG
38100 JRST EXER01
38200 JRST EXNEXT
38300
38400 ; +
38500 EX$$P: TRNE FLAG,F$PC!F$O
38600 JRST EXER01
38700 TRO FLAG,F$OA
38800 JRST EXNEXT
38900
39000 ; ?
39100 EX$$Q: TRNE FLAG,-1
39200 JRST EXER01
39300 JUMPL FLAG,EXNEXT
39400 SETO UTIL,
39500 XORM UTIL,EXDBUG
39600 JRST EXNEXT
39700
39800 ; > AND ]
39900 EX$$R: TRNE FLAG,F$VC!F$V2!F$P!F$O
40000 JRST EXER01
40100 MOVEI V2,(LEVEL)
40200 JUMPE V2,EXER15
40300 SUBI LEVEL,1
40400 JUMPGE FLAG,EX$$R0
40500 POP ENVIR,UTIL ; EXECUTION INHIBITED
40600 POP ENVIR,UTIL
40700 POP ENVIR,UTIL
40800 POP ENVIR,UTIL
40900 POP ENVIR,UTIL
41000 HLRZ UTIL,LEVEL
41100 CAIE UTIL,(V2) ; IF PROPER LEVEL THEN
41200 JRST EXNEXT
41300 TLZ FLAG,F$EI ; CLEAR INHIBIT STATUS
41400 TLZ LEVEL,-1 ; AND LEVEL
41500 JRST EXNEXT
41600 EX$$R0: POP ENVIR,V2 ; GET ITERATION COUNT
41700 POP ENVIR,PTR ; GET COMMAND POINTER
41800 POP ENVIR,N ; GET COMMAND COUNT
41900 POP ENVIR,X1 ; GET FLAGS
42000 POP ENVIR,M ; GET QREG POINTERS
42100 SOJLE V2,EXNEXT ; ITERATE NO LONGER
42200 TRZ FLAG,-1 ; (LEAVE NO ARGS)
42300 PUSH ENVIR,M
42400 PUSH ENVIR,X1
42500 PUSH ENVIR,N
42600 PUSH ENVIR,PTR
42700 PUSH ENVIR,V2
42800 MOVEM PTR,EX%PTR
42900 MOVEM N,EX%N
43000 SKIPN EX%Q ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
43100 AOJA LEVEL,EXNEXT
43200 HLRZ M,M
43300 EXQPTR <M>
43400 AOJA LEVEL,EXNEXT ; ITERATE AGAIN
43500
43600 ; /
43700 EX$$S: TRNE FLAG,F$VC!F$V2!F$P
43800 JRST EXER02
43900 TRO FLAG,F$PS
44000 JRST EXNEXT
44100
44200 ; ;
44300 EX$$$S: TRNE FLAG,F$VC!F$O
44400 JRST EXER01
44500 TRZ FLAG,-1 ; LEAVE NO ARGS
44600 JRST EXNEXT
44700
44800 ; 0 THROUGH 9
44900 EX$0: TRNE FLAG,F$P
45000 JRST EXER02
45100 MOVE N,EXBASE
45200 CAIN CH,"0"
45300 MOVEI N,10 ; (INTEGERS THAT BEGIN WITH 0 ARE OCTAL)
45400 MOVE PTR,EX%PTR
45500 MOVEM CH,EX%CH
45600 EX$0$1: CAIL CH,"0" ; PASS OVER INTEGER STRING
45700 CAILE CH,"9"
45800 JRST EX$0$2
45900 CALLR EXCHAR
46000 JRST EX$0$1
46100 EX$0$2: JUMPL FLAG,EX$0$3
46200 MOVE CH,EX%CH
46300 CALLR M$S.I ; ACCEPT INTEGER
46400 JRST EXER14
46500 EX$0$3: CALLR EXVALS ; PRODUCE VALUE
46600 JRST EXER02
46700 JRST EXNEX0
46800
46900 EX$%: TRNE FLAG,F$VC!F$V2!F$P
47000 JRST EXER01
47100 A$INT <1>
47200 A$QREG
47300 A$$END ; -- END PARSING
47400 ADDM V1,Q.V(PTR) ; ADD TO QREG VALUE
47500 JRST EXNEXT
47600
47700 EX$.: TRNE FLAG,F$P
47800 JRST EXER02
47900 MOVE N,@E.P
48000 CALLR EXVALS ; PRODUCE . VALUE
48100 JRST EXER02
48200 JRST EXNEXT
48300
48400 EX$EN: TRNE FLAG,F$V!F$PC!F$O
48500 JRST EXER04
48600 A$STR <1>
48700 A$$END ; -- END PARSING
48800 MOVE N,EX%S1N
48900 JUMPN N,EX$EN1
49000 SETZM IONAME ; CLEAR NAME BUFFER
49100 JRST EX$EN3
49200 EX$EN1: MOVE M,EX%S1P
49300 TRNE UTIL,F$PS
49400 IBP M
49500 MOVE PTR,[440700,,IONAME]
49600 EX$EN2: ILDB CH,M
49700 IDPB CH,PTR ; MOVE TEXT INTO NAME BUFFER
49800 SOJG N,EX$EN2
49900 SETZ CH,
50000 IDPB CH,PTR
50100 EX$EN3: CALLR EXFIP ; SET FILE NAME
50200 JRST EXNEXT
50300
50400 EX$EP: TRNE FLAG,F$V!F$PC!F$O
50500 JRST EXER04
50600 A$QREG
50700 MOVEM CH,EX%CH
50800 A$STR <1>
50900 A$$END ; -- END PARSING
51000 MOVE CH,EX%CH
51100 CALLR EXESTS
51200 CALLR EXFIG
51300 CAME PTR,E.B
51400 JRST EX$EP0
51500 CALLR IO$ER ; READ FILE INTO QREG CURRENTLY BEING EDITED
51600 JRST EXERER
51700 JRST EXNEXT
51800 EX$EP0: SETZM Q.P(PTR) ; ZERO QREG'S OLD CONTENTS
51900 SETZM Q.Z(PTR)
52000 MOVEI M,(PTR)
52100 MOVE N,E.B
52200 MOVEM M,E.B ; SET EDIT BUFFER TO QREG
52300 ADDI M,1
52400 MOVEM M,E.A
52500 ADDI M,1
52600 MOVEM M,E.Z
52700 ADDI M,1
52800 MOVEM M,E.P
52900 SETZ UTIL,
53000 CALLR IO$ER ; READ FILE
53100 SETO UTIL,
53200 MOVEM N,E.B ; RESET EDIT BUFFER
53300 ADDI N,1
53400 MOVEM N,E.A
53500 ADDI N,1
53600 MOVEM N,E.Z
53700 ADDI N,1
53800 MOVEM N,E.P
53900 JUMPN UTIL,EXERER
54000 JRST EXNEXT
54100
54200 EX$ER: TRNE FLAG,F$V!F$PC!F$O
54300 JRST EXER04
54400 A$STR <1>
54500 A$$END ; -- END PARSING
54600 MOVE PTR,E.B
54700 CALLR EXFIG ; PRODUCE FILE NAME
54800 CALLR IO$ER ; READ FILE
54900 JRST EXERER
55000 CALLR EXFIP
55100 JRST EXNEXT
55200
55300 EX$EW: TRNE FLAG,F$V!F$PC!F$O
55400 JRST EXER04
55500 MOVEM CH,EX%CH
55600 A$STR <1>
55700 A$$END ; -- END PARSING
55800 MOVE PTR,E.B
55900 CALLR EXFIG ; PRODUCE FILE NAME
56000 CALLR IO$EW ; WRITE FILE
56100 JRST EXERER
56200 CALLR EXFIP
56300 MOVE CH,EX%CH
56400 LETEST (G,HALTGO)
56500 LETEST (X,HALT)
56600 JRST EXNEXT
56700
56800 EX$FA: TRNE FLAG,-1
56900 JRST EXER06
57000 MOVE PTR,EX%A
57100 CAIL PTR,Q.0
57200 CAILE PTR,Q.$
57300 JRST EXNEXT ; VERIFY THAT SAVED QREG IS A QREG
57400 JRST EX$A0
57500
57600 EX$FB: TRNE FLAG,F$VC!F$V2!F$P!F$O
57700 JRST EXER06
57800 A$INT <^D10>
57900 A$$END ; -- END PARSING
58000 CAIG V1,1 ; (IF <N> < 2 THEN BASE GETS 10)
58100 MOVEI V1,^D10
58200 CAIL V1,^D11 ; (IF <N> > 10 THEN BASE GETS 10)
58300 MOVEI V1,^D10
58400 MOVEM V1,EXBASE ; SET BASE
58500 JRST EXNEXT
58600
58700 EX$FC: TRNE FLAG,F$VC!F$P!F$O
58800 JRST EXER06
58900 TRNN FLAG,F$V1
59000 MOVEI V1,0 ; DEFAULT TEST VALUE IS 0
59100 TRNN FLAG,F$V2
59200 MOVEI V2,1 ; DEFAULT NUMBER OF LEVELS TO RETURN IS 1
59300 TRZ FLAG,-1 ; LEAVE NO ARGS
59400 MOVEI UTIL,(CH)
59500 CALLR EXCHAR
59600 LETEST (E,EX$FCE)
59700 LETEST (N,EX$FCN)
59800 LETEST (G,EX$FCG)
59900 LETEST (L,EX$FCL)
60000 MOVEI CH,(UTIL)
60100 JRST EXER06
60200 EX$FCE: JUMPE V1,EX$FC0 ; <N> = 0
60300 JRST EXNEXT
60400 EX$FCN: JUMPN V1,EX$FC0 ; <N> # 0
60500 JRST EXNEXT
60600 EX$FCG: JUMPG V1,EX$FC0 ; <N> > 0
60700 JRST EXNEXT
60800 EX$FCL: JUMPL V1,EX$FC0 ; <N> < 0
60900 JRST EXNEXT
61000 EX$FC0: JUMPL FLAG,EXNEXT
61100 TLO FLAG,F$EI ; INHIBIT EXECUTION IF TEST SUCCEEDED
61200 MOVEI V1,(LEVEL)
61300 SUBI V1,-1(V2)
61400 SKIPGE V1
61500 MOVEI V1,0
61600 HRLI LEVEL,(V1)
61700 JRST EXNEXT
61800
61900 EX$FD: TRNE FLAG,F$VC!F$V2!F$PC
62000 JRST EXER06
62100 TRO FLAG,F$VC ; INDICATE FD-FS REPLACE
62200 A$INT <1>
62300 A$STR <1>
62400 A$$END ; -- END PARSING
62500 SETZM EX%S2N ; ZERO REPLACE ARGS
62600 SETZM EX%S2P
62700 JRST EX$R0D
62800
62900 EX$FG: TRNE FLAG,-1
63000 JRST EXER06
63100 TRO FLAG,F$PA
63200 JRST EX$FTS
63300
63400 EX$FI: TRNE FLAG,F$VC!F$V2!F$P!F$O
63500 JRST EXER06
63600 A$INT <" ">
63700 A$$END ; -- END PARSING
63800 MOVEI N,1
63900 CALLR ABORTI
64000 CALLR EXEBIS
64100 CALLR EXEBE ; EXPAND EB
64200 MOVE PTR,@E.P
64300 AOS @E.P ; INCREMENT .
64400 CALLR EXBPE
64500 IDPB V1,PTR ; INSERT CHARACTER
64600 CALLR ABORTE
64700 CALLR EXAV ; (IMPLICIT V)
64800 JRST EXNEXT
64900
65000 EX$FK: TRNE FLAG,-1
65100 JRST EXER01
65200 A$QREG
65300 JUMPL FLAG,EXNEXT ; -- END PARSING
65400 CALLR EXESTS
65500 SETZM Q.Z(PTR)
65600 SETZM Q.P(PTR)
65700 JRST EXNEXT
65800
65900 EX$FM: TRNE FLAG,-1
66000 JRST EXER06
66100 A$QREG
66200 HRRZI UTIL,(PTR)
66300 A$QREG
66400 JUMPL FLAG,EXNEXT ; -- END PARSING
66500 CAMN PTR,E.B
66600 JRST EXER10
66700 CALLR EXESTS
66800 HRLI PTR,(UTIL)
66900 CALLR EXQTOQ
67000 JRST EXERER
67100 JRST EXNEXT
67200
67300 EX$FN: TRNE FLAG,F$VC!F$V2!F$PC
67400 JRST EXER06
67500 TRO FLAG,F$VC ; INDICATE FN SEARCH
67600 JRST EX$S0
67700
67800 EX$FO: TRNE FLAG,F$P
67900 JRST EXER06
68000 JUMPL FLAG,EX$FO0
68100 MOVE N,@E.Z
68200 SUB N,@E.P
68300 JUMPE N,EX$FO0
68400 MOVE PTR,@E.P
68500 CALLR EXBPE
68600 ILDB N,PTR ; GET CHAR AT EP+1 FROM EB
68700 EX$FO0: CALLR EXVALS ; PRODUCE CHAR VALUE
68800 JRST EXER06
68900 JRST EXNEXT
69000
69100 EX$FP: TRNE FLAG,F$VC!F$PA!F$PS
69200 JRST EXER06
69300 TRO FLAG,F$VC ; INDICATE FP-FX
69400 JRST EX$P0
69500
69600 EX$FQ: TRNE FLAG,-1
69700 JRST EXER06
69800 JUMPL FLAG,EXNEXT ; -- END PARSING
69900 MOVEI PTR,Q.0
70000 EX$FQ1: HLRZ N,(PTR)
70100 CAMN PTR,E.B
70200 JRST EX$FQ2
70300 CAMN PTR,EX%A
70400 JRST EX$FQ2
70500 SKIPN Q.A(PTR)
70600 JUMPE N,EX$FQ6
70700 EX$FQ2: TSOUT <[ASCIZ/In /]>
70800 CALLR QNOUT
70900 CAME PTR,E.B
71000 JRST EX$FQ3
71100 TSOUT <[ASCIZ/ (now being edited)/]>
71200 EX$FQ3: CAME PTR,EX%A
71300 JRST EX$FQ4
71400 TSOUT <[ASCIZ/ (last edited)/]>
71500 EX$FQ4: JUMPE N,EX$FQ5
71600 SUBI N,1
71700 IMULI N,NSIZE
71800 ADD N,N.B ; CONVERT FILE NAME INDEX TO POINTER
71900 SKIPN (N)
72000 JRST EX$FQ5
72100 TSOUT <[ASCIZ/ (editing /],(N),[ASCIZ/)/]>
72200 EX$FQ5: TSOUT <[ASCIZ/ . is /]>
72300 MOVEI M,^D10
72400 MOVE N,Q.P(PTR)
72500 CALLR M$I.S
72600 TSOUT <M$I.SR,<[ASCIZ/ and Z is /]>>
72700 MOVE N,Q.Z(PTR)
72800 CALLR M$I.S
72900 TSOUT <M$I.SR,[ASCIZ/./],CRLF>
73000 EX$FQ6: ADDI PTR,PBLOCK
73100 CAIE PTR,E.B
73200 JRST EX$FQ1
73300 JRST EXNEXT
73400
73500 EX$FS: TRNE FLAG,F$VC!F$V2!F$PC
73600 JRST EXER06
73700 TRO FLAG,F$VC ; INDICATE FD-FS REPLACE
73800 JRST EX$R0S
73900
74000 EX$FT$: MOVEI UTIL,(CH)
74100 CALLR EXCHAR
74200 LETEST (E,EX$FTE)
74300 LETEST (I,EX$FTI)
74400 LETEST (O,EX$FTO)
74500 LETEST (P,EX$FTP)
74600 LETEST (S,EX$FTS)
74700 MOVEI CH,(UTIL)
74800 JRST EXER05
74900
75000 EX$FTE: TRNE FLAG,F$VC!F$V2!F$P
75100 JRST EXER07
75200 A$INT <0>
75300 A$$END ; -- END PARSING
75400 MOVEM V1,FLAGEF
75500 CALLR ECHOS
75600 JRST EXNEXT
75700
75800 EX$FTI: TRNE FLAG,F$P
75900 JRST EXER07
76000 JUMPL FLAG,EX%FTI
76100 TBIN <CH>
76200 MOVEI N,(CH)
76300 EX%FTI: CALLR EXVALS ; PRODUCE CHAR VALUE
76400 JRST EXER07
76500 JRST EXNEXT
76600
76700 EX$FTO: TRNE FLAG,F$VC!F$P!F$O
76800 JRST EXER07
76900 TRZN FLAG,F$V2
77000 MOVE V2,EXPRIM
77100 A$INT <" ">
77200 A$$END ; -- END PARSING
77300 MOVEI CH,(V1)
77400 JUMPL V2,EX%FTO
77500 SKIPN V2
77600 CALLR TERMO
77700 SKIPE V2
77800 CALLR TERMV
77900 JRST EXNEXT
78000 EX%FTO: TBOUT <CH>
78100 JRST EXNEXT
78200
78300 EX$FTP: TRNE FLAG,F$VC!F$V2!F$P
78400 JRST EXER07
78500 A$INT <0>
78600 A$$END ; -- END PARSING
78700 MOVEM V1,EXPRIM ; SET <N> FOR PRINT MODE
78800 JRST EXNEXT
78900
79000 EX$FTS: TRNE FLAG,F$VC!F$V2!F$PC!F$O
79100 JRST EXER07
79200 TRZN FLAG,F$V1
79300 MOVE V1,EXPRIM
79400 A$STR <1>
79500 A$$END ; -- END PARSING
79600 MOVE V2,EXPRIM
79700 MOVEM V1,EXPRIM
79800 MOVE N,EX%S1N
79900 MOVE PTR,EX%S1P
80000 JUMPE N,EXNEXT
80100 TRNE UTIL,F$PS
80200 IBP PTR
80300 CALLR EXPRIS ; OUTPUT STRING
80400 MOVEM V2,EXPRIM
80500 JRST EXNEXT
80600
80700 EX$FV: TRNE FLAG,F$V!F$PC!F$O
80800 JRST EXER06
80900 A$STR <1>
81000 A$$END ; -- END PARSING
81100 MOVE N,EX%S1N
81200 CAIL N,9
81300 JRST EXER13
81400 MOVE M,EX%S1P
81500 MOVE PTR,[440700,,EXVPTR]
81600 JUMPE N,EX$FV2
81700 EX$FV1: ILDB CH,M
81800 IDPB CH,PTR ; STORE POINTER TEXT
81900 SOJG N,EX$FV1
82000 EX$FV2: SETZ CH,
82100 IDPB CH,PTR
82200 JRST EXNEXT
82300
82400 EX$FW: TRNE FLAG,F$VC!F$V2!F$P!F$O
82500 JRST EXER06
82600 A$INT <0>
82700 A$$END ; -- END PARSING
82800 SKIPGE V1 ; (IF <N> < 0 THEN EXVSIZ GETS 0)
82900 SETZ V1,
83000 MOVEM V1,EXVSIZ ; SET <N> FOR AUTOMATIC V
83100 JRST EXNEXT
83200
83300 EX$FZ: TRNE FLAG,F$P
83400 JRST EXER01
83500 MOVEI UTIL,(CH)
83600 A$QREG
83700 TLNN FLAG,F$EI
83800 MOVE N,Q.Z(PTR)
83900 MOVEI CH,(UTIL)
84000 CALLR EXVALS ; PRODUCE VALUE ARG
84100 JRST EXER01
84200 JRST EXNEXT
84300
84400 EX$F%D: TRNE FLAG,F$VC!F$P!F$O
84500 JRST EXER06
84600 TRNN FLAG,F$V1
84700 JRST EXER06
84800 TRZN FLAG,F$V2
84900 JRST EXER06
85000 IDIV V1,V2 ; DIVIDE
85100 JRST EXNEXT
85200
85300 EX$F%M: TRNE FLAG,F$VC!F$P!F$O
85400 JRST EXER06
85500 TRNN FLAG,F$V1
85600 JRST EXER06
85700 TRZN FLAG,F$V2
85800 JRST EXER06
85900 IMUL V1,V2 ; MULTIPLY
86000 JRST EXNEXT
86100
86200 EXCHAR: BEGINR
86300 EXCH1: SOSGE EX%N
86400 JRST EXCH2
86500 ILDB CH,EX%PTR
86600 JUMPL FLAG,RETN(0)
86700 SKIPE EXDBUG
86800 CALLR TERMV
86900 RETURN
87000 EXCH2: JUMPN LEVEL,EXER15
87100 TLNN FLAG,F$EM
87200 JRST EXCH3
87300 POP ENVIR,LEVEL
87400 POP ENVIR,EX%PTR
87500 POP ENVIR,EX%N
87600 POP ENVIR,UTIL
87700 HLL FLAG,UTIL ; RESTORE FLAGS
87800 POP ENVIR,UTIL
87900 HRRZI PTR,(UTIL) ; RESTORE QREG POINTER
88000 MOVEM PTR,EX%Q
88100 JUMPE PTR,EXCH1 ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
88200 HLRZ PTR,UTIL
88300 EXQPTR <PTR>
88400 JRST EXCH1
88500 EXCH3: MOVE STACK,[IOWD SSIZE,STACKB]
88600 POPJ ENVIR, ; IF NOT EXECUTING A MACRO THEN RETURN
88700 ENDR
88800
88900 ; TRANSLATE CHARACTER INTO QREG POINTER
89000 ; OUT: CH -- QREG CHARACTER
89100 ; PTR -- POINTER TO QREG
89200 ;
89300 EXQREG: BEGINR
89400 SKIPE EX%PTR
89500 CALLR EXCHAR
89600 CAIN CH,"*"
89700 JRST EXQRE0
89800 MOVEI PTR,(CH)
89900 CAIGE CH,"0"
90000 JRST EXER08
90100 CAIG CH,"9"
90200 JRST EXQRE1
90300 CAIGE CH,"A"
90400 JRST EXER08
90500 CAIG CH,"Z"
90600 JRST EXQRE3
90700 CAIGE CH,"A"+40
90800 JRST EXER08
90900 CAIG CH,"Z"+40
91000 JRST EXQRE2
91100 JRST EXER08
91200 EXQRE0: MOVEI PTR,Q.$
91300 RETURN
91400 EXQRE1: SUBI PTR,"0" ; NUMBERED QREGS (0-9)
91500 IMULI PTR,PBLOCK
91600 ADDI PTR,Q.0
91700 RETURN
91800 EXQRE2: SUBI PTR,40
91900 EXQRE3: SUBI PTR,"A" ; LETTERED QREGS (10-36)
92000 ADDI PTR,^D10
92100 IMULI PTR,PBLOCK
92200 ADDI PTR,Q.0
92300 ENDR
92400
92500 ; PARSE STRING ARGUMENT
92600 ; OUT: CH -- TERMINATING CHARACTER
92700 ; N -- LENGTH OF STRING
92800 ; M -- POINTER TO BEGINNING OF STRING
92900 ;
93000 EXSTRI: BEGINR <PTR,UTIL>
93100 TRNE FLAG,F$PA
93200 JRST EXSTR4
93300 SETZ N,
93400 MOVE M,EX%PTR
93500 PUSH STACK,EXDBUG
93600 SETZM EXDBUG
93700 MOVEI UTIL,33 ; DEFAULT TERMINATOR IS ESCAPE
93800 TRNN FLAG,F$PS
93900 JRST EXSTR1
94000 CALLR EXCHAR ; / -- GET EXPLICIT TERMINATOR
94100 CAIN CH,33 ; IF IT IS ESCAPE THEN QUIT
94200 JRST EXSTR3
94300 MOVEI UTIL,(CH)
94400 EXSTR1: TRNE FLAG,F$EM
94500 JRST EXSTR2
94600 SKIPN EX%N
94700 JRST EXER12
94800 EXSTR2: CALLR EXCHAR ; PASS OVER STRING
94900 CAIN CH,(UTIL)
95000 JRST EXSTR3 ; UNTIL TERMINATOR IS REACHED
95100 AOJA N,EXSTR1
95200 EXSTR3: POP STACK,EXDBUG
95300 RETURN
95400 EXSTR4: CALLR EXQREG ; @ -- GET QREG
95500 JUMPL FLAG,RETN(0)
95600 SKIPG Q.Z(PTR)
95700 JRST EXER09
95800 CAMN PTR,E.B
95900 JRST EXER10
96000 HRR M,(PTR) ; SET UP POINTER
96100 HRLI M,440700
96200 MOVE N,2(PTR) ; AND COUNT
96300 ENDR
96400
96500 ; USE NUMERIC ARGUMENTS -- SUPPLY DEFAULTS
96600 ; IN: N -- DEFAULT VALUE FOR V1
96700 ; OUT: V1 IF DEFAULT, FLAG UPDATED
96800 ;
96900 EXVALU: BEGINR
97000 TRNE FLAG,F$V1
97100 RETURN
97200 TRNN FLAG,F$V2
97300 JRST EXVAU0
97400 MOVEI CH,","
97500 JRST EXER02
97600 EXVAU0: TRNE FLAG,F$OA
97700 MOVEI V1,1
97800 TRNE FLAG,F$OS
97900 MOVNI V1,1
98000 TRZN FLAG,F$O
98100 MOVE V1,N
98200 TRO FLAG,F$V1
98300 ENDR
98400
98500 ; SET NUMERIC ARGUMENTS -- APPLY OPERAND AND OPERATOR TO V1 OR V2
98600 ; IN: N -- OPERAND (OPERATOR FROM FLAG)
98700 ; OUT: V1 OR V2 UPDATED
98800 ; FLAG UPDATED
98900 ;
99000 EXVALS: BEGINR
99100 TRNN FLAG,F$V1!F$VC!F$V2
99200 JRST EXVAS1 ; NO VALUE -- INITIALIZE V1
99300 TRNE FLAG,F$VC
99400 JRST EXVAS2 ; COMMA -- INITIALIZE V2
99500 TRNN FLAG,F$O
99600 RETURN ; ERROR IF V1 OR V2 AND NO OPERATOR
99700 JRST EXVAS3
99800 EXVAS1: TRO FLAG,F$V1 ; FIRST V1
99900 SETZ V1,
00100 JRST EXVAS3
00200 EXVAS2: TRZ FLAG,F$VC
00300 TRO FLAG,F$V2 ; FIRST V2
00400 SETZ V2,
00500 EXVAS3: JUMPL FLAG,EXVAS5
00600 TRNE FLAG,F$V2
00700 JRST EXVAS4
00800 TRNN FLAG,F$OS ; OPERATE ON V1
00900 ADD V1,N
01000 TRNE FLAG,F$OS
01100 SUB V1,N
01200 JRST EXVAS5
01300 EXVAS4: TRNN FLAG,F$OS ; OPERATE ON V2
01400 ADD V2,N
01500 TRNE FLAG,F$OS
01600 SUB V2,N
01700 EXVAS5: TRZ FLAG,F$O
01800 ENDR SKIP,1
01900
02000 ; EXARGE -- END ARGUMENT PROCESSING
02100 ;
02200 EXARGE: BEGINR
02300 MOVE UTIL,FLAG ; SAVE FLAGS
02400 TRZ FLAG,-1 ; LEAVE NO ARGS
02500 JUMPL FLAG,RETN(0) ; -- EXECUTION INHIBITED
02600 ENDR SKIP,1
02700
02800 ; LINE FINDER
02900 ; IN: UTIL -- FLAGS
03000 ; V1
03100 ; V2
03200 ; OUT: V1 -- FIRST CHARACTER NUMBER
03300 ; V2 -- LENGTH OF STRING
03400 ;
03500 EXLINE: BEGINR <CH,PTR,N,M>
03600 TRNE UTIL,F$PC
03700 JRST EXLINC ; :
03800 TRNE UTIL,F$V2
03900 JRST EXLINT ; TWO VALUES
04000 JUMPG V1,EXLINF
04100 MOVN M,V1 ; BACKWARD SEARCH
04200 MOVE V1,@E.P
04300 MOVE V2,@E.P ; DEFAULT VALUES ARE .
04400 JUMPE V2,RETN(0)
04500 MOVE PTR,V1
04600 CALLR EXBPE
04700 EXLIB1: LDB CH,PTR
04800 CAIN CH,12
04900 JRST EXLIB3
05000 CAIN CH,37
05100 JRST EXLIB3
05200 EXLIB2: DBP <PTR>
05300 SOJG V1,EXLIB1
05400 RETURN
05500 EXLIB3: SOJGE M,EXLIB2
05600 SUB V2,V1 ; LENGTH IS . - BACKED OVER CHARS
05700 RETURN
05800 EXLINF: MOVE M,V1 ; FORWARD SEARCH
05900 MOVE V1,@E.P
06000 MOVE V2,@E.Z
06100 SUB V2,@E.P ; DEFAULT VALUES ARE . AND Z - .
06200 MOVE N,V2
06300 MOVE PTR,V1
06400 CALLR EXBPE
06500 EXLIF1: SOJLE N,RETN(0)
06600 ILDB CH,PTR
06700 CAIN CH,12
06800 JRST EXLIF2
06900 CAIN CH,37
07000 JRST EXLIF2
07100 JRST EXLIF1
07200 EXLIF2: SOJG M,EXLIF1
07300 SUB V2,N ; LENGTH IS Z - . - NUMBER OF CHARS LEFT
07400 RETURN
07500 EXLINC: MOVE V1,@E.P ; :
07600 MOVE V2,@E.Z
07700 SUB V2,@E.P ; DEFAULT VALUES ARE . AND Z - .
07800 JUMPE V2,RETN(0)
07900 MOVE N,V2
08000 MOVE PTR,V1
08100 CALLR EXBPE
08200 EXLIC1: ILDB CH,PTR
08300 CAIN CH,12
08400 JRST EXLIC2
08500 CAIN CH,15
08600 JRST EXLIC2
08700 CAIN CH,37
08800 JRST EXLIC2
08900 SOJG N,EXLIC1
09000 RETURN
09100 EXLIC2: SUB V2,N ; LENGTH IS Z - . - NUMBER OF CHARS LEFT
09200 RETURN
09300 EXLINT: CAIGE V1,0 ; <M>,<N>
09400 MOVEI V1,0
09500 CAMLE V1,@E.Z
09600 MOVE V1,@E.Z
09700 CAMGE V2,V1
09800 MOVE V2,V1
09900 CAMLE V2,@E.Z
10000 MOVE V2,@E.Z
10100 SUB V2,V1
10200 ENDR
10300
10400 ; WORD FINDER
10500 ; IN: V1
10600 ; OUT: V1 -- FIRST CHARACTER NUMBER
10700 ; V2 -- LENGTH OF STRING
10800 ;
10900 EXWORD: BEGINR <CH,PTR,N,M,FLAG>
11000 JUMPG V1,EXWOF0
11100 MOVN M,V1 ; BACKWARD SEARCH
11200 MOVE V1,@E.P
11300 MOVE V2,@E.P ; DEFAULT VALUES ARE .
11400 JUMPE V2,RETN(0)
11500 SETZ FLAG,
11600 MOVE PTR,V1
11700 CALLR EXBPE
11800 JRST EXWOB$
11900 EXWOB1: JUMPE V1,RETN(0)
12000 DBP <PTR>
12100 EXWOB$: LDB CH,PTR ; GET A CHAR AND DETERMINE ITS TYPE
12200 CALLR WORDET
12300 JRST EXWOB4
12400 JRST EXWOB2
12500 SETO FLAG, ; PROCESS WORD
12600 SOJA V1,EXWOB1
12700 EXWOB2: JUMPE FLAG,EXWOB3 ; PROCESS PUNCTUATION
12800 SETZ FLAG,
12900 SOJLE M,EXWOB5
13000 EXWOB3: SUBI V1,1
13100 SOJLE M,EXWOB5
13200 JRST EXWOB1
13300 EXWOB4: SKIPN FLAG ; PROCESS SEPARATOR
13400 SOJA V1,EXWOB1
13500 SETZ FLAG,
13600 SOSLE M
13700 SOJA V1,EXWOB1
13800 EXWOB5: SUB V2,V1 ; LENGTH IS . - BACKED OVER CHARS
13900 RETURN
14000 EXWOF0: MOVE M,V1 ; FORWARD SEARCH
14100 MOVE V1,@E.P
14200 MOVE V2,@E.Z
14300 SUB V2,@E.P ; DEFAULT VALUES ARE . AND Z - .
14400 MOVE N,V2
14500 SETZ FLAG,
14600 MOVE PTR,V1
14700 CALLR EXBPE
14800 EXWOF1: JUMPE N,RETN(0)
14900 ILDB CH,PTR ; GET A CHAR AND DETERMINE ITS TYPE
15000 CALLR WORDET
15100 JRST EXWOF4
15200 JRST EXWOF2
15300 SETO FLAG, ; PROCESS WORD
15400 SOJA N,EXWOF1
15500 EXWOF2: JUMPE FLAG,EXWOF3 ; PROCESS PUNCTUATION
15600 SETZ FLAG,
15700 SOJLE M,EXWOF5
15800 EXWOF3: SUBI N,1
15900 SOJLE M,EXWOF5
16000 JRST EXWOF1
16100 EXWOF4: SKIPN FLAG ; PROCESS SEPARATOR
16200 SOJA N,EXWOF1
16300 SETZ FLAG,
16400 SOSLE M
16500 SOJA N,EXWOF1
16600 EXWOF5: SUB V2,N ; LENGTH IS Z - . - NUMBER OF CHARS LEFT
16700 ENDR
16800
16900 ; AUTOMATIC V
17000 ;
17100 EXAV: BEGINR
17200 TLNE FLAG,F$EM ; IF EXECUTING MACRO THEN SKIP V
17300 RETURN
17400 SKIPN EXVSIZ ; IF THE NUMBER OF LINES IS ZERO THEN SKIP V
17500 RETURN
17600 MOVE X1,EX%PTR
17700 MOVE X2,EX%N
17800 EXAV0A: JUMPE X2,EXAV0B
17900 ILDB X3,X1
18000 HRRZ X4,DISPCH(X3)
18100 CAIN X4,EXNEXT ; PASS OVER SEPARATORS TO NEXT COMMAND
18200 SOJA X2,EXAV0A
18300 RETURN
18400 EXAV0B: CALLR EXAV$
18500 ENDR
18600 EXAV$: BEGINR <CH,PTR,N,M,V1,V2,UTIL>
18700 SETZ UTIL, ; ZERO EXLINE FLAGS
18800 MOVN V1,EXVSIZ
18900 ADDI V1,1
19000 CALLR EXLINE ; -(N-1)T SUPPLIES POINTER + PARTIAL LENGTH
19100 MOVE PTR,V1
19200 MOVE V1,EXVSIZ
19300 MOVE N,V2
19400 CALLR EXLINE ; NT SUPPLIES REMAINDER OF LENGTH
19500 MOVE M,N
19600 ADD M,V2
19700 JUMPE M,RETN(0)
19800 CALLR EXBPE
19900 CALLR EXPRIS
20000 TSOUT <EXVPTR>
20100 MOVE N,V2
20200 CALLR EXPRIS
20300 ENDR
20400
20500 ; FILE NAME GET
20600 ; IN: PTR -- POINTER TO QREG
20700 ; UTIL -- ARGUMENT FLAGS
20800 ;
20900 EXFIG: BEGINR <CH,PTR,N,M>
21000 SETZM IONAME
21100 SKIPE N,EX%S1N
21200 JRST EXFIG3
21300 SKIPN N.V
21400 JRST EXFIG1
21500 HLRZ PTR,(PTR)
21600 JUMPE PTR,EXFIG1
21700 SUBI PTR,1
21800 IMULI PTR,NSIZE
21900 ADD PTR,N.B ; CONVERT FILE NAME INDEX TO POINTER
22000 SKIPE (PTR)
22100 JRST EXFIG2
22200 EXFIG1: TSOUT <[ASCIZ/ ? No default file name ?/],CRLF>
22300 JRST EXERER
22400 EXFIG2: HRLI PTR,(PTR)
22500 HRRI PTR,IONAME
22600 BLT PTR,<IONAME+NSIZE-1> ; USE PREVIOUS FILE NAME
22700 RETURN
22800 EXFIG3: CAIL N,<NSIZE*5>
22900 JRST EXER13
23000 MOVE M,EX%S1P
23100 TRNE UTIL,F$PS
23200 IBP M
23300 MOVE PTR,[440700,,IONAME]
23400 EXFIG4: ILDB CH,M
23500 IDPB CH,PTR ; MOVE TEXT INTO FILE NAME BUFFER
23600 SOJG N,EXFIG4
23700 SETZ CH,
23800 IDPB CH,PTR
23900 ENDR
24000
24100 ; FILE NAME PUT
24200 ;
24300 EXFIP: BEGINR <PTR,N,M,UTIL>
24400 MOVE PTR,E.B
24500 HLRZ UTIL,(PTR)
24600 JUMPN UTIL,EXFIP4
24700 SKIPN IONAME
24800 RETURN
24900 MOVE N,N.V ; GET NAME SPACE FOR THIS QREG
25000 CAME N,N.P
25100 JRST EXFIP1
25200 MOVEI UTIL,<NSIZE*5>
25300 ADDB UTIL,N.Z
25400 CAMG UTIL,N.A
25500 JRST EXFIP0
25600 MOVE M,PTR
25700 MOVE PTR,[NSIZE*5,,N.B]
25800 CALLR ALLOC ; ALLOCATE NEW NAME SPACE
25900 RETURN
26000 MOVE PTR,M
26100 EXFIP0: ADDI N,1
26200 MOVEM N,N.V ; INCREMENT COUNT OF ALLOCATED NAMES
26300 JRST EXFIP3
26400 EXFIP1: MOVE M,N.B
26500 MOVEI N,1
26600 EXFIP2: SKIPN (M) ; REUSE OLD (ZEROED) NAME SPACE
26700 JRST EXFIP3
26800 ADDI M,NSIZE
26900 AOJA N,EXFIP2
27000 EXFIP3: AOS N.P ; INCREMENT COUNT OF USED NAMES
27100 MOVEI UTIL,(N)
27200 HRLM UTIL,(PTR) ; SET FILE NAME INDEX OF QREG
27300 JRST EXFIP5
27400 EXFIP4: SKIPE IONAME
27500 JRST EXFIP5
27600 SUBI UTIL,1
27700 IMULI UTIL,NSIZE
27800 ADD UTIL,N.B
27900 SETZM (UTIL)
28000 SOS N.P ; ZERO AND DEALLOCATE NAME SPACE
28100 HRRZS (PTR)
28200 RETURN
28300 EXFIP5: IMULI UTIL,NSIZE
28400 ADD UTIL,N.B
28500 HRLI PTR,IONAME
28600 HRRI PTR,-NSIZE(UTIL)
28700 BLT PTR,-1(UTIL) ; COPY FILE NAME TO QREG NAME SPACE
28800 ENDR
28900
29000 ; QREG TO QREG MOVER
29100 ; IN: PTR -- FROM POINTER,,TO POINTER
29200 ;
29300 EXQTOQ: BEGINR <PTR,N,M,V1,V2>
29400 HLRZ V1,PTR
29500 HRRZI V2,(PTR)
29600 MOVE N,Q.Z(V1)
29700 CAMG N,Q.A(V2)
29800 JRST EXQQ0
29900 MOVEI PTR,(N) ; ALLOCATE QREG SPACE
30000 SUB PTR,Q.A(V2)
30100 HRLI PTR,(PTR)
30200 HRRI PTR,(V2)
30300 CALLR ALLOC
30400 RETURN
30500 EXQQ0: SETZM Q.P(V2)
30600 MOVEM N,Q.Z(V2) ; SET QREG USED COUNT
30700 JUMPE N,RETN(1)
30800 SUBI N,1
30900 IDIVI N,5
31000 ADD N,Q.B(V2)
31100 HRL PTR,(V1) ; MOVE FROM QREG 1
31200 HRR PTR,(V2) ; TO QREG 2
31300 BLT PTR,(N) ; UNTIL (QREG 2 POINTER) + SIZE - 1
31400 ENDR SKIP,1
31500
31600 ; SEARCH BUFFER INITIALIZATION
31700 ; IN: PTR -- POINTER TO FIRST CHARACTER OF STRING
31800 ; N -- LENGTH OF STRING
31900 ; OUT: SB UPDATED
32000 ;
32100 EXSBI: BEGINR <CH,PTR,N,M,V1,V2>
32200 JUMPE N,RETN(0) ; USE PREVIOUS STRING
32300 ADDI N,1 ; (ACCOUNT FOR TRAILING RUBOUT)
32400 MOVEI V1,(N)
32500 IMULI V1,5 ; ONE WORD PER CHAR
32600 SUB V1,S.A
32700 JUMPLE V1,EXSBI1
32800 MOVE M,PTR
32900 CALLR EXQSB
33000 MOVE CH,PTR
33100 MOVE PTR,M
33200 HRLI PTR,(V1) ; ALLOCATE SB SPACE FOR STRING
33300 HRRI PTR,S.B
33400 CALLR ALLOC
33500 JRST EXERER
33600 MOVE PTR,CH
33700 CALLR EXQSA
33800 MOVE PTR,M
33900 EXSBI1: MOVEI V1,-1(N)
34000 MOVE V2,S.B
34100 EXSBI2: ILDB CH,PTR
34200 MOVEM CH,(V2) ; MOVE CHARS INTO SB WORD BY WORD
34300 AOJ V2,
34400 SOJG V1,EXSBI2
34500 SETOM CH,(V2) ; END SB STRING WITH A -1
34600 MOVEM N,S.Z
34700 ENDR
34800
34900 ; EDIT BUFFER SEARCH FORWARD
35000 ; IN: SB
35100 ; OUT: EP UPDATED
35200 ;
35300 ; REGISTER USAGE
35400 ; CH -- EB CHAR
35500 ; PTR -- EB POINTER
35600 ; N -- EB CHAR COUNT
35700 ; M -- PTR TEMPORARY
35800 ; V1 -- SB CHAR INDEX
35900 ; V2 -- SB CHAR
36000 ; FLAG -- SB FIRST CHAR
36100 ;
36200 EXESF: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
36300 SKIPN S.Z
36400 RETURN SKIP,1 ; EVERYTHING MATCHES THE EMPTY STRING
36500 MOVE N,@E.Z ; N GETS NUMBER OF POSSIBLE FIRST CHARS
36600 SUB N,@E.P ; WHICH DOESN'T INCLUDE THOSE BEFORE .
36700 SUB N,S.Z ; OR THOSE AT END
36800 ADDI N,2 ; (ACCOUNT FOR FIRST CHAR AND FINAL -1)
36900 JUMPLE N,RETN(0) ; OUT OF POSSIBILITIES
37000 SETZ M, ; ZERO COUNT OF CHARS PASSED
37100 MOVE FLAG,@S.B ; FLAG GETS FIRST CHAR OF STRING
37200 CAIN FLAG,"X"-100
37300 SETO FLAG,
37400 MOVE PTR,@E.P
37500 CALLR EXBPE ; PTR GETS .
37600 EXESF1: ADDI M,1 ; INCREMENT PASSED CHAR COUNTER
37700 JUMPL FLAG,EXESF2 ; ^X MATCHES ANYTHING
37800 ILDB CH,PTR
37900 CAIN CH,(FLAG) ; SEARCH FOR FIRST MATCH
38000 JRST EXESF2
38100 SOJG N,EXESF1
38200 RETURN ; OUT OF POSSIBILITIES
38300 EXESF2: MOVE UTIL,PTR
38400 MOVE V1,S.B
38500 ADDI V1,1 ; V1 GETS INDEX FOR COMPLETE SB SCAN
38600 EXESF3: MOVE V2,(V1)
38700 JUMPL V2,EXESF4 ; SUCCESS -- END OF SB
38800 ILDB CH,PTR
38900 CAIN V2,"X"-100
39000 AOJA V1,EXESF3 ; ^X MATCHES ANYTHING
39100 CAIN CH,(V2)
39200 AOJA V1,EXESF3
39300 MOVE PTR,UTIL ; FAILURE -- RESTORE PTR AND TRY AGAIN
39400 SOJG N,EXESF1
39500 RETURN ; OUT OF POSSIBILITIES
39600 EXESF4: ADDB M,@E.P ; ADD PASSED CHARS TO .
39700 MOVEM M,EX.S
39800 SOS EX.S
39900 MOVE M,S.Z
40000 SUBI M,2
40100 ADDM M,@E.P ; ADD LENGTH (MINUS FIRST AND FINAL -1)
40200 ENDR SKIP,1
40300
40400 ; EDIT BUFFER SEARCH BACKWARD
40500 ; IN: SB
40600 ; OUT: EP UPDATED
40700 ;
40800 ; REGISTER USAGE SAME AS EXESF
40900 ;
41000 EXESB: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
41100 SKIPN S.Z
41200 RETURN SKIP,1 ; EVERYTHING MATCHES THE EMPTY STRING
41300 MOVE N,@E.P ; N GETS NUMBER OF POSSIBLE FIRST CHARS
41400 MOVE M,@E.Z
41500 SUB M,S.Z ; THE SEARCH MUST START SB CHARS BACK
41600 ADDI M,2 ; (ACCOUNT FOR FIRST CHAR AND FINAL -1)
41700 CAMLE N,M
41800 MOVE N,M
41900 JUMPLE N,RETN(0) ; OUT OF POSSIBILITIES
42000 MOVE FLAG,@S.B ; FLAG GETS FIRST CHAR OF STRING
42100 CAIN FLAG,"X"-100
42200 SETO FLAG,
42300 MOVE PTR,N
42400 CALLR EXBPE
42500 EXESB1: JUMPL FLAG,EXESB2 ; ^X MATCHES ANYTHING
42600 LDB CH,PTR
42700 CAIN CH,(FLAG) ; SEARCH FOR FIRST MATCH
42800 JRST EXESB2
42900 DBP <PTR> ; BACK UP POINTER
43000 SOJG N,EXESB1
43100 RETURN ; OUT OF POSSIBILITIES
43200 EXESB2: MOVE UTIL,PTR
43300 MOVE V1,S.B
43400 ADDI V1,1 ; V1 GETS INDEX FOR COMPLETE SB SCAN
43500 EXESB3: MOVE V2,(V1)
43600 JUMPL V2,EXESB4 ; SUCCESS -- END OF SB
43700 ILDB CH,PTR
43800 CAIN V2,"X"-100
43900 AOJA V1,EXESB3 ; ^X MATCHES ANYTHING
44000 CAIN CH,(V2)
44100 AOJA V1,EXESB3
44200 MOVE PTR,UTIL ; FAILURE -- RESTORE PTR AND TRY AGAIN
44300 DBP <PTR>
44400 SOJG N,EXESB1
44500 RETURN ; OUT OF POSSIBILITIES
44600 EXESB4: MOVEM N,EX.S
44700 SOS EX.S
44800 ADD N,S.Z ; ADD LENGTH OF STRING TO CHARS LEFT
44900 SUBI N,2 ; SUBTRACT FIRST CHAR AND FINAL -1
45000 MOVEM N,@E.P ; . GETS NUMBER OF CHARS LEFT
45100 ENDR SKIP,1
45200
45300 ; EDIT BUFFER INSERT -- SPACE ALLOCATION WITH POINTER UPDATE
45400 ; IN: N -- SIZE OF INSERT IN CHARACTERS
45500 ; M -- POINTER TO BE UPDATED
45600 ; OUT: M -- POINTER UPDATED
45700 ;
45800 EXEBIP: BEGINR <PTR,N,UTIL>
45900 ADD N,@E.Z
46000 CAMG N,@E.A
46100 RETURN
46200 CALLR EXQSB ; CONVERT TEXT POINTER TO PBLOCK POINTER
46300 MOVE UTIL,PTR
46400 HRLI PTR,(N) ; ALLOCATE EB SPACE FOR INSERT
46500 HRRI PTR,@E.B
46600 CALLR ALLOC
46700 JRST EXERER
46800 MOVE PTR,UTIL
46900 CALLR EXQSA ; UPDATE TEXT POINTER WITH PBLOCK POINTER
47000 ENDR
47100
47200 ; EDIT BUFFER INSERT -- SPACE ALLOCATION
47300 ; IN: N -- SIZE OF INSERT IN CHARACTERS
47400 ;
47500 EXEBIS: BEGINR <PTR,N>
47600 ADD N,@E.Z
47700 CAMG N,@E.A
47800 RETURN
47900 HRLI PTR,(N) ; ALLOCATE EB SPACE FOR INSERT
48000 HRRI PTR,@E.B
48100 CALLR ALLOC
48200 JRST EXERER
48300 ENDR
48400
48500 ; EDIT BUFFER INSERT -- TEXT MOVEMENT
48600 ; IN: N -- SIZE OF INSERT IN CHARACTERS
48700 ; M -- POINTER TO TEXT TO BE INSERTED
48800 ; UTIL -- FLAGS
48900 ;
49000 EXEBIT: BEGINR <CH,PTR,N,M>
49100 MOVE PTR,@E.P
49200 ADDM N,@E.P ; ADVANCE .
49300 CALLR EXBPE
49400 TRNE UTIL,F$PS
49500 IBP M ; (PASS OVER / DELIMITER)
49600 EXEBT0: ILDB CH,M
49700 IDPB CH,PTR ; MOVE IN TEXT
49800 SOJG N,EXEBT0
49900 ENDR
50000
50100 ; EDIT BUFFER EXPANSION
50200 ; IN: N -- SIZE OF EXPANSION IN CHARACTERS
50300 ; PTR -- QREG POINTER (IF N < 0)
50400 ; OUT: EZ UPDATED
50500 ;
50600 ; 1) MOVE CHARS BYTE BY BYTE TO NEW-HIGHEST-WORD BOUNDARY
50700 ; 2) MOVE CHARS WORD BY WORD
50800 ; 3) MOVE CHARS BYTE BY BYTE TO FILL NEW-LOWEST-WORD
50900 ;
51000 EXEBE: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
51100 SKIPL N
51200 SKIPA PTR,E.B
51300 MOVN N,N
51400 CALLR ABORTI
51500 MOVE FLAG,N
51600 HRRZI M,(PTR)
51700 MOVE V1,Q.Z(M)
51800 ADDB N,Q.Z(M) ; Z UPDATED
51900 CALLR EXBPQ
52000 MOVE UTIL,PTR ; UTIL GETS NEW Z POINTER
52100 MOVE N,V1
52200 HRRZI PTR,(M)
52300 CALLR EXBPQ ; PTR GETS OLD Z POINTER
52400 SUB N,Q.P(M) ; N GETS NUMBER OF CHARS TO MOVE
52500 JUMPE N,EXEBE6
52600 MOVE V1,Q.Z(M)
52700 IDIVI V1,5 ; V2: NUMBER OF CHARS IN NEW HIGHEST WORD
52800 JUMPE V2,EXEBE2
52900 EXEBE1: LDB CH,PTR
53000 DPB CH,UTIL ; NEW-HIGHEST-WORD MOVE
53100 DBP <PTR>
53200 DBP <UTIL>
53300 SOJE N,EXEBE6
53400 SOJG V2,EXEBE1
53500 EXEBE2: CAIG N,5
53600 JRST EXEBE4 ; SKIP MASS MOVEMENT IF NO MASS
53700 IDIVI N,5 ; N: WORD MOVES, M: RESIDUAL BYTE MOVES
53800 MOVE V1,FLAG
53900 IDIVI V1,5 ; V2: SIZE OF OFFSET (SIZE OF ROTATE)
54000 JRST @EXEBET(V2)
54100 EXEBE3: MOVEI N,(M)
54200 EXEBE4: JUMPE N,EXEBE6
54300 EXEBE5: LDB CH,PTR
54400 DPB CH,UTIL ; NEW-LOWEST-WORD MOVE
54500 DBP <PTR>
54600 DBP <UTIL> ; BACK UP POINTERS
54700 SOJG N,EXEBE5
54800 EXEBE6: CALLR ABORTE
54900 ENDR
55000 EXEBET: EXEER0
55100 EXEER1
55200 EXEER2
55300 EXEER3
55400 EXEER4
55500 EXEER0: MOVE R1,(PTR) ; SIMPLE WORD MOVES
55600 MOVEM R1,(UTIL)
55700 SUBI PTR,1
55800 SUBI UTIL,1
55900 SOJG N,EXEER0
56000 JRST EXEBE3
56100 EXEER1: MOVE R2,(PTR) ; 4 CHARACTER OFFSET MOVES
56200 SUBI PTR,1
56300 MOVE R1,(PTR)
56400 LSH R1,-1
56500 ROTC R1,^D29
56600 IFG F.SYS,< TRZ R1,1>
56700 MOVEM R1,(UTIL)
56800 SUBI UTIL,1
56900 SOJG N,EXEER1
57000 JRST EXEBE3
57100 EXEER2: MOVE R2,(PTR) ; 3 CHARACTER OFFSET MOVES
57200 SUBI PTR,1
57300 MOVE R1,(PTR)
57400 LSH R1,-1
57500 ROTC R1,^D22
57600 IFG F.SYS,< TRZ R1,1>
57700 MOVEM R1,(UTIL)
57800 SUBI UTIL,1
57900 SOJG N,EXEER2
58000 JRST EXEBE3
58100 EXEER3: MOVE R2,(PTR) ; 2 CHARACTER OFFSET MOVES
58200 SUBI PTR,1
58300 MOVE R1,(PTR)
58400 LSH R1,-1
58500 ROTC R1,^D15
58600 IFG F.SYS,< TRZ R1,1>
58700 MOVEM R1,(UTIL)
58800 SUBI UTIL,1
58900 SOJG N,EXEER3
59000 JRST EXEBE3
59100 EXEER4: MOVE R2,(PTR) ; 1 CHARACTER OFFSET MOVES
59200 SUBI PTR,1
59300 MOVE R1,(PTR)
59400 LSH R1,-1
59500 ROTC R1,^D8
59600 IFG F.SYS,< TRZ R1,1>
59700 MOVEM R1,(UTIL)
59800 SUBI UTIL,1
59900 SOJG N,EXEER4
60000 JRST EXEBE3
60100
60200 ; EDIT BUFFER CONTRACTION
60300 ; IN: N -- SIZE OF CONTRACTION IN CHARACTERS
60400 ; OUT: EZ UPDATED
60500 ;
60600 ; 1) MOVE CHARS BYTE BY BYTE TO NEW-LOWEST-WORD BOUNDARY
60700 ; 2) MOVE CHARS WORD BY WORD
60800 ; 3) MOVE CHARS BYTE BY BYTE TO FILL NEW-HIGHEST-WORD
60900 ;
61000 EXEBC: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
61100 CALLR ABORTI
61200 MOVE FLAG,N
61300 MOVE PTR,@E.P
61400 CALLR EXBPE
61500 MOVE UTIL,PTR ; UTIL GETS . POINTER
61600 TLNN UTIL,400000
61700 JRST EXEBC0
61800 HRRI UTIL,-1(UTIL) ; UTIL MUST POINT TO PREVIOUS BYTE
61900 HRLI UTIL,010700
62000 EXEBC0: MOVE PTR,@E.P
62100 ADD PTR,FLAG
62200 CALLR EXBPE ; PTR GETS . + CONTRACTION POINTER
62300 MOVE N,@E.Z
62400 SUB N,FLAG
62500 MOVEM N,@E.Z ; EZ GETS NEW Z
62600 SUB N,@E.P ; N GETS NUMBER OF CHARS TO MOVE
62700 JUMPE N,EXEBC6
62800 MOVE V1,@E.P
62900 IDIVI V1,5
63000 JUMPE V2,EXEBC2
63100 SUBI V2,5
63200 MOVN V2,V2 ; V2: NUMBER OF CHARS TO FILL NEW LOWEST WORD
63300 EXEBC1: ILDB CH,PTR
63400 IDPB CH,UTIL ; NEW-LOWEST-WORD MOVE
63500 SOJE N,EXEBC6
63600 SOJG V2,EXEBC1
63700 EXEBC2: CAIG N,5
63800 JRST EXEBC4 ; SKIP MASS MOVEMENT IF NO MASS
63900 IDIVI N,5 ; N: WORD MOVES, M: RESIDUAL BYTE MOVES
64000 MOVE V1,FLAG
64100 IDIVI V1,5 ; V2: SIZE OF OFFSET (SIZE OF ROTATE)
64200 JRST @EXEBCT(V2)
64300 EXEBC3: MOVEI N,(M)
64400 EXEBC4: JUMPE N,EXEBC6
64500 EXEBC5: ILDB CH,PTR
64600 IDPB CH,UTIL ; NEW-HIGEST-WORD MOVE
64700 SOJG N,EXEBC5
64800 EXEBC6: CALLR ABORTE
64900 ENDR
65000 EXEBCT: EXECR0
65100 EXECR1
65200 EXECR2
65300 EXECR3
65400 EXECR4
65500 EXECR0: ADDI PTR,1 ; SIMPLE WORD MOVES
65600 MOVE R1,(PTR)
65700 ADDI UTIL,1
65800 MOVEM R1,(UTIL)
65900 SOJG N,EXECR0
66000 JRST EXEBC3
66100 EXECR1: MOVE R1,(PTR) ; 1 CHARACTER OFFSET MOVES
66200 ADDI PTR,1
66300 MOVE R2,(PTR)
66400 LSH R1,-1
66500 ROTC R1,^D8
66600 IFG F.SYS,< TRZ R1,1>
66700 ADDI UTIL,1
66800 MOVEM R1,(UTIL)
66900 SOJG N,EXECR1
67000 JRST EXEBC3
67100 EXECR2: MOVE R1,(PTR) ; 2 CHARACTER OFFSET MOVES
67200 ADDI PTR,1
67300 MOVE R2,(PTR)
67400 LSH R1,-1
67500 ROTC R1,^D15
67600 IFG F.SYS,< TRZ R1,1>
67700 ADDI UTIL,1
67800 MOVEM R1,(UTIL)
67900 SOJG N,EXECR2
68000 JRST EXEBC3
68100 EXECR3: MOVE R1,(PTR) ; 3 CHARACTER OFFSET MOVES
68200 ADDI PTR,1
68300 MOVE R2,(PTR)
68400 LSH R1,-1
68500 ROTC R1,^D22
68600 IFG F.SYS,< TRZ R1,1>
68700 ADDI UTIL,1
68800 MOVEM R1,(UTIL)
68900 SOJG N,EXECR3
69000 JRST EXEBC3
69100 EXECR4: MOVE R1,(PTR) ; 4 CHARACTER OFFSET MOVES
69200 ADDI PTR,1
69300 MOVE R2,(PTR)
69400 LSH R1,-1
69500 ROTC R1,^D29
69600 IFG F.SYS,< TRZ R1,1>
69700 ADDI UTIL,1
69800 MOVEM R1,(UTIL)
69900 SOJG N,EXECR4
70000 JRST EXEBC3
70100
70200 ; ENVIRONMENT SAVING
70300 ; IN: N -- VALUE TO STACK
70400 ;
70500 EXESAV: BEGINR <UTIL>
70600 HLRO UTIL,ENVIR
70700 CAML UTIL,[-5]
70800 JRST EXER17
70900 SKIPE UTIL,EX%Q
71000 HRL UTIL,@EX%Q
71100 HRR UTIL,EX%Q
71200 PUSH ENVIR,UTIL ; SAVE MACRO TEXT POINTER,,MACRO QREG POINTER
71300 PUSH ENVIR,FLAG ; SAVE FLAGS
71400 PUSH ENVIR,EX%N ; SAVE COMMAND COUNT
71500 PUSH ENVIR,EX%PTR ; SAVE COMMAND POINTER
71600 PUSH ENVIR,N ; SAVE VALUE
71700 ENDR
71800
71900 ; ENVIRONMENT STACK SCAN
72000 ; IN: PTR -- QREG POINTER
72100 ;
72200 EXESTS: BEGINR <M,N>
72300 CAMN PTR,EX%Q
72400 JRST EXER11 ; DESTINATION QREG IS BEING EXECUTED
72500 HRRZI M,<ENVIRB+1>
72600 EXESS0: CAIL M,(ENVIR) ; SCAN ENVIRONMENT STACK
72700 RETURN
72800 HRRZ N,(M) ; GETTING EACH QREG POINTER
72900 CAIN PTR,(N)
73000 JRST EXER11 ; DESTINATION QREG IS BEING EXECUTED
73100 ADDI M,5
73200 JRST EXESS0
73300 ENDR
73400
73500 ; QREG SOURCE POINTER BEFORE ALLOCATE -- CONVERT TO PBLOCK
73600 ; IN: M -- TEXT POINTER
73700 ; OUT: PTR -- CURRENT Q.B,,PBLOCK POINTER
73800 ;
73900 EXQSB: BEGINR <UTIL>
74000 HRRZI UTIL,(M)
74100 HRRZI PTR,Q.0
74200 CAMGE UTIL,Q.B(PTR)
74300 RETURN ; IF SOURCE IS BELOW Q.0 THEN DONE
74400 EXQSB1: CAMGE UTIL,<Q.B+PBLOCK>(PTR)
74500 JRST EXQSB2
74600 ADDI PTR,PBLOCK
74700 CAIE PTR,Q.$
74800 JRST EXQSB1
74900 EXQSB2: HRL PTR,Q.B(PTR) ; REMEMBER CURRENT BUFFER POINTER
75000 ENDR
75100
75200 ; QREG SOURCE POINTER AFTER ALLOCATE -- UPDATE TEXT POINTER
75300 ; IN: PTR -- OLD Q.B,,PBLOCK POINTER
75400 ; M -- TEXT POINTER
75500 ; OUT: M -- UPDATED TEXT POINTER
75600 ;
75700 EXQSA: BEGINR <V1,V2>
75800 HLRZ V1,PTR
75900 JUMPE V1,RETN(0) ; IF SOURCE IS BELOW Q.0 THEN DONE
76000 HRRZ V2,Q.B(PTR)
76100 SUBI V2,(V1) ; CURRENT Q.B - OLD Q.B
76200 ADDI M,(V2)
76300 ENDR
76400
76500 ; CHARACTER COUNT TO BYTE POINTER FOR EDIT BUFFER
76600 ; IN: PTR -- CHARACTER COUNT
76700 ; OUT: PTR -- BYTE POINTER
76800 ;
76900 EXBPE: BEGINR <N,M>
77000 JUMPG PTR,EXBPE0
77100 HRR PTR,@E.B
77200 HRLI PTR,440700
77300 RETURN
77400 EXBPE0: MOVE N,PTR
77500 SUBI N,1
77600 IDIVI N,5
77700 HRL PTR,EXBPT(M)
77800 HRR PTR,@E.B
77900 ADDI PTR,(N)
78000 ENDR
78100
78200 ; CHARACTER COUNT TO BYTE POINTER FOR QREG
78300 ; IN: N -- CHARACTER COUNT
78400 ; PTR -- QREG POINTER
78500 ; OUT: PTR -- BYTE POINTER
78600 ;
78700 EXBPQ: BEGINR <N,M>
78800 JUMPG N,EXBPQ0
78900 HRR PTR,Q.B(PTR)
79000 HRLI PTR,440700
79100 RETURN
79200 EXBPQ0: SUBI N,1
79300 IDIVI N,5
79400 HRL PTR,EXBPT(M)
79500 HRR PTR,Q.B(PTR)
79600 ADDI PTR,(N)
79700 ENDR
79800
79900 EXBPT: 350700
80000 260700
80100 170700
80200 100700
80300 010700
80400
80500 EXER00: TSOUT <[ASCIZ/ ? Unknown command /]>
80600 JRST EXERE1
80700
80800 EXER01: TSOUT <[ASCIZ/ ? Bad argument to /]>
80900 JRST EXERE1
81000
81100 EXER02: TSOUT <[ASCIZ/ ? Bad argument with /]>
81200 JRST EXERE1
81300
81400 EXER03: TSOUT <[ASCIZ/ ? Unknown command E/]>
81500 JRST EXERE1
81600
81700 EXER04: TSOUT <[ASCIZ/ ? Bad argument to E/]>
81800 JRST EXERE1
81900
82000 EXER05: TSOUT <[ASCIZ/ ? Unknown command F/]>
82100 JRST EXERE1
82200
82300 EXER06: TSOUT <[ASCIZ/ ? Bad argument to F/]>
82400 JRST EXERE1
82500
82600 EXER07: TSOUT <[ASCIZ/ ? Bad argument to FT/]>
82700 JRST EXERE1
82800
82900 EXER08: TSOUT <[ASCIZ/ ? Nonexistent Q register /]>
83000 JRST EXERE1
83100
83200 EXER09: TSOUT <[ASCIZ/ ? Empty Q register /]>
83300 JRST EXERE1
83400
83500 EXER10: TSOUT <[ASCIZ/ ? Now editing Q register /]>
83600 JRST EXERE1
83700
83800 EXER11: TSOUT <[ASCIZ/ ? Now executing Q register /]>
83900 JRST EXERE1
84000
84100 EXER12: TSOUT <[ASCIZ/ ? Unterminated string/]>
84200 JRST EXERE2
84300
84400 EXER13: TSOUT <[ASCIZ/ ? String too long/]>
84500 JRST EXERE2
84600
84700 EXER14: TSOUT <[ASCIZ/ ? Improper digit in integer string/]>
84800 JRST EXERE2
84900
85000 EXER15: TSOUT <[ASCIZ/ ? Unbalanced angle brackets/]>
85100 JRST EXERE2
85200
85300 EXER16: TSOUT <[ASCIZ/ ? Cannot find '/]>
85400 MOVE N,S.B
85500 EXERS1: MOVE CH,(N)
85600 JUMPL CH,EXERS2
85700 CALLR TERMV
85800 AOJA N,EXERS1
85900 EXERS2: MOVEI UTIL,"'"
86000 TBOUT <UTIL>
86100 JRST EXERE2
86200
86300 EXER17: TSOUT <[ASCIZ/ ? Stack overflow/]>
86400 JRST EXERE2
86500
86600 EXERE1: CALLR TERMV
86700 EXERE2: TSOUT <[ASCIZ/ ?/],CRLF>
86800 EXERER: MOVE STACK,[IOWD SSIZE,STACKB]
86900 JRST EXEND$
87000
87100
87200 ; ***CHARACTER DISPATCH TABLE***
87300
87400 ; IN,,EX
87500 ;
87600 DISPCH: INSERT,,EXER00 ; ^@
87700 IN$A%,,EXER00 ; ^A
87800 INSERT,,EXER00 ; ^B
87900 INSERT,,EXER00 ; ^C
88000 INSERT,,EXER00 ; ^D
88100 IN$E,,EXER00 ; ^E
88200 IN$F,,EXER00 ; ^F
88300 IN$G,,EXER00 ; ^G
88400 IN$H%,,EXER00 ; ^H
88500 INSERT,,EX$$I ; <TAB>
88600 IN$J,,EXNEXT ; <LINE-FEED>
88700 INSERT,,EXER00 ; ^K
88800 IN$L,,EXER00 ; ^L
88900 INSERT,,EXNEXT ; <CARRIAGE-RETURN>
89000 IN$N,,EXER00 ; ^N
89100 INSERT,,EXER00 ; ^O
89200 INSERT,,EXER00 ; ^P
89300 INSERT,,EXER00 ; ^Q
89400 IN$R,,EXER00 ; ^R
89500 INSERT,,EXER00 ; ^S
89600 INSERT,,EXER00 ; ^T
89700 IN$U,,EXER00 ; ^U
89800 IN$V,,EXER00 ; ^V
89900 IN$W,,EXER00 ; ^W
90000 INSERT,,EXER00 ; ^X
90100 INSERT,,EXER00 ; ^Y
90200 INSERT,,EXER00 ; ^Z
90300 IN$$,,EXNEXT ; <ESCAPE>
90400 INSERT,,EXER00 ; ^\
90500 INSERT,,EXER00 ; ^]
90600 IN$H%,,EXER00 ; ^^
90700 IN$%,,EXNEXT ; <END-OF-LINE>
90800 INSERT,,EXNEXT ; <SPACE>
90900 INSERT,,EX$$EX ; !
91000 INSERT,,EXER00 ; "
91100 INSERT,,EX$$N ; #
91200 INSERT,,EXER00 ; $
91300 INSERT,,EX$% ; %
91400 INSERT,,EXER00 ; &
91500 INSERT,,EXER00 ; '
91600 INSERT,,EXER00 ; (
91700 INSERT,,EXER00 ; )
91800 INSERT,,EXER00 ; *
91900 INSERT,,EX$$P ; +
92000 INSERT,,EX$$CA ; ,
92100 INSERT,,EX$$M ; -
92200 INSERT,,EX$. ; .
92300 INSERT,,EX$$S ; /
92400 INSERT,,EX$0 ; 0
92500 INSERT,,EX$0 ; 1
92600 INSERT,,EX$0 ; 2
92700 INSERT,,EX$0 ; 3
92800 INSERT,,EX$0 ; 4
92900 INSERT,,EX$0 ; 5
93000 INSERT,,EX$0 ; 6
93100 INSERT,,EX$0 ; 7
93200 INSERT,,EX$0 ; 8
93300 INSERT,,EX$0 ; 9
93400 INSERT,,EX$$CN ; :
93500 INSERT,,EX$$$S ; ;
93600 INSERT,,EX$$L ; <
93700 INSERT,,EX$$EQ ; =
93800 INSERT,,EX$$R ; >
93900 INSERT,,EX$$Q ; ?
94000 INSERT,,EX$$A ; @
94100 INSERT,,EX$A ; A
94200 INSERT,,EX$B ; B
94300 INSERT,,EX$C ; C
94400 INSERT,,EX$D ; D
94500 INSERT,,EX$E$ ; E
94600 INSERT,,EX$F$ ; F
94700 INSERT,,EX$G ; G
94800 INSERT,,EX$H ; H
94900 INSERT,,EX$I ; I
95000 INSERT,,EX$J ; J
95100 INSERT,,EX$K ; K
95200 INSERT,,EX$L ; L
95300 INSERT,,EX$M ; M
95400 INSERT,,EX$N ; N
95500 INSERT,,EX$O ; O
95600 INSERT,,EX$P ; P
95700 INSERT,,EX$Q ; Q
95800 INSERT,,EX$R ; R
95900 INSERT,,EX$S ; S
96000 INSERT,,EX$T ; T
96100 INSERT,,EX$U ; U
96200 INSERT,,EX$V ; V
96300 INSERT,,EX$W ; W
96400 INSERT,,EX$P ; X
96500 INSERT,,EXER00 ; Y
96600 INSERT,,EX$Z ; Z
96700 INSERT,,EX$$L ; [
96800 INSERT,,EXER00 ; \
96900 INSERT,,EX$$R ; ]
97000 INSERT,,EXER00 ; ^
97100 INSERT,,EXER00 ; _
97200 INSERT,,EXER00 ; `
97300 INSERT,,EX$A ; a
97400 INSERT,,EX$B ; b
97500 INSERT,,EX$C ; c
97600 INSERT,,EX$D ; d
97700 INSERT,,EX$E$ ; e
97800 INSERT,,EX$F$ ; f
97900 INSERT,,EX$G ; g
98000 INSERT,,EX$H ; h
98100 INSERT,,EX$I ; i
98200 INSERT,,EX$J ; j
98300 INSERT,,EX$K ; k
98400 INSERT,,EX$L ; l
98500 INSERT,,EX$M ; m
98600 INSERT,,EX$N ; n
98700 INSERT,,EX$O ; o
98800 INSERT,,EX$P ; p
98900 INSERT,,EX$Q ; q
99000 INSERT,,EX$R ; r
99100 INSERT,,EX$S ; s
99200 INSERT,,EX$T ; t
99300 INSERT,,EX$U ; u
99400 INSERT,,EX$V ; v
99500 INSERT,,EX$W ; w
99600 INSERT,,EX$P ; x
99700 INSERT,,EXER00 ; y
99800 INSERT,,EX$Z ; z
99900 INSERT,,EXER00 ; {
00100 INSERT,,EXER00 ; |
00200 INSERT,,EXER00 ; }
00300 INSERT,,EXER00 ; ~
00400 IN$A%,,EXER00 ; <RUBOUT>
00500
00600
00700 ; ***COMMON SUBROUTINES***
00800
00900 ; ALLOCATE BUFFER SPACE
01000 ; IN: PTR -- # OF CHARS ,, POINTER TO POINTER BLOCK
01100 ;
01200 ALLOC: BEGINR <PTR,N,M,UTIL,FLAG>
01300 HLRZ N,PTR
01400 ADDI N,<BSIZE*5-1>
01500 IDIVI N,BSIZE*5 ; ROUND UP TO NEAREST BSIZE
01600 IMULI N,BSIZE
01700 MOVEI FLAG,(N) ; ROUNDED NUMBER OF WORDS
01800 IMULI N,5
01900 HRLI PTR,(N) ; ROUNDED NUMBER OF CHARS
02000 MOVEI UTIL,(FLAG)
02100 ADD UTIL,ZU
02200 CAMG UTIL,ZW
02300 JRST ALLOC1 ; SPACE IS ALLOCATED BUT UNUSED
02400 CALLR GETCOR
02500 JRST .+2
02600 JRST ALLOC1 ; ZW HAS BEEN UPDATED
02700 TSOUT <[ASCIZ/ ? Core exhausted ?/],CRLF>
02800 RETURN
02900 ALLOC1: CALLR ABORTI
03000 ADDM FLAG,ZU ; INCREMENT USED POINTER
03100 HRRZI UTIL,(PTR)
03200 CAIN UTIL,<Q.$>
03300 JRST ALLOC5 ; SKIP MOVE IF LAST BLOCK
03400 HRRZ N,ZU
03500 SUBI N,1 ; SET N TO NEW LAST AVAILABLE WORD
03600 HRRZI M,(N)
03700 SUBI M,(FLAG) ; SET M TO OLD LAST AVAILABLE WORD
03800 HRRZ UTIL,<PBLOCK+Q.B>(PTR)
03900 ALLOC2: CAIGE M,(UTIL)
04000 JRST ALLOC3
04100 MOVE X1,(M)
04200 MOVEM X1,(N) ; MOVE UP WORDS UNTIL THE SOURCE POINTER (M)
04300 SUBI M,1 ; EQUALS THE BLOCK POINTER OF THE QREG ABOVE
04400 SOJA N,ALLOC2 ; THE ONE FOR WHICH SPACE IS BEING ALLOCATED
04500 ALLOC3: HRRZI M,(PTR)
04600 SKIPE EX%Q
04700 MOVE N,@EX%Q
04800 ALLOC4: ADDI M,PBLOCK
04900 ADDM FLAG,Q.B(M) ; INCREMENT BLOCK POINTERS
05000 CAIE M,<Q.$>
05100 JRST ALLOC4
05200 SKIPN EX%Q ; IF EXECUTING QREG THEN ADJUST COMMAND POINTER
05300 JRST ALLOC5
05400 EXQPTR <N>
05500 ALLOC5: HLRZ UTIL,PTR
05600 ADDM UTIL,Q.A(PTR) ; INCREMENT ALLOCATE COUNT
05700 CALLR ABORTE
05800 ENDR SKIP,1
05900
06000 ; ABORT INHIBIT
06100 ;
06200 ABORTI: BEGINR
06300 AOS FLAGCD
06400 ENDR
06500
06600 ; ABORT ENABLE
06700 ABORTE: BEGINR
06800 SOSE FLAGCD
06900 RETURN
07000 SKIPN FLAGCC
07100 RETURN
07200 SETZM FLAGCC
07300 TSOUT <[ASCIZ/^C/]>
07400 IFG F.SYS,<
07500 HRRZI 0,RESUME
07600 >; TENEX
07700 CALLR SUSPEN
07800 ENDR
07900
08000 ; QREG NAME OUTPUT
08100 ; IN: PTR -- QREG POINTER
08200 ;
08300 QNOUT: BEGINR <N,M>
08400 MOVEI N,(PTR)
08500 SUBI N,Q.0
08600 IDIVI N,5
08700 CAIN N,^D36
08800 MOVEI N,"*"
08900 CAIG N,9
09000 ADDI N,"0"
09100 CAIG N,^D35
09200 ADDI N,"A"-^D10
09300 TBOUT <N>
09400 ENDR
09500
09600 TERME: BEGINR
09700 SKIPN FLAGEF
09800 JRST TERME1 ; IF 0 THEN ECHO ALL
09900 SKIPL FLAGEF ; IF - THEN ECHO SOME
10000 RETURN ; IF + THEN ECHO NONE
10100 CAIN CH,177
10200 JRST TERME2
10300 CAIL CH," "
10400 RETURN
10500 TERME1: CAIE CH,7
10600 JRST TERME2
10700 TBOUT <CH>
10800 RETURN
10900 TERME2: CALLR TERMO
11000 ENDR
11100
11200 TERMO: BEGINR <CH,UTIL>
11300 CAIN CH,33
11400 MOVEI CH,"$"
11500 CAIN CH,177
11600 SETO CH,
11700 CAIL CH," "
11800 JRST TERMO0
11900 CAIN CH,11
12000 JRST TERMO0
12100 CAIN CH,12
12200 JRST TERMO0
12300 CAIN CH,15
12400 JRST TERMO0
12500 CAIN CH,37
12600 JRST TERMO0
12700 MOVEI UTIL,"^"
12800 TBOUT <UTIL>
12900 ADDI CH,"@"
13000 CAIGE CH,"@"
13100 MOVEI CH,"?"
13200 TERMO0: TBOUT <CH>
13300 ENDR
13400
13500 TERMV: BEGINR <UTIL>
13600 SETZ UTIL,
13700 CAIN CH,11
13800 MOVEI UTIL,[ASCIZ/<tab>/]
13900 CAIN CH,12
14000 MOVEI UTIL,[ASCIZ/<lf>/]
14100 CAIN CH,15
14200 MOVEI UTIL,[ASCIZ/<cr>/]
14300 CAIN CH,33
14400 MOVEI UTIL,[ASCIZ/<esc>/]
14500 CAIN CH,37
14600 MOVEI UTIL,[ASCIZ/<eol>/]
14700 CAIN CH,177
14800 MOVEI UTIL,[ASCIZ/<rub>/]
14900 JUMPN UTIL,TERMV0
15000 CALLR TERMO
15100 RETURN
15200 TERMV0: TSOUT <(UTIL)>
15300 ENDR
15400
15500 ; STRING TO INTEGER
15600 ; IN: PTR -- BYTE POINTER TO FIRST CHARACTER
15700 ; CH -- FIRST CHARACTER
15800 ; N -- BASE
15900 ; OUT: PTR -- UPDATED (POINTING TO FIRST NON-DIGIT)
16000 ; CH -- FIRST NON-DIGIT
16100 ; N -- INTEGER
16200 ;
16300 M$S.I: BEGINR <UTIL>
16400 MOVEI UTIL,(N)
16500 SETZ N,
16600 M$S.I0: CAIL CH,"0"
16700 CAILE CH,"9"
16800 RETURN SKIP,1
16900 MOVEI CH,-"0"(CH)
17000 CAIL CH,(UTIL)
17100 RETURN
17200 IMULI N,(UTIL)
17300 ADDI N,(CH)
17400 ILDB CH,PTR
17500 JRST M$S.I0
17600 ENDR SKIP,1
17700
17800 ; INTEGER TO STRING
17900 ; IN: N -- INTEGER
18000 ; M -- BASE
18100 ; (RESULT IN M$I.SR AS ASCIZ)
18200 ;
18300 M$I.S: BEGINR <PTR,V1,V2,UTIL,FLAG>
18400 JUMPN N,M$I.S1
18500 MOVE UTIL,[ASCIZ/0/]
18600 MOVEM UTIL,M$I.SR
18700 RETURN
18800 M$I.S1: MOVE PTR,[440700,,M$I.ST]
18900 MOVE UTIL,[440700,,M$I.SR]
19000 MOVE V1,N
19100 SETZ FLAG,
19200 JUMPG V1,M$I.S2
19300 MOVN V1,V1
19400 MOVEI V2,"-"
19500 IDPB V2,UTIL
19600 M$I.S2: IDIVI V1,(M)
19700 ADDI V2,"0"
19800 IDPB V2,PTR
19900 SKIPE V1
20000 AOJA FLAG,M$I.S2
20100 M$I.S3: LDB V2,PTR
20200 IDPB V2,UTIL
20300 DBP <PTR>
20400 SOJGE FLAG,M$I.S3
20500 SETZ V2,
20600 IDPB V2,UTIL
20700 ENDR
20800
20900 ; WORD DETERMINER
21000 ; SPACE OR LESS -- SEPARATOR (RETURN)
21100 ; ! TO / AND : TO @ AND [ TO ` AND { TO ~ -- PUNCTUATION (SKIP,1)
21200 ; 0 TO 9 AND A TO Z AND a TO z -- WORD (SKIP,2)
21300 ;
21400 WORDET: BEGINR
21500 CAIG CH," "
21600 RETURN
21700 CAIGE CH,"0"
21800 RETURN SKIP,1
21900 CAIG CH,"9"
22000 RETURN SKIP,2
22100 CAIGE CH,"A"
22200 RETURN SKIP,1
22300 CAIG CH,"Z"
22400 RETURN SKIP,2
22500 CAIGE CH,"A"+40
22600 RETURN SKIP,1
22700 CAILE CH,"Z"+40
22800 RETURN SKIP,1
22900 ENDR SKIP,2
23000
23100
23200 ; ***SYSTEM DEPENDENT ROUTINES***
23300
23400 ; (((TOPS-10)))
23500 IFL F.SYS,<
23600 FIRSTI: BEGINR
23700 SKIPN FLAGIF
23800 SETOM FLAGEF
23900 CALLR ECHOS
24000 MOVEI X1,PSIPSI
24100 HRRM X1,.JBINT
24200 SETZM PSI$PC
24300 SKIPE FLAGIF
24400 RETURN
24500 MOVE X1,.JBREL
24600 ADDI X1,1
24700 MOVEM X1,ZW
24800 SKIPE X1,C.B
24900 JRST FIRSI1
25000 MOVE X1,.JBFF
25100 ADDI X1,77
25200 LSH X1,-6
25300 LSH X1,6 ; ROUND OFF FIRST FREE TO NEAREST 100
25400 FIRSI1: MOVEM X1,ZU
25500 ENDR
25600
25700 FIRSTN: BEGINR
25800 SKIPE FLAGIF ; CCL ENTRY USED
25900 JRST FIRSN5
26000 RESCAN ; REGULAR ENTRY USED
26100 FIRSN1: INCHRW CH
26200 CAIGE CH," "
26300 JRST FIRSN4
26400 CAIE CH,";"
26500 JRST FIRSN1
26600 MOVE PTR,[440700,,IONAME]
26700 FIRSN2: INCHRW CH
26800 CAIGE CH," "
26900 JRST FIRSN3
27000 IDPB CH,PTR
27100 JRST FIRSN2
27200 FIRSN3: SETZ CH,
27300 IDPB CH,PTR
27400 FIRSN4: CLRBFI
27500 RETURN
27600 ;
27700 ; CCL ENTRY -- READ DEFAULT FILE NAME FROM TMP FILE
27800 ;
27900 FIRSN5: SKIPE C.B
28000 RETURN
28100 MOVSI X1,SIXBIT/ EDT/
28200 MOVEM X1,CCTMP ; TMP: FILE NAME (CORE)
28300 HLRZM X1,IOFILE ; DSK: FILE NAME (###EDT.TMP)
28400 MOVE X1,[440700,,IOIB1+2] ; IOIBUF+1 SERVES AS BYTE PTR BOTH
28500 MOVEM X1,<IOIBUF+1> ; FOR TMP:EDT AND DSK:###EDT.TMP
28600 SUBI X1,1 ; MAKE IOWD PTR TO FIRST FREE WORD
28700 HRLI X1,-BSIZE
28800 MOVEM X1,<CCTMP+1>
28900 SETZM FLAGIF ; ASSUME TMPCOR WILL SUCCEED
29000 MOVE X1,[2,,CCTMP]
29100 TMPCOR X1, ; READ AND DELETE TMP:EDT
29200 SOSA FLAGIF ; FILE NOT FOUND -- TRY DSK:
29300 JRST FIRSN7
29400 MOVEI X4,3
29500 PJOB X1,
29600 FIRSN6: IDIVI X1,12 ; CONVERT JOB # TO SIXBIT
29700 ADDI X2,"0"-40
29800 LSHC X2,-6 ; AND PUT IN LEFT HALF OF X3
29900 SOJG X4,FIRSN6
30000 HLLM X3,IOFILE ; DSK:###EDT
30100 MOVEI X1,SIXBIT/ TMP/ ; .TMP
30200 HRLZM X1,<IOFILE+1>
30300 OPEN IOCHAN,IOCHAS
30400 JRST CCERR
30500 SETZM <IOFILE+3>
30600 LOOKUP IOCHAN,IOFILE
30700 JRST CCERR
30800 IN IOCHAN,
30900 JRST .+2
31000 JRST CCERR
31100 FIRSN7: MOVE PTR,[440700,,IONAME] ; GET FILE NAME
31200 ILDB CH,IOIBUF+1 ; (IGNORE "S")
31300 FIRSN8: ILDB CH,IOIBUF+1
31400 CAIL CH," " ; IF CONTROL CHAR
31500 CAIN CH,175 ; OR ALTMODE (MEANING "CREATE")
31600 JRST FIRSN9 ; THEN END OF NAME
31700 IDPB CH,PTR
31800 JRST FIRSN8
31900 FIRSN9: SETZ X1,
32000 IDPB X1,PTR
32100 CAIN CH,175 ; IF CREATE THEN DO NOT PERFORM INITIAL READ
32200 SETZM FLAGIR
32300 SKIPN FLAGIF ; IF TMPCOR SUCCESSFUL THEN DONE
32400 RETURN
32500 SETZM IOFILE ; DELETE DSK:###EDT.TMP
32600 RENAME IOCHAN,IOFILE
32700 JRST CCERR
32800 RELEAS IOCHAN,
32900 ENDR
33000 CCERR: OUTSTR [ASCIZ / ? CCL error ?/]
33100 EXIT
33200
33300 ECHOS: BEGINR <UTIL>
33400 SKIPLE FLAGEF
33500 JRST ECHOS3
33600 SKIPL FLAGEF
33700 JRST ECHOS2
33800 MOVE UTIL,[0,,11] ; FIRST WORD OF CONFIGURATION TABLE
33900 GETTAB UTIL, ; IS SYSTEM NAME
34000 JRST ECHOS1
34100 ; CAME UTIL,[ASCII/Harva/]
34200 JRST ECHOS1
34300 MOVEI UTIL,2100
34400 MOVEM UTIL,TTCHAS
34500 OPEN TTCHAN,TTCHAS ; A JOINT VENTURE
34600 JRST .+2
34700 JRST ECHOS4
34800 ECHOS1: SETZM FLAGEF
34900 ECHOS2: MOVEI UTIL,200
35000 MOVEM UTIL,TTCHAS
35100 OPEN TTCHAN,TTCHAS ; THIS PROGRAM ECHOS
35200 JRST .+2
35300 JRST ECHOS4
35400 HLLOS FLAGEF
35500 ECHOS3: SETZM TTCHAS
35600 OPEN TTCHAN,TTCHAS ; MONITOR ECHOS
35700 EXIT
35800 ECHOS4: MOVE UTIL,[400000,,TTOB1]
35900 MOVEM UTIL,TTOBUF
36000 MOVE UTIL,[000700,,TTOB1+1]
36100 MOVEM UTIL,TTOBUF+1
36200 MOVEI UTIL,20
36300 MOVEM UTIL,TTOBUF+2
36400 OUT TTCHAN,
36500 RETURN
36600 EXIT
36700 ENDR
36800
36900 ; PRINT STRING
37000 ; IN: PTR -- POINTER TO FIRST CHAR
37100 ; N -- NUMBER OF CHARS
37200 ; OUT: PTR -- UPDATED
37300 EXPRIS: BEGINR <CH,N>
37400 JUMPE N,RETN(0)
37500 SKIPG EXPRIM
37600 JRST EXPRI2
37700 EXPRI1: ILDB CH,PTR
37800 CALLR TERMV
37900 SOJG N,EXPRI1
38000 JRST EXPRI6
38100 EXPRI2: ILDB CH,PTR
38200 SKIPE EXPRIM
38300 JRST EXPRI4
38400 CAIN CH,33
38500 MOVEI CH,"$"
38600 CAIN CH,177
38700 SETO CH,
38800 CAIL CH," "
38900 JRST EXPRI4
39000 CAIN CH,11
39100 JRST EXPRI4
39200 CAIN CH,12
39300 JRST EXPRI4
39400 CAIN CH,15
39500 JRST EXPRI4
39600 MOVEI UTIL,"^"
39700 SOSL <TTOBUF+2>
39800 JRST EXPRI3
39900 OUT TTCHAN, ; OUTPUT DATA
40000 SOS <TTOBUF+2>
40100 EXPRI3: IDPB UTIL,<TTOBUF+1>
40200 ADDI CH,"@"
40300 CAIGE CH,"@"
40400 MOVEI CH,"?"
40500 EXPRI4: SOSL <TTOBUF+2>
40600 JRST EXPRI5
40700 OUT TTCHAN, ; OUTPUT DATA
40800 SOS <TTOBUF+2>
40900 EXPRI5: IDPB CH,<TTOBUF+1>
41000 SOJG N,EXPRI2
41100 OUT TTCHAN, ; OUTPUT TRAILING DATA
41200 JRST .+1
41300 EXPRI6: SKPINC ; CLEAR CONTROL-O
41400 RETURN
41500 ENDR
41600
41700 IO$ER: BEGINR <CH,PTR,N,M>
41800 CALLR IOFNC
41900 RETURN
42000 CALLR IOFNP
42100 OPEN IOCHAN,IOCHAS
42200 JRST IO$ERD
42300 MOVEI PTR,IOCHAS
42400 DEVSIZ PTR,
42500 SETZ PTR,
42600 HRRZI PTR,-2(PTR)
42700 CAILE PTR,<BSIZE+1>
42800 JRST IO$ERD
42900 HRLM PTR,IOIB1
43000 HRLM PTR,IOIB2
43100 MOVEI N,IOCHAN
43200 DEVCHR N,
43300 TLNN N,000004
43400 JRST IO$ER1 ; SKIP LOOKUP IF NO DIRECTORY
43500 LOOKUP IOCHAN,IOFILE ; OPEN FILE
43600 JRST IO$ERF
43700 IO$ER1: MOVE N,[400000,,IOIB1]
43800 MOVEM N,IOIBUF
43900 MOVE N,[000700,,IOIB1+1]
44000 MOVEM N,IOIBUF+1
44100 SETZM IOIBUF+2
44200 IO$ER2: IN IOCHAN, ; READ DATA
44300 JRST IO$ER3
44400 STATO IOCHAN,020000 ; CHECK FOR EOF
44500 JRST IO$ERE
44600 JRST IO$ER6
44700 IO$ER3: MOVE N,@E.Z
44800 ADD N,<IOIBUF+2>
44900 CAMG N,@E.A
45000 JRST IO$ER4
45100 HRLI PTR,PSIZE*5 ; ALLOCATE EDIT BUFFER SPACE
45200 HRRI PTR,@E.B
45300 CALLR ALLOC
45400 JRST IO$ERR
45500 IO$ER4: MOVE PTR,@E.Z
45600 CALLR EXBPE
45700 MOVEM N,@E.Z
45800 IO$ER5: SOSGE <IOIBUF+2>
45900 JRST IO$ER2
46000 ILDB CH,<IOIBUF+1>
46100 IDPB CH,PTR ; MOVE TEXT INTO EDIT BUFFER
46200 JRST IO$ER5
46300 IO$ER6: RELEAS IOCHAN, ; CLOSE FILE
46400 MOVE PTR,@E.Z
46500 JUMPE PTR,IO$ER8
46600 MOVEI N,4
46700 CALLR EXBPE
46800 IO$ER7: LDB CH,PTR ; REMOVE TRAILING ZEROS
46900 JUMPN CH,IO$ER8
47000 SOS @E.Z
47100 DBP <PTR>
47200 SOJG N,IO$ER7
47300 IO$ER8: MOVEI CH," "
47400 OUTCHR CH
47500 MOVE N,@E.Z
47600 MOVEI M,^D10
47700 CALLR M$I.S
47800 OUTSTR M$I.SR
47900 OUTSTR CRLF
48000 RETURN SKIP,1
48100 IO$ERD: OUTSTR [ASCIZ/ ? Device error ?
48200 /]
48300 JRST IO$ERR
48400 IO$ERE: OUTSTR [ASCIZ/ ? Data error ?
48500 /]
48600 JRST IO$ERR
48700 IO$ERF: OUTSTR [ASCIZ/ ? Input file not found ?
48800 /]
48900 IO$ERR: RELEAS IOCHAN,
49000 ENDR
49100
49200 IO$EW: BEGINR <CH,PTR,N,M>
49300 CALLR IOFNC
49400 RETURN
49500 CALLR IOFNP
49600 MOVEI CH," "
49700 OUTCHR CH
49800 MOVE N,@E.Z
49900 MOVEI M,^D10
50000 CALLR M$I.S
50100 OUTSTR M$I.SR
50200 OUTSTR CRLF
50300 OPEN IOCHAN,IOCHAS
50400 JRST IO$EWD
50500 MOVEI PTR,IOCHAS
50600 DEVSIZ PTR,
50700 SETZ PTR,
50800 HRRZI PTR,-2(PTR)
50900 CAILE PTR,<BSIZE+1>
51000 JRST IO$EWD
51100 HRLM PTR,IOOB1
51200 HRLM PTR,IOOB2
51300 MOVEI M,IOCHAN
51400 DEVCHR M,
51500 TLNN M,000004
51600 JRST IO$EW5 ; SKIP ENTER IF NO DIRECTORY
51700 MOVE N,IOFILE
51800 MOVE M,<IOFILE+1>
51900 MOVE PTR,<IOFILE+3>
52000 MOVE CH,<IOCHAS+1>
52100 CAME CH,[SIXBIT/DSK/] ; IF DEVICE IS DSK:
52200 JRST IO$EW1
52300 MOVE CH,<IOFILE+3>
52400 MOVEM CH,<IOFINB+1>
52500 MOVEM N,<IOFINB+2>
52600 MOVEM M,<IOFINB+3>
52700 LOOKUP IOCHAN,IOFINB
52800 JRST IO$EW4
52900 RELEAS IOCHAN,
53000 MOVE CH,IOFIND ; THEN GET ACTUAL DEVICE OF OLD FILE
53100 MOVEM CH,<IOCHAS+1>
53200 OPEN IOCHAN,IOCHAS
53300 JRST IO$EWF
53400 IO$EW1: MOVE CH,[SIXBIT/BAK/]
53500 MOVEM CH,<IOFILE+1>
53600 LOOKUP IOCHAN,IOFILE
53700 JRST IO$EW2
53800 SETZM IOFILE
53900 MOVEM PTR,<IOFILE+3>
54000 RENAME IOCHAN,IOFILE ; DELETE .BAK
54100 JRST IO$EWB
54200 MOVEM N,IOFILE
54300 IO$EW2: MOVEM M,<IOFILE+1>
54400 SETZ N,
54500 LOOKUP IOCHAN,IOFILE
54600 JRST IO$EW3
54700 HLLZ N,<IOFILE+2>
54800 TLZ N,000777 ; PRESERVE PROTECTION
54900 MOVE CH,[SIXBIT/BAK/]
55000 HLLM CH,<IOFILE+1>
55100 MOVEM PTR,<IOFILE+3>
55200 RENAME IOCHAN,IOFILE ; RENAME FILE TO .BAK
55300 JRST IO$EWB
55400 IO$EW3: MOVEM M,<IOFILE+1>
55500 MOVEM N,<IOFILE+2>
55600 IO$EW4: ENTER IOCHAN,IOFILE ; OPEN FILE
55700 JRST IO$EWF
55800 IO$EW5: MOVE N,[400000,,IOOB1]
55900 MOVEM N,IOOBUF
56000 MOVE N,[000700,,IOOB1+1]
56100 MOVEM N,IOOBUF+1
56200 MOVEI N,BSIZE
56300 MOVEM N,IOOBUF+2
56400 OUT IOCHAN, ; INITIALIZE BUFFER POINTERS
56500 JRST .+2
56600 JRST IO$EWE
56700 MOVE N,@E.Z
56800 SETZ PTR,
56900 CALLR EXBPE
57000 IO$EW6: SOJL N,IO$EW8
57100 SOSL <IOOBUF+2>
57200 JRST IO$EW7
57300 OUT IOCHAN, ; OUTPUT DATA
57400 SOSA <IOOBUF+2>
57500 JRST IO$EWE
57600 IO$EW7: ILDB CH,PTR
57700 IDPB CH,<IOOBUF+1> ; MOVE TEXT INTO OUTPUT BUFFER
57800 JRST IO$EW6
57900 IO$EW8: OUT IOCHAN, ; OUTPUT TRAILING DATA
58000 JRST .+2
58100 JRST IO$EWE
58200 RELEAS IOCHAN, ; CLOSE FILE AND RELEASE CHANNEL
58300 RETURN SKIP,1
58400 IO$EWB: OUTSTR [ASCIZ/ ? Cannot rename .BAK file ?
58500 /]
58600 JRST IO$EWR
58700 IO$EWD: OUTSTR [ASCIZ/ ? Device error ?
58800 /]
58900 JRST IO$EWR
59000 IO$EWE: OUTSTR [ASCIZ/ ? Data error ?
59100 /]
59200 JRST IO$EWR
59300 IO$EWF: OUTSTR [ASCIZ/ ? Cannot write file ?
59400 /]
59500 IO$EWR: RELEAS IOCHAN,
59600 ENDR
59700
59800 ; FILE NAME CONVERSION
59900 ;
60000 IOFC$D==400000 ; DEVICE FIELD FLAG
60100 IOFC$P==200000 ; PPN FIELD FLAG
60200 ;
60300 IOFNC: BEGINR <CH,PTR,N,M,V1,V2,UTIL,FLAG>
60400 SETZ FLAG,
60500 SETZM IOFILE
60600 SETZM <IOFILE+1>
60700 SETZM <IOFILE+2>
60800 GETPPN UTIL,
60900 MOVEM UTIL,<IOFILE+3>
61000 MOVE UTIL,[SIXBIT/DSK/]
61100 MOVEM UTIL,<IOCHAS+1> ; SET DEFAULT ARGUMENTS
61200 MOVE PTR,[440700,,IONAME]
61300 IOFC01: ILDB CH,PTR
61400 JUMPE CH,IOFC04
61500 CAIE CH,":" ; LOOK FOR DEVICE FIELD
61600 JRST IOFC01
61700 TLO FLAG,IOFC$D
61800 MOVE V1,PTR
61900 SETZM <IOFILE+3>
62000 MOVE PTR,[440700,,IONAME]
62100 MOVE M,[440600,,<IOCHAS+1>]
62200 MOVEI N,6
62300 SETZM <IOCHAS+1>
62400 IOFC02: ILDB CH,PTR
62500 CAIG CH," "
62600 JRST IOFC02
62700 CAIN CH,":"
62800 JRST IOFC03
62900 CAIGE CH,"A"+40
63000 ADDI CH,40
63100 IDPB CH,M ; STORE DEVICE FIELD
63200 SOJG N,IOFC02
63300 IOFC03: MOVE UTIL,<IOCHAS+1>
63400 DEVCHR UTIL,
63500 JUMPE UTIL,IOFNCE
63600 TLNN UTIL,000004
63700 RETURN SKIP,1 ; (DONE IF NONDIRECTORY DEVICE)
63800 TLNE UTIL,000100 ; (NO PPN IF DECTAPE)
63900 JRST IOFC06
64000 IOFC04: MOVE PTR,[440700,,IONAME]
64100 IOFC05: ILDB CH,PTR
64200 JUMPE CH,IOFC06
64300 CAIE CH,"[" ; LOOK FOR PPN FIELD
64400 JRST IOFC05
64500 TLO FLAG,IOFC$P
64600 ILDB CH,PTR
64700 MOVEI N,10
64800 CALLR M$S.I
64900 JRST IOFNCE
65000 HRLM N,<IOFILE+3>
65100 ILDB CH,PTR
65200 MOVEI N,10
65300 CALLR M$S.I
65400 JRST IOFNCE
65500 HRRM N,<IOFILE+3>
65600 MOVE V2,PTR
65700 IOFC06: TLNE FLAG,IOFC$D
65800 JRST IOFC07
65900 TLNE FLAG,IOFC$P
66000 JRST IOFC10
66100 MOVE PTR,[440700,,IONAME] ; F.E
66200 JRST IOFC12
66300 IOFC07: TLNE FLAG,IOFC$P
66400 JRST IOFC08
66500 MOVE PTR,V1 ; D:F.E
66600 JRST IOFC12
66700 IOFC08: MOVE PTR,V1
66800 ILDB CH,PTR
66900 CAIN CH,"["
67000 JRST IOFC09
67100 MOVE PTR,V1 ; D:F.E[M,N]
67200 JRST IOFC12
67300 IOFC09: LDB CH,V2
67400 CAIE CH,"]"
67500 JRST IOFNCE
67600 MOVE PTR,V2 ; D:[M,M]F.E
67700 JRST IOFC12
67800 IOFC10: LDB CH,[350700,,IONAME]
67900 CAIN CH,"["
68000 JRST IOFC11
68100 MOVE PTR,[440700,,IONAME] ; F.E[M,N]
68200 JRST IOFC12
68300 IOFC11: LDB CH,V2
68400 CAIE CH,"]"
68500 JRST IOFNCE
68600 MOVE PTR,V2 ; [M,N]F.E
68700 IOFC12: MOVE M,[440600,,IOFILE]
68800 MOVEI N,6
68900 IOFC13: ILDB CH,PTR
69000 JUMPE CH,RETN(1)
69100 CAIG CH," "
69200 JRST IOFC13
69300 CAIN CH,"["
69400 RETURN SKIP,1
69500 CAIN CH,"."
69600 JRST IOFC15
69700 CAIGE CH,"A"+40
69800 ADDI CH,40
69900 IDPB CH,M ; STORE FILE NAME FIELD
70000 SOJG N,IOFC13
70100 IOFC14: ILDB CH,PTR
70200 JUMPE CH,RETN(1)
70300 CAIG CH," "
70400 JRST IOFC14
70500 CAIN CH,"."
70600 JRST IOFC15
70700 JRST IOFC14
70800 IOFC15: MOVE M,[440600,,<IOFILE+1>]
70900 MOVEI N,3
71000 IOFC16: ILDB CH,PTR
71100 JUMPE CH,RETN(1)
71200 CAIG CH," "
71300 JRST IOFC16
71400 CAIN CH,"["
71500 RETURN SKIP,1
71600 CAIGE CH,"A"+40
71700 ADDI CH,40
71800 IDPB CH,M ; STORE EXTENSION FIELD
71900 SOJG N,IOFC16
72000 RETURN SKIP,1
72100 IOFNCE: OUTSTR [ASCIZ/ ? Bad file name '/]
72200 OUTSTR IONAME
72300 OUTSTR [ASCIZ/' ?
72400 /]
72500 ENDR
72600
72700 ; FILE NAME PRINT
72800 ;
72900 IOFNP: BEGINR <CH,PTR,N,M>
73000 MOVEI CH," "
73100 OUTCHR CH
73200 MOVE PTR,[440600,,<IOCHAS+1>]
73300 MOVEI N,6
73400 IOFNP1: ILDB CH,PTR
73500 JUMPE CH,IOFNP2
73600 ADDI CH,40
73700 OUTCHR CH
73800 SOJG N,IOFNP1
73900 IOFNP2: MOVEI CH,":"
74000 OUTCHR CH
74100 SKIPN <IOFILE+3>
74200 JRST IOFNP3
74300 MOVEI CH,"["
74400 OUTCHR CH
74500 HLRZ N,IOFILE+3
74600 MOVEI M,10
74700 CALLR M$I.S
74800 OUTSTR M$I.SR
74900 MOVEI CH,","
75000 OUTCHR CH
75100 HRRZ N,IOFILE+3
75200 MOVEI M,10
75300 CALLR M$I.S
75400 OUTSTR M$I.SR
75500 MOVEI CH,"]"
75600 OUTCHR CH
75700 IOFNP3: SKIPN IOFILE
75800 RETURN
75900 MOVE PTR,[440600,,IOFILE]
76000 MOVEI N,6
76100 IOFNP4: ILDB CH,PTR
76200 JUMPE CH,IOFNP5
76300 ADDI CH,40
76400 OUTCHR CH
76500 SOJG N,IOFNP4
76600 IOFNP5: SKIPN <IOFILE+1>
76700 RETURN
76800 MOVEI CH,"."
76900 OUTCHR CH
77000 MOVE PTR,[440600,,<IOFILE+1>]
77100 MOVEI N,3
77200 IOFNP6: ILDB CH,PTR
77300 JUMPE CH,RETN(0)
77400 ADDI CH,40
77500 OUTCHR CH
77600 SOJG N,IOFNP6
77700 ENDR
77800
77900 ; ALLOCATE CORE
78000 ; IN: FLAG -- NUMBER OF WORDS TO ADD
78100 ;
78200 GETCOR: BEGINR <FLAG>
78300 ADD FLAG,.JBREL
78400 CORE FLAG,
78500 RETURN
78600 MOVE FLAG,.JBREL
78700 ADDI FLAG,1
78800 MOVEM FLAG,ZW
78900 ENDR SKIP,1
79000
79100 HALT: CALLR SUSPEN
79200 JRST INBEG
79300
79400 HALTGO: MOVE UTIL,CCCOMP
79500 RUN UTIL,
79600 EXIT
79700 QUIT: EXIT
79800
79900 SUSPEN: BEGINR
80000 RELEAS 0, ; CLEAR ECHO CHARACTERISTICS
80100 EXIT 1,
80200 DDT$G: CALLR ECHOS ; SET ECHO CHARACTERISTICS
80300 ENDR
80400
80500 PSI$CC: SKIPN FLAGCD
80600 JRST PSI$C1
80700 SETOM FLAGCC
80800 PUSH STACK,PSI$PC
80900 SETZM PSI$PC
81000 POPJ STACK,
81100 PSI$C1: PUSH STACK,UTIL
81200 HRRZ UTIL,PSI$PC
81300 CAIL UTIL,EXBEG
81400 JRST PSI$C2
81500 HLLZ UTIL,(UTIL)
81600 CAMN UTIL,[INCHRW]
81700 JRST PSI$C3
81800 PSI$C2: POP STACK,UTIL
81900 OUTSTR [ASCIZ/^C/]
82000 CALLR SUSPEN
82100 PUSH STACK,PSI$PC
82200 SETZM PSI$PC
82300 POPJ STACK,
82400 PSI$C3: POP STACK,UTIL
82500 OUTSTR [ASCIZ/^C/]
82600 CALLR SUSPEN
82700 SETZM PSI$PC
82800 JRST IN$E
82900 >
83000 ; (((^^^)))
83100
83200 ; (((TENEX)))
83300 IFG F.SYS,<
83400 FIRSTI: BEGINR
83500 SKIPE FLAGIF
83600 JRST FIRSI1
83700 MOVEI X1,100
83800 RFMOD
83900 MOVEM X2,TMOD
84000 RFCOC
84100 MOVEM X2,TCOC1
84200 MOVEM X3,TCOC2
84300 SETOM FLAGEF
84400 FIRSI1: CALLR ECHOS
84500 HRRZI X1,400000
84600 RPCAP
84700 TLO X3,400000
84800 EPCAP ; THIS FORK CAN CAPTURE ^C
84900 HRRI X2,CHNTAB
85000 HRLI X2,LEVTAB
85100 SIR ; SET UP PSI TABLE
85200 MOVE X1,[3,,0]
85300 ATI ; ASSIGN ^C TO CHANNEL 0
85400 MOVE X1,[23,,1]
85500 ATI ; ASSIGN ^S TO CHANNEL 1
85600 HRRZI X1,400000
85700 HRLZI X2,600000
85800 AIC ; ACTIVATE CHANNELS 0 AND 1
85900 EIR ; ENABLE PSI SYSTEM
86000 SKIPE FLAGIF
86100 RETURN
86200 HRLZI X1,400000
86300 FIRSI2: RPACS
86400 TLNE X2,010000 ; TEST FOR FIRST NONEXISTENT PAGE
86500 AOJA X1,FIRSI2
86600 LSH X1,^D9
86700 MOVEM X1,ZW
86800 SKIPE C.B
86900 MOVE X1,C.B
87000 MOVEM X1,ZU
87100 ENDR
87200
87300 FIRSTN: BEGINR
87400 SKIPE FLAGIF
87500 JRST FIRSNF
87600 MOVE X1,[SIXBIT/LOADTB/]
87700 SYSGT
87800 JUMPE X2,FIRSN1
87900 ;
88000 ; TENEX -- CONTINUE COMMAND LINE INPUT
88100 ;
88200 MOVEI X1,100
88300 BKJFN
88400 RETURN
88500 BIN
88600 CAIE X2," "
88700 RETURN
88800 HRLZI X1,160003
88900 MOVE X2,[100,,101]
89000 GTJFN
89100 RETURN
89200 MOVE X2,X1
89300 HRROI X1,IONAME
89400 SETZ X3,
89500 JFNS ; GET FILE NAME FROM EXEC LINE
89600 HRRZI X1,(X2)
89700 RLJFN
89800 RETURN
89900 RETURN
90000 ;
90100 ; TOPS-20 -- RESCAN
90200 ; THE COMMAND LINE CAN BE IN ONE OF FOUR FORMS:
90300 ; CREATE <FN>
90400 ; EDIT <FN>
90500 ; ANTE <FN>
90600 ; RU ANTE !<FN>
90700 ;
90800 RSCAN==104000,,500 ; THE TOPS-20 RESCAN JSYS
90900 ;
91000 FIRSN1: SETZ X1,
91100 RSCAN
91200 RETURN
91300 FIRSN2: PBIN ; PASS OVER LEADING SPACES
91400 CAIGE X1," "
91500 JRST FIRSN9
91600 CAIN X1," "
91700 JRST FIRSN2
91800 CAIE X1,"C" ; CREATE -- NO READ
91900 CAIN X1,"C"+40
92000 JRST FIRSN4
92100 CAIE X1,"E" ; EDIT
92200 CAIN X1,"E"+40
92300 JRST FIRSN5
92400 CAIE X1,"A" ; ANTE
92500 CAIN X1,"A"+40
92600 JRST FIRSN5
92700 FIRSN3: PBIN ; PASS OVER EVERYTHING UP TO !
92800 CAIGE X1," "
92900 JRST FIRSN9
93000 CAIE X1,"!"
93100 JRST FIRSN3
93200 MOVE UTIL,[440700,,IONAME]
93300 PBIN
93400 JRST FIRSN7
93500 FIRSN4: SETZM FLAGIR
93600 FIRSN5: PBIN ; PASS OVER COMMAND
93700 CAIGE X1," "
93800 JRST FIRSN9
93900 CAIE X1," "
94000 JRST FIRSN5
94100 FIRSN6: PBIN ; PASS OVER TRAILING SPACES
94200 CAIGE X1," "
94300 JRST FIRSN9
94400 CAIN X1," "
94500 JRST FIRSN6
94600 MOVE UTIL,[440700,,IONAME]
94700 FIRSN7: CAIGE X1," "
94800 JRST FIRSN8
94900 IDPB X1,UTIL
95000 PBIN
95100 JRST FIRSN7
95200 FIRSN8: CAIN X1,15
95300 PBIN
95400 SETZ X1,
95500 IDPB X1,UTIL
95600 RETURN
95700 FIRSN9: CAIN X1,15
95800 PBIN
95900 RETURN
96000 ;
96100 ; INFERIOR FORK ANTE -- GET FILE NAME FROM REGISTERS
96200 ;
96300 FIRSNF: MOVEM 0,FLAGIR
96400 MOVEI FLAG,IONAME
96500 HRLI UTIL,1
96600 HRRI UTIL,(FLAG)
96700 BLT UTIL,6(FLAG) ; GET FILE NAME FROM ACS
96800 ENDR
96900
97000 ECHOS: BEGINR
97100 SKIPG FLAGEF
97200 JRST ECHOS1
97300 MOVEI X1,100
97400 MOVE X2,TMOD
97500 SFMOD ; RESTORE INITIAL CHARACTERISTICS
97600 MOVE X2,TCOC1
97700 MOVE X3,TCOC2
97800 SFCOC
97900 RETURN
98000 ECHOS1: SKIPE FLAGEF
98100 JRST ECHOS2
98200 MOVEI X1,100
98300 MOVE X2,TMOD
98400 TRZ X2,006000 ; (1B24+1B25) TURN OFF ECHOING
98500 SFMOD
98600 MOVE X2,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
98700 MOVE X3,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2]
98800 SFCOC ; PASS ALL CONTROL CHARACTERS
98900 RETURN
99000 ECHOS2: MOVE X1,[SIXBIT/LOADTB/]
99100 SYSGT
99200 JUMPN X2,.+3
99300 SETZM FLAGEF
99400 JRST ECHOS1 ; TOPS-20 WORKS ONLY IN 0 MODE
99500 MOVEI X1,100
99600 RFMOD
99700 TRZ X2,776300 ; CLEAR WAKE UP, ECHOING, OUTPUT MODE
99800 TRO X2,144300 ; WAKE UP ON ^ CHARS, ECHO, OUTPUT ^ CHARS
99900 SFMOD
00100 SETZ X2,
00200 SETZ X3,
00300 SFCOC ; IGNORE ALL CONTROL CHARACTERS (INPUT ONLY)
00400 ENDR
00500
00600 ; PRINT STRING
00700 ; IN: PTR -- POINTER TO FIRST CHAR
00800 ; N -- NUMBER OF CHARS
00900 ; OUT: PTR -- UPDATED
01000 EXPRIS: BEGINR <CH,N>
01100 JUMPE N,RETN(0)
01200 SKIPG EXPRIM
01300 JRST EXPRI2
01400 EXPRI1: ILDB CH,PTR
01500 CALLR TERMV ; VERBOSE OUTPUT
01600 SOJG N,EXPRI1
01700 RETURN
01800 EXPRI2: SKIPE EXPRIM
01900 JRST EXPRI3
02000 MOVEI X1,101
02100 RFMOD
02200 TRZ X2,000300
02300 TRO X2,000100 ; NORMAL OUTPUT MODE
02400 SFMOD
02500 MOVE X2,[BYTE (2) 1,1,1,1,1,1,1,1,1,2,2,1,1,2,1,1,1,1]
02600 MOVE X3,[BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,1]
02700 SFCOC
02800 MOVE X2,PTR
02900 MOVN X3,N
03000 SOUT ; TERSE OUTPUT
03100 MOVE PTR,X2
03200 CALLR ECHOS
03300 RETURN
03400 EXPRI3: MOVEI X1,101
03500 MOVE X2,PTR
03600 MOVN X3,N
03700 SOUT ; DIRECT OUTPUT
03800 MOVE PTR,X2
03900 ENDR
04000
04100 IO$ER: BEGINR <CH,PTR,N,M>
04200 SETZM IOJFN
04300 HRLZI X1,100101
04400 HRROI X2,IONAME
04500 GTJFN
04600 JRST IO$ERF
04700 HRRZM X1,IOJFN
04800 MOVEI X1," "
04900 PBOUT
05000 MOVEI X1,101
05100 HRRZ X2,IOJFN
05200 MOVE X3,[111110,,000001]
05300 JFNS
05400 HRROI X1,IONAME
05500 MOVE X3,[222200,,000001]
05600 JFNS
05700 HRRZ X1,IOJFN
05800 MOVE X2,[070000,,200000]
05900 OPENF ; OPEN FILE
06000 JRST IO$ERF
06100 MOVE PTR,@E.Z
06200 CALLR EXBPE
06300 IO$ER1: MOVE N,@E.Z
06400 ADDI N,PSIZE*5
06500 CAMG N,@E.A
06600 JRST IO$ER2
06700 MOVE CH,PTR ; ALLOCATE EDIT BUFFER SPACE
06800 HRLI PTR,PSIZE*5
06900 HRRI PTR,@E.B
07000 CALLR ALLOC
07100 JRST IO$ERR
07200 MOVE PTR,CH
07300 IO$ER2: HRRZ X1,IOJFN
07400 MOVE X2,PTR
07500 MOVNI X3,PSIZE*5
07600 SETZ X4,
07700 SIN ; MOVE TEXT INTO EDIT BUFFER
07800 MOVE PTR,X2
07900 ADDI X3,PSIZE*5
08000 ADDM X3,@E.Z
08100 GTSTS
08200 TLNN X2,001000 ; CHECK FOR EOF
08300 JRST IO$ER1
08400 CLOSF ; CLOSE FILE
08500 JRST .+1
08600 MOVE PTR,@E.Z
08700 JUMPE PTR,IO$ER4
08800 MOVEI N,4
08900 CALLR EXBPE
09000 IO$ER3: LDB CH,PTR ; REMOVE TRAILING ZEROS
09100 JUMPN CH,IO$ER4
09200 SOS @E.Z
09300 DBP <PTR>
09400 SOJG N,IO$ER3
09500 IO$ER4: MOVEI X1," "
09600 PBOUT
09700 MOVE N,@E.Z
09800 MOVEI M,^D10
09900 CALLR M$I.S
10000 HRROI X1,M$I.SR
10100 PSOUT
10200 HRROI X1,CRLF
10300 PSOUT
10400 RETURN SKIP,1
10500 IO$ERR: HRRZ X1,IOJFN
10600 CLOSF
10700 RETURN
10800 RETURN
10900 IO$ERF: CALLR IO$EE
11000 ENDR
11100
11200 IO$EW: BEGINR <N,M>
11300 SETZM IOJFN
11400 HRLZI X1,600001
11500 HRROI X2,IONAME
11600 GTJFN
11700 JRST IO$EWF
11800 HRRZM X1,IOJFN
11900 MOVEI X1," "
12000 PBOUT
12100 MOVEI X1,101
12200 HRRZ X2,IOJFN
12300 MOVE X3,[111110,,000001]
12400 JFNS
12500 HRROI X1,IONAME
12600 MOVE X3,[222200,,000001]
12700 JFNS
12800 MOVEI X1," "
12900 PBOUT
13000 MOVE N,@E.Z
13100 MOVEI M,^D10
13200 CALLR M$I.S
13300 HRROI X1,M$I.SR
13400 PSOUT
13500 HRROI X1,CRLF
13600 PSOUT
13700 HRRZ X1,IOJFN
13800 MOVE X2,[070000,,100000]
13900 OPENF ; OPEN FILE
14000 JRST IO$EWF
14100 SKIPN @E.Z
14200 JRST IO$EW0
14300 HRRO X2,@E.B
14400 MOVN X3,@E.Z
14500 SETZ X4,
14600 SOUT ; OUTPUT DATA
14700 IO$EW0: CLOSF ; CLOSE FILE
14800 RETURN SKIP,1
14900 RETURN SKIP,1
15000 IO$EWF: CALLR IO$EE
15100 ENDR
15200
15300 IO$EE: BEGINR
15400 SKIPE IOJFN
15500 JRST IO$EE1
15600 MOVEI X1," "
15700 PBOUT
15800 HRROI X1,IONAME
15900 PSOUT
16000 HRROI X1,CRLF
16100 PSOUT
16200 JRST IO$EE2
16300 IO$EE1: HRRZ X1,IOJFN
16400 RLJFN
16500 JRST .+1
16600 IO$EE2: HRROI X1,[ASCIZ/ ? /]
16700 PSOUT
16800 MOVEI X1,101
16900 MOVE X2,[400000,,-1]
17000 SETZ X3,
17100 ERSTR
17200 JRST .+2
17300 JRST .+1
17400 HRROI X1,[ASCIZ/ ?
17500 /]
17600 PSOUT
17700 ENDR
17800
17900 GETCOR: BEGINR
18000 SKIPG FLAG
18100 RETURN SKIP,1
18200 MOVE X1,ZW
18300 LSH X1,-^D9
18400 MOVE X3,ZW
18500 MOVE X4,ZW
18600 SUBI X4,1 ; CONVERT FROM FIRST FREE TO LAST USED
18700 ADDI X4,(FLAG) ; AND ADD NEW REQUIREMENT
18800 LSH X4,-^D9
18900 TLO X1,400000
19000 GETCO0: RPACS
19100 TLNE X2,010000 ; TEST FOR EXISTENCE
19200 RETURN
19300 SETZM (X3) ; MAKE PAGE EXIST
19400 ADDI X3,PSIZE
19500 CAIE X4,(X1)
19600 AOJA X1,GETCO0
19700 MOVEM X3,ZW
19800 ENDR SKIP,1
19900
20000 HALTGO: SETO 0,
20100 CALLR SUSPEN
20200 JRST INBEG
20300
20400 HALT: SETZ 0,
20500 CALLR SUSPEN
20600 JRST INBEG
20700
20800 QUIT: SETZ 0,
20900 CALLR SUSPEN
21000 JRST QUIT
21100
21200 SUSPEN: BEGINR <X1,X2,X3,X4>
21300 MOVE X4,FLAGEF
21400 MOVEI X1,1
21500 MOVEM X1,FLAGEF ; CLEAR ECHO CHARACTERISTICS
21600 CALLR ECHOS
21700 MOVEM X4,FLAGEF
21800 HALTF
21900 RESUME: MOVEI X1,100
22000 RFMOD ; GET TERMINAL CHARACTERISTICS
22100 MOVEM X2,TMOD
22200 RFCOC
22300 MOVEM X2,TCOC1
22400 MOVEM X3,TCOC2
22500 DDT$G: CALLR ECHOS ; SET ECHO CHARACTERISTICS
22600 ENDR
22700
22800 PSI$CC: SKIPN FLAGCD
22900 JRST PSI$C1
23000 SETOM FLAGCC
23100 DEBRK
23200 PSI$C1: PUSH STACK,X1
23300 HRRZ X1,PSI$P2
23400 CAIL X1,EXBEG
23500 JRST PSI$C2
23600 MOVE X1,-1(X1)
23700 CAMN X1,[PBIN]
23800 JRST PSI$C3
23900 PSI$C2: HRROI X1,[ASCIZ/^C/]
24000 PSOUT
24100 HRRZI 0,RESUME
24200 CALLR SUSPEN
24300 POP STACK,X1
24400 DEBRK
24500 PSI$C3: POP STACK,X1
24600 PSI$C4: MOVEI X1,100
24700 SIBE
24800 JRST .+2
24900 JRST PSI$C5
25000 TBIN <CH>
25100 CALLR INADD
25200 JRST PSI$C4
25300 JRST PSI$C4
25400 PSI$C5: HRROI X1,[ASCIZ/^C/]
25500 PSOUT
25600 HRRZI 0,RESUME
25700 CALLR SUSPEN
25800 MOVEI X1,IN$E
25900 MOVEM X1,PSI$P2
26000 DEBRK
26100
26200 PSI$CS: PUSH STACK,X1
26300 HRRZ X1,PSI$P3
26400 MOVE X1,-1(X1)
26500 CAMN X1,[PBIN]
26600 JRST PSI$S0
26700 MOVEI X1,23
26800 DTI ; DEASSIGN ^S
26900 PBIN
27000 MOVE X1,[23,,1]
27100 ATI ; ASSIGN ^S AGAIN
27200 PSI$S0: POP STACK,X1
27300 DEBRK
27400
27500 LEVTAB: PSI$P1
27600 PSI$P2
27700 PSI$P3
27800 CHNTAB: 2,,PSI$CC
27900 3,,PSI$CS
28000 BLOCK 36
28100 >
28200 ; (((^^^)))
28300
28400
28500 ; ***DATA***
28600
28700 CRLF: BYTE (7)15,12,0,0,0
28800
28900 LIT ; LITERALS GO HERE
29000
29100 ; (((TOPS-10)))
29200 IFL F.SYS,<
29300
29400 IFE <F.SEGS-2>,< RELOC 0>
29500
29600 TTCHAS: 0 ; ASCII MODE
29700 SIXBIT /TTY/
29800 TTOBUF,,0
29900 TTOBUF: BLOCK 3
30000 0 ; FILE STATUS
30100 TTOB1: 21,,TTOB2
30200 0 ; BOOKKEEPING
30300 BLOCK 21
30400 0 ; FILE STATUS
30500 TTOB2: 21,,TTOB1
30600 0 ; BOOKKEEPING
30700 BLOCK 21
30800
30900 IOCHAS: 0 ; ASCII MODE
31000 SIXBIT /DSK/
31100 IOOBUF,,IOIBUF
31200 IOIBUF: BLOCK 3
31300 IOOBUF: BLOCK 3
31400 0 ; FILE STATUS
31500 IOIB1: BSIZE+1,,IOIB2
31600 0 ; BOOKKEEPING
31700 BLOCK BSIZE+1
31800 0 ; FILE STATUS
31900 IOIB2: BSIZE+1,,IOIB1
32000 0 ; BOOKKEEPING
32100 BLOCK BSIZE+1
32200 0 ; FILE STATUS
32300 IOOB1: BSIZE+1,,IOOB2
32400 0 ; BOOKKEEPING
32500 BLOCK BSIZE+1
32600 0 ; FILE STATUS
32700 IOOB2: BSIZE+1,,IOOB1
32800 0 ; BOOKKEEPING
32900 BLOCK BSIZE+1
33000
33100 IOFILE: 0 ; FILE NAME
33200 0 ; EXTENSION
33300 0
33400 0 ; PROJECT,,PROGRAMMER
33500
33600 IOFINB: 16
33700 0 ; PROJECT,,PROGRAMMER
33800 0 ; FILE NAME
33900 0 ; EXTENSION
34000 BLOCK 12
34100 IOFIND: 0 ; LOGICAL DEVICE
34200
34300 CCTMP: SIXBIT /EDT/ ; TMP: (CORE)
34400 0 ; (IOWD BSIZE,BUFFER)
34500
34600 CCCOMP: 1,,[ SIXBIT /SYS/
34700 SIXBIT /COMPIL/
34800 0
34900 0
35000 0
35100 0]
35200
35300 PSIPSI: 4,,PSI$CC
35400 0,,000002
35500 PSI$PC: 0
35600 0
35700 >
35800 ; (((^^^)))
35900
36000 ; (((TENEX)))
36100 IFG F.SYS,<
36200 IOJFN: 0
36300
36400 TMOD: 0
36500 TCOC1: 0
36600 TCOC2: 0
36700
36800 PSI$P1: 0
36900 PSI$P2: 0
37000 PSI$P3: 0
37100 >
37200 ; (((^^^)))
37300
37400 ; * VARIABLES
37500
37600 FLAGCC: 0 ; ^C CAPTURED
37700 FLAGCD: 0 ; ^C DEFERRED
37800 FLAGIF: 0 ; INITIALIZATION FLAG
37900 FLAGIR: 0 ; INITIAL READ (0:NO, -1:YES)
38000 FLAGEF: 0 ; ECHO FLAG
38100
38200 EXBASE: ^D10
38300 EXDBUG: 0
38400 EXPRIM: 0
38500 EXVPTR: ASCIZ /~/
38600 0
38700 EXVSIZ: 1
38800
38900 EX..: 0
39000 EX.B: 0
39100 EX.I: 0
39200 EX.S: 0
39300
39400 EX%PTR: 0
39500 EX%N: 0
39600 EX%CH: 0
39700 EX%S1N: 0
39800 EX%S1P: 0
39900 EX%S2N: 0
40000 EX%S2P: 0
40100 EX%Q: 0
40200 EX%B: 0
40300 EX%A: 0
40400
40500 M$I.SR: BLOCK 3
40600 M$I.ST: BLOCK 3
40700
40800 ; FIVE WORD POINTER BLOCK
40900 ; POINTER TO FIRST WORD
41000 ; NUMBER OF CHARACTERS ALLOCATED
41100 ; NUMBER OF CHARACTERS USED
41200 ; EDIT POINTER (CHARACTER NUMBER)
41300 ; VALUE
41400 C.B: 0 ; COMMAND BUFFER
41500 C.A: 0
41600 C.Z: 0
41700 0
41800 0
41900 B.B: 0 ; BACKUP BUFFER
42000 0
42100 B.Z: 0
42200 0
42300 B.V: 0
42400 S.B: 0 ; SEARCH BUFFER (ONE WORD PER CHARACTER)
42500 S.A: 0
42600 S.Z: 0
42700 0
42800 0
42900 N.B: 0 ; FILE NAME BUFFER
43000 N.A: 0
43100 N.Z: 0
43200 N.P: 0 ; NUMBER OF FILE NAME SPACES USED
43300 N.V: 0 ; NUMBER OF FILE NAME SPACES ALLOCATED
43400 Q.0: BLOCK <PBLOCK*^D36> ; QREGS 0-9 AND A-Z
43500 Q.$: 0 ; QREG *
43600 0
43700 0
43800 0
43900 0
44000 E.B: <Q.$+Q.B> ; EDIT BUFFER POINTER
44100 E.A: <Q.$+Q.A> ; EDIT BUFFER ALLOCATED
44200 E.Z: <Q.$+Q.Z> ; EDIT BUFFER USED (Z)
44300 E.P: <Q.$+Q.P> ; EDIT POINTER (.)
44400 ZU: 0 ; FIRST FREE UNUSED
44500 ZW: 0 ; FIRST FREE UNALLOCATED (IN THE WORLD)
44600
44700 ; * BUFFERS
44800
44900 IONAME: BLOCK NSIZE
45000
45100 ENVIRB: BLOCK BSIZE
45200
45300 STACKB: BLOCK SSIZE
45400
45500 END ANTE