www.jupiter-ace.co.uk
 
Previous Page > Hardware index > Deep Thought AceDOS code listing.
Archive Search  


 Deep Thought AceDOS code listing.


; *********************************************************
; ***	                                                ***
; ***	            Jump Table                          ***
; ***	                                                ***
; *********************************************************

Find-index          JP $F900          ; $F800
Find-header         JP $F923          ; $F803
Save-block          JP $F953          ; $F806
Load-block          JP $F9D0          ; $F809
Wait                JP $FA03          ; $F80C
On                  JP $FA0D          ; $F80F
Off                 JP $FA24          ; $F812
Setup               JP $FA2B          ; $F815
Step                JP $FA64          ; $F818
Step-out            JP $FA62          ; $F81B
DRIVE               JP $FA74          ; $F81E
Print               JP $FA86          ; $F821
Track00             JP $FAAS          ; $F824
Save-cat            JP $FAB1          ; $F827
Load-cat            JP $FAC3          ; $F82A
Print-error         JP $FAE7          ; $F82D
XFORMAT             JP $FB0A          ; $F830
Save-file           JP $FB31          ; $F833
Load-file           JP $FB6D          ; $F836
Find-word           JP $FBA6          ; $F839
Enter-word          JP $FBDS          ; $F83C
Lookup-word         JP $FC18          ; $F83F
Hex-byte            JP $FC2C          ; $F842
Hex-char            JP $FC35          ; $F845
CAT                 JP $FC41          ; $F848
Dict-size           JP $FCCA          ; $F84B
Block-length        JP $FCD4          ; $F84E
Delete file         JP $FCDF          ; $F851
DELETE              JP $FD19          ; $F854
Error-?             JP $FD2A          ; $F857
Store               JP $FD35          ; $F85A
DSAVE               JP $FD65          ; $F85D
DBSAVE              JP $FD70          ; $F860
DBLOAD              JP $FD90          ; $F863
RESAVE              JP $FDB2          ; $F866
Word                JP $FDC3          ; $F869
MAP                 JP $FDD0          ; $F86C
DLOAD               JP $F880          ; $F872
SCRATCH             JP $F8D5          ; $F875
Fill-length         JP $FDF0          ; $F878


; *********************************************************
; ***                                                   ***
; ***               Constants                           ***
; ***                                                   ***
; *********************************************************

Acia-status     EQU  $21        ; Acia status register.
Acia-in         EQU  $23        ; Acia data input register.
Acia-control    EQU  $01        ; Acia control register.
Acia-out        EQU  $03        ; Acia data output register.

Pia-a-i         EQU  $29        ; PIA port A data input.
Pia-a-o         EQU  $09        ; PIA port A data output.
Pia-b-o         EQU  $0D        ; PIA port B data output.
Pia-a-cr        EQU  $0B        ; PIA port A control register.
Pia-b-cr        EQU  $0F        ; PIA port B control register.

Dos-words       EQU  $FFFD      ; Address of name length field
                                ; of first DOS FORTH word.
Forth-link      EQU  $3C47      ; Address of the link field
                                ; of the word FORTH.
Cat-size        EQU  $F8FE      ; Address of the first of two
                                ; bytes holding the length
                                ; of the cat in bytes + 1.
Message-space   EQU  $FE30      ; Address of the first string
                                ; used by Print.
Pad             EQU  $2701      ; Address of the Forth PAD
RAMTOP          EQU  $3C18      ; Hold the address of the highest
                                ; byte used by the Jupiter Ace.
                                ; The drive number is stored at
                                ; (RAMTOP). The cat starts at
                                ; (RAMTOP) + 1.
                                ; where a word read by WORD
                                ; is placed.
Enter-forth     EQU  $4B9       ; Enter forth from machine code.
WORD            EQU  $5AB       ; Parameter field address of WORD.
End-forth       EQU  $1A0E      ; Forth word to enter Z-80 code.



 
; *********************************************************
; ***                                                   ***
; ***               Find-index                          ***
; ***                                                   ***
; *********************************************************


; * Waits for the index hole to pass.

; * No arguments or results
; * DE and HL preserved.
; * Can give "Wot no disk" or "Wot no index hole".

; * Calls: None
; * Called by: Find-header and Save-block.


            ; First, loop till high, then loop till low.

            LD BC,$7D00             ; Time out count.
Whilelo     DEC BC                  ; Decrease count
            LD A,B                  ; and test
            OR C                    ; for zero.
            LD A,3                  ; If zero then call Error-?
            CALL Z,Error-?          ; with 3 for "Wot no disk".
            IN A, (Pia-a-i)
            AND 1                   ; Test bit 0.
            JR Z,Whilelo            ; Loop till high.

            LD BC,$7D00             ; Time out count.
Whilehi     DEC BC                  ; Decrease count
            LD A,B                  ; and test
            OR C                    ; for zero.
            LD A,4                  ; Error 4 is
            CALL Z,Error-?          ; "Wot no index hole"
            IN A, (Pia-a-i)
            AND 1                   ; Test bit 0.
            JR NZ,Whilehi           ; Loop till low.
            RET



 
; *********************************************************
; ***                                                   ***
; ***               Find-header                         ***
; ***                                                   ***
; *********************************************************

; * Waits for the index hole to pass and then reads
; * the header which is a sequence of $FF's followed by
; * a 42.

; * A=0 if header found in time.
; * A=5 if header not found.
; * DE and HL preserved.
; * Can give "Wot no disk" or "Wot no index hole".

; * Calls: Find-index.
; * Called by: Load-block and Save-block.

            CALL Find-index
            LD BC,$7D00             ; Time out count.
 NotFF      DEC BC                  ; Decrease count
            LD A,B                  ; and test for zero.
            OR C
            LD A,5                  ; Return with 5 if zero.
            RET Z
            IN A,(Acia-status)
            AND 1                   ; Test Read-full bit.
            JR Z,NotFF              ; Loop if not ready.
            IN A,(Acia-in)          ; Read byte from disk.
            CP $FF
            JR NZ,NotFF             ; Loop while byte is FF.

