        .title  putr
;++
;
; Peripheral Utility Transfer Routines.
;
; Access TSS/8 PUTR DECtapes.
;
; 01-Jul-92     JMBW    Created.
;
;--
        .mcall  .close,.csispc,.exit,.gtlin,.print,.settop
;
.enter= emt!375
.writw= emt!375
;
eis$$=  1               ;NZ => processor has EIS
;
blkmax= 80.             ;# blocks in buffer
;
tcst=   177340          ;status register
tccm=   177342          ;command register
tcwc=   177344          ;word count
tcba=   177346          ;bus address
tcdt=   177350          ;data register
;
; command bits
err=    100000          ;error bit (sets RDY)
rev=    4000            ;reverse direction
fwd=    0000            ;forward direction if REV=0
rdy=    200             ;ready bit
ie=     100             ;interrupt enable
sat=    0*2             ;stop all transports
rnum=   1*2             ;read block number
rdata=  2*2             ;read data
rall=   3*2             ;read all
sst=    4*2             ;stop selected transport
wrtm=   5*2             ;write timing and mark tracks
wdata=  6*2             ;write data
wall=   7*2             ;write all
do=     1               ;actually do the command in bits <3:1>
;
tab=    11
lf=     12
cr=     15
;
; keyword entry in table
;
        .macro  key     word,addr
$$m=    0
$$l=    0
        .irpc   c,<word>
.if idn <c>,<->
$$m=    $$l
.iff
$$l=    $$l+1
.endc
        .endr
.iif eq $$m, you goofed
        .byte   $$l,$$m
        .irpc   c,<word>
.iif dif <c>,<->, .byte ''c
        .endr
        .even
        .word   addr
        .endm
;
start:  mov     #start,sp       ;init stack
        .settop #endmem-2       ;alloc memory
        bcs     10$
        mov     #sat!do,@#tccm  ;stop all transports (init)
        .gtlin  #lbuf,#prompt   ;read command
        mov     #lbuf,r5        ;point at line
        mov     #cmdtab,r4      ;pt at table
        call    parse           ;parse, dispatch
        br      start
10$:    .print  #nomem          ;not enough memory
        .exit
;
cmdtab: key     <B-ACK>,back    ;search for next block backwards
        key     <DI-RECTORY>,direct
        key     <DU-MP>,dump
        key     <F-ORWARD>,fwds ;search for next block forwards
        key     <O-DD>,odd
        key     <R12-D>,read    ;read entire tape
        key     <R18-D>,read15  ;read pdp15 tape
        key     <REW-IND>,rewind ;rewind tape
        .byte   0
        .even
;+
;
; Search backwards for first block.
;
;-
back:   ; search backwards
        mov     #rev!rnum!do,@#tccm ;unit 0, reverse, RNUM, go
        bit     #err!rdy,@#tccm ;done?
        beq     .-6             ;spin
        bmi     20$             ;punt on error
        mov     @#tcdt,r1       ;get record number
        mov     #lbuf,r5        ;pt at buffer
        mov     #5,r0           ;count
10$:    movb    #' ,(r5)+       ;pad with blanks
        sob     r0,10$          ;loop
        mov     r1,-(sp)        ;save
        call    decout          ;convert number
        mov     (sp)+,r0        ;restore
        movb    #' ,(r5)+       ;add a blank
        call    oct6            ;display in octal too
        clrb    (r5)            ;mark end
        .print  #lbuf           ;print msg
        rts     pc
20$:    jmp     dterr           ;print msg
;+
;
; Search forwards for first block.
;
;-
fwds:   ; search forwards
        mov     #fwd!rnum!do,@#tccm ;unit 0, forward, RNUM, go
        bit     #err!rdy,@#tccm ;done?
        beq     .-6             ;spin
        bmi     20$             ;punt on error
        mov     @#tcdt,r1       ;get record number
        mov     #lbuf,r5        ;pt at buffer
        mov     #5,r0           ;count
