         Title SDOS Simulator for MicroMedic MACC Rev 2.0

*        SDOS Simulator For MicroMedic MACC 2.0

* Simulates SDOS so that Software Dynamics Basic Compiler Runtime Package
* can execute compiled BASIC programs in the MACC environment.
* The Simulator must run in the same environment as the Microsoft BASIC
* version of MACC (MACC 1.0 ROM).

* File structure of diskette is very simple:
*    128 bytes per sector
*    18 sectors per track
*    40 tracks
*
* The diskette format is different than the original MACC, so the ROM-based
* MACC disk I/O routines cannot be used by the Simulator.  This problem
* is solved by providing the Simulator with its own copy of the disk I/O
* routines.

* The diskette is broken into 16 sequential files, wrapped contiguosly
* around the diskette, starting with track zero and spiralling inward.
* Most of the files contain object code; all object code is in memory image
* format.  The files are broken in 3 categories:
* 1) The SDOS Simulator, starting at LSN 0, and loaded
*    by the boot strap ROM into location $2000.  Because the MACC Boot
*    ROM only knows about 16-sector-per-track disks, only the 1st 2kb of
*    this file will be loaded correctly.  We overcome this problem
*    by requiring that the loaded 2K contains enough smarts to load the
*    rest of the Simulator correctly using a set of disk drivers
*    that understand the 18-sectors-per-track disk that MACC 2.0 uses.
*    The SDOS Simulator contains the SDOS Simulator
*    code, the I/O interface code, and the SD Runtime Package.
*    This file is up to 32k in size.
* 3) Up to 14 application program containing BASIC Compiled code, none of
*    which exceed 32kb. These programs are loaded by the SDOS Simulator
*    in response to CHAIN "MACCx" statements issued by BASIC programs.
*    The first application program ("MACCA") is automatically loaded by
*    the SDOS Simulator on power up.  These programs are all loaded at $6000.
* 4) The last file, which covers the rest of the disk, and is used as
*    a data file by application programs.  The application programs
*    manage the content of this file without any help from the Simulator.

* A 17 word "File Table", located at $2040 in the boot program file,
* specifies the starting LSN of each file.  The file length in sectors is
* found by subtracting the starting LSN of the file (according to the table)
* from the starting LSN of the next file (as specified by the table).
* The 17th slot contains the number of sectors on the disk.
* This table is copied to location $120 before the simulator is loaded.
*
* The application program will use OPEN/CLOSE/CREATE statements with
* appropriate file/device names to adhere to an SDOS-like application
* structure.  The SDOS Simulator will provide I/O channels that are
* automatically opened in a pre-determined fashion so that SDOS
* OPEN/CREATE/CLOSE syscalls need only trivial (i.e., no-op) simulations.
         page
* ASCII output (SYSCALL:WRITEA), for any serial I/O device or the CRT,
* requires that an ASCII:LF be automatically sent after ASCII:CR, that
* ASCII:FF must clear the screen/skip to top of page, and that ASCII:BELL
* produce a bell tone.

* Channel #0 is automatically open for CONSOLE: I/O as is usual for
* SDOS.  The SDOS simulator implements SYSCALL:READA in linemode for line
* input on channel zero, and SYSCALL:WRITEA to output blocks of text on
* channel zero.  See ASCII OUTPUT for requirements of SYSCALL:WRITEA.
* CC:POSITION subcode of SYSCALL:CONTROL is implemented to allow
* conventional text cursor positioning. A SYSCALL:CONTROL with an CC:
* subcode of $FF is used to specify the setting of individual (big)
* pixels as implemented by the MACC hardware.  CC: subcode of $FE is used
* to reset individual pixels, :FD is used to draw a line segment, and :FC
* to erase an already-drawn line segment. Parameters for these control
* calls will be passed in the SYSCALL:WRBUF as is usual for SDOS System
* calls.  The simulator will object to an SC:GETLINEFLAGS status
* call, but it implements the Trace/Breakpoint/Step facilities required
* to allow checkout of BASIC programs in the execution environment.
* It is not possible to buffer the CRT output as it is
* implemented by memory-mapped I/O.

* Channel #1 refers to the Application data file.  The file is
* byte addressable (as is usual for SDOS disk files), and the operations
* SYSCALL:READA, SYSCALL:READB, SYSCALL:WRITEA, SYSCALL:WRITEB, and
* CC:POSITION subcode for SYSCALL:CONTROL are all implemented as per
* SDOS specification.  To enhance performance, the Simulator will keep
* two disk sector buffers holding the last pair of sectors read from the
* disk. Subsequent read requests will check to see if either sector
* buffer contains the proper sector, and skip the read if the desired
* data is already present.  If the data is not present, the current
* contents of the buffers are dumped back to disk if necessary, and
* two sequential sectors starting with the desired one are read into the
* buffer.  A "dirty flag" for each buffer remembers if the buffer
* contents have been updated; a dirty sector is NOT written to the disk
* unless A) the writing process runs off the end of the sector, B) a
* different sector is required which is not in either buffer, or C) 1
* second elapses with no disk I/O (timing occurs only while the
* application is waiting for data from the operator console:).
* CC:DISMOUNT will be honored to allow the operator to remove a diskette
* from drive 0; when he does, the 1st 16 slots of the file table are
* zeroed, so that an inserted diskette is treated as if it were entirely data.
* SYSCALL:CLOSE will cause the disk buffers for that drive to be flushed.
* A CC:FORMAT syscall will cause drive 0 to be formatted with 18 sectors
* per track.  A CC:BACKUP syscall will cause the SDOSSimulator to make
* a duplicate diskette using source and destination drives specified
* in the WRBUF.
         page
* Channel #2 refers to the entire contents of the 2nd diskette drive as
* a byte addessable file.  The Simulator implements the same functions
* as for channel 1.  Note that no file structure exists on the 2nd
* diskette.
* 
* Channel #3 refers to the entire contents of the 3rd diskette drive
* as a byte addressable file.  The Simulator implements the same functions
* as for channel 2. Note that no file structure exists on the 2nd
* diskette.
* 
* Channel #4 is the line printer device.  SYSCALL:WRITEA must
* be implemented.  SYSCALL:WRITEB must be implemented to allow
* nonstandard code sequences to be sent to the printer.
* 
* Channels #5,#6 and #7 are the 3 auxiliary serial ports used primarily
* for communication with Gamma counters.  SYSCALL:WRITEA and
* SYSCALL:WRITEB must be implemented.  SYSCALL:READA in line mode must be
* implemented to allow data responses to be returned from the Gamma
* counters; however, unlike channel # SYSCALL:READA, no echo or editing
* of the received data is required.  SYSCALL:READB is implemented to
* allow handshake characters to be read one-at-a-time.
         page
*************************************************************************
* The Simulator includes code to accomplish the following functions
*   1. initializes all i/o devices                                      *
*   2. clears scratch & video memories                                  *
*   3. on power up, boots system program into memory & transfers to it  *
*   4. executes the following functions via subroutine calls:           *
*      a. screen i/o                                                    *
*         - conventional character output
*         - read/write cursor position                                  *
*         - position cursor
*         - set cursor on/off                                           *
*         - draw/erase line segment(s)                                  *
*         - set/reset graphic pixel(s)                                  *
*         - test graphic pixel                                          *
*      b. port i/o                                                      *
*         - read/write byte                                             *
*         - read status                                                 *
*      c. disk i/o                                                      *
*         - select & start drive                                        *
*         - read/write logical record(s)                                *
*         - format diskette                                             *
*         - make backup diskette
*************************************************************************
         page   Simulator Definitions
         include sdos11defs.asm  ; where to get SDOS user definitions
; SYSCALL$ equ   $FB             ; entry point to SDOS (Simulator)
LineFlags equ  $F0               ; where RTP line flags are stored
TopOfRAM equ   $DFFF             ; Last byte of RAM store in MACC

;        Device Control Block (DCB:xxx) layout
         org   $0
DCB:OPEN rmb   3                 ; JMP to routine to do OPEN on device
DCB:CLOSE rmb  3                 ; JMP to routine to do CLOSE on device
DCB:CREATE rmb 3                 ; JMP to routine to do CREATE on device
DCB:READA rmb  3                 ; JMP to routine to do READA on device
DCB:READB rmb  3                 ; JMP to routine to do READB on device
DCB:WRITEA rmb 3                 ; JMP to routine to do WRITEA on device
DCB:WRITEB rmb 3                 ; JMP to routine to do WRITEB on device
DCB:CONTROL rmb 3                ; JMP to routine to do CONTROL op on device
DCB:STATUS rmb 3                 ; JMP to routine to get STATUS from device
DCB:FILEPOSITION rmb 4           ; byte position of next byte in file
DCB:COLUMN rmb 1                 ; holds logical column count for device
DCB:COMMON equ *                 ; size of common part of dcb

         org   dcb:common
; define DCB extension for ACIA class devices
DCB:PORTADDRESS rmb 2            ; holds address of ACIA used

         org   dcb:common
; define DCB extension for disk data files
DCB:DRIVENUMBER rmb 1            ; specifies drive containing file
DCB:FILEBASELSN rmb 2            ; points to LSN of bottom of file
DCB:CURRENTTRACK rmb 1           ; holds location of heads on drive

         org   0
; Sector Descriptor Block definition
; Keeps track of a sector which has been read into memory
SectorDB:Next rmb 2                    ; points to next SectorDB: block
SectorDB:Prev rmb 2                    ; points to previous SectorDB: block
SectorDB:LSN   rmb 2                   ; holds 16 bit LSN for floppy
SectorDB:Buffer rmb 2                  ; holds pointer to RAM buffer for LSN
SectorDB:Drive rmb 1                   ; holds drive number LSN came from
SectorDB:Dirty rmb 1                   ; 0 --> unmodified, <>0 --> changed
SectorDB:Size rmb 0                    ; size of Sector Descriptor Block

RTP$Base equ $3400                ; where SD BASIC Runtime Package starts
RTP$SubFunEntry equ RTP$Base+$103-$100 ; entry point to compiled Fns/Subrs
RTP$FLoad equ  RTP$Base+$109-$100 ; RTP entry point for Floating Load
RTP$FStore equ RTP$Base+$10C-$100 ; RTP entry point for Floating Store
RTP$Float equ RTP$Base+$130-$100  ; RTP entry point for Fix-to-Float conversion
RTP$End equ RTP$Base+12*1024      ; where application programs should load
        page
*        bit assignments
        spc     1
b0       equ $01
b1       equ $02
b2       equ $04
b3       equ $08
b4       equ $10
b5       equ $20
b6       equ $40
b7       equ $80
*
*        pia - disk i/o
*
*        ora = $00               cra = $10
*        orb = $01               crb = $11
        spc     2
*        ca1 - not used
*        ca2 - mr'   = fdc master reset
        spc     1
*        pa0 - dal0' = fdc data access lines
*        pa1 - dal1'
*        pa2 - dal2'
*        pa3 - dal3'
*        pa4 - dal4'
*        pa5 - dal5'
*        pa6 - dal6'
*        pa7 - dal7'
        spc     2
*        cb1 - not used
*        cb2 - dtmr  = disk 5 sec. timer start signal
        spc     1
*        pb0 - da0   = fdc register address bit a0
*        pb1 - da1   = fdc register address bit a1
*        pb2 - dren' = fdc read enable signal
*        pb3 - dwen' = fdc write enable signal
*        pb4 - ds0'  = fdc drive select bit 0
*        pb5 - ds1'  = fdc drive select bit 1
*        pb6 - intrq = fdc interrupt request signal
*        pb7 - drq   = fdc data request signal

* fdc status register summary
        spc     1
* bit  all type 1     read address  read          read track    write         write track
*       commands
* b0   busy           busy          busy          busy          busy          busy
* b1   index          drq           drq           drq           drq           drq
* b2   track 0        lost data     lost data     lost data     lost data     lost data
* b3   crc error      crc error     crc error     0             crc error     0
* b4   seek error     id not found  rec not found 0             rec not found 0
* b5   head engaged   0             record type   0             write fault   write fault
* b6   write protect  0             record type   0             write protect write protect
* b7   not ready      not ready     not ready     not ready     not ready     not ready
        page
* acia's - port i/o
        spc     2
* acia no. 1 - printer/keyboard      trr = $08    csr = $09    swt = $18
* acia no. 2 - instrument i/o        trr = $0a    csr = $0b    swt = $1a
* acia no. 3 - communications i/o    trr = $0c    csr = $0d    swt = $1c
* acia no. 4 - spare i/o             trr = $0e    csr = $0f    swt = $1e
        spc     2
* control register
        spc     1
* b0 - count divide select bit
* b1 - count divide select bit
* b2 - word select bit
* b3 - word select bit
* b4 - word select bit
* b5 - transmit control bit
* b6 - transmit control bit
* b7 - receive interrupt enable bit
        spc     2
* status register
        spc     1
* b0 - rdrf = receive data register full
* b1 - tdre = transmit data register empty
* b2 - dcd' = data carrier detect
* b3 - cts' = clear-to-send
* b4 - fe   = framing error
* b5 - ovrn = receive overrun
* b6 - pe   = parity error
* b7 - irq  = interrupt request
        page
* output line assignments
        spc     1
da0      equ b0                        fdc reg. addr. bit 0
da1      equ b1                        fdc reg. addr. bit 1
dren     equ b2                        fdc read enable
dwen     equ b3                        fdc write enable
ds0      equ b4                        fdc drive sel. bit 0
ds1      equ b5                        fdc drive sel. bit 1
        spc     2
* input line assignments
        spc     1
intrq     equ b6                       fdc inter. req.
drq       equ b7                       fdc data req.
tty       equ b0                       tty select
par       equ b1                       parity select
odd       equ b2                       odd parity select
wrd       equ b3                       8 bit i/o word select
stp       equ b4                       1 stop bit select
dup       equ b5                       half duplex select
        spc     1
* status bit equates
        spc     1
rdrf     equ b0                        acia receive data register full
tdre     equ b1                        acia transmit data register empty
dcd      equ b2                        acia data carrier detect
cts      equ b3                        acia clear-to-send
fe       equ b4                        acia framing error
ovrn     equ b5                        acia overrun
acpe     equ b6                        acia parity error
acirq    equ b7                        acia interrupt request
busy     equ b0                        fdc busy
sdrq     equ b1                        fdc drq
trk0     equ b2                        fdc track 0
lostd    equ b2                        fdc lost data
crcerr   equ b3                        fdc crc error
seeker   equ b4                        fdc seek error
recerr   equ b4                        fdc record not found
wprtct   equ b6                        fdc write protect
notrdy   equ b7                        fdc not ready
        page
* pia/acia register assignments
        org     0
piaora   rmb 1                         pia i/o & ddr regs. - a side
piaorb   rmb 1                         pia i/o & ddr regs. - b side
         rmb 6
ac1trr   rmb 1                         acia # 1 trans/rec reg.
ac1csr   rmb 1                         acia # 1 cntrl/status reg.
ac2trr   rmb 1                         acia # 2 trans/rec reg.
ac2csr   rmb 1                         acia # 2 cntrl/status reg.
ac3trr   rmb 1                         acia # 3 trans/rec reg.
ac3csr   rmb 1                         acia # 3 cntrl/status reg.
ac4trr   rmb 1                         acia # 4 trans/rec reg.
ac4csr   rmb 1                         acia # 4 cntrl/status reg.
piacra   rmb 1                         pia cntrl reg. - a side
piacrb   rmb 1                         pia cntrl reg. - b side
         rmb 6
ac1swt   rmb 1                         acia # 1 setup swt.
         rmb 1
ac2swt   rmb 1                         acia # 2 setup swt.
         rmb 1
ac3swt   rmb 1                         acia # 3 setup swt.
         rmb 1
ac4swt   rmb 1                         acia # 4 setup swt.
         rmb 1
        page
        spc     2
video    equ $1000                     video memory base address
bram     equ $2000                     boot program base address
crow     equ 24                        no. of video character rows (lines)
ccol     equ 80                        no. of video character columns
nchars   equ crow*ccol                 total no. of video characters
nbps     equ 128                       # bytes/sector
nspt     equ 18                        # sectors/track
ntpd     equ 40                        # tracks/disk
sync     equ 6                         size of sync gap (see 1771 manual)
gap1     equ 16                        size of gap1 (see 1771 manual)
gap2     equ 11                        size of gap2 (see 1771 manual)
gap3     equ 10                        size of gap3 (see 1771 manual)

BootROM  equ $F800                     where the Bootstrap ROM lives
        spc     2
* interrupt vector address assignments
         org $fff8
irqvector rmb 2                         irq
swivector rmb 2                         swi
nmivector rmb 2                         nmi
resvector rmb 2                         restart
*
ntrys    equ 5                         # times to try disk i/o before giving up
         page
         org   $2000             ; JMP to System Init
****** SDOS Simulator entered here at boot time *******
* Only 1st 16 sectors have been read, Simulator must read rest of itself
*
SDOSSimulator ; starts here
         jmp   SDOSSimInit             ; around the file table
         jmp   MAKE4$                  ; entry point vector for BASIC assy subr
         jmp   FLOAT4                  ; entry point vector for BASIC assy subr

         ; *** Space reserved for additional vectors if required ***

         org   $2040                   ; so MACCGEN can find FILETABLE
