perm filename EEE[LSP,BGB]1 blob
sn#001381 filedate 1972-11-05 generic text, type T, neo UTF8
00100 TITLE ALVINE
00200 P←14
02800 R←10
02850 INTERNAL EDXX
02900 EDXX:
03000 PHASE 0
03100 EDX: JRST ED(R)
03200 JRST RD2(R) ;RETURN FOR BELL
03300 JRST GRNDEF(R)
03400
03500 MESS: 0
03600
03700 CMER1: ASCII / ? /
03800 MER7: ASCII /*UDI /
03900 MER1: ASCII /*EDR /
04000 MER2: ASCII /*EDN /
04100 MER4: ASCII /*UBP /
04200 MER5: ASCII /*IPF /
04300 MER6: ASCII /*UBP /
04400 MER3: ASCII /*NSM /
04500 MER8: ASCII /*FNF /
04600 LPNAME: ASCII / %LP /
04700 RPNAME: ASCII / %RP /
04800 DT: ASCII / %D /
04900 LMBD: ASCII / LAMBDA /
05000 PRG: ASCII /PROG /
05100 LAMB←LMBD+1
05200 LPS: ASCII / LPS /
05300 RPS: ASCII / RPS /
05400 BAL: ASCII / BAL /
05500 PC: ASCII / % /
05600 STR: ASCII /%STR /
05700 PCL: ASCII /%%%L /
05800 TRC: ASCII / TRACE /
05900 DEF: ASCII / DEFPROP /
06000 GRI: ASCII / GRINDEF /
06100 SPR: ASCII / SPRINT /
06200 ASCII /%DPSPRINT /
06300 DPYSPR←.-1
06400 VALU: ASCII / VALUE /
06500 VALUE←VALU+1
06600 FEXP: ASCII / FEXPR /
06700 FEXPR←FEXP+1
06800 EXPR: ASCII/EXPR /
06900 FSUBA: ASCII / FSUBR /
07000 FSUBR←FSUBA+1
07100 SUBR: ASCII /SUBR /
07200
07300 GLS: ASCII /(FEXPR EXPR VALUE MACRO SPECIAL )/
07400 FLO: ASCII / FLONUM /
07500 FLONUM←FLO+1
07600 FIX: ASCII / FIXNUM /
07700 SETQ: ASCII /SETQ /
07800 QUO: ASCII / QUOTE /
07900 ASCII /NIL /
08000 EXTERN NCONC,PRINT,READ,READP1,TYO,ATOM,PUTPROP,GETL
08100 EXTERN XCONS,RATOM,APPEND,OUTC,EVAL,OUTPUT,TYO
08200 EXTERN INC,INPUT,SET,GET,TERPRI,UNBOUND,MEMQ
08300 EXTERN PRIN1,FLATSIZE,CHRCT,LENGTH,LAST,TYI
08400 INTERN ED
08500 P←14
08600 A←1
08700 B←2
08800 C←3
08900 AR1←4
09000 AR2A←5
09100 R←10
09200 S←11
09300 SP←17
09400 F←15
09500 T←6
09600 QUOTE←QUO+1
09700 FIXNUM←FIX+1
09800 DEFPROP←DEF+1
09900 GRINDEF←GRI+1
10000 SPRENT←SPR+1
10100 GLST←FLO-1
10200 TRACE←TRC+1
10300 DEFINE NCONS{XCONS-1}
10400 EXTERNAL PSAV1
10500
10600 ED: PUSH P,A
10700 RD1: MOVEI A,TTYI(R)
10800 PUSHJ P,READP1
10900 JUMPE A,RD2A(R)
11000 MOVEM A,@J(R)
11100 JRST RD1(R)
11200
11300 TTYI: ILDB A,J(R)
11400 POPJ P,0
11500
11600 J: POINT 7,MESS(R)
11700
11800 RD2A: MOVE C,SUBR(R)
11900 MOVEI B,SPRINT(R)
12000 MOVE A,SPRENT(R)
12100 PUSHJ P,PUTPROP
12200 MOVEI B,DPSPR(R)
12300 MOVE C,SUBR(R)
12400 MOVE A,DPYSPR(R)
12500 PUSHJ P,PUTPROP
00100 RD2B: MOVE B,GLST(R)
00200 MOVE A,PCL(R)
00300 PUSHJ P,SET
00400 MOVE B,[JRST EDN(R)](R)
00500 MOVEM B,ED(R)
00600 POP P,A
00100 EDN: JUMPN A,FALSE(R)
00200 MOVEM P,PSAV2#(R)
00300 PUSH P,[0](R) ;%B
00400 PUSH P,[0](R) ;SRCH STRNG
00500 PUSH P,[0](R) ;%STR
00600 PUSH P,[0](R) ;%1
00700 PUSH P,[0](R) ;%2
00800 PUSH P,[0](R) ;%REM
00900 PUSH P,[0](R) ;%NEW
01000 SETZM BK1#(R)
01100 MOVE A,STR(R)
01200 MOVE B,VALUE(R)
01300 PUSHJ P,GET
01400 JUMPE A,.+4(R)
01500 HRRZ A,(A)
01600 MOVEM A,-6(P)
01700 MOVEM A,-4(P)
01800 MOVE B,VALUE(R)
01900 MOVE A,PCL(R)
02000 PUSHJ P,GET
02100 HRRZ A,(A)
02200 MOVEM A,GLST(R)
02300 MOVEM P,PSAV1
02400 RD2:
02500 PUSHJ P,TERPRI
02600 RD3: SETZM OLDCH
02700 PUSHJ P,TYI
02800 CAIN A,"↑"
02900 JRST UPARR(R)
03000 CAIE A,12
03100 CAIN A,15
03200 JRST RD3(R)
03300 CAIN A,175 ;ALTMODE
03400 JRST RD3(R)
03500 CAIN A,"G"
03600 JRST ED1(R)
03700 CAIN A,"P"
03800 JRST ED2(R)
03900 CAIN A,"Q"
04000 JRST ED2X(R)
04100 CAIN A,"B"
04200 JRST ED5(R)
04300 CAIN A,"W"
04400 JRST ED14(R)
04500 CAIN A,"A"
04600 JRST ED4(R)
04700 CAIN A,"V"
04800 JRST ED13(R)
04900 CAIN A,"U"
05000 JRST ED16(R)
05100 CAIN A,"F"
05200 JRST ED9(R)
05300
05400 MOVEI B,1
05500 MOVEM B,CNT#(R)
05600 DSP1: CAIN A,"S"
05700 JRST ED10(R)
05800 CAIN A,"I"
05900 JRST ED8(R)
06000 CAIN A,"R"
06100 JRST ED3(R)
06200 CAIN A,"M"
06300 JRST ED15(R)
06400 CAIN A,"E"
06500 JRST EDEX(R)
06600 CAIN A,"D"
06700 JRST EDDL(R)
06800 CAIN A,">"
06900 JRST ED11(R)
07000 CAIN A,"<"
07100 JRST ED12(R)
07200 CAIN A,"C"
07300 JRST SPC(R)
07400 CAIG A,"9"
07500 CAIGE A,"0"
07600 JRST ER1(R)
07700 JRST NMB(R)
07800
07900 ER1: MOVE A,CMER1(R)
08000 PUSHJ P,PRINT
08100 JRST RD2(R)
08200
08300 SPC: MOVE A,CNT(R) ;C - COUNT
08400 MOVEM A,PCNT(R)
08500 JRST RD2(R)
08600 PCNT: 3
08700 NMB: SETZM CNT(R)
08800 NM1: SUBI A,"0"
08900 MOVE B,CNT(R)
09000 MULI B,12
09100 ADD A,C
09200 MOVEM A,CNT(R)
09300 PUSHJ P,TYI
09400 CAIG A,"9"
09500 CAIGE A,"0"
09600 JRST DSP1(R)
09700 JRST NM1(R)
09800
09900
10000 ERED1: MOVE A,MER7(R)
10100 JRST ER1+1(R)
10200
10300 UPARR: SETZM PSAV1
10400 MOVE P,PSAV2(R)
10500 JRST FALSE(R)
10600
10700 ED1: PUSHJ P,READ ;G - GET
10800 JUMPE A,RD2(R)
10900 PUSH P,A
11000 MOVE B,TRACE(R)
11100 PUSHJ P,GET
11200 JUMPE A,ED1D(R)
11300 HRRZ A,(A)
11400 MOVEM A,(P)
11500 ED1D: MOVE A,(P)
11600 MOVE B,GLST(R)
11700 PUSHJ P,GETL
11800 JUMPE A,ERED1(R)
11900 HRRZ C,(A)
12000 HLRZ A,(A)
00100 CAME A,VALUE(R)
00200 JRST ED1B(R)
00300 HLRZ A,(C)
00400 HRRZ A,(A)
00500 PUSHJ P,NCONS
00600 MOVE B,QUOTE(R)
00700 PUSHJ P,XCONS
00800 PUSHJ P,NCONS
00900 POP P,B
01000 PUSHJ P,XCONS
01100 MOVE B,SETQ(R)
01200 JRST ED1C(R)
01300 ED1B: PUSHJ P,NCONS
01400 HLRZ B,(C)
01500 PUSHJ P,XCONS
01600 POP P,B
01700 PUSHJ P,XCONS
01800 MOVE B,DEFPROP(R)
01900 ED1C: PUSHJ P,XCONS
02000 PUSHJ P,MKLPRP(R)
02100 ED1A: MOVEM A,-4(P)
02200 MOVEM A,-6(P)
02300 SETZM BK1(R)
02400 MOVE B,A
02500 MOVE A,STR(R)
02600 PUSHJ P,SET
02700 JRST RD2(R)
02800
02900 ED2X: MOVE A,-4(P) ;Q -- PUT ON ORIGINAL NAME
03000 HRRZ A,(A)
03100 HRRZ A,(A)
03200 HLRZ A,(A)
03300 JRST ED2+1(R)
03400
03500 ED2: PUSHJ P,READ
03600 PUSH P,A ;P -- PUT
03700 MOVE B,TRACE(R)
03800 PUSHJ P,GET
03900 JUMPE A,ED2A(R)
04000 HRRZ A,(A)
04100 MOVEM A,(P)
04200 ED2A: MOVE A,-5(P)
04300 PUSHJ P,UNMK(R)
04400 JUMPE A,RD2(R)
04500 HRRZ B,(A)
04600 POP P,C
04700 HRLM C,(B)
04800 PUSHJ P,EVAL
04900 JRST RD2(R)
05000
05100 ED3A: SETZM -2(P)
05200 JRST EDB(R)
05300
05400 ED3R: MOVE C,T
05500 JUMPN C,ED3R2(R)
05600 MOVE A,(P)
05700 JRST ED1A(R)
05800
05900 ED3R2: CAME T,BK1(R)
06000 JRST ED3R1(R)
06100 MOVE B,(P)
06200 MOVEM B,-6(P)
06300 JRST ED3R3(R)
06400
06500 ED8A: SKIPE RSW#(R)
06600 JRST ER1(R)
06700 PUSHJ P,EDREAD(R)
06800 MOVE B,-6(P)
06900 ED85: PUSHJ P,.NCONC(R)
07000 MOVEM A,-6(P)
07100 SOSLE CNT(R)
07200 JRST EDB1(R)
07300 SKIPN BK1(R)
07400 JRST ED1A(R)
07500 HRRM A,@BK1(R)
07600 JRST RD2(R)
07700
07800 EDB1: MOVE A,(P)
07900 JRST EDB(R)
08000
08100 EDE1: HRRM A,-4(P)
08200 JRST ED1A+2(R)
08300 ED8C: SKIPE RSW(R)
08400 JRST ER1(R)
08500 PUSHJ P,EDREAD(R)
08600 JRST ED1A(R)
08700 ED8: TDZA C,C ;I - INSERT
08800 ED3: SETOM C ;R - REPLACE
08900 MOVEM C,RSW(R)
09000 SETZM NEWFLG#(R)
09100 PUSHJ P,EDREAD(R)
09200 JUMPE A,ED8A(R)
09300 MOVEM A,-3(P)
09400 HLRZ A,(A)
09500 CAMN A,PC(R)
09600 JRST ED8C(R)
09700 PUSHJ P,EDREAD(R)
09800 JUMPN A,ED3A(R)
09900 PUSHJ P,EDREAD(R)
10000 MOVEM A,-2(P)
10100 PUSHJ P,EDREAD(R)
10200
10300 EDB: MOVEM A,(P)
10400 MOVEM A,LNEW#(R)
10500 HRRZ A,(A)
10600 JUMPN A,.-2(R)
10700
10800 HLRZ@ A,(P)
10900 CAMN A,PC(R)
11000 ED3N: SETOM NEWFLG(R)
11100 MOVE A,-6(P)
11200 MOVE B,-3(P)
11300 MOVE T,BK1(R)
11400 PUSHJ P,SRCH(R)
11500 JUMPE A,ED33(R)
11600 MOVE B,-2(P)
11700 JUMPE B,ED31(R)
11800 MOVEM T,BK2#(R)
11900 PUSHJ P,SRCH(R)
12000 JUMPE A,ED34(R)
12100 MOVE T,BK2(R)
12200 ED31: SKIPE NEWFLG(R)
12300 JRST ED32(R)
12400 HRRM@ A,LNEW(R)
12500 ED34: MOVE C,BK3(R)
12600 SKIPE RSW(R)
12700 JRST ED3R(R)
12800 ED3R1: MOVE B,(P)
12900 ED3R3: HRRM B,@C
13000 JRST RD2(R)
13100 ED32: JUMPE T,ED1A(R)
13200 HRRM A,@T
13300 JRST RD2(R)
13400 ED33: SKIPE -2(P)
13500 JRST SER1(R)
13600 SKIPN NEWFLG(R)
13700 JRST ED34(R)
13800 HRRZ T,(T)
13900 MOVEM T,BK3(R)
14000 JRST ED37(R)
14100
14200 ED4: MOVE A,-4(P) ;A - ALL
14300 PUSH P,A
14400 PUSHJ P,TERPRI
14500 POP P,A
14600 PUSHJ P,EDGRIN(R)
14700 JRST RD2(R)
14800
14900 EDDL: MOVE A,-6(P) ;D - DELETE
15000 MOVEM A,BK3(R)
15100 HRRZ A,(A)
15200 JUMPE A,EDDL2(R)
15300 SOSLE CNT(R)
15400 JRST EDDL+1(R)
15500 EDDL1: PUSH P,A
15600 PUSHJ P,PRINTC(R)
15700 POP P,A
15800 JRST ED85+1(R)
15900
16000 ED5: MOVE A,-4(P) ;B - BALANCED
16100 PUSHJ P,PARSRCH(R)
16200 CAMN A,B
16300 JRST ED51(R)
16400 PUSH P,B
16500 ADDI A,MAGNO
16600 PUSHJ P,PRINT
16700 MOVE A,LPS(R)
16800 PUSHJ P,PRIN1
16900 POP P,A
17000 ADDI A,MAGNO
17100 PUSHJ P,PRINT
17200 MOVE A,RPS(R)
17300 PUSHJ P,PRIN1
17400 JRST RD2(R)
17500 ED51: MOVE A,BAL(R)
17600 JRST ED51-2(R)
17700
17800 EDDL2: MOVEI A,07
17900 PUSHJ P,TYO
18000 SKIPN BK1(R)
18100 JRST ER1(R)
18200 MOVE A,-6(P)
18300 MOVEM A,BK3(R)
18400 MOVE A,-4(P)
18500 HRRZ C,(A)
18600 CAMN C,BK3(R)
18700 JRST ED37B(R)
18800 JUMPE C,RD2(R)
18900 TDZA AR1,AR1
19000 ED37: SETOM AR1
19100 MOVE A,-4(P)
19200 MOVEM A,BK2(R)
19300 HRRZ A,(A)
19400 HRRZ C,(A)
19500 CAME C,BK3(R)
19600 JRST .-4(R)
19700 ED37A: HLRM A,(A)
19800 JUMPN AR1,RD2(R)
19900 MOVEM A,-6(P)
20000 PUSHJ P,PRINTC(R)
20100 MOVE A,BK2(R)
20200 MOVEM A,BK1(R)
20300 JRST RD2(R)
20400
20500 ED37B: HLRM A,(A)
20600 JRST ED1A(R)
20700
20800
20900 ED11: MOVE A,-6(P) ;> - RIGHT
21000 MOVE B,CNT(R)
21100 SKIPN B
21200 MOVEI B,7777
21300 MOVEM A,C
21400 HRRZ A,(A)
21500 JUMPE A,ED11A(R)
21600 MOVEM A,-6(P)
21700 MOVEM C,BK1(R)
21800 SOJG B,.-5(R)
21900 JRST ED11B(R)
22000 ED11A: MOVEI A,07
22100 PUSHJ P,TYO
22200 JRST RD2(R)
22300
22400 ED11B:
22500 PUSHJ P,PRINTC(R)
22600 JRST RD2(R)
22700
22800 ED12: SETZM C ;< - LEFT
22900 SKIPN CNT(R)
23000 JRST ED12C(R)
23100 MOVE A,-4(P)
23200 ED12A: CAMN A,-6(P)
23300 JRST ED12B(R)
23400 AOS C
23500 HRRZ A,(A)
23600 JUMPN A,ED12A(R)
23700 JRST ERR3(R)
23800 ED12B: MOVE A,CNT(R)
23900 SUBM A,C
24000 SKIPL C
24100 JRST ED12C(R)
24200 MOVE A,-4(P)
24300 MOVEM A,BK1(R)
24400 HRRZ A,(A)
24500 AOJL C,.-2(R)
24600 MOVEM A,-6(P)
24700 JRST ED12D(R)
24800 ED12C: MOVEI A,07
24900 PUSHJ P,TYO
25000 MOVE A,-4(P)
25100 MOVEM A,-6(P)
25200 SETZM BK1(R)
25300 ED12D: PUSHJ P,PRINTC(R)
25400 JRST RD2(R)
25500
25600 ED14: MOVE A,-6(P) ;W - WHERE
25700 JRST ED12D(R)
25800
25900 ERR3: MOVE A,MER1(R)
26000 JRST ER1+1(R)
26100
26200 ED10: PUSHJ P,EDREAD(R) ;S - SEARCH
26300 SKIPN A
26400 MOVE A,-5(P)
26500 MOVEM A,-5(P)
26600 MOVE B,A
26700 MOVE A,-6(P)
26800 MOVE T,BK1(R)
26900 ED10C: PUSHJ P,SRCH1(R)
27000 JUMPE A,ED10B(R)
27100 MOVEM A,-6(P)
27200 MOVE B,BK3(R)
27300 MOVEM B,BK1(R)
27400 SOSG CNT(R)
27500 JRST ED10D(R)
27600 MOVE B,-5(P)
27700 JRST ED10C(R)
27800 ED10B: MOVEI A,07
27900 PUSHJ P,TYO
28000 ED10D: MOVE A,-6(P)
28100 PUSHJ P,PRINTC(R)
28200 JRST RD2(R)
28300
28400 ;SRCH RETURNS END IN A
28500 ;SETS T AND BK3
28600 ;STARTS WITH STRING IN A
28700 ;AND SEARCH-STRING IN B
28800 ;STRING-1 IN T
28900 ;SRCH1 RETURNS 0 IN A IF NOT FOUND,SRCH CALL ERROR
29000
29100 SRCH1: TDZA AR2A,AR2A
29200 SRCH: SETOM AR2A
29300 MOVEM B,STRB#(R)
29400
29500 SR1: HLRZ AR1,(B)
29600 HLRZ C,(A)
29700 CAMN AR1,C
29800 JRST SR2(R)
29900 PUSHJ P,SRNUM(R)
30000 MOVEM A,T
30100 HRRZ A,(A)
30200 JUMPN A,SR1+1(R)
30300 SR3: SKIPN AR2A
30400 POPJ P,
30500 POP P,A
30600 SER1: MOVE A,MER3(R)
30700 JRST ER1+1(R)
30800
30900 SR2: MOVEM A,BK3#(R)
31000 HRRZ A,(A)
31100 HRRZ B,(B)
31200 JUMPE A,SR4(R)
31300 SKIPN B
31400 POPJ P,
31500 HLRZ C,(A)
31600 HLRZ AR1,(B)
31700 CAMN C,AR1
31800 JRST SR2(R)
31900 PUSHJ P,SRNUM(R)
32000 MOVE T,BK3(R)
32100 MOVE B,STRB(R)
32200 JRST SR1(R)
32300
32400 SR4: JUMPN B,SR3(R)
32500 POPJ P,
32600 EDEX1: MOVE A,-7(P)
32700
32800
32900 HLRZ B,(A)
33000 CAMN B,LPNAME(R)
33100 JRST ED15B(R)
33200 CAME B,RPNAME(R)
33300 CAMN B,DT(R)
33400 JRST ED15A-1(R)
33500 POPJ P,0
33600
33700 ED15: PUSHJ P,EDEX1(R) ;M - MATCH
33800 ED15D: MOVEM A,B
33900 HRRZ A,(A)
34000 JUMPE A,ED15A(R)
34100 MOVEM B,BK1(R)
34200 MOVEM A,-6(P)
34300 SOSLE CNT(R)
34400 JRST ED15(R)
34500 PUSHJ P,PRINTC(R)
34600 JRST RD2(R)
34700
34800 ED15B: SETZM AR1
34900 ED15C: AOS AR1
35000 ED15E: HRRZ A,(A)
35100 JUMPE A,ED15A-1(R)
35200 HLRZ B,(A)
35300 CAMN B,LPNAME(R)
35400 JRST ED15C(R)
35500 CAMN B,RPNAME(R)
35600 SOJE AR1,ED15-1(R)
35700 JRST ED15E(R)
35800 POP P,A
35900 ED15A: MOVEI A,07
36000 PUSHJ P,TYO
36100 JRST RD2(R)
36200
36300 ED13: MOVE A,-6(P) ;V - VOMIT
36400 PUSHJ P,PARSRCH(R)
36500 MOVE A,-6(P)
36600 CAMGE B,AR1
36700 JRST ED4+1(R)
36800 HLRZ B,(A)
36900 CAME B,LPNAME(R)
37000 JRST ED4+1(R)
37100 HRRZ@ A,-6(P)
37200 MOVEM A,AR2A
37300 PUSHJ P,UNMK1(R)
37400 OPDEF CALLF [36B8]
37500 CALLF 1,@DPYSPR(R)
37600 JRST RD2(R)
37700
37800 DPSPR: MOVEI C,0
37900 MOVEI B,2
38000 PUSHJ P,SPRNT2(R)
38100 JRST TERPRI
38200
38300 UNER1A:
38400 UNER1B: MOVE A,MER2(R)
38500 JRST EDGER+1(R)
38600
38700 MOVEM A,-6(P)
38800 EDEX: PUSHJ P,EDEX1(R) ;E - EXPLUGE
38900 HRRZ A,(A)
39000 JUMPE A,ED15A(R)
39100 SOSLE CNT(R)
39200 JRST EDEX-1(R)
39300 JRST EDDL1(R)
39400
39500 UNMK1: PUSHJ P,EDGET(R)
39600 CAMN A,LPNAME(R)
39700 JRST UN3(R)
39800 CAMN A,RPNAME(R)
39900 JRST UN2(R)
40000 CAMN A,DT(R)
40100 JRST UN1(R)
40200 PUSH P,A
40300 PUSHJ P,UNMK1(R)
40400 POP P,B
40500 PUSHJ P,XCONS
40600 POPJ P,
40700 UN1: PUSHJ P,EDGET(R)
40800 CAMN A,LPNAME(R)
40900 JRST UN4(R)
41000 CAME A,RPNAME(R)
41100 CAMN A,DT(R)
41200 JRST UNER1A(R)
41300 UN5: PUSH P,A
41400 PUSHJ P,EDGET(R)
41500 CAME A,RPNAME(R)
41600 JRST UNER1B(R)
41700 POP P,A
41800 POPJ P,0
41900 UN3: PUSHJ P,UNMK1(R)
42000 PUSH P,A
42100 PUSHJ P,UNMK1(R)
42200 POP P,B
42300 PUSHJ P,XCONS
42400 POPJ P,
42500 UN2: SETZM A
42600 POPJ P,
42700 UN4: PUSHJ P,UNMK1(R)
42800 JRST UN5(R)
42900
43000
43100 EDGET: SKIPN AR2A
43200 JRST EDGER(R)
43300 HLRZ A,(AR2A)
43400 HRRZ AR2A,(AR2A)
43500 POPJ P,
43600 EDGER: MOVE A,MER4(R)
43700 PUSHJ P,PRINT
43800 MOVE P,PSAV(R)
43900 SUB P,[XWD 2,2](R)
44000 JRST RD2(R)
44100
44200 CNT1: 0
44300
44400 PRINTC: PUSH P,A
44500 PUSHJ P,TERPRI
44600 POP P,A
44700 MOVE C,PCNT(R)
44800 MOVEM C,CNT1(R)
44900 JUMPE A,PRN3(R)
45000 PRN1: PUSH P,A
45100 SETZM AR1
45200 HLRZ A,(A)
45300 CAMN A,LPNAME(R)
45400 MOVEI AR1,"("
45500 CAMN A,RPNAME(R)
45600 MOVEI AR1,")"
45700 CAMN A,DT(R)
45800 MOVEI AR1,"."
45900 SKIPE AR1
46000 JRST PRN2(R)
46100 PUSHJ P,PRIN1
46200 MOVEI AR1," "
46300 PRN2: MOVE A,AR1
46400 PUSHJ P,TYO
46500 POP P,A
46600 HRRZ A,(A)
46700 SOSLE CNT1(R)
46800 JUMPN A,PRN1(R)
46900 PRN3: POPJ P,
47000
47100 ED9: PUSHJ P,READ ;F - FILE
47200 PUSH P,A
47300 PUSHJ P,READ
47400 PUSH P,A
47500 PUSHJ P,READ
47600 PUSHJ P,NCONS
47700 POP P,B
47800 PUSHJ P,XCONS
47900 PUSHJ P,OUTPUT
48000 PUSHJ P,OUTC
48100 MOVE A,(P)
48200 PUSHJ P,ATOM
48300 JUMPE A,ED9A(R)
48400 MOVE B,VALUE(R)
48500 MOVE A,(P)
48600 PUSHJ P,GET
48700 HRRZ A,(A)
48800 JRST .+2(R)
48900 ED9A: POP P,A
49000 PUSHJ P,GRNDEF(R)
49100 MOVEI A,0
49200 MOVEI B,1
49300 PUSHJ P,OUTC
49400 JRST RD2(R)
49500
49600 EDGRIN: MOVEI C,7777
49700 JRST PRN1-2(R)
49800
49900 PARSRCH: SETZB AR1,B
50000 PAR1: HLRZ C,(A)
50100 CAMN C,LPNAME(R)
50200 AOS AR1
50300 CAMN C,RPNAME(R)
50400 AOS B
50500 HRRZ A,(A)
50600 JUMPN A,PAR1(R)
50700 MOVE A,AR1
50800 POPJ P,
50900
51000
51100 MKLPRP1: PUSH P,[0](R) ;A
51200 PUSH P,A ;X,B
51300 PUSHJ P,ATOM
51400 JUMPN A,MLP1(R)
51500 MOVE A,LPNAME(R)
51600 PUSHJ P,NCONS
51700 MOVEM A,-1(P)
51800 L1: HLRZ@ A,(P)
51900 PUSHJ P,MKLPRP1(R)
52000 MOVE B,A
52100 MOVE A,-1(P)
52200 PUSHJ P,.NCONC(R)
52300 MOVEM A,-1(P)
52400 HRRZ@ A,(P)
52500 JUMPE A,MLP2(R)
52600 PUSHJ P,ATOM
52700 JUMPN A,MLP3(R)
52800 HRRZ@ A,(P)
52900 MOVEM A,(P)
53000 JRST L1(R)
53100 MLP1: POP P,A
53200 PUSHJ P,NCONS
53300 MOVE B,A
53400 POP P,A
53500 PUSHJ P,.NCONC(R)
53600 POPJ P,0
53700 MLP2: MOVE A,RPNAME(R)
53800 PUSHJ P,NCONS
53900 MLP4: POP P,B
54000 MOVE B,A
54100 POP P,A
54200 JRST .NCONC(R)
54300 MLP3: MOVE A,RPNAME(R)
54400 PUSHJ P,NCONS
54500 HRRZ@ B,(P)
54600 PUSHJ P,XCONS
54700 MOVE B,DT(R)
54800 PUSHJ P,XCONS
54900 JRST MLP4(R)
55000
55100 PSAV: 0
55200 UNMK: MOVEM P,PSAV(R)
55300 HLRZ B,(A)
55400 CAME B,LPNAME(R)
55500 JRST UNER1(R)
55600 HRRZ A,(A)
55700 MOVEM A,AR2A
55800 PUSHJ P,UNMK1(R)
55900 SKIPE AR2A
56000 JRST UNER2(R)
56100 POPJ P,
56200
56300 UNER1: MOVE A,MER5(R)
56400 PUSHJ P,PRINT
56500 MOVE P,PSAV1
56600 JRST RD2(R)
56700 UNER2: MOVE A,MER6(R)
56800 JRST UNER1+1(R)
56900
57000 .NCONC: MOVNI 6,2
57100 PUSH P,A
57200 PUSH P,B
57300 JRST NCONC
57400
57500 ED16: PUSHJ P,READ ;U - UNFILE
57600 PUSH P,A
57700 PUSHJ P,READ
57800 PUSH P,A
57900 PUSHJ P,READ
58000 PUSHJ P,NCONS
58100 POP P,B
58200 PUSHJ P,XCONS
58300 PUSHJ P,INPUT
58400 PUSHJ P,INC
58500 MOVE A,(P)
58600 PUSHJ P,ATOM
58700 JUMPE A,ED16A(R)
58800 MOVE B,VALUE(R)
58900 MOVE A,(P)
59000 PUSHJ P,GET
59100 HRRZ A,(A)
59200 ED16D: MOVEM A,(P)
59300 ED16A: PUSHJ P,READ
59400 MOVE T,A
59500 PUSHJ P,ATOM
59600 JUMPN A,ED16A(R)
59700 HRRZ A,(T)
59800 HLRZ A,(A)
59900 SKIPE B,(P)
60000 PUSHJ P,MEMQ
60100 JUMPE A,ED16A(R)
60200 MOVE A,T
60300 PUSHJ P,EVAL
60400 SKIPE (P)
60500 PUSHJ P,PRINT
60600 JRST ED16A(R)
60700 JRST ER1+1(R)
60800 TT←7
60900 D←12
61000 SRNUM: CAIGE C,INUMIN ;NUMBER COMPARES
61100 CAIL AR1,INUMIN
61200 POPJ P,
61300 HRRZ C,(C)
61400 HLRZ TT,(C)
61500 CAME TT,FIXNUM(R)
61600 CAMN TT,FLONUM(R)
61700 SKIPA D,(AR1)
61800 POPJ P,0
61900 HLRZ S,(D)
62000 CAME TT,S
62100 POPJ P,0
62200 HRRZ C,(C)
62300 HRRZ D,(D)
62400 MOVE D,(D)
62500 MOVE C,(C)
62600 CAME D,C
62700 POPJ P,0
62800 POP P,TT
62900 JRST SR2(R)
63000 EXTERN OLDCH,LINL,CHCT
63100
63200 EDRD1: SETZB A,...FLG(R)
63300 POPJ P,0
63400 ...FLG: 0
63500 EDREAD: SKIPE ...FLG(R)
63600 JRST EDRD1(R)
63700 PUSHJ P,READ1(R)
63800 JUMPL A,.-1(R)
63900 POPJ P,0
64000
64100 READ1: PUSHJ P,RATOM
64200 JRST READ1A(R)
64300 READ2: ADDI B,(R)
64400 XCT EDTAB(B)
64500 READ1A: PUSH P,A
64600 PUSHJ P,READ1(R)
64700 READ3: POP P,B
64800 JUMPL A,READ1(R) ;RUBOUT
64900 JRST XCONS
65000
65100 EDTAB: MOVE A,LPNAME(R) ;0 (
65200 MOVE A,RPNAME(R) ;1 )
65300 MOVE A,LPNAME(R) ;2 [
65400 JRST READ4(R) ;3 ],$
65500 JRST EDRD3(R) ;4 .
65600 SKIP
65700 SETOM A ;6 RUBOUT
65800 POPJ P,
65900
66000 READ4: CAIN A,175
66100 JRST FALSE(R) ;ALTMODE
66200 MOVE A,RPNAME(R)
66300 JRST READ1A(R)
66400
66500 EDRD5: SUB P,[XWD 2,2](R)
66600 JRST EDRD32(R)
66700
66800 EDRD4: SUB P,[XWD 2,2](R)
66900 JRST READ1(R)
67000
67100 EDRD3: PUSH P,DT(R)
67200 PUSH P,[READ3](R)
67300 ADDM R,(P)
67400 EDRD32: PUSHJ P,RATOM
67500 JRST READ1A(R) ;ATOM
67600 CAIN A,177
67700 JRST EDRD4(R) ;RUBOUT
67800 CAIE A,"."
67900 JRST READ2(R)
68000 PUSH P,DT(R)
68100 PUSH P,[READ3](R)
68200 ADDM R,(P)
68300 PUSHJ P,RATOM
68400 JRST READ1A(R) ;ATOM
68500 CAIN A,177
68600 JRST EDRD5(R) ;RUBOUT
68700 CAIE A,"."
68800 JRST READ2(R)
68900 SUB P,[XWD 4,4](R)
69000 MOVEM A,...FLG(R)
69100 FALSE: MOVEI A,0
69200 CPOPJ: POPJ P,0
00100
00200 ;GRINDEF AND FRIENDS
00300 ;THESE FUNCTIONS KNOW ABOUT INUMS
00400 MAGNO←577777
00500 INUMIN←400000
00600 PANL: PUSH P,A
00700 PUSHJ P,ATOM
00800 JUMPN A,PNL3(R)
00900 HRRZ@ A,(P)
01000 PUSHJ P,ATOM
01100 JUMPE A,PNL1(R)
01200 PNL3: MOVEI A,15
01300 EXCH A,(P)
01400 JRST PNL2(R)
01500
01600 PNL1: HRRZ A,@(P)
01700 HLRZ A,(A)
01800 PUSHJ P,PANL(R)
01900 EXCH A,(P)
02000 HLRZ A,(A)
02100 PNL2: PUSHJ P,FLATSIZE
02200 SUBI A,MAGNO
02300 POP P,B
02400 ADD A,B
02500 ADDI A,2
02600 POPJ P,
02700
02800
02900 HUNZ1: AOS C,-2(P)
03000 JRST HUNZ3(R)
03100 HUNZ2: MOVE A,(P)
03200 PUSHJ P,FLATSIZE
03300 SUBI A,MAGNO
03400 ADD A,-2(P)
03500 ADDI A,4
03600 MOVE C,A
03700 JRST HUNZ3(R)
03800
03900 HUNOZ: PUSH P,C
04000 PUSH P,B
04100 PUSH P,A
04200 HLRZ S,(A)
04300 HRRZ A,(A)
04400 MOVEM A,(P)
04500 JUMPE A,HUNZ1(R)
04600 PUSHJ P,ATOM
04700 JUMPN A,HUNZ2(R)
04800 MOVEI C,0
04900 HUNZ3: MOVE B,-1(P)
05000 MOVE A,S
05100 PUSHJ P,SPRNT2(R)
05200 POP P,A
05300 JUMPE A,HUNZ4(R)
05400 PUSHJ P,ATOM
05500 JUMPE A,HUNZ4(R)
05600 MOVEI A," "
05700 PUSHJ P,TYO
05800 MOVEI A,"."
05900 PUSHJ P,TYO
06000 MOVEI A," "
06100 PUSHJ P,TYO
06200 HUNZ4: SUB P,[XWD 2,2](R)
06300 EXIT: POPJ P,
06400 GR1: 0
06500
06600 GRN1: POP P,B
06700 HRRZ B,(B)
06800 JUMPN B,GRN2(R)
06900 POP P,A
07000 SKIPE GR1(R)
07100 JRST GRN4(R)
07200 GRN5: HRRZ A,(A)
07300 JUMPE A,TERPRI
07400
07500 GRNDEF: SETZM GR1(R)
07600 PUSH P,A
07700 MOVE B,TRACE(R)
07800 HLRZ A,(A)
07900 PUSHJ P,GET
08000 JUMPE A,GRN2-1(R)
08100 HLRZ@ AR1,(P)
08200 HRRZ B,(AR1)
08300 PUSH SP,B
08400 HRRZ A,(A)
08500 MOVE B,GLST(R)
08600 PUSHJ P,GETL
08700 HRRM A,(AR1)
08800 HRRZ C,(A)
08900 MOVEM C,GR1(R)
09000 HLRZ D,D
09100 HRRZ D,(D)
09200 HRRZ D,(D)
09300 HRRZ D,(D)
09400 HRRM D,(C)
09500 MOVE B,GLST(R)
09600 GRN2: HLRZ@ A,(P)
09700 PUSH P,B
09800 HLRZ B,(B)
09900 PUSHJ P,GET
10000 JUMPE A,GRN1(R)
10100 PUSH P,A
10200 PUSHJ P,ATOM
10300 JUMPN A,GRNFOO(R)
10400 POP P,A
10500 HRRZ B,(A)
10600 CAIN B,UNBOUND
10700 JRST GRN1(R)
10800 PUSH P,A
10900 GRNFOO: PUSHJ P,TERPRI
11000 PUSHJ P,TERPRI
11100 MOVEI A,"("
11200 PUSHJ P,TYO
11300 MOVE A,DEF+1(R)
11400 PUSHJ P,PRIN1
11500 MOVEI A," "
11600 PUSHJ P,TYO
11700 HLRZ@ A,-2(P)
11800 PUSHJ P,PRIN1
11900 MOVEI A," "
12000 PUSHJ P,TYO
12100 PUSHJ P,TERPRI
12200 MOVEI C,0
12300 MOVEI B,2
12400 POP P,A
12500 PUSHJ P,SPRNT2(R)
12600 MOVEI A," "
12700 PUSHJ P,TYO
12800 PUSHJ P,TERPRI
12900 MOVEI B,1
13000 MOVEI C,1
13100 HLRZ@ A,(P)
13200 PUSHJ P,SPRNT2(R)
13300 MOVEI A,")"
13400 PUSHJ P,TYO
13500 JRST GRN1(R)
13600 GRN4: POP SP,B
13700 HLRZ C,(A)
13800 HRRM B,(C)
13900 HRRZ C,GR1(R)
14000 HLRM C,(C)
14100 JRST GRN5(R)
00100 TAB: SKIPN %%TBFLG#(R)
00200 JRST TYO
00300 MOVEI A,40
00400 MOVEI B,10
00500 PUSHJ P,TYO
00600 SOJG B,.-1(R)
00700 POPJ P,
00800
00900 PPOS: SUBI A,MAGNO
01000 PUSHJ P,SPR1+1(R)
01100 MOVEI A,0
01200 POPJ P,
01300
01400 SPRINT: SUBI B,MAGNO
01500 SUBI C,MAGNO
01600 JRST SPRNT2(R)
01700
01800 SPR1: SOS A,-2(P)
01900 PUSH P,A
02000 PUSH P,A
02100 CAIGE A,1
02200 JRST PPL1(R)
02300 MOVE A,LINL
02400 SUB A,CHCT
02500 CAMLE A,-1(P)
02600 PPL1: PUSHJ P,TERPRI
02700 PPL2: MOVE A,LINL
02800 SUB A,CHCT
02900 ADDI A,10
03000 CAMLE A,-1(P)
03100 JRST PPL3(R)
03200 MOVEI A,11
03300 PUSHJ P,TAB(R)
03400 JRST PPL2(R)
03500
03600 PPL3: SUBI A,10
03700 SUB A,-1(P)
03800 MOVNM A,(P)
03900 PPL4: SOSGE (P)
04000 JRST PPL5(R)
04100 MOVEI A," "
04200 PUSHJ P,TYO
04300 JRST PPL4(R)
04400
04500 PPL5: SUB P,[XWD 2,2](R)
04600 POPJ P,
04700
04800 SPRNT2: PUSH P,AR2A
04900 PUSH P,C
05000 PUSH P,B
05100 PUSH P,A
05200 HRRZ A,LINL
05300 MOVEM A,AR2A
05400 SPR2: PUSHJ P,CHRCT
05500 SUBI A,MAGNO
05600 SUBI A,1(AR2A)
05700 MOVNM A,A
05800 CAMGE A,-1(P)
05900 PUSHJ P,SPR1(R)
06000 MOVE A,(P)
06100 PUSHJ P,ATOM
06200 JUMPN A,SPR3(R)
06300 MOVE A,(P)
06400 PUSHJ P,FLATSIZE
06500 SUBI A,MAGNO
06600 ADD A,-2(P)
06700 MOVEM A,AR1
06800 PUSHJ P,CHRCT
06900 SUBI A,MAGNO
07000 CAML AR1,A
07100 JRST SPR4(R)
07200 SPR3: POP P,A
07300 MOVE AR2A,-2(P)
07400 SUB P,[XWD 3,3](R)
07500 JRST PRIN1
07600 SPR4: MOVEI A,"("
07700 PUSHJ P,TYO
07800 MOVE A,(P)
07900 PUSHJ P,LENGTH
08000 SUBI A,MAGNO
08100 CAIG A,1
08200 JRST SPR5(R)
08300 MOVE A,(P)
08400 PUSHJ P,LAST
08500 PUSH P,A
08600 PUSHJ P,FLATSIZE
08700 SUBI A,MAGNO
08800 EXCH A,(P)
08900 PUSHJ P,PANL(R)
09000 SUB A,(P)
09100 EXCH A,(P)
09200 MOVE A,-1(P)
09300 PUSHJ P,FLATSIZE
09400 SUBI A,MAGNO
09500 ADDM A,(P)
09600 PUSHJ P,CHRCT
09700 SUBI A,MAGNO
09800 POP P,B
09900 ADDI B,1
10000 CAML B,A
10100 JRST SPR5(R)
10200 SPR41: HLRZ@ A,(P)
10300 PUSHJ P,PRIN1
10400 MOVEI A," "
10500 PUSHJ P,TYO
10600 HRRZ @A,(P)
10700 HRRZ B,(A)
10800 MOVEM A,(P)
10900 JUMPN B,SPR41(R)
11000 PUSHJ P,CHRCT
11100 MOVEI B,-MAGNO(A)
11200 MOVE C,-2(P)
11300 MOVE A,(P)
11400 PUSHJ P,HUNOZ(R)
11500 SPREND: MOVEI A,")"
11600 PUSHJ P,TYO
11700 MOVEI A,0
11800 SPND1: MOVE AR2A,-3(P)
11900 SUB P,[XWD 4,4](R)
12000 POPJ P,
12100
12200 SPR5:
12300 MOVE A,(P)
12400 PUSHJ P,LENGTH
12500 SUBI A,MAGNO
12600 CAIG A,2
12700 JRST SPR6(R)
12800 MOVE A,(P)
12900 PUSHJ P,PANL(R)
13000 MOVE AR1,A
13100 PUSHJ P,CHRCT
13200 SUBI A,MAGNO
13300 CAMG A,AR1
13400 JRST SPR6(R)
13500 HLRZ@ A,(P)
13600 PUSHJ P,PRIN1
13700 PUSH P,[0](R)
13800 CAMN A,PRG(R)
13900 SETOM 0(P)
14000 HLRZ@ A,-1(P)
14100 MOVEI AR1,-5(AR2A)
14200 CAME A,LAMB(R)
14300 MOVEI AR1,2(AR2A)
14400 PUSHJ P,CHRCT
14500 SUBI A,MAGNO
14600 SUB AR1,A
14700 MOVEM AR1,-2(P)
14800 SPRA: HRRZ@ A,-1(P)
14900 HLRZ A,(A)
15000 MOVE B,A
15100 PUSHJ P,ATOM
15200 JUMPE A,SPRA1(R)
15300 MOVEI A," "
15400 PUSHJ P,TYO
15500 JUMPE B,SPRA1(R)
15600 MOVNI B,5
15700 SKIPN 0(P)
15800 SPRA1: MOVEI B,0
15900 ADD B,-2(P)
16000 HRRZ@ A,-1(P)
16100 MOVE C,-3(P)
16200 PUSHJ P,HUNOZ(R)
16300 JUMPE A,SPRA2(R)
16400 HRRZ@ A,-1(P)
16500 HRRZ A,(A)
16600 SPRA3: PUSHJ P,PRIN1
16700 POP P,A
16800 JRST SPREND(R)
16900 SPRA2: HRRZ@ A,-1(P)
17000 MOVEM A,-1(P)
17100 HRRZ A,(A)
17200 JUMPE A,SPRA3+1(R)
17300 PUSHJ P,CHRCT
17400 SUBI A,MAGNO
17500 SUBI A,1(AR2A)
17600 MOVNM A,A
17700 CAML A,-2(P)
17800 PUSHJ P,TERPRI
17900 JRST SPRA(R)
18000 SPR6: PUSHJ P,CHRCT
18100 SUBI A,MAGNO
18200 SUBI A,1(AR2A)
18300 MOVNM A,-1(P)
18400 SPR6B: MOVE B,-1(P)
18500 MOVE A,(P)
18600 MOVE C,-2(P)
18700 PUSHJ P,HUNOZ(R)
18800 JUMPE A,SPR6A(R)
18900 HRRZ@ A,(P)
19000 JRST SPRA3A(R)
19100 SPR6A: HRRZ@ A,(P)
19200 JUMPE A,SPREND(R)
19300 MOVEM A,(P)
19400 PUSHJ P,TERPRI
19500 JRST SPR6B(R)
19600 SPRA3A: PUSHJ P,PRIN1
19700 JRST SPREND(R)
19800
19900 VAR
20000 LIT
20100 EDEND:
20200 DEPHASE
20300 END