10$:    movb    #' ,(r5)+       ;pad with blanks
        sob     r0,10$          ;loop
        mov     r1,-(sp)        ;save
        call    decout          ;convert number
        mov     (sp)+,r0        ;restore
        movb    #' ,(r5)+       ;add a blank
        call    oct6            ;display in octal too
        clrb    (r5)            ;mark end
        .print  #lbuf           ;print msg
        rts     pc
20$:    jmp     dterr           ;print msg
;+
;
; Show the directory.
;
;-
direct: mov     #2,r3           ;dir is block 2
        mov     #1,r4           ;blk count
        mov     #buf,r5         ;buffer
 dec r3
 inc r4
        call    read12          ;read the block
        mov     buf,r3          ;-length
 mov buf+512.,r3
        bis     #170000,r3      ;sign-extend
        neg     r3              ;abs val
        mov     #buf+<5*2>,r4   ;point at buffer
 add #512.,r4
10$:    ; display next file
        mov     #lbuf,r5        ;line buffer
        tst     (r4)            ;.EMPTY.?
        beq     50$
        mov     #3,r2           ;3 words
20$:    mov     (r4)+,r0        ;get next
        mov     r0,r1           ;copy
.if ne eis$$
        ash     #-6,r1          ;right 6 bits
.iff
        asl     r1              ;left 2 bits
        asl     r1
        swab    r1              ;and right 8
.endc
        call    text6           ;left 6 bits
        mov     r0,r1           ;copy
        call    text6           ;right 6 bits
        sob     r2,20$          ;loop
        ; extension (???)
        mov     (r4)+,r0        ;get it
        cmp     r0,#53          ;only one I know
        bne     30$
        mov     #".P,(r5)+      ;.PAL
        mov     #"AL,(r5)+
        br      40$
30$:    mov     #".?,(r5)+      ;.???
        mov     #"??,(r5)+
40$:    mov     (r4)+,r2        ;save date
        br      60$
50$:    ; .EMPTY.
        mov     #".E,(r5)+      ;.EMPTY.
        mov     #"MP,(r5)+
        mov     #"TY,(r5)+
        mov     #". ,(r5)+
        mov     #"  ,(r5)+
        clr     r2              ;no date
        tst     (r4)+           ;skip the 0 (pt at size)
60$:    ; size (date is in r2)
        mov     (r4)+,r1        ;get -size
        bis     #170000,r1      ;sign-extend
        neg     r1              ;abs val
        mov     #"  ,(r5)+      ;4 blanks
        mov     #"  ,(r5)+
        call    decout          ;print it
        ; date (if any)
        mov     r2,r1           ;copy date
        beq     70$             ;no date, skip
        mov     #"  ,(r5)+      ;3 blanks
        movb    #' ,(r5)+
        swab    r1              ;right 8.
        bic     #^C17,r1        ;isolate low 4
        call    decout          ;display
        movb    #'/,(r5)+       ;/
        mov     #"  ,(r5)+      ;2 blanks
        mov     r2,r1           ;copy date again
.if ne eis$$
        ash     #-3,r1          ;right 3
.iff
        asr     r1              ;right 3
        asr     r1
        asr     r1
.endc
        bic     #^C37,r1        ;isolate low 5
        call    decout          ;display
        mov     #"/ ,(r5)+      ;/, 2 blanks
        movb    #' ,(r5)+
        mov     r2,r1           ;copy date yet again
        bic     #^C7,r1         ;isolate low 3
;;; do the OS/8 DIRECT trick to fix this within the last 8 years
        add     #78.,r1 ;;;hard coded for now
        call    decout          ;display
70$:    clrb    (r5)            ;mark end
        .print  #lbuf           ;dump buffer
        dec     r3              ;loop
        bne     10$
        rts     pc
;+
;
; Dump a block of the tape.
;
;-
xxxx:   .word   0
odd:    mov     #^B1100,xxxx
        br      dump1
dump:   clr     xxxx
dump1:  call    getnum          ;get a number
        mov     r0,r3           ;block number
        mov     #buf,r5         ;read buffer
        mov     #1,r4           ;# blks
        call    read12          ;read the block
        mov     #buf,r4         ;point at buf
        clr     r3              ;no half-finished char
        mov     xxxx,r3 ;;;
10$:    ; display next word
        mov     #lbuf,r5        ;point at buffer
