/DECTAPE FULL WORD INPUT AND OUTPUT PROCESSORS

/DECTAPE INPUT: FULL WORD
 .LOC 17000
    DISIZE
    .SIXBT 'DTF'
    200001                  /DT INPUT
DIUNIT 1
DIBLK1 2
    .SIXBT 'N'
DIF
    SPA!STL; JMP DI8        /CLOSE ->
DI1 LAC* DICA; ISZ DICA     /PICK UP WORD
    ISZ DIWC; JMP* DIF      /NOT LAST =>
    SPA; JMP DI8            /EOF ->
    DAC DIWC                /TEMP
DIX CMA; TAD DIV+1          /COMPARE WITH CURRENT
    SPA; JMP DI2            /SAME DIRECTION ->
    LAC DIX; DAC DIY        /SWOP CMA
    XOR L1; DAC DIX         /AND NOP
DI2 LAC DIWC
DIY NOP
    DAC DIV+1               /BLOCK NUMBER
    LAC DIV+3; SNA          /IF INITIAL ENTRY
    JMS .BU; DAC DIV+3      /GET BUFFER
    DAC DICA                /CA = BUFF START
    LAW -400; DAC DIWC      /256[10]
DI3 LAC L2000; TAD DIUNIT   /FUNCTION + UNIT
    DAC DIV
    LAC LDIV                /AD OF PARAM VECTOR
    GUARD; JMP .DH          /CALL HANDLER
    GUARD                   /WAIT FOR TRANSFER
    LAC DIV; SMA!SZA; WAIT
    ION
    SMA!CMA!STL; JMP DI1    /OK ->
    GUARD; JMP .MH          /REPORT
    JMP DI3
DI8 LAC DIV+3               /RELEASE BUFFER
    SZA; JMS .BU            /IF FILE OPEN
    DZM DIV+1; DZM DIV+3    /SET INDICATOR
    LAC LBLK1; DAC DICA     /SET CA FOR BLOCK 1
    CLL!CLC; DAC DIWC       /SET WC FOR OVERFLOW
    LAC DIF-1               /CONCATENATED FILE
    JMP* DIF
L1 1;L2000 2000
LDIV DIV
LBLK1 DIBLK1
DICA  DIBLK1
DIWC -1
DIV 0; 0; -400; 0
DISIZE=.

/DECTAPE OUTPUT: FULL WORD (SCRATCH FILE)
 .LOC 17000
    DSSIZE
    .SIXBT 'DTF'
    200002                  /DT OUTPUT
DSUNIT 1
DSBLK1 2
DSBC1 3
DSINC 4
DSCA  1                     /NOT GEN PARAM
DSO
    SNL; JMP DS7            /CLOSE ->
    ISZ DSCA
    ISZ DSWC; JMP DS4       /NOT BLOCK END ->
    DAC DSWL
    LAC DSV+3; SZA; JMP DS2 /FILE OPEN ->
    JMS .BU; DAC DSV+3      /GET BUFFER
    LAC DSBC1; DAC DSBC     /BLOCK COUNT (NEG)
    LAC DSBLK1
    JMP DS3
DS2 ISZ DSBC; SKP; JMP DS8  /NO BLOCKS LEFT ->
    LAC DSV+1; TAD DSINC    /LINK TO NEXT
    JMS SWRITE
    LAC* DSCA
DS3 DAC DSV+1               /CURRENT BLOCK
    LAC DSV+3; DAC DSCA     /CA = BUFF START
    LAW -377; DAC DSWC      /255[10] DATA WORDS
    LAC DSWL
    STL
DS4 DAC* DSCA
    JMP* DSO
DS7 LAC DSV+3               /FILE OPEN?
    SNA; JMP DS9            /NO ->
    ISZ DSCA; DZM* DSCA     /ZERO REST
    ISZ DSWC; JMP .-3
DS8 CLC; JMS SWRITE         /LAST BLOCK
    LAC DSV+3; JMS .BU      /RELEASE BUFFER
    DZM DSV+3               /SET CLOSED
