perm filename EEE[LSP,BGB] blob
sn#017668 filedate 1972-12-27 generic text, type T, neo UTF8
00100 ;THE ALVINE LISP S-EXPRESSION EDITOR.
00200 EDXX:
00300 BEGIN ALVINE
00400 EDX: JRST ED
00500 JRST RD2 ;RETURN FOR BELL
00600 JRST GRNDEF
00700
00800 MESS: 0
00900
01000 CMER1: ASCII / ? /
01100 MER7: ASCII /*UDI /
01200 MER1: ASCII /*EDR /
01300 MER2: ASCII /*EDN /
01400 MER4: ASCII /*UBP /
01500 MER5: ASCII /*IPF /
01600 MER6: ASCII /*UBP /
01700 MER3: ASCII /*NSM /
01800 MER8: ASCII /*FNF /
01900 LPNAME: ASCII / %LP /
02000 RPNAME: ASCII / %RP /
02100 DT: ASCII / %D /
02200 LMBD: ASCII / LAMBDA /
02300 PRG: ASCII /PROG /
02400 LAMB←LMBD+1
02500 LPS: ASCII / LPS /
02600 RPS: ASCII / RPS /
02700 BAL: ASCII / BAL /
02800 PC: ASCII / % /
02900 STR: ASCII /%STR /
03000 PCL: ASCII /%%%L /
03100 TRC: ASCII / TRACE /
03200 DEF: ASCII / DEFPROP /
03300 GRI: ASCII / GRINDEF /
03400 SPR: ASCII / SPRINT /
03500 ASCII /%DPSPRINT /
03600 DPYSPR←.-1
03700 VALU: ASCII / VALUE /
03800 VALUE←VALU+1
03900 FEXP: ASCII / FEXPR /
04000 FEXPR←FEXP+1
04100 EXPR: ASCII/EXPR /
04200 FSUBA: ASCII / FSUBR /
04300 FSUBR←FSUBA+1
04400 SUBR: ASCII /SUBR /
04500 GLS: ASCII /(FEXPR EXPR VALUE MACRO SPECIAL )/
04600 FLO: ASCII / FLONUM /
04700 FLONUM←FLO+1
04800 FIX: ASCII / FIXNUM /
04900 SETQ: ASCII /SETQ /
05000 QUO: ASCII / QUOTE /
05100 ASCII /NIL /
00100 QUOTE←QUO+1
00200 FIXNUM←FIX+1
00300 DEFPROP←DEF+1
00400 GRINDEF←GRI+1
00500 SPRENT←SPR+1
00600 GLST←FLO-1
00700 TRACE←TRC+1
00800 DEFINE NCONS{XCONS-1}
00100 ED: PUSH P,A
00200 RD1: MOVEI A,TTYI
00300 PUSHJ P,READP1
00400 JUMPE A,RD2A
00500 MOVEM A,@J
00600 JRST RD1
00700
00800 TTYI: ILDB A,J
00900 POPJ P,0
01000
01100 J: POINT 7,MESS
01200
01300 RD2A: MOVE C,SUBR
01400 MOVEI B,SPRINT
01500 MOVE A,SPRENT
01600 PUSHJ P,PUTPROP
01700 MOVEI B,DPSPR
01800 MOVE C,SUBR
01900 MOVE A,DPYSPR
02000 PUSHJ P,PUTPROP
00100 RD2B: MOVE B,GLST
00200 MOVE A,PCL
00300 PUSHJ P,SET
00400 MOVE B,[JRST EDN]
00500 MOVEM B,ED
00600 POP P,A
00100 EDN: JUMPN A,FALSE
00200 MOVEM P,PSAV2#
00300 PUSH P,[0] ;%B
00400 PUSH P,[0] ;SRCH STRNG
00500 PUSH P,[0] ;%STR
00600 PUSH P,[0] ;%1
00700 PUSH P,[0] ;%2
00800 PUSH P,[0] ;%REM
00900 PUSH P,[0] ;%NEW
01000 SETZM BK1#
01100 MOVE A,STR
01200 MOVE B,VALUE
01300 PUSHJ P,GET
01400 JUMPE A,.+4
01500 HRRZ A,(A)
01600 MOVEM A,-6(P)
01700 MOVEM A,-4(P)
01800 MOVE B,VALUE
01900 MOVE A,PCL
02000 PUSHJ P,GET
02100 HRRZ A,(A)
02200 MOVEM A,GLST
02300 MOVEM P,PSAV1
02400 RD2:
02500 PUSHJ P,TERPRI
02600 RD3: SETZM OLDCH
02700 PUSHJ P,TYI
02800 CAIN A,"↑"
02900 JRST UPARR
03000 CAIE A,12
03100 CAIN A,15
03200 JRST RD3
03300 CAIN A,175 ;ALTMODE
03400 JRST RD3
03500 CAIN A,"G"
03600 JRST ED1
03700 CAIN A,"P"
03800 JRST ED2
03900 CAIN A,"Q"
04000 JRST ED2X
04100 CAIN A,"B"
04200 JRST ED5
04300 CAIN A,"W"
04400 JRST ED14
04500 CAIN A,"A"
04600 JRST ED4
04700 CAIN A,"V"
04800 JRST ED13
04900 CAIN A,"U"
05000 JRST ED16
05100 CAIN A,"F"
05200 JRST ED9
00100 MOVEI B,1
00200 MOVEM B,CNT#
00300 DSP1: CAIN A,"S"
00400 JRST ED10
00500 CAIN A,"I"
00600 JRST ED8
00700 CAIN A,"R"
00800 JRST ED3
00900 CAIN A,"M"
01000 JRST ED15
01100 CAIN A,"E"
01200 JRST EDEX
01300 CAIN A,"D"
01400 JRST EDDL
01500 CAIN A,">"
01600 JRST ED11
01700 CAIN A,"<"
01800 JRST ED12
01900 CAIN A,"C"
02000 JRST SPC
02100 CAIG A,"9"
02200 CAIGE A,"0"
02300 JRST ER1
02400 JRST NMB
02500
02600 ER1: MOVE A,CMER1
02700 PUSHJ P,PRINT
02800 JRST RD2
02900
03000 SPC: MOVE A,CNT ;C - COUNT
03100 MOVEM A,PCNT
03200 JRST RD2
03300 PCNT: 3
03400 NMB: SETZM CNT
03500 NM1: SUBI A,"0"
03600 MOVE B,CNT
03700 MULI B,12
03800 ADD A,C
03900 MOVEM A,CNT
04000 PUSHJ P,TYI
04100 CAIG A,"9"
04200 CAIGE A,"0"
04300 JRST DSP1
04400 JRST NM1
04500
04600
04700 ERED1: MOVE A,MER7
04800 JRST ER1+1
04900
05000 UPARR: SETZM PSAV1
05100 MOVE P,PSAV2
05200 JRST FALSE
05300
05400 ED1: PUSHJ P,READ ;G - GET
05500 JUMPE A,RD2
05600 PUSH P,A
05700 MOVE B,TRACE
05800 PUSHJ P,GET
05900 JUMPE A,ED1D
06000 HRRZ A,(A)
06100 MOVEM A,(P)
06200 ED1D: MOVE A,(P)
06300 MOVE B,GLST
06400 PUSHJ P,GETL
06500 JUMPE A,ERED1
06600 HRRZ C,(A)
06700 HLRZ A,(A)
00100 CAME A,VALUE
00200 JRST ED1B
00300 HLRZ A,(C)
00400 HRRZ A,(A)
00500 PUSHJ P,NCONS
00600 MOVE B,QUOTE
00700 PUSHJ P,XCONS
00800 PUSHJ P,NCONS
00900 POP P,B
01000 PUSHJ P,XCONS
01100 MOVE B,SETQ
01200 JRST ED1C
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
01900 ED1C: PUSHJ P,XCONS
02000 PUSHJ P,MKLPRP
02100 ED1A: MOVEM A,-4(P)
02200 MOVEM A,-6(P)
02300 SETZM BK1
02400 MOVE B,A
02500 MOVE A,STR
02600 PUSHJ P,SET
02700 JRST RD2
02800
00100 ED2X: MOVE A,-4(P) ;Q -- PUT ON ORIGINAL NAME
00200 HRRZ A,(A)
00300 HRRZ A,(A)
00400 HLRZ A,(A)
00500 JRST ED2+1
00600
00700 ED2: PUSHJ P,READ
00800 PUSH P,A ;P -- PUT
00900 MOVE B,TRACE
01000 PUSHJ P,GET
01100 JUMPE A,ED2A
01200 HRRZ A,(A)
01300 MOVEM A,(P)
01400 ED2A: MOVE A,-5(P)
01500 PUSHJ P,UNMK
01600 JUMPE A,RD2
01700 HRRZ B,(A)
01800 POP P,C
01900 HRLM C,(B)
02000 PUSHJ P,EVAL
02100 JRST RD2
02200
02300 ED3A: SETZM -2(P)
02400 JRST EDB
02500
02600 ED3R: MOVE C,T
02700 JUMPN C,ED3R2
02800 MOVE A,(P)
02900 JRST ED1A
03000
03100 ED3R2: CAME T,BK1
03200 JRST ED3R1
03300 MOVE B,(P)
03400 MOVEM B,-6(P)
03500 JRST ED3R3
03600
03700 ED8A: SKIPE RSW#
03800 JRST ER1
03900 PUSHJ P,EDREAD
04000 MOVE B,-6(P)
04100 ED85: PUSHJ P,.NCONC
04200 MOVEM A,-6(P)
04300 SOSLE CNT
04400 JRST EDB1
04500 SKIPN BK1
04600 JRST ED1A
04700 HRRM A,@BK1
04800 JRST RD2
04900
05000 EDB1: MOVE A,(P)
05100 JRST EDB
05200
05300 EDE1: HRRM A,-4(P)
05400 JRST ED1A+2
05500 ED8C: SKIPE RSW
05600 JRST ER1
05700 PUSHJ P,EDREAD
05800 JRST ED1A
00100 ED8: TDZA C,C ;I - INSERT
00200 ED3: SETOM C ;R - REPLACE
00300 MOVEM C,RSW
00400 SETZM NEWFLG#
00500 PUSHJ P,EDREAD
00600 JUMPE A,ED8A
00700 MOVEM A,-3(P)
00800 HLRZ A,(A)
00900 CAMN A,PC
01000 JRST ED8C
01100 PUSHJ P,EDREAD
01200 JUMPN A,ED3A
01300 PUSHJ P,EDREAD
01400 MOVEM A,-2(P)
01500 PUSHJ P,EDREAD
01600
01700 EDB: MOVEM A,(P)
01800 MOVEM A,LNEW#
01900 HRRZ A,(A)
02000 JUMPN A,.-2
02100
02200 HLRZ@ A,(P)
02300 CAMN A,PC
02400 ED3N: SETOM NEWFLG
02500 MOVE A,-6(P)
02600 MOVE B,-3(P)
02700 MOVE T,BK1
02800 PUSHJ P,SRCH
02900 JUMPE A,ED33
03000 MOVE B,-2(P)
03100 JUMPE B,ED31
03200 MOVEM T,BK2#
03300 PUSHJ P,SRCH
03400 JUMPE A,ED34
03500 MOVE T,BK2
03600 ED31: SKIPE NEWFLG
03700 JRST ED32
03800 HRRM@ A,LNEW
03900 ED34: MOVE C,BK3
04000 SKIPE RSW
04100 JRST ED3R
04200 ED3R1: MOVE B,(P)
04300 ED3R3: HRRM B,@C
04400 JRST RD2
04500 ED32: JUMPE T,ED1A
04600 HRRM A,@T
04700 JRST RD2
04800 ED33: SKIPE -2(P)
04900 JRST SER1
05000 SKIPN NEWFLG
05100 JRST ED34
05200 HRRZ T,(T)
05300 MOVEM T,BK3
05400 JRST ED37
05500
00100 ED4: MOVE A,-4(P) ;A - ALL
00200 PUSH P,A
00300 PUSHJ P,TERPRI
00400 POP P,A
00500 PUSHJ P,EDGRIN
00600 JRST RD2
00700
00800 EDDL: MOVE A,-6(P) ;D - DELETE
00900 MOVEM A,BK3
01000 HRRZ A,(A)
01100 JUMPE A,EDDL2
01200 SOSLE CNT
01300 JRST EDDL+1
01400 EDDL1: PUSH P,A
01500 PUSHJ P,PRINTC
01600 POP P,A
01700 JRST ED85+1
01800
00100 ED5: MOVE A,-4(P) ;B - BALANCED
00200 PUSHJ P,PARSRCH
00300 CAMN A,B
00400 JRST ED51
00500 PUSH P,B
00600 ADDI A,MAGNO
00700 PUSHJ P,PRINT
00800 MOVE A,LPS
00900 PUSHJ P,PRIN1
01000 POP P,A
01100 ADDI A,MAGNO
01200 PUSHJ P,PRINT
01300 MOVE A,RPS
01400 PUSHJ P,PRIN1
01500 JRST RD2
01600 ED51: MOVE A,BAL
01700 JRST ED51-2
01800
01900 EDDL2: MOVEI A,07
02000 PUSHJ P,TYO
02100 SKIPN BK1
02200 JRST ER1
02300 MOVE A,-6(P)
02400 MOVEM A,BK3
02500 MOVE A,-4(P)
02600 HRRZ C,(A)
02700 CAMN C,BK3
02800 JRST ED37B
02900 JUMPE C,RD2
03000 TDZA AR1,AR1
03100 ED37: SETOM AR1
03200 MOVE A,-4(P)
03300 MOVEM A,BK2
03400 HRRZ A,(A)
03500 HRRZ C,(A)
03600 CAME C,BK3
03700 JRST .-4
03800 ED37A: HLRM A,(A)
03900 JUMPN AR1,RD2
04000 MOVEM A,-6(P)
04100 PUSHJ P,PRINTC
04200 MOVE A,BK2
04300 MOVEM A,BK1
04400 JRST RD2
04500
04600 ED37B: HLRM A,(A)
04700 JRST ED1A
04800
04900
05000 ED11: MOVE A,-6(P) ;> - RIGHT
05100 MOVE B,CNT
05200 SKIPN B
05300 MOVEI B,7777
05400 MOVEM A,C
05500 HRRZ A,(A)
05600 JUMPE A,ED11A
05700 MOVEM A,-6(P)
05800 MOVEM C,BK1
05900 SOJG B,.-5
06000 JRST ED11B
06100 ED11A: MOVEI A,07
06200 PUSHJ P,TYO
06300 JRST RD2
06400
06500 ED11B:
06600 PUSHJ P,PRINTC
06700 JRST RD2
06800
06900 ED12: SETZM C ;< - LEFT
07000 SKIPN CNT
07100 JRST ED12C
07200 MOVE A,-4(P)
07300 ED12A: CAMN A,-6(P)
07400 JRST ED12B
07500 AOS C
07600 HRRZ A,(A)
07700 JUMPN A,ED12A
07800 JRST ERR3
07900 ED12B: MOVE A,CNT
08000 SUBM A,C
08100 SKIPL C
08200 JRST ED12C
08300 MOVE A,-4(P)
08400 MOVEM A,BK1
08500 HRRZ A,(A)
08600 AOJL C,.-2
08700 MOVEM A,-6(P)
08800 JRST ED12D
08900 ED12C: MOVEI A,07
09000 PUSHJ P,TYO
09100 MOVE A,-4(P)
09200 MOVEM A,-6(P)
09300 SETZM BK1
09400 ED12D: PUSHJ P,PRINTC
09500 JRST RD2
09600
09700 ED14: MOVE A,-6(P) ;W - WHERE
09800 JRST ED12D
09900
10000 ERR3: MOVE A,MER1
10100 JRST ER1+1
10200
00100 ED10: PUSHJ P,EDREAD ;S - SEARCH
00200 SKIPN A
00300 MOVE A,-5(P)
00400 MOVEM A,-5(P)
00500 MOVE B,A
00600 MOVE A,-6(P)
00700 MOVE T,BK1
00800 ED10C: PUSHJ P,SRCH1
00900 JUMPE A,ED10B
01000 MOVEM A,-6(P)
01100 MOVE B,BK3
01200 MOVEM B,BK1
01300 SOSG CNT
01400 JRST ED10D
01500 MOVE B,-5(P)
01600 JRST ED10C
01700 ED10B: MOVEI A,07
01800 PUSHJ P,TYO
01900 ED10D: MOVE A,-6(P)
02000 PUSHJ P,PRINTC
02100 JRST RD2
02200
00100 ;SRCH RETURNS END IN A
00200 ;SETS T AND BK3
00300 ;STARTS WITH STRING IN A
00400 ;AND SEARCH-STRING IN B
00500 ;STRING-1 IN T
00600 ;SRCH1 RETURNS 0 IN A IF NOT FOUND,SRCH CALL ERROR
00700
00800 SRCH1: TDZA AR2A,AR2A
00900 SRCH: SETOM AR2A
01000 MOVEM B,STRB#
01100
01200 SR1: HLRZ AR1,(B)
01300 HLRZ C,(A)
01400 CAMN AR1,C
01500 JRST SR2
01600 PUSHJ P,SRNUM
01700 MOVEM A,T
01800 HRRZ A,(A)
01900 JUMPN A,SR1+1
02000 SR3: SKIPN AR2A
02100 POPJ P,
02200 POP P,A
02300 SER1: MOVE A,MER3
02400 JRST ER1+1
02500
02600 SR2: MOVEM A,BK3#
02700 HRRZ A,(A)
02800 HRRZ B,(B)
02900 JUMPE A,SR4
03000 SKIPN B
03100 POPJ P,
03200 HLRZ C,(A)
03300 HLRZ AR1,(B)
03400 CAMN C,AR1
03500 JRST SR2
03600 PUSHJ P,SRNUM
03700 MOVE T,BK3
03800 MOVE B,STRB
03900 JRST SR1
04000
04100 SR4: JUMPN B,SR3
04200 POPJ P,
04300 EDEX1: MOVE A,-7(P)
04400
04500
04600 HLRZ B,(A)
04700 CAMN B,LPNAME
04800 JRST ED15B
04900 CAME B,RPNAME
05000 CAMN B,DT
05100 JRST ED15A-1
05200 POPJ P,0
05300
00100 ED15: PUSHJ P,EDEX1 ;M - MATCH
00200 ED15D: MOVEM A,B
00300 HRRZ A,(A)
00400 JUMPE A,ED15A
00500 MOVEM B,BK1
00600 MOVEM A,-6(P)
00700 SOSLE CNT
00800 JRST ED15
00900 PUSHJ P,PRINTC
01000 JRST RD2
01100
01200 ED15B: SETZM AR1
01300 ED15C: AOS AR1
01400 ED15E: HRRZ A,(A)
01500 JUMPE A,ED15A-1
01600 HLRZ B,(A)
01700 CAMN B,LPNAME
01800 JRST ED15C
01900 CAMN B,RPNAME
02000 SOJE AR1,ED15-1
02100 JRST ED15E
02200 POP P,A
02300 ED15A: MOVEI A,07
02400 PUSHJ P,TYO
02500 JRST RD2
02600
00100 ED13: MOVE A,-6(P) ;V - VOMIT
00200 PUSHJ P,PARSRCH
00300 MOVE A,-6(P)
00400 CAMGE B,AR1
00500 JRST ED4+1
00600 HLRZ B,(A)
00700 CAME B,LPNAME
00800 JRST ED4+1
00900 HRRZ@ A,-6(P)
01000 MOVEM A,AR2A
01100 PUSHJ P,UNMK1
01200 OPDEF CALLF [36B8]
01300 CALLF 1,@DPYSPR
01400 JRST RD2
01500
01600 DPSPR: MOVEI C,0
01700 MOVEI B,2
01800 PUSHJ P,SPRNT2
01900 JRST TERPRI
02000
02100 UNER1A:
02200 UNER1B: MOVE A,MER2
02300 JRST EDGER+1
02400
02500 MOVEM A,-6(P)
02600 EDEX: PUSHJ P,EDEX1 ;E - EXPLUGE
02700 HRRZ A,(A)
02800 JUMPE A,ED15A
02900 SOSLE CNT
03000 JRST EDEX-1
03100 JRST EDDL1
03200
03300 UNMK1: PUSHJ P,EDGET
03400 CAMN A,LPNAME
03500 JRST UN3
03600 CAMN A,RPNAME
03700 JRST UN2
03800 CAMN A,DT
03900 JRST UN1
04000 PUSH P,A
04100 PUSHJ P,UNMK1
04200 POP P,B
04300 PUSHJ P,XCONS
04400 POPJ P,
04500 UN1: PUSHJ P,EDGET
04600 CAMN A,LPNAME
04700 JRST UN4
04800 CAME A,RPNAME
04900 CAMN A,DT
05000 JRST UNER1A
05100 UN5: PUSH P,A
05200 PUSHJ P,EDGET
05300 CAME A,RPNAME
05400 JRST UNER1B
05500 POP P,A
05600 POPJ P,0
05700 UN3: PUSHJ P,UNMK1
05800 PUSH P,A
05900 PUSHJ P,UNMK1
06000 POP P,B
06100 PUSHJ P,XCONS
06200 POPJ P,
06300 UN2: SETZM A
06400 POPJ P,
06500 UN4: PUSHJ P,UNMK1
06600 JRST UN5
06700
06800
06900 EDGET: SKIPN AR2A
07000 JRST EDGER
07100 HLRZ A,(AR2A)
07200 HRRZ AR2A,(AR2A)
07300 POPJ P,
07400 EDGER: MOVE A,MER4
07500 PUSHJ P,PRINT
07600 MOVE P,PSAV
07700 SUB P,[XWD 2,2]
07800 JRST RD2
07900
08000 CNT1: 0
08100
00100 PRINTC: PUSH P,A
00200 PUSHJ P,TERPRI
00300 POP P,A
00400 MOVE C,PCNT
00500 MOVEM C,CNT1
00600 JUMPE A,PRN3
00700 PRN1: PUSH P,A
00800 SETZM AR1
00900 HLRZ A,(A)
01000 CAMN A,LPNAME
01100 MOVEI AR1,"("
01200 CAMN A,RPNAME
01300 MOVEI AR1,")"
01400 CAMN A,DT
01500 MOVEI AR1,"."
01600 SKIPE AR1
01700 JRST PRN2
01800 PUSHJ P,PRIN1
01900 MOVEI AR1," "
02000 PRN2: MOVE A,AR1
02100 PUSHJ P,TYO
02200 POP P,A
02300 HRRZ A,(A)
02400 SOSLE CNT1
02500 JUMPN A,PRN1
02600 PRN3: POPJ P,
02700
00100 ED9: PUSHJ P,READ ;F - FILE
00200 PUSH P,A
00300 PUSHJ P,READ
00400 PUSH P,A
00500 PUSHJ P,READ
00600 PUSHJ P,NCONS
00700 POP P,B
00800 PUSHJ P,XCONS
00900 PUSHJ P,OUTPUT
01000 PUSHJ P,OUTC
01100 MOVE A,(P)
01200 PUSHJ P,ATOM
01300 JUMPE A,ED9A
01400 MOVE B,VALUE
01500 MOVE A,(P)
01600 PUSHJ P,GET
01700 HRRZ A,(A)
01800 JRST .+2
01900 ED9A: POP P,A
02000 PUSHJ P,GRNDEF
02100 MOVEI A,0
02200 MOVEI B,1
02300 PUSHJ P,OUTC
02400 JRST RD2
02500
02600 EDGRIN: MOVEI C,7777
02700 JRST PRN1-2
02800
02900 PARSRCH: SETZB AR1,B
03000 PAR1: HLRZ C,(A)
03100 CAMN C,LPNAME
03200 AOS AR1
03300 CAMN C,RPNAME
03400 AOS B
03500 HRRZ A,(A)
03600 JUMPN A,PAR1
03700 MOVE A,AR1
03800 POPJ P,
03900
04000
04100 MKLPRP1: PUSH P,[0] ;A
04200 PUSH P,A ;X,B
04300 PUSHJ P,ATOM
04400 JUMPN A,MLP1
04500 MOVE A,LPNAME
04600 PUSHJ P,NCONS
04700 MOVEM A,-1(P)
04800 L1: HLRZ@ A,(P)
04900 PUSHJ P,MKLPRP1
05000 MOVE B,A
05100 MOVE A,-1(P)
05200 PUSHJ P,.NCONC
05300 MOVEM A,-1(P)
05400 HRRZ@ A,(P)
05500 JUMPE A,MLP2
05600 PUSHJ P,ATOM
05700 JUMPN A,MLP3
05800 HRRZ@ A,(P)
05900 MOVEM A,(P)
06000 JRST L1
06100 MLP1: POP P,A
06200 PUSHJ P,NCONS
06300 MOVE B,A
06400 POP P,A
06500 PUSHJ P,.NCONC
06600 POPJ P,0
06700 MLP2: MOVE A,RPNAME
06800 PUSHJ P,NCONS
06900 MLP4: POP P,B
07000 MOVE B,A
07100 POP P,A
07200 JRST .NCONC
07300 MLP3: MOVE A,RPNAME
07400 PUSHJ P,NCONS
07500 HRRZ@ B,(P)
07600 PUSHJ P,XCONS
07700 MOVE B,DT
07800 PUSHJ P,XCONS
07900 JRST MLP4
08000
08100 PSAV: 0
08200 UNMK: MOVEM P,PSAV
08300 HLRZ B,(A)
08400 CAME B,LPNAME
08500 JRST UNER1
08600 HRRZ A,(A)
08700 MOVEM A,AR2A
08800 PUSHJ P,UNMK1
08900 SKIPE AR2A
09000 JRST UNER2
09100 POPJ P,
09200
09300 UNER1: MOVE A,MER5
09400 PUSHJ P,PRINT
09500 MOVE P,PSAV1
09600 JRST RD2
09700 UNER2: MOVE A,MER6
09800 JRST UNER1+1
09900
10000 .NCONC: MOVNI 6,2
10100 PUSH P,A
10200 PUSH P,B
10300 JRST NCONC
10400
00100 ED16: PUSHJ P,READ ;U - UNFILE
00200 PUSH P,A
00300 PUSHJ P,READ
00400 PUSH P,A
00500 PUSHJ P,READ
00600 PUSHJ P,NCONS
00700 POP P,B
00800 PUSHJ P,XCONS
00900 PUSHJ P,INPUT
01000 PUSHJ P,INC
01100 MOVE A,(P)
01200 PUSHJ P,ATOM
01300 JUMPE A,ED16A
01400 MOVE B,VALUE
01500 MOVE A,(P)
01600 PUSHJ P,GET
01700 HRRZ A,(A)
01800 ED16D: MOVEM A,(P)
01900 ED16A: PUSHJ P,READ
02000 MOVE T,A
02100 PUSHJ P,ATOM
02200 JUMPN A,ED16A
02300 HRRZ A,(T)
02400 HLRZ A,(A)
02500 SKIPE B,(P)
02600 PUSHJ P,MEMQ
02700 JUMPE A,ED16A
02800 MOVE A,T
02900 PUSHJ P,EVAL
03000 SKIPE (P)
03100 PUSHJ P,PRINT
03200 JRST ED16A
03300 JRST ER1+1
00100 SRNUM: CAIGE C,INUMIN ;NUMBER COMPARES
00200 CAIL AR1,INUMIN
00300 POPJ P,
00400 HRRZ C,(C)
00500 HLRZ TT,(C)
00600 CAME TT,FIXNUM
00700 CAMN TT,FLONUM
00800 SKIPA D,(AR1)
00900 POPJ P,0
01000 HLRZ S,(D)
01100 CAME TT,S
01200 POPJ P,0
01300 HRRZ C,(C)
01400 HRRZ D,(D)
01500 MOVE D,(D)
01600 MOVE C,(C)
01700 CAME D,C
01800 POPJ P,0
01900 POP P,TT
02000 JRST SR2
02100 EXTERN OLDCH,LINL,CHCT
02200
02300 EDRD1: SETZB A,...FLG
02400 POPJ P,0
02500 ...FLG: 0
02600 EDREAD: SKIPE ...FLG
02700 JRST EDRD1
02800 PUSHJ P,READ1
02900 JUMPL A,.-1
03000 POPJ P,0
03100
03200 READ1: PUSHJ P,RATOM
03300 JRST READ1A
03400 READ2: ADDI B,
03500 XCT EDTAB(B)
03600 READ1A: PUSH P,A
03700 PUSHJ P,READ1
03800 READ3: POP P,B
03900 JUMPL A,READ1 ;RUBOUT
04000 JRST XCONS
04100
04200 EDTAB: MOVE A,LPNAME ;0 (
04300 MOVE A,RPNAME ;1 )
04400 MOVE A,LPNAME ;2 [
04500 JRST READ4 ;3 ],$
04600 JRST EDRD3 ;4 .
04700 SKIP
04800 SETOM A ;6 RUBOUT
04900 POPJ P,
05000
05100 READ4: CAIN A,175
05200 JRST FALSE ;ALTMODE
05300 MOVE A,RPNAME
05400 JRST READ1A
05500
05600 EDRD5: SUB P,[XWD 2,2]
05700 JRST EDRD32
05800
05900 EDRD4: SUB P,[XWD 2,2]
06000 JRST READ1
06100
06200 EDRD3: PUSH P,DT
06300 PUSH P,[READ3]
06400 ADDM R,(P)
06500 EDRD32: PUSHJ P,RATOM
06600 JRST READ1A ;ATOM
06700 CAIN A,177
06800 JRST EDRD4 ;RUBOUT
06900 CAIE A,"."
07000 JRST READ2
07100 PUSH P,DT
07200 PUSH P,[READ3]
07300 ADDM R,(P)
07400 PUSHJ P,RATOM
07500 JRST READ1A ;ATOM
07600 CAIN A,177
07700 JRST EDRD5 ;RUBOUT
07800 CAIE A,"."
07900 JRST READ2
08000 SUB P,[XWD 4,4]
08100 MOVEM A,...FLG
08200 FALSE: MOVEI A,0
08300 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
00900 HRRZ@ A,(P)
01000 PUSHJ P,ATOM
01100 JUMPE A,PNL1
01200 PNL3: MOVEI A,15
01300 EXCH A,(P)
01400 JRST PNL2
01500
01600 PNL1: HRRZ A,@(P)
01700 HLRZ A,(A)
01800 PUSHJ P,PANL
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
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
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
04600 PUSHJ P,ATOM
04700 JUMPN A,HUNZ2
04800 MOVEI C,0
04900 HUNZ3: MOVE B,-1(P)
05000 MOVE A,S
05100 PUSHJ P,SPRNT2
05200 POP P,A
05300 JUMPE A,HUNZ4
05400 PUSHJ P,ATOM
05500 JUMPE A,HUNZ4
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]
06300 EXIT: POPJ P,
06400 GR1: 0
06500
06600 GRN1: POP P,B
06700 HRRZ B,(B)
06800 JUMPN B,GRN2
06900 POP P,A
07000 SKIPE GR1
07100 JRST GRN4
07200 GRN5: HRRZ A,(A)
07300 JUMPE A,TERPRI
07400
07500 GRNDEF: SETZM GR1
07600 PUSH P,A
07700 MOVE B,TRACE
07800 HLRZ A,(A)
07900 PUSHJ P,GET
08000 JUMPE A,GRN2-1
08100 HLRZ@ AR1,(P)
08200 HRRZ B,(AR1)
08300 PUSH SP,B
08400 HRRZ A,(A)
08500 MOVE B,GLST
08600 PUSHJ P,GETL
08700 HRRM A,(AR1)
08800 HRRZ C,(A)
08900 MOVEM C,GR1
09000 HLRZ D,D
09100 HRRZ D,(D)
09200 HRRZ D,(D)
09300 HRRZ D,(D)
09400 HRRM D,(C)
09500 MOVE B,GLST
09600 GRN2: HLRZ@ A,(P)
09700 PUSH P,B
09800 HLRZ B,(B)
09900 PUSHJ P,GET
10000 JUMPE A,GRN1
10100 PUSH P,A
10200 PUSHJ P,ATOM
10300 JUMPN A,GRNFOO
10400 POP P,A
10500 HRRZ B,(A)
10600 CAIN B,UNBOUND
10700 JRST GRN1
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
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
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
13300 MOVEI A,")"
13400 PUSHJ P,TYO
13500 JRST GRN1
13600 GRN4: POP SP,B
13700 HLRZ C,(A)
13800 HRRM B,(C)
13900 HRRZ C,GR1
14000 HLRM C,(C)
14100 JRST GRN5
00100 TAB: SKIPN %%TBFLG#
00200 JRST TYO
00300 MOVEI A,40
00400 MOVEI B,10
00500 PUSHJ P,TYO
00600 SOJG B,.-1
00700 POPJ P,
00800
00900 PPOS: SUBI A,MAGNO
01000 PUSHJ P,SPR1+1
01100 MOVEI A,0
01200 POPJ P,
01300
01400 SPRINT: SUBI B,MAGNO
01500 SUBI C,MAGNO
01600 JRST SPRNT2
01700
01800 SPR1: SOS A,-2(P)
01900 PUSH P,A
02000 PUSH P,A
02100 CAIGE A,1
02200 JRST PPL1
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
03200 MOVEI A,11
03300 PUSHJ P,TAB
03400 JRST PPL2
03500
03600 PPL3: SUBI A,10
03700 SUB A,-1(P)
03800 MOVNM A,(P)
03900 PPL4: SOSGE (P)
04000 JRST PPL5
04100 MOVEI A," "
04200 PUSHJ P,TYO
04300 JRST PPL4
04400
04500 PPL5: SUB P,[XWD 2,2]
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
06000 MOVE A,(P)
06100 PUSHJ P,ATOM
06200 JUMPN A,SPR3
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
07200 SPR3: POP P,A
07300 MOVE AR2A,-2(P)
07400 SUB P,[XWD 3,3]
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
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
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
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
11000 PUSHJ P,CHRCT
11100 MOVEI B,-MAGNO(A)
11200 MOVE C,-2(P)
11300 MOVE A,(P)
11400 PUSHJ P,HUNOZ
11500 SPREND: MOVEI A,")"
11600 PUSHJ P,TYO
11700 MOVEI A,0
11800 SPND1: MOVE AR2A,-3(P)
11900 SUB P,[XWD 4,4]
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
12800 MOVE A,(P)
12900 PUSHJ P,PANL
13000 MOVE AR1,A
13100 PUSHJ P,CHRCT
13200 SUBI A,MAGNO
13300 CAMG A,AR1
13400 JRST SPR6
13500 HLRZ@ A,(P)
13600 PUSHJ P,PRIN1
13700 PUSH P,[0]
13800 CAMN A,PRG
13900 SETOM 0(P)
14000 HLRZ@ A,-1(P)
14100 MOVEI AR1,-5(AR2A)
14200 CAME A,LAMB
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
15300 MOVEI A," "
15400 PUSHJ P,TYO
15500 JUMPE B,SPRA1
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
16300 JUMPE A,SPRA2
16400 HRRZ@ A,-1(P)
16500 HRRZ A,(A)
16600 SPRA3: PUSHJ P,PRIN1
16700 POP P,A
16800 JRST SPREND
16900 SPRA2: HRRZ@ A,-1(P)
17000 MOVEM A,-1(P)
17100 HRRZ A,(A)
17200 JUMPE A,SPRA3+1
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
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
18800 JUMPE A,SPR6A
18900 HRRZ@ A,(P)
19000 JRST SPRA3A
19100 SPR6A: HRRZ@ A,(P)
19200 JUMPE A,SPREND
19300 MOVEM A,(P)
19400 PUSHJ P,TERPRI
19500 JRST SPR6B
19600 SPRA3A: PUSHJ P,PRIN1
19700 JRST SPREND
19800
19900 VAR
20000 LIT
20100 EDEND:
20300 BEND