FileTable ; specifies base Logical Sector Number of up to 16 contiguous files
; (actually has 17 entries so 17th "file" begins at end of disk
         if    *#$2040
 ? ; FileTable must be at $2040 so MACCGEN program can set it up
         fin
         rpt   16
         fdb   0                       ; LSNs filled in by MACCGEN program
         fdb   NSPT*NTPD               ; start of 17th "file" (end of disk)

SDOSSimInit ; Simulator initz starts here
         lds   #EndOfBASICProgramRAM   ; get a safe stack pointer
         ldx   #D0DataFileDCB    ; select DCB
         stx   DCBPointer
         ldab  #(RTP$End-SDOSSimulator)//NBPS-16 ; how many records to read
         stab  SectorCount       ; tell ReadMultiple how many desired
         clra                    ; set (A,B) to LRN of 1st record...
         ldab  #16               ; read incorrectly by ROM
         ldx   #$2000+16*NBPS    ; where to read balance of simulator
         jsr   ReadMultipleDAtX  ; load rest of simulator/RTP correctly
         ldaa  #$7e              ; set up "JMP" to top of memory
         staa  Syscall$          ; set up SYSCALL$ vector location
         ldx   #EndOfBASICProgramRAM ; to jump to top of memory
         stx   Syscall$+1        ; so BASIC knows where to get its stack ptr
         staa  EndOfBASICProgramRAM ; set top of memory to JMP to Simulator
         ldx   #SyscallService   ; where to go
         stx   EndOfBASICProgramRAM+1
         staa  $100              ; set RTP entry point gen'd by BASIC Compiler
         ldx   #RTP$Base         ; ...to where RTP really is
         stx   $101
         staa  $103              ; set up RTP entry point for FNs/SUBRs
         ldx   #RTP$SubFunEntry  ; where RTP entry point REALLY is
         stx   $104
         if    0                 ; all devices reset by MACC 1.0 Boot ROM
         jsr   ConsoleReset      ; make console ready for use
         jsr   Drive0Reset       ; make Drive 0 data file ready for use
         jsr   Drive1Reset       ; make Drive 1 data file ready for use
         jsr   Drive2Reset       ; make Drive 2 data file ready for use
         jsr   PrinterReset      ; make Printer ready for use
         jsr   GammaCounter1Reset ; make 1st Gamma counter ready for use
         jsr   GammaCounter2Reset ; make 2nd Gamma counter ready for use
         jsr   GammaCounter3Reset ; make 3rd Gamma counter ready for use
         fin
         page
ExecuteSyscallExit      ; perform simulation of SYSCALL:EXIT
ExecuteSyscallErrorExit ; simulate SYSCALL:ERROREXIT (temporary solution)
         lds   #TopOfRAM         ; set stack pointer to top of world
         ldx   #ChainMACCA       ; go fetch main application program
         jsr   Syscall$
         bcs   *                 ; shouldn't happen
         bcc   *                 ; shouldn't happen

ChainMACCA      ; Syscall block used to chain to main application
         fcb   syscall:chain,chain:sclen,ignored,ignored
         fdb   ChainMACCAName,ChainMACCANameLength
         fdb   Changed
         fdb   ScratchBuffer,4

ChainMACCAName  fcc     "MACCA" ; 5th character specifies 1st application file
ChainMACCANameLength    equ     *-ChainMACCAName
         page
ReadMultipleDAtX ; Read multiple sequential sectors with starting LSN in (D)
; into memory at location (X) for SECTORCOUNT (1..255) sectors
; DCBPOINTER selects drive info
; Only assumption made about state of drive is that heads are over track
; specified by DCB:CURRENTTRACK.  After performing read, deselects drive
; and turns the motor off.
        bsr    ReadSectorDAtX          ; go fetch first sector
        dec    SectorCount             ; down count # sectors to read
        beq    ReleaseDrive            ; b/ only 1 sector to read, all done
ReadMultipleLoop ; come here to read another sector
        ldaa   PhysicalSectorNumber    ; at end of track yet ?
        cmpa   #NSPT                   ; ...?
        bls    ReadMultipleWithinTrack ; b/ no, keep on reading
        ldx    dcbpointer              ; force seek to next track
        ldaa   dcb:currenttrack,x      ; get track we are on
        inca                           ; = track we want to be on
        staa   PhysicalTrackNumber     ; set desired track number
        jsr    DiskSeek                ; seek to track
        clr    PhysicalSectorNumber    ; so "inc" below chooses sector #1
ReadMultipleWithinTrack ; all set to read another sector
        inc    PhysicalSectorNumber    ; determine sector number desired
        bsr    ReadWithinTrack         ; read next sector
        dec    SectorCount             ; down count # sectors to read
        bne    ReadMultipleLoop        ; b/ more sectors to read
;       bra    ReleaseDrive            ; all done, let go of drive

ReleaseDrive ; deselect current drive and spin motor down
        ; drive times out by self after 5 seconds, so we need do nothing
        ldab   #3                      ; select impossible drive...
        jmp    DiskSelect              ; so lights will go out
        page
WriteMultipleDAtX ; Write multiple sequential sectors with starting LSN in (D)
; from memory at location (X) for SECTORCOUNT (1..255) sectors
; DCBPOINTER selects drive info
; Only assumption made about state of drive is that heads are over track
; specified by DCB:CURRENTTRACK.  After performing write, deselects drive
; and turns the motor off.
        bsr    WriteSectorDAtX         ; go fetch first sector
        dec    SectorCount             ; down count # sectors to read
        beq    ReleaseDrive            ; b/ only 1 sector to read, all done
WriteMultipleLoop ; come here to write another sector
        ldaa   PhysicalSectorNumber    ; at end of track yet ?
        cmpa   #NSPT                   ; ...?
        bls    WriteMultipleWithinTrack ; b/ no, keep on reading
        ldx    dcbpointer              ; force seek to next track
        ldaa   dcb:currenttrack,x      ; get track we are on
        inca                           ; = track we want to be on
        staa   PhysicalTrackNumber     ; set desired track number
        jsr    DiskSeek                ; seek to track
        clr    PhysicalSectorNumber    ; so "inc" below chooses sector #1
WriteMultipleWithinTrack ; all set to read another sector
        inc    PhysicalSectorNumber    ; determine sector number desired
        bsr    WriteWithinTrack        ; write next sector
        dec    SectorCount             ; down count # sectors to read
        bne    WriteMultipleLoop       ; b/ more sectors to write
        bra    ReleaseDrive            ; all done, let go of drive
        page
ReadSectorDAtX ; Read sector whose LSN is in (D) into memory at location (X)
; DCBPOINTER selects drive info; DRIVENUMBER contains drive desired
; Only assumption made about state of drive is that heads are over track
; specified by DCB:CURRENTTRACK.
; This read can be the first sector of a multi-sector read within a track
; (reading the second and other sectors will occur via ReadWithinTrack)
; Exits with drive left selected, ready, spun up, and heads placed over
; the desired track.  The caller must call ReleaseDrive to turn the motor
; on the drive off when the caller is through with the drive.
; If no disk error, exits with SECTORBUFFER set to entry (X) plus NBPS
        bsr    DiskRWCommon            ; shred LSN, spin drive up, ck ready
ReadWithinTrack ; read sector specified by PhysicalSectorNumber...
; into memory at location specified by SECTORBUFFER
; Used to read sectors within a track once drive has been selected, is ready,
; spun up, heads placed over the desired track and a successful read has
; already been performed. These conditions are assured by calling
; ReadSectorDatX before calling this routine.
; If no disk error, exits with SECTORBUFFER set to entry (X) plus NBPS
        ldaa    #ntrys                 ; set tries to read sector
        staa    trycnt
ReadWithinTrackAgain ; try to read sector
        jsr     ReadPhysicalSector     ; go read desired sector to buffer
        beq     DiskRWWithinTrackDone  ; b/ successful read
        jsr     DiskRestore            ; force heads back to track 0
        jsr     DiskSeek               ; seek to desired track again
        dec     trycnt                 ; any tries left ?
        bne     ReadWithinTrackAgain   ; b/ some tries left, try again
ReadWriteFailed ; can't perform desired disk I/O, give up ungracefully
        ldx     #PrintFatalDiskErrorMessage ; tell user...
        jsr     Syscall$               ; and croak
        bcs     *
        bcc     *

DiskRWWithinTrackDone ; b/ successful read or write operation
        rts
PrintFatalDiskErrorMessage ; system call block used to complain
        fcb     syscall:writea,writea:sclen
        fcb     0,ignored              ; channel # 0
        fdb     FatalDiskErrorMessage,FatalDiskErrorMessageLength

FatalDiskErrorMessage ; must be with gut-level disk drivers
        fcb     ascii:cr
        fcc     "Fatal disk I/O failure"

FatalDiskErrorMessageLength equ *-FatalDiskErrorMessage
        page
WriteSectorDAtX ; Write sector whose LSN is in (D) into memory at location (X)
; DCBPOINTER selects drive info; DRIVENUMBER contains drive desired
; Only assumption made about state of drive is that heads are over track
; specified by DCB:CURRENTTRACK.
; This write can be the first sector of a multi-sector write within a track
; (writing the second and other sectors will occur via WriteWithinTrack)
; Exits with drive left selected, ready, spun up, and heads placed over
; the desired track.  The caller must call ReleaseDrive to turn the motor
; on the drive off when the caller is through with the drive.
; If no disk error, exits with SECTORBUFFER set to entry (X) plus NBPS
        bsr    DiskRWCommon            ; shred LSN, spin drive up, ck ready
WriteWithinTrack ; Write sector specified by PhysicalSectorNumber...
; from memory at location specified by SECTORBUFFER
; Used to write sectors within a track once drive has been selected, is ready,
; spun up, heads placed over the desired track and a successful write has
; already been performed. These conditions are assured by calling
; WriteSectorDatX before calling this routine.
; If no disk error, exits with SECTORBUFFER set to entry (X) plus NBPS
        ldaa    #ntrys                 ; set tries to write sector
        staa    trycnt
WriteWithinTrackAgain ; try to read sector
        jsr     WritePhysicalSector    ; go read desired sector to buffer
        beq     DiskRWWithinTrackDone  ; b/ successful read
        jsr     DiskRestore            ; force heads back to track 0
        jsr     DiskSeek               ; seek to desired track again
        dec     trycnt                 ; any tries left ?
        bne     ReadWithinTrackAgain   ; b/ some tries left, try again
        bra     ReadWriteFailed

        page
DiskRWCommon ; shred LSN, spin drive up, ck ready, position heads
; (X) holds memory address to be used in Read/Write transfer
; (A,B) holds desired logical sector number
        stx     SectorBuffer           ; remember memory address
        clr     PhysicalTrackNumber    ; use as tricky loop counter
        inc     PhysicalTrackNumber    ; so the 8th ROL below gives carry
RipApartLSNLoop ; Rip apart logical sector number to get physical sector, track
        aslb
        rola
        adda    #-nspt                 ; does divisor go in ?
        bcs     RipApartLSNLoop1       ; b/ yes, quotient bit is a one
        suba    #-nspt                 ; no, quotient bit is a zero
RipApartLSNLoop1
        rol     PhysicalTrackNumber    ; save quotient bit
        bcc     RipApartLSNLoop        ; b/ haven't produced 8 quotient bits
        inca                           ; remainder + 1 is desired sector
        staa    PhysicalSectorNumber
        ldx     DCBPointer             ; determine drive desired
        ldab    dcb:drivenumber,x
        jsr     DiskSelect             ; select & start drive
        jsr     pout                   ; setup to write to fdc
        ldaa    piaorb
        anda    #\da1
        oraa    #da0
        staa    piaorb                 ; select track reg. in fdc
        ldx     dcbpointer             ; find drive information
        ldab    dcb:currenttrack,x     ; where heads were last time drive used
        jsr     DiskCommand            ; write track # into track reg. of fdc
        ldaa    piaorb
        anda    #\da0
        staa    piaorb                 ; select command reg. in fdc
;       jsr     DiskSeek               ; seek to desired track
;       rts
        page
DiskSeek ; seek to track PhysicalTrackNumber on drive selected by DCBPOINTER
; Records track number in device DCB
; Drive has already been spun up
* ...assumes disk selected
* ...assumes disk started
        bsr     pout                   ; setup to write to fdc
        ldaa    piaorb
        oraa    #da1+da0
        staa    piaorb                 ; select data reg. in fdc
        ldab    PhysicalTrackNumber
        jsr     DiskCommand            ; write track # into data reg. in fdc
        ldaa    piaorb
        anda    #\(da1+da0)
        staa    piaorb                 ; select status/command reg. in fdc
        ldab    #%00010111
;       bsr     DiskSeekOperation
;       rts
DiskSeekOperation ; do Seek operation specified by (B)
        bsr     DiskCommand            ; give seek track & verify command
        jsr     pin                    ; setup to read from fdc
DiskSeekWaitLoop
        bsr     DiskStatus             ; get status word
        bitb    #busy
        bne     DiskSeekWaitLoop       ; wait until seek complete
        bitb    #seeker!busy!crcerr!notrdy ; notrdy, seek, busy or crc error ?
        bne     ReadWriteFailedJ       ; seek failed, croak die
        ldaa    PhysicalTrackNumber    ; grab track number
        ldx     dcbpointer             ; record where heads are now
        staa    dcb:currenttrack,x
        ldaa    #ntrys                 ; set tries to read sector
        staa    trycnt
        rts

ReadWriteFailedJ
        jmp     ReadWriteFailed        ; seek failed, croak die

DiskRestore ; restore currently selected drive to track 0
        bsr     pout                   ; setup to write to fdc
        ldab    #%00000100             ; = "restore" command
        bsr     DiskSeekOperation      ; go do seek step
        clr     dcb:currenttrack,x     ; we (think) we are on track 0
        rts
        page
DiskStatus ; read disk status subroutine
* ...assumes disk selected
* ...assumes status/command reg. selected
* ...assumes direction of data port setup
* ...returns status word in acc. b
        ldaa    piaorb
        eora    #dren
        staa    piaorb                 ; re' = 0
        ldab    piaora                 ; read status reg.
        oraa    #dren
        staa    piaorb                 ; re' = 1
        comb                           ; complement error bits.
        rts
        spc     2
DiskCommand ; give disk command subroutine
* ...command byte in acc. b
* ...assumes disk selected
* ...assumes status/command reg. selected
* ...assumes direction of data port setup
* ...assumes fdc not busy
        spc     1
        comb                           ; because interface inverts bytes
        ldaa    piaorb
        eora    #dwen
        stab    piaora                 ; setup command
        staa    piaorb                 ; we' = 0; initiate command
        oraa    #dwen
        staa    piaorb                 ; we' = 1
        rts
        page
pout ; setup fdc PIA to "output"
        ldab    #$ff                   ; setup to write
        bra     pio                    ; skip
pin ; setup fdc PIA for "input"
        clrb                           ; setup to read
pio     ldaa    #$38
        staa    piacra                 ; select ddra
        stab    piaora                 ; set ddra
        ldaa    #$3c
        staa    piacra                 ; select ora
        rts
        spc     2
DiskSelect ; select disk drive specified by lower two bits of (B)
* also selects status/command reg.
        eorb    #3                     ; invert select bits
        aslb                           ; position disk select
        aslb
        aslb
        aslb
        orab    #dren+dwen
        stab    piaorb                 ; select drive & then start it
;       bra     DiskStart
        spc     2
DiskStart ; start disk drive subroutine
* ...enables select, starts drive motor, & loads head
        ldaa    #$3c
        staa    piacrb                 ; dtmr = 1; trigger 5 sec. timer
        ldaa    #$34
        staa    piacrb                 ; dtmr = 0
        rts
        spc     2
DiskReadyWait ; wait until disk drive ready subroutine
* ... assumes direction of data port setup
        bsr     pin                    ; setup to read from fdc
        ldx     #51000                 ; init. for time out of 1.598 sec.
DiskWaitReadyLoop
        bsr     DiskStatus             ; get status word
        bitb    #notrdy
        beq     DiskWaitReadyDone      ; drive ready? yes. exit
        dex                            ; no.
        bne     DiskWaitReadyLoop      ; time up? no. keep waiting
DiskWaitReadyDone
        rts
        page
ReadPhysicalSector ; try just ONCE to read PhysicalSectorNumber within track
* ...assumes head positioned over desired track
        bsr     rwsset                 ; setup to read sector
        bne     rdsrt                  ; return if not ready
        jsr     pout                   ; setup to write to fdc
        ldab    #%10001000             ; "read sector" command
        jsr     DiskCommand            ; give read sector command
        ldx     SectorBuffer           ; beginning buffer addr.
        ldaa    piaorb
        oraa    #da1+da0
        staa    piaorb                 ; select data reg. in fdc
        jsr     pin                    ; setup to read from fdc
rdslp   ldaa    piaorb
        bmi     rdssk                  ; skip if a drq is present
        bita    #intrq
        beq     rdslp                  ; wait for a drq or an intrq
        bsr     sset                   ; setup & get status word
        ; if drive is not ready, 1771 will notice and read will fail
        bitb    #recerr!lostd!busy!crcerr!notrdy ; check for errors
        bne     rdsrt                  ; b/ fault, don't update SectorAddres
        stx     SectorBuffer           ; Save updated pointer for seq. reads
        clra                           ; signal caller that read successful
rdsrt   rts

rdssk   eora    #dren                  ; here on data request
        staa    piaorb                 ; re' = 0
        ldab    piaora                 ; read data byte
        oraa    #dren
        staa    piaorb                 ; re' = 1
        comb                           ; invert data byte
        stab    x                      ; store byte in sector buffer
        inx
        bra     rdslp                  ; try to read another byte
        page
WritePhysicalSector ; try just ONCE to write PhysicalSectorNumber within track
* ...assumes head positioned over desired track
        bsr     rwsset                 ; setup to write sector
        bne     wtsrt                  ; return if not ready
        jsr     pout                   ; setup to write to fdc
        ldab    #%10101000             ; "write sector"
        jsr     DiskCommand            ; give write sector command
        ldx     SectorBuffer           ; beginning sector buffer addr.
        ldaa    piaorb
        oraa    #da1+da0
        staa    piaorb                 ; select data reg. in fdc
wtslp1  ldab    x
        comb                           ; invert data byte
        stab    piaora                 ; setup byte to write
wtslp2  ldaa    piaorb
        bmi     wtssk                  ; skip if a drq present
        bita    #intrq
        beq     wtslp2                 ; wait for a drq or an intrq
        bsr     sset                   ; setup & get status word
        ; if drive is not ready, 1771 will notice and read will fail
        bitb    #wprtct!recerr!lostd!busy!crcerr!notrdy ; check for errors
        bne     wtsrt                  ; b/ error, don't update pointer
        stx     SectorBuffer           ; Save updated pointer for seq. writes
        clra                           ; signal caller that read successful
wtsrt   rts

wtssk   eora    #dwen                  ; here on drq
        staa    piaorb                 ; we' = 0; write byte
        oraa    #dwen
        staa    piaorb                 ; we' = 1
        inx
        bra     wtslp1                 ; try to write another byte
        spc     2
* read/write sector setup subroutine
        spc     1
rwsset  jsr     DiskStart              ; start drive
        ldaa    piaorb
        anda    #\da0
        oraa    #da1
        staa    piaorb                 ; select sector reg. in fdc
        jsr     pout                   ; setup to write to fdc
        ldab    PhysicalSectorNumber
        jsr     DiskCommand            ; write sector # into sector reg. in fdc
        ldaa    piaorb
        anda    #\(da1+da0)
        staa    piaorb                 ; select status/command reg. in fdc
        jsr     DiskReadyWait          ; wait until drive ready
        rts

* setup & get status word subroutine
        spc     1
sset    ldaa    piaorb
        anda    #\(da1+da0)
        staa    piaorb                 ; select status/command reg. in fdc
        jsr     pin                    ; setup to read from fdc
        jsr     DiskStatus             ; get status word
        rts
        page
lddbx   ; load double (A,B) from (B)+(X)
         stx   tempx             ; add (B) to (X)
         addb  tempx+1
         stab  tempx+1
         ldab  tempx
         adcb  #0
         stab  tempx
         ldx   tempx             ; whew...
         ldaa  0,x               ; fetch (A,B) from 0,x
         ldab  1,x
         rts

Error   ; (PC) points to error code, move to (X), unwind stack and return
         tsx                     ; fetch error code
         ldx   0,x               ;     points at error code
         ldx   0,x               ;     fetch actual error code
         stx   LastError         ; record last error encountered
         lds   SyscallStack      ; restore stack pointer
         des                     ; to offset initial INS INS below
         des
UnwindStack     ; pop return addresses from stack until BCC/BCS found
         ins                     ; throw away return address on top of stack
         ins
         tsx                     ; grab return address from top of stack
         ldx   0,x
         ldaa  0,x               ; point at BCC/BCS ?
         anda  #$FE              ; (drop LSB)
         cmpa  #$24              ; BCC ?
         bne   UnwindStack       ; b/ no, unwind stack some more
         ldx   LastError         ; get error code
         sec                     ; signal "error"
         rts
         page
SyscallService  ; come here with (X) pointing to syscall block
; Assert: only debugged programs will use the Simulator
; --> Simulator need not validate contents of SYSCALL blocks.
         stx   SyscallBlock      ; remember where syscall block is
         sts   SyscallStack      ; and value of stack pointer at entry
         ldaa  scblk:wrbuf,x     ; get pointer to write buffer
         ldab  scblk:wrbuf+1,x
         staa  writebuffer
         stab  writebuffer+1
         ldaa  scblk:wrlen,x     ; get amount of data written
         ldab  scblk:wrlen+1,x
         staa  writebufferlength
         stab  writebufferlength+1
         ldaa  scblk:rdbuf,x     ; get pointer to reply buffer area
         ldab  scblk:rdbuf+1,x
         staa  replybuffer
         stab  replybuffer+1
         ldaa  scblk:rdlen,x     ; how much space for reply
         ldab  scblk:rdlen+1,x
         staa  replybufferlength
         stab  replybufferlength
         clr   replycount        ; assume zero reply length
         clr   replycount+1
         ldab  scblk:opcode,x    ; get syscall function code
         cmpb  #SyscallsDefined  ; valid syscall code ?
         bhs   NotImplemented    ; b/ no
         aslb                    ; double to make word index
         ldx   #SyscallBranchTable ; grab entry from table
         jsr   lddbx             ; where to go to simulate Syscall
         pshb                    ; go simulate syscall
         psha
         rts

SyscallExitSetReplyCount        ; come here to set SCBLK:RPLEN
         ldx   SyscallBlock      ; find syscall block
         ldaa  ReplyCount        ; stuff reply count into it
         ldab  ReplyCount+1
         staa  scblk:rplen,x
         stab  scblk:rplen+1,x
         okrts                   ; and return to caller
         page
ExecuteSyscallRename    ; simulate SYSCALL:RENAME
ExecuteSyscallDelete    ; simulate SYSCALL:DELETE
ExecuteSyscallLoad      ; simulate SYSCALL:LOAD
ExecuteSyscallCreateLog ; simulate SYSCALL:CREATELOG
ExecuteSyscallCloseLog  ; simulate SYSCALL:CLOSELOG
ExecuteSyscallDiskDefault       ; simulate SYSCALL:DISKDEFAULT
ExecuteSyscallWaitDone  ; simulate SYSCALL:WAITDONE
ExecuteSyscallSetError  ; simulate SYSCALL:SETERROR
ExecuteSyscallGetError  ; simulate SYSCALL:GETERROR
ExecuteSyscallDispError ; simulate SYSCALL:DISPERROR
ExecuteSyscallKillProof ; simulate SYSCALL:KILLPROOF
ExecuteSyscallKillEnable        ; simulate SYSCALL:KILLENABLE
ExecuteSyscallDebug     ; simulate SYSCALL:DEBUG
ExecuteSyscallAttnCheck ; simulate SYSCALL:ATTNCHECK
ExecuteSyscallIsConsole ; simulate SYSCALL:ISCONSOLE
NotImplemented   ; signal error back to caller... we don't know how to do it!
         jsr   Error
         fdb   Err:IllegalSyscall

SyscallBranchTable      ; used to vector on SC:OPCODE to syscall simulation routine
         fdb   ExecuteSyscallOpen              ;    0
         fdb   ExecuteSyscallCreate            ;    1
         fdb   ExecuteSyscallClose             ;    2
         fdb   ExecuteSyscallRename            ;    3
         fdb   ExecuteSyscallDelete            ;    4
         fdb   ExecuteSyscallLoad              ;    5
         fdb   ExecuteSyscallChain             ;    6
         fdb   ExecuteSyscallCreateLog         ;    7
         fdb   ExecuteSyscallCloseLog          ;    8
         fdb   ExecuteSyscallDiskDefault       ;    9
         fdb   ExecuteSyscallReadA             ;  $0A
         fdb   ExecuteSyscallReadB             ;  $0B
         fdb   ExecuteSyscallWriteA            ;  $0C
         fdb   ExecuteSyscallWriteB            ;  $0D
         fdb   ExecuteSyscallControl           ;  $0E
         fdb   ExecuteSyscallStatus            ;  $0F
         fdb   ExecuteSyscallWaitDone          ;  $10
         fdb   ExecuteSyscallExit              ;  $11
         fdb   ExecuteSyscallErrorExit         ;  $12
         fdb   ExecuteSyscallSetError          ;  $13
         fdb   ExecuteSyscallGetError          ;  $14
         fdb   ExecuteSyscallDispError         ;  $15
         fdb   ExecuteSyscallKillProof         ;  $16
         fdb   ExecuteSyscallKillEnable        ;  $17
         fdb   ExecuteSyscallDebug             ;  $18
         fdb   ExecuteSyscallAttnCheck         ;  $19
         fdb   ExecuteSyscallIsConsole         ;  $20
SyscallsDefined equ     (*-SyscallBranchTable)/2
         page
FetchWriteBufferByte    ; get byte from write buffer
; Returns Z bit set (zero) if all write buffer bytes processed
; Else returns Z reset, byte in (A), and advances WRITEBUFFER
         ldx   writebufferlength       ; get remaining buffer length
         beq   FetchWriteBufferByteRts ; b/ none left
         dex                           ; down count # bytes left
         stx   writebufferlength
         ldx   writebuffer             ; get byte from write buffer
         ldaa  0,x
         inx                           ; bump buffer pointer
         stx   writebufferlength       ; assert: Z bit says "Non-zero" here
FetchWriteBufferByteRts
         rts

StoreReplyBufferByte    ; store (A) into reply buffer.
; Must be called only when reply buffer space is still available.
; Advance reply buffer fill pointer, and bump REPLYCOUNT
; Returns with Z set if reply buffer is full.
         ldx   ReplyBuffer             ; where to store next byte
         staa  0,x                     ; store it
         inx
         stx   ReplyBuffer
         ldx   ReplyCount              ; count # bytes collected
         inx
         stx   ReplyCount
         ldx   ReplyBufferLength       ; decrement remaining space
         dex
         stx   ReplyBufferLength
         rts
         page
ExecuteSyscallChain     ; simulate SYSCALL:CHAIN
         ldx   SyscallBlock      ; determine which file to chain to
         ldx   scblk:wrbuf,x     ; points to string of form MACCX...
         ldab  5,x               ; fetch X part of string
         subb  #'A-2             ; specifies FileTable slot to chain to
         aslb                    ; make into word index
         ldx   #FileTable        ; get slot content
         jsr   lddbx
         staa  tempx             ; save starting LSN of file
         stab  tempx+1
         subb  3,x               ; empty file ?
         bne   ExecuteSyscallChain1 ; b/ no
         sbca  2,x               ; ... ?
         bne   ExecuteSyscallChain2 ; b/ no
         jsr   Error             ; yes, force error back to caller
         Err:NoSuchProgram

ExecuteSyscallChain1    ; finish computing size of file
         sbca  2,x
ExecuteSyscallChain2    ; (D) holds negative of size of application program
;        coma                    ; form abs(size of application)
         negb
;        adca  #0
         stab  SectorCount       ; max of 255 blocks of 128 bytes --> 32kb
         ldaa  0,x               ; fetch starting LSN of desired file
         ldab  1,x
         ldx   #D0DataFileDCB    ; select proper DCB
         stx   DCBPointer
         ldx   #RTP$End          ; where application program is to load
         lds   #TopOfRAM         ; make clean stack pointer
         jsr   ReadMultipleDAtX  ; read in block of code
         jmp   RTP$End           ; pass control to application program
         page
DetermineDCBAddress     ; from SCBLK:PARAMS+0 byte
; Returns DCB address in (X) and DCBPointer
         ldx   SyscallBlock      ; get pointer to syscall block
         ldab  scblk:params,x    ; specifies I/O channel number
         aslb                    ; set to do word indexing
         ldx   #ChannelToDCBMap  ; converts channel number to DCB address
         jsr   lddbx             ; fetch DCB pointer to (D)
         staa  DCBpointer        ; remember it for heavy future use
         stab  DCBpointer+1
         ldx   DCBPointer        ; return in (X)
         rts

ChannelToDCBMap ; maps Channel number to appropriate DCB
         fdb   ConsoleDCB        ; Channel 0
         fdb   D0DataFileDCB     ; Channel 1
         fdb   D1DataFileDCB     ; Channel 2
         fdb   D2DataFileDCB     ; Channel 3
         fdb   PrinterDCB        ; Channel 4
         fdb   GammaCounter1DCB  ; Channel 5
         fdb   GammaCounter2DCB  ; Channel 6
         fdb   GammaCounter3DCB  ; Channel 7
         page
ExecuteSyscallOpen      ; simulate SYSCALL:OPEN
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:OPEN,x          ; go to routine

ExecuteSyscallCreate    ; simulate SYSCALL:CREATE
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:CREATE,x        ; go to routine

ExecuteSyscallClose     ; simulate SYSCALL:CLOSE
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:CLOSE,x         ; go to routine

ExecuteSyscallReadA     ; simulate SYSCALL:READA
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:READA,x         ; go to routine

ExecuteSyscallReadB     ; simulate SYSCALL:READB
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:READB,x         ; go to routine

ExecuteSyscallWriteA    ; simulate SYSCALL:WRITEA
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:WRITEA,x        ; go to routine

ExecuteSyscallWriteB    ; simulate SYSCALL:WRITEB
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:WRITEB,x        ; go to routine

ExecuteSyscallControl   ; simulate SYSCALL:CONTROL
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:CONTROL,x       ; go to routine

ExecuteSyscallStatus    ; simulate SYSCALL:STATUS
         jsr   DetermineDCBAddress ; set up DCBPOINTER for device
         jmp   DCB:STATUS,x        ; go to routine
         page
OpenCommon      ; come here to perform common work on DCB for OPEN request
CreateCommon    ; come here to perform common work on DCB for CREATE request
         clr   dcb:column,x      ; set column number back to zero
         clr   dcb:fileposition+0,x ; reset file byte position to zero
         clr   dcb:fileposition+1,x
         clr   dcb:fileposition+2,x
         clr   dcb:fileposition+3,x
         okrts                   ; all done

CloseCommon     ; this is easy to do
         okrts                   ; all done

ConsoleDCB      ; Device Control Block for CRT/Keyboard combination
         jmp   OpenCommon        ; Device OPEN
         jmp   CloseCommon       ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   ConsoleReadA      ; Device READA
         jmp   NotImplemented    ; Device READB
         jmp   CRTWriteA         ; Device WRITEA
         jmp   NotImplemented    ; Device WRITEB
         jmp   ConsoleControl    ; Device CONTROL operation
         jmp   ConsoleStatus     ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fdb   ac1trr            ; ACIA address for serial port (keyboard)

PrinterDCB      ; Device Control Block for Printer
         jmp   OpenCommon        ; Device OPEN
         jmp   CloseCommon       ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   NotImplemented    ; Device READA
         jmp   NotImplemented    ; Device READB
         jmp   SerialWriteA      ; Device WRITEA
         jmp   SerialWriteB      ; Device WRITEB
         jmp   SerialControl     ; Device CONTROL operation
         jmp   SerialStatus      ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fdb   ac1trr            ; ACIA address for serial port (printer)
         page
D0DataFileDCB   ; Device Control Block for Disk 0 Application Data File
         jmp   OpenCommon        ; Device OPEN
         jmp   FileClose         ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   FileReadA         ; Device READA
         jmp   FileReadB         ; Device READB
         jmp   FileWriteA        ; Device WRITEA
         jmp   FileWriteB        ; Device WRITEB
         jmp   FileControl       ; Device CONTROL operation
         jmp   FileStatus        ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fcb   0                 ; Disk Drive Number
         fdb   FileTable+16*2    ; Last slot in FileTable gives file base

D1DataFileDCB   ; Device Control Block for Disk 1 Application Data File
         jmp   OpenCommon        ; Device OPEN
         jmp   FileClose         ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   FileReadA         ; Device READA
         jmp   FileReadB         ; Device READB
         jmp   FileWriteA        ; Device WRITEA
         jmp   FileWriteB        ; Device WRITEB
         jmp   FileControl       ; Device CONTROL operation
         jmp   FileStatus        ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fcb   1                 ; Disk Drive Number
         fdb   EntireDisk        ; Data file covers Entire disk

EntireDisk      ; dummy FileTable for drives 2 and 3
         fdb   0                 ; data file begins at LSN 0
         fdb   NSPT*NTPD         ; and ends at end of disk

D2DataFileDCB   ; Device Control Block for Disk 2 Application Data File
         jmp   OpenCommon        ; Device OPEN
         jmp   FileClose         ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   FileReadA         ; Device READA
         jmp   FileReadB         ; Device READB
         jmp   FileWriteA        ; Device WRITEA
         jmp   FileWriteB        ; Device WRITEB
         jmp   FileControl       ; Device CONTROL operation
         jmp   FileStatus        ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fcb   2                 ; Disk Drive Number
         fdb   EntireDisk        ; Data file covers Entire disk
         page
GammaCounter1DCB        ; Device Control Block for Gamma Counter number 1 port
         jmp   OpenCommon        ; Device OPEN
         jmp   CloseCommon       ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   SerialReadA       ; Device READA
         jmp   SerialReadB       ; Device READB
         jmp   SerialWriteA      ; Device WRITEA
         jmp   SerialWriteB      ; Device WRITEB
         jmp   SerialControl     ; Device CONTROL operation
         jmp   SerialStatus      ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fdb   ac2trr            ; ACIA address for serial port

GammaCounter2DCB        ; Device Control Block for Gamma Counter number 1 port
         jmp   OpenCommon        ; Device OPEN
         jmp   CloseCommon       ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   SerialReadA       ; Device READA
         jmp   SerialReadB       ; Device READB
         jmp   SerialWriteA      ; Device WRITEA
         jmp   SerialWriteB      ; Device WRITEB
         jmp   SerialControl     ; Device CONTROL operation
         jmp   SerialStatus      ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fdb   ac3trr            ; ACIA address for serial port

GammaCounter3DCB        ; Device Control Block for Gamma Counter number 1 port
         jmp   OpenCommon        ; Device OPEN
         jmp   CloseCommon       ; Device CLOSE
         jmp   CreateCommon      ; Device CREATE
         jmp   SerialReadA       ; Device READA
         jmp   SerialReadB       ; Device READB
         jmp   SerialWriteA      ; Device WRITEA
         jmp   SerialWriteB      ; Device WRITEB
         jmp   SerialControl     ; Device CONTROL operation
         jmp   SerialStatus      ; Device STATUS request
         fcb   0,0,0,0           ; File Byte Position
         fcb   0                 ; Column Number
         fdb   ac4trr            ; ACIA address for serial port
         page
ConsoleReadABadChar     ; character is bad or no room available in buffer
         jsr   CRTWriteBell            ; give user the raspberry
ConsoleReadA      ; Device READA
; Implements SYSCALL:READA in line mode. Allows operator line entry
; with character echo (so operator can see what is being typed)
; delete (so operator can fix minor typing faults) and
; ^X (so operator can cancel a line which is completely screwed up).
; Operator may abort keyboard entry by typing ESCAPE.
; Line may run from current cursor position to right edge of screen only.
; Assert: Reply data buffer is if length > 0
         bsr   CRTWaitCharBlinkCursor  ; let operator know we want more data
         jsr   GetSerialByte           ; get keystroke from operator
         cmpa  #ascii:rubout           ; delete character ?
         beq   ConsoleReadABackSpace   ; b/ yes, go delete a character
         cmpa  #ascii:space            ; a printing character ?
         blo   ConsoleReadAControlChar ; b/ no, go process
         ldx   ReplyBufferLength       ; after storing character...
         dex                           ; will there still be room for <RETURN>?
         beq   ConsoleReadABadChar     ; b/ no, go complain
         ldx   CRTLineFillPointer      ; at end of physical display line ?
         cpx   CRTNextLinePointer      ; ...?
         beq   ConsoleReadABadChar     ; yes, no more printing chars accepted
         jsr   StoreReplyBufferByte    ; store the character
         jsr   CRTWritePrintingCharacter ; show character on screen
         bra   ConsoleReadA            ; go collect more keystrokes

ConsoleReadAEndLine     ; handle end-of-input
         jsr   StoreReplyBufferByte    ; store the character
         jsr   CRTWriteCR              ; put cursor on new line
         jmp   SyscallExitSetReplyCount ; all done!

ConsoleReadAControlChar ; control character seen from keyboard
         cmpa  #ascii:cr               ; end of line ?
         beq   ConsoleReadAEndLine     ; b/ yes, terminate input
         cmpa  #ascii:esc              ; abort input ?
         beq   ConsoleReadAEscape      ; b/ yes, go handle
         cmpa  #ascii:bs               ; backspace character ?
         beq   ConsoleReadABackSpace   ; b/ yes, go delete a character
         cmpa  #ascii:can              ; ^X (cancel line) ?
         beq   ConsoleReadACancelLine  ; b/ yes, go handle
         ; not anything that input routine cares about
         bsr   ServiceLineFlagControls ; check for special debug character
         beq   ConsoleReadA            ; accepted, go look for another
         bne   ConsoleReadABadChar     ; b/ no, go complain

ConsoleReadAEscape      ; operator requests attention
         jsr   SyscallExitSetReplyCount ; record # collected characters
         jsr   Error                   ; signal error back to caller
         fdb   Err:Attention
         page
ConsoleReadABackSpace   ; handle character deletion
         ldx   ReplyCount              ; anything to delete ?
         beq   ConsoleReadABadChar     ; b/ no, go complain
         bsr   ConsoleInputDeleteOne   ; delete character from collected line
         bra   ConsoleReadA            ; go process another character

ConsoleReadACancelLine  ; b/ yes, go handle
         ldx   ReplyCount              ; anything to delete ?
         beq   ConsoleReadABadChar     ; b/ no, all done
         bsr   ConsoleInputDeleteOne   ; delete character from collected line
         bra   ConsoleReadACancelLine  ; and do it again

ConsoleInputDeleteOne   ; delete One character from collected line
; (X) holds ReplyCount
         dex                           ; yes, decrease # chars in buffer
         stx   ReplyCount
         ldx   ReplyBufferLength       ; give space back to reply buffer
         inx
         stx   ReplyBufferLength
         ldx   ReplyBuffer             ; and back up buffer pointer
         dex
         stx   ReplyBuffer
         ldx   CRTLineFillPointer      ; backup up CRT display pointer
         dex                           ; 2 locations/displayed character
         dex
         stx   CRTLineFillPointer
         ldaa  #ascii:space            ; blank out current cursor location
         staa  0,x
         rts
         page
CRTWaitCharBlinkCursor  ; blink cursor until new keyboard data arrives
         ldx   CRTLineFillPointer      ; put up cursor
         ldaa  #'_                     ; show cursor
         staa  0,x
         bsr   CRTWaitHalfSecondForKeystroke
         ldx   CRTLineFillPointer      ; put up cursor
         ldaa  #Ascii:space            ; erase cursor
         staa  0,x
         bsr   CRTWaitHalfSecondForKeystroke
         bne   CRTWaitCharBlinkCursor  ; b/ no keystroke yet
         rts                           ; keystroke ready to grab

CRTWaitHalfSecondForKeystroke   ; wait at most .5 second for keystroke
; Return with CC "Non-zero" if keystroke available
; Return with CC "Zero" if no keystroke available
         ldx   #10*(50000/(4+2+4+4+4)) ; magic constant: tune for .5 sec
CRTWaitHalfSecondForKeystrokeLoop
         ldaa  ac1csr                  ; (4~) character arrive ?
         bita  #rdrf                   ; (2~) ...?
         bne   CRTWaitHalfSecondForKeystrokeRTS ; (4~) b/ yes
         dex                           ; (4~) no, down count delay
         bne   CRTWaitHalfSecondForKeystrokeLoop ; (4~)
CRTWaitHalfSecondForKeystrokeRTS        ; Z CC bit set correctly for exit
         rts

ServiceLineFlagControls ; check for special debug character in (A)
; return (A)=0 and Z bit set if special debug character
; also modify location $F0 as required by Runtime Package
; return (A) unchanged, and Z bit reset (non-zero) if not debug character
         ldab  #$80                    ; assume "escape"
         cmpa  #ascii:esc              ; Escape ?
         beq   ServiceLineFlagControlsSetBit ; b/ yes, go record
         ldab  #$40                    ; assume breakpoint
         cmpa  #ascii:stx              ; Breakpoint ?
         beq   ServiceLineFlagControlsSetBit ; b/ yes, go record
         ldab  #$20                    ; assume "go from breakpoint"
         cmpa  #ascii:bel              ; Go from breakpoint ?
         beq   ServiceLineFlagControlsSetBit ; b/ yes, go record
         ldab  #$10                    ; assume "Trace" mode toggle
         cmpa  #ascii:dc4              ; Trace request ?
         beq   ServiceLineFlagControlsSetBit ; b/ yes, go record
         rts                           ; don't recognize --> leave Z bit reset

ServiceLineFlagControlsSetBit   ; record debug bit in line flags byte
         orab  $f0                     ; combine bits with line flags byte
         stab  $f0
         clra                          ; set Z bit as promised
         rts
         page
CRTWriteANotLast        ; not last byte in buffer
         bsr   CRTWriteAByte           ; Write Ascii byte to CRT
CRTWriteA         ; Device WRITEA
; Implements SYSCALL:WRITEA.  ASCII:FF clears CRT display.  ASCII:CR
; gets free ASCII:LF appended.  ASCII:BELL causes <beep> sound.
         jsr   FetchWriteBufferByte    ; get byte to give to CRT
         bne   CRTWriteANotLast        ; b/ not last byte in buffer
CRTWriteAByte   ; Write (A) to CRT as ASCII byte
         ldx   dcbpointer              ; which dcb to adjust
         anda  #Ascii:Mask             ; get rid of garbage bit
         cmpa  #Ascii:space            ; a control character ?
         bhs   CRTWritePrintingCharacter ; b/ no
         cmpa  #Ascii:CR               ; end of line ?
         beq   CRTWriteCR              ; b/ yes
         cmpa  #Ascii:Bel              ; "RING BELL" ?
         beq   CRTWriteBell            ; b/ yes
         cmpa  #Ascii:FF               ; Clear Screen ?
         bne   CRTWriteA               ; b/ no, surpress the character
CRTWriteFF      ; clear the screen
         clr   dcb:column,x            ; set column count to zero
CRTClearScreen  ; erase CRT screen
         ldx   #2*CCol+Video           ; initialize pointer to next line
         stx   CRTNextLinePointer
         ldx   #Video                  ; initialize pointer to current line
         stx   CRTLineFillPointer      ; where to put next printing character
CRTClearRestOfScreen    ; from (X) to top of video display area
         ldaa  #ascii:space            ; blank fill the screen
CRTClearScreenLoop
         staa  0,x                     ; zap two bytes at once...
         staa  1,x                     ; for speed
         inx
         inx
         cpx   #2*CCol*CRow+Video      ; screen filled ?
         bne   CRTClearScreenLoop      ; b/ no
         okrts
         page
CRTWriteCR      ; put end of line on screen
         clr   dcb:column,x            ; set column count to zero
CRTNewLine      ; move cursor to next line, scroll if necessary
         ldx   CRTNextLinePointer      ; on bottom line of screen ?
         cpx   #2*CCol*CRow+Video      ; ...?
         beq   CRTScroll               ; b/ yes, scroll screen
         ldaa  CRTNextLinePointer      ; determine next line after this
         ldab  CRTNextLinePointer+1
         staa  CRTLineFillPointer      ; make current line start...
         stab  CRTLineFillPointer+1    ; where NextLine used to be
         addb  #2*CCol
         adca  #0
         staa  CRTNextLinePointer
         stab  CRTNextLinePointer+1
         okrts

CRTScroll       ; Scroll CRT screen up one physical line
         ldx   #Video                  ; where to start scrolling
CRTScrollLoop
         ldaa  2*CCol,x                ; fetch pair to shuffle up
         ldab  2*CCol+1,x              ; (do two at once for speed)
         staa  0,x                     ; and shuffle them up
         staa  1,x
         inx
         inx
         cpx   #2*CCol*(CRow-1)+Video  ; shuffled up 23 lines ?
         bne   CRTScrollLoop           ; b/ no, shuffle some more
         stx   CRTLineFillPointer      ; make current line start on last line
         bra   CRTClearRestOfScreen    ; blank out last line of screen

CRTWritePrintingCharacter       ; (A) contains a printing character
         inc   dcb:column,x            ; bump column count
         ; Assert: Application program will not write 256 character w/o CR!
CRTPutChar      ; put printing character on CRT screen
         ldx   CRTLineFillPointer      ; put printing character onto screen
         staa  0,x
         inx                           ; advance pointer
         stx   CRTLineFillPointer
         cpx   CRTNextLinePointer      ; is line full ?
         beq   CRTNewLine              ; b/ yes, move to new line
         okrts                         ; no, exit

CRTWriteBell    ; sound <beep>
; ? I don't know how to do this
         okrts
         page
ConsoleControlSetCursor ; User wants to position cursor
         ldaa  2,x                     ; fetch desired row
         ldab  3,x                     ; fetch desired column
         ldx   dcbpointer              ; update logical cursor position
         stab  dcb:column,x
CRTSetCursor    ; Set Cursor to Row (A), Column (B)
         cmpa  #CRow                   ; illegal row spec ?
         bhs   CRTSetCursorRts         ; b/ yes, ignore
         cmpa  #CCol                   ; illegal column number ?
         bhs   CRTSetCursorRts         ; b/ yes, ignore
         aslb                          ; double column number for 2 bytes/char
         stab  tempb                   ; save column number
         tab                           ; save row number momentarily
         asla                          ; = row number * 2 (<48)
         asla                          ; = row number * 4 (<96)
         aba                           ; = row number * 5 (<120)
         asla                          ; = row number * 10 (<240)
         tab                           ; extend to 16 bits
         clra
         rolb
         asla                          ; (D) = row number * 20
         rolb
         asla                          ; (D) = row number * 40
         rolb
         aslb
         rola                          ; (D) = row numer * 80
         rolb                          ; account for 2 chars/row
         asla                          ; 2 bytes per logical column needed
         addb  #(Video+2*CCol)/256     ; compute pointer to Next Line
         adca  #(Video+2*CCol)\256
         staa  CRTNextLinePointer
         stab  CRTNextLinePointer+1
         subb  #2*CCol/256             ; find out where cursor is
         sbca  #2*CCol\256
         addb  Tempb
         adca  #0
         staa  CRTLineFillPointer
         stab  CRTLineFillPointer+1
CRTSetCursorRts ; Cursor position is set
         okrts
         page
ConsoleControl    ; Device CONTROL operation
; Implements various SYSCALL:CONTROL operations on CRT/Keyboard.
; CC:POSITION is implemented to provide cursor positioning.
; Subcodes $FF used to set a big pixel.
;          $FE used to reset a big pixel.
;          $FD draws a line segment.
;          $FC erases a line segment. (not implemented)
; Other CC: subcodes are not implemented.
         ldx   SyscallBlock            ; determine CC: subcode
         ldaa  scblk:params+1,x
         ldx   WriteBuffer             ; get pointer to cursor position bytes
         cmpa  #cc:position            ; cursor positioning request ?
         beq   ConsoleControlSetCursor ; b/ yes, go service
         cmpa  #$FF                    ; set big pixels ?
         beq   ConsoleControlSetBigPixel ; b/ yes
         cmpa  #$FE                    ; reset big pixels ?
         beq   ConsoleControlResetBigPixel ; b/ yes
         cmpa  #$FD                    ; draw line segment ?
         beq   ConsoleControlDrawLine  ; b/ yes
;        cmpa  #$FC                    ; erase line segment ?
;        beq   ConsoleControlEraseLine ; b/ yes
         jmp   NotImplemented          ; Don't recognize control call made

ConsoleControlDrawLine  ; draw line from start (x1,y1) @ 0,x and 1,x
; to end (x2,y2) @ 2,x and 3,x
         jmp   DrawLine

;ConsoleControlEraseLine ; erase line from start (x1,y1) @ 0,x and 1,x
; to end (x2,y2) @ 2,x and 3,x
;        jmp   NotImplemented

ConsoleControlSetBigPixel ; set pixel specified by syscall write buffer
        jsr     FindWriteBufferPixel   ; addr. -> (x); bit pos. -> (a); & pixel state -> (b)
        ; note: illegal pixel causes 0 to be returned in (A), (X) -> Video
        ; --> writing in illegal pixels will have no effect
        oraa    x                      ; combine pixels
        staa    x                      ; store modified graphic byte
        okrts

ConsoleControlResetBigPixel ; clear pixel specified by syscall write buffer
        jsr     FindWriteBufferPixel   ; addr. -> (x); bit pos. -> (a); & pixel state -> (b)
        coma                           ; flip mask
        anda    x                      ; to reset a bit
        staa    x                      ; store modified graphic byte
        okrts

ConsoleControlTestBigPixel ; determine state of pixel specified by syscall write buffer
        jsr     FindWriteBufferPixel   ; addr. -> (x); bit pos. -> (a); & pixel state -> (b)
        anda    x                      ; pixel status -> (a)
        jmp     StoreLastReplyByte
         page
ConsoleStatus     ; Device STATUS request
; Implements various SYSCALL:STATUS operations on CRT.
; SC:GETCOL returns horizontal cursor position.
; SC:GETLINEFLAGS checks the keyboard for various debugging keys
; Subcode $FF returns 0 if keyboard has no data, else returns keystroke
; Other SC: subcodes are not implemented
         ldx   SyscallBlock            ; determine SC: subcode
         ldaa  scblk:params+1,x
         cmpa  #sc:getlineflags        ; RTP asking for line flags ?
         beq   ConsoleStatusGetLineFlags ; b/ yes, go service
         cmpa  #sc:getcol              ; request for current column number ?
         beq   ConsoleStatusGetColumnCount ; b/ yes, go service
         cmpa  #$FF                    ; get keystroke request ?
         beq   ConsoleStatusGetKeyStroke ; b/ yes, go service
         jmp   NotImplemented         ; Don't recognize status call made

ConsoleStatusGetLineFlags       ; RTP issues this request periodically
; we use request as opportunity to check keyboard for Debug keystroke
; Control-T (trace), Control-B (Breakpoint), Control-V (Single step),
; Control-G (GO) and ESCAPE, and updates the line flags byte in $F0.
         ldaa  ac1csr                  ; (4~) character arrive ?
         bita  #rdrf                   ; (2~) ...?
         beq   DebugRequestServiced    ; b/ no, do nothing
         ldaa  ac1trr                  ; get keystroke from operator
         ; ?? perhaps we need to mask parity off here
         jsr   ServiceLineFlagControls ; adjust line flags byte if debug
         ; Line flags byte has been updated. Cheat and claim we
         ; don't implement this function, so we don't have to go thru
         ; the trouble to return the contents of $F0 (the RTP will look
         ; there automatically after it hears our complaint)
DebugRequestServiced    ; operator debug request has been serviced
         jmp   NotImplemented          ; cheat: BASIC RTP knows what to do!

ConsoleStatusGetColumnCount
SyscallStatusGetColumnCount
SerialStatusGetColumnCount
         ldx   dcbpointer              ; get dcb address
         ldaa  dcb:column,x            ; get column number
StoreLastReplyByte      ; (A) contains last byte to return in reply buffer
         jsr   StoreReplyBufferByte    ; save in reply buffer
         jmp   SyscallExitSetReplyCount ; and exit with result

ConsoleStatusGetKeyStroke       ; b/ yes, go service
         ldaa  ac1csr                  ; (4~) character arrive ?
         anda  #rdrf                   ; (2~) ...?
         beq   StoreLastReplyByte      ; b/ no, return zero
         jsr   GetSerialByte           ; get keystroke from operator
         jsr   ServiceLineFlagControls ; adjust line flags byte if debug
         bra   StoreLastReplyByte      ; and save resulting keystroke
         page
SerialControl     ; Device CONTROL operation
; Implements SYSCALL:CONTROL on serial port selected by DCBPOINTER
; No CC: subcodes are implemented.
         jmp   NotImplemented

SerialStatus      ; Device STATUS request
; Implements SYSCALL:STATUS on disk file selected by DCBPOINTER
; SC:GETCOL returns current column number.
; SC:GETBUFFERCOUNT returns 1 if new data has arrived.
; Other SC: subcodes are not implemented.
         ldx   SyscallBlock            ; determine SC: subcode
         ldaa  scblk:params+1,x
         cmpa  #sc:getcol              ; request for current column number ?
         beq   SerialStatusGetColumnCount ; b/ yes, go service
         cmpa  #SC:GETBUFFERCOUNT      ; determine if any data present ?
         beq   SerialGetBufferCount    ; b/ yes, go service
         jmp   NotImplemented          ; Don't recognize status call made

SerialGetBufferCount    ; see if any data has arrived
         ldx   dcbpointer              ; determine which ACIA to test
         ldx   dcb:portaddress,x
         ldaa  0,x                     ; (4~) character arrive ?
         anda  #rdrf                   ; (2~) ...?
         beq   SerialGetBufferCountA   ; b/ no, return "0" as buffer size
         ldaa  #1                      ; yes, signal "1" character ready
SerialGetBufferCountA   ; (A) has available buffer count
         jmp   StoreLastReplyByte      ; record (A) as reply and exit
         page
SerialWriteANotLast     ; not last byte in buffer
         bsr   SerialWriteAByte        ; Write Ascii byte to serial device
SerialWriteA      ; Device WRITEA
; Implements SYSCALL:WRITEA on serial port selected by DCBPOINTER
; ASCII:FF is transmitted unchanged, the CTS line must be connected to
; the printer so that appropriate delays are correctly honored.
; ASCII:CR gets free ASCII:LF appended.  ASCII:BELL is transmitted
; unchanged.  Other control characters cause undefined effects.
         jsr   FetchWriteBufferByte    ; get byte to give to CRT
         bne   SerialWriteANotLast     ; b/ not last byte in buffer
SerialWriteAByte        ; Write (A) to Serial port as ASCII byte
         ldx   dcbpointer              ; which dcb to adjust
         anda  #Ascii:Mask             ; get rid of garbage bit
         cmpa  #Ascii:space            ; a control character ?
         bhs   SerialWriteAPrintingCharacter ; b/ no
         cmpa  #Ascii:CR               ; end of line ?
         beq   SerialWriteACR          ; b/ yes
         cmpa  #Ascii:Bel              ; "RING BELL" ?
         beq   SerialWriteABell        ; b/ yes
         cmpa  #Ascii:FF               ; Clear Screen ?
         bne   SerialWriteA            ; b/ no, surpress the character
SerialWriteAFF  ; clear the screen
         clr   dcb:column,x            ; set column count to zero
SerialWriteABell        ; send (A) to device, don't change column count
         bra   PutSerialByte           ; send character to serial port

SerialWriteACR  ; put end of line on device
         clr   dcb:column,x            ; set column count to zero
         bsr   PutSerialByte           ; send ASCII:CR to serial port
         ldaa  #ascii:lf               ; after ASCII:CR get free ASCII:LF
         bra   PutSerialByte

SerialWriteAPrintingCharacter   ; (A) holds printing character
         inc   dcb:column,x            ; revise column count for printing char
;        bra   PutSerialByte           ; and send character to device
         page
PutSerialByte   ; send character (A) to ACIA specified by DCBPOINTER
         ldx   dcbpointer              ; fetch ACIA address
         ldx   dcb:portaddress,x
         ldab  #tdre                   ; get "transmitter data register empty" mask
PutSerialByteLoop       ; hang waiting for transmitter data register empty
         bitb  1,x                     ; is room available yet ?
         beq   PutSerialByteLoop       ; b/ no, wait for room
         staa  0,x                     ; store character to transmit
         okrts

SerialWriteBNotLast     ; not last byte in buffer
         bsr   SerialWriteBByte        ; Write binary byte to serial device
SerialWriteB      ; Device WRITEB
; Implements SYSCALL:WRITEB on serial port selected by DCBPOINTER
; Bytes are sent to device as-is.
         jsr   FetchWriteBufferByte    ; get byte to give to CRT
         bne   SerialWriteBNotLast     ; b/ not last byte in buffer
SerialWriteBByte        ; Write (A) to Serial port as binary byte
         ldx   dcbpointer              ; which dcb to adjust
         clr   dcb:column,x            ; zap the column counter
         bra   PutSerialByte           ; send character to serial port
         page
SerialReadA       ; Device READA
; Implements SYSCALL:READA on serial port selected by DCBPOINTER
; No echo is given, nor is input editing allowed.
; Assert: Reply data buffer is if length > 0
         bsr   GetSerialByte           ; get keystroke from operator
         jsr   StoreReplyBufferByte    ; store the character
         beq   SerialReadADone         ; b/ buffer is filled
         cmpa  #ascii:cr               ; end of line ?
         bne   SerialReadA             ; b/ no
         bsr   GetSerialByte           ; yes, eat trailing LineFeed
SerialReadADone ; b/ buffer is filled
         jmp   SyscallExitSetReplyCount ; all done!

SerialReadB       ; Device READB
; Implements SYSCALL:READB on serial port selected by DCBPOINTER
; Allows reading of individual characters.
         bsr   GetSerialByte           ; get keystroke from operator
         jsr   StoreReplyBufferByte    ; store the character
         bne   SerialReadA             ; b/ buffer not filled yet
         jmp   SyscallExitSetReplyCount ; all done!

GetSerialByte   ; wait for character arrival from ACIA specified by DCBPOINTER
; return (A) from ACIA and acknowledge receipt of character to hardware
         ldx   dcbpointer              ; fetch ACIA address
         ldx   dcb:portaddress,x
         ldab  #rdrf                   ; get "receiver data ready flag" mask
GetSerialByteLoop       ; hang waiting for data arrival
         bitb  1,x                     ; data arrived yet ?
         beq   GetSerialByteLoop       ; b/ no, wait for data
         ldaa  0,x                     ; fetch acia data
         rts
         page
FileClose ; Device CLOSE
; Implements SYSCALL:CLOSE on disk file selected by DCBPOINTER
; Dumps buffers to corresponding disk device
         jsr   DismountDisk            ; dismount selected drive
         ldx   DCBPointer              ; drive zero ?
         ldaa  dcb:drivenumber,x
         beq   FileCloseDone           ; b/ no
         ldx   dcb:filebaselsn,x       ; yes, set FILEBASELSN to zero
         clr   0,x
         clr   1,x
         ; ?? once this is done, do we ever need to undo it?
FileCloseDone
         okrts
         page
FileReadADone   ; all done reading ascii data from disk
         jsr   SyscallExitSetReplyCount ; tell caller how many bytes read
         jsr   Error                   ; signal error
         fdb   err:activationnotinbuffer

FileReadA         ; Device READA
; Implements SYSCALL:READA in non- and line mode...
; on disk file selected by DCBPOINTER
         ldx   replybufferlength       ; any bytes left to fill ?
         beq   FileReadADone           ; b/ no, so exit
         jsr   FetchDiskSector         ; specified by file position
         ldaa  replybufferlength       ; read more bytes than left in sector ?
         bne   FileReadA1              ; b/ yes
         ldab  replybufferlength+1
         cmpb  SectorBufferRemaining
         blo   FileReadA2              ; b/ no
FileReadA1      ; ReplyBufferLength > SectorBufferRemaining
         ldab  SectorBufferRemaining   ; read only enough to end of sector
FileReadA2      ; (B) contains number of bytes to read this time
         stab  SectorBufferRemaining   ; hold max number of bytes to scan
         ldx   SectorBytePointer       ; = source address
FileReadAScanLoop       ; scan until count exhausted or non-printing character found
         ldaa  0,x                     ; fetch character from source
         inx                           ; advance pointer past character
         cmpa  #ascii:rubout           ; non-printing character or parity set?
         bhs   FileReadA4              ; b/ needs special processing
         cmpa  #ascii:space
         blo   FileReadA4              ; b/ needs special processing
         decb                          ; record acceptance in count left
         bne   FileReadAScanLoop       ; b/ still room in reply buffer
FileReadA4      ; (B) = max bytes - # bytes accepted
         tba                           ; save # bytes unprocessed
         subb  SectorBufferRemaining   ; so (B) = - # bytes accepted
         negb                          ; now (B) = # bytes accepted
         beq   FileReadASpecial        ; b/ none, skip complicated stuff
         staa  SectorBufferRemaining   ; = # bytes we haven't processed
         jsr   AdvanceFilePositionByB  ; advance file position by bytes written
         tba                           ; save byte count
         adda  dcb:column,x            ; advance byte count appropriately
         staa  dcb:column,x
         tba                           ; save byte count
         nega                          ; shrink # bytes left to read
         adda  replybufferlength+1
         staa  replybufferlength+1
         ldaa  replybufferlength
         adca  #$FF                    ; (sign extend difference)
         staa  replybufferlength
         ldx   replybuffer             ; = destination address
         stx   URegister               ; save in simulated Y register
         ldx   SectorBytePointer       ; = source address
         jsr   BlockMoveBBytes         ; move data efficiently to buffer
         stx   SectorBytePointer       ; store updated source pointer
         ldx   URegister               ; update destination pointer
         stx   replybuffer
         ; We get here after processing a block of printing characters.
         ; It must be the case that:
         ;    a) the source sector is exhausted (SectorBufferRemaining=0)
         ;    b) the destination buffer is filled (SectorBufferRemaining=0)
         ;    c) SectorBytePointer points to a non-printing character or
         ;       a character with the parity bit set
         ldab  SectorBufferRemaining   ; = # bytes we haven't processed
         beq   FileReadA               ; b/ none, go see if reply buffer full
         ldx   SectorBytePointer       ; get pointer to non-printing character
         ldaa  0,x                     ; fetch character from source
         inx                           ; accept the character
