PAGE
*
*
*********************
*
*
*            ALLOCATE FILE BLOCK
*
*  THE CURRENT FCB HAS THE DESIRED BLOCK SIZE AND HEADER.
*  AN ABORT IS TAKEN IF THE BLOCK SIZE IS ILLEGAL OR
*  IF THE DISK IS TOO FULL.
*
*  CONTROL RETURNS TO CALL+1 WITH THE BLOCK ADDRESS IN HL
*
AFBLK LHLD FBLKS  FIRST CHECK FOR LEGAL BLOCK SIZE
 PUSH H
 MOV A,L
 ORA H  IS IT ZERO?
 JZ AFB95  IF SO, ILLEGAL
 LXI D,-4096
 DAD D  >=4096?
 JC AFB95  YES ILLEGAL
 POP H  GET BACK BLOCK SIZE
 CALL AFCALC  CALCULATE THE REQUIRED NUMBER OF SECTORS
*
AFB10 MOV A,C  C HAS THE NUMBER OF SECTORS
 STA AFBT1  WE SAVE IT HERE
*
*  READ THE FSMAP
*
 LXI D,MAPDS  FROM HERE
 LXI H,TDAD  TO THE TRANSFER DESCRIPTOR
 CALL MOVEF  SET UP
 DB TBUF-TDAD+2
 LDA FUNIT  GET WHICH UNIT
 STA TUNIT  SET FOR DISK DRIVER
 CALL RDSK
*
*  SET UP MAP SEARCH FOR FREE SPACE
*
 XRA A
 STA AFBTT  SET TRACK NUMBER
 LXI H,DKBUF  ALLOCATION MAP BUFFER
 SHLD AFBT3  SET TRACK MAP POINTER
*
*  OUTER LOOP FOR ALLOCATION BEGINS HERE
*  LOOK FOR NEXT TRACK
*
AFB20 LHLD AFBT3
 MOV B,M  PICKUP MAP
 INX H
 MOV C,M  CURRENT TRACK
 INX H
 SHLD AFBT3  SAVE UPDATED POINTER
 CALL UNPK  UNPACK THE MAP
*
*  A TRACK MAP IS NOW UNPACKED IN PBUF
* AFBT1 HAS THE REQUIRED NUMBER OF SECTORS
*  SET UP FOR MAP SCAN
*
 XRA A
 STA AFBT4  SAVE STARTING SECTOR
 LDA AFBT1  NUMBER OF SECTORS REQUIRED
 MOV B,A  CALCULATE NUMBER FOR LOOP
 MVI A,17  ITERATIONS = 16-AFTB1+1
 SUB B
 MOV B,A  B HAS LOOP COUNT
 LXI H,TMBUF  SCAN STARTING POINT
*
*  THE INNER LOOP TO SCAN THE MAP OF THE CURRENT
*  TRACK BEGINS HERE
*
AFB40 SHLD AFBT6  SAVE PBUF POINTER
 LDA AFBT1
 MOV C,A  NUMBER OF SECTORS REQUIRED
*
AFB50 MOV A,M
 ORA A
 JZ AFB70  NO, THIS BLOCK IS NO GOOD
 INX H  BUMP POINTER
 DCR C  COUNT DOWN
 JNZ AFB50  TRY NEXT SECTOR
*
*  AT THIS POINT WE HAVE FOUND A BLOCK ON THE CURRENT
*  TRACK OF SUFFICIENT LENGTH.  WE NOW PROCEED TO GIVE
*  IT TO THE USER.
*
*  CLEAR BITS IN MAP
*
 LHLD AFBT6  PBUF POINTER
 LDA AFBT1  SECTOR COUNT
AFB60 MVI M,0  CLEAR BIT
 INX H  MOVE TO NEXT
 DCR A
 JNZ AFB60
*
*  REPACK CURRENT TRACK MAP AND REWRITE TO DISK
*
 CALL PACK
 LHLD AFBT3  GET UPDATED TRACK MAP POINTER
 DCX H  MOVE BACK
 MOV M,C
 DCX H
 MOV M,B  STORE MAP BACK IN
 CALL WDSK  WRITE MAP, TDAD IS STILL SET UP
*
*  INITIALIZE BLOCK FOR USER
*
 LDA AFBT4  GET SECTOR NUMBER
 STA TSEC  TO THE TRANSFER DESCRIPTOR
 LDA AFBTT  GET TRACK NUMBER
 STA TTRK
