From 7af95f7162cd1009cd979c2b07c23c464b91ae16 Mon Sep 17 00:00:00 2001 From: Joshua Bell Date: Sat, 28 Sep 2019 20:54:23 -0700 Subject: [PATCH] WIP: Chain using file I/O --- cricket.system.s | 628 +++++++++++++++++++++++++--------------------- inc/macros.inc | 22 -- ns.clock.system.s | 21 +- set.date.s | 6 +- set.time.s | 6 +- test.s | 22 +- 6 files changed, 380 insertions(+), 325 deletions(-) diff --git a/cricket.system.s b/cricket.system.s index c074267..877d613 100644 --- a/cricket.system.s +++ b/cricket.system.s @@ -8,8 +8,10 @@ .setcpu "6502" .linecont + + .feature string_escapes .include "apple2.inc" + .include "apple2.mac" .include "opcodes.inc" .include "inc/apple2.inc" @@ -27,15 +29,13 @@ ;;; ------------------------------------------------------------ - .org $1000 - - ;; Loaded at $2000 but relocates to $1000 + ;; SYS files load at $2000; relocates self to $1000 + .org SYS_ADDR + dst_addr := $1000 ;;; ------------------------------------------------------------ -sys_start: - sec - bcs relocate + jmp relocate .byte MM, DD, YY ; version date stamp @@ -46,7 +46,7 @@ sys_start: .proc relocate src := SYS_ADDR - dst := $1000 + dst := dst_addr ldx #(sys_end - sys_start + $FF) / $100 ; pages ldy #0 @@ -59,57 +59,343 @@ load: lda src,y ; self-modified inc load_hi inc store_hi dex - beq find_self_name ; done - jmp load + bne load + + jmp main .endproc -;;; ------------------------------------------------------------ -;;; Identify the name of this SYS file, which should be present at -;;; $280 with or without a path prefix. This is used when searching -;;; for the next .SYSTEM file to execute. +;;; ============================================================ +;;; Start of relocated code -.proc find_self_name - ;; Search pathname buffer backwards for '/', then - ;; copy name into |self_name|; this is used later - ;; to find/invoke the next .SYSTEM file. + +sys_start: + pushorg dst_addr + +;;; ============================================================ +;;; Main routine +;;; ============================================================ + +.proc main + jsr setup + jsr maybe_install_driver + jsr launch_next + brk +.endproc + +;;; ============================================================ +;;; Preserve state needed to chain to next file +;;; ============================================================ + +.proc setup + ;; -------------------------------------------------- + ;; Save most recent device for later, when chaining + ;; to next .SYSTEM file. + lda DEVNUM + sta devnum + + ;; -------------------------------------------------- + ;; Identify the name of this SYS file, which should be present at + ;; $280 with or without a path prefix. Search pathname buffer + ;; backwards for '/', then copy name into |self_name|. ;; Find '/' (which may not be present, prefix is optional) - lda #0 - sta $A8 ldx PATHNAME - beq pre_install -floop: inc $A8 + beq no_name + ldy #0 ; Y = length +: lda PATHNAME,x + and #$7f ; ignore high bit + cmp #'/' + beq copy_name + iny dex - beq @copy - lda PATHNAME,x - eor #'/' - asl a - bne floop + bne :- ;; Copy name into |self_name| buffer -@copy: ldy #0 -cloop: iny - inx - lda PATHNAME,x - sta self_name,y - cpy $A8 - bcc cloop +copy_name: + cpy #0 + beq no_name sty self_name + + ldx PATHNAME +: lda PATHNAME,x + sta self_name,y + dex + dey + bne :- + + ;; Done + rts + +no_name: + lda #0 + sta self_name + rts +.endproc + +devnum: .byte 0 +self_name: .res 16 + +;;; ============================================================ +;;; Find and invoke the next .SYSTEM file +;;; ============================================================ + +.proc quit + MLI_CALL QUIT, quit_params + brk ; crash if QUIT fails + + DEFINE_QUIT_PARAMS quit_params +.endproc + +online_buf := $1C00 +io_buf := $1C00 +dir_buf := $2000 +block_len = $200 + + DEFINE_ON_LINE_PARAMS on_line_params,,online_buf + DEFINE_OPEN_PARAMS open_params, PATHNAME, io_buf + DEFINE_READ_PARAMS read_params, SYS_ADDR, SYS_LEN + DEFINE_READ_PARAMS read_block_params, dir_buf, block_len + DEFINE_CLOSE_PARAMS close_params + + +.proc launch_next + ;; Update reset vector - now terminates. + lda #quit + sta $03F3 + eor #$A5 + sta $03F4 + + ;; Read directory and look for .SYSTEM files; find this + ;; one, and invoke the following one. + + ptr := $A5 + num := $A7 + len := $A8 + + ;; -------------------------------------------------- + ;; Own name found? If not, just quit + lda self_name + beq quit + ;; -------------------------------------------------- + ;; Find name of boot device, copy into PATHNAME + lda devnum + sta on_line_params::unit_num + MLI_CALL ON_LINE, on_line_params + bcc :+ + jmp on_error + +: lda #'/' ; Prefix by '/' + sta PATHNAME+1 + lda online_buf + and #$0F ; Mask off length + sta PATHNAME + ldx #0 ; Copy name +: lda online_buf+1,x + sta PATHNAME+2,x + inx + cpx PATHNAME + bne :- + inx ; One more for '/' prefix + stx PATHNAME + + ;; Open directory + MLI_CALL OPEN, open_params + bcc :+ + jmp on_error +: lda open_params::ref_num + sta read_block_params::ref_num + sta close_params::ref_num + + ;; Read first "block" + MLI_CALL READ, read_block_params + bcc :+ + jmp on_error + + ;; Get sizes out of header +: lda dir_buf + VolumeDirectoryHeader::entry_length + sta entry_length_mod + lda dir_buf + VolumeDirectoryHeader::entries_per_block + sta entries_per_block_mod + lda #1 + sta num + + ;; Set up pointers to entry + lda #<(dir_buf + .sizeof(VolumeDirectoryHeader)) + sta ptr + lda #>(dir_buf + .sizeof(VolumeDirectoryHeader)) + sta ptr+1 + + ;; Process directory entry +entry: ldy #FileEntry::file_type ; file_type + lda (ptr),y + cmp #$FF ; type=SYS + bne next + ldy #FileEntry::storage_type_name_length + lda (ptr),y + and #$30 ; regular file (not directory, pascal) + beq next + lda (ptr),y + and #$0F ; name_length + sta len + tay + + ;; Compare suffix - is it .SYSTEM? + ldx suffix +: lda (ptr),y + cmp suffix,x + bne next + dey + dex + bne :- + + ;; Yes; is it *this* .SYSTEM file? + ldy self_name + cpy len + bne handle_sys_file +: lda (ptr),y + cmp self_name,y + bne handle_sys_file + dey + bne :- + sec + ror found_self_flag + + ;; Move to the next entry +next: lda ptr + clc + adc #$27 ; self-modified: entry_length + entry_length_mod := *-1 + sta ptr + bcc :+ + inc ptr+1 +: inc num + lda num + cmp #$0D ; self-modified: entries_per_block + entries_per_block_mod := *-1 + bcc entry + + ;; Read next "block" + MLI_CALL READ, read_block_params + bcs not_found + + ;; Set up pointers to entry + lda #0 + sta num + lda #<(dir_buf + $04) + sta ptr + lda #>(dir_buf + $04) + sta ptr+1 + jmp entry + + ;; -------------------------------------------------- + ;; Found a .SYSTEM file which is not this one; invoke + ;; it if follows this one. +handle_sys_file: + bit found_self_flag + bpl next + + MLI_CALL CLOSE, close_params + + ;; Compose the path to invoke. + ldx PATHNAME + inx + lda #'/' + sta PATHNAME,x + ldy #0 +: iny + inx + lda (ptr),y + sta PATHNAME,x + cpy len + bcc :- + stx PATHNAME + + jmp invoke_system_file + +not_found: + jsr zstrout + scrcode "\r\r* Unable to find next '.SYSTEM' file *\r" + .byte 0 + + bit KBDSTRB +: lda KBD + bpl :- + bit KBDSTRB + jmp quit .endproc - ;; Fall through... ;;; ------------------------------------------------------------ +;;; Load/execute the system file in PATHNAME + +.proc invoke_system_file + MLI_CALL OPEN, open_params + bcs on_error + + lda open_params::ref_num + sta read_params::ref_num + + MLI_CALL READ, read_params + bcs on_error + + MLI_CALL CLOSE, close_params + bcs on_error + + jmp SYS_ADDR ; Invoke loaded SYSTEM file +.endproc + +;;; ------------------------------------------------------------ +;;; Error handler - invoked if any ProDOS error occurs. + +.proc on_error + pha + jsr zstrout + scrcode "\r\r* Disk Error $" + .byte 0 + + pla + jsr PRBYTE + + jsr zstrout + scrcode " *\r" + .byte 0 + + bit KBDSTRB +: lda KBD + bpl :- + bit KBDSTRB + jmp quit +.endproc + +;;; ============================================================ +;;; Data + +suffix: + PASCAL_STRING ".SYSTEM" + +found_self_flag: + .byte 0 + + +;;; ============================================================ +;;; +;;; Driver Installer +;;; +;;; ============================================================ + +;;; ============================================================ ;;; Before installing, get the system to a known state and ;;; ensure there is not a previous clock driver installed. -.proc pre_install +.proc maybe_install_driver cld bit ROMIN2 ;; Update reset vector - re-invokes this code. - lda #pre_install + lda #>maybe_install_driver sta $03F3 eor #$A5 sta $03F4 @@ -150,8 +436,7 @@ cloop: iny and #$01 ; existing clock card? beq detect_cricket ; nope, check for Cricket - ;; Chain with no message - jmp launch_next_sys_file + rts ; yes, done! .endproc ;;; ------------------------------------------------------------ @@ -228,8 +513,9 @@ not_found: ;; Show failure message jsr HOME jsr zstrout - HIASCIIZ CR, CR, CR, PRODUCT, " - Not Found." - jmp launch_next_sys_file + scrcode "\r\r\r", PRODUCT, " - Not Found." + .byte 0 + rts restore_cmd_ctl: lda saved_control @@ -316,7 +602,8 @@ loop: lda driver,y bit ROMIN2 jsr HOME jsr zstrout - HIASCIIZ CR, CR, CR, PRODUCT, " - Installed " + scrcode "\r\r\r", PRODUCT, " - Installed " + .byte 0 ;; Display the current date lda DATELO+1 ; month @@ -344,141 +631,13 @@ loop: lda driver,y pla ; year jsr cout_number jsr CROUT + + rts ; done! .endproc -;;; ------------------------------------------------------------ -;;; Find and invoke the next .SYSTEM file - -.proc launch_next_sys_file - ;; Update reset vector - now terminates. - lda #quit - sta $03F3 - eor #$A5 - sta $03F4 - - ptr := $A5 - num := $A7 - len := $A8 - - lda DEVNUM ; stick with most recent device - sta read_block_params_unit_num - jsr read_block - - lda data_buffer + VolumeDirectoryHeader::entry_length - sta entry_length_mod - lda data_buffer + VolumeDirectoryHeader::entries_per_block - sta entries_per_block_mod - lda #1 - sta num - - lda #<(data_buffer + .sizeof(VolumeDirectoryHeader)) - sta ptr - lda #>(data_buffer + .sizeof(VolumeDirectoryHeader)) - sta ptr+1 - - ;; Process directory entry -entry: ldy #FileEntry::file_type ; file_type - lda (ptr),y - cmp #$FF ; type=SYS - bne next - ldy #FileEntry::storage_type_name_length - lda (ptr),y - and #$30 ; regular file (not directory, pascal) - beq next - lda (ptr),y - and #$0F ; name_length - sta len - tay - - ;; Compare suffix - is it .SYSTEM? - ldx #.strlen(SYSTEM_SUFFIX)-1 -: lda (ptr),y - cmp suffix,x - bne next - dey - dex - bpl :- - - ;; Yes; is it *this* .SYSTEM file? - ldy self_name - cpy len - bne handle_sys_file -: lda (ptr),y - cmp self_name,y - bne handle_sys_file - dey - bne :- - sec - ror found_self_flag - - ;; Move to the next entry -next: lda ptr - clc - adc #$27 ; self-modified: entry_length - entry_length_mod := *-1 - sta ptr - bcc :+ - inc ptr+1 -: inc num - lda num - cmp #$0D ; self-modified: entries_per_block - entries_per_block_mod := *-1 - bcc entry - - lda data_buffer + VolumeDirectoryHeader::next_block - sta read_block_params_block_num - lda data_buffer + VolumeDirectoryHeader::next_block + 1 - sta read_block_params_block_num+1 - ora read_block_params_block_num - beq not_found ; last block has next=0 - jsr read_block - lda #0 - sta num - lda #<(data_buffer + $04) - sta ptr - lda #>(data_buffer + $04) - sta ptr+1 - jmp entry - - ;; Found a .SYSTEM file which is not this one; invoke - ;; it if follows this one. -handle_sys_file: - bit found_self_flag - bpl next - - ;; Compose the path to invoke. First walk self path - ;; backwards to '/'. - ldx PATHNAME - beq append -: dex - beq append - lda PATHNAME,x - eor #'/' - asl a - bne :- - - ;; Now append name of found file. -append: ldy #0 -: iny - inx - lda (ptr),y - sta PATHNAME,x - cpy len - bcc :- - stx PATHNAME - jmp invoke_system_file - -not_found: - jsr zstrout - HIASCIIZ CR, CR, CR, "* Unable to find next '.SYSTEM' file *", CR - bit KBDSTRB -: lda KBD - bpl :- - bit KBDSTRB - jmp quit -.endproc +;;; ============================================================ +;;; Common Routines +;;; ============================================================ ;;; ------------------------------------------------------------ ;;; Output a high-ascii, null-terminated string. @@ -511,6 +670,9 @@ skip: inc ptr rts .endproc +lowercase_mask: + .byte $FF ; Set to $DF on systems w/o lower-case + ;;; ------------------------------------------------------------ ;;; COUT a 2-digit number in A @@ -537,118 +699,9 @@ units: pla rts .endproc -;;; ------------------------------------------------------------ - -lowercase_mask: - .byte $FF ; Set to $DF on systems w/o lower-case - -;;; ------------------------------------------------------------ -;;; Invoke ProDOS QUIT routine. - -.proc quit - MLI_CALL QUIT, quit_params - .byte 0 ; crash if QUIT fails - rts -.proc quit_params - .byte 4 ; param_count - .byte 0 ; quit_type - .word 0000 ; reserved - .byte 0 ; reserved - .word 0000 ; reserved -.endproc -.endproc - -;;; ------------------------------------------------------------ -;;; Read a disk block. - -.proc read_block - MLI_CALL READ_BLOCK, read_block_params - bcs on_error - rts -.endproc - -.proc read_block_params - .byte 3 ; param_count -unit_num: .byte $60 ; unit_num - .addr data_buffer ; data_buffer -block_num: .word 2 ; block_num - block 2 is volume directory -.endproc - read_block_params_unit_num := read_block_params::unit_num - read_block_params_block_num := read_block_params::block_num - -;;; ------------------------------------------------------------ -;;; Load/execute the system file in PATHNAME - -.proc invoke_system_file - MLI_CALL OPEN, open_params - bcs on_error - - lda open_params_ref_num - sta read_params_ref_num - - MLI_CALL READ, read_params - bcs on_error - - MLI_CALL CLOSE, close_params - bcs on_error - - jmp SYS_ADDR ; Invoke loaded SYSTEM file -.endproc - -;;; ------------------------------------------------------------ -;;; Error handler - invoked if any ProDOS error occurs. - -.proc on_error - pha - jsr zstrout - HIASCIIZ CR, CR, CR, "** Disk Error $" - pla - jsr PRBYTE - jsr zstrout - HIASCIIZ " **", CR - bit KBDSTRB -: lda KBD - bpl :- - bit KBDSTRB - jmp quit -.endproc - -;;; ------------------------------------------------------------ - -.proc open_params - .byte 3 ; param_count - .addr PATHNAME ; pathname - .addr data_buffer ; io_buffer -ref_num:.byte 1 ; ref_num -.endproc - open_params_ref_num := open_params::ref_num - -.proc read_params - .byte 4 ; param_count -ref_num:.byte 1 ; ref_num - .addr SYS_ADDR ; data_buffer - .word MAX_DW ; request_count - .word 0 ; trans_count -.endproc - read_params_ref_num := read_params::ref_num - -.proc close_params - .byte 1 ; param_count -ref_num:.byte 0 ; ref_num -.endproc - -;;; ------------------------------------------------------------ - -found_self_flag: - .byte 0 - -suffix: .byte SYSTEM_SUFFIX - -self_name: - PASCAL_STRING "CRICKET.SYSTEM" - -;;; ------------------------------------------------------------ +;;; ============================================================ ;;; Cricket Clock Driver - copied into ProDOS +;;; ============================================================ .proc driver scratch := $3A ; ZP scratch location @@ -741,4 +794,7 @@ done: pla ; restore saved command state .assert sizeof_driver <= 125, error, "Clock code must be <= 125 bytes" ;;; ------------------------------------------------------------ +;;; ============================================================ +;;; End of relocated code + poporg sys_end: diff --git a/inc/macros.inc b/inc/macros.inc index a1f475d..9610987 100644 --- a/inc/macros.inc +++ b/inc/macros.inc @@ -119,27 +119,5 @@ end: ;;; ============================================================ -;;; Define a string with high bits set -;;; e.g. HIASCII "Ding ding", $7, $7 -.macro HIASCII arg, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9 - .if .blank(arg) - .exitmacro - .endif - .if .match ({arg}, "") ; string? - .repeat .strlen(arg), i - .byte .strat(arg, i) | $80 - .endrep - .else ; otherwise assume number/char/identifier - .byte (arg | $80) - .endif - HIASCII arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9 -.endmacro - -;;; Like HIASCII, but null-terminated -.macro HIASCIIZ arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9 - HIASCII arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9 - .byte 0 -.endmacro - ;;; Set the high bit on the passed byte .define HI(c) ((c)|$80) diff --git a/ns.clock.system.s b/ns.clock.system.s index bbe9b22..ed634c6 100644 --- a/ns.clock.system.s +++ b/ns.clock.system.s @@ -7,8 +7,10 @@ .setcpu "6502" .linecont + + .feature string_escapes .include "apple2.inc" + .include "apple2.mac" .include "opcodes.inc" .include "inc/apple2.inc" @@ -240,7 +242,9 @@ not_found: ;; Show failure message jsr HOME jsr zstrout - HIASCIIZ CR, CR, CR, PRODUCT, " - Not Found." + scrcode "\r\r\r", PRODUCT, " - Not Found." + .byte 0 + jmp launch_next_sys_file saved: .byte 0, 0, 0, 0 @@ -289,7 +293,8 @@ loop: lda driver,y bit ROMIN2 jsr HOME jsr zstrout - HIASCIIZ CR, CR, CR, PRODUCT, " - Installed " + scrcode "\r\r\r", PRODUCT, " - Installed " + .byte 0 ;; Display the current date lda DATELO+1 ; month @@ -445,7 +450,9 @@ append: ldy #0 not_found: jsr zstrout - HIASCIIZ CR, CR, CR, "* Unable to find next '.SYSTEM' file *", CR + scrcode "\r\r\r* Unable to find next '.SYSTEM' file *\r" + .byte 0 + bit KBDSTRB : lda KBD bpl :- @@ -574,11 +581,15 @@ block_num: .word 2 ; block_num - block 2 is volume directory .proc on_error pha jsr zstrout - HIASCIIZ CR, CR, CR, "** Disk Error $" + scrcode "\r\r\r** Disk Error $" + .byte 0 + pla jsr PRBYTE jsr zstrout - HIASCIIZ " **", CR + scrcode " **\r" + .byte 0 + bit KBDSTRB : lda KBD bpl :- diff --git a/set.date.s b/set.date.s index d9b6e80..e1ec3ce 100644 --- a/set.date.s +++ b/set.date.s @@ -3,8 +3,10 @@ .setcpu "6502" .linecont + + .feature string_escapes .include "apple2.inc" + .include "apple2.mac" .include "inc/apple2.inc" .include "inc/macros.inc" @@ -13,9 +15,7 @@ .proc main jsr zstrout - HIASCII CR, "Date: WWW MM/DD/YY" - HIASCII BS, BS, BS, BS, BS, BS - HIASCII BS, BS, BS, BS, BS, BS + scrcode "\rDate: WWW MM/DD/YY\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08" .byte 0 jsr GETLN2 diff --git a/set.time.s b/set.time.s index 12b266f..ac99c48 100644 --- a/set.time.s +++ b/set.time.s @@ -3,8 +3,10 @@ .setcpu "6502" .linecont + + .feature string_escapes .include "apple2.inc" + .include "apple2.mac" .include "inc/apple2.inc" .include "inc/macros.inc" @@ -13,9 +15,7 @@ .proc main jsr zstrout - HIASCII CR, "Time: HH:MM:SS XM" - HIASCII BS, BS, BS, BS, BS, BS - HIASCII BS, BS, BS, BS, BS + scrcode "\rTime: HH:MM:SS XM\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08" .byte 0 jsr GETLN2 diff --git a/test.s b/test.s index 5f78967..256be9f 100644 --- a/test.s +++ b/test.s @@ -5,8 +5,10 @@ .setcpu "6502" .linecont + + .feature string_escapes .include "apple2.inc" + .include "apple2.mac" .include "opcodes.inc" .include "./inc/apple2.inc" @@ -33,12 +35,16 @@ bne ssc_not_found jsr zstrout - HIASCIIZ "SSC found.", CR + scrcode "SSC found.\r" + .byte 0 + jmp init_ssc ssc_not_found: jsr zstrout - HIASCIIZ "SSC not found.", CR + scrcode "SSC not found.\r" + .byte 0 + rts ;; TODO: Write NUL and check for 'C' ... version ... $8D (CR) @@ -64,7 +70,8 @@ init_ssc: ;; by a version number (in ASCII) and a carriage return (141, ;; $8D)." jsr zstrout - HIASCIIZ "Reading SSC: " + scrcode "Reading SSC: " + .byte 0 jsr readbyte bcs cricket_not_found ; timeout @@ -89,12 +96,14 @@ digit: cmp #HI('0') ; < '0' ? cricket_found: jsr zstrout - HIASCIIZ CR, "Cricket tentatively found.", CR + scrcode "\rCricket tentatively found.\r" + .byte 0 jmp exit cricket_not_found: jsr zstrout - HIASCIIZ CR, "Cricket not identified.", CR + scrcode "\rCricket not identified.\r" + .byte 0 jmp exit exit: @@ -143,7 +152,8 @@ check: lda STATUS ; did we get it? bne check jsr zstrout - HIASCIIZ "... timeout!" + scrcode "... timeout!" + .byte 0 sec ; failed rts