;;;.rem _
        ; octal
        mov     (r4),r0         ;get this word
        call    oct4            ;display it
        movb    #' ,(r5)+       ;blank
        ; sixbit
        mov     (r4),r0         ;get it again
        mov     r0,r1           ;copy
.if ne eis$$
        ash     #-6,r1          ;right 6 bits
.iff
        asl     r1              ;left 2
        asl     r1
        clrb    r1              ;zap low byte
        swab    r1
.endc
        add     #' ,r1          ;convert to ASCII
        movb    r1,(r5)+        ;first char
        bic     #^C77,r0        ;second char
        add     #' ,r0          ;cvt to ASCII
        movb    r0,(r5)+        ;second char
        movb    #' ,(r5)+       ;blank
        ; 6-bit trimmed ASCII
        mov     (r4),r0         ;get it again
        mov     r0,r1           ;copy
.if ne eis$$
        ash     #-6,r1          ;right 6 bits
.iff
        asl     r1              ;left 2
        asl     r1
        swab    r1              ;right 8
.endc
        call    text6           ;display one char
        mov     r0,r1           ;copy
        call    text6           ;display the other
        movb    #' ,(r5)+       ;blank
;       ; 3-into-2 ASCII
;       mov     (r4)+,r0        ;get a char
;       call    prnchr          ;display as printing char
;       tst     r3              ;is does this complete the 3rd char?
;       bne     20$             ;yes
;       mov     r0,r3           ;no, save
;       bis     #1,r3           ;guarantee non-zero
;       br      30$
;20$:   ; high 4 bits of this and prev word make a 3rd char
;.if ne eis$$
;       ash     #-4,r3          ;right 4
;.iff
;       asr     r3              ;right 4
;       asr     r3
;       asr     r3
;       asr     r3
;.endc
;       swab    r0              ;right 8
;       bic     #^C17,r0        ;isolate
;       bic     #^C36,r3        ;yep
;       bis     r3,r0           ;build new char
;       call    prnchr          ;display it
;       clr     r3              ;now no pending char
;30$:
;;_
        ; 3-into-2 TSS/8 ASCII
        mov     (r4)+,r1        ;get next word
        tst     r3              ;starts with half-char?
        bne     20$             ;yes
        mov     r1,r3           ;no, it will now
        bis     #20,r3          ;guarantee non-zero
.if ne eis$$
        ash     #-4,r1          ;right 4
.iff
        lose
.endc
        br      30$             ;print, return
20$:    mov     r3,r0           ;copy
.if ne eis$$
        ash     #4,r1           ;left 4
        ashc    #4,r0           ;left 4
.iff
        lose
.endc
        call    prnchr          ;middle char
        swab    r1              ;right 8
        clr     r3              ;r3=0
30$:    mov     r1,r0           ;put in r0
        call    prnchr
        clrb    (r5)            ;mark end
;;;  movb #200,(r5) ;;;;
        .print  #lbuf           ;display
        cmp     r4,#buf+<129.*2> ;off end of block?
        blo     10$             ;loop if not
        rts     pc
;+
;
; Read entire 12 bit tape into a file.
;
;-
read:   call    skip            ;skip blanks
        beq     50$
        .csispc #buf,#defext,r5 ;parse filename
        bcs     50$
        tst     (sp)+           ;no switches, right?
        bne     50$
        mov     #earea,r0       ;point at area
        .enter                  ;create file (handler assumed LOADed)
        bcs     50$
        clr     wblk            ;init block #
10$:    ; read next bufferload
        mov     #buf,r5         ;pt at buf
        mov     wblk,r3         ;starting block #
        mov     #2702,r4        ;# blocks/tape (1474.)
        sub     r3,r4           ;find # to read
        beq     40$             ;(none)
        cmp     r4,#blkmax      ;>buf size?
        blo     20$
         mov    #blkmax,r4      ;stop at end of buf
20$:    mov     r5,r0           ;pt at buf
        mov     r4,r1           ;block count
        swab    r1              ;word count
