*
 PAGE
*
*
*********************
*
*
*
*           DISK DRIVER CONTROL/STATUS OPERATION
*
*  COME HERE WITH A, DE, HL SET FROM USER CALL B,DE,HL
*
DDCTL ORA A
 JZ DDC2  IF STATUS REQUEST
*
*
 CPI 7
 JZ CTRL7  RETURN STATUS
*
*
 CPI 8
 JZ CTRL8  SET DRIVE READY TRAP
 CPI 9
 JZ CTRL9  READ BUFFER
 CPI 10
 JZ CTR10  WRITE BUFFER
*
 CPI 4  IS IT A "LOAD INDEX" REQUEST?
 JZ DDC4  YES
*
 CALL ERRL2  NO, BUT THAT'S ALL WE DO
 DB ERNCT
*
CTRL7 EQU $
 IF 0
*
*  RETURN DRIVE AND BUFFER STATUS
*
 LHLD DSKRD  GET CURRENT TRAP ADDRESS
 PUSH H  AND SAVE FOR LATER
 LXI H,CTR7A  PUT IN OUR LOCAL TRAP
 SHLD DSKRD
 LDA FUNIT  GET THE FILES UNIT NUMBER
 CALL USET  AND CONVERT IT TO A PROPER CODE
 OUT COMPT  SELECT IT THROUGH THE CONTROLLER
 CALL DRLOP  AND GO FIND OUT IF IT'S READY
 MVI A,1  RETURN HERE IF READY
 JMP CTR7B  AND CONTINUE ON
*
*
*  THE DRLOP CALL RETURNS HERE IF THE DRIVE IS NOT READY
*
CTR7A XRA A  RETURN A ZERO
CTR7B POP H  THE ORIGINAL TRAP ADDRESS
 SHLD DSKRD
 PUSH PSW  SAVE DRIVE STATUS
 LDA RUNIT  GET THE ORIGINAL DRIVE
 OUT COMPT  AND SELECT IT
*
 ENDF
*
*  FIRST SELECT THE UNIT
*
 LDA FUNIT
 CALL USET
 OUT COMPT  LOAD IT UP FOR LATER
*
 LHLD FNBD  GET CURRENT BYTE DISPLACEMENT
 XCHG
 LHLD FBLKS  AND THE BLOCK SIZE
 CALL ARITH  HL = HL - DE
 XCHG .  RETURN IT IN DE
*
*  NOW GET DRIVE STATUS
*
 IN STAPT  GET STATUS
 CMA
 ANI DREDY  GET THE READY BIT
 RET
*
 IF 0
 POP PSW
 RET .  ALL DONE
*
 ENDF
*
*  SET DRIVE NOT READY TRAP
*
CTRL8 SHLD DSKRD  SET IT
 RET .  QUICK CALL
*
*
*  REFRESH BUFFER OF STATIC BUFFERED FILE
*
CTRL9 CALL BUFTST  TEST TYPE OF BUFFERING
 RZ .  IF DYNAMIC BUFFER
 JMP RBLK  READ THE BLOCK AGAIN AND RETURN
*
*
*  WRITE OUT THE BUFFER IF STATIC BUFFERED
*
CTR10 CALL BUFTST  TEST TYPE OF BUFFERING
 RZ
 XRA A
 STA FFLAG  CLEAR THE BUFFER DIRTY FLAG
 JMP WBLK  WRITE IT OUT AND RETURN
*
*
*
*  RETURN FILE STATUS
*
DDC2 LDA FPROT  A = FILE PROTECTION
 MVI D,0  NOTHING ELSE OF IMPORTANCE!
 RET
*
*
*  LOAD INDEX INTO ADDRESS IN HL
*
DDC4 INX H  TEST FOR -1 FIRST
 MOV A,H
 ORA L
 DCX H
 JZ DDC4A  IT IS -1, SKIP TEST
