    NAM INITER
***********************************************************
* Extracted from the book:
* "CP/68, an M6800 Operating System" by Jack E. Hemenway
*
* Scott LaBombard
* labomb@rochester.rr.com
* 02/29/2019
***********************************************************
*
* INITIALIZE A DISK FOR CP-68 OPERATING SYSTEM
*
* FOR PERCOM FLOPPY DISKS
*
*
* TRACK 0, SECTOR  1        HEADER OF FREE-SPACE LIST
* TRACK 0, SECTORS 2-10     DIRECTORY SPACE
* TRACKS 1-35               FREE-SPACE
*
*
* DISK ATTRIBUTES
*
SECSIZ EQU 256      256 BYTES PER SECTOR    
TRKSIZ EQU 10       10 SECTORS PER TRACK
DSKSIZ EQU 34       35 TRACKS ON DISK (LESS TRACK 0)
*
* FILE-CONTROL BLOCK ADDRESSES
*
FCBSTA EQU 5        ERROR STATUS FLAG
FCBDBA EQU 7        DATA BUFFER ADDRESS
FCBDRV EQU 9        DRIVE NUMBER
FCBTRK EQU 10       TRACK NUMBER
FCBSCT EQU 11       SECTOR NUMBER
FCBTLK EQU 12       TRACK LINK POINTER
FCBSLK EQU 13       SECTOR LINK POINTER
*
FCBSPC RMB 2        FILE-CONTROL BLOCK
       FCC 'DSK'    DISK
       RMB 1
       FCB $FF      OUTPUT
       RMB 35
*
BUFFER RMB SECSIZ   SECTOR BUFFER
*
* COMMAND-LINE INTERPRETER BASE-PAGE LOCATIONS
*
DESCRA EQU $20      ADDRESS OF TOKEN
VALUE  EQU $27      VALUE OF NUMERIC TOKEN
*
PROMPT FCC 'INIT. DISK IN DRIVE '
DRVNO  RMB 1
       FCC   ' ? '
       FCB $04
*
       ENT .INITR   ENTRY POINT FROM CLI
*
.INITR LDA A VALUE+1  GET DRIVE NUMBER
    AND A #$03      LIMIT RANGE (ICOM PERMITS 4 DRIVES)
    LDX #FCBSPC     POINT TO FCB
    STA A FCBDRV,X
    ADD A #$30      MAKE DRIVE NUMBER ASCII
    STA A DRVNO     PUT IN PROMPT LINE
    LDX #PROMPT
    PRTMSG          OUTPUT PROMPT
    GTCMD           GET USER RESPONSE
    LDX DESCRA
    LDA A 0,X       GET FIRST CHAR. OF RESPONSE
    CMP A #'Y       WAS IT 'YES'?
    BEQ INITR2      IF SO, CONTINUE
*
    RTS             IF NOT, QUIT
*
INITR2 LDX #FCBSPC  POINT TO FCB
    CLR FCBTRK,X    TRACK=0
    LDA A #1
    STA A FCBSCT,X  SECTOR=1
*
* INITIALIZE HEAD OF FREE-SPACE BLOCK
*
* ALL ZERO EXCEPT FOR LAST TWO BYTES=TRACK 1, SECTOR 1 
*
    TXAB
    LDX #BUFFER
    XABX
    STA A FCBDBA,X
    STA B FCBDBA+1,X
    PSHX
*
* CLEAR OUT BUFFER EXCEPT FOR LAST 2 BYTES
*   
    LDX #BUFFER
    LDA B #SECSIZ-2
    CLR A
INITR3 STA A 0,X
    INX
    DEC B
    BNE INITR3
*   
    LDA A #1        TRACK, SECTOR=1
    STA A 0,X
    STA A 1,X
    PULX
    BSR WRTBLK      WRITE BLOCK 1
    TST FCBSTA,X    CHECK FOR DISK ERROR
    BEQ *+6         OK
*   
    BRA INITQ       FATAL DISK ERROR, QUIT
*
_WRTBL BRA WRTBLK   OUT OF RANGE "BSR WRTBLK"
    INC FCBSCT,X    SECTOR=2
    CLR BUFFER+SECSIZ-2
    CLR BUFFER+SECSIZ-1
*
* INITIALIZE DIRECTORY TO ZERO
*
INITR4 BSR WRTBLK   WRITE DIRECTORY BLOCK
    TST FCBSTA,X    CHECK FOR DISK ERROR
    BEQ *+4         OK
*
    BRA INITQ       FATAL DISK ERROR, QUIT