FileReadASpecial        ; (A) holds character, (X) points past funny character
         stx   SectorBytePointer       ; save pointer to next character
         ldab  #1                      ; advance file position past byte
         jsr   AdvanceFilePositionByB
         cmpa  #ascii:rubout           ; non-printing character or parity set?
         bhs   FileReadA6              ; b/ RUBOUT or parity set, ignore it
         ; assert: (A) must be < ascii:blank here
         cmpa  #ascii:cr               ; end of line ?
         bne   FileReadA6              ; b/ no, ignore character
         clr   dcb:column,x            ; yes, zero the column count
         jsr   StoreReplyBufferByte    ; save end-of-line in reply buffer
         ldx   SyscallBlock            ; READA in line mode ?
         ldaa  scblk:params+1,x        ; ...?
         bne   FileReadA6              ; b/ no, keep on collecting data
         jmp   SyscallExitSetReplyCount ; Line mode request satisfied

FileReadA6      ; get set to process next byte
         dec   SectorBufferRemaining   ; down count remaining buffer/sector
         bne   FileReadA1              ; b/ some left, go move bytes
         jmp   FileReadA               ; go see if more to read
         page
FileWriteADone  ; all done writing ascii data from disk
         okrts

FileWriteA         ; Device WRITEA
; Implements SYSCALL:WRITEA on disk file selected by DCBPOINTER
; Updates logical column counter for disk file
; The architecture of this routine and FileReadA is very similar
         ldx   writebufferlength       ; any bytes left to write ?
         beq   FileWriteADone          ; b/ no, so exit
         jsr   FetchDiskSector         ; specified by file position
         ldaa  writebufferlength       ; write more bytes than left in sector ?
         bne   FileWriteA1             ; b/ yes
         ldab  writebufferlength+1
         cmpb  SectorBufferRemaining
         blo   FileWriteA2              ; b/ no