*
 LXI D,SECTSZ  CHECK FOR OVERWRITE
 CALL MEMCHK
 MVI A,1
 ORA A  SET NZ TO FORCE CALL
*
DDC4A LHLD UHL  WE KNOW WHERE IT IS
 SHLD FAIND  ALL IS WELL, SET IT IN
 CNZ RINDY  LOAD THE INDEX
 RET
*
 PAGE
*
*
*********************
*
*
*
*          DISK DRIVER WRITE BLOCK
*
DDWBL CALL WBLK  WRITE IT
 JMP RX2  AND RETURN
*
*
*
*    DISK DRIVER WRITE BLOCK/READ NEXT
*
DDWBR CALL WBLK  WRITE OUT
 CALL DDRNB  READ NEXT
 CALL LNKBLK  NONE SO ADD ONE
 JMP RX2  WASN'T THAT EASY
*
* NOTE:  THE ABOVE ROUTINE IS REALLY ESTHETICALLY
*        PLEASING. (IF I DO SAY SO MYSELF.)
*
*********************
*
*
*         WRITE BLOCK OF DISK FILE
*
*   WRITE THE CURRENT BLOCK OF THE CURRENT FILE.
*   IF THIS BLOCK HAS THE EOF, UPDATE THE HEADER.
*
*   INFORMATION IN THE CURRENT FCB IS USED.
*
*
*  UPDATE HEADER IF NECESSARY
*
WBLK LDA FFORE+1  HIGH ORDER FORE
 ORA A
 JP WBL60  NO EOF, JUST WRITE
 LHLD FBDL
 MOV A,H
 ORI 128  SET HIGH BIT
 MOV H,A
 SHLD FFORE  SET NEW COUNT IN FORE PTR
*
*  SET OUTGOING HEADER
*
 LXI D,FFORE
 LXI H,OHFOR
 CALL MOVEF  JUST MOVE IT
 DB OHPRO-OHFOR+1
 CALL STDAD  SET TRANSFER DESCRIPTOR
 JMP WDSKH  WRITE BLOCK AND HEADER
*
*
*  WRITE BLOCK TO DISK OR OTHER WONDERFUL DEVICE
*
WBL60 CALL STDAD  SET TRANSFER DESCRIPTOR
 JMP WDSK  WRITE IT OUT
*
*********************
*
*
*      SET TRANSFER DESCRIPTOR
*
*  COPY STUFF FROM FCB TO TDAD
*
STDAD LHLD FCURSC
 SHLD TDAD  DISK ADDRESS
 LHLD FBLKS
 SHLD TBCNT  BYTE COUNT
 LHLD FID
 SHLD TFID  FILE ID
 LHLD TBUFA
 SHLD TBUF  BUFFER ADDRESS
 LDA FUNIT
 STA TUNIT  DISK UNIT
 RET
*
*********************
*
*
*      READ NEXT BLOCK OF A DISK FILE
*
*   CURRENT FCB HAS HEADER, ID, ETC.
*   CALL DDRNB
*   RETURN - EOF
*   RETURN - OK, HEADER, FCB UPDATED
*
*
*  TEST FOR  EOF
*
DDRNB LHLD FFORE
 MOV A,H
 ANI 127
 CMP H  IS A=H=127?
 MOV H,A  HAVE HL=COUNT IN CASE
 RNZ .  A AND H DIFFER BY HIGH BIT, => EOF
*
 XCHG .  DE HAS NEXT SECTOR ADDRESS
 LHLD FCURSC
 SHLD LSECT  SAVE CURRENT SECTOR ADDRESS
 XCHG
 SHLD FCURSC  SET CURRENT AS NEXT
 CALL RBLK  READ BLOCK
 PUSH H  SAVE BDL
*
*  PERFORM STRUCTURE TEST
*
 LXI H,LSECT  POINT TO LAST SECTOR ADDRESS
 LDA FBACK
 CMP M  COMPARE LOW ORDER
 JNZ FSBAD  BAD BAD BAD
 INX H
 LDA FBACK+1
 CMP M  COMPARE HIGH ORDER
 JNZ FSBAD  BAD BAD BAD
 POP H  PASS BACK BDL
 JMP RX2
