RamDos Source code.

I found this while surfing the internet...

;
; change list after v1.0
;
version .macro ; declare 3 char version here
.byte "4.3"
.endm
;
; when who version what
; -------- --- ---- ---------------------------------------------
; 11/13/87 fab V4.3 Added patch to correctly handle CLOSE for
; C128 opration. Patch added to match posted
; version of RAMDOS128.BIN.
;
; 10/26/87 fab V4.2 RBASIN did not check for prior status error-
; added code at DISK_IO to exit if bad status.
; This caused a problem especially for Relative
; file reads of empty records.
;
; EOF_CHECK did not preserve prior status-
; added ora status/ sta status. This caused a
; problem for file read loops expecting some kind
; of error status when past end of file.
;
; READ_BYTE did not set TIMEOUT status bit, and
; now it does (eg, read past EOF & you get ST=66).
;
; Relative file writes did not report OVERFLOW
; if given too much data for one record, and
; instead placed the excess data into subsequent
; records. Changed write_byte_rel to properly
; update current record only and report error.
; Fix assumes that a chkin/out implies a prior
; clrchn was performed.
;
; CLOSEing the command channel now closes all
; other user channels on disk side, as it should.
; Also, for C128 mode only, the status of carry
; is important as it should be (i.e., c=1 means
; not a real CLOSE, just remove crap from tables).
;
; 8/26/87 fab V4.1 Added NEW command. Simply sets disk_end=start.
;
; Added range check to set_unit_number (4-30).
;
; F access command string failed when a parameter
; was equal to <CR>. It's okay now.
;
; Added code to strip trailing <CR> if any from
; any filename processed by init_get_filename.
;
; 8/24/87 hcd V4.0 added 'F' access ( as opposed to 'RWMA' ).
;
; F access allows both reading and writing a
; file like sequential read and sequential
; write access. The file pointer merely points to
; the byte to operate on for reads or writes.
;
; F access is legal for SEQ or PRG files only.
;
; F access allows the POSITION command to be used
; to position the r/w head at any byte in the
; file. Positioning the head past the end of the
; file causes the file to be expanded, $FF is the
; padding char.
;
; The format for the F access version of the
; position command is:
;
; P:<channel><lpage><hpage>[<byte>]
;
; where:
;
; <channel> is the file's channel
; <hpage><lpage><byte> is a three byte
; pointer into the file. Three nulls
; would point the the first byte in the
; file.
;
; <byte> is optional, if omitted it
; defaults to zero.
;
; Note the odd order for the arguements.
;
;
;
; 8/20/87 hcd V3.6 added flush block call to read_byte_default.
; This is required before all DMAs directly
; to disk ram. Its omission had caused strange
; happenings when a file was opened for write,
; and a previously open read file was then opened.
;
; The rule is that any system calls which
; access disk memory directly ( as opposed to
; accessing disk memory via the default page ),
; must flush the default block before execution,
; and must unflush the block after execution.
;
; added flush block to do_load also.
;
; Corrected "FILE TOO LARGE" mispelling.
;
; Fixed bug with cleanup command write call
; to interpret command. Bad commands would
; shown errors because the command would be
; interpreted ( via cleanup ), then the commands
; cr would be interpreted as an ok command
; clearing the error channel. Fix was implemented
; by causeing commands of a single <cr> to
; have no effect on error channel.
;
; Caused serial buss timeout bit to be set when
; an attempt to read past the end of a file
; occurs. This is to accomodate BASIC7.0 DOS
; input command which is not satisfied by a
; simple EOF status.
;
; 7/20/87 hcd V3.5 BA ( the system bank variable ) was corrected
; to reflect the proper address. It was $cb.
; It is $c6.
;
; Corrected "FILE NAME EXSISTS" mispelling.
;
; Corrected "FILES SCRATCHED" error message
; where the number of files scratched was
; incorrect.
;
; Removed enhancement allowing for files
; > 10K block long. This causes the
; directory format display to be correct.
; ( filenames were shifted one char right )
;
; Caused cleanup_command_write to force any
; command in buffer to interpreted. This is
; in line with serial buss standard that clrch
; can terminate a command.
;
; 5/27/87 hcd V3.4 corrected save bug (saved 1 too many bytes
; causing load to load 1 too many)
;
; 4/8/87 hcd V3.3 corrected bug in sniff_disk_size which
; smelled 512k when only 256k exsisted
; on some ramdisk units. (erp)
;
; 11/12/86 hcd V3.2 added copyright message to jump vectors.
; corrected error 73 text to include Vx.x
; correctly from version macro.
;
; 11/11/86 hcd V3.1 added USR files.
; corrected error in M-W for unit change.
; corrected pattern matching bug where ending *
; in filename may mean 0-n chars.
;
;
;c64 = 1 ; define this flag to force c65 assy
rel_flag =1 ; define this flag to enable rel file code....
position_flag =1 ; define this flag to allow position command on
; program and relative files.
;
;
.ifdef position_flag
.ifndef rel_flag
*** error *** illegal to assemble with position and no rel files
.endif
.endif
;
.ifdef c64
;
.nam C64 RAMDISK DOS
;
default_unit_number = $08 unit 8
default_interface_page = $cf place for interface page
;
swapped_dos_base = $6000 install the dos here boss....
;
.else
.nam C128 RAMDISK DOS
;
default_unit_number = $09 unit 9
default_interface_page = $0e place for interface page
;
down_load_area = $3e4 start of down load area
swapped_dos_base = $2000
;
.endif
;
curzpg = $fe
curram = swapped_dos_base
code_start = swapped_dos_base+$300
swapped_code_start = swapped_dos_base
swapped_code_size = $1fff
;
.blist
.nclist
.include macros
;
* = code_start
;
jmp install ; install at default location
jmp reinstall ; reinstall at default location
jmp install_on_page ; install anywhere
jmp reinstall_on_page ; reinstall anywhere
jmp copyright_message ; print copyright message
;
;
.subttl "EQUATES"
;**************************************************************
; EQUATES
;**************************************************************
;
cr = $0d
;
; kernal_declares
;
status = $90
svxt = $92
verck = $93
ldtnd = $98
dfltn = $99
dflto = $9a
eal = $ae
eah = $af
fnlen = $b7
la = $b8
sa = $b9
fa = $ba
fnadr = $bb
stal = $c1
stah = $c2
memuss = $c3
.ifndef c64
ba = $c6
fnbank = $c7
.endif
;
inmi = $0318
iopen = $031a
iclose = $031c
ichkin = $031e
ickout = $0320
iclrch = $0322
ibasin = $0324
ibsout = $0326
; istop
igetin = $032a
iclall = $032c
; exmon
iload = $0330
isave = $0332
;
d1prb = $dc01 key scan port
d1ddrb = $dc03 key scan port ddr
d2icr = $dd0d icr for nmni 6526
;
.ifdef c64
fat = $0263
;
print = $e716 ; direct entry to screen printer.
;
cheap_open = $f34a
jxrmv = $f2f2 remove lat fat sat entry whose index is in .a
lookup = $f30f
jltlk = $f314
getlfs = $f31f ; jz100
;
_luking = $f5af print looking for filename
loding = $f5d2 print loading
_saving = $f68f print saving filename
;
no_restor_restore = $fe69 ; run stop restore less the restor....
fake_nmi = $fe72 ; calls nmi232, and does a prend...
;
kernal_error = $f715 ; kernal error handler
ud60 = $f6bc
;
.else
;
fat = $036c
;
system_vector = $0a00
;
print = $c00c direct entry into screen print...
;
cheap_open = $efbd
jxrmv = $f1e5 remove lat fat sat entry whose index is in .a
lookup = $f202
jltlk = $f207
getlfs = $f212
;
_luking = $f50f print looking for filename
loding = $f533 print loading
_saving = $f5bc print saving filename
;
no_restor_restore = $fa56 ; run stop restore less the restor....
fake_nmi = $fa5f ; calls nmi232, and does a prend...
;
kernal_error = $f699 ; kernal error handler
fnadry = $f7ae ; indirect load file name address
getcfg = $ff6b ; .a <= mmu setting for config .x
ud60 = $f63d
;
.endif
;
cint = $ff81
ioinit = $ff84
restor = $ff8a
clrch = $ffcc
stop = $ffe1
;
;
.subttl "ram declarations"
;*************************************************************************
; GENERAL SYSTEM RAM
;*************************************************************************
;
ram data_block,256 data block buffer
;
dir_filelen = data_block number of blocks for this file
dir_access = data_block+2 access char if open, null otherwise ( R,W,L,$ )
dir_filetype = data_block+3 type char for file ( S,P,L )
dir_last_byte = data_block+4 pointer to last byte
dir_end_record = data_block+5 two bytes indicating number of rel file records
dir_record_len = data_block+7 record length for rel files
dir_filename = data_block+8
; use rest of file for data
dir_data_start = dir_filename+18
dir_data_offset = dir_data_start-data_block
dir_load_addr = dir_data_offset+data_block
dir_load_data_offset = dir_data_offset+2
;
ram first_block,2 ; pointer to location of first data
; on disk after dos code and ram
ram disk_end,2 ; pointer to one past last data block in disk
; ( if disk_end == first_block then disk empty )
ram disk_max,2 ; highest legal value for disk_end
; ; this is the number of blocks on the disk
ram channel_blocks,2 ; this stores the pointer to channel
; storage on disk ( less than first block )
ram default_channel_number ; current channel in default_channel
;
ram cleanup_vector,2 ; pointer to cleanup routine for fastop
;
default_channel = curram
ram channel_access,1 ( R,W,L,$ ) read/write/relative/directory
ram directory_block,2 ( first_block - 1 )
ram current_byte,1
ram current_block,2 point directly to next byte
ram end_byte,1
ram end_block,2 point directly to last byte
.ifdef rel_flag
ram current_record_byte rel file, current byte in record
ram current_record,2 index of current record
ram current_record_len length of current record
; ram rel_write_flag flag for interface to disk_unlsn for rel only
ram end_record,2 index of last record in rel file
ram record_len length of physical record
.endif
default_channel_end
channel_len = curram-default_channel used to allocate channels
;
;
ram default_block,2 ; current block in the data_block buffer
;
zpage pntr,2 all I want is a pointer to use
ram pntr_save,2 save this too shithead....
;
;
ram eof_flag internal eof flag
ram data_byte data byte buffer
ram interface_page page number of the dma interface block
ram disk_fa our unit number ( can you say 9 )
ram alt_filename,17 alternate filename for copy/rename
;
;
;
.subttl "DMA DECLARATIONS"
;****************************************************************************
; DMA DECLARES
;****************************************************************************
;
;
.ifndef c64
mmucr = $ff00 ; mmu configuration
mmurcr = $d506
.endif
;
dma = $df00 ; base of dma unit
vicspeed = $d030 ; must do for c64 mode on c128
;
dma_status = dma ; dma status
; b7 - irq pending
; b6 - dma complete
; b5 - block verify error
; b4 - size register
; b3-0 - version
;
dma_cmd = dma+1 ; dma command
; b7 =1 arm transfer
; b6
; b5 =1 autoload enable
; b4 =1 disable $ff00 decode
; b3
; b2
; b1:b0
; 00 write c128 --> disk
; 01 read c128 <-- disk
; 10 swap c128 <-> disk
; 11 compare c128 == disk
;
dma_immediate_write = %10110000
dma_immediate_read = %10110001
dma_immediate_swap = %10110010
dma_immediate_compare = %10110011
;
dma_banked_write = %10100000
dma_banked_read = %10100001
dma_banked_swap = %10100010
dma_banked_compare = %10100011
;
dma_fastop_write = %10010000
dma_fastop_read = %10010001
;
dma_cpu_addr = dma+2 ; c128 addr
dma_disk_addr = dma+4 ; disk low order adder
dma_disk_block = dma+5 ; disk block ( two bytes )
dma_disk_bank = dma+6 ; disk bank
;
dma_len = dma+7 ; two bytes for length of transfer
;
dma_ifr = dma+9 ; interupt mask register
dma_acr = dma+10 ; address_control_register
;
;
;
.subttl "COPYRIGHT MESSAGE"
;************************************************************************
; COPYRIGHT MESSAGE
;************************************************************************
;
copyright_message
ldx #0
10$ txa
pha
lda 100$,x
jsr print
pla
tax
inx
cpx #110$-100$
bne 10$
rts
;
100$ .byte $0d
.byte "(C) 1986 COMMODORE ELECTRONICS, LTD. ",$0d
.byte " ALL RIGHTS RESERVED. ",$0d
110$ ;
;
;
.subttl "ERROR TEXT"
;************************************************************************
; ERROR TEXT
;************************************************************************
;
error .macro %n,%s,%a,%b,%c,%d
%s = %n
.ifb <%d>
.ifb <%c>
.ifb <%b>
.byte %n,"%a",0
.else
.byte %n,"%a %b",0
.endif
.else
.byte %n,"%a %b %c",0
.endif
.else
.byte %n,"%a %b %c %d",0
.endif
.endm
;
error_text
ERROR 00,OK,OK
ERROR 01,FILES_SCRATCHED,FILES,SCRATCHED
ERROR 13,DOS_CONFUSED,DOS,CONFUSED
ERROR 30,SYNTAX_ERROR,SYNTAX,ERROR
ERROR 31,ILLEGAL_COMMAND,SYNTAX,ERROR
ERROR 32,LONG_LINE,SYNTAX,ERROR
ERROR 33,ILLEGAL_WILD_CARD,SYNTAX,ERROR
ERROR 34,NO_FILENAME,SYNTAX,ERROR
ERROR 50,RECORD_NOT_PRESENT,RECORD,NOT,PRESENT
ERROR 51,OVERFLOW_IN_RECORD,OVERFLOW,IN,RECORD
ERROR 52,FILE_TOO_LARGE,FILE,TOO,LARGE
ERROR 60,FILE_OPEN,FILE,OPEN
ERROR 61,FILE_NOT_OPEN,FILE,NOT,OPEN
ERROR 62,FILE_NOT_FOUND,FILE,NOT,FOUND
ERROR 63,FILE_EXISTS,FILE,EXISTS
ERROR 64,FILE_TYPE_MISMATCH,FILE,TYPE,MISMATCH
ERROR 66,ILLEGAL_TRACK_AND_SECTOR,ILLEGAL,TRACK,AND,SECTOR
ERROR 70,NO_CHANNEL,NO,CHANNEL
ERROR 72,DISK_FULL,DISK,FULL
;
INIT_ERROR = 73
.byte 73,"CBM DOS V"
version
.ifdef c64
.byte " 1764",0
.else
.byte " 1750",0
.endif
;
ERROR 00,NULL,BAD,ERROR,NUMBER
;
;
;
.subttl "ERROR CHANNEL"
;************************************************************************
; ERROR CHANNEL
;************************************************************************
;
; ERROR_CHANNEL
;
; read_error_channel
; returns one byte from error channel
; sets eof flag at end of error
; error_channel_scratch_set_up
; formats message for this message
; entry: x,a = number of files scratched
; clear_error
; resets any pending errors to ok message
; error_channel_init_set_up
; inits error channel
; error_channel_set_up
; general purpose error entry ( .a = error number )
; format_error_message
; formats all error messages
; entry: a = error number
;
error_pntr = pntr
;
ram error_number
ram error_track
ram error_sector
;
max_error_length = 50
ram error_line,max_error_length
;
ram error_current_byte
ram error_end_byte
;
;
error_cleanup
clc
adc error_current_byte advance current byte by .a
sta error_current_byte
rts
;
read_error_channel
ldx error_current_byte if at end of error message
cpx error_end_byte
bcc 10$
jsr clear_error clear error message
clc
jmp disk_system_return_cr_eof return cr_eof
;
10$ ldi error_cleanup cleanup vector point to error cleanup
std cleanup_vector
ldi error_line-swapped_code_start
clc dma_disk_addr points to appropriate error line
adc error_current_byte
bcc 20$
inx
20$ std dma_disk_addr
lda #0
sta dma_disk_bank
;
lda error_end_byte .a <= number of bytes left to return to user
sec
sbc error_current_byte
;
ldx system_reg_x restore x,y
ldy system_reg_y
sec this is a read operation
jmp return_execute_fastop return via fastop
;
;