30$:    clr     (r0)+           ;clear out buf (to fill gaps between blocks)
        sob     r1,30$
        mov     r0,-(sp)
        call    read12          ;read blocks
        cmp     (sp)+,r5
        bne     .
        mov     r4,r0           ;copy block count
        swab    r0              ;convert to word count
        mov     r0,wwc          ;save
        mov     #warea,r0       ;point at area
        .writw
        bcs     60$
        add     r4,wblk         ;advance block #
        br      10$             ;loop

40$:    .close  #0
        rts     pc

50$:    .print  #crerr
        jmp     start

60$:    .print  #wrerr
        jmp     start

;+
;
; Read entire 18 bit tape into a file.
;
;-
read15: call    skip            ;skip blanks
        beq     50$
        .csispc #buf,#defext,r5 ;parse filename
        bcs     50$
        tst     (sp)+           ;no switches, right?
        bne     50$
        mov     #earea,r0       ;point at area
        .enter                  ;create file (handler assumed LOADed)
        bcs     50$

        clr     wblk            ;init block #
10$:    ; read next bufferload
        mov     #buf,r5         ;pt at buf
        mov     wblk,r3         ;starting block #
        asr     r3				; divided by 2
        mov     #576.,r4        ;# blocks/tape (576 - note: pdp11 is 578)
        sub     r3,r4           ;find # to read
        beq     40$             ;(none)
        cmp     r4,#blkmax/2    ;>buf size?
        blo     20$
        mov     #blkmax/2, r4   ;stop at end of buf
20$:   
        call    read18          ;read blocks
;        cmp (sp)+,r5
;        bne .
        mov     r4,r0           ;copy block count
        swab    r0              ;convert to word count
        asl     r0				; two blocks for each 18 bit block
        mov     r0,wwc          ;save
        mov     #warea,r0       ;point at area
        .writw
        bcs     60$
        add     r4,wblk         ;advance block #
        add     r4,wblk         ; by two or each 18 bit block
        br      10$             ;loop

40$:    .close  #0
        rts     pc

50$:    .print  #crerr
        jmp     start

60$:    .print  #wrerr
        jmp     start


;+
;
; Rewind tape.
;
;-
rewind: mov     #rev!rnum!do,@#tccm ;unit 0, reverse, RNUM, go
10$:    bit     #err!rdy,@#tccm ;done?
        beq     10$             ;spin
        bmi     20$             ;punt on error
        tst     @#tcdt          ;there yet?
        bne     10$             ;no
        rts     pc
20$:    jmp     dterr           ;print msg
;
       .sbttl  utility routines
;+
;
; Parse a keyword and look it up.
;
; r5    ptr into line
; r4    KEY table
;
;-
parse:  call    skip            ;skip blanks
        beq     70$             ;null line
        mov     r5,r3           ;point at keyword
10$:    cmpb    (r5)+,#<' >     ;blank or ctrl char or eol?
        bhi     10$             ;no, loop
        dec     r5              ;yes, unget
        mov     r5,r2           ;copy
        sub     r3,r2           ;find length
20$:    ; check next entry in table
        movb    (r4)+,r0        ;get total length
        beq     60$             ;end of table
        movb    (r4)+,r1        ;get length to match
        cmp     r2,r0           ;too long?
        bhi     50$
        cmp     r2,r1           ;too short?
        blo     50$
        ; length in range, compare
        mov     r3,r1           ;copy our ptr
        mov     r2,-(sp)        ;save our length
30$:    dec     r0              ;fix count in case of no match
        cmpb    (r1)+,(r4)+     ;match?
        bne     40$             ;no
        sob     r2,30$          ;loop
        tst     (sp)+           ;it's a match, purge stack
        add     r0,r4           ;skip rest of keyword
        inc     r4              ;.EVEN
        bic     #1,r4
        jmp     @(r4)+          ;dispatch
40$:    ; not a match
        mov     (sp)+,r2        ;restore
50$:    add     r0,r4           ;skip to end
        add     #3,r4           ;.EVEN, skip dispatch address
        bic     #1,r4
        br      20$             ;try next entry
60$:    ; no match
        .print  #badkw          ;error
