.enabl lc .title DUPE ;+ ; ; Diskette duplicating machine control program. ; ; By John Wilson ; ; Copyright (C) 1999 by Digby's Bitpile, Inc. All rights reserved. ; ; 09/01/99 JMBW Created (from DUTEST.MAC). ; ; Expected hardware config: ; * PDP-11 CPU with enough memory to hold program plus entire disk contents ; * 50/60 Hz line clock (used for timeouts only) ; * MSCP controller attached to both source and destination drives (RX23 etc.) ; * Victory Enterprises V3000 autoloader or similar, connected to TT1: ; (CSR=176500), most other autoloaders use the same simple protocol ; ;- blkcnt= 5*18. ;# blocks to transfer at a time (5 tracks) ;(must be less than 128., i.e. 64 KB) ; rqdx3= 0 ;NZ => format with RQDX3 command parms ;0 => format with RQZX1 command parms ; du$csr= 172150 ;base address of MSCP port (DUA:) du$cid= 0 ;MSCP connection ID ; lk$csr= 177546 ;KW11L CSR tt$csr= 177560 ;console DL11 base CSR al$csr= 176500 ;autoloader DL11 base CSR ; kbcsr= tt$csr+0 ;keyboard CSR kbbuf= tt$csr+2 ;keyboard buffer ttcsr= tt$csr+4 ;TTY CSR ttbuf= tt$csr+6 ;TTY buffer ; rcvcsr= al$csr+0 ;receiver CSR rcvbuf= al$csr+2 ;receiver buffer xmtcsr= al$csr+4 ;transmitter CSR xmtbuf= al$csr+6 ;transmitter buffer ; ; MMU stuff, needed to use Unibus map: ; mmr0= 177572 ;MMU CSR mmr3= 172516 ;D space, PAR22, UMAP ; kisdr0= 172300 ;kernel instruction PDR0 kisar0= 172340 ; " " PAR0 uisdr0= 177600 ;user instruction PDR0 uisar0= 177640 ; " " PAR0 ; umr= 170200 ;address of first Unibus map register ; .asect .=0 p.crf: .blkw 2 ;(00) command reference number p.unit: .blkw ;(04) unit number .blkw ;(06) (reserved) p.opcd: .blkb ;(10) opcode p.flgs: .blkb ;(11) end message flags (reserved in cmd msg) p.mod: ;(12) modifiers p.sts: .blkw ;(12) status (in end msgs) p.bcnt: .blkw ;(14) byte count (or record/object count) p.unfl: .blkw ;(16) unit flags p.tcnt: ;(20) tape mark count p.buff: .blkw 6 ;(20) buffer descriptor p.medi: ;(34) medium ID, 4 bytes p.fmti: ;(34) format information, 4 bytes (OP.SP8) p.lbn: .blkw 2 ;(34) logical block number p.shun: .blkw ;(40) shadow unit .blkw p.unsz: ;(44) unit size p.trck: .blkw ;(44) track size p.grp: .blkw ;(46) group size p.cyl: .blkw ;(50) cyl size .blkw ;(52) (reserved) p.rcts: .blkw ;(54) RCT size p.rbns: .blkb ;(56) RBNs/track p.rctc: .blkb ;(57) # RCT copies ; .psect ; ; MSCP opcodes: ; ; "immediate" category op.abo= 001 ;ABORT op.gcs= 002 ;GET COMMAND STATUS op.gus= 003 ;GET UNIT STATUS op.scc= 004 ;SET CONTROLLER CHARACTERISTICS ;op.???=005 ;WRITE NON-VOLATILE MEMORY (which does what?) op.sex= 007 ;serious exception (used in responses only, ; ;although I've never seen it in real life) ; "sequential" category (cmds must be executed in the order sent) op.avl= 010 ;AVAILABLE op.onl= 011 ;ONLINE op.suc= 012 ;SET UNIT CHARACTERISTICS op.dap= 013 ;DETERMINE ACCESS PATHS ; "non-sequential" category (controller may reorder these) op.acc= 020 ;ACCESS op.ccd= 021 ;COMPARE CONTROLLER DATA op.ers= 022 ;ERASE op.flu= 023 ;FLUSH op.rpl= 024 ;REPLACE ; (why does the sequence skip 3 opcodes here?) op.fmt= 030 ;FORMAT ; op.cmp= 040 ;COMPARE HOST DATA (page 6-11 is missing!!!) op.rd= 041 ;READ op.wr= 042 ;WRITE ; skips 043 op.wtm= 044 ;WRITE TAPE MARK(S) (TMSCP only) op.rep= 045 ;REPOSITION (TMSCP only) ; op.sp8=057 ;used by RT, RSX when formatting RX33s on ; ;RQDX3 (RQZX1 uses OP.FMT) ; op.ava= 100 ;AVAILABLE attn msg op.dup= 101 ;DUPLICATE UNIT NUMER attn msg op.acp= 102 ;ACCES PATH attn msg ; op.end= 200 ;end message flag (added to cmd opcode in reply) ; ; Command modifier bits: md.spd= 000001 ;spin down drive (for OP.AVL) md.imf= 000002 ;ignore media format err (for OP.ONL) ; ; Status values (low 5 bits of status word at P.STS in response packets) st.suc= 000 ;success st.cmd= 001 ;invalid command st.abo= 002 ;command aborted st.ofl= 003 ;unit-offline st.avl= 004 ;unit-available st.mfe= 005 ;media format error st.wpr= 006 ;write protected st.cmp= 007 ;compare error st.dat= 010 ;data error st.hst= 011 ;host buffer access error st.cnt= 012 ;controller error st.drv= 013 ;drive error st.dia= 037 ;message from an internal diagnostic ; bel= 7 ;bell bs= 10 ;backspace lf= 12 ;line feed cr= 15 ;carriage return ; ; Macro to define an entry in a keyword table. The keyword text must contain ; exactly one hyphen (-), indicating the minimum acceptable abbreviation. ; ; The following is stored for each keyword: ; .byte length to match ; .byte total length ; .ascii /keyword/ ; .even ; .word call address ; .macro kw text,addr $$kh= 0 $$ki= 0 .irpc $$kc, $$ki= $$ki+1 .iif idn <$$kc>,<->, $$kh=$$ki .endm ; .IRPC .if eq $$kh .error ; No hyphen in string: text .mexit .endc ; .IF EQ $$KH .byte $$kh-1,$$ki-1 ;len to match, total len .irpc $$kc, ;keyword text, omit the '-' .iif dif <$$kc>,<->, .byte ''$$kc .endm ; .IRPC .even .word addr ;call address .endm ; ; Cram in-line text into line buffer at (R5) ; .macro cram text jsr r0,cram$ .asciz \text\ .even .endm ; ; Call and return: ; .macro callr addr jmp addr .endm ; ; Main entry point: ; start: mov #.,sp ;init SP if not already done reset ;kill RT-11 (or whatever got us here) ; if we're in RT11XM then that didn't work (RESET = nop in user mode) ; (nothing we can do if we're run by VBGEXE but we'll try anyway, a ; regular XM background program still has access to the I/O page and ; vector area so switching to kernel mode is easy) mov #4+8.,r0 ;point past vectors 4/10 mov #340,-(r0) mov #10$,-(r0) mov #340,-(r0) mov #10$,-(r0) jmp r0 ;traps to one or the other on all CPUs 10$: reset ;NOW we're in kernel mode! mov #50$,(r0) ;addr to trap to if no Unibus map (R0=4) mov #umr,r1 ;point at first UMR tst (r1) ;does Unibus map exist? inc umap ;if we're still here, then yes ; identity-map the low part of memory (up until BUF) so rings work clr r2 ;init ptr 20$: mov r2,(r1)+ ;set addr clr (r1)+ ;(in low 64 KB) add #8192.,r2 ;bump to next page cmp r2,#buf ;covered all low memory? blo 20$ ;loop if not mov r1,freumr ;save addr of first free UMR mov r2,freadr ;save addr corresponding to it ; MMU must be enabled for Unibus map to work, so identity-map that too clr r1 ;base addr mov #7,r2 ;count mov #kisar0,r3 ;PAR0 30$: mov r1,(r3)+ ;set next PAR add #200,r1 ;skip 8 KB sob r2,30$ ;loop mov #177600,(r3) ;I/O page mov #10,r1 ;count mov #kisdr0,r2 ;PDR0 40$: mov #077406,(r2)+ ;set next PDR (len=4KW, ED=up, R/W) sob r1,40$ ;loop mov #60,@#mmr3 ;set UMAP, PAR22 inc @#mmr0 ;enable relocation 50$: ; OK, proceed with init mov #t4,(r0)+ ;fill in vectors for 4/10 (R0 still =4) mov #340,(r0)+ mov #t10,(r0)+ mov #340,(r0) mov #banner,r0 ;pt at msg call print ;print it ; tell duplicator to calibrate itself mov #'C,r0 ;do calibration sequence call putc call chksts ;check completion status ; init MSCP controller clr unit ;init unit # call init ;init controller ;;; check for spurious response? mov #op.scc,r0 ;resync with controller call opcode call goerr ; get source unit mov #srcunt,r0 ;prompt mov #lbuf,r1 ;input line buffer call gtlin mov #lbuf,r5 ;point at command line mov r0,r4 ;copy length call getdec ;get decimal # bcs 70$ ;none, leave UNIT=0 mov r0,unit ;save 70$: mov #op.onl,r0 ;bring drive online call opcode call goerr mov p.unsz(r5),size ;save size in blocks mov p.unsz+2(r5),size+2 ; read it mov #op.rd,r0 ;opcode=read call opcode ;build packet (P.LBN=0) call xfr ;do the transfer bcc 80$ ;success mov #ioerr,r0 ;point at msg call print ;print it br start 80$: ; get destination unit mov #dstunt,r0 ;prompt mov #lbuf,r1 ;input line buffer call gtlin mov #lbuf,r5 ;point at command line mov r0,r4 ;copy length mov #1,unit ;default unit call getdec ;get decimal # bcs 90$ ;none, leave UNIT=1 mov r0,unit ;save 90$: ; get # copies clr ncopy ;assume copying until out of disks mov #copies,r0 ;prompt mov #lbuf,r1 ;input line buffer call gtlin mov #lbuf,r5 ;point at command line mov r0,r4 ;copy length call getdec ;get decimal # bcs 100$ ;none, leave NCOPY=0 mov r0,ncopy ;save 100$: ; see if we should format clr format ;assume not 110$: mov #frmtq,r0 ;prompt mov #lbuf,r1 ;input line buffer call gtlin mov #lbuf,r5 ;point at command line mov r0,r4 ;copy length call getw ;get first word bcs 120$ ;none, keep default mov #yesno,r0 ;point at keywords call tbluk ;look it up bcs 110$ ;invalid, ask again mov r0,format ;save flag 120$: clr disk ;init disk # ;br next ;go start copying ; next: ; start next disk inc disk ;bump to next disk 10$: ; feed next disk mov #'I,r0 ;insert next disk call putc call getc ;get status cmp r0,#'H ;hopper empty? bne 30$ ; out of disks tst ncopy ;is that OK? beq 20$ ;yes, done mov #refill,r0 ;prompt mov #lbuf,r1 ;input line buffer call gtlin ;wait for them to press CR br 10$ ;try again 20$: br done 30$: call chkst1 ;make sure status is OK mov #lbuf,r5 ;init ptr into line buffer cram mov disk,r0 ;fetch disk # clr r1 call prdec ;convert movb #200,(r5) ;mark end mov #lbuf,r0 ;point at string call print ; format next disk tst format ;should we format the disk? beq 50$ ;no mov #fmting,r0 ;say what we're doing call print .if ne rqdx3 ; weird RQDX3 format command mov #op.sp8,r0 ;format disk call opcode mov #100000,txbuf+p.fmti+2 ;format=2**31 call go ;do it .iff ; RQZX1 style mov #op.onl,r0 ;bring drive online call opcode mov #md.imf,txbuf+p.mod ;ignore media format error call go bcs 40$ mov #op.fmt,r0 ;format it call opcode call go ;takes a while bcs 40$ mov #op.avl,r0 ;available again (OP.ONL below w/o MD.IMF) call opcode call go .endc bcc 50$ ;success 40$: call reject ;reject disk br 10$ ;try again 50$: ; bring drive online mov #op.onl,r0 ;bring drive online call opcode call go bcs 80$ ; check size to make sure it will fit cmp p.unsz+2(r5),size+2 ;will it fit? bhi 70$ ;OK blo 60$ ;won't fit cmp p.unsz(r5),size ;check low word bhis 70$ ;OK 60$: call reject mov #toosml,r0 ;dest volume is too small call print br 10$ 70$: ; write the disk mov #wrting,r0 ;say what we're doing call print mov #op.wr,r0 ;opcode=write call opcode ;build packet (P.LBN=0) call xfr ;do the transfer bcs 80$ ;fail ; verify the disk mov #vfying,r0 ;say what we're doing call print mov #op.cmp,r0 ;opcode=compare call opcode ;build packet (P.LBN=0) call xfr ;do the transfer bcc 90$ ;success 80$: call reject ;reject the disk mov #ioerr,r0 ;point at msg call print ;print it br 10$ 90$: ; done call accept ;happy tst ncopy ;are we shooting for a particular number? beq 100$ ;no, keep going until we run out of disks cmp disk,ncopy ;are we there? beq done 100$: jmp next done: jmp quit ;+ ; ; Accept current disk. ; ;- accept: mov #ok,r0 ;disk accepted call print mov #op.avl,r0 ;unit-available call opcode mov #md.spd,txbuf+p.mod ;spin down drive call go ;(ignore error if any, we're giving up anyway) mov #'A,r0 ;accept disk call putc call chksts ;check completion status rts pc ;+ ; ; Clear screen. ; ;- cls: mov #clrscr,r0 ;point at string callr print ;print it, return ;+ ; ; Go (execute command). ; ; C=1 on error. ; ;- go: call send ;send the packet (put in ring) call poll ;tell port to poll ring callr result ;await result, return with C set up ;+ ; ; As above, but errors are fatal. ; ;- goerr: call go ;do it bcs 10$ rts pc ;return 10$: mov #ioerr,r0 ;point at msg call print ;print it jmp start ;restart program ;+ ; ; Initialize MSCP controller. ; ;- init: ; go through 4-step init process mov #60.,rxbuf-4 ;init envelope header clr rxbuf-2 ;(set connection ID to 1 for TMSCP?) mov #rring,r1 ;point at descriptor rings mov #rxbuf,(r1)+ ;reinit descriptors mov #100000,(r1)+ ;OWN=1, FLAG=0 mov #txbuf,(r1)+ clr (r1) ;OWN=0, FLAG=0 clr @udip ;write IP, start init process mov #4000,r0 ;step 1 flag mov #steps,r5 ;point at table mov #stepv,r4 ;point at table for values at each step 10$: mov @udsa,r2 ;get flag from UDSA bmi 30$ ;error, die bit r0,r2 ;is our step on yet? bne 40$ ;got it ; Dilog controllers get stuck if you poll too often mov #1000.,r3 ;delay count, somewhat CPU-specific 20$: tst @#ttcsr ;touch a known port, less CPU-specific dec r3 bne 20$ br 10$ ;go poll again 30$: mov #inierr,r0 ;print error msg callr print ;and return 40$: mov @udsa,(r4)+ ;fetch value mov (r5)+,@udsa ;store next word asl r0 ;shift to next step bpl 10$ ;loop unless ran into bit 15 clr cred ;clear credit account ; display interesting values returned by controller .if ne 0 mov #lbuf,r5 ;init ptr into line buffer cram bit #2000,stepv ;NV set? beq 50$ cram < NV> ;yes 50$: bit #1000,stepv ;QB? beq 60$ cram < QB> ;yes 60$: bit #400,stepv ;DI beq 70$ cram < DI> ;yes 70$: cram < Step 1 bits 7:0=> mov stepv,r0 call proct3 cram < (documented as 000)> call flush cram movb stepv+3,r0 ;get port type bic #^C7,r0 ;isolate mov #1,r2 ;# digits call proct ;print it cram <, reserved step 3 bits 10:8 = > movb stepv+5,r0 ;get them bic #^C7,r0 ;isolate mov #1,r2 ;# digits call proct ;print it cram <, model = > mov stepv+6,r0 ;get value asr r0 ;right 4 bits asr r0 asr r0 asr r0 bic #^C177,r0 ;isolate call proct3 ;print it cram <, FW version = > mov stepv+6,r0 ;get value bic #^C17,r0 ;isolate mov #2,r2 ;# digits call proct ;print it callr flush ;flush line, return .iff rts pc .endc ;+ ; ; Initialize cmd packet with specified opcode. ; ; r0 opcode ; ;- opcode: mov #txbuf,r1 ;point at packet mov #/2,r2 ;length in words 10$: clr (r1)+ ;clear a word sob r2,10$ ;loop movb r0,txbuf+p.opcd ;set opcode mov unit,txbuf+p.unit ;set unit # rts pc ;+ ; ; Tell port to poll. ; ;- poll: tst @udip ;poll .if ne 0 mov #2,r0 ;count 2 clock edges tst @#lk$csr ;flush existing clock pulse 10$: tstb @#lk$csr ;clock? bpl 10$ ;no clr @#lk$csr ;clear it (if writable) 20$: tstb @#lk$csr ;in any event wait for it to clear bmi 20$ dec r0 ;count the edge bne 10$ ;loop if more to do .endc rts pc ;+ ; ; QUIT ; ;- quit: mov #10$,@#4 ;in case no M9312 jmp @#165020 ;jump to M9312 console emulator ;(machine-specific!!!) 10$: halt ;OK whatever br 10$ ;+ ; ; Reject current disk. ; ;- reject: mov #rjctd,r0 ;disk rejected call print mov #op.avl,r0 ;unit-available (if wasn't already) call opcode mov #md.spd,txbuf+p.mod ;spin down drive call go ;(ignore error if any, we're giving up anyway) mov #'R,r0 ;reject disk call putc call chksts ;check completion status rts pc ;+ ; ; Wait for result from MSCP command. ; ; r5 returns pointer to response packet ; ;- result: tst rring+2 ;received a message? bmi result ;loop if not ; received a message mov rxbuf-2,r0 ;get message credits bic #^C17,r0 ;isolate add r0,cred ;add to message credit account mov #rxbuf-4,r0 ;init source ptr mov #rxbuf1-4,r1 ;dest mov (r0),r2 ;length add #4,r2 ;including envelope 10$: movb (r0)+,(r1)+ ;copy sob r2,10$ ;loop mov #rxbuf,rring ;reinit mov #100000,rring+2 mov #60.,rxbuf-4 ;reinit envelope header clr rxbuf-2 ;(set connection ID to 1 for TMSCP?) mov #rxbuf1,r5 ;point at it tst p.sts(r5) ;success? beq 20$ ;yes, C=0 sec ;no, error 20$: rts pc ;+ ; ; Send the command packet we've been working on. ; ;- send: movb cid,txbuf-1 ;patch in connection ID mov #txbuf,cring ;init ptr mov #100000,cring+2 ;set OWN=1 FLAG=0 dec cred ;count it off our credit total rts pc ;+ ; ; Set up Unibus map for transfer. ; ; We only have one transfer outstanding at a time so there's no fancy ; allocation/deallocation, we just grab however many regs we need starting at ; the first UMR following the one(s) needed to identity-map the rest of the ; code and data (below BUF). ; ; On call: ; r0,r1 physical addr of buffer (R1=MSW) ; r2 length of buffer in bytes ; ; On return: ; r0,r1 bus address of buffer (R1=MSW) ; ;- setumr: tst umap ;does machine have Unibus map? beq 20$ ;no, must be Q22, use actual address mov freumr,r3 ;point at first free UMR 10$: mov r0,(r3)+ ;fill in next reg (maps 8 KB) mov r1,(r3)+ add #8192.,r0 ;bump to next page adc r1 sub #8192.,r2 ;deduct from total bhi 10$ ;loop unless done all pages mov freadr,r0 ;get bus address corresponding to FREUMR clr r1 ;(in low 64 KB) 20$: rts pc ;+ ; ; Handle traps to 4/10. ; ;- t4: mov #trap4,r0 ;point at message br t10a t10: mov #trap10,r0 t10a: call print ;print it jmp quit ;+ ; ; Transfer an entire disk worth of data. ; ; TXBUF set up with I/O command packet (and any modifiers) ; ; Returns C=0 on success, C=1 on failure. ; ;- xfr: mov #blkcnt*512.,txbuf+p.bcnt ;set byte count mov #buf,ba ;init 22-bit buffer address clr ba+2 10$: ; read next bufferful (shorten read if within one bufferload of EOD) mov size,r0 ;get size mov size+2,r1 sub txbuf+p.lbn,r0 ;find # blocks to go until EOD sbc r1 sub txbuf+p.lbn+2,r1 bne 20$ ;>64 K blocks, skip cmp r0,#blkcnt ;less than a bufferload left? bhis 20$ ;no swab r0 ;left 8 bits beq 30$ ;whoops, nothing left at all! clrb r0 ;(clear RH) asl r0 ;left 9 bits mov r0,txbuf+p.bcnt ;set short count for last buf 20$: mov ba,r0 ;get 22-bit buf address mov ba+2,r1 mov txbuf+p.bcnt,r2 ;length call setumr ;set Unibus map register, if any mov r0,txbuf+p.buff ;save addr to use mov r1,txbuf+p.buff+2 call go ;do the cmd bcs 40$ ;failed mov txbuf+p.bcnt,r0 ;get # bytes requested add r0,ba ;advance buf addr adc ba+2 swab r0 ;right 8 (9 MSBs known 0) asr r0 ;right 9 add r0,txbuf+p.lbn ;bump block # adc txbuf+p.lbn+2 br 10$ ;loop 30$: clc ;happy 40$: rts pc ;+ ; ; Cram in-line text into output buffer. ; ; r5 buf ptr ; r0 link register for JSR ; ;- cram$: movb (r0)+,(r5)+ ;copy a byte bne cram$ ;loop until 0 dec r5 ;un-put final 0 inc r0 ;.EVEN bic #1,r0 rts r0 ;return ;+ ; ; Flush output buffer. ; ; r5 output line buffer, reinitted to beginning of line on return ; ; All others preserved. ; ;- flush: clrb (r5) ;mark end mov #lbuf,r5 ;reinit mov r0,-(sp) ;save mov r5,r0 ;copy call print mov (sp)+,r0 ;restore rts pc ;+ ; ; Print octal number. ; ; r1:r0 number ; r2 # digits (PROCT only) ; r5 output line ptr (updated on return) ; ;- proct3: bic #^C377,r0 ;isolate low byte mov #3,r2 ;print 3-digit number br proct ;go print proct6: clr r1 ;isolate low word mov #6,r2 ;print 6-digit number proct: ; print # digits in R2 add r2,r5 ;update ptr mov r5,r3 ;copy 10$: mov r0,r4 ;copy low 3 bits of # bic #^C7,r4 ;isolate digit bis #'0,r4 ;convert to ASCII (C=0) movb r4,-(r3) ;[save] ror r1 ;right 1 bit (C=0 from above ror r0 asr r1 ;right 2 more bits (b31=0) ror r0 asr r1 ror r0 dec r2 ;count the digit bne 10$ ;loop until all done rts pc ;+ ; ; Print variable-width decimal number. ; ; r1:r0 number (MSW in R1) ; r5 output line ptr (updated on return) ; ;- prdec: clr r2 ;init remainder mov #32.,r3 ;init loop counter 10$: asl r0 ;shift a bit left rol r1 ;through R1 rol r2 ;into R2 cmp r2,#10. ;will 10. fit in? blo 20$ ;no sub #10.,r2 ;yes, subtract it out inc r0 ;and count it in quotient 20$: dec r3 ;loop through all bits of dividend bne 10$ mov r0,r3 ;copy bis r1,r3 ;quotient =0? beq 30$ ;yes mov r2,-(sp) ;there are more digits, save this one call prdec ;recurse for other digits mov (sp)+,r2 30$: add #'0,r2 ;convert digit to ASCII movb r2,(r5)+ ;save rts pc ;+ ; ; Parse a word from the command line. ; ; r5 current position ; r4 # chars left ; ; On return: ; r5 points at posn after last char of word ; r4 updated ; r3 points at begn of word if C=0 ; r2 length of word ; ; C=1 if no word available. ; ;- getw: tst r4 ;anything? beq 20$ ;no 10$: ; look for beginning of word mov r5,r3 ;in case word starts here movb (r5)+,r0 ;get a char cmp r0,#<' > ;blank or ctrl? bhi 40$ ;no dec r4 ;loop bne 10$ 20$: sec ;no luck rts pc 30$: ; look for end of word movb (r5)+,r0 ;get a char 40$: cmp r0,#<' > ;blank or ctrl? blos 60$ ;yes, end of word cmp r0,#'a ;lower case? blo 50$ cmp r0,#'z ;hm? bhi 50$ bic #40,r0 ;yes, convert movb r0,-1(r5) ;put back 50$: sob r4,30$ ;loop inc r5 ;compensate for next inst 60$: dec r5 ;unget mov r5,r2 ;calc length sub r3,r2 ;C=0 rts pc ;+ ; ; Parse an octal number from the command line. ; ; r5 cmd line ptr ; r4 # chars left (both updated on return) ; r1:r0 returns number ; ;- getoct: clr r0 ;init number clr r1 tst r4 ;anything? beq 20$ ;no 10$: ; skip white space mov r5,r3 ;in case number starts here movb (r5)+,r2 ;get a char cmp r2,#<' > ;blank or ctrl? bhi 40$ ;no dec r4 ;loop bne 10$ 20$: sec ;no luck rts pc 30$: movb (r5)+,r2 ;get a char 40$: sub #'0,r2 ;convert to binary cmp r2,#7 ;legal digit? bhi 50$ ;no asl r0 ;make space rol r1 asl r0 rol r1 asl r0 rol r1 bis r2,r0 ;insert new character dec r4 ;count char bne 30$ ;loop inc r5 ;compensate for next inst 50$: dec r5 ;un-get char cmp r5,r3 ;any chars? (C=0 if so) bhi 60$ sec ;C=1 60$: rts pc ;+ ; ; Parse a decimal number from the command line. ; ; r5 cmd line ptr ; r4 # chars left (both updated on return) ; r1:r0 returns number ; ;- getdec: clr r0 ;init number clr r1 tst r4 ;anything? beq 20$ ;no 10$: ; skip white space mov r5,r3 ;in case number starts here movb (r5)+,r2 ;get a char cmp r2,#<' > ;blank or ctrl? bhi 40$ ;no dec r4 ;loop bne 10$ 20$: sec ;no luck rts pc 30$: movb (r5)+,r2 ;get a char 40$: sub #'0,r2 ;convert to binary cmp r2,#9. ;legal digit? bhi 50$ ;no asl r0 ;old # *2 rol r1 mov r1,-(sp) ;(save) mov r0,-(sp) asl r0 ;*4 rol r1 asl r0 ;*8 rol r1 add (sp)+,r0 ;add in *2 adc r1 add (sp)+,r1 ;to get *10. total add r2,r0 ;insert new character adc r1 dec r4 ;count char bne 30$ ;loop inc r5 ;compensate for next inst 50$: dec r5 ;un-get char cmp r5,r3 ;any chars? (C=0 if so) bhi 60$ sec ;C=1 60$: rts pc ;+ ; ; Look up a keyword in a table. ; ; r3 keyword } from GETW ; r2 length } ; r0 table ; ; Returns C=1 if not found, otherwise r0=number or call addr from table. ; ; r5,r4 preserved either way. ; ;- tbluk: mov r5,-(sp) ;save mov r4,-(sp) 10$: movb (r0)+,r4 ;get length to match beq 50$ ;end of table movb (r0)+,r1 ;get total length cmp r2,r4 ;is ours long enough? blo 40$ ;no cmp r2,r1 ;too long? bhi 40$ sub r2,r1 ;find # to go after abbreviation mov r3,r5 ;copy ptr mov r2,r4 ;and ctr 20$: cmpb (r0)+,(r5)+ ;match? bne 30$ ;no dec r4 ;loop bne 20$ ; got it add r1,r0 ;skip to end of string (C=0) inc r0 ;.EVEN bic #1,r0 mov (r0),r0 ;get value mov (sp)+,r4 ;restore mov (sp)+,r5 rts pc ;C=0 from ADD above 30$: dec r0 ;unget failed char add r4,r0 ;skip to end of abbreviation 40$: add r1,r0 ;skip from there to end of string inc r0 ;.EVEN bic #1,r0 tst (r0)+ ;skip arg br 10$ ;around for more 50$: mov (sp)+,r4 ;restore mov (sp)+,r5 sec ;error return rts pc ;+ ; ; Get a line from the TTY (not quite like RT-11 .GTLIN). ; ; r0 prompt string ; r1 addr of 81.-byte buffer (81st byte is for NUL that marks end) ; ; r0 returns actual length of line (not including NUL), others preserved ; ;- gtlin: mov r2,-(sp) ;save mov r3,-(sp) mov r4,-(sp) mov r5,-(sp) 10$: mov r0,-(sp) ;save prompt call print ;print prompt mov r1,r5 ;working copy of ptr 20$: tstb @#kbcsr ;wait for a character bpl 20$ ;loop mov @#kbbuf,r0 ;get char bic #^C177,r0 ;trim to 7 bits cmp r0,#cr ;end of line? beq 70$ cmp r0,#'U&77 ;^U? beq 60$ cmp r0,#177 ;rubout? beq 40$ mov r5,r4 ;copy ptr sub r1,r4 ;find length cmp r4,#80. ;buf full? beq 20$ ;yes, ignore character movb r0,(r5)+ ;save the char bit #^C37,r0 ;ctrl char? bne 30$ ;no, easy mov r0,r4 ;save char mov #'^,r0 ;^ first call ttyout mov r4,r0 ;copy bis #100,r0 ;convert to letters etc. 30$: call ttyout ;echo br 20$ ;around for more 40$: ; rubout cmp r5,r1 ;at BOL? beq 20$ ;yes, ignore mov #bsbbsb,r0 ;assume ctrl char bitb #^C37,-(r5) ;is it? beq 50$ mov #bsb,r0 ;no, just one column 50$: call print ;delete it br 20$ ;around for more 60$: ; ^U mov #ctrlu,r0 ;point at string call print ;echo it mov (sp)+,r0 ;restore prompt addr br 10$ ;start over 70$: ; CR clrb (r5) ;mark end mov #crlf,r0 ;pt at string call print ;echo the CR mov r5,r0 ;copy sub r1,r0 ;compute length tst (sp)+ ;flush prompt string address mov (sp)+,r5 ;restore mov (sp)+,r4 mov (sp)+,r3 mov (sp)+,r2 rts pc ;(R1 was never touched) ;+ ; ; Print a string (like RT-11 .PRINT). ; ; r0 addr of string, ended with 0 (implicit CRLF) or 200 (no CRLF) ; ; R0 trashed, others preserved. ; ;- print: bitb #177,(r0) ;done? beq 20$ ;yes, skip 10$: tstb @#ttcsr ;ready? bpl 10$ ;no movb (r0)+,@#ttbuf ;print it br print 20$: tstb (r0) ;0 or 200? bmi 30$ ;200, skip mov #crlf,r0 ;add CR, LF br 10$ 30$: rts pc ;+ ; ; Send a char to the TTY (like RT-11 .TTYOUT). ; ; r0 char to send ; other regs preserved (actually R0 too) ; ;- ttyout: tstb @#ttcsr ;ready? bpl ttyout ;no mov r0,@#ttbuf ;print it rts pc ;+ ; ; Send a char to the autoloader. ; ; r0 char to send ; ; All regs preserved. ; ;- putc: ; flush any received junk tst @#rcvbuf ;flush char, if any tstb @#rcvcsr ;anything new? bmi putc ;yes, eat that too 10$: ; send the char tstb @#xmtcsr ;ready? bpl 10$ ;no mov r0,@#xmtbuf ;send it rts pc ;+ ; ; Receive char from the autoloader. ; ; r0 returns char received ; ; All other regs preserved. ; ;- getc: mov #60.*20.+1,r0 ;timeout = at least 20 sec (more if 50 Hz) tst @#lk$csr ;flush last clock pulse (probably piled up) 10$: tstb @#rcvcsr ;character received? bmi 30$ ;got one tstb @#lk$csr ;clock? bpl 10$ ;no clr @#lk$csr ;clear it (if writable) 20$: tstb @#rcvcsr ;check again bmi 30$ ;got a char tstb @#lk$csr ;in any event wait for it to clear bmi 20$ sob r0,10$ ;loop mov #tmoerr,r0 ;point at msg call print ;print it jmp quit 30$: mov @#rcvbuf,r0 ;get char bic #^C177,r0 ;trim to 7 bits rts pc ;+ ; ; Check autoloader completion status. ; ;- chksts: call getc ;get a char chkst1: ; enter here with char in R0 cmp r0,#'X ;executed successfully? beq 10$ ;yes mov #ldrerr,r0 ;point at message call print jmp quit 10$: rts pc ; banner: .ascii /DUPE by John Wilson / .ascii /Copyright (C) 1999 by Digby's Bitpile, Inc. / .asciz /All rights reserved./ bsbbsb: .byte bs,' ,bs ;two sets of backspace/space/backspace bsb: .byte bs,' ,bs,200 ;backspace/space/backspace, MUST FOLLOW BSBBSB clrscr: .ascii <33>//[H/<33>/[J/<200> ;assume ANSI terminal crdits: .ascii /Message credits: /<200> crlf: .byte cr,lf,200 ctrlu: .asciz /^U/ ;^U echo (cancels line and re-prompts) srcunt: .ascii /Source unit [0]: /<200> dstunt: .ascii /Destination unit [1]: /<200> copies: .ascii /Number of copies [ALL]: /<200> frmtq: .asciz /Format disks [NO]: /<200> refill: .ascii /Hopper empty, reload and press CR: /<200> ; fmting: .ascii / [format]/<200> wrting: .ascii / [write]/<200> vfying: .ascii / [verify]/<200> ok: .asciz / OK/ rjctd: .asciz / *** REJECTED ***/ tmoerr: .asciz /?Timeout waiting for autoloader response/ ldrerr: .asciz /?Autoloader error/ toosml: .asciz /?Output volume too small/ ioerr: .asciz "?I/O error" ; inierr: .asciz /?Init error/ trap10: .asciz /?Trap to 10/ trap4: .asciz /?Trap to 4/ ; .even yesno: ; keyword table for YES or NO kw ,0 kw ,1 .byte 0 ; cid: .byte du$cid ;connection ID, 0=MSCP, 1=TMSCP .even ; udip: .word du$csr+0 ;addr of init/polling register udsa: .word du$csr+2 ;addr of status/addr, purge register ; umap: .word 0 ;NZ => system has Unibus map ; ; MSCP packet buffer ; .iif gt <<.-start>&777>-774, .=.+4 .=.+<774-<<.-start>&777>> .word endpkt-txbuf ;length of packet .word 0 ;virtual circuit ID txbuf: ; actual start of packet .blkb 60. endpkt: ; .iif gt <<.-start>&777>-774, .=.+4 .=.+<774-<<.-start>&777>> .blkw 2 rxbuf: .blkb 60. ;receive buffer ; .blkw 2 rxbuf1: .blkb 60. ;copy of receive buffer ; .blkw 2 ; prev 2 words get overwritten with int info by port rring: .blkw 2 ;response ring base cring: .blkw 2 ;command ring base ; steps: .word 100000 ;STEP bit, no interrupts, rings=1 entry each .word rring ;LSW of ring pointer base .word 0 ;MSW=0 .word 1 ;burst=default, last fail=no, go ; stepv: .blkw 4 ;SA values during each init step 1-4 ; cred: .blkw ;command buffer credit account ; unit: .blkw ;current MSCP unit # size: .blkw 2 ;size of input device ba: .blkw 2 ;current 22-bit buffer addr ; ncopy: .blkw ;# copies to make, or 0 to continue until out ; disk: .blkw ;current output disk # format: .blkw ;NZ => format disks first ;0 => disks are pre-formated ; freumr: .blkw ;addr of first free UMR freadr: .blkw ;bus address correspodning to that UMR, known ;in low 64 KB since BUF is below I/O page ; lbuf: .blkb 81. ;line buffer ; .even .=.+<1000-<<.-start>&777>> ;multiple of 1000 just for neatness buf: ;buffer starts here (and goes into XM) ; .end start