//ECCE for PDP-8    Contributed by Hamish Dewar    FEB 2002
// The source of this stand-alone program has been keyed in
// from a listing which is hand-dated 4/5/73;
// I do not recall when the program was actually written.
// My apologies for any typos.
// I have resisted the temptation to add to or clarify the comments.
//
// The PDP-8 was a 'scientific' mini-computer produced by DEC
// (Digital Equipment Corporation) in the 1960s.
// The store comprised 4k of 12-bit words,
// organised as pages of 128 words.
// Memory addressing was to current page or global page (page 0).
// Assemblers generally handled literal and off-page references
// by planting literals downwards from the end of the current page.
// The minimal instruction set was very ingenious.
// Programming practice was to keep the Accumulator clear (zero)
// except when it contained a live operand.
// This allowed the TAD instruction to serve both as an Add
// and as a Load, and the DCA instruction to serve both as a Deposit
// and a Clear.
//
/ECCE FOR PDP-8

/VARIANT INSTRUCTIONS
INC=ISZ                     /WHEN NO SKIP POSSIBLE
SET=ISZ                     /DITTO, JUST TO SET NON-ZERO
CLR=DCA                     /WHEN AC ZERO
SNAC=SNA CLA
SZAC=SZA CLA
SPAC=SPA CLA
SMAC=SMA CLA

/CHARACTER VALUES (ASCII)
/NEWLINE IS REPRESENTED AS ZERO
CR=15
LF=12
CAN=177
CANECH=134
DEL=177
LB=50
RB=51
COMMA=54
COLON=72
SEMI=73
GTSIGN=76
MINUS=55
QUOTE=47
HASH=43
PERCNT=45
QUERY=77
ARROW=136
C=103
H=110
P=120
R=122

/PARAMETERS
CSLOTS=40                   /COMMAND CODE SLOTS (32)
SSIZE=120                   /STRING BUFF SIZE (80)
MAXLIN=121                  /MAX LINE (81)
TOP=FREE                    /MAIN FILE BUFFER
BOT=7577                    /REST OF STORE
STOP=-3777                  /LOOP STOP

*1
/INTERRUPT
    DCA AC; RAL; DCA LINK
    JMP I RI
AC,  0
LINK, 0

*10
/AUTOINDEX VARIABLES
RA, 0
CA, 0
SA, 0
WA, 0

*20
/DEVICE CASCADE
RI, RH3; JMP DIS; JMS RI
    JMP I PI
PI, .+3; JMP DIS; JMS PI
    JMP I TI