*
*
FSBAD CALL ERRL0  SERIOUS ERROR
 DB FBER  FILE STRUCTURE BAD
*
*********************
*
*
*
*      READ DISK BLOCK
*
*   CURRENT FCB IS SET
*   CALL RBLK
*   RETURN
*
*
RBLK CALL STDAD  SET TRANSFER DESCRIPTOR
 CALL RDSK  READ IT
*
*  COME HERE AFTER TRANSFER
*
RBL30 LXI D,IHFOR  COPY HEADER TO
 LXI H,FFORE  FCB.
 CALL MOVEF
 DB FPRST-FFORE+1
*
*  IF EOF, RETURN COUNT, ELSE BLOCK SIZE
*
 LHLD FFORE
 MOV A,H
 ORA A  TEST HIGH BIT FOR EOF
 JP RBL40  NO EOF
 ANI 127  MASK OFF HIGH BIT
 MOV H,A  HL HAVE NEW COUNT
 RET .  RETURN
*
RBL40 LHLD FBLKS  NO EOF, USE BLOCK SIZE
 RET
*
*********************
*
*
*      FLUSH DEVICE BUFFER
*
FDB LHLD FDRIV
 LXI D,DTITO  DISPL. TO ITO
 DAD D
 MOV A,M  PICK UP ITO
 ORA A
 RZ .  ZERO, RETURN
 CALL WDBUF  WRITE OUT (IT BETTER BE DIRTY)
 LXI H,0  THEN BDL=NBD=0
 JMP WDB45
*
 PAGE
*
*
*********************
*
*
*
*               RELEASE FILE BLOCK
*
*  CURRENT FCB HAS STUFF
*  CALL RFBLK
*  RETURN
*
*  FCURSC IS THE BLOCK RELEASED.
*  THE FREE SPACE MAP IS UPDATED.
*  FDLTA IS UPDATED
*
*  GET COUNT OF TRUE NUMBER OF SECTORS
*
RFBLK LDA FPRST
 ANI 15  EXTRACT LOW 4 BITS
 STA RFBCN
 STA RFBC1  SAVE
*
*      REWRITE BLOCK
*  SET OUTPUT HEADER, THEN LOOP AND WRITE
*
 LXI H,0
 SHLD OHFOR
 SHLD OHBAK
 SHLD OHFID
 SHLD TFID
 MVI A,1
 STA OHPRO  1 SECTOR
 LHLD FCURSC
 SHLD TDAD  SET DISK ADDRESS
 LXI H,SECTSZ
 SHLD TBCNT  SET STANDARD BYTE COUNT
 LXI H,DKBUF
 SHLD TBUF  SET TO USE DISK ALLOC. BUFFER
 LDA FUNIT
 STA TUNIT  SET UNIT
*
RFB10 CALL WDSKH  WRITE SECTOR AND HEADER
 LXI H,TSEC
 INR M  MOVE TO NEXT SECTOR
 LXI H,RFBCN
 DCR M  COUNT DOWN ON SECTOR COUNT
 JNZ RFB10
*
*  READ FREE MAP
*
 LXI D,MAPDS
 LXI H,TDAD
 CALL MOVEF  MOVE STUFF TO TRANSFER DESCRIPTOR
 DB TBUF-TDAD+2
 CALL RDSK
*
*  FIND WORD TO UPDATE
*
 LDA FCURSC+1  TRACK NUMBER
 MOV E,A
 MVI D,0  DE HAS TRACK NUMBER
 LXI H,DKBUF
 DAD D
 DAD D  HL POINTS TO ENTRY
*
*  UNPACK IT
*
 PUSH H  SAVE HL
 MOV B,M
 INX H
 MOV C,M  BC HAVE WORD
 CALL UNPK  UNPACK INTO PBUF