FileWriteA1     ; WriteBufferLength > SectorBufferRemaining
         ldab  SectorBufferRemaining   ; write only enough to fill sector
FileWriteA2     ; (B) contains number of bytes to write this time
         stab  SectorBufferRemaining   ; hold max number of bytes to scan
         ldx   writebuffer             ; = source address
FileWriteAScanLoop      ; scan until count exhausted or non-printing character found
         ldaa  0,x                     ; fetch character from source
         inx                           ; advance pointer past character
         cmpa  #ascii:rubout           ; non-printing character or parity set?
         bhs   FileWriteA4             ; b/ needs special processing
         cmpa  #ascii:space
         blo   FileWriteA4             ; b/ needs special processing
         decb                          ; record acceptance in count left
         bne   FileWriteAScanLoop       ; b/ still room in write buffer
FileWriteA4     ; (B) = max bytes - # bytes accepted
         tba                           ; save # bytes unprocessed
         subb  SectorBufferRemaining   ; so (B) = - # bytes accepted
         negb                          ; now (B) = # bytes accepted
         beq   FileWriteASpecial       ; b/ none, skip complicated stuff
         staa  SectorBufferRemaining   ; = # bytes we haven't processed
         jsr   AdvanceFilePositionByB  ; advance file position by bytes written
         tba                           ; save byte count
         adda  dcb:column,x            ; advance byte count appropriately
         staa  dcb:column,x
         tba                           ; save byte count
         nega                          ; shrink # bytes left to write
         adda  writebufferlength+1
         staa  writebufferlength+1
         ldaa  writebufferlength
         adca  #$FF                    ; (sign extend difference)
         staa  writebufferlength
         ldx   SectorBytePointer       ; = destination address
         stx   URegister               ; save in simulated Y register
         ldx   writebuffer             ; = source address
         jsr   BlockMoveBBytes         ; move data efficiently to buffer
         stx   writebuffer             ; store updated source pointer
         ldx   URegister               ; update destination pointer
         stx   SectorBytePointer
         ldx   SectorDescriptorPointer ; mark sector as dirty
         ldaa  #1                      ; since we wrote on it
         staa  SectorDB:Dirty,x
         ; We get here after processing a block of printing characters.
         ; It must be the case that:
         ;    a) the source sector is exhausted (SectorBufferRemaining=0)
         ;    b) the destination buffer is filled (SectorBufferRemaining=0)
         ;    c) WriteBuffer points to a non-printing character or
         ;       a character with the parity bit set
         ldab  SectorBufferRemaining   ; = # bytes we haven't processed
         beq   FileWriteA              ; b/ none, go see if write buffer empty
