.Mcall .module .module dy,version=107,comment=,audit=yes .Nlist bex .psect dydvr ;Force PSECT ordering for programme portion. .psect dyboot .psect program .psect mesage con Vermes: .asciz /DY Extended Handler, V4d, 7-Oct-91/ ; Modifications for the various controllers - initially Dilog DQ419 ; ***************************************************************** ; Allow use of double sided drives; ; Allow use of full 22-bit addressing if DY$22B non-zero; ; Allow to be a mapped handler under TSX-plus; ; Pinch Peter Miedecke's good ideas from his V4 handler. ; Provide FORMAT function to allow formatting under TSX safely! ; Add ideas for other controllers ; Chester Wilson, Charleville, Australia ;1f - Fix bug in mmgt formatting code (bic -> bis) ;1g - Add writing home block to initialization (for DIR & BUP) ;2 - Reorganize problems with memory mapping which caused disaster on ; crossing page boundaries under TSX. ;2a - Bug fix in WDT code ;2b - [9-Apr-86] Further, ibid, & add patch "adc (sp)" ;2c - [9-Sep-86] Remove error checking code from handler format code or ; tells you you have a disc with an error because it is unformatted! ;2d - [12-Feb-87] Bug fix in MTI code (thanks Paul Clarke). ;2e - [20-Feb-88] Put in ability to cope with 16-bit controller (old RX02) ; if c.tiny is defined non-zero. This operates by reserving a buffer ; in low memory (this handler MUST NOT be mapped!), using this for ; disc I/O, and copying across to the user's buffer in the handler. ; Not terribly fast, but it works! ;2f - [23-Feb-88] Considerable code tidying: if I must work on this again, ; it might be handy to tidy it up and put in comments while it is ; still reasonably fresh in my mind. ;2g - [26-May-88] Put in DSD (c.dsd=1) formatting code. *** WARNING *** with ; the DSDs: they appear to have the HEAD in use recorded in the ; headers, with the track and sector numbers. If you format a ; disc on them, you can read side 1 on any machine. If you format ; on a Dilog however, you can read only side 0 on a DSD! ;3 - [30-Dec-89] Rewrite the options sections to attempt to make them able ; to be understood! - and to allow mapped handler with standard DEC ; equipment. ;3a - [25-Mar-90] Make size print as unsigned rather than negative number. ; ;4 - [24-Aug-90] Put in SET (NO) BILLY for Billy Youdelman's different ; mapping. SET NOBILLY sets the mapping as per RX02 on side 0, ; giving blocks 0-997, then going to side 2 for blocks 998-1975. ; SET BILLY uses track 1, side 0, then track 1, side 1 und so ; weiter. This is of course limited to 2-sided discs. ; Sigh. Compatibility is always a four-letter word. ; ; The BILLY mode was used by SMS ; ; Completely rewrite the boot code to cope with this. ; ; Rewrite the density testing: as we now know at the start of ; each I/O, forget the swapping on error. ; ; Remove the DY$DD option. ; ;4a [23-Oct-90] Check for type of error on initial get status, and if not ; density error or deleted data, prang him there and then, or get ; loop (happens with corrupted disc). ;4b [29-Nov-90] Add ANDROMEDA support (18 bit only - sorry!) ; (Worked fine on controller; but no luck getting discs readable ; on other systems. Sigh.) ;4c [24-Jan-91] Allow retries (unless disc unloaded) if get error on initial ; Get Status, as Flex-02 can throw these up occasionally under TSX ; with discs formatted on other controllers. ;4d [ 7-Oct-91] Add single/double sided message (actually puts together two ; inadvertently different DY flavours ...) .Sbttl Ideas for different controllers: (users, please add your own!) .iif ndf c.mti, c.mti = 0 ;Default is not MTI .iif ndf c.dec, c.dec = 0 ; & not DEC .iif ndf c.dsd, c.dsd = 0 ; & not DSD .iif ndf c.and, c.and = 0 ; & not andromeda .iif ndf c.tiny, c.tiny = 0 ; and not special 16-bit ancient! .if eq .iif ndf c.dilog, c.dilog = 1 ;Default to SIGMA/DILOG controller .iff .iif ndf c.dilog, c.dilog = 0 .endc .if eq 1 Sigma/Dilog DQ419: (default; selected if c.dilog non-zero) 22 bit addressing is enabled by setting the bit in the command. An extra phase is added to all cycles requiring a memory access. In this cycle the high-order address is passed to the controller, as six bits right justified. The bits and are not used. MTI: (selected if c.mti non-zero) 22 bit addressing is enabled by setting the bit in the command. An extra phase is added to all cycles requiring a memory access. In this cycle the high order four bits of the address are passed to the controller, right justified. Bits 16 and 17 still need to be set in the command word as per a DEC 18-bit controller. DSD: (selected if c.dsd non-zero) Using mode 2, same as Dilog apart from the formatting, which is completely different. See note about problem with HEAD being recorded in sector headers above! DEC: (selected if c.dec non-zero) Nothing fancy; 18-bit addressing only. The only advantages of this handler are (1) 2-sided operation if desired; (2) handler may be mapped under TSX-plus; (3) inbuilt formatting. This setting may be suitable for General Robotics boards, but I cannot be sure of this. Andromeda: (selected if c.and non-zero) As per DEC, but has nasty that have to check for busy controller by testing for zero CSR value, or if write at this time into a register you get a trap to 4! 16-bit controllers (selected if c.tiny non-zero) This is a special for use with very early 16-bit controllers under TSX-plus. I suspect it has very limited application these days, especially as it runs like a one-legged dog! .endc ;Allow only 0 and 1 for values: .iif ne c.dilog, c.dilog = 1 .iif ne c.mti, c.mti = 1 .iif ne c.dec, c.dec = 1 .iif ne c.dsd, c.dsd = 1 .iif ne c.tiny, c.tiny = 1 .if ne .error ;Please select only one type of controller! .endc .if ne c.dec .iif ndf sides$, sides$ = 1 ;If DEC, assume single sided .endc .iif ndf sides$, sides$ = 2 ;Assume 2-sided for everyone else. .if ne c.and ;Andromeda like DEC but 2-sided c.dec = 1 sides$=2 .endc .if ne sides$-1 .if ne sides$-2 .error ;You may only select 1 or 2 sides! .endc .endc .iif ndf tsx$p, tsx$p = 0 ;Assume non-TSX unless specified. .iif ne tsx$p, mmg$t = 1 ;If TSX, must have memory management. .iif ndf dy$22b, dy$22b = 1 ;Assume 22 bit addressing unless specified, or .iif ne , dy$22b = 0 ; DEC, DSD or 16-bit, .iif eq mmg$t, dy$22b = 0 ; or SJ/FB. .if ne c.tiny .if eq tsx$p .error ;16-bit controller version is limited to TSX-plus only .endc .endc .Sbttl TSX Problem: .if eq 1 TSX makes assumptions about its devices, and refuses to allow its assumptions to be altered. DY is forced into being an 18-bit handler and may not be mapped. This is hopeless, and I hope an option will become available in later versions of TSX to get around this. Call it DA and assign DA DY, DA0 DY0, and DA1 DY1 on all start-up files and you obviate this problem in a messy way. Otherwise you must patch either a TSX object file or the TSX.SAV file. Sigh. [Note that if you use the c.tiny option, this handler then must NOT be mapped, as it uses a buffer in low memory.] .endc .Sbttl FORMAT function details .if eq 1 SPFUN 200: Requires values in buffer - First byte: 0 = side 0, NZ = side 1 Second byte: 0 = single density, NZ = double and Block Number: 0 = soft, NZ = hard format Sigma/Dilog protocol (extension of DEC type): Command: 10 + <20 if unit 1> + <400 if double dens> + <1000 for side 1> Followed by (in data register) 111 for soft format, or 222 for hard format. DSD protocol: Command: 5 Followed by: 154 for single-density 155 for double density each twice into the data register. Both sides of a disc will be formatted if it is double sided. .endc ; COPYRIGHT (c) 1984 BY ; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ALL RIGHTS RESERVED. ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ; TRANSFERRED. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ; CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. .Sbttl Macros and Definitions .Enabl lc .Mcall .drdef, .addr, .assume, .br .dstatus=342 sysptr = 54 .macro bne. label,?alt beq alt jmp label alt: .endm bne. .macro beq. label,?alt bne alt jmp label alt: .endm beq. .macro bcs. label,?alt bcc alt jmp label alt: .endm bcs. .macro bcc. labtl,?alt bcs alt jmp labtl alt: .endm bcc. .IIF NDF DYT$O, DYT$O = 0 ;Non-zero if two DY controllers .IIF NDF DY$DD, DY$DD = 0 ;Non-zero if RX02 only (*removed*) .IIF NDF DY$CS2 DY$CS2 == 177150 .IIF NDF DY$VC2 DY$VC2 == 270 p1=172342 ;Par 1, for XM buffer p5=172352 ;Par 5, for mapping TSX handler p6=172354 ;Par 6, for TSX buffer px=p1 .iif ne tsx$p, px=p6 ;Set up appropriate user buffer mapping .Drdef dy,6,filst$!spfun$!varsz$,494.,177170,264 ;Bits in CSR csgo = 1 ;"GO" bit ;10,4,2: used for commands csunit = 20 ;Set if unit 1 csdone = 40 ;Set if done (-> interrupt if CSINT set) csint = 100 ;Set if desire interrupt cstr = 200 ;Set when ready for next piece of data csdn = 400 ;Set for double density cshead = 1000 ;Set for head 1 (= side 1 of disc) cs22bit = 2000 ;1 Set if full 22-bit addressing required csrx02 = 4000 ;Set if RX02 controller csma16 = 10000 ;Extended memory: MTI bit 16 csma17 = 20000 ;ibid, bit 17 csinit = 40000 ;Set by user to re-init DY cserr = 100000 ;Set if error .if eq dy$22b ;Full-scale READ command cs.read=csgo!csrd!csint .iff cs.read=csgo!csrd!csint!cs22bit .endc dnerr = 20 ;Density error (see ESDNER) ; - Commands csfbuf = 0*2 ;Fill buffer csebuf = 1*2 ;Empty buffer cswrt = 2*2 ;Write csrd = 3*2 ;Read csdnft = 4*2 ;Set media density/format csrdst = 5*2 ;Read status cswrtd = 6*2 ;Write deleted data csmain = 7*2 ;Read error code .assume csrd&2 ne 0 ;Some assumptions about read & .assume cswrt&2 eq 0 ; write commands, to check which by .assume cswrtd&2 eq 0 ; testing only a single bit. ;Data Register Bits escrc = 1 ;CRC Error espar = 2 ;Side Ready (double sided disc in place) esid = 4 ;Init done essid1 = 10 ;AC low [? differs between DILOG & DEC] esdner = 20 ;Density error esdn = 40 ;Density of disc in drive (1 = double) esdd = 100 ;Deleted data esdry = 200 ;Drive ready ddnblk = dydsiz*2 dynreg = 3 retry = 8. spfunc = 100000 ;SPFUN flag in command word fmt$fn = 200 ;Format function siz$fn = 373 ;Read volume size wdd$fn = 375 ;Write deleted data wrt$fn = 376 ;Write track/sector red$fn = 377 ;Read track/sector .Sbttl Installation Checks .asect . = 176 inscsr: . = 200 nop bit #csrx02,@inscsr ;Make sure controller is RX02 bne o.good br o.bad findrv: ;Find address of handler, if loaded. .addr #devnam,r0 .addr #darea+1,-(sp) emt .dstatus bcs o.bad mov darea+4,r1 ;Check to see if handler loaded beq o.bad br o.good darea: .blkw 4 devnam: .rad50 /dy / barea: .byte 17,10 ;Used for I/O for SET code .word 0 .word 0 .word 256. .word 0 ;Need SET (NO) BILLY here, as otherwise with ERL$G things get oversize .if eq sides$-2 x.billy: call getbot ;Get boot block. mov r3,<<+>&777>(r2);Put it in, then call putbot ; get normal block again. mov r3,billy br o.good .endc .iif gt,<.-356> .error .Sbttl SET Options .drset CSR, 160000, o.csr, oct .if eq dyt$o .drset VECTOR, 500, o.vec, oct .iff .drset VECTOR, +1, o.vec, oct .drset CSR2, 160000, o.csr2, oct .drset VEC2, +1+6, o.vec2, oct .endc .if eq sides$-2 .drset BILLY, 1, o.billy, no .endc .drset WRITE, 1, o.wp, no .drset RETRY, retry, o.rtry, num .if ne erl$g .drset SUCCES, -1, o.succ, no .endc btcsr = ++1000 ;Bootstrap CSR location .Sbttl Actual SET Code o.csr: cmp r0,r3 ;Check for valid CSR address blo o.bad mov r0,inscsr ;Put it into installation CSR area call getbot ;Get boot block. mov r3,(r2);Put it in, then call putbot ; get normal block again. .if eq dyt$o mov r3,dycsa .iff mov r3,dycsr .endc o.good: tst (pc)+ o.bad: sec return .if eq sides$-2 o.billy: nop clr r3 n.billy: br x.billy .endc ;--------------------------------------------------------------------------- ; Get and write the boot block code ;--------------------------------------------------------------------------- getbot: .addr #barea+4,r1 ;Get boot area block into memory .addr #1000,r2 ; at position 1000. mov r2,(r1) mov #btcsr/1000,-(r1);Block with boot CSR tst -(r1) mov r1,r0 emt 375 ;.readw bcs oo.swy return putbot: mov r1,r0 incb 1(r0) emt 375 ; write the block out again. bcs oo.swy mov r1,r0 ;Re-read normal first block back again decb 1(r0) ; in case further SETs. mov #1,2(r0) emt 375 bcs o.bad return oo.bad: tst (sp)+ br o.bad oo.swy: tst (sp)+ .br o.swyl ;--------------------------------------------------------------------------- o.sywl: ;System Write Error, if return to add #2,@sp ; + 2 br o.bad .if eq dyt$o o.vec: cmp r0,r3 ;SET VECTOR bhis o.bad bit #3,r0 bne o.bad mov r0,dystrt br o.good .iff o.csr2: cmp r0,r3 ;SET second CSR blo o.bad mov r0,dycsr2 br o.good o.vec: o.vec2: cmp r0,#500 ;SET second (or only) VECTOR bhis o.bad bit #3,r0 bne o.bad .addr #dy$vtb-1,r3,add mov r0,@r3 br o.good .endc o.rtry: cmp r0,r3 ;SET RETRY bhi o.bad mov r0,dretry bne o.good br o.bad .if ne erl$g ;Error logging - SET SUCCESS o.succ: mov #0,r3 n.succ: .assume o.succ+4 eq n.succ mov r3,scsflg br o.good .endc o.wp: nop ;SET (NO) WRITE clr r3 n.wp: .assume o.wp+4 eq n.wp mov r3,o.wpf mov r1,r3 cmp r3,#dyt$o*2+1 bhi o.bad .addr #dywpro,r0 add r3,r0 movb (pc)+,(r0) ;Set this one in handler on disc o.wpf: 0 call findrv ; and if possible also in memory. bcs o.good cmp @#sysptr,r1 bhi 10$ mov #100000,dyw1-dylqe(r1) ;This only if non-system device. 10$: add r3,r1 movb o.wpf,dywpro-dylqe(r1) br o.good .iif gt,<.-1000> .error; Set Code too Big .Sbttl Driver Request Entry Point .Enabl lsb .DRBEG DY br dyent ;---------------------------------------------------------------------- ;Data area, to be accessible by SET commands DYCSA: .word dy$csr ;CSR address DYWPRO: ;Write-protect table .rept dyt$o+1 .byte 0,0 .endr .if eq sides$-2 BILLY: 1 ;0 if Billy Youdelman compatible, <>0 if not. .endc .if ne erl$g SCSFLG: .word 0 .endc .if ne dyt$o .drvtb dy,dy$vec,dyint .drvtb ,dy$vc2,dyint .endc ;---------------------------------------------------------------------- ;Start of Handler Code DYENT: mov (pc)+,(pc)+ ;Set up retry count dretry: .word retry dytry: .word 0 reride: .if ne c.and tst @dycsa ;Andromeda - wait for controller beq dyent ; to become not busy. clr andabt ;Clear "abort" flag .endc mov dycqe,r5 bic #csunit,dyicmd ;Assume drive 0 .assume . le dystrt+1000 ;Retry number must be within SET block mov (r5)+,r3 ;Block number mov #cs.read,r4 ;Put READ command into R4 clr (pc)+ ;Flag to provide interrupt jump rawflg: 0 ; without customary processing. movb (r5)+,r1 ;Function movb (r5)+,r0 ;Unit/Job bic #^c<7>,r0 ;Get unit only mov r0,r2 asr r0 ;Make sure 0 or 1 unless dyt$o .if eq dyt$o ; defined, in which case 0-3. bne 20$ bcc 10$ bis #csunit,r4 bis #csunit,dyicmd 10$: br 50$ 20$: jmp dyerr .iff bcc 10$ bis #csunit,r4 ;Low order bit set - unit 1 of bis #csunit,dyicmd 10$: mov (pc)+,-(sp) ; whichever controller. dycsr: .word dy$csr .assume . le dystrt+1000 ;1st CSR must be within SET block asr r0 ;See if second controller. beq 30$ ;(0-3 if this EQ, else >3 & error) 20$: jmp dyerr 30$: bcc 40$ ;If carry bit set, second controller mov (pc)+,(sp) dycsr2: .word dy$cs2 .assume . le dystrt+1000 ;2nd CSR must be within SET block 40$: mov (sp)+,dycsa ;NOW we have our controller. .endc 50$: cmpb r1,#fmt$fn ;Check for format spfun bne 60$ jmp format 60$: ;BUFFER ADDRESS Setting .if ne c.tiny mov (r5)+,r0 ;Tiny mov q$par-q$wcnt(r5),holpar .iff .if eq mmg$t mov (r5)+,r0 ;SJ/FB .iff .if eq dy$22b ;18-bit addressing call @$mpptr mov (sp)+,r0 mov r4,(pc)+ 70$: 0 mov (sp)+,r4 bit #1700,r4 bne. dyerr swab r4 bis 70$,r4 .iff ;22-bit addressing .if ne dy$22b call @$mpptr ;For DILOG, mpptr returns full 22 bit address mov 2(sp),r0 ; but it is left-shifted 4 places too far. ash #-4,r0 ; DILOG doesn't use csma16/17 but MTI does. mov r0,himem ;Hold high-order address for later. mov (sp)+,r0 ;Low order bits tst (sp)+ ;Use same code for MTI as later buffer manips .endc ; use INC HIMEM. .endc .endc .endc mov @r5,wrdcnt ;WORD COUNT bpl 90$ ;If read, don't worry about NOWRITE option asl (pc)+ dyw1: 0 .assume . le dystrt+1000 bcs 80$ clr -(sp) movb q.unit-q.wcnt(r5),(sp) ;Re-get unit number bic #<^c3>,(sp) ;Trim to size, and add .addr #dywpro,(sp),add ; to unit offset. tstb @(sp)+ ;If non-zero, bne 20$ ; prang him. 80$: add #cswrt-csrd,r4 ;Change command to WRITE neg wrdcnt 90$: asl r1 ;SPFUN, if non zero. beq 100$ ;Here, we are looking at SPFUN parameters. mov r1,r5 ;CHGTBL contains values which when add pc,r1 ; accessed using the SPFUN*2 offsets add chgtbl-.(r1),r4 ; sets the command up for that spfun. sub #377*400!siz$fn*2,r5 ;If only size check, no special beq 110$ ; things with 1st buffer word. .if eq mmg$t clr (r0)+ ;Clear status word in buffer .iff mov r4,-(sp) mov dycqe,r4 clr -(sp) call @$ptwrd add #2,r0 ;Skip first word of buffer mov (sp)+,r4 .endc br 110$ 100$: asl r3 ;Block number to Logical Sector # tst (r5) ;Any words to transfer? bne 110$ jmp dydone ;No. 110$: mov r0,(pc)+ ;Buffer address BUFRAD: 0 mov r3,dylsn ;Logical sector number mov r4,(pc)+ ;Command to be executed after initial DYFUN2: 0 ; interrupt. mov r5,(pc)+ ;Remains of "function" byte SIZFLG: 0 inc rawflg ;Get status rather than original test for mov (pc)+,r0 ;previous error then re-init. dyicmd: .word csint!csrdst!csgo call inwait mov (r5),(pc)+ dystat: 0 bit #esdry,(r5) ;Drive loaded and ready? beq 135$ ;Whoops. Die. .assume cserr eq 100000 ;Check for error. tst (r4) bpl 120$ ;None. bit #esdner!esdd,(r5) ;If error, see if deleted data or density. beq 130$ ;If not, die now. 120$: mov #64.,-(sp) ;Word count - assume single density first. bit #esdn,(r5) ;Is it a double density disc? beq 140$ ;No. bis #csdn,dyfun2 ;Yes - set double density bit asl (sp) ; Increase word count to 128. br 150$ 130$: dec dytry ;Allow retries on Get Status (or Flex-02 ble 135$ ; can do some funny things on discs jmp reride ; formatted on other controllers) 135$: jmp dyerr 140$: asl dylsn ;If RX01, jack up logical sector number. 150$: mov (sp)+,(pc)+ wcount: 0 .br dyinit .Dsabl lsb .Sbttl Start Transfer or Retry .Enabl lsb DYINIT: mov dyfun2,r0 ;Get default "read into silo" command, with ; any mods from "get status" operation. tst sizflg ;SIZE SPFUN? bne 40$ ;No. ;------------------------- SIZE SPFUN------------------------------ mov dystat,r1 ;Get density of side 0 (from initial bic #^c,r1 ; "get status" request. mov r1,(pc)+ d1: 0 com r1 ;(In case single sided drive) add #cshead,r0 ;Set up to check side 1 bit #espar,dystat ;See if double sided drive. beq 10$ ;No. Leave R1<>D1 inc rawflg ;Take it errors and all. call inwait mov (r5),r1 ;Get density of side 1 tst (r4) bmi 10$ ;If error, none on this side. bic #^c,r1 10$: mov #494.,-(sp) ;Assume DX, single sided. cmp r1,d1 ;See if same both sides. bne 20$ ;Differ - give him first side only asl (sp) ;Same - double whatever it be 20$: tst d1 ;See if double density beq 30$ ;Single. asl (sp) 30$: .if eq mmg$t mov (sp)+,@bufrad .iff mov dycqe,r4 call @$ptwrd .endc br dydone ;-------------------------------------------------------------------------- ;------------------------- I/O (Normal or SPFUN) -------------------------- 40$: ;Have next command in r0. bit #1*2,r0 ;Is it a write? bne 50$ ;No - must fill silo first. .if ne c.tiny call filbuf ;Put user's data into internal buffer .endc ; before a write call dosilo ;Fill silo 50$: call doxfer ;Perform I/O bit #1*2,r0 ;Read or write? beq 80$ ;Write, if bit 1*2 not set. tst r0 ;See if SPFUN bpl 70$ ;Is not - nothing fancy about first word. bit #esdd,@r5 ;SPFUN, reading a block. Check density beq 70$ ; and tell him if double. .if eq mmg$t mov bufrad,r2 inc -(r2) .iff mov r4,r1 mov dycqe,r4 mov #1,-(sp) sub #2,q$buff(r4) ;Point back to first word of buffer (flag) .if eq tsx$p cmp q$buff(r4),#20000 ;If not TSX, make sure we have not crossed bhis 60$ ; buffer boundaries. (In TSX these are add #100,q$buff(r4) ; normalized before the handler gets them, dec q$par(r4) ; and since we added 2 before, we're ok.) .endc 60$: call @$ptwrd mov r1,r4 .endc 70$: call dosilo .if ne c.tiny call empbuf ;Empty internal buffer into user's .endc 80$: .if ne c.tiny add #2,holpar ;Re-adjust by 200 bytes cmp holwrd,#100 ;Used double or single density? beq 90$ ;Single. add #2,holpar ;Double - up by another 200. 90$: .endc tst r0 ;SPFUN? bmi dydone ;If so, finished. .if eq c.tiny mov r3,r2 ;Otherwise, readjust buffer address. asl r2 add r2,bufrad .if ne mmg$t bcc 100$ .if ne dy$22b ;If overflow, adjust either high mem inc himem ; word, or set next address bit, depending .iff ; upon hardware. add #csma16,r0 .endc .endc .endc 100$: inc (pc)+ ;Logical sector number DYLSN: 0 sub r3,(pc)+ ;Word count WRDCNT: 0 bhi 40$ ;More to do? bit #1*2,r0 ;If a write, must write extra sectors for bne dydone ; incomplete blocks. mov #1,wrdcnt ;Make the word count 1 only. .if ne c.tiny .addr #zero,r1 ;Buffer address for zero blocks is in mov r1,bufrad ; low memory. Get its address, and clear clr holpar ; PAR for it. .iff .if eq tsx$p .addr #zero,r1 ;Low memory also for SJ/FB/XM mov r1,bufrad .iff .if eq dy$22b ;If no 22-bit ability, and want mapped TSX mov #500,bufrad ; handler, must have buffer in low memory. ;(This could cause hassles, but the MT devices ; use a similar subterfuge so I'll hope!) bic #,r0 ;Clear extra address bits clr r1 ; and make high-order memory zero. .iff mov r4,-(sp) ;Mapping returns low order in r4 call mapadr ;Get physical mapping of ZERO .word map-zero mov r4,bufrad ;Low order in r4 .if ne c.mti ;If MTI board, need to juggle mem addr bits bic #,r0 asr r1 ; to put bits bcc 110$ ; 16 and 17 into bis #csma16,r0 ; their correct positions 110$: asr r1 ; in the status bcc 120$ ; word. bis #csma17,r0 120$: .endc mov (sp)+,r4 mov r1,himem ;High order in r1 .endc .endc .endc mov #3,r1 ;If not purely RX02, may have up to 3 bit #csdn,r0 ; additional segments to write. beq 130$ asr r1 130$: bit r1,dylsn bne 40$ br dydone .Dsabl lsb .Sbttl Done with I/O, Finish Up and Exit .Enabl lsb .if ne erl$g DYDONE: tst scsflg bne dyhome mov dycqe,r5 mov #dy$cod*400+377,r4 call @$elptr br dyhome .endc DYABRT: .if ne c.and ;If Andromeda, wait. inc andabt .iff mov #csinit,@dycsa ;Reset the brute after an abort. clr dyfblk+2 br dyf .endc DYERR: mov dycqe,r4 bis #hderr$,@-(r4) .br dyhome .iif eq erl$g, DYDONE: DYHOME: clr @dycsa dyf: .drfin dy .Dsabl lsb .Sbttl Buffer fill/empty routines for 16-bit systems .if ne c.tiny filbuf: call setpx 10$: mov (r0)+,(r1)+ sob r2,10$ return empbuf: call setpx 10$: mov (r1)+,(r0)+ sob r2,10$ return setpx: mov r0,-(sp) mov r1,-(sp) mov r2,-(sp) mov wrdcnt,r2 ;Work out word count cmp r3,r2 bhis 10$ mov r3,r2 10$: mov r2,holwrd mov holpar,@#px mov bufrad,r0 .addr #intnbf,r1 call @6(sp) mov (sp)+,r2 mov (sp)+,r1 mov (sp)+,r0 tst (sp)+ ;Scrub old return address return .endc .Sbttl INWAIT - Start Function and Wait for Interrupt from Floppy INWAIT: mov (sp)+,intrtn mov r0,@dycsa return .Sbttl Interrupt Entry Point .drast dy,5,dyabrt .fork dyfblk .if ne c.and ;Andromeda - check for abort tst (pc)+ andabt: 0 beq 15$ call setdy mov #csinit,@dycsa ;Reset the brute after an abort. clr dyfblk+2 br dyf 15$: .endc call setdy ;Reset registers. bpl intdsp ;If ok, always give it back to him. tst rawflg ;If error, see if he wants it straight bne 20$ ;He does. clr rawflg br dyerr2 20$: clr rawflg dec dytry INTDSP: jmp @(pc)+ INTRTN: 0 .Sbttl Error Handling - Retry DYERR2: mov r0,dyfun2 .if ne erl$g .addr #dyrbuf,r3 mov r3,r2 mov @r4,(r3)+ mov @r5,(r3)+ mov #csmain!csgo,@r4 50$: bit #cstr,(r4) beq 50$ mov r3,(r5) 60$: bit #csdone,(r4) beq 60$ mov dretry,r3 swab r3 add #dynreg,r3 mov dycqe,r5 mov dytry,r4 add #dy$cod*400-1,r4 call @$elptr .endc mov #csinit,@dycsa mov #csint,r0 call inwait 70$: dec dytry .if eq c.tiny beq dyerr jmp dyinit .iff beq 80$ jmp dyinit 80$: jmp dyerr .endc .Sbttl DOSILO - Initiate a Silo Fill or Empty Command .Enabl lsb DOSILO: mov (sp)+,intrtn mov wrdcnt,r2 bic #6*2,r0 bpl 10$ mov r3,r2 10$: .if ne dy$22b .if ne c.mti mov himem,-(sp) ;Set up the bits within the command asr (sp) ; register for MTI boards, at the same bcc 20$ ; time shifting the high order memory bis #csma16,r0 ; address two places to the right. 20$: asr (sp) ;This leaves the top four bits right bcc 30$ ; justified in (sp). We can't leave it bis #csma17,r0 ; there as if there's an error we must not 30$: mov (sp)+,(pc)+ ; have the stack altered. mtihi: 0 .endc .endc mov r0,@r4 ;Command itself. cmp r3,r2 ;Determine byte count for this transfer blos 40$ mov r2,r3 beq intdsp 40$: .if eq c.tiny mov bufrad,r2 ;Normally use user buffer address. .iff ;If only 16 bit on big machine, use our own .addr #intnbf,r2 ; internal address. .endc .if ne dy$22b ;If using 22-bit addressing, need to allow 50$: bitb #cstr!csdone,@r4; for extra transfer step to get the beq 50$ ; high-order word of the address across. bpl dyerr2 mov r3,@r5 ;Byte count 60$: bitb #cstr!csdone,@r4 beq 60$ bpl dyerr2 mov r2,@r5 ;Address 70$: bitb #cstr!csdone,(r4) beq 70$ .if eq c.mti mov himem,(r5) ;High order address .iff mov mtihi,(r5) .endc return .iff br dydofn .endc .Dsabl lsb .Sbttl DOXFER - Start a Sector Read or Write DOXFER: mov (sp)+,intrtn ;Address to return to from interrupt mov wrdcnt,r2 ;Word count mov dylsn,r3 ;Logical sector number bic #cshead,r0 ;Side 0 till proven otherwise bmi dydof1 ;SPFUN, but need to mov r0,(r4) yet .if eq sides$-2 10$: bic #cshead,r0 ;Side 0 until proven otherwise bit #espar,dystat ;See if double sided beq 30$ ;Single - no problems. tst billy ;See which double! bne 20$ ;Normal ;---------------------------------------------------------------------------- ; Billy Youdelman's Format (SMS) - both sides of each track before next ;---------------------------------------------------------------------------- call trksec inc r2 ;Starts at track 1 asr r2 ;Split track/head bcc 40$ ;Head 0 bis #cshead,r0 ;Head 1 br 40$ ;---------------------------------------------------------------------------- ; Normal RX03 - first side = RX02, then second side ;---------------------------------------------------------------------------- 20$: cmp r3,#26.*76. blo 30$ ;First side bis #cshead,r0 ;Second side sub #26.*76.,r3 .br 30$ ;---------------------------------------------------------------------------- ; RX02 ;---------------------------------------------------------------------------- 30$: .endc call trksec 40$: cmp r2,#76. ;Make sure not oversize blos dydof1 jmp dyerr ;---------------------------------------------------------------------------- ; Calculate track and sector trksec: clr -(sp) ;Offset for track calculation for cmp r3,#1352.*2 ; non-RX02. (Block 1352 starts a blo 20$ ; new track at sector 1, so is a sub #1352.*2,r3 ; suitable one for an offset as if mov #104.,(sp) ; go > 1663 get rubbish). 20$: mov #8.,r2 30$: cmp #26.*200,r3 bhi 40$ add #-26.*200,r3 40$: rol r3 dec r2 bgt 30$ movb r3,r2 clrb r3 swab r3 cmp #12.,r3 rol r3 asl r2 add r2,r3 add r2,r3 add r2,r3 asr r2 inc r2 50$: sub #26.,r3 bge 50$ add #27.,r3 add (sp)+,r2 ;Add in track offset return .Sbttl DYDOFN - Start a Transfer or Silo Operation DYDOF1: mov r0,@r4 DYDOFN: bitb #cstr!csdone,@r4 ;Wait on transfer/done bits beq dydofn bpl .dyerr2 mov r3,@r5 1$: bitb #cstr!csdone,@r4 ;Ibid. beq 1$ bpl .dyerr2 mov r2,@r5 return .dyerr2:jmp dyerr2 .Sbttl SETDY - Set up Registers SETDY: mov dyfun2,r0 mov wcount,r3 mov dycsa,r4 mov r4,r5 tst (r5)+ return .Sbttl FORMAT function FORMAT: .if eq c.dsd ;---------------------------------------------------------------------- ; Non - D S D formatting ;---------------------------------------------------------------------- add #csdnft-csrd,r4 ;Reset command to Set Density/Format .if ne mmg$t mov r4,-(sp) ;Need R4 for CQE pointer if MMGT mov dycqe,r4 call @$gtbyt ;If first byte non-zero, side 1 tstb (sp)+ beq 10$ bis #cshead,(sp) 10$: call @$gtbyt ;If second byte non-zero, double density tstb (sp)+ beq 20$ bis #csdn,(sp) 20$: mov (sp)+,dyfun2 .iff mov dycqe,r5 mov q$buff(r5),-(sp);Address of user buffer tstb @(sp) ;If first byte non-zero, side 1 beq 10$ bis #cshead,r4 10$: inc (sp) ;If second byte non-zero, double density tstb @(sp)+ beq 20$ bis #csdn,r4 20$: mov r4,dyfun2 .endc 30$: inc rawflg ;Get error back from INWAIT if needed mov #csint,r0 call inwait ;Don't care if get error as disc unformatted mov r0,(r4) ;Actual Format command 50$: bitb #cstr!csdone,(r4) beq 50$ bpl 70$ mov #111,r0 ;Soft format .if eq tst @dycqe ; unless block number non-zero. beq 60$ asl r0 .endc 60$: call fmt ;Send keyword for formatting and wait. tst (r4) ;See if error bpl 80$ 70$: jmp dyerr 80$: jmp dyhome .iff ;---------------------------------------------------------------------- ; D S D Formatting ;---------------------------------------------------------------------- add #cswrt-csrd,r4 ;Reset command to Format = Write Sector mov r4,dyfun2 .if ne mmg$t mov dycqe,r4 call @$gtbyt ;If first byte non-zero, side 1 tstb (sp)+ ;Can't set desired side, so ignore. mov #154,dsdfmt ;Assume single density ... call @$gtbyt ;If second byte non-zero, double density tstb (sp)+ beq 110$ inc dsdfmt ;If double density, 155 rather than 154. 110$: .iff mov dycqe,r5 mov q$buff(r5),-(sp);Address of user buffer mov #154,dsdfmt inc (sp) tstb @(sp)+ ;If second byte non-zero, double density beq 110$ inc dsdfmt 110$: .endc 120$: inc rawflg ;Get error back from INWAIT if needed mov #csint,r0 call inwait ;Don't care if get error as disc unformatted mov r0,(r4) ;Actual Format command 130$: bitb #cstr!csdone,(r4) beq 130$ bpl 150$ mov dsdfmt,(r5) 140$: bitb #cstr!csdone,(r4) beq 140$ bpl 150$ call fmt ;Send final keyword for formatting and wait. tst (r4) ;See if error bpl 160$ 150$: jmp dyerr 160$: jmp dyhome dsdfmt: 0 .endc fmt: inc rawflg mov (sp)+,intrtn mov r0,(r5) return .Sbttl . TSX High Memory Mapping .If eq 1 Called by call mapadr .word map-address returns r3 / high order physical address r4 / low order physical address .Endc .if ne tsx$p .if eq c.tiny Mapadr: clr r3 ;Clear high order physical address mov pc,r4 map: sub @(sp),r4 ;Get virtual address of desired loc add #2,(sp) ;So we return properly. cmp r4,#120000 ;Mapped? blo 10$ ;No - no problems. mov r4,-(sp) ;Yes. Hold virtual address mov @#172352,r4 ;Get PAR5 value ashc #6,r3 ;Convert to physical address bic #160000,(sp) ;Remove offset from virtual address add (sp)+,r4 ;Add to physical address offset adc r3 ;(Need high order bits right-justified) 10$: return .endc .endc .Sbttl Tables, Fork Block, End of Driver ZERO: .word 0 ;Null block, for writing incomplete blocks. ;CHGTBL - accessed using a negative index, to reset required function: .if eq dy$dd .word csrdst-csrd+spfunc .word 0 .endc .word cswrtd-csrd+spfunc .word cswrt-csrd+spfunc .word csrd-csrd+spfunc CHGTBL: .if eq dy$dd SAVDEN: .word csdn,csdn .if ne dyt$o .word csdn,csdn .endc .endc DYFBLK: .word 0,0,0,0 .if ne erl$g DYRBUF: .blkw dynreg .blkw 4 .endc .if ne dy$22b himem:0 .endc .if ne c.tiny intnbf: .blkw 200 ;Internal sector buffer holpar: 0 ;PAR of user buffer holwrd: 0 ;Stores word count .endc .Sbttl Bootstrap Read Routine .drbot dy,boot1,read ;------------------------- Initialization -------------------------------- .enabl lsb . = dyboot+40 BOOT1: mov #10000,sp mov r0,btunit ;Get boot unit mov r0,@#b$devu call botini br 300$ . = dyboot+104 300$: mov #2,r0 ;Initial "Boot" Code mov #<4*400>,r1 mov #1000,r2 jmp @#boot-dyboot ;And so to boot. ;Boot Initialization, First Episode: botini: mov #401,read1o ;Only init once. tst @#b$devu ;Check out boot unit. beq 10$ bis #csunit,redcmd ;Set it in read command bis #csunit,inicmd ; and initialization command. 10$: mov botcsr,r4 mov (pc)+,(r4) ;Send initialization command inicmd: .word csrdst!csgo 20$: bitb #csdone,(r4) beq 20$ br botin1 .dsabl lsb .iif ge .-dyboot-210,.error; Boot Initialization (1) Code too Big ;------------------------------------------------------------------------- .enabl lsb . = DYBOOT+210 READ: read1o: call botini ;If warm boot, need initialization. asl r0 ;Logical sector number shiftb: asl r0 ;(if RX01, make it x4 rather than x2) bootgo: mov r0,-(sp) ;Keep for next sector bic #cshead,redcmd ;Assume side 0 doublb: br 30$ ;Changed to NOP if double sided. tst (pc)+ ;See whose RX03 billyb: 1 bne 20$ ;Billy Youdelman's (SMS) call trkscb inc r0 asr r0 bcc 35$ bis #cshead,redcmd br 35$ ;Normal RX03 20$: cmp r0,#26.*76. blo 30$ bis #cshead,redcmd sub #26.*76.,r0 ;RX01, RX02 and normal RX03 30$: call trkscb 35$: mov (pc)+,r5 BOTCSR: .word dy$csr mov r5,r4 mov (pc)+,(r5)+ REDCMD: .word csgo!csrd call wait mov r3,@r5 ;Sector call wait mov r0,@r5 ;Track 40$: bit #csdone,@r4 beq 40$ tst @r4 ;Any errors? bmi rtry mov (pc)+,(r4) EMTCMD: .word csebuf!csgo ;Empty buffer command mov (pc)+,r3 countb: 64. cmp r1,r3 bhis 50$ mov r1,r3 50$: call wait mov r3,@r5 ;Word count call wait mov r2,@r5 ;Address 60$: bit #csdone,@r4 beq 60$ tst @r4 bmi rtry mov (sp)+,r0 ;Get logical sector number back sub r3,r1 ;Fix word count. ble 100$ add r3,r2 ;Try for next one. add r3,r2 inc r0 br bootgo ;------------------------- Track & Sector Calculation -------------------- trkscb: mov r0,r3 mov r0,r4 clr r0 br 80$ 70$: sub #23.,r3 80$: inc r0 sub #26.,r4 bpl 70$ cmp #-14.,r4 rol r3 90$: sub #26.,r3 bpl 90$ add #27.,r3 return ;------------------------------------------------------------------------- ;Boot Initialization, Episode 2: botin1: mov 2(r4),-(sp) ;Get status of DY bit #esdn,(sp) ;See if double density beq 220$ ;No. bis #csdn,redcmd ;Yes - set bit in read command bis #csdn,emtcmd ; and in buffer empty command. mov #128.,countb ;Set 128 words/bufflerload mov #nop,shiftb ;If double density, only 1 shift 220$: ; required per block number. bit #espar,(sp) ;Double sided? beq 230$ ;No. mov #nop,doublb ;Yes - perform double sided code. 230$: tst (sp)+ ;Scrub status now. return .iif gt .-dyboot-576, .error; Boot Initialization (2) Code too big. . = dyboot+576 WAIT: bitb #cstr!csdone,@r4 ;Wait on transfer or done. bmi 110$ beq wait RTRY: mov (sp)+,r0 br bootgo 100$: clc 110$: return BOOT: call read mov #b$dnam,@#b$devn btunit=.+2 mov #0,@#b$devu ;Must do this AFTER first read! jmp @#b$boot .dsabl lsb .DREND DY .Sbttl Programme Portion for Formatting Discs .psect program .psect data limit: .limit ;Programme linked limits hlimit: 0 ;For new high memory limit area: .blkw 7 ;EMT area defext: .rad50 / / ;CSI default extensions line: .blkb 100. ;For input line. iniseg: 0 ;For number of directory segments tell: 0 ;NZ if wants device size ffmt: 0 ;NZ if wants disc formatted buffer: 0 ;.byte .if eq sides$-2 bilval: 0 ;NZ if /B:ON or /B:OFF bilflg: 0 ;NZ if /B specified .endc .psect mesage con bilmes: .ascii /Currently SET DY BILLY (for SMS format) is in effect./<0> bnlmes: .ascii /Currently SET DY NO BILLY (for normal RX03 format) is in effect./<0> hmes: .ascii /Built for / .iif ne c.dilog,.ascii #Sigma/Dilog# .iif ne c.mti, .ascii #MTI# .iif ne c.dsd, .ascii #DSD# .if ne c.dec .if eq c.and .ascii #DEC# .iff .ascii #Andromeda# .endc .endc .iif ne c.tiny, .ascii #16-bit# .iif eq sides$-1 .ascii / single/ .iif eq sides$-2 .ascii / double/ .ascii /-sided/ .ascii / DY controller.//Commands are:/ .if eq .ascii # /H (without any file) - Type this text# .ascii # The device specified should be a DY floppy drive,# .ascii .ascii # write-enabled.# .ascii # /H - hard format;# .ascii # /F - soft format;# .ascii # /D - double density;# .ascii # /S - both sides.# .ascii # /S:0 - side 0 only (default);# .ascii # /S:1 - side 1 only.# .ascii # /I - initialize directory when formatted# .ascii # (default 4 segments), or# .ascii # /I:n for n segments (1 to 31.)# .ascii # /T - tell size of disc (in blocks)# .ascii # /Z - equivalent to /F/D/S/I# .ascii # (/D and /S imply /F unless /H is specified.# .if eq sides$-2 .ascii # /B - tell whether normal RX03 or Billy Youdelman's# .ascii # SMS format# .ascii # /B:ON sets Billy's format; /B:OFF returns to# .ascii # normal RX03# .endc .iff .ascii # /H (without any file) - Type this text# .ascii # The device specified should be a DY floppy,# .ascii # write-enabled.# .ascii # /F - format in single density;# .ascii # /D - format in double density;# .ascii # /I - initialize directory when formatted# .ascii # (default 4 segments), or# .ascii # /I:n for n segments (1 to 31.)# .ascii # /T - tell size of disc (in blocks)# .ascii # /Z - equivalent to /F/D/I# .ascii # /H (hard format for Dilog Controllers) is# .ascii # taken as the equivalent of /F, because# .if ne c.dsd .ascii # DSD controllers always perform hard formatting.# .iff .ascii # DEC controllers only perform soft formatting.# .endc .ascii .if eq sides$-2 .ascii # /B - tell whether normal RX03 or Billy Youdelman's# .ascii # SMS format# .ascii # /B:ON sets Billy's format; /B:OFF returns to# .ascii # normal RX03# .endc .endc .byte 0 illsw: .ascii \?DY-E-Illegal Switch or Value for Switch /\<200> illswh: .asciz \Type /H for help.\ .psect program jsw=44 ttlc$=40000 ovly$=1000 .asect .=jsw ovly$ .psect program userrb=53 error=4 cr=15 lf=12 .mcall .sreset,.csigen,.wait,.print,.ttyou,.spfun,.writw Badrun: bisb #error,@#userrb Start:: .sreset bis #ttlc$,@#jsw .csigen limit+2,#defext,,#line mov r0,hlimit clr r1 ;Block Number = Soft/Hard clr r2 ;First byte = Side 0/1 clr r3 ;Second byte = Single/Double Dens clr iniseg ;Number of segments in directory clr tell ;Doesn't want to be told size clr ffmt ;Doesn't want disc formatted .if eq sides$-2 clr bilval ;Doesn't want /B:ON.OFF clr bilflg ;No /B specified .endc mov (sp)+,r5 ;Number of switches beq noswt nexswt: clr r0 ;Clear option value mov (sp)+,r4 ;Option itself bpl 10$ mov (sp)+,r0 10$: bicb #40,r4 ;Make switch upper case. cmpb r4,#'H bne 20$ inc r1 ;/H - Hard format required ; (not TINY or DSD - see FORMAT:) inc ffmt br endswt 20$: cmpb r4,#'D bne 30$ inc r3 ;/D - Double density required inc ffmt ;Implies formatting br endswt 30$: .if eq cmpb r4,#'S bne 50$ inc ffmt ;/S -> /F tst r4 ;/S - see if value specified bmi 40$ ;Yes - side specified. mov #2,r2 ;No - do both sides. br endswt 40$: cmp r0,#2 bhi illswt mov r0,r2 br endswt 50$: .endc cmpb r4,#'I ;/I:n - initialize disc with n bne 60$ ; directory segments. mov #4,iniseg ;Default is 4 segments tst r4 bpl endswt tst r0 beq illswt cmp r0,#32. bhis illswt mov r0,iniseg br endswt 60$: cmpb r4,#'F bne 70$ inc ffmt ;/F - soft formatting br endswt 70$: cmpb r4,#'T bne 80$ inc tell ;/T - tell him size of disc br endswt 80$: cmpb r4,#'Z ;/Z = /F/S/D/I bne 90$ inc ffmt ; = /F .if eq mov #2,r2 ; = /S (not if DSD or TINY) .endc inc r3 ; = /D mov #4,iniseg ; = /I:4 br endswt 90$: .if eq sides$-2 cmpb r4,#'B ;/B - tell or set Billy/NoBilly bne 130$ inc bilflg ;Remember it's specified. tst r4 ;Value specified? bmi 110$ ;Yes - must be :ON or :OFF mov #bilmes,r0 tst billy beq 100$ mov #bnlmes,r0 100$: .print br endswt 110$: cmp r0,#^rON beq 120$ cmp r0,#^rOFF bne illswt 120$: mov r0,bilval .br endswt 130$: .endc endswt: dec r5 bne nexswt br go illswt: .print #illsw .ttyou r4 .print #illswh jmp badrun noswt: inc tell ;No switches -> /T only (to be harmless?) .br go .Sbttl Actual Programme Machinations .Enabl lsb go: .wait #3 ;Any input file? bcc 30$ ;Yes - not just /H or /B .if eq sides$-2 tst bilval ;Does he want to change /B setting? beq 10$ ;No. call bilset ;Yes. br 20$ 10$: tst bilflg ;If /B and no files or /H, no more said. beq 15$ ;No /B. tst r1 ;/B and /H? beq 20$ ;No - don't give him version message (Gawd!) .endc 15$: .print #vermes ;Either /H or no /H gives version message tst r1 ;Was there a /H? beq 20$ ;No. .print #hmes ;Yes - give him help text 20$: jmp start 30$: tst ffmt ;Does he want formatting? beq endfmt mov r2,r5 ;0 = side 0, 1 = side 1, 2 = both bic #^c1,r2 40$: movb r2,buffer ;Buffer contains .BYTE , movb r3,buffer+1 .spfun #area,#3,#fmt$fn,#buffer,#1,r1 ;Block no. == bcs. spferr inc r2 dec r5 cmp r5,r2 beq 40$ endfmt: mov iniseg,r1 ;Does he want it initialized? beq trytell ;No. .spfun #area,#3,#siz$fn,#length,#0,#0 ;Get size bcs. sizerr mov r1,dir ;Number of segments asl r1 sub r1,length ;Length less number of blocks taken by sub #6,length ; directory and boot blocks add #6,r1 ;Block upon which first file starts mov r1,ffile .writw #area,#3,#dir,#dircnt,#6 ;Write first directory block bcs. direrr .writw #area,#3,#block1,#400,#1 ; and the home block. bcs homerr trytell: tst tell beq endtell .spfun #area,#3,#siz$fn,#length,#0,#0 ;Get size bcs sizerr .print #siz1 mov length,r0 call wdut .print #siz2 endtell:jmp start .Dsabl lsb ;Set/Unset Billy Youdelman mode: .if eq sides$-2 bilset: mov bilval,r0 ;Want /B:ON or /B:OFF? beq endbil mov #1,r1 ;Assume NOBILLY cmp r0,#^rON bne 10$ clr r1 10$: mov r1,billy mov r1,billyb .writw #area,#17,#1000,#400,#1 bcs 20$ .writw #area,#17,#,#400,#</400> bcs 30$ br endbil 20$: .print #nowb1 br 40$ 30$: .print #nowbb 40$: jmp badrun endbil: return .psect mesage con nowb1: .ascii /DY-E-Error writing block 1 of DY handler/<0> nowbb: .ascii /DY-E-Error writing block containing boot in DY handler/<0> .psect program .endc .psect mesage con siz1: .ascii /Size of disc is /<200> siz2: .ascii / blocks (decimal)/<0> .psect program .Sbttl Directory & Home Block Data .psect data ;--------------------------------------------------------------------------- ;Directory Data dir: ;Portion of directory 0 ;Number of segments 0 ;Next segment in use 1 ;Number of highest in use 0 ;Number of extra bytes ffile: 0 ;Block on which data starts 1000 ;Empty area 0,0,0 ;Filename.ext length: 0 ;Length 0,0 4000 ;End of segment dircnt = <.-dir> / 2 ;Number of words in this bit. ;--------------------------------------------------------------------------- ;Block 1 (Home Block) initializing data block1: .word 0 .rept 101 .ascii / / .endr .=. ;(so we can see what loc we're up to) .rept 34 0 .endr .=. .rept 202 .ascii / / .endr 0 0 .=. .rept 7 .ascii / / .endr 1 6 .rad50 /V05/ .ascii /RT11A / .ascii /DECRT11A / ;--------------------------------------------------------------------------- .psect program spferr: ;SPFUN error on formatting .print #sperr mov #'0,r0 tst r2 beq 10$ inc r0 10$: movb r0,sper1 .print #sper1 jmp badrun .Sbttl Assorted Errors sizerr: .print #sizer ;SPFUN error getting size jmp badrun direrr: .print #direr ;WRITE error getting directory jmp badrun homerr: .print #homer ;Error writing home block jmp badrun .psect mesage con sperr: .ascii \?DY-E-Error Formatting Disc (side \<200> sper1: .asciz \0)\ sizer: .asciz \?DY-E-Error Reading Device Size\ direr: .asciz \?DY-E-Error Writing Directory\ homer: .asciz \?DY-E-Error Writing Home Block\ .psect program .Sbttl WDT/WDUT - Write a signed or unsigned decimal number to the terminal .If eq 1 Called by: mov number,r0 call wdt (or wdut) .endc .Enabl lsb DECTAB: .WORD 10.,100.,1000.,10000.,-1 WDUT: ;For unsigned number mov r0,-(sp) br 10$ WDT: mov r0,-(sp) bge 10$ mov #'-,r0 .ttyou mov (sp),r0 neg r0 bic #100000,r0 10$: mov r3,-(sp) mov r2,-(sp) mov r0,r2 clr -(sp) mov #dectab,r3 20$: cmp r0,(r3) ;Compare value with subtractors blo 40$ mov (r3)+,-(sp) ;Stack next subtractor if relevant tst (r3) bpl 20$ 40$: mov (sp)+,r3 ;Get next subtractor beq 70$ ;Last one zero, in case number = 0. mov #60,r0 ;Initalize digit 50$: sub r3,r2 bcs 60$ inc r0 br 50$ 60$: add r3,r2 .ttyou br 40$ 70$: add #60,r2 mov r2,r0 .ttyou mov (sp)+,r2 mov (sp)+,r3 mov (sp)+,r0 return .Dsabl lsb .end start