IsFF        DEC BC                  ; Check for timeout
            LD A,B                  ; again as before.
            OR C                    ; Test for zero.
            LD A,5                  ; Return 5 for "Wot no header"
            RET Z                   ; if zero.
            IN A,(Acia-status)
            AND 1                   ; Test Read-full bit.
            JR Z,IsFF               ; Loop if not ready.
            IN A,(Acia-in)          ; Read byte from disk.
            CP $FF
            JR Z,IsFF               ; Loop while byte is FF.
            CP 42                   ; If its not FF and
            JR NZ,NotFF             ; its not 42, look for a FF again.
            XOR A                   ; Clear A (No error).
            RET



 
; *********************************************************
; ***                                                   ***
; ***               Save-block                          ***
; ***                                                   ***
; *********************************************************

; * Saves a single block of data and then verifies it against
; * memory. Assumes that the head is at the correct track.

; * On entry, HL = start address of data to be saved,
;             DE = number of bytes to be saved.

; * Calls: Wait, Find-header and Find-index.
; * Called by: Save-cat and Save-file.

            IN A,(Pia-a-i)          ; Test write-protect
            AND 4                   ; line.
            LD A,6                  ; Give "Disk is write protected"
            CALL Z,Error-?          ; if line low.
                                    ; (Assumes disk enabled).
            LD C,20                 ; Wait for 20ms,
            CALL Wait               ; for head to settle.

            DI                      ; Disable interrupts,
                                    ; Writing is time dependant.
            CALL Find-index

            PUSH DE                 ; Save start and length
            PUSH HL                 ; for verify.

            LD A,%10110111          ; Motor on, write enable.
            OUT (Pia-a-o),A

            LD C,2                  ; Wait for lms to set
            CALL Wait               ; blank at start of track.

            LD B,8                  ; Write 8 $FFs onto disk.
NextFF      IN A, (Acia-status)     ; Test ready for data.
            AND 2
            JR Z,NextFF             ; Loop till ACIA ready.
            LD A,$FF
            OUT (Acia-out),A
            DJNZ NextFF             ; Repeat for other bytes.

            ; B has been set to zero a this point as it
            ; is used as checksum.

Wait42      IN A,(Acia-status)      ; Write a single 42,
            AND 2                   ; first waiting
            JR Z,Wait42             ; for ACIA ready.
            LD A,42
            OUT (Acia-out),A

            ; Now store the data.

Mainst      IN A, (Acia-status)     ; Wait for
            AND 2                   ; ACIA ready.
            JR Z, Mainst

            LD A, (HL)              ; Get byte form data.
            OUT (Acia-out),A        ; Write it to disk.
            ADD B                   ; Add it to check sun so far,
            LD B,A
            INC HL                  ; Point to next byte in data.
            DEC DE                  ; One less byte to be written.
            LD A,D                  ; Loop
            OR E                    ; till
            JR NZ,Mainst            ; count zero.

            ; Write check sun at end.

Checkw      IN A, (Acia-status)     ; Wait for
            AND 2                   ; ACIA ready.
            JR Z,Checkw
            LD A,B                  ; Write checksum.
            OUT (Acia-out),A

            LD C,1                  ; Wait 1ms for ACIA to
            CALL Wait	            ; finish writing last bytes.

            LD A,%10111111          ; Motor on, write disable.
            OUT (Pia-a-o),A

            POP HL                  ; Recover start and length.
            POP DE

            ; Verify data.

            CALL Find-header
            CALL Error-?            ; Error if header not found.

Vloop       IN A, (Acia-status)     ; Wait for data
            LD C,A                  ; keeping status for possible
            AND 1                   ; error message.
            JR Z,Vloop

            IN A,(Acia-in)          ; Get byte from disk.
            CP (HL)                 ; Is it the same as memory ?
            LD A,2                  ; Raise "Verify error" if not.
            CALL NZ,Error-?

            LD A,C                  ; Test for error from ACIA.
            AND %1110000            ; Framing, parity or overrun.
            CALL NZ,Error-?

            INC HL                  ; Point to next byte in data.
            DEC DE                  ; One less byte to be checked.
            LD A,D                  ; Loop
            OR E                    ; till
            JR NZ,Vloop             ; count zero.

            ; Checksum not read.

            EI
            RET

 
; *********************************************************
; ***                                                   ***
; ***               Load-block                          ***
; ***                                                   ***
; *********************************************************

; * Loads a single block of data.
; * Assumes that the head is at the correct track.

; * On entry, HL = start address to load data at.
; *           DE = number of bytes to be loaded.
; *                 (must be the same as when saved).
; * On exit, A = error number, 0 if no error.

; * Calls: Wait and Find-header.
; * Called by: Load-cat and Load-file.

            LD C,20                 ; Wait for 20ms,
            CALL Wait               ; for head to settle.
            DI                      ; Disable interrupts,
                                    ; Loading is time dependant.

            CALL Find-header
            OR A                    ; Test for not error (=0).
            RET NZ                  ; Return if error in finding header.

            LD B,A                  ; B := 0, Zero checksum to start with.

Loadlop     IN A, (Acia-status)     ; Wait for data
            LD C,A                  ; keeping status for possible
            AND 1                   ; error message.
            JR Z,Loadlop

            IN A, (Acia-in)         ; Get byte from disk.
            LD (HL),A               ; Store it into memory.
            ADD A,B                 ; Checksum so far.
            LD B,A

            LD A,C                  ; Test for error from ACIA.
            AND %1110000            ; Framing, parity or overrun.
            JR NZ,IntoffR           ; Return if error.

            INC HL                  ; Point to next byte in data.
            DEC DE                  ; One less byte to be loaded.
            LD A,D                  ; Loop
            OR E                    ; till
            JR NZ,Loadlop           ; count zero.

            ; Load and check checksum.
            ; ACIA error not checked on checksum read.

LChLoop     IN A, (Acia-status)     ; Wait for data
            AND 1
            jR Z,LChLoop
            IN A, (Acia-in)         ; Checksum from disk.
            CP B                    ; Compare with sum calculated.
            ID A,1                  ; Error 1 if not the same.
            JR NZ,IntoffR
            XOR A                   ; A := 0 for no error.

IntoffR     EI
            RET



 
; *********************************************************
; ***                                                   ***
; ***               Wait                                ***
; ***                                                   ***
; *********************************************************

; * Waits a specified number of milli seconds.
; * Depends on a Z-80 clock of 3.25 MHz.

; * On entry, C is the time to be waited in ms.
; * BC,DE,HL and A are preserved.