FileWriteASpecial ; next write buffer character is not a printable character
         jsr   FetchWriteBufferByte    ; get character from write buffer
         cmpa  #ascii:rubout           ; non-printing character or parity set?
         bhs   FileWriteA6             ; b/ RUBOUT or parity set, ignore it
         ; assert: (A) must be < ascii:blank here
         cmpa  #ascii:cr               ; end of line ?
         bne   FileWriteA6             ; b/ no, ignore character
         ldx   SectorBytePointer       ; save byte in target sector
         staa  0,x
         inx
         stx   SectorBytePointer
         ldab  #1                      ; advance file position
         jsr   AdvanceFilePositionByB
         clr   dcb:column,x            ; end of line --> zero column count
FileWriteA6     ; get set to process next byte
         dec   SectorBufferRemaining   ; down count remaining buffer/sector
         bne   FileWriteA1             ; b/ some left, go move bytes
         jmp   FileWriteA              ; go see if more to read
         page
FileReadB         ; Device READB
; Implements SYSCALL:READB on disk file selected by DCBPOINTER
; Zeros logical column counter for disk file
         clr   dcb:column,x            ; zap the column counter
         ldx   replybufferlength       ; any bytes left to fill ?
         beq   FileReadBDone           ; b/ no, so exit
         jsr   FetchDiskSector         ; specified by file position
         ldaa  replybufferlength       ; read more bytes than left in sector ?
         bne   FileReadB1              ; b/ yes
         ldab  replybufferlength+1
         cmpb  SectorBufferRemaining
         blo   FileReadB2              ; b/ no
FileReadB1      ; ReplyBufferLength > SectorBufferRemaining
         ldab  SectorBufferRemaining   ; read only until end of sector
FileReadB2      ; (B) contains number of bytes to read this time
         bsr   AdvanceFilePositionByB  ; advance file position by bytes written
         tba                           ; save byte count
         nega                          ; shrink # bytes left to read
         adda  replybufferlength+1
         staa  replybufferlength+1
         ldaa  replybufferlength
         adca  #$FF                    ; (sign extend difference)
         staa  replybufferlength
         ldx   replybuffer             ; = destination address
         stx   URegister               ; save in simulated Y register
         ldx   SectorBytePointer       ; = source address
         bsr   BlockMoveBBytes         ; move data efficiently to buffer
         ldx   URegister               ; update destination pointer
         stx   replybuffer
         bra   FileReadB               ; go see if more to read

FileReadBDone   ; all done reading binary data to disk
         jmp   SyscallExitSetReplyCount ; tell caller how many bytes read
         page
         okrts
FileWriteB        ; Device WRITEB
; Implements SYSCALL:WRITEB on disk file selected by DCBPOINTER
; Zeros logical column counter for disk file
         clr   dcb:column,x            ; zap the column counter
         ldx   writebufferlength       ; any bytes left to write ?
         beq   FileWriteBDone          ; b/ no, so exit
         jsr   FetchDiskSector         ; specified by file position
         ldaa  writebufferlength       ; write more bytes than left in sector ?
         bne   FileWriteB1             ; b/ yes
         ldab  writebufferlength+1
         cmpb  SectorBufferRemaining
         blo   FileWriteB2             ; b/ no
FileWriteB1     ; WriteBufferLength > SectorBufferRemaining
         ldab  SectorBufferRemaining   ; write only enough to fill sector
FileWriteB2     ; (B) contains number of bytes to write this time
         bsr   AdvanceFilePositionByB  ; advance file position by bytes written
         tba                           ; save byte count
         nega                          ; shrink # bytes left to write
         adda  writebufferlength+1
         staa  writebufferlength+1
         ldaa  writebufferlength
         adca  #$FF                    ; (sign extend difference)
         staa  writebufferlength
         ldx   SectorBytePointer       ; = destination address
         stx   URegister               ; save in simulated Y register
         ldx   writebuffer             ; = source address
         bsr   BlockMoveBBytes         ; move data efficiently to buffer
         stx   writebuffer             ; update source pointer
         ldx   SectorDescriptorPointer ; mark sector as dirty
         ldaa  #1                      ; since we wrote in it
         staa  SectorDB:Dirty,x
         bra   FileWriteB              ; go see if more to write

FileWriteBDone  ; all done writing binary data to disk
         okrts
         page
AdvanceFilePositionByB  ; add (B) to file position
; Preserves (B), exits with (X) pointing to DCB
         pshb                          ; save byte count to adjust by
         ldx   dcbpointer
         addb  dcb:fileposition+3,x
         stab  dcb:fileposition+3,x
         bcc   AdvanceFilePositionByBRts ; b/ file position updated
         inc   dcb:fileposition+2,x    ; propogate carry
         bne   AdvanceFilePositionByBRts ; b/ file position updated
         inc   dcb:fileposition+1,x    ; propogate carry
         bne   AdvanceFilePositionByBRts ; b/ file position updated
         inc   dcb:fileposition+0,x    ; propogate carry
AdvanceFilePositionByBRts
         pulb                          ; restore (B) at time of entry
         rts



BlockMoveBBytes ; move bytes from (X) to (URegister) for (B) bytes
; Moves bytes at rate of about 23 uS/byte (twice as fast as obvious way)
; Assumes that Copy-to region does not overlap Copy-From region
; Works even if (B) is zero
; Uses page zero locations for speed; must not conflict with Basic RTP!
; Since we running with interrupts disabled, we could do this with an
; (X) register to (S) pointer shuffle.  We choose not to, for high principles.
FromPointer equ $20                    ; where to copy bytes from
Limit    equ   $22                     ; where to stop copying
URegister equ  $24                     ; where to copy bytes to
BlockMoveX equ $26                     ; holds pair of bytes
         tba                           ; save count to move
         addb  URegister+1             ; find end of Copy-To region
         stab  Limit+1
         ldab  URegister
         adcb  #0
         stab  Limit
         anda  #%00000011              ; copy one-at-a-time until multiple of 4
         beq   BlockMoveMultipleOf4    ; b/ ready to move 4 bytes at at time
BlockMoveBytesOneAtATimeLoop    ; moves bytes at rate of 43uS/byte
         ldab  0,x                     ; fetch a byte
         stx   FromPointer             ; save where to copy from
         ldx   URegister               ; where to copy to
         stab  0,x                     ; store the byte in target
         ldx   FromPointer             ; where to get next byte from
         deca                          ; down count # to copy
         bne   BlockMoveBytesOneAtATimeLoop ; b/ more to copy
BlockMoveMultipleOf4    ; must move multiple of 4 bytes
         cpx   Limit                   ; all bytes moved ?
         beq   BlockMoveDone           ; b/ yes
         page
BlockMoveMultipleOf4Loop        ; must move multiple of 4 bytes
         ldaa  2,x                     ; get 3nd and 4th bytes of 4
         ldab  3,x
         ldx   0,x                     ; get 1st and 2nd bytes of 4
         stx   BlockMoveX              ; put in holding area
         ldx   URegister               ; where to put bytes
         staa  2,x
         stab  3,x
         ldaa  BlockMoveX
         ldab  BlockMoveX+1
         staa  0,x
         stab  1,x
         ldab  URegister+1             ; advance URegister
         addb  #4
         stab  URegister+1
         bcc   *+5
         inc   URegister
         ldab  FromPointer+1           ; advance FromPointer
         addb  #4
         stab  FromPointer+1
         bcc   *+5
         inc   FromPointer
         ldx   FromPointer             ; set up pointer to next block of 4
         cpx   Limit                   ; all bytes moved ?
         bne   BlockMoveMultipleOf4Loop ; b/ no, go move some more
BlockMoveDone   ; all done, (X) points past source region
; URegister points past destination region
         rts
         page
FetchDiskSectorEOFJ
         jmp   FetchDiskSectorEOF

FetchDiskSector ; ensure that logical data sector...
; specified by file position in DCB...
; is in one of the sector buffers
; Note: this may cause several sector buffers to be written/read...
; if appropriate or efficient.  Disk I/O errors cause ?? to occur.
; No errors are propogated as result of disk I/O faults.
; If attempt to position past logical end of file, signals Err:EOFhit
;
; Returns:
;   SECTORDESCRIPTORPOINTER, pointing to sector buffer control information,
;   SECTORBYTEPOINTER pointing to byte in the sector buffer selected by file position,
;   and SECTORBUFFERREMAINING contains number of bytes left before end
;   of sector buffer reached.
         ldx   dcbpointer              ; which DCB to inspect
         ldaa  dcb:drivenumber,x       ; fetch which drive desired
         staa  DriveNumber             ; so we can find w/o damaging (X)
         ldaa  #NBPS                   ; = # bytes to end sector if filepos=0
         ldab  dcb:fileposition+3,x    ; compute SECTORBUFFERREMAINING
         andb  #(NBPS-1)               ; isn't this ingenious?
         stab  SectorBytePointer+1     ; save offset into sector of byte
         sba
         staa  SectorBufferRemaining   ; = distance to end of sector
         ldaa  dcb:fileposition+3,x    ; compute LSN offset into file
         rola                          ; save bit 7 in carry
         ldaa  dcb:fileposition+1,x    ; pick up "middle" 16 bits...
         ldab  dcb:fileposition+2,x    ; of file position
         rolb                          ; set (A,B) to bits 22-7 of filepos
         rola
         bcs   FetchDiskSectorEOFJ     ; b/ past end of file
         tst   dcb:fileposition,x      ; make sure file position is valid
         bne   FetchDiskSectorEOFJ     ; b/ past end of file
         ldx   dcb:filebaseLSN         ; get pointer to base of file
         addb  1,x                     ; add file base LSN
         adca  0,x                     ; get get LSN from start of disk
         staa  fileLSN
         stab  fileLSN+1
         ldx   SectorDBChain+SectorDB:Next ; check out sector buffers
;        jmp   FetchDiskSectorFindBufferLoop
         page