* 
    LDA A FCBSCT,X
    INC A           NEXT SECTOR
    CMP A #TRKSIZ+1 DONE WITH TRACK?
    BEQ INITR5      YES
* 
    STA A FCBSCT,X
    BRA INITR4      NO, CONTINUE WRITING
*
INITR5 LDA A #1
    STA A FCBSCT,X  SECTOR=1
    STA A FCBTRK,X  TRACK=1
    TAB
*
* INITIALIZE REST OF DISK (FREE-SPACE)
*
*   X=FCB ADDRESS
*   A=TRACK NUMBER
*   B=SECTOR NUMBER
*
INITR6 INC B        MAKE SECTOR LINKAGE
    CMP B #TRKSIZ+1 END OF TRACK?
    BNE INITR7      NO
* 
    LDA B #1        YES, SECTOR=1
    INC A           NEXT TRACK
    CMP A #DSKSIZ+1 END OF DISK?
    BNE INITR7      NO
* 
    CLR A           LAST SECTOR POINTS TO 0,0
    CLR B
*
INITR7 STA A >BUFFER  TRACK LINK
    PSH B           SAVE LSEC
    BSR GETSC       GET PSEC
    STA B >BUFFER+1 SECTOR LINK
    PUL B           RESTORE LSEC
    BSR WRTBLK      WRITE SECTOR
    TST A           DONE? (=0)
    BNE INITR8      NO
* 
    TST B           DONE? (=O)
    BNE INITR8      NO
* 
    RTS             YES, DONE!!!
*
INITR8 STA A FCBTRK,X
    PSH B           SAVE LSEC
    BSR GETSC       GET PSEC
    STA B FCBSCT,X
    PUL B           GET LSEC
    BRA INITR6      KEEP WRITING
*
*
* FATAL ERROR MESSAGE
*
INITQ LDX #QMSG     OUTPUT ERROR MESSAGE
    PRTMSG
    RTS             RETURN TO CLI
*
QMSG FCC 'INITIALIZATION FAILED'
    FCB $0D
*
* CONVERT LSEC TO PSEC
* LSEC IN B-REG
*
GETSC PSHX          SAVE X-REGISTER
    LDX #TBL        POINT TO LOGICAL/PHYSICAL TABLE
    ADDBX           ADD LOGICAL OFFSET
    DEX             SECTOR STARTS AT 1
    LDA B 0,X       GET PSEC
    PULX            RESTORE X-REG
    RTS
*
* WRITE A SECTOR WITH ERROR CHECKING
*
WRTBLK PSH A        SAVE 'A'
    CLR FCBSTA,X    CLEAR ERROR FLAG
    IOHDR           ISSUE I/O REQUEST
    TST FCBSTA,X    ERROR?
    BNE WRTERR      YES
*
    PUL A           RESTORE 'A'
    RTS
*
WRTERR TAB
    BSR OUTHL       CONVERT LEFT DIGIT
    STA A ERTYPE
    TBA
    BSR OUTHR       CONVERT RIGHT DIGIT
    STA A ERTYPE+1
    PSHX            SAVE X
    LDA A FCBSCT,X
    BSR OUTHL       MAKE SECTOR NO. HEX
    STA A SECT
    LDA A FCBSCT,X
    BSR OUTHR
    STA A SECT+1
    LDA A FCBTRK,X
    BSR OUTHL       MAKE TRACK NO. HEX
    STA A TRACK
    LDA A FCBTRK,X
    BSR OUTHR
    STA A TRACK+1
    LDX #DERROR
    PRTMSG          PRINT ERROR MESSAGE
    SWI             CALL CP/68
    FCB 31          "WARMSTART"
    RTS             QUIT
*
DERROR  FCC 'DISK ERROR:'
ERTYPE  RMB 2
        FCC ' AT SECTOR '
SECT    RMB 2
        FCC ', TRACK '
TRACK   RMB 2
        FCB $0D
*
* CONVERT BINARY TO HEX-ASCII HERE
*
OUTHL LSR A         SHIFT RIGHT
    LSR A
    LSR A
    LSR A
*
OUTHR AND A #$0F    GET NIBBLE
    ADD A #$30      MAKE ASCII
    CMP A #$39      >9?
    BLS *+4         NO
*
    ADD A #$7       YES
*
    RTS
*
*
* LOGICAL/PHYSICAL SECTOR TABLE
*
    FCB 00
*
TBL FCB $1
    FCB $5
    FCB $9
    FCB $3
    FCB $7
    FCB $2
    FCB $6
    FCB $A
    FCB $4
    FCB $8
    END