; * Calls: None.
; * Called by: Load-block, Save-block, On and Step.

            PUSH BC                 ; Must be the same on exit.
Wait1       LD B,$FA                ; Loop lasting 1ms.
Wait        DJNZ Wait2
            DEC C                   ; Repeat the number in C times.
            JR NZ,Waitl
            POP BC
            RET

 
; *********************************************************
; ***                                                   ***
; ***               On                                  ***
; ***                                                   ***
; *********************************************************

; * Switchs the drive motor on and then, after a delay,
; * selects the drive.

; * No arguments or results.
: * Uses HL, A, C

; * Calls Wait.
; * Called by: Load-cat, XFORMAT.

            LD A,%10111111          ; Motor on.
            OUT (Pia-a-o),A

            LD C,255                ; Wait about half a second.
            CALL Wait
            CALL Wait

            LD HL, (RAMTOP)         ; Point to first byte
            LD A, (HL)              ; reserved for disk.
                                    ; This is setup by DRIVE.
            OUT (Pia-b-o),A         ; Select drive.
            LD C,$40                ; Wait for head load.
            JP Wait


  
; *********************************************************
; ***                                                   ***
; ***               Off                                 ***
; ***                                                   ***
; *********************************************************

; * Switchs the drive motor off and selects no drive.

; * No arguments or results.
; * Uses A only.

; * Calls: None.
; * Called by: XFORMAT,Save-cat,Error-?,CAT,LD and BLD.

            LD A,%11111111          ; All high (disabled).
            OUT (Pia-b-o),A         ; Deselect drive.
            OUT (Pia-a-o),A         ; Motor off.
            RET



 
; *********************************************************
; ***                                                   ***
; ***               Setup                               ***
; ***                                                   ***
; *********************************************************

; * Initializes PIA and ACIA,
; * and then allocates RAM for the cat and sets to drive 0.

; * Calls: Wait.
; * Called by: None.

            LD BC, (Catsize)        ; HL = top of detected RAM.
            OR A                    ; Clear carry.
            SBC HL, DE
            LD (RAMTOP),HL
            LD SP, HL
            LD (HL),$FD             ; Drive 0.
            LD C,100                ; Wait 0.1s for PIA reset
            CALL Wait               ; to be high.
            LD B,A

            ; First initialise PIA.

            XOR A                   ; A := 0
            OUT (Pia-a-cr),A        ; Set both control registers
            OUT (Pia-b-cr),A        ; to allow access to direction
                                    ; control registers.
            DEC A                   ; A := $FF
            OUT (Pia-b-o),A         ; All lines output for port B.
            LD A,%11111000          ; Three lines input for
            OUT (Pia-a-o),A         ; port A.
            LD A,4                  ; Set both control registers
            OUT (Pia-a-cr),A        ; to allow access to
            OUT (Pia-b-cr),A        ; data registers.
            LD A,$FF                ; Set all outputs high (inactive).
            OUT (Pia-a-o),A
            OUT (Pia-b-o),A

            ; Initialise ACIA.

            ID A,3                  ; Reset ACIA.
            OUT (Acia-control),A
            LD A,%11100             ; Set ACIA to 9-bit parity.
            OUT (Acia-control),A

            LD A,B
            JP $32                  ; Resume startup.






  
; *********************************************************
; ***                                                   ***
; ***               Step-out                            ***
; ***                                                   ***
; *********************************************************

; * Steps head one track further out.

; * No arguments or results.
; * DE and HL preserved.

; * Calls: Wait.
; * Called by: Save-cat, Load-cat, Save-file and Load-file.

                LD A,%10101111	    ; Direction and motor on low.

                ; Implicit CALL Step and RET.





  
; *********************************************************
; ***                                                   ***
; ***               Step                                ***
; ***                                                   ***
; *********************************************************

; * Steps head in or out depending on argument.

; * Step in if A = %10111111.
; * Step out if A = % 10101111.
; * DE and HL preserved.

; * Calls: Wait.
; * A Called by: Step-out and Track00.

            OUT (Pia-a-o),A         ; Specify direction.
            LD C,5                  ; Can do one step every 5ms.
            CALL Wait
            SUB %100000             ; Pull step low.
            OUT (Pia-a-o),A
            ADD %100000             ; And then high again.
            OUT (Pia-a-o),A
            RET


 
; *********************************************************
; ***                                                   ***
; ***               DRIVE                               ***
; ***                                                   ***
; *********************************************************

; * Forth word to select drive and side.
; * Least significant bit of number on parameter stack
; * gives side, next two bits give drive number.


                RST 24              ; Pop DE from parameter stack.

                ; Convert number to correct form for PIA register.
                ; A := not((E and 1) | (1 << (E >> 1))).

                LD A,%11111110
                LD B,E
                INC B
drlab1          RLCA
                DEC B
                JR Z,drlab2
                DJNZ drlabl
                DEC A

                ; Store it in the first byte above RAMTOP.

drlab2          LD HL, (RAMTOP)
                LD (HL),A
                JP (1Y)             ; Forth return.





 
; *********************************************************
; ***                                                   ***
; ***               Print                               ***
; ***                                                   ***
; *********************************************************

; * Prints a text message specified by a number in A.
; * A The text store used has message arranged consecutively
; * in order of increasing number.
; * 00 is used to separate message.
; * Characters with codes > 127 are interpreted as messages
; * to be inserted recursively.
; * This method of store is used to save memory as many
; * messages are similar.

; * On entry A= message number.

; * Calls: none.
; * Called by:

                LD DE,message-space ; Start of message store.
                LD B,A              ; Count 00's the number in A.
Prsrch          LD A,(DE)
                INC DE
                OR A                ; Test zero.
                JR NZ,Prsrch
                DJNZ Prsrch

Prloop          LD A,(DE)           ; First character of message.
                INC DE              ; point to next character.
                OR A                ; Test for zero which
                RET Z               ; marks the end.
                LD B,A              ; See if the top bit is set.
                AND $7F             ; Making a copy with the
                CP B                ; top bit clear at the same time.
                OR Z,Prwrch         ; If bit not set print as character.
                PUSH DE             ; Else call Print recursively.
                CALL Print
                POP DE
                JR Prloop

Prwrch          RST 8              ; Wrch.
                JR Prloop


 
; *********************************************************
; ***                                                   ***
; ***               Track00                             ***
; ***                                                   ***
; *********************************************************