FetchDiskSectorFindBufferLoop   ; hunt for matching buffer
; (B) holds lower 8 bits of LSN of desired sector on diskette
; (X) points to a Sector Descriptor block
; Note: tests are in decreasing order of failure probability to maximize speed
         cmpb  SectorDB:LSN+1,x        ; does this sector buffer hold LSN ?
         bne   FetchDiskSectorFindNextBuffer ; b/ no, try some other buffer
         ldaa  FileLSN
         cmpa  SectorDB:LSN,x          ; does this sector buffer hold LSN ?
         bne   FetchDiskSectorFindNextBuffer ; b/ no, try some other buffer
         ldaa  DriveNumber             ; does sector buffer match desired drive?
         cmpa  SectorDB:Drive,x        ; does this sector buffer hold LSN ?
         bne   FetchDiskSectorFindNextBuffer ; b/ no, try some other buffer
         jmp   FetchDiskSectorFoundBuffer ; b/ yes! take the money and run!

FetchDiskSectorFindNextBuffer   ; this buffer doesn't contain sector, try next
         ldx   SectorDB:Next,x         ; follow pointer
         cpx   #SectorDBChain          ; at end of LRU queue ?
         bne   FetchDiskSectorFindBufferLoop ; b/ another descriptor block to check
         ; Rats. We can't find sector that we want in the queue
         ; --> we'll have to read it from the disk.  In an effor to
         ; make disk reads efficient, we will try to read TWO sectors
         ; from the disk (i.e., readahead); after all, once the one we want
         ; goes under the heads, the one after that goes under the heads almost
         ; instantly.  We would read the entire track, if we had
         ; enough memory, and had DMA and interrupts so we wouldn't have
         ; wait for the entire track read, but we don't, so we settle
         ; for two.  A complication arises: what if the readahead sector is
         ; already (unlikely, but possible) in the sector pool?
         ; We handle this by checking if it is (sigh!); if not, we read
         ; two sectors, if so, we only read one. (Try to test THAT!).
         ldx   SectorDBChain+SectorDB:Next ; check out sector buffers
         incb                          ; compute ReadAhead LSN (possible carry!)
FetchDiskSectorFindReadAheadLoop        ; hunt for matching buffer
; (B) holds lower 8 bits of LSN of desired sector on diskette
; (X) points to a Sector Descriptor block
; Note: tests are in decreasing order of failure probability to maximize speed
         cmpb  SectorDB:LSN+1,x        ; does this sector buffer hold LSN ?
         bne   FetchDiskSectorFindReadAheadNext ; b/ no, try some other buffer
         ldaa  DriveNumber             ; does sector buffer match desired drive?
         cmpa  SectorDB:Drive,x        ; does this sector buffer hold LSN ?
         bne   FetchDiskSectorFindReadAheadNext ; b/ no, try some other buffer
         ldaa  FileLSN
         tstb                          ; was there logical carry at INCB above?
         bne   *+3                     ; b/ no
         inca                          ; yes, propogate logical carry
         cmpa  SectorDB:LSN,x          ; does this sector buffer hold LSN ?
         beq   FetchDiskSectorFoundReadAhead ; b/ amazing! readahead already here
FetchDiskSectorFindReadAheadNext        ; this buffer doesn't contain sector, try next
         ldx   SectorDB:Next,x         ; follow pointer
         cpx   #SectorDBChain          ; at end of LRU queue ?
         bne   FetchDiskSectorFindReadAheadLoop ; b/ another descriptor block to check
         ; fall into next page
         page
         ; Arrival here is the normal case: Readahead is not in buffer.
         jsr   DumpTrack               ; can't find desired, make one available
         ldx   SectorDBChain+SectorDB:Prev ; pull free descriptor out of queue
         jsr   RemoveSectorDBFromLRUChain ; Remove SectorDB: selected by (X) from LRU queue
         jsr   InsertSectorDBIntoLRUChain ; and re-insert at the front
         jsr   DumpTrack               ; make a second descriptor block free
         ldx   SectorDBChain+SectorDB:Prev ; descriptor for desired sector
         ldaa  #$FF                    ; record impossible drivenumber...
         staa  SectorDB:drive,x        ; in case read fails (buffer trashed)
         ldx   SectorDB:Buffer,x       ; where to put disk sector when read
         ldaa  FileLSN                 ; which sector to fetch
         ldab  FileLSN+1
         jsr   ReadSectorDAtX          ; read sector (D) to buffer (X)
         bsr   RecordDesiredSectorInfo ; remember our success!
         ldaa  PhysicalSectorNumber    ; of FileLSN within a track
         cmpa  #NSPT                   ; end of track ?
         beq   FetchDiskSectorUseLastBuffer ; b/ yes, DON'T DO READAHEAD!
         ; because Seek time will cause us to miss a revolution --> 200ms shot
         inc   PhysicalSectorNumber    ; of FileLSN+1 == Readahead sector
         ldx   SectorDBChain+SectorDB:Next ; get addr of sector desc. used
         ldaa  #$FF                    ; record impossible drivenumber...
         staa  SectorDB:drive,x        ; in case read fails (buffer trashed)
         ldx   SectorDB:Buffer,x       ; where to readahead into
         jsr   ReadWithinTrack         ; heads haven't moved, drive still sel'd
         ldaa  FileLSN                 ; which sector we fetched
         ldab  FileLSN+1
         addb  #1                      ; compute LSN of readahead sector
         adca  #0
         ldx   SectorDBChain+SectorDB:Next ; SectorDB: to use for readahead
         bsr   RecordDesiredSectorInfoDatX ; record LSN (D) in descriptor (X)
         bra   FetchDiskSectorUseLastBuffer ; last sector buffer contains desired info

         ; if read fails on readahead, we don't really care, but
         ; the SDOSSimulator is not smart enough. Result: fatal error.
         ; if desired sector read fails, we croak: fatal error
         page
FetchDiskSectorFoundReadAhead   ; ReadAhead sector already in Buffer pool
; So we only need to fetch the sector we actually wanted.
; Our plan is simple: steal the oldest block in the pool (using DumpTrack)
; and read the desired sector into that; then we have both the desired
; sector and the readahead sector too.
; There is an incredibly slight chance that the readahead sector is actually
; (how can the world be so cruel?) the oldest sector in the pool.
; Rather than heap enormous amounts of code to make this rare case
; work perfectly, we simply proceed as planned, losing the readahead
; sector, which merely makes the improbable case slightly inefficient.
; If this cheap shot offends your sensibilities, you are welcome to fix it.
         jsr   DumpTrack               ; can't find desired, make one available
         ldx   SectorDBChain+SectorDB:Prev ; get addr of sector desc. to use
         ldaa  #$FF                    ; record impossible drivenumber...
         staa  SectorDB:drive,x        ; in case read fails (buffer trashed)
         ldx   SectorDB:Buffer,x       ; where to put disk sector when read
         jsr   ReadSectorDAtX          ; read sector (D) to buffer (X)
         ; if read fails, what do we tell OUR caller?
         bsr   RecordDesiredSectorInfo ; info in last sector descriptor
FetchDiskSectorUseLastBuffer    ; last sector buffer contains desired info
         ldx   SectorDBChain+SectorDB:Prev ; get addr of sector desc. used
FetchDiskSectorFoundBuffer      ; Sector descriptor at (X) has desired sector
         ldaa  SectorDB:Buffer,x       ; get pointer to buffer base
         ldab  SectorDB:Buffer+1,x
         addb  SectorBytePointer+1     ; compute pointer to byte in buffer
         adca  #0
         staa  SectorBytePointer
         stab  SectorBytePointer+1
         bsr   RemoveSectorDBFromLRUChain ; rip descriptor out of queue
         bsr   InsertSectorDBIntoLRUChain ; and re-insert at the front
         rts

FetchDiskSectorEOF      ; signal past end of file
         jsr   Error
         fdb   Err:EOFHit
         page
RecordDesiredSectorInfo ; in last sector descriptor
; exits wit (D) holding FileLSN
         ldx   SectorDBChain+SectorDB:Prev ; use this for sector buffer
         ldaa  FileLSN                 ; what sector to read
         ldab  FileLSN+1
RecordDesiredSectorInfoDatX     ; record LSN (D) in descriptor (X)
         staa  SectorDB:LSN,x          ; remember what sector was read
         stab  SectorDB:LSN+1,x
         psha                          ; leave (A) preserved
         ldaa  DriveNumber             ; record the drive number too
         staa  SectorDB:Drive,x
         pulb
         rts

InsertSectorDBIntoLRUChain ; Insert SectorDB: (X) into front of LRU queue
; SectorDB: at (X) must not be in LRU queue when this routine is called
; exits with (X),SectorDescriptorPointer set to value of (X) on entry
         stx   SectorDescriptorPointer
         ldx   SectorDBChain+SectorDB:Next
         ldaa  SectorDescriptorPointer
         ldab  SectorDescriptorPointer+1
         staa  SectorDB:Prev,x
         stab  SectorDB:Prev+1,x       ; (now former 1st points to new block)
         ldaa  SectorDBChain+SectorDB:Next
         ldab  SectorDBChain+SectorDB:Next+1
         staa  SectorDB:Next,x
         stab  SectorDB:Next+1,x       ; (now new block points to former 1st)
         stx   SectorDBChain+SectorDB:Next ; (now queue head points to new)
         ldaa  #SectorDBChain/256
         ldab  #SectorDBChain\256
         staa  SectorDB:Prev,x
         stab  SectorDB:Prev+1,x       ; (now new descriptor pts to queue head)
         rts

RemoveSectorDBFromLRUChain      ; Remove SectorDB: selected by (X) from LRU queue
; Returns (X), SectorDescriptorPointer pointing to SectorDB: at time of entry
; ASSERT: There is a dummy sector descriptor block that acts
; as head/tail of LRU chain.  LRU "Chain" is actually a ring.
         stx   SectorDescriptorPointer ; remember SectorDB: to remove
         ldaa  SectorDB:Next,x         ; find next Sector DB in chain
         ldab  SectorDB:Next+1,x
         ldx   SectorDB:Prev,x         ; make Prev SectorDB...
         staa  SectorDB:Next,x         ; point to Next SectorDB
         stab  SectorDB:Next+1,x
         ldx   SectorDescriptorPointer
         ldaa  SectorDB:Prev,x         ; make Next SectorDB...
         ldab  SectorDB:Prev+1,x       ; point to previous
         ldx   SectorDB:Next,x
         staa  SectorDB:Prev,x
         stab  SectorDB:Prev+1,x       ; now SectorDB is unlinked
         ldx   SectorDescriptorPointer
         rts
         page
DumpTrack ; starting at end of LRU queue, write all dirty sectors that are
; directly chained together on SectorDB:Prev link, with the same drive number,
; and that have sequentially increasing LSNs to the target disk.
; Erase the SectorDB:Dirty flags for those sectors
; On exit from DumpTrack, SectorDBChain+SectorDB:Next will point to a
; sector descriptor that has SectorDB:Dirty reset (i.e., "clean").
; A Write fault is fatal. Tough.
         ldx   SectorDBChain+SectorDB:Prev ; start with last block in queue
DumpTrackFromSectorDBatX        ; like DumpTrack, but starts scanning sector
; descriptor blocks backwards beginning with one selected by (X)
; Does not disturb SectorDescriptorPointer or DCBPointer
; *** If SECTORDB: contained DCB pointer instead of DriveNumber, the
; next 15 lines of code would not be so ugly! But it isn't. Sigh.
         ldaa  DCBPointer              ; save current DCBPointer
         ldab  DCBPointer+1
         psha
         pshb
         ldaa  SectorDB:Drive,x        ; which drive to dump to
         stx   tempx                   ; remember SectorDB: specified
         ldx   #D0DataFileDCB          ; determine DCB for sector
         staa  DumpTrackDriveNumber
         beq   DumpTrackFromSectorDB1  ; b/ DCB for drive 0
         ldx   #D1DataFileDCB          ; sector from drive 1 ?
         deca
         beq   DumpTrackFromSectorDB1  ; b/ DCB for drive 0
         ldx   #D2DataFileDCB          ; must be sector from drive 2
DumpTrackFromSectorDB1 ; (X) points to DCB for SectorDB: specified
         stx   DCBPointer
         ldx   tempx                   ; remember SectorDB: specified
         ldaa  SectorDB:Dirty,x        ; does buffer need to go to disk ?
         ; assert: we will eventually find a non-dirty SectorDB, if for no
         ; other reason than SectorDBChain has SectorDB:Dirty zeroed.
         beq   DumpTrackFromSectorDBDone ; b/ no, all through dumping
         ldaa  SectorDB:LSN,x          ; get sector number
         ldab  SectorDB:LSN+1,x
         ldx   SectorDB:Buffer,x       ; and where sector is
         jsr   WriteSectorDatX         ; put sector back on disk
         ; Note: a disk I/O operation implicitly enables disk drive
         ; gak! if no verify-after-write, this will work ok.
         ; if verify after write, this will be slow (1 write/rev)
         ; Note: hardware automatically spins down drive after 5 sec of nonuse
DumpTrackFromSectorDBLoop       ; see if next SectorDB is from same drive, LSN+1
         ldx   tempx                   ; pointer to SectorDB just dumped
         clr   SectorDB:Dirty,x        ; disk version now matches core version
         ldaa  SectorDB:LSN,x          ; get LSN of sector just dumped
         ldab  SectorDB:LSN+1,x
         ldx   SectorDB:Prev,x         ; find next candidate to dump
         addb  #1                      ; bump just-dumped LSN...
         adca  #0
         cmpb  SectorDB:LSN+1,x        ; next SectorDB in LSN increasing order?
         bne   DumpTrackFromSectorDBDone ; b/ no, done dumping
         cmpa  SectorDB:LSN,x          ; ...?
         bne   DumpTrackFromSectorDBDone ; b/ no, done dumping
         ldaa  SectorDB:Drive,x        ; from same drive ?
         cmpa  DumpTrackDriveNumber    ; ...?
         bne   DumpTrackFromSectorDBDone ; b/ no, done dumping
         ldaa  PhysicalSectorNumber    ; of sector just dumped
         cmpa  #NSPT                   ; last sector on track ?
         beq   DumpTrackFromSectorDBDone ; b/ yes, no point in trying to write
         ; because we will lose a revolution doing disk seek
         inc   PhysicalSectorNumber    ; now matches LSN of this SectorDB
         ldaa  #$FF                    ; record impossible drivenumber...
         staa  SectorDB:drive,x        ; in case write fails (buffer lost)
         stx   tempx                   ; remember address of SectorDB
         ldx   SectorDB:Buffer,x       ; get address of sector buffer
         jsr   WriteWithinTrack        ; put sector back on disk from (X)
         bra   DumpTrackFromSectorDBLoop ; see if next SectorDB is from same drive, LSN+1

DumpTrackFromSectorDBDone    ; all through dumping
         pulb                          ; restore original DCB pointer
         pula
         staa  DCBPointer
         stab  DCBPointer+1
         okrts
         page
FileControl       ; Device CONTROL operation
; Implements SYSCALL:CONTROL on disk file selected by DCBPOINTER
; CC:POSITION is implemented to provide cursor positioning.
; CC:DISMOUNT is implemented to allow diskette removal.
; CC: subcode $FF causes diskette in corresponding drive to be formatted
; CC: subcode $FE causes diskette to be duplicated.
; Other CC: subcodes are not implemented.
         ldx   SyscallBlock            ; determine CC: subcode
         ldaa  scblk:params+1,x
         ldx   WriteBuffer             ; get pointer to cursor position bytes
         cmpa  #cc:position            ; file positioning request ?
         beq   FileControlSetPosition  ; b/ yes, go service
         cmpa  #cc:dismountdisk        ; let go of a disk?
         beq   DismountDisk            ; b/ yes, go service
         cmpa  #$FF                    ; format a disk?
         beq   FormatDiskJ             ; b/ yes
         cmpa  #$FE                    ; backup diskette contents ?
         beq   BackupDiskJ             ; b/ yes
         jmp   NotImplemented          ; Don't recognize control call made

FormatDiskJ
         jmp   FormatDisk

BackupDiskJ
         jmp   BackupDisk

FileControlSetPosition  ; set diskette file position
         ldaa  0,x                     ; fetch desired file position
         ldab  1,x
         ldx   2,x
         stx   tempx
         ldx   dcbpointer              ; and save as file position
         staa  dcb:fileposition,x
         stab  dcb:fileposition+1,x
         ldaa  tempx
         ldab  tempx+1
         staa  dcb:fileposition+2,x
         stab  dcb:fileposition+3,x
         okrts                         ; all done!
         page
DismountDisk ; let go of diskette; flushes pool to disk drive
; (note: FileClose calls this, too!)
; what if disk I/O faults ??? tell operator and hang ??
         ldx   dcbpointer              ; determine which drive
         ldaa  dcb:drivenumber,x
         staa  drivenumber
         ldx   SectorDBChain+SectorDB:Prev ; make SectorDB into 1st in list
         ; scan LRU list in oldest-to-newest order, as this is most
         ; likely to be LSN increasing order on disk. Think about it.
DiskMountDiskBuffer ; dump this buffer
         ldaa  SectorDB:Drive,x        ; is buffer for drive being dismounted ?
         cmpa  drivenumber             ; ...?
         beq   DiskMountDiskNextBuffer ; b/ no
         stx   SectorDescriptorPointer ; remember where we left off
         jsr   DumpTrackFromSectorDBatX ; dump a block of sectors to disk
         ldx   SectorDescriptorPointer ; setup to finish processing SectorDB:
DiskMountDiskBufferDone   ; all done with buffer for this disk
         clr   SectorDB:Dirty,x        ; mark buffer as free
         ldaa  #$FF                    ; get impossible LSN...
         staa  SectorDB:drive,x        ; make so SectorDB can't match real LSN
; put SectorDB at END of LRU chain here, making this SectorDB most grabbable
         jsr   RemoveSectorDBfromLRUChain
         ldx   SectorDB:Next,x
         stx   tempx                   ; remember where to pick up scanning
         staa  SectorDB:Prev,x
         stab  SectorDB:Prev+1,x       ; now SectorDB is unlinked
         ldx   SectorDBChain+SectorDB:Prev ; tack SectorDB onto END of LRU chain
         ldaa  SectorDescriptorPointer
         ldab  SectorDescriptorPointer+1
         staa  SectorDB:Next,x
         stab  SectorDB:Next+1,x       ; (now former oldest points to this)
         ldx   SectorDescriptorPointer
         ldaa  SectorDBChain+SectorDB:Prev
         ldab  SectorDBChain+SectorDB:Prev+1
         staa  SectorDB:Prev,x
         stab  SectorDB:Prev+1,x       ; (now this points to former oldest)
         stx   SectorDBChain+SectorDB:Prev ; (now chain head points to this)
         ldaa  #SectorDBChain/256
         ldab  #SectorDBChain\256
         staa  SectorDB:Next,x
         stab  SectorDB:Next+1,x       ; (lastly, this points to chain head)
         ldx   tempx                   ; points to SectorDB not yet inspected
