.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, .if idn ,<-> $$m= $$l .iff $$l= $$l+1 .endc .endr .iif eq $$m, you goofed .byte $$l,$$m .irpc c, .iif dif ,<->, .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 ,back ;search for next block backwards key ,direct key ,dump key ,fwds ;search for next block forwards key ,odd key ,read ;read entire tape key ,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 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 ;+ ; ; 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$: .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: mtps #340 ;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$: mtps #0 ;ints back on cmp dtblk,dtblk0 ;did we get anything? beq dterr ;no, nothing to return 40$: mov #sst!do,@#tccm ;stop tape mtps #0 ;wake up mov dtblk,r4 ;get next blk # sub dtblk0,r4 ;find # that we got rts pc 50$: mtps #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= .+ ;(for .SETTOP) ; .end start