;
ram scratched_files_temp,2
ram scratched_files_temp2,2
ram scratched_files_digit
;
error_channel_scratch_set_up ;
std scratched_files_temp save number of files trashed
ldy #1
jsr format_error_message_scratch format first part of line
;
lda #0 clear the digit
sta scratched_files_digit
;
ldi 10000 try 10000's
jsr 100$
ldi 1000 try 1000's
jsr 100$
ldi 100 try 100's
jsr 100$
;
lda scratched_files_temp use exsisting software for last two digits
jsr add_error_decimal
jsr add_error_comma do the comma and trailing '00'
lda #0
jmp add_error_decimal and return
;
;
100$ std scratched_files_temp2 save subtractor
;
lda scratched_files_digit clear ones digit
and #$f0
sta scratched_files_digit
;
110$ lda scratched_files_temp while can subtract temp2 from temp1
sec
sbc scratched_files_temp2
tax
lda scratched_files_temp+1
sbc scratched_files_temp2+1
bcc 120$ do
sta scratched_files_temp+1 save result
stx scratched_files_temp
lda scratched_files_digit inc digit and or in the $30
adc #$00
ora #$30
sta scratched_files_digit
bne 110$
;
120$ lda scratched_files_digit if digit <> 0
beq 130$
jsr add_error_byte add digit to error message
130$ rts return
;
;
error_channel_init_set_up
ldy #73
.byte $2c
clear_error
error_channel_ok_set_up
ldy #0
lda #0
tax
jmp format_error_message
;
error_channel_set_up
tay
ldd current_block
;
format_error_message
jsr format_error_message_scratch
;
lda error_track
jsr add_error_decimal
jsr add_error_comma
lda error_sector
jmp add_error_decimal
;
format_error_message_scratch
sty error_number
stx error_track
sta error_sector
;
lda #0
sta error_current_byte
sta error_end_byte
lda error_number
jsr add_error_decimal
jsr add_error_comma
lda #$20
jsr add_error_byte
jsr add_error_text
jsr add_error_comma
rts
;
add_error_decimal
cmp #100
bcc 30$
cmp #200
bcc 10$
sbc #200
pha
lda #2
jmp 20$
10$ sec
sbc #100
pha
lda #1
20$ jsr add_error_digit
pla
30$ ldx #$ff
40$ inx
sec
sbc #10
bcs 40$
pha
txa
jsr add_error_digit
pla
clc
adc #10
; jmp add_error_digit
;
add_error_digit
ora #$30
.byte $2c
add_error_comma
lda #','
add_error_byte
ldx error_end_byte
sta error_line,x
cpx #max_error_length-2
beq 80$
inc error_end_byte
80$ lda #0
sta error_line+1,x
clc
rts
;
add_error_text
ldi error_text error_pntr <= start of messages
std error_pntr
20$ lda error_number do a <= error number
ldx #0 if (error_pntr) = .a
cmp (error_pntr,x)
beq 70$ break
jsr 100$ read until one past null
bne 20$ while not at a second null
;
;
70$ jsr 110$ do point and fetch next byte
beq 80$ if null, break
jsr add_error_byte add byte to message
jmp 70$ loop
80$ clc exit happy
rts
;
100$ jsr 110$ do point to and fetch next byte
bne 100$ while byte not null
110$ incd error_pntr point to next byte
ldx #0 .a <= next byte
lda (error_pntr,x)
rts return
;
.subttl "SELECT CHANNELS"
;******************************************************************
; SELECT_CHANNELS
;******************************************************************
;
num_channels = 17
directory_channel = 16
;
init_channels
ldx #num_channels-1
10$ txa
jsr select_channel_a
jsr clear_channel
ldx default_channel_number
dex
bpl 10$
rts
;
clear_channel ; set all channel data to zero
ldx #channel_len-1
lda #0
20$ sta default_channel,x
dex
bpl 20$
rts
;
select_channel_given_sa
lda sa
and #$0f
.byte $2c
;
select_dir_channel
lda #16
;
select_channel_a
cmp default_channel_number
beq 80$
;
10$ pha save channel to get
;
ldi default_channel set up cpu addr
std dma_cpu_addr
lda channel_blocks+1 set up bank
sta dma_disk_bank
ldi channel_len set up length
std dma_len
;
;
lda default_channel_number write the default channel
ldy #dma_immediate_write
jsr 50$
pla mark new channel number
sta default_channel_number
ldy #dma_immediate_read
jsr 50$ read the new channel
80$ lda default_channel_number .a <= channel number
ldx channel_access .x <= channel open flag
clc
rts
;
50$ asl a
tax
lda 100$,x
sta dma_disk_addr set up byte address
lda 100$+1,x
adc channel_blocks correct for page boundary
sta dma_disk_block
sty dma+1 do dat dma, oh yeah, do wah do wah
rts
;
;
channel_offset_temp = 0
100$
.rept num_channels
.word channel_offset_temp
channel_offset_temp = channel_offset_temp+channel_len
.iflt $200-channel_offset_temp
*** CHANNELS TOO LARGE ****
.endif
.endr
;
;

.subttl "ACCESS DISK"
;******************************************************************
; ACCESS_DISK
;******************************************************************
;
;
access_new_current_block
std current_block
access_current_block
ldd current_block
access_block_a
access_block
cpd default_block if already have desired block
beq access_block_ret go return
phd save block to load
jsr flush_block flush the current block to disk
pld recall block to load
std default_block save as current block
;
;
unflush_block ; read the new default block in.
ldy #dma_immediate_read
.byte $2c
flush_block
ldy #dma_immediate_write y <= write ( auto load )
jsr dma_data_block_setup set up dma controller
ldd default_block x,a <= default block pla

std dma_disk_block write block to dma controller
sty dma+1 do the dma
access_block_ret
clc return happy
rts
;
;
dma_data_block_setup ; set up dma controller for data block
ldx #110$-100$-1 ( y must be preserved )
10$ lda 100$,x
sta dma+2,x
dex
bpl 10$
rts
;
100$ .word data_block ; c128 addr
.byte 0 ; low order ramdisk address
.word 0 ; ramdisk block - overwritten
.word $100 ; number of bytes to move
.word 0 ; ifr
.word 0 ; increment both sets of registers
110$
;
;
;
;
.subttl "READ BYTE"
;**************************************************************************
; READ BYTE
;**************************************************************************
;
;
read_byte_given_sa
jsr select_channel_given_sa
cmp #15 if error channel
bne 10$
jmp read_error_channel
10$ cpx #0 if channel not open
bne 20$
lda #$46 ;<4.2 fab>
sta status ;<4.2 fab> set EOF and TIMEOUT bits
lda #no_channel
jmp disk_system_return_error
;
20$ cpx #'$ if not directory channel
bne read_byte_default
jmp directory_read
;
read_byte_default_cleanup
tay save number of bytes moved
beq 80$ exit iff none
clc current_byte += number of bytes moved
adc current_byte
sta current_byte
bcc 10$
incd current_block
10$ jsr unflush_block unflush the block ( think about it... )
80$ rts return
;
;
;
read_byte_default
;
lda channel_access
cmp #'R
beq 10$
.ifdef rel_flag
.ifdef position_flag
cmp #'F
beq 10$
.endif
cmp #'L if rel file
bne 90$
jmp read_byte_rel call special routinue
.endif
90$ lda #file_open
jmp disk_system_return_error
;
10$ sec a,x,y <= end_byte - current_byte - 1
lda end_byte
sbc current_byte
tay
lda end_block
sbc current_block
tax
lda end_block+1
sbc current_block+1
bcs 20$ if < 0
jmp disk_system_return_eof_timeout
;
20$ bne 25$ .y <= min( xay, $ff )
txa
beq 50$
25$ ldy #$ff
;
50$ tya save y while we flush the block....
pha
jsr flush_block
pla
tay if y = 0
bne 60$ ( must be time for last byte )
;
lda #$40 set eof status
sta status
iny y <= 1
;
60$ ldi read_byte_default_cleanup
; x,a <= cleanup vector
sec this is a read operation
jmp io_fastop setup fastop and return
;
;
.subttl "WRITE BYTE"
;**************************************************************************
; WRITE_BYTE
;**************************************************************************
;
write_byte_given_sa
jsr select_channel_given_sa
cmp #15 if command channel
bne 10$
jmp command_channel_write
;
10$ cpx #'W if write access
beq write_byte_default
;
.ifdef rel_flag
.ifdef position_flag
cpx #'F if fast access
beq write_byte_default
.endif
cpx #'L if relative access
bne 90$
jmp write_byte_rel
.endif
;
90$ lda #no_channel complain no channel
jmp disk_system_return_error
;
;
cleanup_write_byte
tay save bytes transferred in .y
beq 80$ exit if zero
;
dey
tya current_byte += number of bytes transfered-1
clc ( guarentted never to carry )
adc current_byte
sta current_byte
; if current block=end_block
cmpdr current_block,end_block,x
bne 10$
;
cmp end_byte if .a > endbyte
bcc 10$
sta end_byte end_byte <= a
;
10$ inc current_byte inc current_byte
bne 20$ if wrap
incd current_block inc the block number too
;
20$
80$ jmp unflush_block unflush_data_block and return
;
;
write_byte_default
;
20$ jsr write_byte_immediate write the damn byte....
bcs 90$ puke if error
;
; set up fastop if appropriate
;
lda #$00 .a <= number of bytes i could write to
sec current block
sbc current_byte
;
40$ cmp #0 if .a = 0
bne 50$
clc go return happy
90$ jmp disk_system_return
;
50$ pha save .a
jsr flush_block flush default block to disk
pla
tay .y <- saved number of bytes to fastop
ldi cleanup_write_byte x,a <= cleanup vector
clc clc means write operation
jmp io_fastop set up fastop and return
;
;
; write_byte_immediate
; writes data byte to current file at current file pointer
; also may make an effort to expand the file. If file expansion
; must take place, any expansion area is filled withg $FFs.
;
;
write_byte_immediate
; while current_byte > end_byte
30$ lda end_block+1
cmp current_block+1
bne 33$
lda end_block
cmp current_block
bne 33$
lda end_byte
cmp current_byte
33$ bcs 70$
;
lda end_byte do if end_byte = $ff
cmp #$ff
bne 40$
;
ldd current_block save current block
phd
ldd end_block x,a <= end_block+1
clc
adc #1
bcc 35$
inx
35$ jsr grow_disk expand disk at and after x,a
tay .y <= possible error
pld
std current_block restore current block
tya .a <= possible error
bcs 90$
;
;
incd end_block inc end_block
ldd directory_block ( inform directory file )
jsr access_block_a
incd dir_filelen
;
40$ inc end_byte inc end_byte
ldd end_block access last block
jsr access_block_a
lda #$ff write a fill charecter
ldy end_byte
sta data_block,y
jmp 30$ loop
;
70$ jsr access_current_block access the current block
;
ldy current_byte write the byte
lda data_byte
sta data_block,y
;
inc current_byte point to next byte
bne 80$
incd current_block
;
80$ clc return happy
90$ rts
;
.ifdef rel_flag
;
.subttl "REL FILES"
;**************************************************************************
; REL FILES
;**************************************************************************
;
;directory:
; dir_record_len 1 record length
; dir_end_record 2 number of records we have
;
;channel current_record 2 current record number
; current_record_byte 1 position in current record
; current_record_len 1 length of current record
; rel_write_flag 1 write flag...
; record_len 1 length of physical record
; end_record 2 maximum record number written
;
;access_record
; current_block/byte <= address of current_record,current_record_byte
;;
;add_record
; adds one record to end of file
; $ff plus nulls
;;
;fill_record
; fills current record from current byte to end of record with nulls.
; this may be a nop if current record is full
;;
;scan_record
; returns number of bytes in current record.
; this involves scanning the record.
;
;;; read_byte_rel
;; always returns current byte ( even if past end of record )
;; if past (conceptual )end of record
;; will return nulls to end of physical record before eof
;; otherwise will return bytes until EOF.
;; at time EOF is returned, read_byte_rel will advance current record
;; to start of succedding record.
;;
;; write_byte_rel
;; if record not present
;; add records as neccesary
;; if error
;; let user know about problem ( disk full ! )
;; if record is not full
;; writes bytes at current record until record full.
;; else
;; returns record overflow error
;;
;; position command
;; if channel is not open
;; no channel error
;; if not relative file
;; complain
;; set record number
;; current_record_byte <= 0
;; if record length specified
;; if greater than max
;; puke record_overflow
;; else
;; set current_record_byte
;; if record not present
;; return record_not_present_error
;;
;;
;
;
; access_record
;
; sets current byte to point at area in current record/current_record_byte
;
; returns error if record not present
;
;
ram access_record_temp,3
access_record
; current_block <= start of file+current_record_byte
clc
lda #dir_data_offset
adc current_record_byte
sta current_byte
ldi 0
addc directory_block
std current_block
;
ldy channel_access
cpy #'F
bne 5$
;
add current_record
bcs 9$
std current_block
9$ lda #file_too_large
rts
;
5$ lda #0 temp <= 00:recordnumber
sta access_record_temp+2
ldd current_record
std access_record_temp
;
lda record_len .a <= physical record_length
10$ lsr a do a >>1
pha save .a
bcc 20$ if carry
clc current += temp
lda access_record_temp
adc current_byte
sta current_byte
lda access_record_temp+1
adc current_block
sta current_block
lda access_record_temp+2
adc current_block+1
sta current_block+1
20$ asl access_record_temp temp <<1
rol access_record_temp+1
rol access_record_temp+2
pla recall .a
bne 10$ while .a <> 0
;
lda #record_not_present .a <= record not present error code
; set carry if record no present
cmpdr current_record,end_record,x
rts return
;
;