DiskMountDiskNextBuffer   ; move on to next buffer and dump it
         ldx   SectorDB:Prev,x         ; find next SectorDB
         cpx   #SectorDBChain          ; end of buffer chain ?
         bne   DiskMountDiskBuffer ; b/ no, go dump another buffer
         jsr   ReleaseDrive            ; stop motor, etc.
         okrts
         page
FileStatus        ; Device STATUS request
; Implements SYSCALL:STATUS on disk file selected by DCBPOINTER
; SC:GETCOL returns current column number.
; Other SC: subcodes are not implemented.
         ldx   SyscallBlock            ; determine SC: subcode
         ldaa  scblk:params+1,x
         cmpa  #sc:getcol              ; want column number ?
         beq   FileStatusGetColumnCount ; b/ yes, go give it to user
         jmp   NotImplemented          ; complain about bad request

FileStatusGetColumnCount
         jmp   SyscallStatusGetColumnCount
         page
* subroutine - format diskette
* Exits with Z status bit set if no errors in formatting
*
FormatDisk ; selected by DCBPointer
        ldx     DCBPointer             ; determine drive to format
        ldab    dcb:drivenumber,x
        jsr     DiskSelect             ; make the drive ready
        jsr     DiskRestore            ; puts heads on track zero
        jsr     DiskReadyWait          ; wait until disk is ready
frmtl1  jsr     DiskStatus             ; get status word
        bitb    #busy                  ; How can disk be busy ??
        bne     frmtl1                 ; loop if fdc busy
        bitb    #seeker!busy!crcerr!notrdy ; notrdy, seek, busy or crc error?
        beq     frmts1                 ; skip if no errors
        jsr     Error                  ; signal formatter failure
        fdb     Err:DiskWrite

frmts1  clr     PhysicalSectorNumber   ; init. sector # reg. = 1
        jsr     DiskStart              ; give drive start pulse
        jsr     DiskReadyWait          ; wait until drive ready
        jsr     pout                   ; setup to write to fdc
        ldab    #%11110100
        jsr     DiskCommand            ; give write track command
        ldaa    piaorb
        oraa    #da1+da0
        staa    piaorb                 ; select data reg. in fdc
        ldaa    #$ff
        ldab    #gap1
        jsr     fmtwbytes              ; write gap1
frmtl2  clra                           ; write format for one sector, loop
        ldab    #sync
        bsr     fmtwbytes              ; write i.d. sync
        ldaa    #$fe
        incb
        bsr     fmtwbytes              ; write i.d. address mark
        ldaa    PhysicalTrackNumber
        incb
        bsr     fmtwbytes              ; write track #
        clra
        incb
        bsr     fmtwbytes              ; write side # code
        inc     PhysicalSectorNumber   ; generate sector number
        ldaa    PhysicalSectorNumber
        incb
        bsr     fmtwbytes              ; write sector #
        clra
        incb
        bsr     fmtwbytes              ; write sector length code
        ldaa    #$f7
        incb
        bsr     fmtwbytes              ; write i.d. crc's
        ldaa    #$ff
        ldab    #gap2
        bsr     fmtwbytes              ; write gap2
        clra
        ldab    #sync
        bsr     fmtwbytes              ; write data sync
        ldaa    #$fb
        incb
        bsr     fmtwbytes              ; write data address mark
        ldaa    #$ff
        ldab    #nbps
        bsr     fmtwbytes              ; write data
        ldaa    #$f7
        incb
        bsr     fmtwbytes              ; write data crc's
        ldaa    #$ff
        ldab    #gap3+1
        bsr     fmtwbytes              ; write w.g. off & gap3
        ldaa    PhysicalSectorNumber   ; done writing all sectors...
        cmpa    #nspt                  ; on this track ?
        bne     frmtl2                 ; b/ no
        clra                           ; yes. write gap4
        staa    piaora                 ; setup byte