*
*  SET BITS
*
 LXI D,TMBUF  TRACK MAP BUFFER
 LDA FCURSC
 MOV L,A
 MVI H,0  HL HAVE SECTOR ADDRESS
 DAD D  HL NOW POINT TO WORD
 LDA RFBC1  GET COUNT OF SECTORS
*
RFB30 MVI M,1  SET BIT
 INX H
 DCR A
 JNZ RFB30
 CALL PACK  RE PACK THE WORD
 POP H
 MOV M,B
 INX H
 MOV M,C  STORE BACK INTO MAP
*
*  REWRITE MAP
*
 CALL WDSK
 LHLD FDLTA
 DCX H
 SHLD FDLTA
 RET .  THAT IS ALL
*
*********************
*
*
*  FREE SPACE MAP DESCRIPTOR
*
MAPDS DB DAFSS
 DB DAFST
 DW 77+77  MAP LENGTH
 DW IDFSM  MAP ID
 DW DKBUF  USE DISK ALLOCATION BUFFER
*
*********************
*
*
*        UNPACK BC INTO TMBUF
*  1 BIT IS PLACED IN EACH WORD. B FIRST.
*
*
UNPK LXI H,TMBUF
 MVI D,16  ZERO IT FIRST
 XRA A  = 0
*
UNPK5 MOV M,A
 INX H
 DCR D
 JNZ UNPK5
*
 LXI H,TMBUF
 MOV A,B  B FIRST
 CALL UNP
 LXI H,TMBUF+8
 MOV A,C  C NEXT
 CALL UNP
 RET
*
*
*  UNPACK A INTO HL
*
UNP ORA A
 RZ .  ZERO, DONE
 RAL .  LEFT 1 PLACE, ZERO FILL
 MVI M,0
 JNC UNP10  NO CARRY, ITS ZERO
 INR M  INCREMENT TO 1
UNP10 INX H
 JMP UNP
*
*
*  PACK TMBUF INTO BC, RETURNS BC
*
PACK LXI H,TMBUF
 CALL PAC
 MOV B,A  B FIRST
 LXI H,TMBUF+8
 CALL PAC
 MOV C,A  C NEXT
 RET .  WASNT THAT EASY...
*
*
*  PACK HL INTO A
*
PAC XRA A
 MVI D,8  COUNT IS 8
*
PAC5 MOV E,A  SAVE PARTIAL
 MOV A,M  GET BIT
 RAR .  PUT IN CARRY
 MOV A,E  GET PARTIAL
 RAL .  SHIFT IN BIT
 INX H
 DCR D
 JNZ PAC5  AGAIN
 RET .  QUIT
*
*********************
*
*
*       PREPARE BUFFER
*
*  CURRENT FCB IS SET UP
*  CALL PBUF
*  RETURN - BUFFER IS SET UP
*
PBUF CALL BUFTST
 RNZ .  ALL DONE IF BUFFERED
*
*  UNBUFFERED, ALLOCATE AND PRIME BUFFER
*
PBU70 LHLD FBLKS
 PUSH H  SAVE BLOCK SIZE
 XCHG
 CALL ALBUF  ALLOCATE BUFFER
 SHLD TBUFA  OK
 POP D  DE=CT, HL->BUFFER
 CALL DVBR  READ IN BLOCK
 DB DTRB
 JMP SEOF  BAD IDEA *******
 SHLD FBDL
 RET
*
*
*   TEST IF FILE IS UNBUFFERED
*
BUFTST LHLD FBUFA
 INX H
 MOV A,H
 ORA L  IF IT WAS -1, IT IS UNBUFFERED
 DCX H  BACK TO TRUE
 SHLD TBUFA  SET IT TO TRUE BUFFERED ADDRESS
 RET .  ZERO PSW IF UNBUFFERED