70$:    jmp     start
;+
;
; Parse an octal number.
;
;-
getnum: call    skip            ;skip blanks
        beq     30$
        clr     r0              ;init
10$:    movb    (r5)+,r1        ;get next char
        beq     20$             ;eol
        sub     #'0,r1          ;cvt to binary
        cmp     r1,#7           ;octal digit?
        bhi     20$             ;no
.if ne eis$$
        ash     #3,r0           ;left 3
.iff
        asl     r0              ;left 3
        asl     r0
        asl     r0
.endc
        bis     r1,r0           ;OR in new digit
        br      10$             ;loop
20$:    dec     r5              ;unget
        rts     pc
30$:    .gtlin  #lbuf,#number   ;prompt for new line
        mov     #lbuf,r5        ;point
        br      getnum          ;try again
;+
;
; Skip blanks and tabs.  Z=1 => blank line.
;
;-
skip:   movb    (r5)+,r0        ;get next char
        beq     10$             ;EOL
        cmp     r0,#<' >        ;blank or ctrl char?
        blos    skip            ;loop if so
        dec     r5              ;-1
10$:    rts     pc
;+
;
; Display a decimal number.
;
; r1    number
; r5    buffer ptr (end of buf, restored on return)
;
;-
decout: mov     r5,-(sp)        ;save
10$:    clr     r0              ;0-extend
.if ne eis$$
        div     #10.,r0         ;/10
.iff
        lose
.endc
        bis     #'0,r1          ;cvt to ASCII
        movb    r1,-(r5)        ;save
        mov     r0,r1           ;copy quotient
        bne     10$             ;loop if non-zero
        mov     (sp)+,r5        ;restore
        rts     pc
;+
;
; Print 4- or 6-digit octal number.
;
; r5    buf ptr (updated)
; r0    number
;
;-
oct6:   mov     #6,r1           ;# digits
        br      octn
oct4:   mov     #4,r1           ;# digits
octn:   ; R1=# digits
        add     r1,r5           ;skip to end
        mov     r1,-(sp)        ;save
10$:    mov     r0,r2           ;copy
        bic     #^C7,r2         ;isolate low 3 bits
        bis     #'0,r2          ;cvt to ASCII
        movb    r2,-(r5)        ;save
.if ne eis$$
        ash     #-3,r0          ;right 3 bits
.iff
        asr     r0              ;right 3 bits
        asr     r0
        asr     r0
.endc
        bic     #160000,r0      ;clear high bits
        sob     r1,10$          ;loop
        add     (sp)+,r5        ;skip to end again
        rts     pc
;+
;
; Print low 8 bits of r0 as a printing char.
;
;-
prnchr: bic     #^C177,r0       ;isolate low 7
        beq     30$     ;;;;;
        cmp     r0,#177         ;rubout?
        beq     30$             ;yes
        cmp     r0,#40          ;control char
        blo     20$             ;yes
10$:    movb    r0,(r5)+        ;save
        rts     pc

20$:    cmp     r0,#cr          ;cr or lf?
        beq     10$
        cmp     r0,#lf
        beq     10$
        cmp     r0,#tab         ;or tab?
        beq     10$
        movb    #'.,(r5)+       ;dot instead
30$:    rts     pc
;+
;
; Print trimmed ASCII char in r1.
;
;-
text6:  bic     #^C77,r1        ;isolate
        beq     20$             ;0, skip
        bit     #40,r1          ;40's bit set?
        bne     10$             ;yes
         bis    #100,r1         ;no, set 100's bit
10$:    movb    r1,(r5)+        ;save
        rts     pc

20$:    movb    #' ,(r5)+       ;blank
        rts     pc
;
       .sbttl  DECtape I/O routines
;+
;
; Search for a specified block.
;
; Ripped off from TC11 manual.
;
; r3    block to find
;
;-
search: mov     #5+1,r0         ;reverse directions 5 times, then give up
        mov     r3,r2           ;save
        sub     #8.,r2          ;offset (allow for turnaround)
10$:    ; search backwards
        dec     r0              ;too many reversals?
        beq     90$