add_record
ldd current_record save current record on stack
phd
lda current_record_byte save current record byte
pha
lda data_byte save current data_byte on stack
pha
;
5$ jsr 10$ do add a record
bcs 90$ puke if error
; lda current_byte while another record would fit in this block
; clc
; adc record_len
; bcc 5$
;
clc happy
90$ tay save possible error code
pla
sta data_byte restore data byte from stack
pla
sta current_record_byte
pld restore current record
std current_record
tya restore possible error code
rts return
;
;
;
;
;
10$ ldd end_record if end record = $ffff
cpi $ffff
bcs 95$ exit file too large
std current_record current_record <= end_record
lda #0 current_record_byte <= 0
sta current_record_byte
jsr access_record access_record
lda #$ff write $ff
sta data_byte
jsr write_byte_immediate
bcs 19$ puke if errror
inc current_record_byte point to next byte
jsr pad_record pad remainder of record with nulls
bcs 19$ if no error
incd end_record indicate new end record
19$ rts
;
95$ lda #file_too_large
sec
rts
;
;
; pad_record fills out remainder of record with nulls
;
; NOTE: current_block/byte must be aligned with
; current_record/current_record_byte before
; using this routine. ( This can be done by
; calling access_record first.
;
pad_record ; fills out remainder of record with nulls
10$ lda current_record_byte
cmp record_len
bcs 80$
lda #0
sta data_byte
jsr write_byte_immediate
bcs 90$
inc current_record_byte
bne 10$
80$ clc
90$ rts
;
;
scan_record
lda current_record_byte save current byte on stack
pha
lda #0 access the record
sta current_record_byte
sta current_record_len
jsr access_record ( pukes if record not present )
bcs 90$
;
20$ lda current_record_byte while current_record_byte < record_len
cmp record_len
bcs 80$
;
jsr access_current_block do access the data block
ldy current_byte if current byte <> 0
lda data_block,y
beq 30$
lda current_record_byte len <= current index
sta current_record_len
30$ inc current_byte current_byte++
bne 40$ if zero
incd current_block current_block++
40$ inc current_record_byte current_record_byte++
bne 20$
;
80$ pla restore current_record byte
sta current_record_byte
clc
rts
;

90$ tay
pla
tya
rts
;
;
read_a_byte_from_the_record
jsr access_record
bcs 90$
jsr access_current_block
ldx current_byte
lda data_block,x
clc
90$ rts
;
;
; 
; read_byte_rel
; always returns current byte ( even if past end of record )
; if past (conceptual )end of record
; will return nulls to end of physical record before eof
; otherwise will return bytes until EOF.
; at time EOF is returned, read_byte_rel will advance current record
; to start of succedding record.
;
cleanup_write_byte_rel
; correct current_record_byte
jsr cleanup_read_byte_rel
jsr access_record access the record
jsr pad_record pad the remainder of the record with nulls.
bcs 80$
incd current_record point to start of next record
lda #0
sta current_record_byte
80$ clc return happy
rts
;
cleanup_read_byte_rel
clc
adc current_record_byte
sta current_record_byte
jmp unflush_block
;
read_byte_rel
ldi cleanup_read_byte_rel
std cleanup_vector set up cleanup vector
jsr scan_record scan record for length
bcs 90$ puke if error
jsr access_record set up current_block/byte
;
sec .a <= bytes in record-current_record_byte
lda current_record_len
sbc current_record_byte
beq 64$ if 0, go do that eof thing...
;
; bcs 20$ if < 0
; lda record_len .a <= number of bytes left in physrecord
; clc -1
; sbc current_record_byte
;
20$ sec let fastop move most of the bytes...
jmp rel_fastop
90$ jmp disk_system_return_error
;
64$ jsr read_a_byte_from_the_record read a byte
ldx #0 point to start of next record
stx current_record_byte ( .a must be preserved )
incd current_record
jmp disk_system_return_eof return data byte and eof to user
;

write_byte_rel
clc ;<4.2 fab>
jsr write_byte_rel_flag_carry ;<4.2 fab> it's ok if clrchn was done
bne 95$ ;<4.2 fab> puke

ldi cleanup_write_byte_rel
std cleanup_vector
10$ cmpdr current_record,end_record,x
bcc 20$
jsr add_record
bcc 10$
.byte $2c

95$ lda #overflow_in_record
90$ jmp disk_system_return_error

20$ lda record_len if record is full
sec
sbc current_record_byte
bcc 95$ puke
beq 95$
pha ;<4.2 fab>
jsr write_byte_rel_flag_carry ;set flag to puke later if no clrchn
pla ;<4.2 fab>
clc c=0

rel_fastop
php save .c
pha save .a
jsr access_record
jsr access_current_block
jsr flush_block
lda current_byte set up dma address
sta dma_disk_addr
ldd current_block
std dma_disk_block
pla restore .c ,.a
plp
jmp return_execute_fastop go do it...
;
;
write_byte_rel_flag_carry ;<4.2 fab & hcd>
;
lda interface_page get pntr to write_byte_rel_flag
sta pntr+1
lda #<write_byte_rel_flag
sta pntr
;
ldy #0 .c=0 read it
lda (pntr),y .c=1 set it
bcc 10$
rol a
sta (pntr),y
10$ rts
;
;
position_command
jsr get_filename_char read channel number
bcs 94$
tya
and #$0f
jsr select_channel_a select channel

lda channel_access
.ifdef position_flag
cmp #'F if not open for fast access
beq 10$ or
.endif
cmp #'L if not open for rel
bne 95$ go complain
;
10$ jsr get_filename_char get low byte of record number
tya
bcs 94$
sta current_record
jsr get_filename_char get high byte of record number
tya
bcs 94$
sta current_record+1
lda #0 current_record_byte <= 0
sta current_record_byte
jsr get_filename_char
tya
bcs 80$
;
.ifdef position_flag
ldy channel_access
cpy #'F if not open for fast access
beq 50$
.endif
;
cmp #0 if not zero
beq 80$
tay decrement
dey
tya
cmp record_len if > record length
bcs 93$ puke
50$ sta current_record_byte
80$ lda current_record if current record != 0
bne 85$
lda current_record+1 decd current record
beq 88$
dec current_record+1
85$ dec current_record
88$ jmp access_record go access record
;
;
95$ lda #no_channel
.byte $2c
94$ lda #syntax_error
.byte $2c
93$ lda #overflow_in_record
90$ sec
rts
;
.endif
;
.subttl "GROW DISK
;**************************************************************************
; GROW DISK
;**************************************************************************
;
ram swap_block,2
ram swap_delta,2
;
; entry:
; x,a lowest block number to shift up by one.
; ( if == disk end then disk simply expanded )
;
;
;
grow_disk
std swap_block save swap block
ldd disk_end x,a <= disk_end after grow opeartion
clc
adc #$01
bne 5$
inx
5$ cpd disk_max if >= disk_max
bcc 10$
lda #disk_full puke
rts
;
10$ ldi 1 adjust all pointers into disk
jsr adjust_pointers
;
ldd swap_block point to swap block & load into current_block
jsr access_block_a
;
70$ incd swap_block do swap_block <= address of next
jsr dma_data_block_setup set up for data block dma
ldd swap_block dma_disk_block <= swap_block
std dma_disk_block ( next block )
cpd disk_end if >= disk_end
bcs 80$ break
lda #dma_immediate_swap swap a roo
sta dma+1
jmp 70$
;
80$ clc
rts
;
;
;
adjust_pointers
std swap_delta
lda default_channel_number save current channel
pha
ldx #num_channels-1 x <= number of channels
10$ txa do
jsr select_channel_a select channel x
lda channel_access if open
beq 20$
;
ldd end_block adjust end block
jsr adjust_pointer
std end_block
;
ldd current_block adjust current block
jsr adjust_pointer
std current_block
;
ldd directory_block adjust dir block
jsr adjust_pointer
std directory_block
;
20$ ldx default_channel_number while 0 <> (x <= default_channel-1 )
dex
bpl 10$
;
pla
jsr select_channel_a restore to correct channel
;
ldd disk_end oh yeah, fix the disk_end too
jsr adjust_pointer
std disk_end
clc
rts
;
adjust_pointer
cpd swap_block
bcc 20$
add swap_delta
20$ rts
;

.subttl "DELETE FILE & COMPACT DISK"
;************************************************************************
; DELETE FILE ( also crushes disk )
;************************************************************************
;
; delete_file
; entry: data page has directory block on it
;
delete_file
ldd default_block swap block <= default_block
std swap_block
;
ldd dir_filelen stack number of blocks
phd
ldd dir_filelen
;
eor #$ff x,a <- ones complement of x,a
tay ( we wish to remove (-x,a)+1 blocks
txa
eor #$ff
tax
tya
;
5$ jsr adjust_pointers modify relavent pointers by that amount
pld
std swap_delta save number of blocks in delta to move disk by
; do
10$ ldd swap_block point to block to move down
sec
addc swap_delta
jsr access_block_a access that block
ldd swap_block tell access new number for block
std default_block
incd swap_block point to next location
; while within the disk domain
cmpdr disk_end,swap_block,a
bcs 10$
;
rts return happy
;
;

.subttl "UTILITIES
;************************************************************************
; UTILITIES
;************************************************************************
;
to_lower
cmp #$40
bcc 20$
cmp #$80
bcc 10$
cmp #$c0
bcc 20$
10$ and #$1f
ora #$40
20$ clc
rts
;
exptab .byte $01,$02,$04,$08,$10,$20,$40,$80
;
;
.subttl "DIRECTORY OPERATIONS
;************************************************************************
; DIRECTORY OPERATIONS
;************************************************************************
;
; find_a_file_for_open
; find_nth_matching_file
;
ram filename,17
ram file_type
ram parse_access,1
ram type_char,1
ram wild_char,1
ram replace_flag,1
.ifdef rel_flag
ram parse_record_len,1
.endif
ram found_flag,1
;
;
;
find_a_file
;
jsr select_dir_channel
ldd first_block
;
10$ std current_block
cpd disk_end
bcc 20$
beq 15$
lda #dos_confused
.byte $2c
15$ lda #file_not_found
90$ sec
rts
;
20$ jsr access_current_block
bcs 90$
jsr compare_filenames
bcs 30$
ldd current_block
rts
;
30$ ldd dir_filelen
sec
addc current_block
jmp 10$
;
find_open_file
jsr select_dir_channel
ldd first_block
10$ std current_block
cpd disk_end
bcc 20$
beq 15$
lda #dos_confused
.byte $2c
15$ lda #file_not_found
90$ sec
rts
;
20$ jsr access_current_block
lda dir_access
beq 30$
ldd current_block
clc
rts
;
30$ ldd dir_filelen
sec
addc current_block
jmp 10$
;
compare_filenames
ldx #$ff
10$ inx
lda dir_filename,x
bne 20$
lda filename,x
beq 80$
cmp #'*
bne 90$
80$ clc
rts
;
20$ lda filename,x
beq 90$
cmp dir_filename,x
beq 10$
cmp #'?
beq 10$
cmp #'*
beq 80$
90$ sec
rts
;
;

.subttl "GENERAL PURPOSE OPEN ROUTINE"
;************************************************************************
; OPENS
;************************************************************************
;
;
;
; open:
; 0-14 <$><:>filename<,<s|p|r>>
; <@><<0>:>filename<,<s|p|r>><,<r|w|a|m>>
; 15 only:
; Rename<0<:>>filename=<0<:>>filename
; Copy<0<:>>filename=<0<:>>filename
; Scratch<0<:>>filename
; New<0<:>>filename,idh <4.1 fab>
; Initialize<0<:>>
; Validate<0<:>>
; P<96+channel_number><record_low><record_high><offset>
; UJ:
;
;
; dir_file
; parse_filename
; second_filename
; file_type <p>,<s>,<r>
; access_type <r>,<w>,<m>,<a>
; replace_flag
;
;
; ram filename,17
; ram parse_access,1
; ram type_char,1
; ram wild_char,1
; ram replace_flag,1
; ram found_flag,1
;
;
;
.subttl "LOW LEVEL PARSING
;************************************************************************
; PARSING low level utilities
;************************************************************************
;
ram get_filename_index pointer to next char
ram get_filename_len max chars to get
ram get_filename_source 0 = from basic, 1 = from command
ram remote_filename_buffer,256 copy of filename from user
;
; get_filename_char
; exit: c = 0 y = char
; .a type of char
; c = 1 no char there
; un_get_filename_char
; ungets a gotton filename char
;
; init_get_filename
; inits all this stuff for geting from user filenames
; init_get_filename_from_command
; inits all this stuff for geting from command.
;
parse_init
lda #0
sta parse_access
sta type_char
sta wild_char
sta replace_flag
.ifdef rel_flag
sta parse_record_len
.endif
;
init_get_filename
jsr read_users_filename
ldy fnlen
lda remote_filename_buffer-1,y ;<4.1 fab>
ldx #0
beq igf_really

init_get_filename_from_command
ldx #1 ; source
ldy command_len ; len
lda command-1,y ;<4.1 fab>

igf_really
cmp #cr ;for 1541 compatibility, strip trailing <CR> if any
bne 10$ ;<4.1 fab>
dey ;<4.1 fab>

10$ stx get_filename_source
sty get_filename_len
lda #0
sta get_filename_index
clc
rts
;
unget_filename_char
dec get_filename_index
rts
;
get_filename_char
ldy get_filename_index if index >= len
cpy get_filename_len
bcs 80$ go return error
;
lda get_filename_source if source is ram
bne 10$
lda remote_filename_buffer,y
; jsr read_yth_filename_byte
jmp 20$ else
10$ lda command,y read char from command
;
20$ inc get_filename_index point to next char
jsr classify_char classify_char
clc return happy
80$ rts
;
; classsify_char
; entry: a= char
; exit: a = class
; y = char
; c = 0
;
classify_char
ldx #7
10$ cmp classy_chars,x
beq 80$
dex
bne 10$
tay
lda #0
rts
;
80$ tay
lda exptab,x
cmp #%00000100
beq 85$
cmp #%00000010
bne 88$
85$ sty wild_char
88$ clc
rts
;
classy_chars
.byte ' ?*"@=$,'
;
;
; classes 7 6 5 4 3 2 1 0
; class <comma> <$> <=> <@> <"> <*> <?> < >
;
;
.subttl "MID LEVEL PARSING
;************************************************************************
; PARSING mid level calls
;************************************************************************
; get_filename
; entry: cur_filename_char = users string
; exit: cur_filename_char = advanced
; get_mod_type
; entry: cur_filename_char = pointer to users string
;
get_filename
ldx #$ff x <= 0
10$ inx do x++;
lda #0 filename,x <= 0
sta filename,x
jsr get_filename_char get char ( into y )
bcs 90$ exit if none
and #%10100000 if not correct type
bne 80$ backup and exit
ldx #$ff x <= -1
20$ inx do x++
cpx #16 if x==16
beq 80$ backup and exit
lda filename,x while filename,x <> 0
bne 20$
tya filename,x <= y
sta filename,x
jmp 10$ loop
;
80$ jsr unget_filename_char
90$ clc
rts
;
;
; get_mod_type
; entry: cur_filename_char = pointer to users string
; exit: type & access flags set if such is found
; things advanced
; if comma found, but not legal mod
; routine pukes.
;
get_mod_type
jsr get_mod_type_2
.ifdef rel_flag
jsr get_mod_type_2
.endif
get_mod_type_2
jsr get_filename_char
bcs 80$
;
cpy #',
bne 70$
;
jsr get_filename_char
bcs 70$
;
tya
jsr to_lower
;
cmp #'P
beq get_type
cmp #'S
beq get_type
cmp #'U
beq get_type
;
cmp #'R
beq get_access
cmp #'W
beq get_access
cmp #'A
beq get_access
cmp #'F
beq get_access
;
.ifdef rel_flag
cmp #'L
beq get_rel_length
.endif
;
jsr unget_filename_char
70$ jsr unget_filename_char
80$ clc
rts
;
.ifdef rel_flag
get_rel_length
jsr get_type
bcs 90$
jsr get_filename_char
bcs 80$
cpy #',
bne 70$
jsr get_filename_char
bcs 90$
sty parse_record_len
jmp get_end_mod
;
70$ jsr unget_filename_char
80$ clc
rts
;
90$ lda #syntax_error
sec
rts
.endif
;
;
get_type
ldy type_char
sta type_char
jmp get_end_mod
;
get_access
ldy parse_access
sta parse_access
;
get_end_mod
tya stack previous mod char
pha
10$ jsr get_filename_char do eat chars
bcs 80$ until none left
and #%10100000 or comma, or equals sign
beq 10$
jsr unget_filename_char if comma or eq, unget
80$ clc clc
pla recall previous mod char
beq 88$ if <> 0
lda #syntax_error syntax error
sec
88$ rts return
;
; eat_zero_colon
; skips over <0><:> iff present
;
;
eat_zero_colon
jsr get_filename_char
bcs 80$ exit if none
cpy #': if colon
beq 80$ exit
;
10$ cpy #'0 if zero
bne 70$
jsr get_filename_char
bcs 80$ if there
cpy #': if colon
beq 80$ exit
70$ jsr unget_filename_char
80$ clc exit
rts
;
;

.subttl "HIGH LEVEL PARSING
;************************************************************************
; PARSING high level calls
;************************************************************************
;
;
;
; parse_for_open
;
parse_for_open
jsr parse_init
;
jsr get_filename_char
bcs 80$
cpy #'@
bne 10$
5$ sty replace_flag
jsr get_filename_char
bcs 30$
cpy #'@
beq 5$
jsr unget_filename_char
jmp 30$
;
10$ cpy #'$
bne 20$
sty parse_access ;!!!! kludge defining directory read as an
; type of access....
jmp 30$
20$ jsr unget_filename_char
;
30$ jsr eat_zero_colon eat zero colon
;
jsr get_filename get the filename
jsr get_mod_type get modifiers
bcs 90$
jsr get_filename_char if more stuff left
bcs 80$
lda #syntax_error puke
90$ sec
rts
;
80$ clc return
rts
;
;
;
.subttl "OPEN CHANNEL"
;************************************************************************
; NORMAL OPENS
;************************************************************************
;
;
;
; open 1 = parse
; check for existence of file
; do all checking which is independent of access
;
; open 2 = type dependent checking & actual opens
;
open_channel_given_sa
jsr select_channel_given_sa
cmp #15
bne 5$
jmp command_channel_open
;
5$ cpx #0 if channel is open
beq 10$
;
jsr close_channel_given_sa close it for the asshole
;
10$ jsr clear_error clear any old errors
jsr parse_for_open parse users filename
bcs 90$
;
lda parse_access if open of directory file
cmp #'$
bne 15$
jmp directory_open call directory_open
;
15$ lda #no_filename
ldx filename if no filename
beq 90$ puke
;
lda #0 found_flag <= 0
sta found_flag
;
lda parse_access if no parse_access
bne 20$
lda #'R access <= read
sta parse_access
;
20$ jsr find_a_file attempt to find the file
bcs 80$ if found
;
phd save file location
jsr select_channel_given_sa get our channel
pld recall file location
std current_block get the directory_block
jsr access_current_block
bcs 90$
;
lda #file_open puke if file is open
ldx dir_access
bne 90$
;
ldx dir_filetype x <= directory type
;
30$ lda type_char a <= type_char
stx type_char type_char <= x
beq 40$ if a <> 0
cmp dir_filetype if a <> dir_filetype
beq 40$
lda #file_type_mismatch file_type_mismatch
90$ sec puke
rts
;
40$ inc found_flag set found_flag
80$ lda type_char if no file type specified or found
bne 83$
lda #'S default too sequential file type
sta type_char
83$
;
.ifdef rel_flag
cmp #'L if relative file
bne 84$
jmp open2_rel do up the rel file parse
84$
.endif
;
lda parse_access if open for read
cmp #'R
beq open2_read call open for read
cmp #'A if open for append
beq open2_append
.ifdef position_flag
cmp #'F if access for fast
bne 85$
jmp open2_fast go open for fast
.endif
85$ jmp open2_write call open for write
;
; access request
; replace_request
; wild present
; type request
; found_flag
; r1--- error syntax ( replace and read access incompat )
; r0--0 error file not found
; r0-s1 open for sequential
; r0-p1 open prog for read
; r0-l1 open rel for read
; r1--- error syntax ( replace and read access incompat )
; r0--0 error file not found
; r0-s1 open for sequential
; r0-p1 open prog for read
; r0-l1 open rel for read
;
; access request
; replace_request
; wild present
; type request
; found_flag
; f-1-- error syntax ( illegal wild cards )
; f-0$- error syntax ( not on directory file , file_type_mismatch )
; f-0L- error syntax ( not on rel files, file type mismatch )
; f-0s0 open new seq file using open2_write
; f-0p0 open new prg file using open2_write
; f00s1 open existing seq file using open2_read
; f00p1 open existing prg file using open2_read
; f10s1 open existing seq file using open2_write
; f10p1 open existing prg file using open2_write
;
;
; access request
; replace_request
; wild present
; type request
; found_flag
; w-000 open seq file for write new
; w-0s0 open seq file for write new
; w-0p0 open prg file for write new
; w-0l0 open rel file for write new
; w1001 open seq file for write ( delete old )
; w10s1 open seq file for write ( delete old )
; w10p1 open prg file for write ( delete old )
; w10l1 open rel file for write ( delete old )
; w-!-- error illegal use of wild cards
; w00-1 error file exists
;
; w-!-- error illegal use of wild cards
; w00-1 error file exists
; w-000 open seq file for write new
; w-0s0 open seq file for write new
; w-0p0 open prg file for write new
; w-0l0 open rel file for write new
; w1001 open seq file for write ( delete old )
; w10s1 open seq file for write ( delete old )
; w10p1 open prg file for write ( delete old )
; w10l1 open rel file for write ( delete old )
;
; open2_read directory_block is current_block
;
open2_read
lda #syntax_error
ldx replace_flag if open for replace ( and read )
bne 90$ puke
;
lda #file_not_found if file not found
ldx found_flag
beq 90$ puke
;
jsr access_current_block access_current_block
bcs 90$
; access_channel
jsr select_channel_given_sa
;
ldd default_block copy default_block
;
std directory_block mark the directory_block in channel
std current_block mark pointing to first block
;
add dir_filelen add in the file length
std end_block end_block <= x,a
;
lda #dir_data_offset first byte pointer
sta current_byte
;
lda dir_last_byte end_byte <= from dir entry
sta end_byte
;
.ifdef rel_flag
;
lda dir_record_len mark record length and end record
sta record_len
ldd dir_end_record
std end_record
ldi 0 clear current record
std current_record
sta current_record_len
sta current_record_byte
; sta rel_write_flag
;
.endif
;
;
lda parse_access mark channel access type
sta channel_access
sta dir_access mark directory block as open
;
80$ clc return happy
rts
;
90$ sec error exit
rts
;
open2_append
lda #'W uh.. pretend this is opening for write...
sta parse_access
ldx found_flag if file not found
beq open2_write go open for write
;
lda #illegal_wild_card if wild cards
ldx wild_char
bne 90$ puke
;
jsr open2_read open as if for read
bcs 90$ puke if error
;
lda end_byte current block,byte <= end block,byte
sta current_byte
ldd end_block
std current_block
;
inc current_byte advance current block,byte by one
bne 20$
incd current_block
20$ clc return happy
rts
;
90$ sec
rts
;
.ifdef position_flag
open2_fast
lda #illegal_wild_card
ldx wild_char
bne 90$
lda #syntax_error
ldx type_char
cpx #'S
beq 10$
cpx #'P
beq 10$
sec
rts
;
10$ lda found_flag
beq open2_write
lda replace_flag
bne open2_write
jmp open2_read
;
90$ sec
rts
;
.endif
;
open2_write
lda #illegal_wild_card
ldx wild_char if wild_char <> 0
beq 10$ puke
jmp 90$
;
10$ ldx found_flag if found_flag <> 0
beq 20$
lda #file_exists
ldx replace_flag if not open for replace
beq 90$ puke
;
jsr access_current_block
jsr delete_file delete file and directory entry
;
20$ jsr select_channel_given_sa
jsr clear_channel
ldd disk_end point to end of disk
std current_block this will be the current block
std directory_block entire file is here
std end_block
;
jsr grow_disk make it grow from the end
bcs 90$ puke if error
;
jsr select_channel_given_sa
jsr access_current_block access the directory block to use
;
ldy #17 copy filename to dir block
70$ lda filename,y
sta dir_filename,y
dey
bpl 70$
;
lda type_char markl type in channel & directory
sta dir_filetype
;
.ifdef rel_flag
lda parse_record_len mark record_lengths ( in case rel )
sta dir_record_len
sta record_len
.endif
;
ldi 0
std dir_filelen number of blocks <= 0
;
lda #dir_data_offset mark last byte in dir file
sta dir_last_byte
sta end_byte mark last & current byte in channel
sta current_byte
;
lda parse_access mark directory & channel entry as open for write
sta dir_access
sta channel_access
;
; if rel file, end_record is already cleared
;
80$ clc return happy
rts
;
90$ sec
rts
;
.ifdef rel_flag
open2_rel
lda #'L set access and filetype to relative
sta parse_access
sta type_char
;
ldx found_flag if found_flag <> 0
beq 20$
;
jsr access_current_block access directory block
lda dir_record_len parse_record_len <= dir_rec_len
ldx parse_record_len if user specification of rec len
sta parse_record_len
beq 10$
cpx parse_record_len if wrong
bne 95$ HA ! puke !
;
10$ ldx replace_flag if not open for replace
bne 20$ go open it for read
jmp open2_read
;
20$ lda parse_record_len if record len zero
beq 95$ go puke
ldx found_flag if file not present
bne 30$
lda #illegal_wild_card
ldx wild_char if wild_char <> 0
bne 90$ puke
30$ jmp open2_write go open file for write
;
95$ lda #record_not_present
90$ sec
rts
;
.endif
;
;
;
.subttl "CLOSE CHANNEL"
;************************************************************************
; CLOSE CHANNEL
;************************************************************************
;
close_all_channels
ldx #num_channels-1
10$ txa
pha
jsr select_channel_a
jsr close_channel_default
pla
tax
dex
bpl 10$
clc
rts
;
;
close_channel_given_sa_user ;<4.2 fab>
lda sa ;<4.2 fab> if closing command channel...
and #$0f ;<4.2 fab>
cmp #15 ;<4.2 fab>
beq close_all_channels ;<4.2 fab> ...then close all others too.

close_channel_given_sa
jsr select_channel_given_sa
;
close_channel_default
lda default_channel_number .a <= channel number
ldx channel_access .x <= channel open flag
; if not open
beq 80$
cmp #15 if not command channel or dir file
beq 70$
cpx #'$
beq 70$
;
ldd directory_block access the directory block
std current_block
jsr access_current_block
bcs 90$
;
lda end_byte copy length of file to dir_blocks
sta dir_last_byte
;
ldd end_block
sbd directory_block
std dir_filelen
;
.ifdef rel_flag
ldd end_record copy number of recordes to directory
std dir_end_record
.endif
;
lda #0 mark dir as closed
sta dir_access
;
70$ lda #0 mark channel as closed
sta channel_access
;
80$ clc return happy
90$ rts
;
;

.subttl "COMMAND CHANNEL"
;************************************************************************
; COMMAND CHANNEL OPEN AND WRITE
;************************************************************************
;
;
command_len_max = 40 max length of command
ram command_len length of command
ram command,41 actual command text
;
;
command_channel_open
lda #15
jsr select_channel_given_sa
lda #'W
sta channel_access ; mark the channel as open
;
jsr init_get_filename read filename into filename_buffer
ldy fnlen if filename not present
clc
beq 8$ return happy
cpy #command_len_max if filename too long
bcc 10$
lda #long_line puke
8$ rts
;
10$ sty command_len mark length of command
dey
20$ lda remote_filename_buffer,y copy name to command_buffer
sta command,y
dey
bpl 20$
;
command_clear_and_interpret
jsr interpret_command interpret the command
ldx #0 clear command length
stx command_len
rts return possible error
;
;
cleanup_command_write
clc add in length of command
adc command_len
sta command_len
beq 10$
jsr command_clear_and_interpret execute command
bcc 10$
jsr error_channel_set_up possible_error ?
10$ rts
;
;
command_channel_write
ldy data_byte .y <= data to write

; lda command_len if command length is null
; bne 5$
; cpy #cr if command is simple cr
; bne 5$
; clc
; jmp disk_system_return just return
;
; ( command was interpreted by
; cleanup command write )
;
5$ lda #command_len_max .a <= number of free bytes in command
sec
sbc command_len
bcs 20$ if < 0
;
cpy #cr if char is a cr
bne 10$
lda #0 command_len <= 0
sta command_len
10$ lda #long_line puke long line error
jmp disk_system_return_error
;
20$ cpy #cr if char is a cr
bne 30$
jsr interpret_command
ldx #0 clear command
stx command_len
jmp disk_system_return return to user passing possible error
;
30$ tay save free bytes in .y
ldi cleanup_command_write
std cleanup_vector set up cleanup vector
; set up dma disk address
ldi command-swapped_code_start
clc
adc command_len
bcc 40$
inx
40$ std dma_disk_addr
lda #0
sta dma_disk_bank
;
tya .a <= number of bytes can write
clc this is a write operation
jmp return_execute_fastop
;
;
;
;
.subttl "COMMAND DISPATCH"
;************************************************************************
; COMMAND DISPATCH
;************************************************************************
; commands:
; Rename<0<:>>filename=<0<:>>filename
; Copy<0<:>>filename=<0<:>>filename
; Scratch<0<:>>filename
; New<0<:>>filename,idh <4.1 fab>
; Initialize<0<:>>
; Validate<0<:>>
; P<96+channel_number><record_low><record_high><offset>
; Uxxxx
;
com_def .macro %c,%r
.byte %c
.dbyte %r-1
.endm
;
commands
com_def 'S',scratch_command
com_def 'R',rename_command
com_def 'C',copy_command
com_def 'N',new_command ;<4.1 fab>
com_def 'M',m_command ; m-w,m-r ( used only for dev change )
com_def 'I',init_command
com_def 'U',u_command
com_def 'V',validate_command
.ifdef rel_flag
com_def 'P',position_command
.endif
.byte 0
;
command_pntr = pntr
;
next_command
jsr 10$
jsr 10$
10$ incd command_pntr
rts
;
;
interpret_command
jsr error_channel_ok_set_up
jsr parse_init
jsr init_get_filename_from_command
ldi commands
std command_pntr
lda command_len
beq 80$
;
jsr get_filename_char
tya
tax
;
ldy #<-3
10$ iny
iny
iny
lda (command_pntr),y
bne 20$
lda #illegal_command
sec
rts
;
20$ txa
cmp (command_pntr),y
bne 10$
;
;
30$ iny push command address on stack for rts
lda (command_pntr),y
pha
iny
lda (command_pntr),y
pha
;
40$ nop
;
80$ clc
rts
;
eat_until_colon
jsr get_filename_char eat chars until colon encountered
bcs 80$ ( or end of command encountered )
cpy #':
bne eat_until_colon
80$ clc
rts
;
;
;
.subttl "INDIVIDUAL COMMANDS"
;************************************************************************
; COMMANDS
;************************************************************************
;
ram scratch_cntr,2
;
scratch_command
jsr eat_until_colon
jsr get_filename
bcs 90$
; no need to consider rest of filename
ldi 0000 cntr <= 0
std scratch_cntr
;
10$ jsr find_a_file while can find a file with matching name
bcc 20$
cmp #file_not_found
beq 80$
sec
rts
; do
20$ ldd current_block close any channels which may be pointing
jsr close_pointing_channels
incd scratch_cntr cntr++
jsr delete_file delete file
bcc 10$
;
90$ sec
rts
;
80$ ldd scratch_cntr return cntr
jmp error_channel_scratch_set_up
;
;
;
ram close_pointing_block,2
ram channel_exception
;
close_pointing_channels ; except directory channel
std close_pointing_block ; save block to deal with
lda default_channel_number ; channel exception <= currentt channel
sta channel_exception
lda #num_channels-1 ; .a <= highest channel number
10$ jsr select_channel_a do select channel a
beq 30$ if open
ldd close_pointing_block andif dirblock=outblock
cpd directory_block
bne 30$
lda default_channel_number andif not our channel
cmp channel_exception
beq 30$
lda #0
sta channel_access close channel
30$ lda default_channel_number .a <= default_channel-1
clc
adc #$ff
bcs 10$ while a > 0
lda channel_exception restore our channel
jmp select_channel_a
;
validate_command
jsr close_all_channels
jsr clear_error
10$ jsr find_open_file
bcs 80$
jsr delete_file
bcc 10$
;
80$ cmp #file_not_found
bne 90$
clc
90$ rts
;
;
new_command ;<4.1 fab> added routine
ldd first_block
std disk_end
clc
rts
;
;
rename_command
jsr parse_for_rename_copy
bcs 90$
;
ldx #$ff
10$ inx
lda alt_filename,x
sta dir_filename,x
bne 10$
clc
rts
;
90$ sec
rts
;
ram copy_block,2
;
copy_command

jsr parse_for_rename_copy puke if parse fails
bcs 90$
;
ldd dir_filelen if will not fit
sec
addc disk_end
cpd disk_max
beq 10$
bcs 91$ puke
;
10$ std copy_block save limiting location for copy
;
ldd disk_end save where new dir_block will be
phd
;
20$ ldd disk_end do fake out access_disk
std default_block
incd current_block point to next block
incd disk_end add block to disk
jsr access_current_block do it.
cmpdr disk_end,copy_block,a
bne 20$ loop until disk_end = copy_block
;
pld point to new directory block
std current_block
jsr access_block_a
ldx #$ff copy alt_filename to new block
30$ inx
lda alt_filename,x
sta dir_filename,x
bne 30$
;
sta dir_access mark file as closed
;
clc return happy
rts
;
91$ lda #disk_full
90$ sec
rts
;
;
uj_command
ui_command
ucolon_command
jsr close_all_channels ; close all channels
jmp error_channel_init_set_up ; reset init message & return
;
init_command
jsr close_all_channels
jmp clear_error
;
u_command
jsr get_filename_char ; get second another char
bcs 90$
cpy #': ; if colon
beq ucolon_command ; do ucolon
cpy #'J ; if j
beq uj_command ; go do dat uj command stuff..
cpy #'I ; if i
beq ui_command ; do ui command stuff
cpy #'0 ; if not zero
bne 90$ puke
jsr get_filename_char ; get more
bcs 90$
cpy #'> ; if not >
bne 90$ puke
clc
.byte $24
90$ sec
; rem
;
set_unit_or_bitch
bcs 90$
jsr get_filename_char
bcs 90$
tya ; .a <= char masked to 0-31
cmp #31 ; <4.1 fab>
bcs 90$
cmp #4
bcc 90$
jmp set_unit_number ; go set unit number and return
;
90$ lda #illegal_command
sec
rts
;
;
m_command
jsr get_filename_char ; eat dash
jsr get_filename_char ; check for W
bcs 90$
cpy #'W
bne 90$
jsr get_filename_char ; get low order address
bcs 90$
cpy #119 ; if not 119 or 120
beq 10$
cpy #120
bne 90$ ; puke
10$ jsr get_filename_char ; get high order address
bcs 90$
cpy #0 ; if not null
bne 90$ puke
jsr get_filename_char ; eat the number of bytes to write...
bcs 90$ ; puke if not there or null
cpy #0
beq 90$
clc
.byte $24
90$ sec
jmp set_unit_or_bitch
;
;
;
.subttl "PARSE FOR RENAME/COPY"
;************************************************************************
; "PARSE FOR RENAME/COPY"
;************************************************************************
;
; does parsing. copys first filename to alt_filename
; verifys that first does not exist.
; parse second file name
; verifies that file does exist.
; returns with current channel pointing to default block
;
;
;
parse_for_rename_copy
jsr eat_until_colon
jsr get_filename
bcs 90$
;
lda wild_char puke if dem wild chars
bne 91$
;
jsr find_a_file
lda #file_exists
bcc 90$
;
ldx #$ff
10$ inx
lda filename,x
sta alt_filename,x
bne 10$
;
jsr get_filename_char
bcs 90$
cpy #'=
bne 91$
;
jsr eat_zero_colon
jsr get_filename
bcs 90$
;
lda #no_filename
ldx filename
beq 90$
;
jsr find_a_file
bcs 92$
jmp access_new_current_block
;
92$ lda #file_not_found
.byte $2c
91$ lda #syntax_error
90$ sec
rts
;
;
.subttl "READ DIRECTORY"
;************************************************************************
; READ DIRECTORY FOR USER
;************************************************************************
;
;
ram dir_line,50
;
; directory open
; entry: parse for open called
; filename = filename
; filetype = filetype
; parse_access = $
; end byte in file not checked
; default channel is users channel
;
;
;
directory_open
lda #'$ mark channel access as directory
sta channel_access
;
jsr select_dir_channel
lda #0
sta current_byte clear the currents
sta current_block
sta current_block+1
;
lda filename if filename is null
bne 20$
sta filename+1 filename <= "*"
lda #'*
sta filename
20$ jmp format_first_line format first line and return
;
;
directory_cleanup
clc
adc current_byte
sta current_byte
rts
;
;
directory_read
jsr select_dir_channel select the directory channel
ldy current_byte if no bytes left in line
cpy end_byte
bcc 80$
;
jsr directory_format_next_line
bcc 80$ if done
clc
jmp disk_system_return_eof_timeout go return timeout
;
80$ ldi directory_cleanup cleanup vector point to directory cleanup
std cleanup_vector
ldi dir_line-swapped_code_start
clc dma_disk_addr points to appropriate dir line
adc current_byte
bcc 85$
inx
85$ std dma_disk_addr
lda #0
sta dma_disk_bank
;
lda end_byte .a <= number of bytes left to return to user
sec
sbc current_byte
;
ldx system_reg_x restore x,y
ldy system_reg_y
sec this is a read operation
jmp return_execute_fastop return via fastop
;
;
;
; directory_format_next_line
;
; entry: current channel is directory channel
; filename is set up
; exit: c=0 operation is ok
; c=1 EOF return one null to user
;
;
directory_format_next_line
10$ zchk current_block if current_block = 0
bne 20$
ldd first_block x,a <= first_data_block
jmp 40$ else

20$ ldd current_block if current_block >= end of disk
cpd disk_end
bcc 30$
rts return c=1 ( done )
;
30$ jsr access_current_block access_current_block
ldd current_block x,a <= address of next block
sec
addc dir_filelen
;
40$ std current_block current_block <= x,a
cpd disk_end if >= disk_end
bcc 50$
jsr format_last_line
jmp 70$ else
;
50$ jsr access_current_block access the block
;
jsr compare_filenames compare the filenames
bcs 10$ if no match,
; go look for next
; lda type_char if type specified
; beq 60$
; cmp dir_filetype if <> dir_filetype
; bne 10$ go look for next
;
60$ jsr format_nth_line format the nth line
;
70$ lda #0 current_byte <= 0
sta current_byte
clc return c=0
rts
;
format_first_line
ldx #end_first_line_text-first_line_text
stx end_byte
dex
10$ lda first_line_text,x
sta dir_line,x
dex
bpl 10$
clc
rts
;
first_line_text
.byte $01,$10 ; load address
.byte $01,$10 ; next line address
.byte $00,$00 ; line number
.byte $12,$22 ; rvs on, quote
; 0123456789abcdef
.byte "RAMDISK V"
version
.byte " " ; 16 char disk name
;
.byte $22 ; terminal quote
.byte " HD 00" ; id and version
.byte 0 ; trailing null
;
end_first_line_text
;
;
;
last_line_text
.byte $01,$10 ; next line address
.byte $00,$00 ; line number
; 0123456789abcdef01234567
.byte "BLOCKS FREE ",0,0
end_last_line_text
;
format_last_line
ldx #end_last_line_text-last_line_text
stx end_byte
dex
10$ lda last_line_text,x
sta dir_line,x
dex
bpl 10$
;
ldd disk_max ; set up the number of free blocks
sbd disk_end
std dir_line+2
clc
rts
;
format_nth_line
ldx #32
stx end_byte
;
lda #$20 clear line except line number and link
10$ sta dir_line,x
dex
cpx #3
bne 10$
;
lda #$22 opening quote
sta dir_line+4
;
ldx #0 copy filename until 17 chars or null
20$ lda dir_filename,x
sta dir_line+5,x
beq 30$
inx
cpx #17
bne 20$
;
30$ lda #$22 close quote
sta dir_line+5,x
;
ldy #'S set up type of file....
lda #'E
ldx #'Q
cpy dir_filetype
beq 40$
;
ldy #'P
lda #'R
ldx #'G
cpy dir_filetype
beq 40$
;
ldy #'U
lda #'S
ldx #'R
cpy dir_filetype
beq 40$
;
ldy #'R
lda #'E
ldx #'L
;
cpx dir_filetype
beq 40$
;
lda #'?
tax
tay
;
;
40$ sty dir_line+23
sta dir_line+24
stx dir_line+25
;
lda dir_access if file is open for write
cmp #'W
bne 50$
lda #'* mark it as such
sta dir_line+22
;
50$ ldd dir_filelen mark number of blocks
addi $0001
std dir_line+2
;
70$ cpi 1000 if < 1000 blocks
bcs 80$
cpi 100 if < 100 blocks
bcs 72$
cpi 10 if < 10 blocks
bcs 71$
;
jsr 100$ insert space
71$ jsr 100$ insert space
72$ jsr 100$ insert space
;
;
80$ lda #0 terminating null
sta dir_line+31
clc return happy
rts
;
;
100$ ldx #4 insert a space in front of name
lda #$20
;
110$ ldy dir_line,x
sta dir_line,x
tya
inx
cpx #32
bne 110$
rts
;

.subttl "LOAD HIGH LEVEL"
;*****************************************************************************
; LOAD
;*****************************************************************************
;
;
;
; sa =0 memuss = loading address
; <>0 load at address specified by file
;
; .a = 0 load
; .a <> 0 vefify only
;
; ba destination bank
;
; file_not_found_exit
; set b1 of status
; error4
;
; load of directory
; load of file...
;
;
;rload ldx fa ; load
; fa_cmp x
; beq 10$
; continue load
;10$ abs_ref jsr,swap_disk
; jmp disk_load
;
disk_load
sta verck
lda fnlen if user has no filename
bne 5$
lda #8 .a <-= kernal kernal error code
bne 90$ go return kernal error
;
5$ jsr disk_load_1
;
bcc 80$
;
cmp #0 if error code is zero
bne 20$
lda verck if verck is zero
bne 10$
lda #16 .a <= 16 ( out of mem error )
bne 90$ go return via kernal err handler
;
10$ lda #$10 set bits in status for verify error
ora status
sta status
bne 80$ go return happy
;
20$ jsr error_channel_set_up set up the error code for error channel
lda #$02 set up IEEE timeout error
ora status
sta status
;
lda #4 return file not found error in kernal
bne 90$
;
80$ lda #$40 return EOF in error status
ora status
sta status
ldx eal good exit return end load address
ldy eah
clc
jmp disk_direct_return return to user directly
;
;
90$ tay save error code in .a
100$ = kernal_error-1
lda #>100$ stack a return to kernal error routine
pha
lda #<100$
pha
tya .a <= error code
jmp disk_direct_return return to that after swapping out DOS
;
;
;
; disk_load_1
; does all the major parsing and performs the load
;
; exit:
; eal,eah point to last byte + 1
; c=0 ok
; c=1 .a = 0 verck = 0 out of memory error
; c=1 .a = 0 verck != 0 verify error
; c=1 .a != 0 error code in .a
;
disk_load_1
lda #0 clear status
sta status
;
jsr luking
jsr parse_for_open parse input stuff
bcs 90$ puke if error
jsr get_filename_char if more
bcc 91$ puke syntax
lda replace_flag if replace flag
bne 91$
;
lda parse_access if $
cmp #'$
bne 10$
jmp directory_load goto directory_load
;
10$ ora type_char if type char or access char
bne 91$ puke
;
lda #no_filename if no filename
ldx filename
beq 90$ puke
;
jsr find_a_file if cannot find file
bcs 90$ puke
;
std current_block get the directory block
jsr access_current_block
;
lda #file_type_mismatch if not prg file
ldx dir_filetype
cpx #'P
bne 90$ puke
;
ldx dir_access if not open
beq do_load go do the load
lda #file_open file_open error
.byte $2c
92$ lda #file_not_found
.byte $2c
91$ lda #syntax_error
90$ sec
rts
;
;
.subttl "LOAD LOW LEVEL"
;*****************************************************************************
; DO_LOAD
;*****************************************************************************
;
;
; do_load
; entry:
; sa =0 memuss = loading address
; <>0 load at address specified by file
; verck = 0 load
; <> 0 vefify only
; ba destination bank
; load save channel selected
; current_block is directory block & is accessed
;
; exit: c=0 load completed
; c=1 verck <> 0 verify error
; c=1 verck = 0 out of mem error ( $ff00 )
;
do_load jsr loding tell user
jsr flush_block flush disk buffers ( play it safe )
;
10$ ldd memuss set up the cpu address to load at
ldy sa
beq 20$
ldd data_block+dir_data_offset
20$ std dma_cpu_addr
;
ldy #dir_data_offset+2 set up the disk address to load from
sty dma_disk_addr
ldd current_block
std dma_disk_block
; ; calculate length of transfer
; 256*dir_len+end_byte-(dir_data_offset+2)+1
sec
lda dir_last_byte
sbc #dir_data_offset+1
tay
ldd dir_filelen
sbc #0
bcs 30$
dex
jmp 30$
;
;
;
255$ ldx #0 ; entry for directory load routine
txa
ldy end_byte ; x,a,y <= length in bytes for xfer
;
;
30$ sty dma_len mark length based on file
sta dma_len+1
cpx #0 save set Z flag if not too large
php
;
ldi $efff x,a <= length of xfer to $efff
sbd dma_cpu_addr
plp recall z flag
bne 50$ if Z flag or x,a < transfer len
cpd dma_len
bcs 60$
50$ std dma_len length <= len to $efff
jsr 60$ call 60$
jmp 90$ return error
;
60$ ldd dma_cpu_addr tell user end address
add dma_len
std eal
lda dma_len if length is zero
ora dma_len+1
beq 80$ done....
;
ldy #dma_banked_read y <= code for loads
lda verck if verck
beq 70$
ldy #dma_banked_compare y <= code for verify
70$ jsr remote_dma do the remote_dma operation
lda verck if no verck
beq 80$ return happy
lda dma_status .a < status
and #%00100000 verck <= fault status
sta verck if none
beq 80$ exit happy
;
90$ lda #0 complain, but no error
sec
rts
;
80$ clc
rts
directory_load_entry = 255$
;
;
.subttl "DIRECTORY LOAD"
;*****************************************************************************
; DIRECTORY_LOAD
;*****************************************************************************
;
;
; DIRECTORY_LOAD
; entry:
; sa =0 memuss = loading address
; <>0 load at address specified by file
; verck = 0 load
; <> 0 vefify only
; ba destination bank
;
; exit: c=0 load completed
; c=1 verck <> 0 verify error
; c=1 verck = 0 out of mem error ( $ff00 )
;
directory_load
jsr loding tell user
jsr directory_open do normal directory open
;
10$ ldd memuss eal,eah <= cpu address to load at
ldy sa
beq 20$
ldi $1010
20$ std eal
;
dec end_byte remove the first two bytes from directory line
dec end_byte ( can you say load address ? )
ldx #$ff
30$ inx
lda dir_line+2,x
sta dir_line,x
cpx end_byte
bcc 30$
;
; do
40$ jsr 100$ load a sinfle line
;
bcs 90$ exit if error
;
jsr directory_format_next_line format the next line
bcc 40$ loop while another line ready
;
ldx #0 make dir_line contain a single null...
stx dir_line
inx
stx end_byte
jsr 100$ send that
;
90$ lda #0 return a null
rts return
;
100$ ldi dir_line-swapped_code_start disk addr is where dir line is
; when disk swapped out !!!!
std dma_disk_addr
lda #0
sta dma_disk_bank
;
ldd eal cpu addr <= eal,eah
std dma_cpu_addr
;
jmp directory_load_entry use a hunk of normal load for xfer
;

.subttl "SAVE"
;********************************************************************
; SAVE
;********************************************************************
;
; enrty
; (y,x) eal ending address of area to save
; (@a) stal starting address of area to save
; ba bank source
;
;
;rsave lda fa ; save
; fa_cmp a
; beq 10$
; continue save
;10$ abs_ref jsr,swap_disk
; jmp disk_load
;
;
disk_save_1
lda #0 clear status
sta status
jsr saving
jsr parse_for_open parse input stuff
bcs 90$
;
10$ lda type_char if type char,access_char,wild_char <> 0
ora parse_access ( includes save "$:asda" )
ora wild_char
bne 91$ puke
;
lda #no_filename if no filename
ldx filename
beq 90$ puke
;
jsr find_a_file if can find file
bcs 20$
std current_block
jsr access_current_block
;
lda #file_exists if no replace
ldx replace_flag
beq 90$ puke
;
lda #file_type_mismatch if not prg file
ldx dir_filetype
cpx #'P
bne 90$ puke
;
lda #file_open if open
ldx dir_access
bne 90$ puke
;
jsr delete_file delete the file
;
20$ jmp do_save
;
92$ lda #file_not_found
.byte $2c
91$ lda #syntax_error
90$ sec
rts
;
;
do_save ldd disk_end save always at end of disk....
cpd disk_max if full
bcc 1$
;
lda #disk_full puke
sec
rts
;
1$ jsr access_new_current_block block x,a <= current
;
ldd stal write starting address
std data_block+dir_data_offset
;
ldd eal x,a <= length of file
sbd stal
;
tay stack length (preserve x, a)
phd
tya
;
addi $ffff point to last byte, not last+1
;
clc add header offset & mark header
adc #dir_data_offset+2
sta dir_last_byte
txa
adc #0
sta dir_filelen
;
lda #0
sta dir_filelen+1
asl dir_filelen+1
sta dir_access mark access as closed
;
lda #'P mark type
sta dir_filetype
; copy name to header
ldx #$ff
10$ inx
lda filename,x
sta dir_filename,x
bne 10$
;
jsr flush_block flush current block to ramdisk
;
pld recall length of transfer
std dma_len write to dma controller
ldd stal write start address to controller
std dma_cpu_addr
;
ldd current_block set up disk dma address
std dma_disk_block
lda #dir_data_offset+2
sta dma_disk_addr
; oh yeah.. check size of disk after save
;
ldd dir_filelen x,a <= end of disk after save
sec
addc disk_end
cpd disk_max if > disk_max
bcc 80$
;
lda #disk_full puke
rts
;
80$ std disk_end mark new end of disk
;
ldy #dma_banked_write use dma to do save
jsr remote_dma
jsr unflush_block read back into default page
;
clc return happy
rts
;
;

.subttl "DOS ENTRY ROUTINES"
;****************************************************************************
; FIRST_DISK_ROUTINES
;****************************************************************************
;
ram system_reg_x
ram system_reg_y
;
disk_io
jsr cleanup_fastop_pntr
stx system_reg_x save regies...
sty system_reg_y
sta data_byte
bcc 10$
lda status ;<4.2 fab>
bne 5$ ;<4.2 fab> bad prior status?
jmp read_byte_given_sa ;<4.2 fab> ...no, do basin
5$ jmp disk_system_return_cr_eof ;<4.2 fab> ...yes, just pass <cr> & exit
;
10$ jmp write_byte_given_sa
;
.ifdef rel_flag
disk_ckout
.endif
cleanup_user_dma
jsr cleanup_fastop_pntr ( so much for that )
jmp disk_direct_return return
;
;
disk_close
.ifdef rel_flag
bcc disk_ckout
.endif
jsr cleanup_fastop_pntr ; clean up....
txa move index to .a
jsr jxrmv remove the bugger please ( .a = index )
.ifndef c64
plp ;<4.2 fab> if c128, is this a real close (c=0)?
; bcs 10$ ; branch if a special close...
nop ;<4.3 fab> placeholders
nop
.endif
.ifdef c64
jsr close_channel_given_sa_user close our version of it <4.2 fab>
.endif
.ifndef c64
jsr close_channel_given_sa_patch close our version of it <4.2 fab>
.endif
.ifndef c64
10$ clc ;<4.2 fab> always happy
.endif
jmp disk_system_return return to user
;
;
disk_open_nmi
jsr cleanup_fastop_pntr clean house there shit head
sta data_byte save .a
bcs 10$ if c=0
jmp disk_run_stop_restore uh oh... better call maaco...
;
10$ lda fa if not for disk
cmp disk_fa
beq disk_open stack return address of continue
lda copen+1 x,a <= open stuff
pha
lda copen
pha
lda data_byte
jmp disk_direct_return do a direct return to let someone else
; have this open...
;
disk_open
lda fa save file address on stack
pha
lda #0
sta fa
jsr cheap_open ; jump right on in here boys....
tay restore stacked fa preserveing .a,.x
pla
sta fa
tya
bcs disk_direct_return
lda fa
sta fat,x ; just stick the data where ever
jsr open_channel_given_sa
jmp disk_system_return
;
;
disk_load_save
php save that carry too
pha better save that .a
;
jsr cleanup_fastop_pntr
;
lda fa if uh.. its not for us...
cmp disk_fa
beq disk_load_save_2
;
pla data byte <= .a
sta data_byte
plp recall who it was ( load or save )
bcc 10$ if save
lda csave+1 stack return to continue vector
pha
lda csave
pha
lda data_byte
jmp disk_direct_return return to user to let save to elsewhere
;
10$ lda cload+1 stack a reutrn to load
pha
lda cload
pha
lda data_byte
jmp disk_direct_return return to user to load from elsewhere

disk_load_save_2
pla recall that .a
plp recall load / save
bcs disk_save
jmp disk_load
disk_save
jsr disk_save_1
jmp disk_system_return
;
disk_system_return_eof_timeout
lda #$42
sta status
lda #0
jmp disk_system_return_timeout_entry
;
;
disk_system_return_error
sec
bcs disk_system_return
disk_system_return_cr_eof
lda #cr
.byte $2c
disk_system_return_null_eof
lda #0
disk_system_return_eof
sta data_byte data byte <- value to return
lda #$ff set eof flag
sta eof_flag
clc this returns no errors
disk_system_return
bcc 20$ if error
rol eof_flag set eof flag
jsr error_channel_set_up set up error channel
lda #cr errors return carriage returns
sta data_byte
;
20$ jsr eof_check set up eof status
50$ lda data_byte
disk_system_return_timeout_entry
ldx system_reg_x set up registers
ldy system_reg_y
clc return no buss error
;
disk_direct_return
sta data_byte save .a
lda interface_page
pha stack return to fast
lda #<fast-1
pha
lda interface_page stack return to swap disk
pha
lda #<swap_disk-1
pha
lda pntr_save restore users pointer
sta pntr
lda pntr_save+1
sta pntr+1
lda data_byte .a <= data byte
rts return to swap disk enable
;
eof_check
lda eof_flag
beq 10$
lda #$40
ora status ;merge EOF into status byte <4.2 fab>
10$ sta status
lda #0
sta eof_flag
rts
;
;
disk_run_stop_restore
jsr restor do the damn restore
jsr install_vectors install our vectors ( sneaky no ? )
mactmp = no_restor_restore-1
lda #>mactmp push return to nmi code less the restore
pha
lda #<mactmp
pha
;
lda interface_page stack return to swap disk
pha
lda #<swap_disk-1
pha
rts return via swap disk and exit...
;
;

.subttl "REMOTE DMA ROUTINES"
;****************************************************************************
; REMOTE DMA ROUTINES
;****************************************************************************
;
ram stack_restore_registers_dma_op
;
; read_users_filename
; dmas system filename into ram at remote_filename_buffer
;
read_users_filename
ldd fnadr set up cpu address
std dma_cpu_addr
lda fnlen set up transfer length
bne 1$ ( if zero then return )
rts
1$ sta dma_len
lda #0
sta dma_len+1
sta dma_disk_bank set up disk address
ldi remote_filename_buffer-swapped_code_start
std dma_disk_addr
.ifndef c64
ldx fnbank x <= bank
.endif
ldy #dma_banked_write y <= dma command
jmp remote_dma_bank_x perform remote dma
;
;
; remote_dma
; entry: dma registers set for transfer
; y = controller code for transfer
; x = desired bank for transfer
;
remote_dma
.ifndef c64
ldx ba stack mmu cfg for dma bank
.endif
remote_dma_bank_x
sty stack_restore_registers_dma_op
lda interface_page push call to swap disk ( no speed adjust )
pha
lda #<swap_disk-1
pha
;
.ifndef c64
;
lda #>down_load_area push a call to downloaded code
pha
lda #<down_load_area-1
pha
;
jsr getcfg .a <= mmu config
pha save
and #%11000000 get high order bits only
ora mmurcr .x <= mmurcr
tax
pla recall mmucr
;
.endif
;
jmp stack_restore_registers do that restore register thing
;
; call restore dma registers
; call downloaded code
; call swap_disk
; return
;
;
; stack_restore_registers
;
; call this routine.
; when returned, the next return you perform will:
; restore the dma registers
; restore x,a to value at entry
; perform an rts
;
;
; entry: routine is jsred too
; .x,.a = x,a registers for return after restore reg
; dma registers are setup for transfer
;
; exit: x,a stacked
; dma registers are stacked for restore registers
; call to restore registers is stacked
; y preserved
;
;
;
stack_restore_registers
pha stack users .a
txa stack users .x
pha
;
lda stack_restore_registers_dma_op push controller code....
.ifdef c64
ora #%00010000 execute immediately....
.endif
pha
;
ldx #2 stack dma registers ( 9 of em.. )
10$ lda dma,x
pha
inx
cpx #$0b
bne 10$
;
lda interface_page stack a call to restore registers
pha
lda #<restore_registers-1
pha
;
lda interface_page stack a call to swaap disk ( no speed )
pha
lda #<swap_disk-1
pha
lda pntr_save restore the users pointer
sta pntr
lda pntr_save+1
sta pntr+1
;
clc return carry clear
rts execute swap disk and restore registters
; perform rts
;
;
;
saving
ldi _saving-1
jmp remote_call
luking
ldi _luking-1
;
remote_call
tay save .a in .y
lda interface_page stack a call to swap disk slow
pha
lda #<swap_disk_slow-1
pha
txa stack a call to routine in x,y
pha
tya
pha
jmp disk_direct_return let this do the work
;

.subttl "FASTOP ROUTINES"
;****************************************************************************
; FASTOP ROUTINES
;****************************************************************************
;
; .byte <fastop ; fast op code start
; .byte <fastop_sa_loc ; sa location for fastop
; .byte <fastop_dmaop_loc ; dma_op code
; .byte <fastop_dma_destination ; low order address of dma_cpu_addr
; .byte <fastop_cntr ; counter for fastop cycles
; .byte <bsout_fastop_loc ; opcode for bit or jsr routines, bsout
; .byte <basin_fastop_loc ; opcode for bit or jsr routines, basin
;
;
ram fastop_max
;
;
;
cleanup_fastop_pntr
php save status
pha save .a
lda pntr
sta pntr_save
lda pntr+1
sta pntr_save+1
;
lda fastop_max if number of fastop bytes <> 0
beq 85$
txa save .x
pha
tya save .y
pha
lda interface_page pntr <= address of interface block
sta pntr+1
lda #0
sta pntr
;
lda #$2c kill both fastops
ldy #<basin_fastop_loc
sta (pntr),y
ldy #<bsout_fastop_loc
sta (pntr),y
;
.ifdef rel_flag
;
lda #$60 kill chkout_swap
ldy #<ckout_swap_op
sta (pntr),y
;
.endif
;
ldy #<fastop_cntr .a <= number of bytes transfered
sec
lda fastop_max
sbc (pntr),y
jsr 100$ call users cleanup routine
;
;
80$ pla recall y
tay
pla recall x
tax
lda #0 fsatop_bytes <= 0
sta fastop_max
85$ pla recall .a
plp recall status
rts continue with the call
;
100$ jmp (cleanup_vector)
;
;
; return_setup_fastop
; swaps disk, and sets up fastop before returning to user
; does a rts to user with fastop set up
; return_execute_fastop
; swaps disk, and executes a fastop before returning to user
;
; entry: dma_disk_bank,dma_disk_addr set up
; cleanup vector pointed to correct cleanup routine.
; a = number of bytes to fastop
; c = 0 writeing to disk
; c = 1 reading from disk
; sa = set up for current channel
; exit:
; control returned to users routine
;
io_fastop
std cleanup_vector set up cleanup vector
ldd current_block set up dma disk address
std dma_disk_block
lda current_byte
sta dma_disk_addr
tya .a <= number of bytes to move
bcc return_setup_fastop if write, just setup (kludge)
; fall through to setup/execute
;
return_execute_fastop
tax
lda interface_page stack the fake rts to be removed (KLUDGE_MAX)
pha ( corrects for pla,pla inside of fastop )
lda #<fastop_fake_rts-1
pha
lda interface_page stack a rts to fastop itself
pha
lda #<fastop-1
pha
txa
jmp return_execute_fastop_entry
;
return_setup_fastop ; stack a return to fast
tax
lda interface_page
pha
lda #<fast-1
pha
txa
;
return_execute_fastop_entry
sta fastop_max save number of bytes
lda #0 pntr <= address of interface block
sta pntr
lda interface_page
sta pntr+1
;
ldy #<fastop_dmaop_loc y <= pointer to dma operation location
;
bcs 10$ if write
;
lda #dma_fastop_write (pntr),y <= dma_immdeiate_write
sta (pntr),y

; ldy #$f0 .y <= opcode for BEQ
; lda sa if sa is not command channel
; and #$0f
; eor #$0f
; beq 5$

.ifdef rel_flag
;
ldy #$60 .y <= opcode for RTS
lda channel_access if relative file access
eor #'L
bne 7$
ldy #$EA .y <= opcode for NOP
7$ tya
ldy #<ckout_swap_op write at chkout_swap_op
sta (pntr),y
;
.endif
;
ldi $202c x <= jsr, a <= bit
bcc 20$ else
;
10$ lda #dma_fastop_read (pntr),y <= read operation
sta (pntr),y
ldi $2c20 x <= bit, a <= jsr
;
20$ ldy #<basin_fastop_loc opcode for read <= .a
sta (pntr),y
ldy #<bsout_fastop_loc opcode for write <= .x
txa
sta (pntr),y
;
ldy #<fastop_sa_loc set fastop sa loc
lda sa
and #$0f
sta (pntr),y
;
ldy #<fastop_cntr set up the max byte count
lda fastop_max
sta (pntr),y
;
;
lda interface_page set dma host address
sta dma_cpu_addr+1
lda #<fastop_dma_destination
sta dma_cpu_addr
;
lda #0 select no interupts
sta dma_ifr
lda #$80 fix cpu address
sta dma_acr
;
ldi 1 select transfer length of 1 byte
std dma_len
;
ldx system_reg_x setup users a,x,y
ldy system_reg_y
lda #0 set up stack_restore_registers final opcode
sta stack_restore_registers_dma_op
lda data_byte
jmp stack_restore_registers stack them restore register guys
;
.ifndef c64
;
;
.subttl C128 PATCH SPACE
brk

close_channel_given_sa_patch ;close our version of it <4.3 fab>

bcs 20$ ;status of carry at time of CLOSE call...
10$ jmp close_channel_given_sa_user ;....c=0 no special processing of CLOSE
20$ lda sa ;if .c=1 AND sa=15 (command channel)...
and #$0f
cmp #$0f
bne 10$ ;...sa<>15
rts ;...special- channel assignment removed, skip real CLOSE
.endif
;
;
.subttl "INTERFACE BLOCK CODE"
;***********************************************************************
;
; NOTE:
; ALL CODE AFTER THIS POINT IS NOT USED DURING
; NORMAL DISK OPERATION. ALL THIS CODE IS STRICTLY
; FOR INSTALLING THE DISK, AND THAT CODE WHICH IS
; PERMANENTLY DOWNLOADED. ( I.E. disk INTERFACE BLOCK ).
;
;***********************************************************************
;
*=*+$100-<* ; align page for swapping
;
;***********************************************************************
; disk INTERFACE BLOCK CODE
;***********************************************************************
;
continue .macro %a
jmp $FFFC
j_%a = *-2
.endm
;
faref .macro %op
entry fa_tab,*+1
%op #$09
.endm
;
abs_ref .macro %op,%ref ; use for all intra page jmps/jsrs
entry abs_ref,*+2
%op %ref
.endm
;
;
install_code
fastop_cntr .byte 0 ; fast transfer byte counter
write_byte_rel_flag .byte 0 ; flag cleared by ckinout <4.2 fab>
;
;
rgetin lda dfltn ; getin
faref cmp #$09
beq rbasin
continue getin
;
rbasin lda dfltn ; basin
faref cmp #$09
beq basin_fastop_loc
continue basin
;
basin_fastop_loc
abs_ref bit,fastop_slow
sec
bcs basinout_system_call
;
;
rbsout pha
lda dflto
faref cmp #$09
beq 10$
pla
continue bsout
10$ pla

bsout_fastop_loc
abs_ref bit,fastop_slow
bsout_no_fastop_continue
clc
basinout_system_call
abs_ref jsr,swap_disk_slow
jmp disk_io
;
;
rchkin abs_ref jsr,chkinout
bcs 10$
continue chkin
10$ sta dfltn
clc
rts
;
;
chkinout ; return c=0 continue, c=1 call disk_version
lda #0 ;<4.2 fab> rashly assume clrchn called
abs_ref sta,write_byte_rel_flag
jsr lookup do lookup
tax restore
jltlk_cmp
jsr jltlk
bne 20$
jsr getlfs
.ifdef c64
lda fa
.endif
faref cmp #$09
beq 90$
lda la
20$ tax
clc
90$ rts
;
;
rckout abs_ref jsr,chkinout
bcs 10$
continue ckout
;
10$ sta dflto
clc
;
.ifdef rel_flag
ckout_swap_op
rts
.else
rts
.endif
;
;
disk_swap_close_call
abs_ref jsr,swap_disk_slow
jmp disk_close
;
;
.ifdef c64
rclose abs_ref jsr,jltlk_cmp lookup
.else
rclose php save cary for serial buss close
abs_ref jsr,jltlk_cmp lookup
.endif
bcs disk_swap_close_call
.ifndef c64
plp restore serial buss close carry
.endif
continue close continue with normal close
;
;
rsave sec
.byte $24
rload clc
abs_ref jsr,swap_disk_slow
jmp disk_load_save
;
.ifdef c64
rnmi pha save dem registers....
txa
pha
tya
pha
cld decimal mode...
.else
rnmi cld decimal mode...
.endif
;
lda #$7f disable nmis
sta d2icr
ldy d2icr if not 6526 nmi
bmi 80$
jsr ud60 set up kybd
jsr stop if stop key
beq 90$ uh.. better go get the disk..
80$ jmp fake_nmi pretend just a normal rs232 nmi ( normal ? )
;
90$ clc
.byte $24
ropen sec
abs_ref jsr,swap_disk_slow
jmp disk_open_nmi
;
;
;
;***********************************************************************
; GET_DISK
;***********************************************************************
;
;
; swap table
; contains dma register contents for a normal swap.
; table must be in reverse order due to perverse method
; of saving bytes....
;
swap_table
.byte 0 acr
.byte 0 ifr
.dbyte swapped_code_size len
.dbyte 0
.byte 0 dma addr
.dbyte swapped_code_start cpu addr
.byte dma_immediate_swap command
swap_table_end
;
;
;
; swap_disk
; swaps disk and preserves a,x,y, and carry
;
;fa_facmp_swap
; lda fa ; hybrid code based on needs of others
facmp_swap ; ( kludges to save bytes )
faref eor #$09
bne facmp_rts
swap_disk_slow
abs_ref jsr,slow
;
swap_disk
pha ; save x,a registers
txa
pha
;
ldx #9 ; stack register table
10$ abs_ref lda,<swap_table,x>
pha
dex
bpl 10$
;
;
restore_registers
ldx #9
10$ pla pull 10 dma registers for setup
sta dma+1,x
dex
bpl 10$
;
pla restore x,a
tax
pla
facmp_rts
rts
;

fastop_slow
abs_ref jsr,slow go slow , kill irqs
fastop abs_ref sta,fastop_dma_destination ; write byte in magic spot
lda sa if sa = fastop_sa
and #$0f
;
.byte $c9 cmp #
fastop_sa_loc
.byte $ff
;
bne fastop_exit
abs_ref lda,fastop_cntr if cntr <> 0
beq fastop_exit
abs_ref dec,fastop_cntr dec cntr cntr--
pla
pla pull off return address
;
.byte $a9 lda # perform the dma operation
fastop_dmaop_loc
.byte dma_immediate_read
;
sta dma+1
fastop_exit
.byte $a9 ; lda # load the accumilator
fastop_dma_destination
.byte $00
clc return via fast ( clear carry )
;
.ifdef c64
;
fast pha save .a ( to set status on return )
inc d1ddrb enable the stop routine
cli enable irqs
pla restore .a ( and basin status )
fastop_fake_rts
rts
;
slow pha save .a
sei kill interupts
lda #0 make sure vic is slow
sta vicspeed
dec d1ddrb disable the stop routine
pla restore .a and return
rts
;
.else
;
fast inc d1ddrb enable stop routine
pha carry must be preserved
;
vicspeed_restore = *+1
lda #0 speed variable name
cli enable irqs
speed_return
sta vicspeed restore vic speed
pla
fastop_fake_rts
rts return
;
slow pha save .a
sei kill interupts
lda vicspeed save current speed
abs_ref sta,vicspeed_restore
dec d1ddrb disable the stop routine
lda #0 go slow vic, and return
beq speed_return
;
.endif
;
.ifgt *-install_code-$100
*** error - interface block too large ***
.endif
;
;
.subttl "INSTALL VECTORS"
;
; for all indirects:
; this macro calls is arguement as a macro.
; the first arg in all these calls is the indirect symbol
;
;
for_all_indirects .macro %a
%a getin
%a basin
%a bsout
%a chkin
%a ckout
%a open
%a close
; %a clrch
; %a clall
%a load
%a save
%a nmi
.endm
;
byte_table .macro %a
btm .macro %b
.ifdef %a%b
.byte <%a%b
.else
.byte $00
.endif
.endm
for_all_indirects btm
.endm
;
; table of system indirect vector addresses on page 3
;
system_indirect_addrs byte_table <i>
;
; table of locations to install continue vectors on interface page
;
disk_jmp_addrs byte_table <j_>
;
; table of interface page entry points
;
disk_routine_addrs byte_table <r>
;
continue_macro .macro %a ; effectively reserves space for continue
c%a .word $0000 ; vectors ( like load and save might need )
.endm
;
continue_vectors
for_all_indirects continue_macro ; reserve space for continues
;
; number of vectors
;
num_vectors = disk_routine_addrs-disk_jmp_addrs
;
;***************************************************************************
; INSTALL VECTORS
;***************************************************************************
;
;
; the following loop actually installs the driver vectors
; if it was hard to write, it should be hard to understand
;
install_vectors
lda #$ff fix keyuscan for stop fake out (kludge)
sta d1prb
lda interface_page (pntr) points to interface page
sta pntr+1
lda #0
sta pntr
;
ldx #num_vectors-1 x <= number of vectors
; do
30$ ldy system_indirect_addrs,x
lda $301,y stack high order system address
pha
lda $300,y stack low order system address
pha
txa y <= 2*x
asl a
tay
pla store low order system address in cont
clc ( must be address-1 for use with
adc #$ff stacked RTS operations. )
sta continue_vectors,y
pla
adc #$ff
sta continue_vectors+1,y store high order system address in cont
;
ldy system_indirect_addrs,x .a <= low order system indirect
lda $300,y
ldy disk_jmp_addrs,x .y <= continue JMP address
beq 33$ if not zero
sta (pntr),y store low addr to interface page
;
ldy system_indirect_addrs,x .a <= high order system indirect
lda $301,y
ldy disk_jmp_addrs,x .y <= continue jmp address
iny store high addr to interface page
sta (pntr),y
;
33$ ldy system_indirect_addrs,x set low order system indirects
lda disk_routine_addrs,x
sta $300,y
;
lda pntr+1 set high order system indirects
sta $301,y
;
dex x=x-1
bpl 30$ while x> 0
;
rts
;
;

.subttl "DISK INSTALLATION"
;
patch_addrs table abs_ref
end_patch_addrs
;
fa_refs table fa_tab,.byte
end_fa_refs
;***********************************************************************
; The great disk god: INSTALL ( not swapped )
;***********************************************************************
;
; install_on_page
;
; installs the disk interface control block on any page in
; the system.
; entry: .a = page
;
;
install lda #default_unit_number ( install as unit #9 )
ldx #default_interface_page ( install in sprite buffers buffer )
install_on_page
cld decimal mode please..
phd save wherefores
;
jsr slow slow down there for out dmas...
;
ldx #0 clear the ram
lda #0
40$ sta swapped_code_start,x
sta swapped_code_start+$100,x
sta swapped_code_start+$200,x
inx
bne 40$
;
jsr sniff_disk_size ; sniff size, set major pointers up
;
pld recall wherefores
;
;
install_2
pha ; save unit number
txa ; .a <= page to install on
;
sta interface_page save page to return too.
;
jsr install_interface_page_a install the page
;
pla recall unit number too install as
jsr set_unit_number
;
jsr install_vectors install the interface vectors
;
jsr error_channel_init_set_up init the error channel
jsr init_channels init all the channels
;
; at this point the code has been copied down and patched, and
; all vectors have been approiately installed.
;
; all that remains is to swap out the disk, and
; return. This is acheived by calling swap_disk which is
; on that user page.
;
lda interface_page stack a call to fast
pha
lda #<fast-1
pha
;
lda interface_page stack a call to swap disk
pha
lda #<swap_disk-1
pha
;
rts call swap_disk, then call fast then return
;
;
.subttl "REINSTALL DISK"
;
; reinstall
; assumes disk is not destroyed and not installed
; reinstalls disk at default location
;
; reinstall on page
; assumes disk is not destroyed and not installed
; reinstalls disk at location specified
;
;
reinstall
lda #default_unit_number ( install as unit #9 )
ldx #default_interface_page ( install in sprite buffers buffer )
reinstall_on_page
cld decimal mode please..
phd save the wherefores
; see if we can get back our data
;
jsr slow ; do a big slow ( very important )
;
ldx #110$-100$-1 ; get out three data pages back
10$ lda 100$,x ( I hope they're mine !!! )
sta dma+2,x
dex
bpl 10$
lda #dma_immediate_swap
sta dma+1
;
pld recall the wherefores
jmp install_2 ; do rest of install
;
;
100$ .word swapped_code_start
.word 0
.byte 0
.word $300
.byte 0
.byte 0
110$
;
;
.subttl "SET UNIT NUMBER "
;
set_unit_number ; sets device number for disk.
and #%00011111 ; mask to something reasonable
sta disk_fa save for future genreations.
ldx interface_page set pntr to point to interface page
stx pntr+1
ldx #0
stx pntr
;
ldx #end_fa_refs-fa_refs-1
30$ ldy fa_refs,x fix the interface page fa references..
sta (pntr),y
dex
bpl 30$
clc return happy
rts
;
;
.subttl "INSTALL INTERFACE PAGE"
;
;
; install_interface_page_a
; entry: .a = page for interface page to be located too
; exit: interface page downloaded and patched
; if c128
; downloaded code aslow copied down
;
;
install_interface_page_a ; installs interface page on page .a
sta pntr+1 point pntr to that page
ldy #0
sty pntr
;
10$ lda install_code,y copy interface code to specified page
sta (pntr),y
iny
bne 10$
;
; patch all high order intra page references
;
ldx #end_patch_addrs-patch_addrs-1
lda pntr+1
20$ ldy patch_addrs,x
sta (pntr),y
dex
bpl 20$
;
.ifdef c64
rts return
.else
.local
; fall through to down_loaded_code
;
.subttl "DOWN_LOADED_CODE"
;***********************************************************************
; "DOWN_LOADED_CODE"
;***********************************************************************
;
ldx #110$-100$-1
10$ lda 100$,x
sta down_load_area,x
dex
bpl 10$
;
ldx #113$-100$ ; patch even this stuff
lda pntr+1
sta down_load_area,x
rts
;
100$
; entry: .y = disk command
; .a = desired configuration
; .x = desired vic bank configuration
;
ldy mmurcr y <= current dma bank
stx mmurcr current dma bank <= x
ldx mmucr x <= current mmu config
sec
bcs 105$
;
.byte $20 ; jsr
.byte <swap_disk_slow ; low_order
113$ .byte 00 ; high order
;
jmp cleanup_user_dma
;
105$ sta mmucr perform dma using mmucfg in .a
stx mmucr restore mmu
sty mmurcr restore vic bank
rts
;
110$
.endif
;

.subttl "sniff_disk_size"
;***********************************************************************
; sniff_disk_size
;***********************************************************************
;
; sniff_disk_size
; assumes that the disk is present and working, and the
; ram is present in an integral number of BANKS.
;
; sets up major disk pointers:
; first_block
; disk_max
; channel_blocks
; default_block
;
sniff_disk_size
ldi 0
std default_block default_block <= 0
; mark block with all different numbers
ldx #0
10$ txa
eor #$5a nothing magic here , just "unlikely"
sta data_block,x
dex
bne 10$
;
20$ jsr flush_block flush data page to 256 possible banks
inc default_block+1
bne 20$
;
;
30$ ldx #0 do
;
40$ txa fill data block with different stuff
eor #$2c
sta data_block,x
dex
bne 40$
;
jsr flush_block
inc default_block+1 point to next bank
bmi 80$ exit if > 128 banks
jsr unflush_block
;
ldx #0 check for original stuff
50$ txa
eor #$5a
cmp data_block,x if different
bne 80$ break
dex
bne 50$
jmp 30$ loop

;
;
80$ ldd default_block return end of disk +1
;
; set up major disk pointers based on size
;
std disk_max mark end of disk
;
ldx #0 set up the major disk pointers
lda #>swapped_code_size+1
std channel_blocks
lda #>swapped_code_size+3
std first_block
std disk_end
lda #>swapped_code_size+10
std default_block default_block must be inconsequential....
;
rts
;
.ifge *-swapped_dos_base-swapped_code_size
*** error *** code space exceeded
.endif
;
.ifge curram-code_start
*** error *** non-zero page ram use exceeded
.endif
;
.end