*
*********************
*
*
*    RESTORE FCB
*
*  IF FRADD ZERO, DO NOTHING. LEAVE FRADD ZERO.
*
RFCB LHLD FRADD
 MOV A,L
 ORA H
 RZ .  ZERO, JUST RETURN
 LXI D,FCBORG
 CALL MOVEF  MOVE BACK
 DB LNFCB
*
RFCB1 LXI H,0
 SHLD FRADD  SET FRADD TO ZERO
 RET
*
*********************
*
*
*    LINK BLOCK
*
*  ALLOCATE AND LINK A BLOCK ONTO THE CURRENT ONE.
*  FOR DISK FILES ONLY.
*
LNKBLK CALL PROTST  CHECK IF ALLOCATE PROTECTED
 DB PALO
 JMP EOFE0  YES, PROTECTED!
*
 LHLD FBACK
 SHLD LNKT2  SAVE BACK POINTER
*
*  SET UP HEADER FOR NEW BLOCK
*
 LHLD FCURSC
 SHLD FBACK  SET BACK AS CURRENT
 SHLD LNKT1  SAVE CURRENT
 LXI H,EOFCD
 SHLD FFORE  SET FORE = EOF
*
*  ID, ETC. ARE THE SAME, ALLOCATE NEW
*
 CALL AFBLK
 SHLD FCURSC  SET AS CURRENT SECTOR
*
*  UPDATE HEADER OF LAST BLOCK
*
 SHLD OHFOR  FORE IS NEW SECTOR
 LHLD LNKT1
 SHLD TDAD  DISK ADDRESS OF LAST BLOCK
 LHLD LNKT2
 SHLD OHBAK  RESTORE BACK POINTER
 CALL WDSKH
 LHLD FINDX  INDEXED?
 MOV A,H
 ORA L
 JZ LNK40  NO, FORGET IT
*
*     UPDATE RANDOM FILE INDEX
*
 CALL RINDX  READ INDEX
 MVI B,128
 LXI H,DIBUF
*
*    SEARCH FOR ZERO ENTRY
*
LNK10 MOV A,M
 INX H
 ORA M
 JNZ LNK30
 XCHG
 LHLD FCURSC  GET CURRENT BLOCK
 XCHG
 MOV M,D  PUT IN NEW ENTRY
 DCX H
 MOV M,E
 CALL WDSK  WRITE OUT INDEX
 CALL UPIM  UPDATE INDEX IN MEMORY, IF ANY
 MVI B,1  SET FLAG THAT WE FOUND IT
*
LNK30 INX H
 DCR B
 JNZ LNK10  NOT YET
LNK40 LXI H,0  NO BYTES YET
 RET
*
 PAGE
*
*
*********************
*
*
*      SEARCH FILE CONTROL BLOCKS
*
*    HL HAS FILE ID
*    FUNIT HAS UNIT
*    CALL SFCBS
*
*    RETURN - >1 FOUND
*    RETURN -  1 FOUND
*    RETURN -  0 FOUND
*
SFCBS XCHG .  DE HAS ID NOW
 XRA A
 STA SFCT1  INITIALIZE COUNT
 LHLD FCBASE  HL POINT TO FCB
 LDA NFCB
 STA SFCT2  SET COUNT
*
SFC20 LXI B,FID-FCBORG
 DAD B  HL POINT TO FILE ID
 MOV A,M  GET LOW ORDER ID
 INX H
 CMP E  CHECK
 JNZ SFC70  NO, MOVE TO NEXT
*
 MOV A,M  GET HIGH ORDER ID
 CMP D  CHECK
 JNZ SFC70  NO, MOVE TO NEXT
*
*  ID MATCH, CHECK UNIT
*
 LXI B,FUNIT-FID-1
 DAD B  MOVE TO UNIT
 LDA FUNIT
 CMP M  CHECK UNIT
 JNZ SFC40  NO, UNITS DIFFER
*
*  FOUND
*
 LDA SFCT1  COUNT UP
 INR A
 STA SFCT1