; A Moves head to track zero.

; * No args or results.
; * DE and HL preserved.

: * Calls: Step.
; * A Called by: Save-cat and Load-cat.

Trk001p         IN A,(Pia-a-i)          ; Input lines
                AND 2                   ; track00 bit.
                RET Z                   ; Quit if already at track00.
                LD A,%10111111          ; For step in.
                CALL Step
                JR Trk001p              ; Test again.



; *********************************************************
; ***                                                   ***
; ***               Save-cat                            ***
; ***                                                   ***
; *********************************************************

: * Saves the cat to disk.
; * No args or results.

: * Calls Track00,Dictsize,Save-block,Step-out.
; * Called by: STORE,RESTORE,BSTORE,XFORMAT and DELETE.

            CALL Track00
            CALL Dictsize
            CALL Save-block             ; Save first copy on track 0.
            CALL Step-out
            CALL Dictsize
            JP	Save-block              ; Save second copy on track 1.






; *********************************************************
; ***                                                   ***
; ***               Load-cat                            ***
; ***                                                   ***
; *********************************************************

; * Loads the cat from disk after switching on the drive.

; * No args or results.

; * Calls: On,TrackOO,Dictsize, Load-block, Step-out,Print,
           Print-error and Error-?
; * Called by: STQRE/RESTORE,BSTORE,LD,BLD,CAT and DELETE.

              CALL On
              CALL Track00
              CALL Dictsize           ; Load first copy.
              CALL Load-block
              PUSH AF
              CALL Step-out           ; Move to track 1.
              POP AF
              OR A
              RET Z                   ; Return if no error.
              CALL Print-error
              LD A,$18                ; "Second cat read".
              CALL Print
              CALL Dictsize
              CALL Load-block         ; Load second copy.
              JP Error-?


 
; *********************************************************
; ***                                                   ***
; ***               Print-error                         ***
; ***                                                   ***
; *********************************************************

; * If A holds an error number, it prints the error.
; * Otherwise, it has no effect.

; * On entry A = error number.

                OR A                ; Test for A = 0
                RET Z               ; Return if so.
                LD B,A              ; Error number in B.
                LD A,$0D            ; Print carriage return.
                RST 8               ; Wrch.

                LD A,B
                AND $70             ; Test for ACIA error.
                JR Z,Erknown        ; Skip if it isn't.
                LD B,$12
                LD C,A
                AND $40
                JR NZ,Erknown       ; Parity error.
                DEC B
                LD C,A
                AND $20
                JR NZ,Erknown       ; Overrun error.
                                    ; (Should be impossible).
                DEC B               ; Else, Framing error.
Erknown         LD A,B
                ADD 5               ; Errors start a message 5.
                CALL Print
                LD A,$0D            ; Print carriage return.
                RST 8               ; Wrch.
                RET



 
; *********************************************************
; ***                                                   ***
; ***                 XFORMAT                           ***
; ***                                                   ***
; *********************************************************

; * Forth word to write a blank catalogue to disk.
; * This specifies the block length and number of tracks.

; * Top of the parameter stack is the number of track.
; * Next on the parameter stack is the number of bytes
; * per track.

                CALL On
                RST 24              ; Pop DE from parameter stack.
                LD A,E              ; Only least significant byte.
                RST 24              ; Pop DE from parameter stack.

                LD HL,(RAMTOP)
                INC HL              ; First byte of cat.
                LD (HL),A           ; Number of tracks.
                INC HL
                LD (HL),E           ; Number of bytes per track.
                INC HL
                LD (HL),D
                INC HL

                LD (HL),0           ; Rest of the cat is filled
                LD D,H              ; with zeros.
                LD E,L
                INC DE
                LD BC, (Cat-size)
                DEC BC
                DEC BC
                DEC BC
                DEC BC
                LDIR

                CALL Save-cat
                CALL Off
                JP (IY)             ; Forth return.


  
; *********************************************************
; ***                                                   ***
; ***                 Save-file                         ***
; ***                                                   ***
; *********************************************************

; * Saves an area of memory to disk.
; * Doesn't read or alter the disk catalogue.

; * On entry:   HL = starting address of the memory to be saved.
; *             DE = the number of bytes to be saved.
; *              B = the file number of the file to be created.

: * Calls: Block-length,Step-out and Save-block.
; * Called by: STORE, BSTORE and RESTORE.


                LD C,2              ; Offset from (RAMTOP)+l of byte
                                    ; below start of track file table.
Sfnextb         PUSH HL             ; Save start address,
                PUSH DE             ; length.

Sfnextt         LD HL,(RAMTOP)
                INC HL              ; Load number of tracks.
                LD A, (HL)

                CP C                ; If the previous tack number
                LD A,$A             ; was equal to the limit, raise
                CALL Z,Error-?      ; a "Disk is full" error.

                PUSH BC             ; Move head to next track.
                CALL Step-out
                POP BC              ; Only BC was corrupted
                                    ; in Step-out.

                INC C               ; Pointer to table slot for
                                    ; this track.

                LD D,0              ; Calculate address in the cat
                LD E,C              ; of this tracks file entry.
                ADD HL,DE
                LD A,(HL)           ; The file for this track.
                OR A                ; Is it empty (=0) ?
                JR NZ,Sfnextt       ; If it isn't, try next track.

                LD (HL),B           ; If it is, claim it for this file.

                POP HL              ; HL := file length.
                POP DE              ; DE := start address.
                PUSH BC             ; Save BC.
                PUSH DE             ; Save start address.
                CALL block-length   ; DE := block length.

                OR A                ; CY := 0
                SBC HL,DE
                JR Z,Sfend          ; If file is exactly one block.
                JR C,Sfend          ; If file less than one block.

                 EX (SP),HL

                ; At this point, HL - start address,
                ; DE = block length, and remaining file length
                ; and track and file numbers saved.

                CALL Save-block     ; Leaves HL pointing to start
                                    ; of next block.

                POP DE              ; Save remaining file.
                POP BC
                JR Sfnextb

Sfend           ADD HL,DE           ; File was shorter than a block
                                    ; so make length positive again.
                EX DE,HL            ; DE := length still to be saved.
                POP HL              ; HL := start address.

                CALL Save-block
                POP BC
                RET



  
; *********************************************************
; ***                                                   ***
; ***               Load-file                           ***
; ***                                                   ***
; *********************************************************