*
*  SET OUTGOING HEADER AND TRANSFER DESCRIPTOR
*
 LHLD FBLKS
 SHLD TBCNT  BYTE COUNT
 LXI H,0
 SHLD TFID  SET FREE SPACE FILE ID
 LHLD TBUFA
 SHLD TBUF  SET BUFFER ADDRESS
*
*  UNIT IS ALREADY SET
*
 LXI D,FFORE
 LXI H,OHFOR
 CALL MOVEF  MOVE IN USER HEADER
 DB OHPRO-OHFOR+1
*
*  INITIALIZE DISK BLOCK
*
 CALL WDSKH  WRITE HEADER AND DATA
*
*  RETURN DISK ADDRESS TO USER AND UPDATE DELTA
*
 LHLD FDLTA
 INX H
 SHLD FDLTA
 LHLD TDAD
 RET
*
*********************
*
*
*  CALCULATE NUMBER OF SECTORS REQUIRED
*
AFCALC MVI C,0  FOR STARTERS
 LXI D,-SECTSZ  FIRST SECTOR IS THIS BIG
*
AFB05 DAD D  SUBTRACT AMOUNT IN THIS SECTOR
 INR C  BUMP THE SECTOR COUNT
 MOV A,H
 ORA A
 RM .  RESULT NEGATIVE, GOT ENOUGH
*
 ORA L  ZERO IS GOOD ENOUGH, THOUGH
 RZ
*
 LXI D,-FULSZ  SUBSEQUENT SECTORS ARE THIS BIG
 JMP AFB05
*
*********************
*
*   CAN'T ALLOCATE ONE HERE...MOVE TO NEXT
*
*
AFB70 LXI H,AFBT4
 INR M  BUMP SECTOR NUMBER
 DCR B  TOTAL ITERATIONS
 JZ AFB80  THIS TRACK IS FULL
 LHLD AFBT6  MOVE PBUF POINTER
 INX H  UP ONE
 JMP AFB40  AND LOOP
*
*
*   THIS TRACK IS TOO FULL,  TRY NEXT TRACK
*
AFB80 LDA AFBTT
 INR A  MOVE TO NEXT TRACK
 STA AFBTT
 CPI 77  DISK FULL?
 JC AFB20  STILL OK
*
*   DISK IS FULL ABORT
*
 LHLD LNKT1  GET BACK CURRENT SECTOR
 SHLD FCURSC
 LHLD LNKT2  AND BACK POINTER
 SHLD FBACK
*
 CALL ERRL1
 DB DAER0  DISK FULL
*
*
AFB95 CALL ERRL1
 DB DAER1  ILLEGAL BLOCK SIZE
*
 PAGE
*
*
****************************
*
*
*          SHORT RESET AFTER ABORT
*
USRES XRA A
 STA UA
SRESET XRA A
 STA CIFILE  SET CIFILE TO 0
 INR A
 STA COFILE
 INR A
 STA UTIL  SET UTILITY FILE = 2
*
*  CLEAR COMMAND STRING
*
 LHLD FCBASE
 LXI D,FNBD-FCBORG
 DAD D  POINT TO NBD WORD IN FCB #0
 MVI A,4  CLEAR FOUR BYTES
*
CSTRG MVI M,0
 INX H
 DCR A
 JNZ CSTRG  NBD=BDL=0
*
 LXI SP,CISTK  USE CI STACK
 CALL INRST  RESET THE DISK TRAPS
 SHLD CRTRAP  CLEAR CI RETURN TRAP = -1
 LDA UA
 ORA A
 JZ CI  CAN'T EXPLAIN ZERO
*
*  WAIT FOR A CHARACTER
*
 CALL CONIN
 CPI CR
 JZ CI  CR....DON'T EXPLAIN
*
*  TYPE MESSAGE
*
 LHLD UTOS  GET USER RETURN INTO HL
 SPHL
 POP H  = USER RETURN HOPEFULLY
 LXI SP,CISTK
 MVI A,-1
 STA OPER  ERRP8 SETS EOPR TO OPER
 JMP ERRP8
*
*
*********************
*
SRE50 STA UA  SAVE SYSTEM ERROR
*
*  1) SET ERCD TO UA  (THE CALLED ERROR #)
*  2) SET ERROR TRAPS
*  3) DO UTILITY WILL "CALLED FROM" MSG
*
*   TRAP HERE IF ERROR DURING EXPLAIN
*
XTRP CALL OUST
 DB CR
 DB LF
 ASC "CAN'T EXPLAIN"
 DB 0
 JMP ABURP  TRY TO ABORT AGAIN
*
*