.NLIST
  .INCLUDE /ASCII.MAC/
  .INCLUDE /HWDF.MAC/
  .INCLUDE /DSMAC.MAC/
  .INCLUDE /MYMAC.MAC/
.LIST

MODULE NAME=<DLDRV>, VER=<2.2PL>, COMM=<XXDP+ DL Drive>, TYPE=<NOSECT>

  .NLIST
    .INCLUDE /XXDPCM.MAC/
    .INCLUDE /XXDPDF.MAC/
  .LIST

  FROM HMINIT IMPORT IN$ENG
  FROM HMROOT IMPORT D$RUNI, D$RCSR

  EXPORT QUALIFIED X$XDRV
  EXPORT QUALIFIED SYCSR., D$PUFD, DR$TRA, DR$DEV, DR$OPN, DR$RST

  .SBTTL RL01/02 device structure

  ; Registers

  DLCSR. =: ^O<174400>		; csr
  DL.CSR =: ^O<0>	 	; csr
  DL.BUF =: ^O<2>		; 02 	; buffer
  DL.ADR =: ^O<4>	 	; track/sector
  DL.WCT =: ^O<6>	 	; word count (write)
  DL.DAT =: ^O<6>	 	; data value (read)

  ; Geometry
				;
  DLCYL. =: ^D<256>		; cylinders
  DLRL2. =: ^D<2>		; RL02 cylinder factor
  DLHDS. =: ^D<2>		; heads
  DLBPT. =: ^D<20>		; blocks per track
  DLTRK. =: ^D<64>		; track 
  DL1SZ. =: ^D<10240>		; blocks per RL01
  DL2SZ. =: ^D<20480>		; blocks per RL02
  DLSIZ. =: DL1SZ.		;

  ; CSR definitions.

  DLRDY$ =: ^O<1>		; operation complete ("drive ready")
  DLFUN$ =: ^O<7*2>		; function
  DLGO$  =: ^O<200>		; clear to start operation
  				; actually "controller ready"
  DLUNI$ =: ^O<1400>		; unit number (0..3)
  DLUN$M =: ^C<DLUNI$>		; unit mask
  DLERR$ =: ^O<100000>		; error seen

  DLNOP. =: ^O<0*2>		; 00	; nop
  DLSTA. =: ^O<2*2>		; 04	; get status
  DLSEE. =: ^O<3*2>		; 06	; seek
  DLRHD. =: ^O<4*2>		; 10	; read header
  DLREA. =: ^O<6*2>		; 14	; read data
  DLRDX. =: ^O<7*2>		; 16	; read with no header check

  ; Seek

  DLSEE$ =: ^O<1>		;DL.ADR	; seek activate
  DLDIR$ =: ^O<4>		; seek direction
  DLHEA$ =: ^O<20>		; head select

  DLTRK$ =: ^C<^O<177>>		;DL.DAT	; track mask (RL02)

  ; Get device status/size

  DLMRK$ =: ^O<1>		;DL.ADR	; marker
  DLSTS$ =: ^O<2>		; get status
  DLRST$ =: ^O<10>		; reset errors
  DLREP$ =: ^O<13>		; get device size (rst,sts,mrk)

  DLRL2$ =: ^O<200>		;DL.DAT	; RL02 

  SYCSR. =: DLCSR.		; csr

  .PSECT XXDP9

  .SBTTL Driver Transfer function

  X$XDRV:

  ;
  ; Separate driver code exists for each XXDP-supported system device
  ;
  ; DP.UFD = 0		;3	 ; UFD directory start block (from init)
  ; DP.SPC = 2		;"FN.T"	 ; space filled "filnam.typ"
  ; DPSPC. = 10.	;	 ; 10-char name (6+1+3)
  ; DP.TER = 12		;.WORD 0 ; 1-word zero terminator
  ; DPBBS. = 14			 ; block length
  ;

  D$RLOW:

  D$PUFD:
    .WORD 3		;	; first UFD/directory block (savm)(boot)

  D$PSPC:

  .IF EQ DLDR.V-1
    .WORD  336		; 16660 (15660 in source)
    B.LKB 10		;	; .ASCIZ "filnam.typ"<0>
    .BYTE  0            ; 16672 (15672 in source)
    .BYTE 20
  .ENDC

  .IF EQ <DLDR.V-2>&<DLDR.V-3>
    B.LKB 12		;	; .ASCIZ "filnam.typ"<0>
    .BYTE	0
    E.VEN
  .ENDC

  D$PMON:
    .WORD 170.		;252	; first xmonitor block	    (savm)(boot)

  D$CYL:
    .WORD 0		;	; local

  D$PTWC:
    .WORD 0		;	; transaction word count

  ;
  ; DR$TRA - Driver transfer function 
  ;
  ; in R5 -> IOB
  ;            IO.BLK
  ;            IO.BUF
  ;            IO.WCT
  ;            DR.UNI
  ;
  ; CALL @DR.TRA(R5)
  ;
  ; fine R0/R1 unchanged
  ;      R2..R4 burnt
  ;
  ; fail abort "? RD ERR"
  ;
  ; While the boot and the driver both support partial block reads,
  ; all monitor system device reads are for full blocks (see MO$CHN).
  ;
  PROCEDURE DR$TRA
  BEGIN
    PUSH <R0, R1>		; we do our own thing 

      LET R0         := (R5)	; R0 -> csr
      LET DR.STS(R5) :B= #0	; assume happiness

    .IF EQ <DLDR.V-2>&<DLDR.V-3>
      CALL DU$RES		; reset dl:
    .ENDC

      PUSH #0			; (SP) = result track

      LET R3 := IO.BLK(R5)	; R3 = requested block
      LET R2 := #40.		; R2 = sectors-per-track

      LOOP
        LET R3 := R3 - R2	; more tracks?
        IF RESULT IS LO LEAVE LOOP ; oops - too far
        LET TOP := TOP + #1	; another track
      END

      LET R3 := R3 + R2		; backup from too far
      LET R4 := #0
      LET R2 := R2 R.SHIFT 1	; blocks-per-track now

      LOOP
        LET R3 := R3 - R2
        IF RESULT IS LO LEAVE LOOP
        LET R4 := R4 +  #1
      END

      LET R3 := R3 + R2 L.SHIFT 1
      LET R1 := #7		; compute cylinder

      REPEAT
        LET TOP := TOP L.SHIFT 1 ; shift left 
        LET R1 := R1 - #1
      UNTIL RESULT IS EQ

      POP D$CYL			; cylinder

      PUSH IO.WCT(R5)

        ; Block loop

        ; (SP)	 running word count
        ; D$PTWC transaction word count


        LOOP
          LET TOP := TOP - #^D<256> ; got more than a block?
          IF RESULT IS HI THEN
            LET D$PTWC := #^D<256> ; yes - transaction wct
          ELSE
            LET D$PTWC := (SP)	; no - restore 
            LET D$PTWC := D$PTWC + #^D<256>
          END

          LET R1 := R0 + #6		; R1 -> wct

          PUSH DR.UNI(R5)
            SWAB (SP)		; (SP) = unit
            LET TOP := TOP SET.BY #DLRHD. ; read header
          POP (R0)		; issue function

          CALL DU$WAI
          IF RESULT IS NE GOTO 140$

	  PUSH (R1)		; (SP) = wct = 
            LET  -(R1) := #1	; adr: see$

            IF R4 NE #0 THEN
              LET (R1) := (R1) SET.BY #20 ; adr: hea$
            END

            LET TOP := TOP OFF.BY #177 - D$CYL
            IF RESULT IS LO THEN
              LET (SP) := - (SP) OFF.BY #177
              LET (R1) := (R1) SET.BY #4 ; adr: dir$
            END
          LET (R1) := (R1) SET.BY (SP)+

          LET (R0) := (R0) OFF.BY #DLFUN$ SET.BY #DLSEE. ; clear function bit field and set function to seek

          CALL DU$OPR		; perform seek and wait
          IF RESULT IS NE GOTO 140$

          REPEAT
	  UNTIL #1 SET.IN (R0)	; wait for drive ready

          PUSH D$CYL		; cylinder
            LET TOP := TOP SET.BY R3 ; sector
            IF R4 NE #0 THEN		 ; head flag
              LET TOP := TOP SET.BY #100 ; head
            END
          POP (R1)+		; adr

	  PUSH D$PTWC
            LET (SP) := - (SP)
	  POP (R1)		; wct

          LET 2(R0) := IO.BUF(R5)
          LET (R0) := (R0) OFF.BY #DLFUN$ SET.BY #DLREA. ; read data

          CALL DU$OPR
          IF RESULT IS NE GOTO 140$

          IF (SP) LE #0 GOTO 135$ ; if the word count less or equil zero - we are done

          LET R3 := R3 + #2	; next block

          IF R3 GE #40. THEN	; sectors-per-track - if still within track
            LET R3 := #0	; sector/block = 0
            LET R4 := R4 + #1	; switch head
            LET R4 := R4 OFF.BY #^C<1> ; isolate head flag
            IF RESULT IS EQ THEN
              LET D$CYL := D$CYL + #^D<128> ; advance cylinder
            END
          END

          LET IO.BUF(R5) := IO.BUF(R5) + #^D<512> ; advance buffer pointer

        END

      ;POP (it will done at next command)

      ; Transfer completed

  135$:
    POP <, R1, R0>		; dump temp and restore R1/R1
    RETURN

    ; Transfer aborted

  140$:
    LET DR.STS(R5) :B= DR.STS(R5) - #1 ; DR.STS = -1 - I/O error
    LET R0 := #M$SRER		; "? RD ERR" (abort routine relocates)
    JmpAbt			; abort
  END DR$TRA

  ;
  ; DU$OPR - Initiate operation, wait and check errors
  ;
  ; CALL DU$OPR
  ; BEQ  fine
  ; BNE  fail
  ;
  PROCEDURE DU$OPR
  BEGIN
    LET (R0) := (R0) OFF.BY #DLGO$	; ready?
    $GOTO DU$WAI
  END DU$OPR

  PROCEDURE DU$WAI
  BEGIN
    REPEAT
    UNTIL #DLERR$!DLGO$ SET.IN (R0) ; until error or ready
    IF RESULT IS PL THEN	; if wonderful
      SEZ			; wonderful
    END
    RETURN
  END DU$WAI

  .SBTTL Get Device, Open File, Restore Driver functions		(driver)
		
  ;
  ; DR$DEV - Get device name/unit/media function
  ;
  ; in R5 -> IOB
  ;
  ; CALL DR.DEV(R5)
  ;
  ; out R0 -> D$RDEV: drTdev structure
  ;
  ; Translate the DR.UNI ordinal to DV.UNI ascii
  ; Called by GetDev service and the Enable command
  ;
  PROCEDURE DR$DEV
  BEGIN
    LET R0 :B= DR.UNI(R5) + #'0 ; unit ordinal, asciify it
    LET D$RDEV+DV.UNI :B= R0	; store past "DL"
    .ADDR R0 := #D$RDEV		; point to it
    RETURN
  END DR$DEV

  D$RDEV:
    .ASCII "DL"			;0	;\ DV.NAM - driver device name ("DL")
    .ASCII <0>			;2	;| DV.UNI - driver device unit ("0")
    .BYTE DVRL1.		;3 14	;/ DV.MED - driver device media code

  ;
  ; DR$OPN - Open file function
  ;
  ; No status is sent back to the caller because only succesful opens return.
  ; Failed opens issue abort.
  ;
  ; in IO.SPC .ASCIZ "filnam.typ"
  ;
  ; CALL DR.OPN(R5)
  ;
  ; out R0    burnt
  ;     R1 ->   .ASCIZ "filnam.typ"
  ;     DR.FNM 	.RAD50 /filnamtyp
  ;     DI.SBL  .WORD  n		; start block file
  ;
  ; fail abort "? NOT FOUND filnam.typ"
  ;      R0 = 0
  ;
  PROCEDURE DR$OPN
  BEGIN
    CALL DU$LOO			; lookup
    LET R3 := R1		; R1 -> entry filnamtyp
    LET R2 := R5 + #DR.FNM	; copy filnamtyp and first block 
    LET (R2)+ := (R3)+		; DR.FIL
    LET (R2)+ := (R3)+		; DR.NAM
    LET (R2)+ := (R3)+		; DR.TYP
    LET (R2)  := 4(R3)		; DR.SBL - first file block
    RETURN
  END DR$OPN

  ;
  ; DU$LOO - Lookup file
  ;
  ; in IO.SPC -> .ASCIZ "filnam.typ"
  ;
  ; fine R1 -> directory entry: .RAD50 /filnamtyp/
  ; fail abort "? NOT FOUND"
  ;
  PROCEDURE DU$LOO
  BEGIN
    LET  DR.STS(R5) :B= #0	; reset errors
    CALL DU$MFD			; MFD -> directory
    LET  IO.BLK(R5) := @IO.UFD(R5)
    LET  R3 := #0
    ReaBlk			; read directory
    LET  DR.ENT(R5) := #0

    ; Block Loop

  10$:
    LET R4 := DR.BUF(R5)	; R4 -> buffer
    TST (R4)+			; R4 -> buffer record (skip next block link)
    LET R3 := R3 + #^D<UFDFLC>	; 28. entries per block

    ; Entry Loop

    LOOP
      LET DR.ENT(R5) := DR.ENT(R5) + #1 ; next (or first) entry
      IF DR.ENT(R5) HI R3 THEN	; if no more entries
        LET DR.ENT(R5) := DR.ENT(R5) - #1 ; no - backup
	ReaNxt			; read next directory block
          GOTO 60$		; end of file 
	GOTO 10$		; restart block loop
      END

      IF (R4) NE #0 THEN	; if non empty/deleted entry?
        ; convert rad50 directory entry
        .ADDR R2 := #D$PSPC	; R2 -> driver spec ascii buffer
        LET  R1 := R4		; R1 -> .RAD50 /filnamtyp/
	SpcAsc			; unradify
        LET R0 := R5 + #IO.SPC	; R0 -> I/O ascii spec
	CmpSpc			; and the verdict is?
          GOTO 40$		; missmatch
	LEAVE LOOP		; match - we are done

    40$:
      END

      LET R4 := R4 + #^O<22>	;18. ; next entry
    END				; and off we go again

    LET R1 := R4		; R1 -> result ascii filespec
    RETURN

    ; File not found message and abort

  60$:
    LET DR.STS(R5) :B= DR.STS(R5) + #1 ; DR.STS = 1 - file not found error
    .ADDR4 R0 := #M$SFNF	; R0 = "? NOT FOUND" (.ADDR R0 := #M$SFNF) ??
    TypBrk			;
    LET R0 := R5 + #IO.SPC
    TypBrk			; "? NOT FOUND filnam.typ"
    LET R0 := #0		; no message
    JmpAbt			; begone
  END DU$LOO

  ;
  ; DU$MFD - Read MFD block
  ;
  ; Called by DU$LOO and DR$RST
  ;
  ; out D$PUFD = UFD start block	
  ;     D$PMON = monitor start block
  ;
  ; This routine is only required for disks which have variable disk locations for the UFD and/or monitor.
  ; This is true for DL: but not for DK:
  ;
  PROCEDURE DU$MFD
  BEGIN
    LET IO.BLK(R5) := #1	; MFD block
    ReaBlk			; read it
    LET R0 := IO.BUF(R5)	; get the input buffer
    TST (R0)+			; skip the block linkage
    LET D$PUFD := H2.UFD(R0)	; first UFD block  (mov 0(R0),...)	(note)
    LET D$PMON := H2.MON(R0)	; first monitor block
    RETURN
  END DU$MFD

  ;
  ; DR$RST - Restore monitor function
  ;
  ; XXDP needs a special function to read the monitor disk image because it is a contiguous file.
  ;
  ; in IO.WCT = word count
  ;    IO.BUF = store address
  ;    IO.BLK = monitor relative block
  ;    D$PMON is the monitor base block
  ;
  ; CALL DR.RST(R5)
  ;
  ; out IO.BUF = restored area
  ;
  ; DR$RST reads the MFD to get D$PMON (which ENABLE can modify)
  ; The assumption is that an ENABLED disk has the same monitor version
  ;
  PROCEDURE DR$RST
  BEGIN
    PUSH <IO.WCT(R5), IO.BUF(R5), IO.BLK(R5)>	; save context and monitor-relative block
      CALL DU$MFD				; get mfd block
    POP <IO.BLK(R5), IO.BUF(R5), IO.WCT(R5)>	; restore
    LET IO.BLK(R5) := IO.BLK(R5) + D$PMON	; relocate monitor block
    CALL @DR.TRA(R5)				; transfer
    RETURN
  END DR$RST