DS9 CLL!CLC; DAC DSWC       /SET TO CAUSE OVERFLOW
    JMP* DSO
/OUTPUT BLOCK
SWRITE
    DAC* DSCA               /LAST WORD (LINK)
SW1 LAC L4000; TAD DSUNIT   /FUNCTION + UNIT
    DAC DSV
    LAC LDSV
    GUARD; JMP .DH          /CALL HANDLER
    GUARD                   /WAIT FOR TRANSFER
    LAC DSV; SMA!SZA; WAIT
    ION
    SMA!CMA; JMP* SWRITE    /OK =>
    GUARD; JMP .MH          /REPORT
    JMP SW1
L4000 4000
LDSV DSV
DSWL;DSBC
DSWC  -1
DSV 0; 0; -400; 0
DSSIZE=.

/DECTAPE OUTPUT: FULL WORD (NAMED FILE)
 .LOC 17000
    .SIZE
    042446                  /'DTF'+40
    200002                  /DT OUTPUT
                            /DIRECTORY COMES HERE
UNIT 1
INC 4
CA  1                       /NOT GEN PARAM
DNO
    SNL; JMP DN7            /CLOSE ->
    ISZ CA
    ISZ WC; JMP DN4
    DAC I
    LAC DV+3                /FILE CLOSED?
    SPA!CLL; JMP* DNO       /YES =>
    SZA; JMP DN2            /OPEN ->
    JMS .BU; DAC DV+3       /GET BUFFER
    CLC; JMS ADVANCE        /FIND FIRST
    LAC BN; DAC BLK1        /FREE BLOCK
    JMP DN3
DN2 CLC; TAD INC; CMA       /-INC
    JMS ADVANCE             /FIND FREE BLOCK
    LAC BN; JMS WRITE
DN3 LAC BN; DAC DV+1        /BLOCK NUMBER
    LAC DV+3; DAC CA        /CA = BUFF START
    LAW -377; DAC WC        /255[10] DATA WORDS
    LAC I
    STL
DN4 DAC* CA
    JMP* DNO
DN7 LAC DV+3                /FILE OPEN?
    SPA!SNA!CLL!CLC; JMP* DNO /NO =>
    ISZ CA; DZM* CA         /ZERO REST
    ISZ WC; JMP .-3
DN8 CLC; JMS WRITE          /LAST BLOCK
    LAC DV+3; JMS .BU       /RELEASE BUFFER
    LAC BLK1; XOR (400000   /STORE FIRST BN
    DAC INC                 /OVERWRITING INC FOR EXEC
    CLL!CLC; DAC WC; DAC DV+3
    JMP* DNO
/MOVE ON BIT POSITION
ADVANCE
A1  DAC WC                  /MINIMUM INC (NEG)
    LAC BIT                 /BIT POSITION
A2  RCR; SNL; JMP A3        /STILL IN AC ->
    ISZ BWC; RAR!SKP; JMP DN8 /NO BLOCKS LEFT ->
A3  ISZ BN; ISZ WC; JMP A2  /NOT FAR ENOUGH
    DAC BIT
    LAC (UNIT; TAD BWC      /COMPUTE BIT-MAP
    DAC J                   /WORD ADDRESS
    LAC* J; AND BIT         /BIT SET?
    SZA!CLC; JMP A1         /YES ->
    LAC* J; XOR BIT         /ZERO BIT
    DAC* J
    JMP* ADVANCE
WRITE
    DAC* CA                 /LAST WORD
W1  LAC (4000; TAD UNIT     /FUNCTION + UNIT
    DAC DV
    LAC (DV
    GUARD; JMP .DH          /CALL HANDLER
    GUARD                   /WAIT FOR TRANSFER
    LAC DV; SMA!SZA; WAIT
    ION
    SMA!CMA; JMP* WRITE     /OK ->
    GUARD; JMP .MH          /REPORT
    JMP W1
WC  -1
BWC -40
BIT 400000
I;J;BLK1;BN
DV  0; 0; -400; 0
GUARD=JMS 3;WAIT=JMP 2
.BU=16000;.DH=16010;.MH=16020
 .END