; * Loads a file into an area of memory.
; * Doesn't read or alter the disk catalogue.
; 
; * On entry: HL = the starting address of the memory.
; *           DE = the number of bytes to be loaded
; *            B = the file number of the file to be loaded.

; * Calls: Block-length, Step-out and load-block.
; * Called by: LD,RUN and BLD.

              LD C,3                ; Offset from (RAMTOP) of the byte
                                    ; below start of track file table.
Lfnextb       PUSH HL               ; Save start address,
              PUSH DE               ; length.

Lfnextt       PUSH BC               ; Move head to next track.
              CALL Step-out
              POP BC                ; Only BC was corrupted in Step-out

              INC C                 ; Pointer to slot for this track.

              LD HL,(RAMTOP)
              LD D,O                ; Calculate the address in the cat
              LD E,C                ; of this tracks file entry.
              ADD HL,DE
              LD A,(HL)             ; The file for this track.
              CP B                  ; Is it the file we want ?
              JR NZ,Lfnextt         ; Try next track it if isn't.
              
              POP HL                ; HL := file length.
              POP DE                ; DE := start address.
              PUSH BC               ; Save BC.
              PUSH DE               ; Save start address.
              CALL block-length     ; DE := block length.

              OR A                  ; CY := 0
              SBC HL,DE
              JR Z,Lfend            ; If file is exactly one block.
              JR C,Lfend            ; If file less than one block.

              EX (SP),HL
            
             ; At this point, HL = start address,
             ; DE = block length, and remaining file length and
             ; track and file numbers saved.
              
              CALL Load-block       ; Leaves HL pointing to start
                                    ; of the next block.
            CALL Error-?

            POP DB                  ; Load remaining file.
            POP BC
            JR Sfnextb

Lfend      ADD HL,DE               ; File was shorter than a block
                                    ; so make it positive again.
            EX DE,HL                ; DE := length still to be loaded.
            POP HL                  ; HL := start address.

            CALL Load-block
            CALL Error-?

            POP BC
            RET

 
; *********************************************************
; ***                                                   ***
; ***               Find-word                           ***
; ***                                                   ***
; *********************************************************

; * Finds the address of a word in the cat if it exists and
; * the address of the first free point in the cat if it doesn't.

; * On exit:    if A=0, word not found, HL = end of used cat.
; *             else, word found, DE = address of first data field.
; *                               HL = address of length field,
                                   A = file number.
; * Calls: WORD.
; * Called by: Enter-word, Lookup-word and DELETE.

                LD C,0              ; File number in C.

                LD HL,(RAMTOP)      ; Find start of names in cat.
                INC HL
                LD E, (HL)
                LD D,0
                INC HL
                ADD HL,DE

                LD DE,Pad           ; Address of name to be used.

Fwloop          EX HL,DE            ; DE := pos in cat, HL = pos in PAD.
                INC C               ; Next file number.

                LD A, (DE)          ; Length field.
                OR A                ; Zero marks the end of cat.
                RET Z               ; So return if zero.

                PUSH DE
                PUSH HL

                LD B,A              ; Length field in B.
                INC B

FwComp          CP (HL)             ; Compare lengths first, then chars.
                JR NZ,Fwnotf        ; Break if any difference.
                INC HL              ; Next character in PAD.
                INC DE              ; Next character in cat.
                LD A,(DE)           ; Next character.
                DJNZ Fwcomp         ; End of string ?

                ; File name has been found

                POP HL	            ; Throw away pad pointer.
                POP HL              ; Recover address of length field.

                LD A,C              ; File number in A.
                RET

Fwnotf          LD A,B              ; Find start of next word.
                ADD 4
                LD L,A
                LD H,0
                ADD HL,DE
                POP DE              ; Recover start of pad pointer.
                INC SP              ; Through away address of previous
                INC SP              ; length field.
                JR Fwloop           ; Try next word.




  
; *********************************************************
; ***                                                   ***
; ***               Enter-word                          ***
; ***                                                   ***
; *********************************************************

; * Enters a new file name into the catalogue.

; * On entry, the file name is in the input buffer.
; * HL = start address of file (0 for a DICT file).
; * DE = length of file in bytes.
; * On exit, DE and HL have their entry values and
: * B = the file number of the file.

* Calls: Find-word and Error-?
* Called by: STORE and BSTORE.

                PUSH DE             ; Save DE and HL.
                PUSH HL
                PUSH DE             ; Two copies of DE.

                CALL Find-word      ; Sets C to file number.
                OR A                ; Test for found.
                LD A,7              ; "File name already exist".
                CALL NZ,Error-?     ; Call if found.

                LD B,(HL)           ; HL was set to point at
                                    ; the name in the PAD by Find-word.
                LD A,B
                LD (DE),A           ; Store name length in cat.
                                    ; Find word made DE point to
                                    ; the first free point in the cat.

                PUSH HL
                PUSH DE

                LD HL, (RAMTOP)     ; Start of cat.
                OR A                ; Clear carry.
                SBC HL,DE           ; HL := -bytes used.

                LD DE, ($F8FE)      ; Cat size.
                ADD HL,DE           ; HL := bytes free.

                ADD 8               ; bytes needed +3.
                LD E,A
                LD D,0
                OR A                ; Clear carry.
                SBC HL,DE           ; Set carry if not enough room.

                POP DE
                POP HL
                LD A,9              ; "Cat full".

                CALL C,Error-?

Ewcopy          INC DE              ; Next position in the cat.
                INC HL              ; Next character in the name.
                LD A,(HL)           ; Copy character.
                LD (DE),A
                DJNZ Ewcopy         ; Repeat for length of name.

                EX HL,DE            ; HL := pointer to cat.
                POP DE              ; file length.

                INC HL              ; Store length.
                LD (HL),E
                INC HL
                LD (HL),D

                POP DE              ; File start address.
                INC HL
                LD (HL),E
                INC HL
                LD (HL),D

                INC HL              ; Zero marks end of names.
                LD (HL),0

                POP HL
                EX HL,DE            ; HL := start, DE := length.
                LD B,C              ; B := file number.
                RET

 
; *********************************************************
; ***                                                   ***
; ***               Lookup- word                        ***
; ***                                                   ***
; *********************************************************


; * Finds the file number, length and start address of the ;
; * file with name in the input buffer.