.IF EQ <DLDR.V-2>&<DLDR.V-3>
  ;
  ; DU$RES - Device reset
  ;
  PROCEDURE DU$RES
  BEGIN
    PUSH DR.UNI(R5)	; .BYTE unit, function

      SWAB (SP)
      LET TOP        := TOP SET.BY #DLSTA.	  ; get status
      LET DL.ADR(R0) := DL.ADR(R0) SET.BY #DLREP$ ; reset, get status

    POP (R0)		; issue disk function

    CALL DU$WAI
    RETURN
  END DU$RES
.ENDC

  ; Driver error messages

  M$SFNF:
    .ASCIZ "? NOT FOUND: "

  M$SRER:
    .ASCIZ "? RD ERR"<CR><LF>

  .IF EQ DLDR.V-1
    .EVEN
  .ENDC

  .IF EQ <DLDR.V-2>&<DLDR.V-3>
    E.VEN
  .ENDC

  .IF EQ DLDR.V-3
    .WORD 0, 0
  .ENDC

  .SBTTL Boot engine

  .ASECT

  . = ^O<0>

  BBSZ  =: ^O<1000>		; boot block size
  BBCNT =: ^O<BBSZ/1000>	; boot block count

  X$XLOW:

  ; XXDP boot enters at location zero, like everyone else

  ; boot communication area

  PROCEDURE BO$PRI
  BEGIN
    NOP			;0000	; boot primary entry point
    GOTO BO$CON		;0002	; continuation
  END BO$PRI

  .WORD .+2		;0004	; bus trap vector
  .WORD 0		;0006	;

  .WORD .+2		;0010	; cpu trap vector
  .WORD 0		;0012	;