20$:    mov     #rev!rnum!do,@#tccm ;unit 0, reverse, RNUM, go
30$:    bit     #err!rdy,@#tccm ;done?
        beq     30$             ;spin
        bmi     70$             ;punt on error
        mov     @#tcdt,r1       ;get block
        bic     #170000,r1      ;some PDP-8 tapes have ones in high 4 bits
        cmp     r1,r2           ;there yet?
        bgt     20$             ;keep rewinding if not
40$:    ; search forwards
        dec     r0              ;too many reversals?
        beq     90$
50$:    mov     #fwd!rnum!do,@#tccm ;unit 0, forward, RNUM, go
60$:    bit     #err!rdy,@#tccm ;done?
        beq     60$             ;wait
        bmi     80$             ;punt on error
        mov     @#tcdt,r1       ;get block
        bic     #170000,r1      ;some PDP-8 tapes have ones in high 4 bits
        cmp     r1,r3           ;there yet?
        blt     50$             ;no, keep going
        bgt     10$             ;missed it, go back
        rts     pc              ;EQ, so C=0
70$:    ; error while rewinding
        tst     @#tcst          ;check ENDZ bit
        bmi     40$             ;off begn, try forwards now
        ;... drop through (check again, who cares)
80$:    ; error while fast-forwarding
        tst     @#tcst          ;check ENDZ bit
        bmi     10$             ;off end, try backwards now
        jmp     dterr           ;punt

90$:    mov     r3, r1
        mov     #bntfnd+10., r5
        call	decout
        .print  #bntfnd         ;block not found
        .close  #0              ;close output file, if any
        jmp     start
;+
;
; Read 12-bit words.
;
; r5    buffer address
; r4    block count
; r3    starting block number
;
; Words are stored right-justified in 16-bit words.
; R4 returns actual # of blocks read.
;
;-
read12: spl     7               ;can't drop words, sorry about the LTC!
        mov     r3,dtblk        ;init block #
        mov     r3,dtblk0       ;starting blk #
        call    search          ;find block
        mov     #fwd!rall!do,@#tccm ;func=RALL
rnxt12: ; read next block as 12-bit words
        ; flush first word of block (checksum)
        bit     #err!rdy,@#tccm ;wait until ready
        beq     .-6
        bmi     30$             ;error
        tst     @#tcst          ;flush high 2 bits
        mov     @#tcdt,xorsum   ;(should be 777777 if written fwds)
        bic     #^C77,xorsum    ;it's a 6-bit sum, ignore other bits
        clr     xorsum+2
        mov     #129./3,r3      ;init loop count
10$:    ; get next 36 bits (2*18.=3*12.)
        bit     #err!rdy,@#tccm ;next word ready?
        beq     .-6
        bmi     30$             ;error
        mov     @#tcst,r0       ;get high 2 bits
        mov     @#tcdt,r1       ;and low 16 bits
        mov     r1,r2           ;copy
.if ne eis$$
        xor     r0,xorsum+2     ;add into sum
        xor     r1,xorsum
        ashc    #-6,r0          ;assemble first word
        bic     #^C7777,r1      ;isolate
        mov     r1,(r5)+        ;save
.iff
        lose
.endc
        bit     #err!rdy,@#tccm ;next word ready?
        beq     .-6
        bmi     30$             ;error
        mov     @#tcst,r0       ;get high 2 bits
        mov     @#tcdt,r1       ;and low 16 bits
.if ne eis$$
        xor     r0,xorsum+2     ;add into sum
        xor     r1,xorsum
        ash     #2,r2           ;make space
        bic     #^C3,r0         ;isolate next 2 bits
        bis     r2,r0           ;OR them in (R0=left 8 bits)
        mov     r1,r2           ;save low
        ashc    #4,r0           ;left 4 more bits
        bic     #^C7777,r0      ;2nd word
        mov     r0,(r5)+        ;save
        bic     #^C7777,r2      ;3rd word
        mov     r2,(r5)+
.iff
        lose
.endc
        sob     r3,10$          ;loop
        add     #<256.-129.>*2,r5 ;skip to next block boundary
        ; check checksum
        bit     #err!rdy,@#tccm ;next word ready?
        beq     .-6
        bmi     30$             ;error
        mov     @#tcst,r0       ;get high 2 bits
        mov     @#tcdt,r1       ;and low 16 bits
        bic     #7777,r1        ;clear low 12 bits (not part of check)