; * On exit: B = file number,
; *          DE = length,
; *          HL = start address (0 of DICT files).

; * Calls: Find-word and Error-?.
; * Called by: LD, BLD and RUN.

                CALL Find-word
                LD B,A              ; B := file number.
                OR A                ; Test for file not found.
                LD A,8              ; "File name not found".
                CALL Z,Error-?      ; Raise error if not found.

                EX HL,DE            ; HL points to first data field.

                LD E,(HL)           ; Load DE with length.
                INC HL
                LD D, (HL)
                INC HL

                LD A, (HL)          ; Load HL with start address.
                INC HL
                LD H, (HL)
                LD L,A

                RET



 
; *********************************************************
; ***                                                   ***
; ***               Hex-byte                            ***
; ***                                                   ***
; *********************************************************

; * Prints the contents of A as a two digit hexadecimal number.

; * On entry: A = number to be printed.
; * Only register A is used.

; * Calls: Hex-char.
; * Called by: CAT.

                PUSH AF
                RR A                ; Get most significant nibble.
                RR A
                RR A
                RR A
                CALL Hex-char       ; Print it.
                POP AF              ; Implicit CALL of Hex-char
                                    ; and then return.



  
; *********************************************************
; ***                                                   ***
; ***               Hex-char                            ***
; ***                                                   ***
; *********************************************************


; * Prints the least significant nibble of the byte in A
; * as a single hexadecimal digit.

; * On entry: A = nibble to be printed.
; * Only register A is used.

; * Calls: None.
; * Called by: Hex-digit and CAT.

                AND $F              ; Mask off high nibble.
                CP $A               ; if >= 10,
                JR C,Numdigt        ; add "A"-"9"+1.
                ADD 7
Numdigt         ADD $30             ; ASCII for "0".
                RST 8               ; Wrch.
                RET



  
; *********************************************************
; ***                                                   ***
; ***                     CAT                           ***
; ***                                                   ***
; *********************************************************

; * Gives a list of all the file names on the disk together
; * with their lengths and starting addresses.
; * (Dictionary files have "DICT" in place of the starting
; * address).
; * It then gives the number of bytes free for use on the disk
; * and a map of track usage.
; * It is a FORTH word.

; * Calls: Load-cat, Off, Hex-byte, Hex-char and Block-length.

                CALL Load-cat       ; Turns the motor on first.
                CALL Off

                LD A,$D             ; CR.
                RST 8               ; Wrch.

                LD HL, (RAMTOP)     ; Point to start of names.
                INC HL
                LD E,(HL)           ; number of tracks.
                LD D,0
                INC HL
                ADD HL,DE

Namelp          LD C,$15            ; Number of character for name.
                LD A, (HL)
                OR A                ; Zero marks end of names.
                JR Z,findfre

                LD B,A              ; Name length in B.
Namepr          INC HL
                DEC C
                LD A, (HL)
                RST 8               ; Wrch.
                DJNZ Namepr         ; Print rest of name.

                ; Pad with spaces to get to the same column.

                LD A,C
                AND $1F             ; File name might have been
                                    ; longer than a line.
                                    ; (Assumes 32 chars per line).
                LD B,A
Catpdlp         LD A,$20            ; ASCII for space.
                RST 8               ; Wrch.
                DJNZ Catpdlp

                ; Print length in hex.

                INC HL
                LD C, (HL)
                INC HL
                LD A, (HL)
                CALL Hex-byte

                LD A,C
                CALL Hex-byte

                ; Print space.

                LD A,$20            ; ASCII for space.
                RST 8               ; Wrch.

                ; Print start address in hex of "DICT".

                INC HL
                LD C, (HL)
                INC HL
                LD A, (HL)
                INC HL              ; Point to start of next word.

                LD B,A              ; Test start = 0.
                OR C
                JR NZ,Catbyts
                LD A,$19            ; "DICT".
                CALL Print
                JR Catjn

Catbyts         LD A,B              ; Print as hex
                CALL Hex-byte
                LD A,C
                CALL Hex-byte

                LD A,$D             ; CR.
                RST 8               ; Wrch.
                JR Namelp           ; Next file name.

Findfre         LD A,$D             ; CR.
                RST 8               ; Wrch.

                LD HL, (RAMTOP)     ; Find start of file for track
                INC HL              ; vector.
                LD B,(HL)           ; Number of tracks.
                DEC B               ; Two tracks used for cats.
                DEC B
                CALL Block-length   ; DE := number of bytes on a track.
                INC HL
                INC HL              ; First element of vector.

                PUSH HL             ; Temp start of vector.
                LD HL,0             ; Bytes free accumulated in HL
                LD C,0              ; and C.

Freelp          EX HL, (SP)         ; HL = vector pointer.
                INC HL              ; Next track.
                LD A, (HL)          ; File number of track.
                EX HL, (SP)         ; HL = Count.

                OR A                ; Test A=0 ie free.
                JR NZ,Notfree       ; If its used, don't count it.
                ADD HL,DE           ; If it is free, add a track full
                                    ; of bytes.
                JR NC,Notfree       ; Use C for high byte if 16 bits
                INC C               ; overflow.
Notfree         DJNZ Freelp         ; Try all tracks.

                POP DE             ; discard vector pointer.

                LD A,C              ; Most significant byte of count.
                CALL Hex-byte
                LD A,H              ; Middle byte of count.
                CALL Hex-byte
                LD A,L              ; Least significant byte of count.
                CALL Hex-byte

                LD A,$1A            ; " bytes free".
                CALL Print

                JP (IY)             ; Forth return.

 
; *********************************************************
; ***                                                   ***
; ***               Dict-size                           ***
; ***                                                   ***
; *********************************************************

; * Sets DE and HL to the start and length of the catalogue.

; * DE = length of cat on exit.
; * HL = starting address of cat on exit.

; Calls: none.
; Called by: Load-cat and Save-cat.

                LD HL,(RAMTOP)
                INC HL              ; Miss the byte used for DRIVE.
                LD DE,($F8FE)       ; Cat size.
                DEC DE              ; Don't save drive number.
                RET

 
; *********************************************************
; ***                                                   ***
; ***               Block-length                        ***
; ***                                                   ***
; *********************************************************

; * Loads the block length of the current disk into DE without
; * changing any other registers.

; * DE = Block length on exit.