frmtl3  ; loop to write gap4 until end of track
        ldaa    piaorb
        bpl     frmtl3a                ; b/ no data request yet
        eora    #dwen                  ; data request seen
        staa    piaorb                 ; toggle strobe to write byte (we':=0)
        oraa    #dwen
        staa    piaorb                 ; we':=1
        bra     frmtl3                 ; try to write another byte

frmtl3a ; writing gap4, no data request right now
        bita    #intrq                 ; all done writing gap4 ?
        beq     frmtl3                 ; b/ no, wait for drq or an intrq
        inc     PhysicalTrackNumber    ; Track write completed.
        ldaa    PhysicalTrackNumber    ; written all tracks ?
        cmpa    #ntpd
        beq     fmatdone               ; b/ yes, get out.
        ldaa    piaorb                 ; must write another track
        anda    #\da1+da0
        staa    piaorb                 ; select status/command reg. in fdc
        ldab    #%01000011             ; "step in" command
        jsr     DiskCommand            ; tell heads to step in
        jsr     pin                    ; setup to read from fdc
        jmp     frmtl1                 ; go format another track

fmatdone ; all done formatting diskette
        jsr     DiskRestore            ; leave DCB and heads synchronized
        rts
        page
fmtwbytes ; write (A) to disk (B) times in a row
* write format bytes to disk subroutine
* ...byte to write in acc. a
* ...# times to write same byte in acc. b
* ...assumes data register selected
        coma                           ; invert data byte
        staa    piaora                 ; setup byte
fmtwbslp ; loop to write format bytes
        ldaa    piaorb                 ; wait for drq = 1
        bpl     *-2
        eora    #dwen
        staa    piaorb                 ; we' = 0; write byte
        oraa    #dwen
        staa    piaorb                 ; we' = 1
        decb                           ; more left to write ?
        bne     fmtwbslp               ; b/ yes, hop to it
        rts                            ; done
        page
PrintSourceDriveName
         bsr   PrintInlineString
         fcc   " drive "
BackupSourceDriveName
         fcc   "0"
         fcb   0
         rts

PrintDestinationDriveName
         bsr   PrintInlineString
         fcc   " drive "
BackupDestinationDriveName
         fcc   "0"
         fcb   0
PrintNewLine ; send new line to CRT screen
         bsr   PrintInlineStringLoop
         fcb   ascii:cr,0              ; end of string mark
         rts

PrintInlineStringLoop ; something to display in (A)
        jsr     CRTWriteAByte          ; make CRT display put up text character
PrintInlineString ; print string at return address until 0 byte encountered
        tsx                            ; fetch return address
        inc     1,x                    ; bump return address past next byte
        bne     PrintInlineString1
        inc     0,x
PrintInlineString1
        ldx     0,x                    ; fetch pointer to byte to print
        dex
        ldaa    0,x                    ; fetch byte to print
        bne     PrintInlineStringLoop  ; b/ something to display
        rts                            ; end of string hit
        page
BackupDisk ; Backup diskette from drive to drive
; Note: application program has requested source and destination drive numbers
; and verified that drive numbers are in range 0..2
; Application must also do a CC:DISMOUNT on all drives to ensure that
; disk buffer pool has been flushed.
; The application is destroyed by the backup process;
; when backup is complete, the MACCA overlay (1st file on Drive 0) is
; reloaded from diskette so operator has a command interpreter again.
; DCBPointer specifies source drive; WriteBuffer specifies destination drive
;       BASIC code required to cause disk backup:
;           ...
;       Dim CCBackup$/:E,4,0,:FE/
;           ...
;       INPUT "Source Drive: " SourceDrive
;       INPUT "Destination Drive: " DestinationDrive
;       Let Temp$[1]=DestinationDrive\Let len(temp$)=1
;       Syscall #SourceDrive+2,CCBackup$,Temp$ \ ! Cause backup to occur
;           ...
         jsr   BackupCheckSameDrive    ; get drive numbers
         adda  #'0                     ; convert to ascii digits
         addb  #'0
         staa  BackupSourceDriveName
         stab  BackupDestinationDriveName
         jsr   PrintInlineString       ; tell operator what is happening
         fcb   ascii:ff                ; erase the screen
         fcc   "Disk Backup in progress from "
         bsr   PrintSourceDriveName
         bsr   PrintInlineString
         fcc   " to drive "
         fcb   0
         bsr   PrintDestinationDriveName
         clr   FileLSN                 ; set 1st LSN to be copied to zero
         clr   FileLSN+1
BackupChunkLoop ; need to copy another chunk of disk
         jsr   BackupCheckSameDrive    ; set Z bit if Source and Destination drives are identical
         bne   BackupChunkRead         ; b/ not same drive, say nothing
         jsr   PrintInlineString
         fcc   "Insert Source diskette in "
         jsr   PrintSourceDriveName
         jsr   CRTWaitCharBlinkCursor  ; show cursor until key struck
         jsr   PrintNewline
BackupChunkRead ; Read chunk from source drive
         ldab  #NTPD*NSPT/3            ; copy 1/3 of disk each time
         stab  SectorCount             ; set up # sectors on which to do I/O
         ldaa  FileLSN                 ; get base of disk chunk
         ldab  FileLSN+1
         ldx   #RTP$End                ; place for almost 32kb buffer
         jsr   ReadMultipleDAtX        ; read chunk of diskette
         jsr   BackupCheckSameDrive    ; get source to (A), dest to (B)
         psha                          ; save source drive number
         stab  dcb:drivenumber,x       ; make DCB do I/O to destination drive
         jsr   BackupCheckSameDrive    ; set Z bit if Source and Destination drives are identical
         bne   BackupChunkWrite        ; b/ not same drive, say nothing
         jsr   PrintInlineString
         fcc   "Insert Destination diskette in "
         jsr   PrintSourceDriveName    ; remember? same as Destination drive!
         jsr   CRTWaitCharBlinkCursor  ; show cursor until key struck
         jsr   PrintNewline
BackupChunkWrite ; Write chunk to destination drive
         ldab  #NTPD*NSPT/3            ; copy 1/3 of disk each time
         stab  SectorCount             ; set up # sectors on which to do I/O
         ldaa  FileLSN                 ; get base of disk chunk
         ldab  FileLSN+1
         ldx   #RTP$End                ; place for almost 32kb buffer
         jsr   WriteMultipleDAtX       ; write chunk to destination drive
         jsr   BackupCheckSameDrive    ; get dest to (A), dest to (B)
         pula                          ; restore source drive number
         staa  dcb:drivenumber,x       ; make DCB do I/O to source drive
         ldaa  FileLSN                 ; get base of disk chunk
         ldab  FileLSN+1
         addb  #NTPD*NSPT/3            ; add number of sectors copied
         adca  #0
         staa  FileLSN
         stab  FileLSN+1
         cmpa  #NTPD*NSPT/256          ; done copying ?
         bhs   BackupComplete          ; b/ yes
         jmp   BackupChunkLoop         ; b/ no, go copy another chunk

BackupComplete ; diskette completely copied
         jsr   PrintInlineString
         fcc   "Disk Backup complete"
         fcb   0
         bsr   BackupCheckSameDrive    ; fetch destination drive number
         tstb                          ; drive zero used as destination ?
         bne   BackupExitJ             ; b/ no
         jsr   PrintInlineString
         fcc   "Insert System diskette into "
         fcb   0
         jsr   PrintSourceDriveName
         jsr   CRTWaitCharBlinkCursor  ; wait for operator to catch up
BackupExitJ
         jmp   ExecuteSyscallExit      ; go reload MACCA

BackupCheckSameDrive ; set Z bit if Source and Destination drives are identical
        ldx     DCBPointer             ; fetch source drive number
        ldaa    dcb:drivenumber,x
        ldx     WriteBuffer            ; determine source/destination drives
        ldab    0,x                    ; get destination drive number
        cba
        rts
        page
FindPixelBad ; illegal (off screen) pixel address specified
        ldx     #Video                 ; illegal pixel.
        clra                           ; make zero (harmless) mask
        rts

FindWriteBufferPixel ; determine pixel address/mask specified by System call
; Syscall write buffer holds pixel (x,y) address as 2 bytes.
        ldx     WriteBuffer            ; fetch pixel coordinates
;       bsr     FindPixel              ; determine pixel address
;       rts                            ; and exit

FindPixel ; calculate pixel address/mask
* subroutine - calculate video address & bit position of graphic char.
*    X coordinate is horizontal, Y vertical, with (0,0) being upper left corner
*    Returns (X) pointing to screen byte containing desired pixel.
*    Returns (A) with mask for pixel bit.
*    If pixel off screen, pointer to screen base and zero mask are returned.
*    Does not move character cursor!
*    Routine is coded for speed to allow lines of pixels to be drawn quickly
*
*    Format of screen byte pair:
*
*      7 6 5 4 3 2 1 0   7 6 5 4 3 2 1 0
*    !-----------------!-----------------!
*    ! G P P P P P P P ! P P P P P P P P !
*    !-----------------!-----------------!
*
*    G = 0 --> P bits in left byte contain Ascii "printable" character.
*              Second byte is ignored (?)
*
*    G = 1 --> P bits specify pixel in 3 column wide, 5 row high "dot" box
*
*         0  1  2
*       !---------!
*     0 ! P  P  P !
*     1 ! P  P  P !
*     2 ! P  P  P !      Dot display format
*     3 ! P  P  P !
*     4 ! P  P  P !
*     5 ! P  P  P !
*       !---------!

        ldaa    x                      ; x coordinate
        cmpa    #3*ccol                ; valid X coordinate ?
        bcc     FindPixelBad           ; b/ no
        ; fall into next page
        page
        ; Now to pull a rabbit out of my (we are speed demons, remember?)
        ; This is an unrolled loop to divide by 3 and generate 7 quotient bits
        ; This scheme is 4X as fast as original scheme which used a real loop,
        ; in a subroutine, generated 9 bits and diddled a lot with memory
        adda    #((-3)*64)&$FF         ; generate a quotient bit
        bcs     *+4
        suba    #((-3)*64)&$FF
        rola                           ; save 1st quotient bit
        adda    #((-3)*64)&$FF         ; generate a quotient bit
        bcs     *+4
        suba    #((-3)*64)&$FF
        rola                           ; save 2nd quotient bit
        adda    #((-3)*64)&$FF         ; generate a quotient bit
        bcs     *+4
        suba    #((-3)*64)&$FF
        rola                           ; save 3rd quotient bit
        adda    #((-3)*64)&$FF         ; generate a quotient bit
        bcs     *+4
        suba    #((-3)*64)&$FF
        rola                           ; save 4th quotient bit
        adda    #((-3)*64)&$FF         ; generate a quotient bit
        bcs     *+4
        suba    #((-3)*64)&$FF
        rola                           ; save 5th quotient bit
        adda    #((-3)*64)&$FF         ; generate a quotient bit
        bcs     *+4
        suba    #((-3)*64)&$FF
        rola                           ; save 6th quotient bit
        adda    #((-3)*64)&$FF         ; generate a quotient bit
        bcs     *+4
        suba    #((-3)*64)&$FF
        rola                           ; save 7th quotient bit
        rolb                           ; save most significant remainder bit
        asla                           ; shift out lsb of remainder
        rolb                           ; now (B) has remainder
        lsra                           ; and (A) has quotient
        ; End Divide-by-three
        staa    tempx+1                ; save screen column # ( = int(X/3) )
        ldaa    1,x                    ; fetch y coordinate
        cmpa    #5*crow                ; valid Y coordinate ?
        bcc     FindPixelBad           ; b/ no
        pshb                           ; save remainder of X/3 (RC)
        ; fall into next page
        page
        ; Another unrolled loop: to divide by 5 and generate 5 quotient bits
        ; This scheme is 6X as fast as original scheme which used a real loop,
        ; in a subroutine, generated 9 bits and diddled a lot with memory
        adda    #(-5)*16               ; generate a quotient bit
        bcs     *+4                    ; (original dividend < 120)
        suba    #(-5)*16
        rola                           ; save 1st quotient bit
        adda    #(-5)*16               ; generate a quotient bit
        bcs     *+4                    ; (original dividend < 120)
        suba    #(-5)*16
        rola                           ; save 2nd quotient bit
        adda    #(-5)*16               ; generate a quotient bit
        bcs     *+4                    ; (original dividend < 120)
        suba    #(-5)*16
        rola                           ; save 3rd quotient bit
        adda    #(-5)*16               ; generate a quotient bit
        bcs     *+4                    ; (original dividend < 120)
        suba    #(-5)*16
        rola                           ; save 4th quotient bit
        adda    #(-5)*16               ; generate a quotient bit
        bcs     *+4                    ; (original dividend < 120)
        suba    #(-5)*16
        tab                            ; save remainder in (B)
        rola                           ; save 5th quotient bit
        anda    #%00011111             ; so (A) has only the quotient
        lsrb                           ; right normalize binary point...
        lsrb                           ; of remainder
        lsrb
        lsrb                           ; now (B) has row remainder
        ; end of divide by 5
        ; fall into next page
        page
        ; compute address of screen byte containing desired pixel
        pshb                           ; save row remainder
        tab                            ; save row number
        aslb                           ; row # * 2 (<48)
        aslb                           ; row # * 4 (<96)
        aba                            ; row # * 5 (<120)
        asla                           ; row # * 10 (<240)
        tab                            ; convert to 16 bit quantity
        clra
        aslb
        rola                           ; row # * 20
        aslb
        rola                           ; row # * 40
        aslb
        rola                           ; row # * 80
        addb   tempx+1                 ; row # * 80 + column number
        adca   #(video/2)/256          ; add base address of video ram
        aslb                           ; double one last time...
        rola                           ; because 2 bytes per screen character
        staa   tempx                   ; move to (X)
        stab   tempx+1
        ldx    tempx
        ldaa    x                      ; Graphic character already present ?
        bmi     FindPixelGraphicPresent ; b/ yes, leave byte alone
        ldaa    #b7                    ; no, convert to graphic character
; why not clear screen to graphic charcter blanks, and only allow graphics
; where a graphic blank already exists ?  Then there would be no need
; to change display byte to graphic format at all.
        staa    x                      ; by setting MSB
        clr     1,x                    ; and leaving other bits reset
FindPixelGraphicPresent ; (X) points to graphics byte pair
        pula                           ; Row Remainder -> (a)
        tab                            ; ...& (B)
        aslb                           ; 2*Row Remainder
        aba                            ; 3*Row Remainder -> (a)
        pulb                           ; Column Remainder -> (b)
        aba                            ; 3*RR+CR -> (a) = bit pos. [0..14]
        cmpa    #7                     ; left or right byte of pixel byte pair?
        bhi     *+3                    ; b/ left byte, (X) already points there
        inx                            ; make (X) point to right byte
        ; fall into next page
        page
        ; convert least significant 3 bits of (A) to 2**(A)
        lsra                           ; convert (A) to bit mask as fast as can
        bcs     FindPixel0S            ; b/ (A) had bit 0 set
        lsra
        bcs     FindPixel0R1S
        lsra
        bcs     FindPixel0R1R2S
        ldaa    #%00000001
        rts

FindPixel0R1R2S
        ldaa    #%00010000
        rts

FindPixel0R1S ; (A) had bit 0 reset, bit 1 set
        lsra
        bcs     FindPixel0R1S2S
        ldaa    #%00000100
        rts

FindPixel0R1S2S
        ldaa    #%01000000
        rts

FindPixel0S ; (A) had bit 0 set
        lsra
        bcs     FindPixel0S1S
        lsra
        bcs     FindPixel0S1R2S
        ldaa    #%00000010
        rts

FindPixel0S1R2S
        ldaa    #%00100000
        rts

FindPixel0S1S
        lsra
        bcs     FindPixel0S1S2S
        ldaa    #%00001000
        rts

FindPixel0S1S2S
        ldaa    #%10000000
        rts
        page
DrawLine ; called to draw line between two points
; Uses Symmetric DDA technique
; (see "Principles Of Interactive Computer Graphics" Newmann/Sproull)
; Replaced algorithm that compute slope by actually performing divide;
; algorithm was unsafe because endpoint check assumed that no precision
; was lost in divide, which almost always loses precision.
; To draw proper line, X and Y must be rounded.  This gives us 1/2 unit
; error.  If we were to draw a line of 128 units in one direction, the
; error in the quotient would add up to another 1/2 unit, and we would
; be off by one on the end point check. Result: infinite loop.
; To do computation with quotient, must keep 9 bits of quotient, which
; makes the arithmetic really ugly.
; The DDA technique used here ensures that final point generated exactly
; equals the end point specified.
        ldx     WriteBuffer            ; fetch data to operate on
        ldaa    0,x                    ; = starting X coordinate
        ldab    1,x                    ; = starting Y coordinate
        staa    XCoordinate
        stab    YCoordinate
        ldaa    #$7F                   ; set XFraction to .499999+
        staa    XFraction              ; cheap trick to avoid rounding
        stab    YFraction
        ldaa    2,x                    ; = ending X coordinate
        ldab    3,x                    ; = ending Y coordinate
        staa    XEndCoordinate
        stab    YEndCoordinate
        clr     XDeltaSign             ; assume sign of X delta = positive
        suba    XCoordinate            ; compute X delta, sign -> Carry bit
        bcc     DrawLine1              ; b/ sign of X delta is positive
        dec     XDeltaSign             ; set sign of X delta negative
        nega                           ; take absolute value of XDelta
DrawLine1 ; sign of X delta is set properly
        clr     YDeltaSign             ; assume sign of Y delta = positive
        subb    YCoordinate            ; compute Y delta
        bcc     DrawLine2              ; b/ sign of Y delta is positive
        dec     YDeltaSign             ; set sign of Y delta negative
        negb                           ; take absolute value of YDelta
DrawLine2 ; sign of Y delta is set properly
        cba                            ; same deltas?
        bne     DrawLineNormalize      ; b/ no
        ldaa    #$40                   ; set deltas to nonzero value
        ldab    #$40                   ; (dual zero deltas won't normalize)
        ; fall into next page
        page
; Now we normalize XDelta and YDelta by left shifting both together
; (thus preserving their ratio, i.e., preserving the slope of the line)
; until significance shifted out the top of register holding X/YDelta
; i.e., we get unit step in X or Y direction (Symmetric DDA)
DrawLineNormalize ; normalize X and Y deltas
        asla                           ; shift bit out of X delta
        bcs     DrawLineXOvernormalized ; b/ shifting too far, time to stop
        aslb                           ; shift bit out of Y delta
        bcc     DrawLineNormalize      ; b/ more normalization needed
        rorb                           ; overnormalized, restore to normalized
DrawLineXOvernormalized ; shifted too far, time to stop
        rora                           ; restore (X) to normalized form
DrawLineNormalized ; Normalization process complete
        tst     XDeltaSign             ; is X delta negative ?
        bpl     DrawLine3              ; b/ no, leave it alone
        nega                           ; yes, make negative
DrawLine3 ; (A) is normalized, signed value
        tst     YDeltaSign             ; is Y delta negative ?
        bpl     DrawLine4              ; b/ no, leave alone
        negb                           ; yes, make negative
DrawLine4 ; (B) is normalized, signed value
; Now, we could be a little more efficient if we discovered that the larger
; of the two normalized deltas was $80: then we could shift left one more
; time (handling sign complications that occur with negative deltas), and
; thus assuring that a new X or Y coordinate is generated on EVERY pass
; thru the loop.  I deemed all this trouble not worth the code.
        staa    XDelta                 ; save appropriately signed deltas
        stab    YDelta
        ; fall into next page
        page
DrawLineLoop ; loop back here to generate another line point
        ldaa    XCoordinate            ; see if at endpoint
        ldab    YCoordinate
        cmpa    XEndCoordinate         ; ...?
        bne     DrawLineShowPoint      ; b/ no, show current point
        cmpb    YEndCoordinate         ; ... ?
        beq     DrawLineDone           ; b/ yes, all done
DrawLineShowPoint ; show current point
        jsr     FindPixel              ; so we can set it
        orab    ,x                     ; combine existing and new pixels
        stab    ,x
        ldaa    XCoordinate            ; generate next point on line
        ldab    XFraction
        addb    XDelta
        adca    XDeltaSign
        staa    XCoordinate
        stab    XFraction
        ldaa    YCoordinate
        ldab    YFraction
        addb    YDelta
        adca    YDeltaSign
        staa    YCoordinate
        stab    YFraction
        bra     DrawLineLoop

DrawLineDone
        okrts
        page
        if      0                      ; save for rainy day
* subroutine - divide (a) by (b) [fractional result]
* ...on return (a) = whole part [0 or 1] and (b) = fractional part
* ...if msb = 1 then lsb = 0 also
* ...if lsb not = 0 then msb = 0
        spc     1
divbaf  tsta
        beq     dbafr0  if (a) = 0, force results = 0 and return
        cba
        beq     dbafr1  if (a) = (b), force results = 1 and return
        clr     acc     init. acc
        clr     acc+1
        psha    save    (a) temp.
        ldaa    #8+1
        staa    trycnt  init. loop control reg.
        pula    restore (a)
dbaflp  tst     acc
        bne     dbafsb  subtract if msb = 1
        cba
        bcs     dbafsk  skip if can't subtract
dbafsb  sba
        clr     acc     msb = 0
        sec     prepare to rotate a "1" into acc.
        fcb     $85     skip next instruction
dbafsk  clc     prepare to rotate a "0" into acc.
        rol     acc+1   adj. (acc) for next subtract try & form answer
        rola
        rol     acc
        dec     trycnt
        bne     dbaflp  done? no. continue
        anda    #b0     yes. drop remainder
        ldab    acc+1
        rts             return
dbafr0  clra            force answer = 0
        clrb
        rts
dbafr1  ldaa    #1      force answer = 1
        clrb
        rts
        fin
        page
MAKE4$  ; assembly language string function to generate 4 byte string of FNUM
; form:     ...MAKE4$(expression)...
; Returns string descriptor for 4 byte string carrying value of expression
; This routine has a jump table entry point so that BASIC programs
; need not be recompiled if the SDOSSimulator is changed
         ldx   4,x                     ; get address of argument
         jsr   RTP$FLoad               ; load number as if floating point
         tsx                           ; is number truly floating point ?
         ldaa  0,x                     ; get exponent byte
         bne   Make4.1                 ; b/ yes, leave it alone
         jsr   RTP$Float               ; convert number to floating point
Make4.1 ; number on top of stack is now in FP format
         ldx   #Make4Buffer            ; where to stuff result
         jsr   RTP$FStore              ; save result
         ; Each of the mantissa bytes of the floating point number
         ; has only 7 data bits in it.  We will mash all the bytes together
         ; to keep max precision in a total of 4 bytes.
         ; FP number has following form after store:
         ;         ; xxxxxxxx 0aaaaaaa 0bbbbbbb 0ccccccc 0ddddddd 0eeeeeee
         asl   4,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb 0ccccccc ddddddd0 0eeeeeee
         asl   4,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb 0ccccccc d dddddd00 0eeeeeee
         rol   3,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb cccccccd dddddd00 0eeeeeee
         asl   4,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb cccccccd d ddddd000 0eeeeeee
         rol   3,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb c ccccccdd ddddd000 0eeeeeee
         rol   2,x ; xxxxxxxx 0aaaaaaa bbbbbbbc ccccccdd ddddd000 0eeeeeee
         asl   4,x ; xxxxxxxx 0aaaaaaa bbbbbbbc ccccccdd d dddd0000 0eeeeeee
         rol   3,x ; xxxxxxxx 0aaaaaaa bbbbbbbc c cccccddd dddd0000 0eeeeeee
         rol   2,x ; xxxxxxxx 0aaaaaaa b bbbbbbcc cccccddd dddd0000 0eeeeeee
         rol   1,x ; xxxxxxxx aaaaaaab bbbbbbcc cccccddd dddd0000 0eeeeeee
         ldaa  #(Make4Buffer-4)/256    ; form string descriptor on top of stack
         ldab  #(Make4Buffer-4)\256
         pshb                          ; push pointer to string head
         psha
         clra
         ldab  #4
         pshb                          ; push string length of 4
         psha
         des                           ; push garbage for string tag
         des
         okrts                         ; and return to caller
         page
FLOAT4 ; assembly language numeric function to generate value from string
; form:     ...FLOAT4(string$)...
; Returns 6 byte floating point value matching value given to MAKE4$,
; i.e., FLOAT4(MAKE4$(exp)) = exp except for truncation issues
         ldx   4,x                     ; fetch pointer to string head
         clra                          ; zero bottom two bytes of result
         psha
         psha
         ldaa  4+(4-1),x               ; fetch 4th byte of string
         psha                          ; push into stack
         ldaa  4+(3-1),x               ; fetch 3rd byte of string
         psha                          ; push into stack
         ldaa  4+(2-1),x               ; fetch 2nd byte of string
         psha                          ; push into stack
         ldaa  4+(1-1),x               ; fetch 1st byte of string
         tsx                           ; make (X) point to 6 byte number
; this pack/unpack process retains 100/128*24 bits ~~ 19 bits of precision
         ; we need to unpack 4 byte of significance into 6 bytes
         ; (X) points to 6 byte region with following format:
         ;           xxxxxxxx aaaaaaab bbbbbbcc cccccddd 00000000 00000000
         lsr   1,x ; xxxxxxxx 0aaaaaaa b bbbbbbcc cccccddd 00000000 00000000
         ror   2,x ; xxxxxxxx 0aaaaaaa bbbbbbbc c cccccddd 00000000 00000000
         ror   3,x ; xxxxxxxx 0aaaaaaa bbbbbbbc ccccccdd d 00000000 00000000
         ror   4,x ; xxxxxxxx 0aaaaaaa bbbbbbbc ccccccdd d0000000 00000000
         lsr   2,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb c ccccccdd d0000000 00000000
         ror   3,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb cccccccd d d0000000 00000000
         ror   4,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb cccccccd dd000000 00000000
         lsr   3,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb 0ccccccc d dd000000 00000000
         ror   4,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb 0ccccccc ddd00000 00000000
         lsr   4,x ; xxxxxxxx 0aaaaaaa 0bbbbbbb 0ccccccc 0ddddddd 00000000
         okrts                         ; done: top of stack holds result
         page
SDOSSimulatorLocationCounter set *     ; since we are changing ORG's

         org   $106                    ; place for working variables
Make4Buffer rmb 6                      ; room for 6 byte F.P. number

ScratchBuffer  rmb 4                   ; place safe to trash at any time
LastError      rmb 2                   ; holds last SDOS-like error encountered
SyscallStack   rmb 2                   ; holds S register contents on Sim entry
SyscallBlock   rmb 2                   ; holds X register content on Sim entry
WriteBuffer    rmb 2                   ; points to unused part of SCBLK:WRBUF
WriteBufferLength rmb 2                ; amount of SCBLK:WRBUF not yet used
ReplyBuffer    rmb 2                   ; points to next unfilled part of SCBLK:RDBUF
ReplyBufferLength rmb 2                ; amount of SCBLK:RDBUF unfilled
ReplyCount     rmb 2                   ; number of bytes placed in SCBLK:RDBUF

DCBpointer     rmb 2                   ; points to Device Control block selected

CRTLineFillPointer rmb 2               ; points to where to put next Video byte
CRTNextLinePointer rmb 2               ; points to end of Video RAM for this li

FileLSN        rmb 2                   ; Holds starting LSN of disk file
SectorBufferRemaining rmb 1            ; holds # bytes unprocessed in sector buffer
SectorBytePointer rmb 1                ; points to next unprocessed byte
SectorDescriptorPointer rmb 2          ; points to descriptor for current sector
SectorBuffer rmb 2                     ; location for disk sector I/O
PhysicalSectorNumber rmb 1             ; Sector-within-track
PhysicalTrackNumber rmb 1              ; Desired track number
SectorCount rmb 1                      ; holds number of sectors desired
trycnt   rmb 1                         ; Disk I/O read/write try counter
DriveNumber rmb 1                      ; holds FetchSector desired drive number
DumpTrackDriveNumber rmb 1             ; holds DumpSector actual drive number

; Working storage for DrawLine
XCoordinate rmb 1                      ; X axis units accumulator
XFraction rmb  1                       ; partial unit step accumulator
XDelta   rmb   1                       ; normalized delta of start,end point
XDeltaSign rmb 1                       ; holds sign of YDelta
XEndCoordinate rmb 1                   ; point at which line stops
YCoordinate rmb 1                      ; Y axis units accumulator
YFraction rmb  1                       ; partial unit step accumulator
YDelta   rmb   1                       ; normalized delta of start,end point
YDeltaSign rmb 1                       ; holds sign of YDelta
YEndCoordinate rmb 1                   ; point at which line stops

ccoln    rmb 1                         ; FindPixel: cursor's col #
crown    rmb 1                         ; FindPixel: cursor's row #
         page
         org   SDOSSimulatorLocationCounter ; continue with Simulator code

SectorDBChain   ; head of Sector Descriptor block chain
; Is a dummy SectorDB:, with SectorDB:Next pointing to 1st real SectorDB,
; and SectorDB:Prev pointing to last (oldest) SectorDB.
**** Begin dummy sector descriptor block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   BootRom                 ; place to read sector (dummy)
         fdb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged
**** End dummy sector descriptor block

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer1           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer2           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer3           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer4           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer5           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer6           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer7           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer8           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   ThisSectorDescriptorBlock+SectorDB:Size ; SectorDB:Next
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer9           ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

         ; Sector Descriptor Block
ThisSectorDescriptorBlock       set     *
         fdb   SectorDBChain           ; SectorDB:Next points to chain head
         fdb   ThisSectorDescriptorBlock-SectorDB:Size ; SectorDB:Prev
         fdb   $FFFF                   ; LSN that is never fetched
         fdb   SectorBuffer10          ; place to read sector
         fcb   $FF                     ; impossible drive number
         fcb   0                       ; and record that LSN is unchanged

LastSectorDescriptorBlock       equ     ThisSectorDescriptorBlock

SDOSSimulatorCodeEnd ; end of loadable object code ***************
         page

         org   TopOfRam-10*NBPS-3      ; place for sector buffers
EndOfBASICProgramRAM ; No BASIC program may use a place higher than this
;        JMP   SYSCALL                 ; place that FB points to

;  Sector Buffer space needed for LRU disk sector pool
;
SectorBuffer1  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer2  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer3  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer4  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer5  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer6  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer7  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer8  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer9  rmb NBPS                ; Sector Buffer for LRU pool
SectorBuffer10 rmb NBPS                ; Sector Buffer for LRU pool
         page
         org   SectorBuffer1
        if      0                      ; boot ROM does all this
* put following code into 1st disk buffer so it evaporates
* Note: although the boot ROM technically does all of these things, we
* do it again here so that the SDOSSimulator is a self-contained package.
        spc     1
start   clra
        ldx     #stack
        staa    x
        dex
        bne     *-3
        staa    x
        spc     1
* initialize pia
        ldx     #$0404
        stx     piacra  select ora & orb
        ldx     #dwen+dren
        stx     piaora  init. outputs before setting ddr's
        ldx     #$0000
        stx     piacra  re-select ddr's
        ldx     #$003f
        stx     piaora  init. ddr's
        ldx     #$3c34
        stx     piacra  select ora & orb, set mr' high & dtmr low
        page
* initialize acia's
        spc     1
* ...acia no. 1 - printer/keyboard
* ...7 bit word + even parity + 1 stop bit
* ...divide count by 16
        ldaa    #3
        staa    ac1csr  give master reset
        ldab    #9
        stab    ac1csr  give control word
        spc     1
* ...acia no. 2 - instrument i/o
* ...7 bit word + even parity + 2 stop bits
* ...divide count by 16
        staa    ac2csr  give master reset
        ldab    #1
        stab    ac2csr  give control word
        spc     1
* ...acia no. 3 - communications i/o
* ...read switch to determine setup
* ...divide count by 16
* ...if tty selected then: 7 bit word + even parity + 2 stop bits
        staa    ac3csr  give master reset
        ldaa    #1      init. acc. for control word
        ldab    ac3swt  load setup switch data
        bitb    #tty
        bne     ac3set  skip if tty selected
        bitb    #wrd
        bne     ac3w8b  skip if 8 bit word selected
        bitb    #odd
        beq     *+4     skip if even parity selected
        oraa    #b2     set cr2
        bitb    #stp
        beq     *+4     skip if 2 stop bits selected
        oraa    #b3     set cr3
        bra     ac3set  bra to give control word
ac3w8b  oraa    #b4 here for 8 bit word/set cr4
        bitb    #par
        bne     ac3par  skip if parity selected
        bitb    #stp
        bne     ac3sb2  bra for 1 stop bit
        bra     ac3set  bra to give control word
ac3par  oraa    #b3 here for parity/set cr3
        bitb    #odd
        beq     *+4     skip if even parity
ac3sb2  oraa    #b2 set cr2
ac3set  staa    ac3csr give control word
        spc     1
* ...acia no. 4 - spare i/o
* ...setup for model 43 teletype
* ...7 bit word + even parity + 1 stop bit
* ...divide count by 16
        ldaa    #3
        staa    ac4csr  give master reset
        ldab    #9
        stab    ac4csr  give control word
        page
        lds     #stack  init. stack pointer
        spc     2
* restore all disk drives to track 0
        clrb
        stab    trkrg0  clear all drive track regs.
        stab    trkrg1
        stab    trkrg2
idsklp  pshb    init. drive # reg.
        jsr     select  select & start drive
        ldaa    #$34
        staa    piacra  mr' = 0
        ldaa    #$3c
        staa    piacra  mr' = 1
        ldx     #20000  delay 2.0 sec.
dlp2    ldaa    #14
dlp1    nop
        nop
        deca
        bne     dlp1
        dex
        bne     dlp2
        pulb
        incb
        cmpb    #3
        bne     idsklp
        jsr     select  de-select disk drives
        jmp     system  boot in system
        fin

         end   SDOSSimulator