.if ne eis$$
        ; combine the 18 bit sum to get one 6-bit sum
        xor     r0,xorsum+2     ;add into sum, should give 777777
        xor     r1,xorsum       ;(6 bit sum in three pieces)
        mov     xorsum,r0       ;get low 6 bits
        mov     r0,r1           ;copy
        ash     #-6,r0          ;right-justify middle third
        xor     r1,r0           ;combine low and middle thirds
        ash     #-12.,r1        ;right-justify low 4 bits of high third
        bic     #^C17,r1        ;isolate
        xor     r1,r0           ;combine it
        mov     xorsum+2,r1     ;get high 2 bits
        ash     #4,r1           ;slide into position
        xor     r1,r0           ;compose final check in low 6 bits
        inc     r0              ;should give 77, so make it 00 if correct
        bit     #77,r0          ;right?
        bne     50$             ;checksum error if not
.iff
        lose
.endc
        ; flush word(s) at end of block and begn of next
        mov     #8.,r3          ;# 18-bit words to flush
20$:    bit     #err!rdy,@#tccm ;wait until ready
        beq     .-6
        bmi     30$             ;error
        tst     @#tcdt          ;flush word
        sob     r3,20$
        inc     dtblk           ;point at next blk
        dec     r4              ;done all blocks?
        beq     40$             ;yes
        br      rnxt12          ;go read next block

30$:    spl     0               ;ints back on
        cmp     dtblk,dtblk0    ;did we get anything?
        beq 40$
        jmp     dterr           ;no, nothing to return

40$:    mov     #sst!do,@#tccm  ;stop tape
        spl     0               ;wake up
        mov     dtblk,r4        ;get next blk #
        sub     dtblk0,r4       ;find # that we got
        rts     pc

50$:    spl     0               ;ints back on
        mov     #sst!do,@#tccm  ;stop tape
        .print  #chkerr         ;software checksum error
        jmp     start

;+
;
; Read 18-bit words.
;
; r5    buffer address
; r4    block count
; r3    starting block number
;
; Words are stored right-justified in 16-bit words.
; R4 returns actual # of blocks read.
;
;-
read18: spl     7               ;can't drop words, sorry about the LTC!
        mov     r3,dtblk        ;init block #
        mov     r3,dtblk0       ;starting blk #
        call    search          ;find block
        mov     #fwd!rall!do,@#tccm ;func=RALL

rnxt18: ; read next block as 18-bit words
        ; flush first word of block (checksum)
        bit     #err!rdy,@#tccm ;wait until ready
        beq     .-6
        bmi     30$             ;error
        tst     @#tcst          ;flush high 2 bits
        mov     @#tcdt,xorsum   ;(should be 777777 if written fwds)
        bic     #^C77,xorsum    ;it's a 6-bit sum, ignore other bits
        clr     xorsum+2

        mov     #256.,r3        ;init loop count

10$:    ; get next 18 bits
        bit     #err!rdy,@#tccm ;next word ready?
        beq     .-6
        bmi     30$             ;error
        mov     @#tcst,r0       ;get high 2 bits
        bic     #^C3, r0
        mov     @#tcdt,r1       ;and low 16 bits

.if ne eis$$
        xor     r0,xorsum+2     ;add into sum
        xor     r1,xorsum
        mov     r1,(r5)+        ;save
        mov     r0,(r5)+        ; 18 bit word into 4 bytes
.iff
        lose
.endc

        sob     r3,10$          ;loop

        ; check checksum
        bit     #err!rdy,@#tccm ;next word ready?
        beq     .-6
        bmi     30$             ;error
        mov     @#tcst,r0       ;get high 2 bits
        mov     @#tcdt,r1       ;and low 16 bits
        bic     #7777,r1        ;clear low 12 bits (not part of check)