; * Calls: None.
; * Called by: Load-file, Save-file.

                PUSH HL             ; HL must be the same at the end.
                LD HL, (RAMTOP)
                INC HL
                INC HL              ; The block length is in the second
                LD E,(HL)           ; and third bytes of the cat.
                INC HL
                LD D,(HL)
                POP HL              ; Recover HL.
                RET


 
; *********************************************************
; ***                                                   ***
; ***               Delete-file                         ***
; ***                                                   ***
; *********************************************************

; * Deletes the file with its name in the pad from the
; * catalogue copy in RAM.

; * No args or results.

; * Calls: Find-word.
; * Called by: DELETE and RESTORE.

                CALL Find-word          ; DE := data field of word,
                                        ; HL := name length field,
                                        ; C := file number.

                LD C,A

                OR A                    ; Test for word not found.
                LD A,8                  ; "File name does not exit".
                CALL Z,Error-?

                PUSH DE
                PUSH HL

                ; First free all blocks used by this file and
                ; decrease the file number entries if they are
                ; greater than this file.

                LD HL,(RAMTOP)          ; Find the start of the
                INC HL                  ; block usage vector.
                LD B,(HL)               ; number of tracks.
                DEC B                   ; Two tracks used for cats.
                DEC B
                INC HL
                INC HL                  ; Skip block size bytes.

Delfl           INC HL                  ; Next track.
                LD A,(HL)               ; File for this track.
                CP C                    ; Is if used for this file.
                JR Z, Delfd             ; If it is, set it free.
                JR C, Delfst            ; If its < this file, leave it.
                DEC A                   ; If its greater than this file,
                                        ; the file number will have decreased
                                        ; by one.
                JR Delfst
Delfd           XOR A                   ; A := 0 for empty track.
Delfst          LD (HL),A               ; Store back to cat.
                DJNZ Delfl              ; Repeat for all tracks.

                ; Second, remove the name it self by shuffling
                ; all the names above it down.

                POP DE                  ; name length field.
                POP HL                  ; data field.
                INC HL                  ; HL := name length field
                INC HL                  ;       of next word.
                INC HL
                INC HL

Delfl2          LD A, (HL)              ; Name length.
                LD (DE),A               ; Store it even it its zero.
                OR A                    ; If it is zero, stop.
                RET Z
                ADD 4                   ; Four data bytes to copy as well.
                LD B,A

Delfl3          INC HL                  ; Copy one name and data.
                INC DE
                LD A, (HL)
                LD (DE),A
                DJNZ Delfl3
                INC HL                  ; Then repeat for the rest
                INC DE                  ; of the names.
                JR Delfl2


; *********************************************************
; ***                                                   ***
; ***               DELETE                              ***
; ***                                                   ***
; *********************************************************

; * Forth word to delete a file.

; * No arguments or results.

; * Calls; Load-cat,Delete-file, Save-cat and Off.

                CALL Word
                CALL Load-cat
                CALL Delete-file
                CALL Save-cat
                CALL Off
                JP (IY)             ; Forth return.


; *********************************************************
; ***                                                   ***
; ***               Error-?                             ***
; ***                                                   ***
; *********************************************************

; * Prints and error message and then ABORTS (if A>0).

; * A = error number on entry.
; * If A = 0, the routine returns immediately.

; * Calls: Print-error and Off.
; * Called by: Almost everything.

                OR A                ; Test A=0
                RET Z               ; Return if it is.

                CALL Print-error
                CALL Off            ; Switch drive off.
                                    ; (Doesn't matter if it wasn't on).

                EI                  ; Could have been called with
                                    ; interrupts off.
                RST 32              ; ABORT.
                $FF                 ; No error number.


  
; *********************************************************
; ***                                                   ***
; ***               Store                               ***
; ***                                                   ***
; *********************************************************

; * Store a dictionary file.

; * No arguments or results.

; * Calls; Save-file,Save-cat and Off.

                CALL Fill-length
                LD HL,(STKBOT)          ; End of dict.
                LD DE, (Forth)          ; Newest word in FORTH.
                LD (HL),E               ; Save it at the end of the dict.
                INC HL
                LD (HL),D
                INC HL

                LD DE,DCTRAM            ; Start of dict (after FORTH).
                OR A                    ; Clear carry.
                SBC HL,DE
                EX HL,DE                ; HL = start, DE = length.
                LD A,E                  ; Is there anything to save.
                SUB 2                   ; Two bytes added even if nothing.
                OR D
                LD A,$D                 ; "Why save 0 bytes".
                CALL Z,Error-?

                PUSH HL
                LD HL,0                 ; 0 represents a DICT file.
                CALL Enter-word
                POP HL
                CALL Save-file
                CALL Save-cat
                CALL Off
                RET



; *********************************************************
; ***                                                   ***
; ***               DSAVE                               ***
; ***                                                   ***
; *********************************************************

; * Forth word to store a dictionary file.
; * Disk equivalent of SAVE.

; * No arguments or results.

; * Calls; Load-cat and Store.

                CALL Word
                CALL Load-cat
                CALL Save
                JP (IY)


 
; *********************************************************
; ***                                                   ***
; ***               DBSAVE                              ***
; ***                                                   ***
; *********************************************************

; * Forth word to store a bytes file.
; * Disk equivalent of BSAVE.

; * No arguments or results.

; * Calls; Load-cat,Save-file,Save-cat and Off.

                CALL Word
                CALL Load-cat

                RST 24                  ; Pop DE from parameter stack.
                PUSH DE
                RST 24                  ; Pop DE from parameter stack.
                POP HL
                EX DE,HL                ; DE = length, HL = start.

                LD A,D                  ; Test len = 0.
                OR E
                LD A,$D                 ; "Why BSTORE 0 bytes".
                CALL Z,Error-?

                CALL Enter-word
                CALL Save-file
                CALL Save-cat
                CALL Off
                JP (IY)                 ; Forth return.



; *********************************************************
; ***                                                   ***
; ***               DLOAD                               ***
; ***                                                   ***
; *********************************************************

; * Forth word to load a bytes file.
; * Disk equivalent of BLOAD.

; * No arguments or results.