TI, .+3; JMP DIS; JMS TI
    KRB; AND (177; DCA KK
    JMP I KI
KI, .+3; JMP TI+2; JMS KI
/DISMISS (OK IF AC#0)
DIS,CLL CLA; TAD LINK
    RAR; TAD AC
    ION
    JMP I 0

/PAGE ZERO VARIABLES
KK,0                        /KB INPUT SYMBOL
KP1, TTBUFF                 /KB EXTRACT POINTER
PROMPT, 0                   /PROMPT SYM
TK, LF                      /PENDING LINE FEED
RFLIP, 0                    /READER FLIP-FLOP
RSTAT, -1                   /READER STATUS
UP, 0                       /UP-ARROW (OR ZERO)
WC, 0                       /WORD COUNT (GENERAL)
WL, 0                       /WORKING LOCATION
FLIP, 0                     /FLIP-FLOP
SYM, 0                      /COMMAND SYMBOL
TYPAD, 0                    /COMMAND CODE TYPE AD
CODE, 0                     /COMMAND CODE
TXT, 0                      /TEXT STRING AD (USUALLY)
NUM, 0                      /REPETITION NUM
CHAIN, 0
MS, 0                       /MATCH START (NEG)
ML, 0                       /MATCH LIM
PP, LBEG                    /PREVIOUS SYM POINTER
FP, LMID                    /FILE POINTER
BP1, TOP                    /MAIN BUFF POINTERS
BP2, BOT
ENDED, 0                    /'FP AT END' INDIC
/ENTRY POINTS
KSYMI, KSYM
SKIPI, SKIP
TSYMI, TSYM
RSYMI, RSYM
PSYMI, PSYM
STARTI, START

/SR TO COMPUTE PARITY BIT
PARBIT, 0
PB1, CLL RAR; SNL SZA; JMP PB1
    SNA; JMP PB2
    CLL RAR; CML
    JMP PB1+1
PB2,SZL; TAD (200
    JMP I PARBIT

*200
    JMP I STARTI
/KEYBOARD HANDLER
/IF KH IS LOCKED, I/O IS IN PROGRESS
/IF KP1 CELL IS >= 0, DATA IS AVAILABLE
/IF NEITHER, HANDLER IS IDLE
KBE=TTBUFF+114
KP2, TTBUFF+1               /KB INSERT POINTER
KC, 0                       /KB COUNT (AFTER LF)
KH, 0
    TAD I KP1               /SYM AVAILABLE?
    SPA; JMP K0             /NO -> START UP
    DCA AC                  /RETURN SYM
    INC KP1
    ISZ KC; CLR KH          /UNLOCK UNLESS KC OUT
    JMP DIS
K0, DCA AC                  /RETURN NEG
    SET TH                  /LOCK TP HANDLER
    TAD (TTBUFF+1; DCA KP1  /SET KB POINTERS
    TAD (TTBUFF+1; DCA KP2
    TAD TK; JMS TYPE        /LF
    TAD PROMPT
K1, JMS TYPE
K2, TAD KP2; TAD (-KBE      /BUFF FULL?
    SMAC; JMP K9            /YES ->
    CLR I KP2               /NL (DEFAULT)
K3, JMS KI                  /WAIT FOR FLAG
    TAD KK; SNA; JMP K3     /NULL ->
    TAD (-CAN; SNAC; JMP K6 /CANCEL (DEL) ->
    TAD KK; JMS TYPE        /DUPLEX
    TAD KK
    TAD (-LF; SNA; JMP K7   /LINE FEED ->
    TAD (LF-CR; SNAC; JMP K8 /CARRIAGE RETURN
    TAD KK; DCA I KP2       /STORE IN BUFFER
K5, INC KP2
    JMP K2
/CANCEL LAST CHARACTER
K6, STA; TAD KP2; DCA KP2   /BACK OFF
    TAD I KP2               /BEYOND START?
    SPA SNAC; JMP K5        /YES -> RESTORE
    TAD (CANECH
    JMP K1
/LINE FEED: RELEASE LINE, CONTINUE
K7, TAD KP2; CMA; TAD KP1   /SYM COUNT (NEG)
    DCA KC
    CLR KH                  /UNLOCK
    JMP K5
/CARRIAGE RETURN: RELEASE LINE, EXIT
K8, INC KP2
/+ BUFFER FULL
K9, TAD (LF; DCA TK
    STA; DCA I KP2          /NEG MARKS END
    TAD KP2; IAC; DCA TP1   /SET TP POINTERS
    TAD TP1; DCA TP2
    CLR KC
    JMP T9

/TELEPRINTER HANDLER
TH, 0
    DCA I TP1               /STORE SYM
    JMS BUMP
TP1,TTBUFF+2                /TP INSERT POINTER
    SZAC; CLR TH            /UNLOCK UNLESS FULL
    TAD KH; SZAC; JMP DIS   /ACTIVE ->
    SET KH
T1, TAD TK; JMS TYPE
    TAD I TP2; SZA; JMP T2  /NOT NL ->
    KCC
    TAD (CR; JMS TYPE
    TAD (LF; DCA TK
    JMP T3
T2, JMS TYPE
T3, JMS BUMP
TP2,TTBUFF+2                /TP EXTRACT POINTER
    SZAC; JMP T1            /BUFF NOT EMPTY ->
T9, CLR KH; CLR TH
    JMP KI+2

/BUMP POINTER
/N.B. POINTER SLOT FOLLOWS CALL
BUMP, 0
    TAD I BUMP; TAD (-KBE   /AT END?
    SPA SNAC; JMP .+3       /NO ->
    TAD KP2; DCA I BUMP     /WRAP ROUND
    INC I BUMP
    INC BUMP
    TAD TP1; CIA; TAD TP2   /POINTERS EQUAL?
    JMP I BUMP              /AC=0 IF YES

PAGE
TPOS, -1
TYPE, 0
    KSF; SPA SNA; JMP TY3   /-> IGNORE
    TAD (-CR; SZA; JMP TY1  /NOT CR ->
    TAD (-111; DCA TPOS     /73 CHARS
TY1,TAD (CR-40; SMA         /NO INC IF CONTROL
    ISZ TPOS; JMP TY2       /LINE NOT FULL ->
    DCA TK
    TAD (CR; JMS TOUT
    TAD (LF; JMS TOUT
    TAD TK
TY2,TAD (40; JMS TOUT
TY3,CLA; CLR TK
    JMP I TYPE
TOUT, 0
    TLS
    JMS TI; TSF; JMP DIS; TCF
    JMP I TOUT

/TELETYPE BUFFER (KB + TP)
TTBUFF, -1                  /FOR BOUNCING OFF
    0
*.+114

/PUNCH HANDLER
PH, 0
    JMS PARBIT
    TAD CALL1; PLS; JMS PI  /PUNCH
    PSF; JMP PI+3; PCF
    CLR PH
    JMP PI+2

PAGE
/READER HANDLER
/BUFFERS TWO SYMS
RK1, 0;RK2, 0
RH, 1                       /ENTRY-POINT LOCKED
    TAD RK1; DCA AC         /RETURN CURRENT SYM
RH1,ISZ RFLIP; SKP; JMP DIS /NOT READY FOR NEXT =>
    STA; DCA RFLIP
    TAD RK2                 /PROMOTE RK2
RH2,DCA RK1
    RFC                     /SELECT READER
    TAD RK1; TAD (-CR
    SNAC; JMP RH4           /CR ->
    CLR RH                  /UNLOCK
RH3,JMS RWAIT
    JMP RH1
RH4,JMS RWAIT
    TAD RK2; TAD (-LF
    SNAC; JMP RH2           /CR+LF (NL) ->
    CLR RH                  /UNLOCK (FOR CR)
    JMP RH1
RWAIT, 0
    JMS RI; RSF; JMP RI+3   /WAIT FOR READER
    RRB; AND (177; DCA RK2
    TAD RK2; SZA; TAD (-DEL /NULL OR DEL?
    SZAC; JMP I RWAIT       /NO =>
    RFC
    JMP RWAIT+1

/HANDLER CALL
/WAIT IF LOCKED
CALL1, 0;CALL2, 0
CALL, 0
    DCA CALL1               /DATUM
    TAD I CALL; DCA CALL2   /HANDLER AD
    TAD I CALL2; SZAC; JMP .-2
    IOF
    TAD CALL; IAC; DCA 0    /RETURN AD
    CLR AC
    TAD CALL1
    JMS I CALL2             /JMS TO LOCK

/INPUT SYM FROM KB
KSYM, 0
    DCA PROMPT              /PROMPT (OR ZERO)
KS1,LAS; RTL                /IF SW1 CLEAR
    SNA CLA; TAD (-40; DCA WL /MAP ALL LC TO UC
    JMS CALL; KH            /CALL KB HANDLER
    SPA; JMP KS1            /NO DATA AVAILABLE ->
    TAD (-140; SMA; TAD WL
    TAD (140
    JMP I KSYM

/SKIP REST OF INPUT
SKIP, 0
SK1,TAD I KP1; SPAC; JMP I SKIP
    JMS I KSYMI; CLA
    JMP SK1

/OUTPUT SYM TO TP
TSYM, 0
    JMS CALL; TH
    JMP I TSYM

/INPUT SYM FROM READER
RSYM, 0
RS1,TAD RSTAT; SNAC; JMP RS2 /STATUS NORMAL ->
    ISZ RSTAT; JMP RS3      /EOF ->
    TAD RH; SZAC; RFC       /SELECT IF HUNG
RS2,TAD RH; SNAC; JMP RS4   /HANDLER IDLE ->
    ISZ 0; JMP RS1          /NOT TIMED OUT
    CLR LMID                /IN CASE RUBBISH
RS3,IAC; DCA RSTAT          /EOF
    TAD (ENDMES-LBEG; DCA ENDED
    JMP I RSYM
RS4,JMS CALL; RH
    JMP I RSYM

/OUTPUT SYM TO PUNCH
PSYM, 0
    SZA; JMP PS1            /NOT NL ->
    TAD (CR
    JMS CALL; PH
    TAD (LF
PS1,JMS CALL; PH            /CALL PUNCH HANDLER
    JMP I PSYM

/PUNCH RUNOUT
RUN, 0
    TAD (-400; DCA WL
    JMS CALL; PH
    ISZ WL; JMP .-3
    JMP I RUN

PAGE
/CODIFICATION TABLE
/USED FOR RECOGNITION & EXECUTION
/HIGH-ORDER THREE BITS: TYPE
/LOW-ORDER NINE BITS: EXEC AD (REL TO XBASE)
/COMMAND CODES
CTYPE=0000-XBASE            /COMMA
LBTYPE=1000-XBASE           /LEFT BRACKET
RBTYPE=2000-XBASE           /RIGHT BRACKET
FTYPE=3000-XBASE            /FIND
DTYPE=4000-XBASE            /DELETE, ETC.
ITYPE=5000-XBASE            /INSERT, ETC.
MTYPE=6000-XBASE            /MOVE, ETC.
GTYPE=7000-XBASE            /GET, ETC.
/OTHER SYMBOLS
DIGIT=0000
INVERT=1000
INDEF=2000
OPT=3000
MARK=4000
OTHER=7000
CTAB,OTHER; MARK; MARK; MARK  /.!.#
    MARK; MARK; MARK; MARK  /$%&'
    LBTYPE+XY; RBTYPE+XZ; INDEF; MARK  /()*+
    XZ1+CTYPE; OTHER; MARK; MARK  /,-./
    DIGIT; DIGIT; DIGIT; DIGIT  /0123
    DIGIT; DIGIT; DIGIT; DIGIT  /4567
    DIGIT; DIGIT; MARK; OTHER  /89:;
    MARK; MARK; MARK; OPT  /<=>?
    MARK; OTHER; GTYPE+XB; OTHER  /@ABC
    DTYPE+XD; MTYPE+XE; FTYPE+XF; GTYPE+XG  /DEFG
    OTHER; ITYPE+XI; GTYPE+XJ; GTYPE+XK  /HIJK
    GTYPE+XL; MTYPE+XM; OTHER; GTYPE+XO  /LMNO
    GTYPE+XP; OTHER; GTYPE+XR; ITYPE+XS  /PQRS
    DTYPE+XT; DTYPE+XU; DTYPE+XV; GTYPE+XW  /TUVW
    OTHER; OTHER; OTHER; MARK  /XYZ[
    INVERT; MARK; MARK; MARK  /\].~

/READ KB SYM, SET UP TYPE AD
GETSYM, 0
GS1,JMS I KSYMI
    TAD (-140; SMA; TAD (-40 /LC TO UC
    TAD (140-SEMI; SZA; TAD (SEMI /SEMI TO NL
    DCA SYM
    TAD SYM; SNA; JMP GS2   /NL ->
    TAD (-40                /SPACE OR CONTROL?
    SPA SNAC; JMP GS1       /YES ->
    TAD SYM; TAD (-40
GS2,TAD (CTAB; DCA TYPAD
    JMP I GETSYM

/READ NUM IF ANY
GETNUM, 0
    TAD I TYPAD; AND (4777  /NUMERIC TYPE?
    SZAC; JMP I GETNUM      /NO =>
    TAD I TYPAD; SZA; JMP GN2 /NOT DIGIT ->
GN1,TAD SYM; TAD (-60; DCA NUM
    JMS GETSYM
    TAD I TYPAD
    SZAC; JMP I GETNUM
    TAD NUM; CLL RTL; TAD NUM; RAL /NUM*10
    JMP GN1
/INVERT,INDEF,OPT: STOP,ZERO,STOP+1
GN2,CLL RTL; RAL
    SNL; SKP CLA
    TAD (STOP; DCA NUM
    JMS GETSYM
    JMP I GETNUM

PAGE
/POP LAST LB IF ANY
UNCHAIN, 0
UC1,TAD CHAIN               /END OF CHAIN?
    SNA; JMP I UNCHAIN      /YES (AC=0) =>
    DCA WL                  /AD
    TAD WL; IAC; DCA TXT    /AD+1
    TAD I CHAIN; DCA CHAIN  /POP
    TAD I TXT; SZAC; TAD (3 /COMMA: CA
    TAD CA; DCA I WL        /LEFT: CA+3
    TAD I TXT; SNA; JMP UC1 /COMMA ->
    JMP I UNCHAIN           /(AC#0)

/SWITCH ACC. TO TYPE
SWITCH, 0
    TAD I TYPAD; RTL; RTL
    AND (7
    TAD SWITCH; DCA SWITCH
    JMS GETSYM
    JMP I SWITCH
   
/PICK OFF SPECIAL COMMANDS
SPECIAL, 0
SP0,TAD (GTSIGN; JMS GETSYM /'>' AS PROMPT
    TAD SYM; SNA; JMP SP0   /NL ->
    TAD (-PERCNT; SZAC; JMP I SPECIAL /NOT '%' =>
    JMS GETSYM
    TAD SYM; DCA CODE
    JMS I KSYMI             /FOLLOWED BY NL?
    SZAC; JMP ER1           /NO ->
    TAD CODE
    TAD (-C; SZA; JMP SP3   /NOT CLOSE ->
SP1,TAD ENDED; SZAC; JMP SP2 /READ REST OF FILE
    JMS PUT; JMS GET
    JMP SP1
SP2,TAD (TOP; JMS PUNCH     /PUNCH HALF (IN CASE > 2K)
    TAD BP1; JMS PUNCH      /PUNCH REST
    JMS RUN
    HLT
    JMP I STARTI
SP3,TAD (C-H; SZA; JMP SP4  /NOT HOLD ->
    IAC; DCA RSTAT          /EOF
    JMP SP0
SP4,TAD (H-P; SZA; JMP SP5  /NOT PUNCH ->
    TAD (TOP; JMS PUNCH     /PUNCH HALF (IN CASE > 2K)
    TAD BP1; JMS PUNCH      /PUNCH REST
    JMP SP0
SP5,TAD (P-R; SZAC; JMP ER4 /NOT RELEASE ->
    STA; DCA RSTAT
    TAD ENDED; SZAC; JMS GET
    JMP SP0

/START: RESET IN CASE RESTART
START, IAC; DCA RH
    STA; DCA RSTAT
    CLR RFLIP
    CLR KH; CLR TH
    CLR PH; CLR RUN
    TAD (TTBUFF; DCA KP1
    TAD (LBEG; DCA PP
    TAD (TOP; DCA BP1
    TAD (BOT; DCA BP2
    JMP D0

PAGE
/READ COMMAND
READCO, 0
C1, JMS SPECIAL             /PICK OFF SPECIALS
    TAD I TYPAD; AND (4777  /NUMERIC TYPE?
    SNAC; TAD CHAIN         /AND LAST COMMAND OK?
    SNA; JMP C2
    DCA CA                  /RESTORE POINTER
    JMS GETNUM
    JMP C95
C2, TAD (CBUFF-1; DCA CA    /COMMAND POINTER
    TAD (-CSLOTS; DCA WC
    TAD (SBUFF-1; DCA SA    /STRING POINTER
    CLR CHAIN
C10,IAC; DCA NUM            /NUM = 1 (DEFAULT)
    TAD SYM; SNA; JMP C90   /NL ->
    DCA CODE; CLR TXT
    TAD I TYPAD; AND (777   /COMMAND CODE?
    SNAC; JMP ER1
    JMS SWITCH
    CLR NUM                 /COMMA (NUM = 0)
    JMP C20                 /+LEFT (NUM = 1)
    JMP C30                 /RIGHT
    CLR NUM                 /FIND (LIM = 0)
    JMS GETNUM              /+DEL, ETC.
    JMP C40                 /+INS, ETC.
    JMP C50                 /MOVE, ETC.
    JMP C60                 /OTHERS
C20,TAD CHAIN; DCA TXT      /ADD TO CHAIN
    TAD CA; TAD (2; DCA CHAIN
    JMP C80
C30,JMS UNCHAIN             /LOCATE LEFT
    SNAC; JMP ER4           /NON ->
    JMS GETNUM
    TAD NUM; DCA I TXT
    JMP C80
C40,TAD I TYPAD; TAD (-MARK /VALID QUOTE MARK?
    SZAC; JMP ER1           /NO ->
    TAD SA; IAC; DCA TXT
    TAD NUM; CIA            /LIM (NEG)
C41,DCA I SA
    TAD SA; TAD (-SBUFF-SSIZE+1
    SMAC; JMP ER6
    JMS I KSYMI
    SNA; JMP C43            /NL ->
    CIA; TAD SYM
    SNA; JMP C42            /END ->
    CIA; TAD SYM            /RESTORE
    JMP C41
C42,CLR I SA
    IAC; DCA NUM            /RESTORE NUM
    JMP C52
C43,CLR I SA; CLR SYM
    JMP C80
C50,TAD SYM; TAD (-MINUS
    SZAC; JMP C60           /NOT MINUS ->
    TAD CODE; TAD (4012     /E TO O, M TO W (SIGNED)
    DCA CODE
C52,JMS GETSYM
C60,JMS GETNUM
C80,TAD CODE; DCA I CA      /STORE TRIPLE
    TAD TXT; DCA I CA
    TAD NUM; DCA I CA
    ISZ WC; JMP C10
    JMP ER6
C90,JMS UNCHAIN; SZAC; JMP ER6
    TAD CA; DCA CHAIN
C95,TAD (RB; DCA I CA       /ADD EXTRA RB
    TAD (CBUFF-1; DCA I CA
    TAD NUM; DCA I CA
    CLR I CA
    JMP I READCO
ER1,TAD SYM; JMP ER5
ER4,TAD CODE
ER5,JMS I TSYMI
ER6,TAD (QUERY; JMS I TSYMI
    JMS I TSYMI; JMS I SKIPI
    CLR CHAIN
    JMP C1

PAGE
/UNPACK NEXT 6-BIT VALUE
UN6, 0
    ISZ FLIP; JMP U61       /FLIP = 0 ->
    TAD I BP2               /RIGHT HALF
    JMP U62
U61,STA; DCA FLIP
    INC BP2; TAD I BP2
    RTR; RTR; RTR           /LEFT HALF
U62,AND (77
    JMP I UN6

/UNPACK LINE
/N.B. INSTRUCTION AS PARAM
UNPACK, 0
    TAD I UNPACK; DCA U3
    CLR FLIP
U1, JMS UN6                 /NL?
    SNA; JMP I UNPACK       /YES => LAST EXECUTION
    TAD (-77; SZA; JMP U2   /NOT SHIFT ->
    JMS UN6; TAD (-41
    SMA SZA; JMP U3
    TAD (40
U2, TAD (136
U3, NOP
    JMP U1

/PACK 6-BIT VALUE
PK6, 0
    ISZ FLIP; JMP P61       /FLIP = 0 ->
    TAD I BP1; DCA I BP1    /RIGHT HALF
    JMP I PK6
P61,CLL RTL; RTL; RTL       /LEFT HALF
    INC BP1; DCA I BP1
    STA; DCA FLIP
    JMP I PK6

/PACK SYM AS 6-BIT VALUE(S)
PACK, 0
    SZA; TAD (-37
    SPA; TAD (176           /MAP CONTROLS UP
    TAD (-76                /SINGLE VALUE
    SMA SZA; JMP PK1        /NO ->
    TAD (76; JMS PK6
    JMP I PACK
PK1,DCA WL
    TAD (77; JMS PK6        /77 AS SHIFT
    TAD WL; JMS PK6
    JMP I PACK

/SEND CURRENT LINE
/N.B. INSTRUCTION AS PARAM
SEND, 0
    TAD (LBEG; DCA WA
    CLR FLIP
    TAD (-MAXLIN-1; DCA WC
    TAD I SEND; DCA S3
S1, TAD WA; CIA; TAD PP
    SZAC; JMP S2
    TAD UP; SZA; JMS I TSYMI
    STA; TAD FP; DCA WA
S2, ISZ WC; TAD I WA        /COUNT OUT OR NL?
    SNA; JMP I SEND         /YES => LAST EXECUTION
S3, NOP
    JMP S1

/GET FILE LINE: UNPACK OR READ
GET, 0
    TAD (LMID-1; DCA RA
    TAD (LMID; DCA FP
    CLR MS; CLR ENDED
    TAD BP2; TAD (-BOT      /LINE STORED?
    SNAC; JMP G1            /NO ->
    JMS UNPACK; DCA I RA
    JMP I GET
G1, TAD (-MAXLIN-1; DCA WC
G2, ISZ WC; JMS I RSYMI     /COUNT OUT OR NL?
    SNA; JMP G3             /YES ->
    DCA I RA
    JMP G2
G3, CLR I RA
    JMP I GET

/PUT FILE LINE
PUT, 0
    JMS ELBOW
    JMS SEND; JMS PACK
    TAD (LBEG; DCA PP
    JMP I PUT

PAGE
/PUNCH STORED LINES
PX, 0;PY, 0
PUNCH, 0
P5, DCA PX
    TAD BP2; DCA PY         /SAVE BP2
    TAD (TOP; DCA BP2       /SET FOR UNPACK
P6, TAD BP1; STL CMA; TAD BP2
    DCA WL                  /WORDS LEFT + 1 (NEG)
    TAD WL; TAD BP2         /ENOUGH PUNCHED?
    CML CMA; TAD PX
    SZL SNAC; JMP P7        /YES ->
    TAD RUN; SNAC; JMS RUN
    JMS UNPACK; JMS I PSYMI
    JMP P6
P7, TAD (TOP; DCA BP1       /COPY UP REST
P8, ISZ WL; JMP P9          /COUNT NOT OUT ->
    TAD PY; DCA BP2         /RESTORE BP2
    JMP I PUNCH
P9, INC BP1; INC BP2
    TAD I BP2; DCA I BP1
    JMP P8

/MAKE ROOM IF NECESSARY
ELBOW, 0
    TAD BP2; TAD (-MAXLIN-1
    STL CIA; TAD BP1
    SZL CLA; JMP I ELBOW    /NOT NECESSARY =>
    TAD (TOP; JMS PUNCH     /PUNCH ABOUT HALF
    JMP I ELBOW

/COPY DOWN PACKED LINE
PUSH, 0
    TAD I BP1; DCA I BP2
    STA; TAD BP1; DCA BP1
    STA; TAD BP2; DCA BP2
    TAD I BP1
    AND (77; SZAC; JMP PUSH+1
    JMP I PUSH

/MATCH TEXT STRING
FX, 0;FY, 0;FZ, 0
FIND, 0
    DCA FX                  /INDIC
    TAD FP; DCA FY
    TAD I TXT; DCA FZ       /LIM (NEG)
    SZL; JMP F2
    TAD FY; TAD MS; SNAC
F1, INC FY
F2, TAD TXT; DCA SA
    TAD I FY; SNA; JMP F5
    CIA; TAD I SA; SZAC; JMP F4
    TAD FY; DCA WL
F3, INC WL
    TAD I SA; SNA; JMP F6
    CIA; TAD I WL; SNAC; JMP F3
F4, TAD FX; SPA SNAC; JMP F1
F5, ISZ FZ; SKP; JMP NO
    TAD ENDED; SZAC; JMP NO
    TAD FX; SMAC; JMS PUT
    JMS GET
    TAD FP; DCA FY
    JMP F2
F6, TAD FY; CIA; DCA MS     /MATCH START (NEG)
    TAD WL; DCA ML          /MATCH LIM
F7, TAD FP; TAD MS
    SNAC; JMP I FIND
    TAD FX; SPAC; JMP F8
    INC PP; TAD I PP; DCA I PP
F8, INC FP
    JMP F7

PAGE
/MAIN PROGRAM
/DESPATCH COMMANDS
XBASE=.
D0, JMS I TSYMI; JMS I TSYMI /NEWLINES
    JMS READCO              /FIRST COMMAND
    JMS GET                 /READ FIRST LINE OF FILE
D1, TAD (CBUFF-1
D2, DCA CA
D3, TAD I CA; DCA CODE      /EXTRACT TRIPLE
    TAD I CA; DCA TXT
    TAD I CA; DCA NUM
    TAD CODE; SNA; JMP D9   /FINISHED ->
    AND (177
    TAD (CTAB-40; DCA TYPAD
    TAD I TYPAD; AND (777
    TAD (XBASE; DCA TYPAD
    JMP I TYPAD
OK, CLR PRINT
OK1,JMS REP
    JMP I TYPAD
NO, TAD NUM                 /NUM <= 0?
    SPA SNAC; JMP D3        /YES -> NEXT
D4, TAD I CA; SNA; JMP D7   /END ->
    TAD (-LB; SZA; JMP D5   /NOT LB ->
    TAD I CA; DCA CA        /SKIP OVER
    JMP D4
D5, INC CA
    TAD (LB-RB; SZA
    TAD (RB-COMMA; SNAC; JMP D6 /RB OR COMMA ->
    INC CA
    JMP D4
D6, TAD I CA; DCA NUM
    JMP NO
/FAILURE REPORT
D7, TAD (HASH; JMS I TSYMI
    TAD CODE; SPA; TAD (-4012 /CONVERT O,W
    JMS I TSYMI
    TAD TXT; SNAC; JMP D8   /NO TEXT ->
    TAD (QUOTE
    JMS I TSYMI
    INC TXT; TAD I TXT
    SZA; JMP .-4
    TAD (QUOTE; JMS I TSYMI
D8, JMS I TSYMI             /NEWLINE
    JMS I SKIPI
D9, TAD PRINT; TAD I KP1    /(HAIRY TEST)
    CMA; OSR
    SMAC; JMS PRINT
    JMS READCO              /READ NEXT COMMAND
    JMP D1
REP, 0
    STA; TAD NUM; DCA NUM   /NUM = NUM-1
    TAD NUM; SZA
    TAD (-STOP; SNA; JMP D3 /FINISHED =>
    IAC; SNAC; JMP D4       /INVERTED =>
    JMP I REP
PRINT, 0
    SNAC; TAD I PP; SZAC
    TAD (ARROW; DCA UP
    TAD ENDED; JMS SEND; JMS I TSYMI
    DCA UP
    JMP I PRINT
/LEFT BRACKET
XY, TAD NUM; DCA I TXT      /RESTORE NUM
    JMP D3
/RIGHT BRACKET
XZ, JMS REP
    TAD CA; DCA WL
    TAD NUM; DCA I WL       /UPDATE NUM
/+COMMA
XZ1,TAD TXT
    JMP D2
/PRINT
XP, STA; TAD NUM; JMS PRINT /NO ARROW IF MULTIPLE
    JMS REP                 /TEST FINISHED
    ISZ NUM; NOP            /RESTORE NUM
    JMP XM                  /-> MOVE

PAGE
/RIGHT-SHIFT
XR, TAD I FP; SNA; JMP NO   /END OF LINE ->
    INC PP; DCA I PP
XR1,INC FP
    JMP OK
/ERASE
XE, TAD I FP; SNAC; JMP NO  /END OF LINE ->
    JMP XR1
/LEFT-SHIFT
XL, TAD I PP; SNAC; JMP NO  /START OF LINE ->
    STA; TAD FP; DCA FP
    TAD I PP; DCA I FP
    CLR MS
XL1,STA; TAD PP; DCA PP
    JMP OK
/ERASE BACK
XO, TAD I PP; SNAC; JMP NO  /START OF LINE ->
    JMP XL1
/VERIFY
XV, STL IAC; JMS FIND       /L#0, AC>0
    JMP OK
/FIND
XF, CLL; JMS FIND           /L=0, AC=0
    JMP OK
/TRAVERSE
XT, STL; JMS FIND           /L#0, AC=0
    JMP XS1
/UNCOVER
XU, CLL STA; JMS FIND       /L=0, AC<0
    JMP OK
/DELETE
XD, STL; JMS FIND           /L#0, AC=0
    TAD ML; DCA FP
    JMP OK
/JOIN
XJ, TAD PP; TAD (-LMID+1    /LINE TOO BIG?
    SMAC; JMP NO            /YES ->
    TAD I FP; SNA; JMP XK1  /END OF LINE ->
    INC PP; DCA I PP; INC FP
    JMP XJ
/SUBSTITUTE
XS, TAD FP; TAD MS          /TEXT LOCATED?
    SZAC; JMP NO            /NO ->
XS1,TAD ML; DCA FP
/+INSERT
XI, TAD ENDED; SZAC; JMP NO /END OF FILE ->
    TAD TXT; DCA SA
XI1,TAD PP; CMA; TAD FP     /CROSSOVER?
    SPA SNAC; JMP NO        /YES ->
    TAD I SA; SNA; JMP OK   /FINISHED ->
    INC PP; DCA I PP
    JMP XI1
/BREAK
XB, INC PP; CLR I PP        /INSERT NL
    JMS PUT
    JMP OK1
/KILL
XK, TAD (LBEG; DCA PP
XK1,TAD ENDED; SZAC; JMP NO /END OF FILE ->
    JMS GET
    JMP OK
/GET
XG, TAD (COLON; JMS I KSYMI /COLON AS PROMPT
    DCA SYM
    TAD SYM; TAD (-COLON
    SNAC; JMP NO
    JMS ELBOW
    CLR FLIP
XG1,TAD SYM; JMS PACK
    TAD SYM; SNAC; JMP OK1
    JMS I KSYMI; DCA SYM
    JMP XG1
/MOVE
XM, TAD ENDED; SZAC; JMP NO /END OF FILE ->
    JMS PUT
XM1,JMS GET
    JMP OK
/MOVE BACK
XW, JMS ELBOW
    TAD BP1; TAD (-TOP      /START OF BUFF?
    SNAC; JMP NO            /YES ->
    JMS PUSH                /PUSH FOR UNPACKING
    TAD ENDED; SZAC; JMP XM1
    JMS PUT; JMS GET; JMS PUSH /MULBERRY BUSH
    JMP OK

PAGE
/BUFFERS
CBUFF=.
*.+CSLOTS+CSLOTS+CSLOTS+4
SBUFF=.
*.+SSIZE
ENDMES, 0
    52; 52; 105; 115; 104; 52; 52
LBEG, 0
*.+MAXLIN+2
LMID=.
*.+MAXLIN+3
FREE,0