.if ne eis$$
        ; combine the 18 bit sum to get one 6-bit sum
        xor     r0,xorsum+2     ;add into sum, should give 777777
        xor     r1,xorsum       ;(6 bit sum in three pieces)
        mov     xorsum,r0       ;get low 6 bits
        mov     r0,r1           ;copy
        ash     #-6,r0          ;right-justify middle third
        xor     r1,r0           ;combine low and middle thirds
        ash     #-12.,r1        ;right-justify low 4 bits of high third
        bic     #^C17,r1        ;isolate
        xor     r1,r0           ;combine it
        mov     xorsum+2,r1     ;get high 2 bits
        ash     #4,r1           ;slide into position
        xor     r1,r0           ;compose final check in low 6 bits
        inc     r0              ;should give 77, so make it 00 if correct
        bit     #77,r0          ;right?
;       bne     50$             ;checksum error if not
.iff
        lose
.endc

        ; flush dectape word(s) at end of block and start of next
        mov     #8.,r3          ;# 18-bit words to flush
20$:    bit     #err!rdy,@#tccm ;wait until ready
        beq     .-6
        bmi     30$             ;error
        tst     @#tcdt          ;flush word
        sob     r3,20$
        inc     dtblk           ;point at next blk
        dec     r4              ;done all blocks?
        beq     40$             ;yes
        br      rnxt18          ;go read next block

30$:    spl     0               ;ints back on
        cmp     dtblk,dtblk0    ;did we get anything?
        bne 40$
        jmp     dterr           ;no, nothing to return

40$:    mov     #sst!do,@#tccm  ;stop tape
        spl     0               ;wake up
        mov     dtblk,r4        ;get next blk #
        sub     dtblk0,r4       ;find # that we got
        rts     pc

50$:    spl     0               ;ints back on
        mov     #sst!do,@#tccm  ;stop tape
        .print  #chkerr         ;software checksum error
        jmp     start


;+
;
; Print DECtape error message.
;
;-
dterr:  mov     @#tcst,r1       ;get status
        clrb    r1              ;zap low byte
        mov     #sst!do,@#tccm  ;stop tape
        mov     #dterrs,r2      ;pt at table
10$:    mov     (r2)+,r0        ;get next msg
        asl     r1              ;left a bit
        bcc     20$             ;not this one
        .print                  ;display msg
        tst     r1              ;set flags
20$:    bne     10$             ;still more bits set
        .close  #0              ;close output file if any
        jmp     start
;
dterrs: .word   10$,20$,30$,40$,50$,60$,70$,80$
10$:    .asciz  /ENDZ ERR/
20$:    .asciz  /PAR ERR/
30$:    .asciz  /MARK ERR/
40$:    .asciz  /WRT PROT ERR/
50$:    .asciz  /SEL ERR/
60$:    .asciz  /BLK MISSED ERR/
70$:    .asciz  /DATA MISSED ERR/
80$:    .asciz  /ILL MEM REF/
number: .ascii  /NUMBER? /<200>
prompt: .ascii  /*/<200>
nomem:  .asciz  /?INSUFFICIENT MEMORY/
badkw:  .asciz  /?WHAT?/
crerr:  .asciz  /?ERROR CREATING FILE/
wrerr:  .asciz  /?WRITE ERROR/
chkerr: .asciz  /?CHECKSUM ERROR/
bntfnd: .asciz  /?BLOCK       NOT FOUND/
;
        .even
;
defext: .rad50  /DTADTADTADTA/
;
earea:  .byte   0,2             ;.ENTER, channel #0
        .word   buf+36          ;filename
        .word   -1              ;length
        .word   0               ;rewind MT:/CT:
;
warea:  .byte   0,11            ;.WRITE, channel #0
wblk:   .word                   ;starting block #
        .word   buf             ;buf addr
wwc:    .word                   ;word count
        .word   0               ;.WRITW
;
        .even                   ;so we can write blanks in pairs
lbuf:   .blkb   81.             ;line buffer
;
        .even
;
xorsum: .blkw   2               ;18-bit XOR checksum for data block
dtblk:  .blkw                   ;current DECtape block
dtblk0: .blkw                   ;block at start of transfer
;
buf:                            ;read buffer
endmem= .+<blkmax*1000>         ;(for .SETTOP)
;
        .end    start
