/IMP EXECUTIVE
 .LOC 6000
LOAD=4000
BUFF1=16340
BUFF2=16740
BUFF3=17340
FPLOC=17000
    JMP X1
SUBS .SIZE
PAR
UNIT                        /P1: UNIT
BN                          /P2: BLOCK
    0                       /P3: SIZE
    5                       /P4: INC
    40                      /P5: ASCII SPACE
    6                       /P6: CARD CANCEL
    177                     /P7: ASCII MASK
    200                     /P8: ASCII PAR BIT
    110                     /P9: CARD COLS
    0                       /P10: CARD SPACE
    0                       /P11: RUNOUT
    4                       /P12: ASCII EOT
    15                      /P13: ASCII CR
    12                      /P14: LINE FEED
    0                       /P15: LINK DEV
AD
BIT
BITAD
CON
DIR
DUMP
INOUT
MAP
MAPAD
MODE
MOD
SBASE
SYM
TRIND
WC
CI
CJ
AI
AJ
WL1
WL2
N   .SIXBT 'N@@@@@'
CS  .SIXBT 'CS@@@@'
TT  .SIXBT 'TT@@@@'
DT0 .SIXBT 'DT0'
U   .SIXBT 'DT1'
W   .SIXBT 'DT2'
PER .SIXBT '***0PERM@@@@@@@'
LIB .SIXBT '***0LIB@@@@@@@@'
CD  .SIXBT '***0@@@@@@@@@@@'
SYS .SIXBT '***EDIT@@'
OBJ .SIXBT 'OBJ'
SRC .SIXBT 'SRC'
ABS .SIXBT 'ABS'
TMP .SIXBT 'TMP'
ASSTAB .BLOCK 120
/INITIAL ENTRY
X1  LAC (JMP .LE; DAC .LL   /TREAT ALL CALS ALIKE
    LAC (JMP E1; DAC .LE
    LAC 20; SNA; JMP M1     /NOT ENTERED BY CAL ->
    LAC .FN                 /FAULT NUM
    SAD (100; DZM .FN
    LAC .FN
    TAD (-400; SMA; JMP E0  /LOAD FAULT ->
X2  LAC .NF                 /NEW O/P FILE?
    SNA; JMP M1             /NO ->
    TAD (40; DAC CI
    LAW 777770; AND* CI     /CHECK UNIT VALID
    SZA; JMP E9             /NO ->
    LAC DT0; TAD* CI        /UNIT
    DAC DEV; ISZ CI
    LAC .NF+1; DAC FA
    LAC .NF+2; DAC FB
    LAC .NF+3; DAC FC
    LAC* CI                 /FIRST BLOCK NUM
    SMA; JMP E8             /NOT CLOSED  ->
    LAC .FN                 /FAULT?
    SNA; JMP .+3            /NO ->
    LAC TMP; DAC FC         /ALTER FILE EXT
    JMS LOOKUP; DAC CJ      /OLD VERSION (IF ANY)
    JMS INSERT              /NEW VERSION
    JMS MAPBLK
    CYCLE
    LAC* MOD; AND* DIR      /NEW DIR OK?
    SAD* DIR; SKP; JMP E9   /NO ->
    XOR* MOD; DAC* MAP      /MOD MINUS DIR
    LAC* MOD; DAC* DIR
    REPEAT
    LAC (4000               /WRITE MAP BLK
    JMS TRANS; DV2
    LAC* CI; DAC* AD
    LAC CJ                  /OLD VERSION
    SZA; JMS DELETE
    LAC (4000               /WRITE DIRECTORY
    JMS TRANS; DV1
    JMP M1
CYCLE=JMS .                 /FOR BIT MAPS
CY
    LAC DV1+3; DAC DIR      /DIRECTORY
    LAC .NF; DAC MOD        /MODIFIED DIRECTORY
    LAC MAPAD; DAC MAP      /FILE BIT MAP
    LAW -40; DAC WC
    JMP* CY
REPEAT=JMS .
    0
    ISZ DIR; ISZ MOD
    ISZ MAP
    ISZ WC; JMP* CY
    JMP* .-6
/COMMAND PROCESSOR
M0  DZM .FN                 /CLEAR FAULT
M1  CLC; DAC DV2+1          /SCARIFY DT INF
    DAC DV1+4; DAC DV2+4
    DZM .NF                 /CLEAR NEW FILE AD
    DZM 20                  /CLEAR CAL ENTRY
    DZM .BL                 /CLEAR BUFF LIST
    DZM .IM                 /CLEAR INT MESS
    DZM TRIND               /CLEAR TRANSFER IND
    LAW -20; DAC AJ         /CLEAR STREAMS
    LAC (IN0; DAC AI
    DZM* AI; ISZ AI
    ISZ AJ; JMP .-3
    LAC (RS1; DAC RSW       /GENUINE INPUT
    LAC .SD; AND (7         /SYSTEM UNIT
    TAD DT0; DAC SYS
    DAC PER; DAC CD
    DAC LIB
    LAC .DG; DAC PAR+4      /DECTAPE INC
    DZM PROG                /PROG FILE
    LAC (1; DAC SBASE       /STREAM BASE
    LAC (LOAD; DAC 10       /UPPER LIM FOR I.O.
    LAC .CS+2; DAC .LO      /CONTROL LIM
    SZA; JMP M2             /SET ->
    LAC .SS; DAC .LO        /SUPER SIZE
    TAD (JMP*               /CREATE NULL FPS
    DZM* .LO; ISZ .LO
    DAC* .LO; ISZ .LO
    TAD (2
    DZM* .LO; ISZ .LO
    DAC* .LO; ISZ .LO
    LAC (1; DAC INOUT       /1:INPUT
    LAC (TT; JMS ASS1REF
    DAC .CS                 /CONTROL INPUT
    ISZ INOUT               /2:OUTPUT
    LAC (TT; JMS ASS1REF
    DAC .CS+1               /CONTROL OUTPUT
M2  LAC .CS                 /TT?
    JMS TTQ; JMP M3         /NO ->
    LAC .KE                 /IDLE?
    SAD .KI; JMP M6         /YES ->
M3  LAC SYM                 /START OF LINE?
    SZA; SAD .NL; JMP M4    /YES ->
    JMS RSYM                /SKIP REST
    JMP M2
M4  DZM SYM
    LAC .FN                 /FAULT?
    SNA; JMP M6             /NO ->
    JMS RSYM                /READ SYM
    SAD (76; SKP; JMP M2    /NOT '>' ->
M6  DZM SYM; DZM .FN
    LAC (400000; DAC LOG-1  /INDIC FOR PROMPT
    LAC (12                 /EXTRA LINEFEED?
    SAD .TK; SKP; JMS PSYM  /PRINT IF NECESSARY
    JMS LOG; .SIXBT <42>'<'<36>'>;'
M9  JMS RSYM
    SAD (40; JMP M9         /SPACE ->
    SAD (76; JMP M9         /'>' ->
    SAD (120; JMP PP1       /'P' ->
    SAD .NL; JMP M3         /NL ->
    LAC (ASSTAB; DAC CI     /ASS POINTER
    DZM INOUT               /0:PROG
    JMS ASS1IN
    SNA; FAULT
    LAC (040514             /DELETE?
    SAD FA; LAC FB
    SAD (052405; JMP DD1    /YES ->
    JMS SWITCH
    .SIXBT 'A'
    JMP AA1
    .SIXBT 'C'
    JMP CC1
    .SIXBT 'E'
    JMP EE1
    .SIXBT 'F'
    JMP FF1
    .SIXBT 'G'
    JMP GG1
    .SIXBT 'L'
    JMP LL1
    .SIXBT 'M'
    JMP MM1
    .SIXBT 'N'
    JMP NN1
    .SIXBT 'R'
    JMP RR1
    .SIXBT 'DT0'
    JMP RR3
    .SIXBT 'S'
    JMP SS1
    .SIXBT 'T'
    JMP TT1
    .SIXBT 'Z'
    JMP ZZ1
    0
    JMP E10
SWITCH
    LAW -10; AND ASSTAB
    DAC DUMP
    LAC* SWITCH; ISZ SWITCH
    SZA; SAD DUMP; JMP* SWITCH
    ISZ SWITCH
    JMP .-6
/COMMUNICATION TABLE
COMTAB 10; 0; 0; 1; 1; 1; 0; 0
    0; 0; XCT .LO; XCT .DH; XCT .MH; 0; 0;PROG 0
IN0 0;OUT0 0; 0; 0; 0; 0; 0; 0
    0; 0; 0; 0; 0; 0; 0; 0
/ASSIGN CONTROL STREAMS
AA1 DZM SBASE
    JMS ASSIN
    JMS DEFLT
    .SIXBT 'TT/TT;'
    CLL!CLC; JMS* .CS+1     /CLOSE EXISTING O/P
    CLL!CLC; JMS* .CS       /CLOSE EXISTING I/P
    LAC .SS; TAD (4         /REMOVE EXISTING CSTREAMS
    DAC .LO; DZM .CS+2
    JMS ASSREF
    LAC IN0; DAC .CS        /CONTROL INPUT
    LAC OUT0; DAC .CS+1     /CONTROL OUTPUT
    LAC .LO; DAC .CS+2      /CONTROL LIMIT
    JMP M1
/COMPILE
CC1 JMS ASSIN
    JMS DEFLT
    .SIXBT 'N,CS/CS,.0;'
    JMS ASSREF
    LAC .LC+4; TAD (14340   /COMTAB FOR COMP
    JMS CTCOPY
    CLL!CLA; JMS* COMTAB+6  /LOOK AT FIRST SYM
    DAC* COMTAB+6
    SAD (41; SNL!CLL!CLA; JMP CC5 /NOT '!' ->
    JMS* COMTAB+6
    SAD (41; SNL; JMP CC3   /NOT SECOND '!' ->
    LAC (40                 /SPACE
CC2 JMS* COMTAB+7           /TRANSFER TO OUTPUT
    CLL!CLA; JMS* COMTAB+6  /READ NEXT
    DAC* COMTAB+6
    SAD (73; SKP            /SEMI-COLON?
    SAD .NL; SKP; JMP CC2   /NO, NOR NL ->
    LAC (73; JMS* COMTAB+7  /SEND SC
    JMP CC5
CC3 SAD (73; SKP            /OVERWRITE '!'
    SAD .NL; SKP            /ONLY IF SC OR NL
    LAC (41; DAC* COMTAB+6
CC5 LAC .LC; DAC .LL        /RESTORE 'JMS SYSLD'
    JMP .LC
/DELETE
DD1 JMS DTDEVIN
    LAC DEV
    SAD SYS; JMS HMD
    JMS NAMEIN; JMS EXTIN
    LAC SYM
    SAD .NL; SKP
    SAD (54; SKP; FAULT
    JMS LOOKUP
    SNA; JMP E6
    JMS DELETE
    LAC (4000               /WRITE
    JMS TRANS; DV1          /DIRECTORY BLOCK
    LAC SYM
    SAD .NL; JMP M1
    JMS RSYM
    JMP DD1
/EDIT
EE1 LAC (SYS; DAC PROG
    JMP RR4
/FILES
FF1 JMS DTDEVIN
    LAC SYM
    SAD .NL; SKP; FAULT
    JMS DIRBLK
FF2 LAC* AD; DAC FA; ISZ AD
    LAC* AD; DAC FB; ISZ AD
    LAC* AD; DAC FC; ISZ AD
    LAC* AD
    SMA; JMP FF3            /ACTIVE BIT ZERO ->
    JMS NAMEOUT
    JMS LOG; .SIXBT <42>';'
FF3 ISZ AD; ISZ WC; JMP FF2
    JMS LOG; .SIXBT <42>';'
    JMP M1
/GENERATE LIBRARY
GG1 JMS ASS1IN
    SNA; LAC (CD
    JMS ASS1REF
    DAC PROG                /OBJECT FILE
    LAC SYM
    SAD (57; JMS RSYM       /SKIP '/'
    ISZ INOUT; ISZ INOUT    /2:OUTPUT
    JMS ASS1IN
    SNA; FAULT
    JMS ASS1REF
    DAC .GL                 /NEW LIB FILE
    JMP RR6
/LIBRARY
LL1 JMS ASS1IN
    JMS ASS1REF
    DAC .UL                 /USER LIBRARY
    JMP M1
/MONITOR
MM1 LAC (40; XOR 21; DAC 21 /FLIP HLT BIT
    JMP M1
/NEWNAME
NN1 JMS DTDEVIN             /READ OLD NAME
    JMS NAMEIN; JMS EXTIN
    LAC SYM                 /TEST SLASH
    SAD (57; SKP; FAULT
    JMS RSYM
    JMS ZER
    JMS LOOKUP
    SNA; JMP E6             /NOT THERE =>
    TAD (-3; DAC CI
    LAC DEV; DAC CJ
    JMS DTDEVIN
    JMS NAMEIN; JMS EXTIN
    LAC DEV
    SAD CJ; SKP; JMP E12    /NOT SAME UNIT =>
    JMS LOOKUP
    SZA; JMP E7             /THERE ALREADY ->
    LAC* CI; RAL
    LAC FA; DAC* CI; ISZ CI
    SZL!RAL; JMP .+3        /OLD SCRATCH ->
    SZL; JMP E5             /NEW SCRATCH =>
    LAC FB; DAC* CI; ISZ CI
    LAC FC; SNL; DAC* CI
    LAC (4000               /WRITE
    JMS TRANS; DV1          /DIRECTORY BLOCK
    JMP M1
/RUN
RR1 LAC (CD; DAC PROG       /.0
    JMP RR4
RR3 LAC (ASSTAB; DAC PROG
RR4 JMS ASSIN
    DZM INOUT               /0: PROG
    LAC (PER; JMS ASS1REF   /PERM
    DAC .PE
    LAC (LIB; JMS ASS1REF   /SYS LIB
    DAC .PE+1
    LAC PROG; JMS ASS1REF   /MAIN PROG
    DAC PROG
    LAC BN; DAC DV3+1       /FIRST BLOCK
    LAC (2000
    JMS TRANS; DV3          /READ BLOCK
    LAC DV3+3; TAD (1
    DAC DEFLT
    LAC (40; DAC SYM
    LAC (DS1; DAC RSW
    DZM SBASE
    LAW 770000; AND* DEFLT
    SAD (400000; SKP; JMP .+3 /FIRST SYM NOT SPACE ->
    JMS ASSIN
    JMP RR5
    JMS DEFLT
    .SIXBT 'CS,=0/CS,=0;'
RR5 JMS ASSREF
    ISZ .LI                 /INC LOADER INPUT SW
RR6 LAC (LOAD; DAC CI       /RELOCATE LOADER
    LAC .LO; DAC CJ
    LAW -2000; DAC WC
RR7 LAC* CI; CLL; TAD (100000
    SZL; JMP RR8            /IOT OR OPR ->
    AND (17000
    SAD (7000; JMP RR8
    AND (14000
    SAD (4000; SKP; JMP RR8
    LAW -4000; TAD .LO
    TAD* CI; SKP
RR8 LAC* CI; DAC* CJ
    ISZ CI; ISZ CJ
    ISZ WC; JMP RR7
    LAC CJ; TAD (4
    DAC CJ
    LAC* DV3+3; DAC* CJ     /COPY DOWN
    ISZ DV3+3; ISZ CJ
    ISZ DV3+2; JMP .-5
    LAW -37; TAD .MA        /COMTAB DEST
    JMS CTCOPY
    JMP* .LO                /=> LOADER
/COPY COMTAB
CTCOPY
    DAC AJ                  /DEST
    TAD (20; DAC COMTAB+11  /INOUT TAB AD
    LAC (COMTAB; DAC AI     /SOURCE
    LAW -40; DAC WC         /32[10]
    LAC* AI; DAC* AJ
    ISZ AI; ISZ AJ
    ISZ WC; JMP .-5
    LAC .LC; DAC .LE        /RESTORE 'JMS SYSLD'
    XCT 21                  /HLT?
    JMP* CTCOPY
/SCRATCH
SS1 JMS DTDEVIN             /DT UNIT
    LAC DEV
    SAD SYS; JMS HMD
    JMS NAMEIN
    LAC FA; SMA; FAULT      /TEST STARTS WITH DIGIT
    JMS NUMIN; FAULT        /NUMBER OF BLOCKS
    LAC NUM; DAC FC
    CMA; TAD (1
    DAC PAR+3               /BLOCK COUNT (NEG)
    JMS NUMIN; JMP .+4      /BLOCK INCREMENT
    LAC NUM; AND (77
    DAC PAR+4
    LAC PAR+4
    RCR; RTR; RTR; RTR      /INC: TOP 6 BITS
    TAD FC; DAC FC          /NUM: BOTTOM 12
    JMS LOOKUP
    SZA; JMP E7             /ALREADY EXISTS ->
    JMS INSERT
    JMS MAPBLK
    LAC (400000; DAC* AD    /FLAGGED START BLOCK
SS2 ISZ* AD                 /STARTING AT 1
    CYCLE
    DZM* MAP
    REPEAT
    LAC PAR+3; DAC WC       /BC (NEG)
    LAC DV1+3; DAC BITAD    /DIRECTORY BIT MAP
    LAC (400000; DAC BIT    /LEFTMOST BIT
    XOR* AD; DAC BN         /BN (UNFLAGGED)
SS3 JMS BITON; AND* BITAD   /TEST BIT
    SZA; JMP SS2            /OCCUPIED ->
    LAC BITAD; TAD MAPAD
    CMA; TAD DV1+3; CMA
    DAC DUMP                /CORRESPONDING AD
    LAC* DUMP; TAD BIT      /IN FILE MAP
    DAC* DUMP
    ISZ WC; SKP; JMP SS4    /FINISHED ->
    LAC BN; TAD PAR+4
    DAC BN                  /NEXT BLOCK
    LAC PAR+4
    JMP SS3
SS4 CYCLE
    LAC* DIR; TAD* MAP      /SET FILE BITS
    DAC* DIR                /IN DIRECTORY
    REPEAT
    LAC (4000               /WRITE MAP BLK
    JMS TRANS; DV2
    LAC (4000               /WRITE DIRECTORY
    JMS TRANS; DV1
    JMP M1
BITON
    CMA; TAD (1; DAC DUMP   /INC (NEG)
    LAC BIT
B1  RCR; SZA; JMP B2        /SAME WORD ->
    ISZ BITAD
    LAW -40; TAD BITAD
    SAD DV1+3; JMP E4       /OFF END =>
    LAC (400000
B2  ISZ DUMP; JMP B1
    DAC BIT
    JMP* BITON
/TRANSFER
TT1 JMS ASSIN
    JMS DEFLT
    .SIXBT 'CS,=0/CS,=0;'
    JMS ASSREF
    CLC; DAC TRIND          /TRANSFER IND -1
TT2 CLL!CLA; JMS* COMTAB+6  /CALL INPUT SR
    SNL; JMP TT5            /EOF,ERR,CONCAT ->
    JMS* COMTAB+7           /CALL OUTPUT SR
    SNL; JMP E4             /ERR =>
    JMP TT2
TT5 SMA!SZA; JMP E9         /ERR =>
    SZA; SAD (-1; JMP TT7   /NOT CONCAT ->
    DAC COMTAB+6
    JMP TT2
                            /AFTER ESC CR
TT6 ISZ TRIND; JMP M0       /NOT TRANSFERRING =>
    CLL!CLC; JMS* COMTAB+6  /CLOSE INPUT
TT7 DZM .KK
    LAC COMTAB+7            /TT?
    JMS TTQ; JMP .+4        /NO ->
    LAC .NL; STL
    JMS* COMTAB+7
    CLL!CLC; JMS* COMTAB+7  /CLOSE FILE
    JMP X2
/ZERO
ZZ1 DZM SBASE               /STREAM BASE ZERO
    JMP M2
/PARAM VALUE
PP1 JMS RSYM
    JMS NUMIN; FAULT
    LAW -5; TAD NUM
    SPA; JMS HMD
    LAW -16; TAD NUM
    SMA!SZA; JMS HMD
    LAC (PAR; TAD NUM
    DAC AI
    JMS RSYM
    JMS NUMIN; FAULT
    LAC NUM; DAC* AI
    JMP M1
/TEST TT: SKIP IF YES
TTQ
    AND (300000
    SAD (100000; ISZ TTQ
    JMP* TTQ
/ERROR MESSAGES
E0  TAD (60; DAC .+6
    JMS LOG; .SIXBT <42>'LOAD FAULT ***;'
    JMP E99
E1  LAC .FN               /AFTER CAL FROM EXEC
    SAD (15; JMP TT6      /ESC CR ->
    SAD (4; SKP; JMP .    /HOWL IF UNKNOWN
E2  JMS LOG
    .SIXBT <42>'I.O. AREA FULL;'
    JMP E99
E3  JMS DEVOUT
    JMS LOG
    .SIXBT 'DIRECTORY FULL;'
    JMP E99
E35 JMS DEVOUT
    JMS LOG
    .SIXBT 'DIRECTORY CORRUPT;'
    JMP E99
E4  JMS LOG
    .SIXBT 'FILE TOO BIG;'
    JMP E99
E5  JMS LOG; .SIXBT 'NO;'
    JMP E99
E6  JMS NAMEOUT; JMS LOG
    .SIXBT 'NOT ON ;'
    JMS DEVOUT
    JMP E99
E7  JMS NAMEOUT; JMS LOG
    .SIXBT 'ALREADY ON ;'
    JMS DEVOUT
    JMP E99
E8  JMS LOG; .SIXBT <42>'NO NEW ;'
    JMS DEVOUT
    JMS NAMEOUT
    JMP E99
E9  JMS LOG
    .SIXBT <42>'DATA ERROR;'
    JMP E99
E10 JMS LOG
    .SIXBT ' COMMAND ;'
    JMS DEVOUT
    JMP E99-2
E11 LAC FK; DAC DEV
E12 JMS LOG
    .SIXBT ' DEVICE ;'
    JMS DEVOUT
    JMP E99-2
FAULT=JMS .; 0
    LAC SYM
    STL; JMS* .CS+1         /SEND TO REPORT STREAM
    JMS LOG
    .SIXBT '?;'
E99 JMS LOG
    .SIXBT <42>';'
    XCT 21
    ISZ .FN
    JMP M1
DEVOUT
    JMS LOG
DEV .SIXBT '***;'
    JMP* DEVOUT
NAMEOUT
    JMS LOG
    .SIXBT '@@ '
FA  .SIXBT '***'
FB  .SIXBT '*** ;'
    LAC FC; SZA; LAC FA
    SPA!SNA; JMP* NAMEOUT
    JMS LOG
FC  .SIXBT '*** ;'
    JMP* NAMEOUT
/REFERENCE I/O ASSIGNMENTS
ASSREF
    DZM INOUT; ISZ INOUT    /1: INPUT
    LAC (IN0; DAC AI
    LAW -10; DAC AJ
A11 LAC* AI; JMS ASS1REF
    DAC* AI
    ISZ AI; ISZ AI
    ISZ AJ; JMP A11
    ISZ INOUT               /2: OUTPUT
    LAC (OUT0; DAC AI
    LAW -10; DAC AJ
A12 LAC* AI; JMS ASS1REF
    DAC* AI
    ISZ AI; ISZ AI
    ISZ AJ; JMP A12
    LAC IN0+2; DAC COMTAB+6 /IN1
    LAC OUT0+2; DAC COMTAB+7 /OUT1
    JMP* ASSREF
/REFERENCE ASSIGNMENT
AP;AQ
ASS1REF
    SNA; LAC (N
    DAC CJ                  /AD OF DESCRIPTOR
    LAC (AQ; DAC AP
    DZM* AP
A21 DZM MODE
    LAC* CJ; DAC DEV
    ISZ CJ
    AND (777770
    SAD (750060; JMP A30    /'=' ->
    SMA; JMP .+4
    LAC DEV; DAC CJ         /INDIRECT REF
    JMP A21
    SAD DT0; SKP; JMP A27
    LAC* CJ; DAC FA; ISZ CJ /DECTAPE FILE
    LAC* CJ; DAC FB; ISZ CJ
    LAC* CJ; DAC FC; ISZ CJ
    LAC ASSTAB              /COMPILER?
    SAD (030000; JMP .+4    /YES ->
    LAC INOUT
    SAD (2; JMS ZER
    LAC FA
    SMA; LAC INOUT
    SAD (2; JMP A25         /NAMED OUT ->
    JMS LOOKUP
    SNA; JMP E6
    LAC FA; SMA; JMP A25    /NOT SCRATCH FILE ->
    LAC FC; AND (7777
    CMA; TAD (1; DAC PAR+3  /BLOCK COUNT (NEG)
    TAD (1000; SPA; JMP E35 /OUT OF RANGE ->
    LAW 770000; AND FC
    RCL; RTL; RTL; RTL
    DAC PAR+4               /GAP
A25 LAC FC
    SAD SRC; SKP; JMP .+4
    LAC (4; DAC MODE        /'D'
    JMP A27
    SAD ABS; SKP; JMP A27
    LAC (2; DAC MODE        /'B'
/CREATE FILE PROCESSOR MNEMONIC
A27 LAC INOUT
    SNA; JMP A29            /OBJ FILE ->
    DZM PAR+17              /LINK DEVICE
    LAC* CJ; AND (7700
    SNA; JMP .+5
    LAC* CJ; AND (7777
    DAC PAR+17
    JMP .+5
    LAC* CJ; AND (77
    SZA; DAC MODE
    LAW 777700; AND DEV
    TAD MODE
A28 JMS FPLOAD
    TAD* AP; DAC* AP        /INSERT AD
    LAC AQ; AND (300000     /LEADING DEV CODE
    SZA; JMP .+5            /SET ->
    LAC* AP; AND (300000
    TAD AQ; DAC AQ          /PROMOTE
    LAC CON; DAC AP         /CONTINUATION
    SZA; JMP .+6            /PERMITTED ->
    LAC* CJ; SPA; FAULT     /ERROR IF SPECIFIED
    LAC AQ                  /FP AD
    JMP* ASS1REF
    LAC* AP; DAC FK
    LAC (400000; DAC* AP
    LAC* CJ; RAL            /SIGN TO LINK
    LAC FK                  /CONCAT?
    SAD N; SNL; JMP A28     /NO ->
    ISZ CJ
    JMP A21
A29 LAC UNIT; CLL
    RTR; RTR
    TAD BN
    JMP* ASS1REF
A30 XOR DEV; RCL            /STREAM<<1
    TAD INOUT; TAD (-1      /+1 IF INOUT
    TAD (IN0; DAC DUMP      /EQUIV SLOT
    CMA; TAD AI             /LESS THAN AI?
    SPA; JMP E12            /NO =>
    LAC* DUMP
    SNA; JMP E12
    TAD* AP; DAC* AP
    LAC AQ
    JMP* ASS1REF
/LOAD FILE PROCESSOR
DTF 042406; 042400
FI;FJ;FK; 0
FPLOAD
    DAC FK; DZM CON
    SAD N; SKP; JMP F1
    LAC INOUT; AND (2       /NONE
    TAD .SS
    JMP* FPLOAD
F1  SAD DTF+1; SKP          /DT
    SAD DTF; SKP; JMP F2
    LAC INOUT; AND (2       /OUTPUT?
    SNA; JMP F4             /NO ->
    LAC FA; SPA; JMP F4     /SCRATCH ->
    LAC FK; TAD (40         /SET EXTRA BIT
    DAC FK                  /FOR NAMED FILE
    LAC .NF                 /NAMED OUTPUT FILE
    SZA; FAULT              /ONLY ONE ALLOWED
    LAC .LO; DAC .NF        /AD FOR DIRECTORY
    TAD (40; DAC .LO
    LAC FA; DAC .NF+1       /STORE NAME
    LAC FB; DAC .NF+2
    LAC FC; DAC .NF+3
    JMS DIRBLK
    CYCLE
    LAC* DIR; DAC* MOD      /COPY DIR BITS
    REPEAT
    JMP F4
F2  SAD CS; SKP; JMP F4
    LAC INOUT
    SAD (1; JMP .+3
    LAC .CS+1; JMP* FPLOAD
    LAC .CS; JMP* FPLOAD
F4  LAC SUBS                /SEARCH FOR MNEMONIC
F5  DAC FI
    DAC FJ; ISZ FJ
    LAC* FI
    SNA; JMP E11            /END OF CHAIN =>
    LAC FK
    SAD* FJ; SKP; JMP .+6
    ISZ FJ
    LAC INOUT; AND* FJ
    SZA; JMP F6             /MATCH ->
    LAW -FPLOC
    TAD* FI; TAD FI
    JMP F5
F6  LAW -FPLOC-3; TAD .LO   /ACTUAL-NOTIONAL START
    DAC FK                  /RELOCATION FACTOR
    LAW -FPLOC-4; TAD* FI
    CMA; DAC WC             /SIZE (NEG)
    TAD 10; CMA; TAD .LO
    SMA; JMP E2             /NO SPACE =>
    LAC* FJ; AND (300000    /DEV TYPE
    DAC FK+1
    ISZ FJ
F7  LAC .LO; DAC FI         /PARAMETER SECTION
    LAC* FJ                 /ENTRY-POINT?
    SNA; JMP F8             /YES ->
    AND (77                 /PAR OR CON?
    SAD* FJ; JMP .+5        /PAR ->
    LAC .LO; DAC CON
    LAC* FJ
    JMP .+4
    TAD (PAR; DAC DUMP
    LAC* DUMP; DAC* .LO
    ISZ FJ; ISZ .LO
    ISZ WC; JMP F7
F8  LAC* FJ; DAC* .LO       /REST OF ROUTINE
    AND (OPR
    SAD (OPR; JMP F9        /NOT MEM-REF
    SAD (IOT; JMP F9        /NOT MEM-REF
    LAC* FJ; AND (17777
    TAD (-FPLOC
    SPA; JMP F9             /NOT > FPLOC ->
    LAC* FJ; TAD FK         /RELOCATE
    DAC* .LO
F9  ISZ FJ; ISZ .LO
    ISZ WC; JMP F8
    LAC FI; TAD FK+1        /ENTRY-POINT AD
    JMP* FPLOAD
/LOOKUP FILE IN DIRECTORY
LOOKUP
    JMS DIRBLK
L1  LAC* AD; ISZ AD         /FIRST THREE
    SAD FA; SKP!RAL; JMP L2
    LAC* AD; ISZ AD         /SECOND THREE
    SAD FB; SKP; JMP L2+1
    LAC* AD; ISZ AD         /EXTENSION
    SZL; DAC FC             /SET FC IF SCRATCH
    SAD FC; SKP; JMP L2+2
    LAC* AD; AND (1777      /FIRST BLOCK
    DAC BN
    LAC AD                  /FOUND (AD IN AC)
    JMP* LOOKUP
L2  ISZ AD
    ISZ AD
    ISZ AD
    ISZ WC; JMP L1
    CLA                     /NOT FOUND (AC ZERO)
    JMP* LOOKUP
/INSERT FILE IN DIRECTORY
/EXIT WITH AD FOR FIRST BLOCK NUM
INSERT
    JMS DIRBLK
I1  LAC* AD
    SNA; JMP I2             /FREE SLOT ->
    LAC AD; TAD (4; DAC AD
    ISZ WC; JMP I1
    JMP E3
I2  LAC FA; DAC* AD; ISZ AD /STORE NAME
    LAC FB; DAC* AD; ISZ AD
    LAC FC; DAC* AD; ISZ AD
    LAC AD
    JMP* INSERT
/DELETE FILE
/ENTER WITH AD FOR FIRST BLOCK NUM
DELETE
    TAD (-3; DAC AD
    JMS ZER                 /CHECK
    DZM* AD                 /CLEAR OUT NAME
    ISZ AD; DZM* AD
    ISZ AD; DZM* AD
    ISZ AD; DZM* AD
    LAC AD; JMS MAPBLK
    CYCLE
    LAC* MAP; AND* DIR      /BITMAP OK?
    SAD* MAP; SKP; JMP E35  /NO ->
    XOR* DIR; DAC* DIR      /UPDATE DIR
    DZM* MAP                /CLEAR MAP
    REPEAT
    LAC (4000               /REWRITE MAP BLK ONLY
    JMS TRANS; DV2
    JMP* DELETE
/READ DIRECTORY BLOCK
DIRBLK
    LAC DEV; AND (7
    DAC UNIT
    SAD DV1+4; JMP DI1      /IN FIRST BUFF ->
    LAC DV1+3; DAC DUMP     /INTERCHANGE BUFF ADS
    LAC DV2+3; DAC DV1+3
    LAC DUMP; DAC DV2+3
    LAC DV1+4; DAC DUMP     /INTERCHANGE DIR UNITS
    LAC DV2+4; DAC DV1+4
    LAC DUMP; DAC DV2+4
    DZM DV2+1               /SCARIFY MAP BLOCK NUM
    LAC UNIT
    SAD DV1+4; JMP DI1      /IN SECOND BUFF
    DAC DV1+4
    LAC (2000               /READ DIRECTORY
    JMS TRANS; DV1
DI1 LAC* DV1+3              /DEC SYS TAPE?
    SPA!CLA; LAC (40        /24[10] FILES IF SO
    TAD (-70; DAC WC        /56[10] IF NOT
    LAC DV1+3; TAD (40
    DAC AD                  /AD OF FIRST NAME
    JMP* DIRBLK
/READ MAP BLOCK (AFTER DIRBLK)
MAPBLK
    CMA; TAD DV1+3; CMA     /AD - START
    RCR; RCR
    DAC DUMP
    AND (7; RCL; RTL; RTL   /MAP AD WITHIN BLK
    TAD DV2+3; DAC MAPAD
    LAC DUMP
    RCR; RCR; RCR
    TAD (70                 /FILE MAP BLK
    SAD DV2+1; JMP* MAPBLK
    DAC DV2+1
    LAC (2000
    JMS TRANS; DV2
    CLC; DAC DV2+4          /SCARIFY DIR UNIT
    JMP* MAPBLK
/DECTAPE VECTOR: DIRECTORY
DV1 0; 100; -400; BUFF1; -1
/DECTAPE VECTOR: MAP BLOCK
DV2 0;   0; -400; BUFF2; -1
/DECTAPE VECTOR: PROG
DV3 0; 0; -400; BUFF3
DVAD 0
TRANS
    TAD UNIT; DAC DUMP      /FUNCTION + UNIT
    LAC* TRANS; ISZ TRANS
    DAC DVAD
    LAC DUMP; DAC* DVAD
    LAC DVAD
    GUARD; JMP .DH          /CALL HANDLER
    GUARD
    LAC* DVAD; SMA!SZA; WAIT
    ION
    SMA!CMA; JMP* TRANS
    GUARD; JMP .MH
    JMP TRANS+6
/COMMAND INPUT ROUTINES
    .SIXBT 'HMD'
HMD
    LAS; AND (177777
    SAD HMD-1; JMP* HMD
    JMP E5
ZER
    LAC FA; AND (770000
    SAD (600000; JMS HMD
    JMP* ZER
/ASSIGNMENTS ARE STORED IN ASSTAB:
/    DEV / SIGNBIT + ASSTAB AD FOR ==
/    NAME(1-3)  )
/    NAME(4-6)  ) DECTAPE ONLY
/    EXT        )
/    MODE -- SIGNBIT SET IF MORE FOLLOW
DEFLT
    LAC (DS1; DAC RSW       /SET READ SWITCH
    LAC (40; DAC SYM
    DZM SBASE               /STREAM BASE ZERO
    JMS ASSIN
    JMP* DEFLT
ASSIN
    LAC (1; DAC INOUT       /1: INPUT
    LAC (IN0; JMS ASS8IN
    SAD (57; JMS RSYM       /SKIP SLASH
    ISZ INOUT               /2: OUTPUT
    LAC (OUT0; JMS ASS8IN
    JMS SKIP
    SAD .NL; SKP; FAULT     /TEST NEWLINE
    JMP* ASSIN
ASS8IN
    TAD SBASE; TAD SBASE
    DAC AI
    LAW -10; TAD SBASE
    DAC AJ
A52 JMS ASS1IN; DAC CJ
    LAC* AI                 /ALREADY SET?
    SNA; LAC CJ             /IGNORE CJ IF YES
    DAC* AI
    ISZ AI; ISZ AI
    JMS SKIP
    JMS SEP; FAULT          /TEST SEPARATOR
    SAD (54; JMS RSYM       /SKIP COMMA
    ISZ AJ; JMP A52
    JMP* ASS8IN
ASS1IN
    JMS DEVIN
    LAC DEV
    SNA; JMP* ASS1IN        /NOT SPECIFIED ->
    LAC CI; DAC CJ          /START AD FOR THIS ASS
AS1 LAC DEV; DAC* CI
    AND (777770
    SAD (757560; JMP AS6    /'==' ->
    ISZ CI
    SAD DT0; SKP; JMP AS4   /NOT DECTAPE ->
    JMS NAMEIN
    LAC FA; DAC* CI; ISZ CI /NAME(1-3)
    LAC FB; DAC* CI; ISZ CI /NAME(4-6)
    LAC FA; SPA; JMP AS3    /SCRATCH (NO EXT) ->
    LAC INOUT; SZA; JMP AS2 /NOT PROG ->
    LAC OBJ; DAC FC
    JMP AS3
AS2 JMS EXTIN               /READ EXTENSION
AS3 LAC FC; DAC* CI; ISZ CI /EXT
AS4 JMS MODEIN
    LAC MODE; DAC* CI
    JMS SKIP
    SAD (53; JMP AS5        /'+'
    SAD (72; JMP AS5        /':'
    ISZ CI
    LAC CJ                  /EXIT WITH START AD
    JMP* ASS1IN
AS5 JMS RSYM
    LAC* CI; TAD (400000    /FLAG MODE WORD
    DAC* CI; ISZ CI
    JMS DEVIN
    JMP AS1
AS6 XOR DEV; RCL            /STREAM<<1
    TAD (IN0; DAC DUMP
    LAC* DUMP
    SNA; JMP E12
    TAD (400000; DAC* CI
    ISZ CI
    LAC CJ
    JMP* ASS1IN
/READ DEVICE MNEMONIC
    .SIXBT 'X'
DEVIN
    DZM DEV
    JMS SKIP
    JMS SEP; SKP; JMP* DEVIN
    DZM FA; DZM FB
    SAD (56; JMP DE5        /'.' ->
    AND (77; DAC DEV
    SAD (75; JMP DE6        /'=' ->
    JMS LET; FAULT
    JMS LET; SKP; JMP DE2   /SECOND LETTER ->
    LAC DEV
    SAD (25; JMP DE5+3      /'U' ->
    SAD (27; JMP DE5+5      /'W' ->
    CLA
DE2 JMS APPEND; DEV
    JMS LET; SKP; JMP DE3   /THIRD LETTER ->
    JMS DIG; CLA
    JMS APPEND; DEV
    LAC DEV
    SAD DEVIN-1; JMS HMD
    JMP* DEVIN
DE3 JMS APPEND; DEV
    LAC DEV; DAC FA
    JMP DE5+3
DE5 JMS RSYM
    LAC SYS; SKP
    LAC U; SKP
    LAC W; DAC DEV
    JMP* DEVIN
DE6 JMS RSYM
    XOR (75; SZA!CLA; JMP .+3 /NOT SECOND '=' ->
    JMS RSYM
    LAC (75
    JMS APPEND; DEV
    JMS DIG; FAULT
    JMS APPEND; DEV
    JMP* DEVIN
DTDEVIN
    JMS DEVIN
    LAW -10; AND DEV
    SAD DT0; JMP* DTDEVIN
    JMP E12
/READ FILE NAME
NI
NAMEIN
    DZM FB; DZM FC
    LAC FA; SZA; JMP N2
    JMS SKIP
    LAW -3; DAC NI
N1  JMS LET; SKP; JMP .+7
    JMS DIG; SKP; JMP .+4
    JMS SEP; FAULT; CLA
    JMS APPEND; FA
    ISZ NI; JMP N1
N2  LAW -3; DAC NI
N4  JMS LET; SKP; JMP .+7
    JMS DIG; SKP; JMP .+4
    JMS SEP; FAULT; CLA
    JMS APPEND; FB
    ISZ NI; JMP N4
    JMS LET; JMP* NAMEIN
    JMP .-2
EXTIN
    JMS SKIP
    LAW -3; DAC NI
N6  JMS DIG; SKP; JMP .+3
    JMS LET; CLA
    JMS APPEND; FC
    ISZ NI; JMP N6
    JMP* EXTIN
MODEIN
    DZM MODE
    JMS SKIP
    SAD (50; SKP; JMP* MODEIN
    JMS RSYM
    JMS LET; FAULT
    JMS APPEND; MODE
    LAC SYM
    SAD (51; SKP; JMP .-7
    JMS RSYM
    JMP* MODEIN
/TEST NEXT WORD TO BE NUM
/READ IF YES
NUM
NUMIN
    DZM NUM
    JMS SKIP
    JMS DIG; JMP* NUMIN
N8  AND (17; DAC DUMP
    LAC NUM; RCL; RCL
    TAD NUM; RCL
    TAD DUMP; DAC NUM
    JMS DIG; SKP; JMP N8
    ISZ NUMIN
    JMP* NUMIN
APPEND
    DAC WL1
    LAC* APPEND; DAC WL2
    ISZ APPEND
    LAC* WL2; CLL
    RTL; RTL; RTL
    TAD WL1; DAC* WL2
    JMP* APPEND
/TEST NEXT SYM TO BE DIGIT
/READ IF YES
DIG
    LAC SYM; DAC WL1
    LAW -71; TAD SYM        /SYM-'9'
    SMA!SZA; JMP* DIG
    TAD (11
    SPA; JMP* DIG
    JMS RSYM
    LAC WL1; ISZ DIG
    JMP* DIG
/TEST NEXT SYM TO BE LETTER
/READ IF YES
LET
    LAC SYM; DAC WL1
    LAW -132; TAD SYM       /SYM-'Z'
    SMA!SZA; JMP* LET
    TAD (32
    SPA; JMP* LET
    JMS RSYM
    LAC WL1; AND (77
    ISZ LET
    JMP* LET
/TEST NEXT SYM TO BE SEPARATOR
SEP
    LAC SYM
    SAD (40; ISZ SEP        /SPACE
    SAD (54; ISZ SEP        /COMMA
    SAD (57; ISZ SEP        /SLASH
    SAD .NL; ISZ SEP        /NL
    SAD (53; ISZ SEP        /PLUS
    SAD (50; ISZ SEP        /LB
    SAD (51; ISZ SEP        /RB
    SAD (72; ISZ SEP        /COLON
    JMP* SEP
SKIP
    LAC SYM
    SAD (40; SKP; JMP* SKIP
    JMS RSYM
    JMP SKIP+1
/READ SYMBOL
RSYM
    LAC SYM
    SAD .NL; JMP* RSYM      /HOWL ON NL
    JMP* RSW                /READ SWITCH
RS1 LAC .CS                 /TT IN?
    JMS TTQ; JMP RS2        /NO ->
    CLL!CLA; JMS* .CS       /CALL SR
    SNL; JMP RS9            /EOF ->
    DAC SYM
    LAC .CS+1               /TT OUT?
    JMS TTQ; JMP RS4        /NO ->
    JMP RS5
RS2 CLL!CLA; JMS* .CS       /CALL SR
    SNA; JMP RS2            /PSEUDO-EOF? ->
    SNL; JMP RS9            /EOF ->
    DAC SYM
RS4 LAC SYM
    STL; JMS* .CS+1         /ECHO
RS5 LAC .CS+2; SZA          /KEEP CONTROL LIM
    LAC .LO; DAC .CS+2      /UPDATED
    LAC SYM
    SAD (73; LAC .NL        /NL FOR SEMI-COLON
    TAD (-40; SPA; JMP RS6  /CONTROL ->
    TAD (-100; SPA; TAD (40 /ENSURE UPPER CASE
    TAD (100
    SKP
RS6 LAC .NL
    DAC SYM; DZM* .CS
    JMP* RSYM
RS9 DZM .CS+2; DZM SYM      /CLEAR CONTROL LIMIT
    JMP M1                  /=> RESTART
/PSEUDO INPUT FOR DEFAULTS
WORD 0
DS1 LAC* DEFLT; DAC WORD
    ISZ DEFLT
    JMS RSW; JMS RSW; JMS RSW
    JMP DS1
RSW RS1
    LAC WORD
    SMA!CLL; STL            /RESTORE BIT7
    RTL; RTL; RTL
    DAC WORD
    RAL; AND (177
    SAD (73; LAC .NL
    DAC SYM
    JMP* RSYM
/PRINT SYMBOL
PSYM
    DAC DUMP
    LAC LOG-1; SMA; JMP PS2 /NOT PROMPT ->
    LAC .CS                 /TT IN?
    JMS TTQ; JMP PS2        /NO ->
    LAC .KE                 /KB IDLE?
    SAD .KI; SKP; JMP PS1   /NO ->
    LAC DUMP; TAD LOG-1
    CLL; JMS* .CS           /ISSUE PROMPT
PS1 LAC .CS+1               /TT OUT?
    JMS TTQ; SKP; JMP* PSYM /YES =>
PS2 LAC DUMP
    STL; JMS* .CS+1         /SEND TO REPORT STREAM
    JMP* PSYM
    0
LOG
    LAC* LOG; DAC WL1
    ISZ LOG
    LAW -3; DAC WL2
LO1 LAC WL1
    SMA!CLL; STL
    RTL; RTL; RTL
    DAC WL1
    RAL; AND (177
    SAD (73; JMP LO3
    SAD (100; JMP LO2
    SAD (136; LAC (15
    SAD (42; LAC .NL
    JMS PSYM
LO2 ISZ WL2; JMP LO1
    JMP LOG+1
LO3 DZM LOG-1
    JMP* LOG
GUARD=JMS 3;WAIT=JMP 2
.MA=16000;.NF=16010;.SD=16020
.KK=16030;.KI=16040;.FN=16050
.LL=16060;.CS=16070;.LC=16100
.DH=16110;.MH=16120;.KH=16130
.TH=16140;.SS=16150;.IM=16160
.KE=16170;.LE=16200;.BL=16210
.DG=16220;.LO=16230;.PE=16240
.SL=16250;.UL=16260;.GL=16270
.TK=16300;.NL=16310;.LI=16320
 .END