.IF EQ DLDR.V-1
  B.LKW			;0014	; bpt vector skipped
  GOTO BO$CON		;0016	; 
.ENDC

.IF EQ <DLDR.V-2>&<DLDR.V-3>
  B.LKW			;0014	; bpt vector skipped
  B.LKW			;0016	; 
.ENDC

  B$OCSR:
    .WORD DLCSR.	;0020	; CSR address 	   (patch point)	(note)

  PROCEDURE BO$CON
  BEGIN
    NOP			;0022	; boot continuation
    GOTO BO$ENG		;0024	; boot mainline
  END BO$CON

  B$OTRK:
    .WORD 0		;0026	; track - cylinder mask + initial sector

  B$OWCT:
    .WORD 256.		;0030	; word count

  B$OBLK:
    .WORD 0		;0032	; block

  B$OCYL:
    .WORD 0		;0034	; cylinder number

  B$OSEC:
    .BYTE 0		;0036	; sector: 0..39.

  B$OHEA:
    .BYTE 0		;0037	;

    .WORD 0		;0040	;
    .WORD 0		;0042	;

  ;
  ; BO$ENG - Boot engine and start
  ;
  PROCEDURE BO$ENG
  BEGIN
    LET SP     := #40000	; some random stack
    LET R1     := B$OCSR	; R1 -> RL01 csr
    LET B$OBUF := #1000		; read buffer address
    LET B$OTRK := B$OTRK + #2	; sector needs to +2 for MFD and monitor

    ; MFD/monitor loop

    LOOP
      PUSH B$OWCT		; (SP) = remaining word count

      ; Block loop

      LOOP

        LET TOP := TOP - #256.	; shave off 256. words
        IF RESULT IS HI THEN	; if remainder is higher, then zero - too much
          LET B$OTWC := #256.	; then - transfer a full block
        ELSE
	  LET B$OTWC := (SP)	; less than a block - count is negative
	  LET B$OTWC := B$OTWC + #256. ; add to get partial block word count
        END

        CALL BO$SEE		; seek
        CALL BO$ADR		; setup address/wordcount/buffer

        LET (R1) := (R1) OFF.BY #DLFUN$ SET.BY #DLREA.	; clear the function and set read function

        CALL BO$OPR		; go go and wait
	GOTO 60$		; continue just below

        ; I/O error halt and retry

      BO$HLT:
        HALT			; stop the world
        GOTO BO$ENG		; restart the world

    ; Continue boot

      60$:
        IF (SP) LE #0 LEAVE LOOP ; if read completed - MFD or monitor read done

        CALL BO$NXT		; no - advance our cause

      END			; and read the next block's worth

      ; MFD or monitor read done?

      POP			; pop temporary transfer word count
				;
      TST (PC)+			; MFD or monitor read done?
    80$:
      .WORD 0			; 0=MFD, -1=Monitor

      IF RESULT IS NE LEAVE LOOP ; monitor read - finish up

      LET 80$ := NOT 80$	; MFD - monitor next time

      ; MFD read done
      ; Setup for monitor read

      B$OMFD =: 1002		;?? 1000 - boot MFD buffer
      B$OMON =: B$OMFD+H2.MON	;?? 1026 - MFD monitor block
      BOWCT. =: 4096.-256.	;?? 7400 - monitor wordcount - boot block

      LET B$OBLK := @#B$OMON	; monitor block from the MFD
      LET B$OWCT := #BOWCT.	; monitor word count
      LET B$OBLK := B$OBLK + #BBCNT ; skipping the boot block
      CALL BO$GEO		; cylinder/sector/head geometry
      CALL BO$CYL		; get the cylinder
      LET DL.ADR(R1) := #DLSEE$ SET.BY #DLDIR$ SET.BY B$OTRK ; seek flag, we know its forward, cylinder (and sector for MFD read)
    END 			; do the monitor read loop

    ;
    ; Monitor read done
    ;
    ; Setup monitor CSR/unit and launch init
    ;

    LET D$RUNI := (R1) OFF.BY #DLUN$M ; pass the unit number to the driver (boot), mask the unit
    SWAB D$RUNI			; into low byte
    LET	D$RCSR := R1		; IOB csr

    ; Launch the init engine

    JUMPTO IN$ENG		; galacto city
  END BO$ENG

  ;
  ; BO$CYL - Cylinder calculation
  ;
  PROCEDURE BO$CYL
  BEGIN
    PUSH B$OCYL
    LET  R3 := #7		; shift count
    REPEAT
      LET TOP := TOP L.SHIFT 1  ; shift
      LET R3 := R3 - #1
    UNTIL RESULT IS EQ
    POP B$OTRK			; cylinder
    RETURN
  END BO$CYL

  ;
  ; BO$OPR - Boot operation
  ;
  PROCEDURE BO$OPR
  BEGIN
    LET (R1) := (R1) OFF.BY #DLGO$ ; clear to activate

  ENTRY BO$WAI

    REPEAT
    UNTIL #DLERR$!DLGO$ SET.IN (R1) ; wazzup DL?

    IF RESULT IS PL THEN

  ENTRY OK

      RETURN			; fine
    END

  ENTRY BAD

    JUMPTO BO$HLT		; fail - halt
  END BO$OPR

  ;
  ; BO$CHK - Wait for seek to complete
  ;
  PROCEDURE BO$CHK
  BEGIN
    REPEAT
    UNTIL #DLERR$!DLRDY$ SET.IN (R1) ; ready/error

    IF RESULT IS PL GOTO OK	; fine - return

    CALL BO$RES			; bummer - reset (which calls BO$WAI above)
    GOTO BAD			; and go halt via BAD
  END BO$CHK

  ;
  ; BO$ADR - Combine all the addressing bits
  ;
  PROCEDURE BO$ADR
  BEGIN
    PUSH B$OTRK			; cylinder (and MFD sector)
    LET TOP :B= TOP SET.BY B$OSEC ; sector
    IFB B$OHEA NE #0 THEN
      LET (SP) := (SP) SET.BY #100 ; head
    END
    POP  DL.ADR(R1)		; combined track
    PUSH B$OTWC			; transfer word count
    LET  (SP) := - (SP)		; negated word count
    POP  DL.WCT(R1)
    LET  DL.BUF(R1) := B$OBUF	; buffer address
    RETURN
  END BO$ADR

  B$OBUF:
    .WORD 0			; buffer address

  B$OTWC:
    .WORD 0			; transfer word count

  ;
  ; BO$RES - Reset
  ;
  ; Called after an error and before a restart
  ;
  PROCEDURE BO$RES
  BEGIN
    PUSH (R1)
    LET  TOP := TOP OFF.BY #DLUN$M SET.BY #DLSTA. ; clear all but unit, get status
    LET  DL.ADR(R1) := DL.ADR(R1) SET.BY #DLREP$ ; get device status
    POP  (R1)			; take that CSR!
    CALL BO$WAI			; wait and check
    RETURN
  END BO$RES

  ;
  ; BO$NXT - Next block/track/sector/buffer address
  ;
  PROCEDURE BO$NXT
  BEGIN
    LET B$OSEC := B$OSEC + #2	; two sectors per block
    IFB B$OSEC GE #40.		; if end of track

      LET B$OSEC :B= #0		; sector = 0
      LET B$OHEA :B= B$OHEA + #1
      LET B$OHEA :B= B$OHEA OFF.BY #376

      IF RESULT IS EQ THEN
        LET B$OTRK := B$OTRK + #200
        LET B$OCYL := B$OCYL + #1
      END

    END

    LET B$OBUF := B$OBUF + #^O1000 ; next transfer buffer address
    RETURN
  END BO$NXT

  ;
  ; BO$SEE - Seek
  ;
  PROCEDURE BO$SEE
  BEGIN
    LET  (R1) := (R1) OFF.BY #DLFUN$ SET.BY #DLRHD. ; clear function, read header

    CALL BO$OPR

    PUSH DL.WCT(R1)		; wct holds current track address	

    LET DL.ADR(R1) := #DLSEE$	; we will be seeking

    IFB B$OHEA NE #0 THEN
      LET DL.ADR(R1) := DL.ADR(R1) SET.BY #DLHEA$ ; set the head
    END

    LET TOP := TOP OFF.BY #177 - B$OTRK	; determine cylinder and subtract what we want

    IF RESULT IS LO THEN
      LET (SP)       := - (SP) OFF.BY #177        ; we are going backwardsd
      LET DL.ADR(R1) := DL.ADR(R1) SET.BY #DLDIR$ ; set negative direction
    END

    LET  DL.ADR(R1) := DL.ADR(R1) SET.BY (SP)+ ; tell the RL01
    LET  (R1)       := (R1) OFF.BY #DLFUN$ SET.BY #DLSEE. OFF.BY #DLGO$ ; clear function, function = read data, go

    CALL BO$CHK			; wait and check errors

    RETURN
  END BO$SEE

  ;
  ; BO$GEO - Cylinder/sector/head geometry
  ;
  PROCEDURE BO$GEO
  BEGIN
    LET B$OCYL := #0		; clear proto cylinder
    LET R3     := B$OBLK	; R3 = target block

    LET R2     := #40.		; R2 = sectors per cylinder 
				;
    LOOP
      LET R3 := R3 - R2		 ; get cylinder
      IF RESULT IS LO LEAVE LOOP ; no more sectors here
      LET B$OCYL := B$OCYL + #1	 ; up cylinder
    END
    LET R3 := R3 + R2		; backout the subtraction above

    LET B$OSEC := #0
    LET R2 :=  #20.		; R2 = sectors per head

    LOOP
      LET R3 := R3 - R2		 ; see how many fit
      IF RESULT IS LO LEAVE LOOP ; no more fit
      LET B$OHEA :B= B$OHEA + #1 ; flip the head
    END

    LET R3     := R3 + R2 L.SHIFT 1 ; backout subraction, R3 * 2

    LET B$OSEC :B= R3		; is the sector number
    RETURN	
  END BO$GEO

  B.LKB <^O<BBSZ-.>>			; boot round-up

END DLDRV

.END