*
SFC40 LXI B,FPRST-FUNIT+1
 DAD B  MOVE TO BEGINNING OF NEXT FCB
 JMP SFC75
*
*
SFC70 LXI B,FPRST-FID-1+1
 DAD B  MOVE TO NEXT FROM FID+1
*
SFC75 LDA SFCT2
 DCR A
 STA SFCT2  DROP COUNT
 JNZ SFC20  DO NEXT
*
*  DONE, DO RETURN
*
 LDA SFCT1  GET COUNT
 CPI 2
 RNC .  MORE THAN 2
 POP H
 INX H
 INX H
 INX H
 PUSH H  UPDATE RETURN
 ORA A  SET FLAGS
 RNZ .  MUST BE 1
 INX H
 INX H
 INX H
 XTHL .  UPDATE RETURN
 RET .  AND RETURN FOR ZERO.
*
 PAGE
*
*
*********************
*
*
*    GET RID OF DANGLING BUFFER
*    BECAUSE OF AN ERROR
*
RIDBF LHLD WBUFSZ
 MOV A,H
 ORA L
 RZ .  NONE
 XCHG
 LHLD WBUFAD  GET IT AND FALL THROUGH TO DEALLOCATE
*
*     FALL THROUGH
*
*********************
*
*
*   DEALLOCATE BUFFER
*
*  HL POINTS TO BUFFER
*  DE HAS BUFFER SIZE
*  THE BUFFER MUST BE IN THE SYSTEM GLOBAL AREA.
*  CALL DLBUF
*  RETURN
*
DLBUF SHLD DABT1  SAVE BUFFER ADDRESS
 XCHG
 SHLD DABT2  SAVE BUFFER SIZE
 DAD D  ADDRESS OF NEXT BUFFER (HL)
 PUSH H
 LXI H,0
 SHLD WBUFSZ  CLEAR SAVED BUF
 POP H
*
*  BUFFER ADDRESS (DE)
*
*      COMPRESS BUFFER SPACE
*
*  DE POINTS TO ONE WORD HIGHER THAN BUFFER
*  HL POINTS ONE WORD HIGHER THAN NEXT LOWER BUFFER.
*
DAB10 PUSH H
 LHLD MINAD  COMPARE DE WITH MINIMUM ADDRESS
 CALL COMP
 POP H  RESTORE HL
 JZ DAB30  MOVE IS DONE
*  MOVE A BYTE
 DCX H
 DCX D
 LDAX D
 MOV M,A
 JMP DAB10
*
*
*  ADJUST ANY AFFECTED ADDRESSES IN THE FCBS
*
DAB30 SHLD MINAD
 LHLD FCBASE
 LXI D,FBUFA-FCBORG
 DAD D
 PUSH H  FIRST BUFFER ADDRESS
 LDA NFCB
 STA DABT3
*
DAB40 MOV E,M
 INX H
 MOV D,M  GET BUFFER ADDRESS FROM FCB
 LHLD LOWAD
 CALL COMP  COMPARE WITH GLOBAL BASE
 JC DAB50  BELOW, MUST BE A USER BUFFER
*
 LHLD DABT1
 CALL COMP  COMPARE WITH BUFFER ADDRESS
 JNC DAB50  ABOVE AFFECTED AREA
*
 LHLD DABT2  GET DELTA
 DAD D  = UPDATED BUFFER ADDRESS
 XCHG .  IN DE
 POP H
 MOV M,E
 INX H
 MOV M,D  PUT BACK INTO FCB
 DCX H
 PUSH H
*
*  MOVE TO NEXT
*
DAB50 POP H  GET POINTER TO BUFF +1
 LXI D,LNFCB  DELTA TO NEXT FCB
 DAD D
 LDA DABT3  CHECK COUNT
 DCR A
 RZ
 STA DABT3
 PUSH H  SAVE POINTER AGAIN
 JMP DAB40
*
*