; * Calls; Load-cat,Load-file, Error-? and Off.

                CALL Word
                CALL Load-cat
                RST 24                  ; Pop DE from parameter stack.
                                        ; First argument ignored.
                RST 24                  ; Pop DE from parameter stack.
                PUSH DE                 ; Save start address.
                CALL Lookup-word

                LD A,H                  ; Check not DICT.
                OR L
                LD A,$B                 ; "BLD a DICT".
                CALL Z,Error-?

                EX HL, (SP)             ; HL = parameter start.
                LD A,H                  ; If zero ...
                OR L
                JR Z,Bldlb              ; Use start from cat.
                EX HL,(SP)
Bldlb           POP HL

                CALL Load-file
                CAll Off
                JP (IY)                 ; Forth return.





; *********************************************************
; ***                                                   ***
; ***               RESAVE                              ***
; ***                                                   ***
; *********************************************************

; * Forth word to save a dictionary file under a name which
; * already exists.

; * No arguments or results.

; * Calls; Load-cat,Delete,Save.

                CALL Word
                CALL Load-cat
                CALL Delete-file
                CALL Save-cat
                CALL Store
                JP (IY)


 
; *********************************************************
; ***                                                   ***
; ***               Word                                ***
; ***                                                   ***
; *********************************************************

; * Transfers a word from the input buffer to the pad.

; * No arguments or results.
; * All registers corrupted.

; * Calls: The forth word WORD.

                LD DE,$20               ; Put a space on top,
                RST 16                  ; of the parameter stack.
                                        ; WORD uses this character
                                        ; as its termination mark.
                CALL Enter-forth
                WORD
                End-forth

                RST 24                  ; Discard the top e.,f the stack
                                        ; which is the address of the pad.
                RET




  
; *********************************************************
; ***                                                   ***
; ***               MAP                                 ***
; ***                                                   ***
; *********************************************************

; * Prints the file number for each track as a  single
; * hexadecimal digit. "-" for not used.
; * It is a Forth word.

; * Calls: Hex-char, Load-cat and Off.

                CALL Load-cat
                CALL Off
                LD HL,(RAMTOP)
                INC HL
                LD B, (HL)                  ; Number of tracks,
                DEC B                       ; Two tracks uses cat.
                DEC B
                INC HL                      ; Skip block size.
                INC HL

Catmap          INC HL
                LD A, (HL)
                OR A                        ; Use space not 0 for an
                JR Z,Mapl                   ; empty track. (0 for 0 mod 16) .
                CALL Hex-char
                JR Map2
Mapl            LD A,$2D                    : "-".
                RST 8                       ; Wrch
Map2            DJNZ Catmap                 ; Print all tracks
                JP (IY)                     ; Forth return.



; *********************************************************
; ***                                                   ***
; ***               DLOAD                               ***
; ***                                                   ***
; *********************************************************

; * Loads a dict or bytes (At stored address) file from
; * disk to RAM.
; * It is a Forth word.

; * No args or results.

; * Calls: Word, Load-cat, Lookup-word, Load-file, Off
; *        and the Forth ROM for LOAD.

                CALL Fill-length
                CALL Word
                CALL Load-cat
                CALL Lookup-word            ; HL := start address,
                                            ; DE := length and
                                            ; B := file number.
                LD A,H                      ; Test start address = 0
                OR L                        ; Which indicates a dict.
                JR Z,Dloadl1                ; Jump if dict.

                CALL Load-file              ; Load bytes file at address
                CALL Off                    ; Read from cat.
                JP (IY)

Dloadl1         LD ($2325),SP               ; Transfer SP to HL.
                LD HL,($2325)

                PUSH DE                     ; Save length to be loaded.
                LD DE,$40                   ; There must be some room
                OR A                        ; after loading.
                SBC HL,DE
                POP DE

                PUSH HL                     ; Save top of usable RAM.
                LD HL,(STKBOT)              ; Start point of loading.
                ADD HL,DE                   ; End point of loading.
                EX HL,DE
                EX HL, (SP)

                ; At this point, HL = highest point which can be used,
                                 DE = highest point which will be used,
                ; and the length of load is on the stack.

                OR A                        ; Clear carry.
                SBC HL,DE                   ; Compare.

                POP DE
                LD A,$F                     ; "Not enough RAM".
                CALL C,Error-?              ; Error if DE was > HL.

                LD HL,(STKBOT)              ; First free byte after dict.
                PUSH DE
                PUSH HL
                CALL Load-file
                CALL Off

                POP HL
                POP DE
                DEC DE                      ; Two bytes were added
                DEC DE                      ; for vocab pointer,
                LD ($2325),DE               ; Will be read as length
                                            ; added to diet.
                ADD HL,DE
                LD E, (HL)                  ; Read vocab pointer.
                INC HL
                LD D, (HL)
                LD ($2329),DE               ; Will be read as newest
                                            ; word.
                JP $19AA                    ; Enter LOAD adjust section.





; *********************************************************
; ***                                                   ***
; ***               SCRATCH                             ***
; ***                                                   ***
; *********************************************************

; * Forth word to remove all words from dictionary,
; * Similar to FORGET <Oldest word>.

; * Calls: None.

                LD HL,$3C4C                 ; Forth.
                LD ($3C31),HL               ; CURRENT.
                LD ($3C33),HL               ; CONTEXT.
                LD L,$4F
                LD ($3C35),HL               ; VOCLINK.
                LD L,$51
                LD ($3C37),HL               ; STKBOT.
                LD L,$45
                LD ($3C39),HL               ; DICT.
                LD L,$5D
                LD ($3C3B),HL               ; SPARE.
                LD L,$49
                LD ($3C49),HL               ; Forth link.
                JP (IY)

 
; *********************************************************
; ***                                                   ***
; ***               Fill-length                         ***
; ***                                                   ***
; *********************************************************

; * Fills in the length field of the newest word in the
; * dictionary if it is not already filled and
; * then sets DICT to 0 to show that it is now filled.

; * Calls: None.

; * Called by: Store and DLOAD.

                LD HL,(STKBOT)              ; HERE.
                LD DE,(DICT)                ; Address of length field or zero.
                LD A,D                      ; Test for zero for already
                OR E                        ; Filled.
                RET Z
                SBC HL,DE                   ; Carry cleared by previous
                OR E.
                EX HL,DE                    ; HL is the address of the length
                                            ; field, DE is the length.
                LD (HL),E                   ; Store length.
                INC HL
                LD (HL),D

                LD HL,0                     ; (DICT) := 0
                LD (DICT),HL
                RET