Merge remote-tracking branch 'cricket/master'

This commit is contained in:
Joshua Bell 2019-10-03 21:13:20 -07:00
commit 2fab1e19bc
17 changed files with 2512 additions and 0 deletions

10
.gitignore vendored Normal file
View File

@ -0,0 +1,10 @@
# Reference copy of original binary
orig
# Output directory
out
# Output files
*.SYS
*.BIN
*.list

11
.travis.yml Normal file
View File

@ -0,0 +1,11 @@
sudo: enabled
os: osx
language: c
install:
- git clone https://github.com/cc65/cc65 /tmp/cc65 &&
sudo make -C /tmp/cc65 ca65 ld65 avail &&
ca65 --version
script:
- make

40
Makefile Normal file
View File

@ -0,0 +1,40 @@
CAFLAGS = --target apple2enh --list-bytes 0
LDFLAGS = --config apple2-asm.cfg
OUTDIR = out
HEADERS = $(wildcard *.inc) $(wildcard inc/*.inc)
TARGETS = \
$(OUTDIR)/prodos.mod.BIN \
$(OUTDIR)/ns.clock.system.SYS \
$(OUTDIR)/cricket.system.SYS \
$(OUTDIR)/test.BIN \
$(OUTDIR)/date.BIN \
$(OUTDIR)/set.time.BIN \
$(OUTDIR)/set.date.BIN
# For timestamps
MM = $(shell date "+%-m")
DD = $(shell date "+%-d")
YY = $(shell date "+%-y")
DEFINES = -D DD=$(DD) -D MM=$(MM) -D YY=$(YY)
.PHONY: clean all
all: $(OUTDIR) $(TARGETS)
$(OUTDIR):
mkdir -p $(OUTDIR)
clean:
rm -f $(OUTDIR)/*.o
rm -f $(OUTDIR)/*.list
rm -f $(OUTDIR)/$(TARGETS)
$(OUTDIR)/%.o: %.s $(HEADERS)
ca65 $(CAFLAGS) $(DEFINES) --listing $(basename $@).list -o $@ $<
$(OUTDIR)/%.BIN $(OUTDIR)/%.SYS: $(OUTDIR)/%.o
ld65 $(LDFLAGS) -o $@ $<
xattr -wx prodos.AuxType '00 20' $@

60
README.md Normal file
View File

@ -0,0 +1,60 @@
# _The Cricket!_ &mdash; ProDOS Clock Driver
[![Build Status](https://travis-ci.org/a2stuff/cricket.svg?branch=master)](https://travis-ci.org/a2stuff/cricket)
I acquired a Cricket sound/clock peripheral on eBay. Therefore it is now critical that we have a conforming ProDOS clock driver for it.
> STATUS: Works on my machine!
## Background
_"The Cricket!"_ by Street Electronics Corporation, released in 1984, is a hardware peripheral for the Apple //c computer. It plugs into the serial port and offers a multi-voice sound synthesizer, a speech synthesizer, and a real-time clock.
The disks supplied with the device include:
* `/CRICKET/PRODOS.MOD` which can be BRUN to patch ProDOS in memory with a clock driver.
* A modified version of ProDOS
* A utility to patch ProDOS on disk
## `CRICKET.SYSTEM`
Like the `NS.CLOCK.SYSTEM` (by "CAP"), `CRICKET.SYSTEM` has these features:
* [x] A ProDOS `.SYSTEM` file
* [x] Detects the presence of a Cricket
* [x] Installs a driver in memory following the ProDOS clock driver protocol
* [x] Chains to the next `.SYSTEM` file (e.g. `BASIC.SYSTEM`)
Successfully tested on real hardware. (Laser 128EX, an Apple //c clone &mdash; including at 3x speed!)
## Build
Requires [cc65](https://github.com/cc65/cc65). The included `Makefile` is very specific to my machine - sorry about that.
[CRICKET.SYSTEM](cricket.system.s) is the result of the build.
## Notes
I ended up disassembling both [NS.CLOCK.SYSTEM](ns.clock.system.s) (to understand the SYSTEM chaining - what a pain!) and The Cricket!'s [PRODOS.MOD](prodos.mod.s) and melding them together, adding in the detection routine following the protocol in the manual.
## Other Utilities
These `BRUN`able files are also built:
* [DATE](date.s) just prints the current ProDOS date/time, to verify the time is set and updating. It does not depend on having a Cricket.
* [TEST](test.s) attempts to identify an SSC in Slot 2 and the Cricket via the ID sequence, to test routines.
* [SET.DATE](set.date.s) sets the Cricket's current date.
* [SET.TIME](set.time.s) sets the Cricket's current time.
Also, an updated [NS.CLOCK.SYSTEM](ns.clock.system.s) is included that fixes a typo, removes beeps, and is less chatty so you can have both `NS.CLOCK.SYSTEM` and `CRICKET.SYSTEM` in the same hard disk image if you use the image across different hardware configurations.
## Resources
Cricket disks on Asimov:
* ftp://ftp.apple.asimov.net/pub/apple_II/images/hardware/sound/cricket_disk1.po
* ftp://ftp.apple.asimov.net/pub/apple_II/images/hardware/sound/cricket_disk2.po
Cricket Manual on Asimov:
* ftp://ftp.apple.asimov.net/pub/apple_II/documentation/hardware/sound/Street%20Electronics%20The%20Cricket.pdf
## FYI...
In the Cricket manual there is a short sample BASIC program to set the clock without the use of any assembly routines, using `PR#2` to talk to the serial card followed by `PRINT` statements. This does not appear to work from ProDOS with the clock driver in place - the time ends up temporarily scrambled until the clock sorts itself out again. Assembly language routines do work, however. I believe ProDOS attempts to read the clock during the execution of the basic program, which interferes the device.

337
cricket.system.s Normal file
View File

@ -0,0 +1,337 @@
;;; The Cricket Clock - ProDOS System
;;; Adapted from /CRICKET/PRODOS.MOD
;;; Original: Street Electronics Corporation (C) 1984
;;; Adapted from: /NO.SLOT.CLOCK/NS.CLOCK.SYSTEM
;;; Original by "CAP" 04/21/91
;;; http://www.apple2.org.za/gswv/a2zine/GS.WorldView/v1999/Oct/MISC/NSC.Disk.TXT
.setcpu "6502"
.linecont +
.feature string_escapes
.include "apple2.inc"
.include "apple2.mac"
.include "opcodes.inc"
.include "inc/apple2.inc"
.include "inc/macros.inc"
.include "inc/prodos.inc"
;;; ************************************************************
.include "driver_preamble.inc"
;;; ************************************************************
;;; ============================================================
;;;
;;; Driver Installer
;;;
;;; ============================================================
read_delay_hi = $3 * 3 ; ($300 iterations is normal * 3.6MHz)
.define PRODUCT "Cricket Clock"
;;; ============================================================
;;; Ensure there is not a previous clock driver installed.
.proc maybe_install_driver
lda MACHID
and #$01 ; existing clock card?
beq detect_cricket ; nope, check for Cricket
rts ; yes, done!
.endproc
;;; ------------------------------------------------------------
;;; Detect Cricket. Detect SSC and if present probe device.
.proc detect_cricket
;; Check Slot 2 for SSC. ID bytes per:
;; Apple II Technical Note #8: Pascal 1.1 Firmware Protocol ID Bytes
lda $C205
cmp #$38
bne ssc_not_found
lda $C207
cmp #$18
bne ssc_not_found
lda $C20B
cmp #$01
bne ssc_not_found
lda $C20C
cmp #$31
bne ssc_not_found
beq init_ssc
ssc_not_found:
jmp not_found
;; Init SSC and try the "Read Cricket ID code" sequence.
init_ssc:
lda COMMAND ; save status of SSC registers
sta saved_command
lda CONTROL
sta saved_control
;; Configure SSC
lda #%00001011 ; no parity/echo/interrupts, RTS low, DTR low
sta COMMAND
lda #%10011110 ; 9600 baud, 8 data bits, 2 stop bits
sta CONTROL
;; Read Cricket ID code: 00 ($00)
lda #0
jsr sendbyte
;; "The Cricket will return a "C" (195, $C3) followed by a
;; version number (in ASCII) and a carriage return (141, $8D)."
jsr readbyte
bcs cricket_not_found ; timeout
cmp #HI('C') ; = 'C' ?
bne cricket_not_found
jsr readbyte
bcs cricket_not_found ; timeout
bcc digit
: jsr readbyte
bcs cricket_not_found ; timeout
cmp #HI($0D) ; = CR ?
beq cricket_found
digit: cmp #HI('0') ; < '0' ?
bcc cricket_not_found
cmp #HI('9' + 1) ; > '9' ?
bcs cricket_not_found
bcc :-
cricket_found:
jsr restore_cmd_ctl
jmp install_driver
cricket_not_found:
jsr restore_cmd_ctl
;; fall through...
not_found:
;; Show failure message
jsr zstrout
scrcode "\r\r\r", PRODUCT, " - Not Found."
.byte 0
rts
restore_cmd_ctl:
lda saved_control
sta CONTROL
lda saved_command
sta COMMAND
rts
saved_command: .byte 0
saved_control: .byte 0
.endproc
;; Write byte in A
.proc sendbyte
pha
: lda STATUS
and #(1 << 4) ; transmit register empty? (bit 4)
beq :- ; nope, keep waiting
pla
sta TDREG
rts
.endproc
;; Read byte into A, or carry set if timed out
.proc readbyte
tries := $100 * read_delay_hi
counter := $A5
lda #<tries
sta counter
lda #>tries
sta counter+1
check: lda STATUS ; did we get it?
and #(1 << 3) ; receive register full? (bit 3)
bne ready ; yes, we read the value
dec counter
bne check
dec counter+1
bne check
sec ; failed
rts
ready: lda RDREG ; actually read the register
clc
rts
.endproc
;;; ------------------------------------------------------------
;;; Install Cricket Driver. Copy into address at DATETIME vector,
;;; update the vector and update MACHID bits to signal a clock
;;; is present.
.proc install_driver
ptr := $A5
lda DATETIME+1
sta ptr
lda DATETIME+2
sta ptr+1
lda RWRAM1
lda RWRAM1
ldy #sizeof_driver-1
loop: lda driver,y
sta (ptr),y
dey
bpl loop
;; Set the "Recognizable Clock Card" bit
lda MACHID
ora #$01
sta MACHID
lda #OPC_JMP_abs
sta DATETIME
;; Invoke the driver to init the time
jsr DATETIME
lda ROMIN2
;; Display success message
jsr zstrout
scrcode "\r\r\r", PRODUCT, " - Installed "
.byte 0
;; Display the current date
lda DATELO+1 ; month
ror a
pha
lda DATELO
pha
rol a
rol a
rol a
rol a
and #%00001111
jsr cout_number
lda #HI('/') ; /
jsr COUT
pla ; day
and #%00011111
jsr cout_number
lda #HI('/') ; /
jsr COUT
pla ; year
jsr cout_number
jsr CROUT
rts ; done!
.endproc
;;; ============================================================
;;; Cricket Clock Driver - copied into ProDOS
;;; ============================================================
.proc driver
scratch := $3A ; ZP scratch location
;; Initialize
php
sei
lda COMMAND ; save status of command register
pha
;; Configure SSC
lda #%00001011 ; no parity/echo/interrupts, RTS low, DTR low
sta COMMAND
lda #%10011110 ; 9600 baud, 8 data bits, 2 stop bits
sta CONTROL
;; Send command
: lda STATUS
and #(1 << 4) ; transmit register empty? (bit 4)
beq :- ; nope, keep waiting
lda #HI('@') ; '@' command
sta TDREG
read_len := 7 ; read 7 bytes (w/m/d/y/H/M/S)
;; Read response, pushing to stack
ldy #(read_len-1)
rloop: ldx #0 ; x = retry loop counter low byte
lda #read_delay_hi ; scratch = retry loop counter high byte
sta scratch
check: lda STATUS ; did we get it?
and #(1 << 3) ; receive register full? (bit 3)
bne ready ; yes, we read the value
inx ; not yet, so keep trying
bne check ; until counter runs out
dec scratch
bne check
;; Read failed - restore stack and exit
reset: cpy #(read_len-1) ; anything left to restore?
beq done ; nope, exit
pla ; yep, clear it off the stack
iny
bne reset
;; Read succeeded - stuff it on the stack and continue
ready: lda RDREG
pha
dey
bpl rloop
;; Convert pushed response to ProDOS time field
pla ; day of week (unused)
pla ; minute
sta TIMELO ; -- stored as-is (TIMELO 5-0)
pla ; hour
sta TIMELO+1 ; -- stored as-is (TIMELO 12-8)
pla ; year
sta DATELO+1 ; -- will be shifted up by 1 (DATELO 15-9)
pla ; day
and #%00011111 ; -- masked, stored as is (DATELO 4-0)
sta DATELO
pla ; month
asl a ; -- shifted up (DATELO 8-5)
asl a
asl a
asl a
asl a
ora DATELO ; -- merge low 5 bits
sta DATELO
rol DATELO+1
pla ; seconds (unused)
;; Restore prior state
done: pla ; restore saved command state
sta COMMAND
plp
rts
.endproc
sizeof_driver := .sizeof(driver)
.assert sizeof_driver <= 125, error, "Clock code must be <= 125 bytes"
;;; ************************************************************
.include "driver_postamble.inc"
;;; ************************************************************

127
date.s Normal file
View File

@ -0,0 +1,127 @@
;;; Query ProDOS and print the current date/time
;;; (No dependency on Cricket clock)
;;; Output is: MM/DD/YY HH:MM
.setcpu "6502"
.org $2000
.include "apple2.inc"
.include "inc/apple2.inc"
.include "inc/macros.inc"
.include "inc/prodos.inc"
start:
MLI_CALL GET_TIME, 0
;;; Standard format:
;;;
;;; 49041 ($BF91) 49040 ($BF90)
;;; 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;; DATE: | year | month | day |
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;;
;;; 49043 ($BF93) 49042 ($BF92)
;;; 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;; TIME: |0 0 0| hour | |0 0| minute |
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;;
;;; Extended format (ProDOS 2.5):
;;; https://groups.google.com/d/topic/comp.sys.apple2/6MwlJSKTmQc/discussion
;;;
;;; 49039 ($BF8F) 49038 ($BF8E)
;;; 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;; xTIME: | xSeconds | xMilliseconds |
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;;
;;; 49041 ($BF91) 49040 ($BF90)
;;; 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;; DATE: | year | month | day |
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;;
;;; 49043 ($BF93) 49042 ($BF92)
;;; 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;;; TIME: |xYear| hour | |0 0| minute |
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;; Date
lda DATELO+1 ; month
ror a
pha
lda DATELO
pha
rol a
rol a
rol a
rol a
and #%00001111
jsr cout_number
lda #HI('/') ; /
jsr COUT
pla ; day
and #%00011111
jsr cout_number
lda #HI('/') ; /
jsr COUT
pla ; year
;; TODO: Shift in xYear bits
jsr cout_number ; TODO: Support 16-bit numbers
lda #HI(' ')
jsr COUT
jsr COUT
;; Time
lda TIMELO+1 ; hour
and #%00011111
jsr cout_number
lda #HI(':') ; ':'
jsr COUT
lda TIMELO ; minute
and #%00111111
jsr cout_number
jsr CROUT
rts
pm_flag:
.byte 0
;;; ------------------------------------------------------------
.proc cout_number
ldx #HI('0')
cmp #10 ; >= 10?
bcc tens
;; divide by 10, dividend(+'0') in x remainder in a
: sbc #10
inx
cmp #10
bcs :-
tens: pha
txa
jsr COUT
units: pla
ora #HI('0')
jsr COUT
rts
.endproc

3
driver_postamble.inc Normal file
View File

@ -0,0 +1,3 @@
poporg
reloc_end := *

458
driver_preamble.inc Normal file
View File

@ -0,0 +1,458 @@
;;; ------------------------------------------------------------
;; SYS files load at $2000; relocates self to $1000
.org SYS_ADDR
dst_addr := $1000
;;; ------------------------------------------------------------
jmp relocate
.byte MM, DD, YY ; version date stamp
;;; ------------------------------------------------------------
;;; Relocate this code from $2000 (.SYSTEM start location) to $1000
;;; and start executing there. This is done so that the next .SYSTEM
;;; file can be loaded/run at $2000.
.proc relocate
src := reloc_start
dst := dst_addr
ldx #(reloc_end - reloc_start + $FF) / $100 ; pages
ldy #0
load: lda src,y ; self-modified
load_hi := *-1
sta dst,y ; self-modified
store_hi := *-1
iny
bne load
inc load_hi
inc store_hi
dex
bne load
jmp main
.endproc
;;; ============================================================
;;; Start of relocated code
reloc_start := *
pushorg dst_addr
;;; ============================================================
;;; Main routine
;;; ============================================================
.proc main
jsr save_chain_info
jsr init_system
jsr maybe_install_driver
jmp launch_next
.endproc
;;; ============================================================
;;; Preserve state needed to chain to next file
;;; ============================================================
.proc save_chain_info
;; --------------------------------------------------
;; 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)
ldx PATHNAME
beq no_name
ldy #0 ; Y = length
: lda PATHNAME,x
and #$7f ; ignore high bit
cmp #'/'
beq copy_name
iny
dex
bne :-
;; Copy name into |self_name| buffer
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
;;; ============================================================
;;; Init system state
;;; ============================================================
;;; Before installing, get the system to a known state.
.proc init_system
cld
bit ROMIN2
;; Update reset vector - ProDOS QUIT
lda #<quit
sta $03F2
lda #>quit
sta $03F3
eor #$A5
sta $03F4
;; Quit 80-column firmware
lda #$95 ; Ctrl+U (quit 80 col firmware)
jsr COUT
;; Reset I/O
sta CLR80VID
sta CLRALTCHAR
jsr SETVID
jsr SETKBD
jsr SETNORM
jsr INIT
jsr HOME
;; Update System Bit Map
ldx #BITMAP_SIZE-1
lda #%00000001 ; protect page $BF
: sta BITMAP,x
lda #%00000000 ; nothing else protected until...
dex
bne :-
lda #%11001111 ; ZP ($00), stack ($01), text page 1 ($04-$07)
sta BITMAP
;; Determine lowercase support
lda MACHID
and #$88 ; IIe or IIc (or IIgs) ?
bne :+
lda #$DF
sta lowercase_mask ; lower case to upper case
: rts
.endproc
;;; ============================================================
;;; Find and invoke the next .SYSTEM file
;;; ============================================================
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
;; 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
bne :+
jmp 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
;;; ------------------------------------------------------------
;;; 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
sta close_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
.proc quit
MLI_CALL QUIT, quit_params
brk ; crash if QUIT fails
DEFINE_QUIT_PARAMS quit_params
.endproc
;;; ============================================================
;;; Data
suffix:
PASCAL_STRING ".SYSTEM"
found_self_flag:
.byte 0
;;; ============================================================
;;; Common Routines
;;; ============================================================
;;; ------------------------------------------------------------
;;; Output a high-ascii, null-terminated string.
;;; String immediately follows the JSR.
.proc zstrout
ptr := $A5
pla ; read address from stack
sta ptr
pla
sta ptr+1
bne skip ; always (since data not on ZP)
next: cmp #HI('a') ; lower-case?
bcc :+
and lowercase_mask ; make upper-case if needed
: jsr COUT
skip: inc ptr
bne :+
inc ptr+1
: ldy #0
lda (ptr),y
bne next
lda ptr+1 ; restore address to stack
pha
lda ptr
pha
rts
.endproc
lowercase_mask:
.byte $FF ; Set to $DF on systems w/o lower-case
;;; ------------------------------------------------------------
;;; COUT a 2-digit number in A
.proc cout_number
ldx #HI('0')
cmp #10 ; >= 10?
bcc tens
;; divide by 10, dividend(+'0') in x remainder in a
: sbc #10
inx
cmp #10
bcs :-
tens: pha
cpx #HI('0')
beq units
txa
jsr COUT
units: pla
ora #HI('0')
jsr COUT
rts
.endproc

54
inc/apple2.inc Normal file
View File

@ -0,0 +1,54 @@
;;; ============================================================
;;;
;;; More Apple II Symbols
;;;
;;; ============================================================
;;; ============================================================
;;; Soft Switches
;;; ============================================================
RAMRDOFF := $C002
RAMRDON := $C003
RAMWRTOFF := $C004
RAMWRTON := $C005
ALTZPOFF := $C008
ALTZPON := $C009
CLR80VID := $C00C
SET80VID := $C00D
RDALTZP := $C016
RD80STORE := $C018
RDPAGE2 := $C01C
BANKSEL := $C073 ; Select RamWorks bank
ROMIN2 := $C082 ; Read ROM; no write
RWRAM1 := $C08B ; Read/write RAM bank 1
;;; ============================================================
;;; I/O Registers (for Slot 2)
;;; ============================================================
TDREG := $C088 + $20 ; ACIA Transmit Register (write)
RDREG := $C088 + $20 ; ACIA Receive Register (read)
STATUS := $C089 + $20 ; ACIA Status/Reset Register
COMMAND := $C08A + $20 ; ACIA Command Register (read/write)
CONTROL := $C08B + $20 ; ACIA Control Register (read/write)
;;; ============================================================
;;; Monitor ROM routines
;;; ============================================================
INIT := $FB2F
HOME := $FC58
GETLN := $FD6A ; with prompt character
GETLN2 := $FD6F ; no prompt character
CROUT := $FD8E
PRBYTE := $FDDA
COUT := $FDED
SETNORM := $FE84
SETKBD := $FE89
SETVID := $FE93
INPUT_BUFFER := $200

123
inc/macros.inc Normal file
View File

@ -0,0 +1,123 @@
;;; ============================================================
;;; Generic Macros
;;; ============================================================
.define _is_immediate(arg) (.match (.mid (0, 1, {arg}), #))
.define _is_register(arg) (.match ({arg}, x) .or .match ({arg}, y))
.define _is_y_register(arg) (.match ({arg}, y))
.define _immediate_value(arg) (.right (.tcount ({arg})-1, {arg}))
.macro _op_lo op, arg
.if _is_immediate {arg}
op #<_immediate_value {arg}
.else
op arg
.endif
.endmacro
.macro _op_hi op, arg
.if _is_immediate {arg}
op #>_immediate_value {arg}
.else
op arg+1
.endif
.endmacro
;;; ============================================================
;;; Temporary org change, for relocated routines
__pushorg_depth__ .set 0
.macro pushorg addr
::__pushorg_depth__ .set ::__pushorg_depth__ + 1
.ident(.sprintf("__pushorg_saved__%d", ::__pushorg_depth__)) := *
.org addr
.ident(.sprintf("__pushorg_start__%d", ::__pushorg_depth__)) := *
.endmacro
.macro poporg
.org .ident(.sprintf("__pushorg_saved__%d", ::__pushorg_depth__)) + (* - .ident(.sprintf("__pushorg_start__%d", ::__pushorg_depth__)))
::__pushorg_depth__ .set ::__pushorg_depth__ - 1
.endmacro
;;; ============================================================
;;; Length-prefixed string
;;;
;;; Can include control chars by using:
;;;
;;; PASCAL_STRING {"abc",$0D,"def"}
.macro PASCAL_STRING str,res
.local data
.local end
.byte end - data
data: .byte str
end:
.if .paramcount > 1
.res res - (end - data), 0
.endif
.endmacro
;;; ============================================================
;;; Common patterns
.macro copy arg1, arg2, arg3, arg4
.if _is_register {arg2} && _is_register {arg4}
;; indexed load/indexed store
lda arg1,arg2
sta arg3,arg4
.elseif _is_register {arg2}
;; indexed load variant (arg2 is x or y)
lda arg1,arg2
sta arg3
.elseif _is_register {arg3}
;; indexed store variant (arg3 is x or y)
lda arg1
sta arg2,arg3
.else
lda arg1
sta arg2
.endif
.endmacro
;;; Copy 16-bit value
;;; copy16 #$1111, $2222 ; immediate, absolute
;;; copy16 $1111, $2222 ; absolute, absolute
;;; copy16 $1111,x, $2222 ; indirect load, absolute store
;;; copy16 $1111, $2222,x ; absolute load, indirect store
;;; copy16 $1111,x $2222,x ; indirect load, indirect store
;;; copy16 #$1111, $2222,x ; immediate load, indirect store
.macro copy16 arg1, arg2, arg3, arg4
.if _is_register {arg2} && _is_register {arg4}
;; indexed load/indexed store
lda arg1,arg2
sta arg3,arg4
lda arg1+1,arg2
sta arg3+1,arg4
.elseif _is_register {arg2}
;; indexed load variant (arg2 is x or y)
lda arg1,arg2
sta arg3
lda arg1+1,arg2
sta arg3+1
.elseif _is_register {arg3}
;; indexed store variant (arg3 is x or y)
_op_lo lda, {arg1}
sta arg2,arg3
_op_hi lda, {arg1}
sta arg2+1,arg3
.else
_op_lo lda, {arg1}
sta arg2
_op_hi lda, {arg1}
sta arg2+1
.endif
.endmacro
;;; ============================================================
;;; Set the high bit on the passed byte
.define HI(c) ((c)|$80)

477
inc/prodos.inc Normal file
View File

@ -0,0 +1,477 @@
;;; ============================================================
;;;
;;; ProDOS MLI
;;;
;;; ============================================================
;;; Entry point / Global Page
MLI := $BF00 ; Entry point
DATETIME := $BF06 ; JMP to clock routine
DEVADR := $BF10 ; Device driver addresses ($BF10-$BF2F)
NODEV := $BF10 ; "No Device Connected" entry (slot 0)
DEVNUM := $BF30 ; Most recent accessed device
DEVCNT := $BF31 ; Number of on-line devices minus 1
DEVLST := $BF32 ; Up to 14 units ($BF32-$BF3F)
BITMAP := $BF58 ; System memory bitmap
BITMAP_SIZE = $18 ; Bits for pages $00 to $BF
DATELO := $BF90 ; Date lo
DATEHI := $BF91 ; Date hi
TIMELO := $BF92 ; Time lo
TIMEHI := $BF93 ; Time hi
LEVEL := $BF94 ; File level
MACHID := $BF98 ; Machine ID
SLTBYT := $BF99 ; '1' bits indicate rom in slot (bit#)
IVERSION := $BFFD ; Interpreter Version
KVERSION := $BFFF ; ProDOS Kernel Version
;;; Patch Locations
SELECTOR := $D100
BLOCK_SIZE = $200
PATHNAME := $280
SYS_ADDR := $2000 ; Load address for SYS files
SYS_LEN = $BF00 - SYS_ADDR ; Maximum SYS file length
;;; ============================================================
;;; MLI Calls
;;; ============================================================
;;; Housekeeping Calls
CREATE = $C0
DESTROY = $C1
RENAME = $C2
SET_FILE_INFO = $C3
GET_FILE_INFO = $C4
ON_LINE = $C5
SET_PREFIX = $C6
GET_PREFIX = $C7
;;; Filing Calls
OPEN = $C8
NEWLINE = $C9
READ = $CA
WRITE = $CB
CLOSE = $CC
FLUSH = $CD
SET_MARK = $CE
GET_MARK = $CF
SET_EOF = $D0
GET_EOF = $D1
SET_BUF = $D2
GET_BUF = $D3
;;; System Calls
GET_TIME = $82
ALLOC_INTERRUPT = $40
DEALLOC_INTERRUPT = $41
QUIT = $65
;;; Direct Disk Access Commands
READ_BLOCK = $80
WRITE_BLOCK = $81
;;; ============================================================
;;; File Types
;;; ============================================================
FT_TYPELESS = $00
FT_BAD = $01
FT_TEXT = $04 ; ASCII Text File *
FT_BINARY = $06 ; Generic Binary File *
FT_GRAPHICS = $08 ; Graphics File
FT_DIRECTORY = $0F ; Directory *
FT_ADB = $19 ; AppleWorks Database *
FT_AWP = $1A ; AppleWorks Word Processing *
FT_ASP = $1B ; AppleWorks Spreadsheet *
FT_SRC = $B0 ; IIgs system type; re-used?
FT_S16 = $B3 ; IIgs Application Program
FT_PAS = $EF ; Pascal Area *
FT_CMD = $F0 ; ProDOS Command File *
FT_INT = $FA ; Integer BASIC Program *
FT_IVR = $FB ; Integer BASIC Variable File *
FT_BASIC = $FC ; Applesoft BASIC Program *
FT_VAR = $FD ; Applesoft BASIC Variable File *
FT_REL = $FE ; EDASM/Contiki Relocatable File *
FT_SYSTEM = $FF ; ProDOS System File *
;;; Types marked with * are known to BASIC.SYSTEM and have an
;;; associated three-letter abbreviation.
;;; ============================================================
;;; Access
;;; ============================================================
ACCESS_DEFAULT = %11000011
ACCESS_LOCKED = %00100001
;;; ============================================================
;;; Storage Types
;;; ============================================================
ST_STANDARD_FILE = $01
ST_LINKED_DIRECTORY = $0D
ST_VOLUME_DIRECTORY = $0F
;;; ============================================================
;;; Errors
;;; ============================================================
ERR_DEVICE_NOT_CONNECTED = $28
ERR_WRITE_PROTECTED = $2B
ERR_INVALID_PATHNAME = $40
ERR_INVALID_REFERENCE = $43
ERR_PATH_NOT_FOUND = $44
ERR_VOL_NOT_FOUND = $45
ERR_FILE_NOT_FOUND = $46
ERR_DUPLICATE_FILENAME= $47
ERR_OVERRUN_ERROR = $48
ERR_VOLUME_DIR_FULL = $49
ERR_END_OF_FILE = $4C
ERR_ACCESS_ERROR = $4E
ERR_DUPLICATE_VOLUME = $57
ERR_NETWORK_ERROR = $88
;;; ============================================================
;;; Directory Structures
;;; ============================================================
STORAGE_TYPE_MASK = $F0
NAME_LENGTH_MASK = $0F
;;; Volume Directory Header structure
.struct VolumeDirectoryHeader
prev_block .word
next_block .word
storage_type_name_length .byte
file_name .byte 15
reserved .byte 8
creation_date .word
creation_time .word
version .byte
min_version .byte
access .byte
entry_length .byte
entries_per_block .byte
file_count .word
;; same through here ---------
bit_map_pointer .word
total_blocks .word
.endstruct
.assert .sizeof(VolumeDirectoryHeader) = $2B, error, "incorrect struct size"
;;; Subdirectory Header structure
.struct SubdirectoryHeader
prev_block .word
next_block .word
storage_type_name_length .byte
file_name .byte 15
reserved .byte 8
creation_date .word
creation_time .word
version .byte
min_version .byte
access .byte
entry_length .byte
entries_per_block .byte
file_count .word
;; same through here ---------
parent_pointer .word
parent_entry_number .byte
parent_entry_length .byte
.endstruct
.assert .sizeof(SubdirectoryHeader) = $2B, error, "incorrect struct size"
;; File Entry structure
.struct FileEntry
storage_type_name_length .byte
file_name .byte 15
file_type .byte
key_pointer .word
blocks_used .word
eof .faraddr
creation_date .word
creation_time .word
version .byte
min_version .byte
access .byte
aux_type .word
mod_date .word
mod_time .word
header_pointer .word
.endstruct
.assert .sizeof(FileEntry) = $27, error, "incorrect struct size"
;;; ============================================================
;;; ProDOS Driver Protocol
;;; ============================================================
;;; Addresses for command parameters
DRIVER_COMMAND := $42
DRIVER_UNIT_NUMBER := $43
DRIVER_BUFFER := $44
DRIVER_BLOCK_NUMBER := $46
;;; Commands
DRIVER_COMMAND_STATUS = 0
DRIVER_COMMAND_READ = 1
DRIVER_COMMAND_WRITE = 2
DRIVER_COMMAND_FORMAT = 3
;;; ============================================================
;;; Macros
;;; ============================================================
.macro MLI_CALL op, addr
jsr MLI
.byte op
.addr addr
.endmacro
.macro DEFINE_OPEN_PARAMS name, pn, io, rn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.if .xmatch(.string(io), "io_buffer")
.error "Can't pass 'io_buffer' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 3
pathname: .addr pn
io_buffer: .addr io
.ifnblank rn
ref_num: .byte rn
.else
ref_num: .byte 0
.endif
.endproc
.endmacro
.macro DEFINE_READ_PARAMS name, db, rc
.proc name
param_count: .byte 4
ref_num: .byte 0
data_buffer: .addr db
request_count: .word rc
trans_count: .word 0
.endproc
.endmacro
.macro DEFINE_WRITE_PARAMS name, db, rc
.proc name
param_count: .byte 4
ref_num: .byte 0
data_buffer: .addr db
request_count: .word rc
trans_count: .word 0
.endproc
.endmacro
.macro DEFINE_CLOSE_PARAMS name
.proc name
param_count: .byte 1
ref_num: .byte 0
.endproc
.endmacro
.macro DEFINE_FLUSH_PARAMS name
.proc name
param_count: .byte 1
ref_num: .byte 0
.endproc
.endmacro
.macro DEFINE_GET_FILE_INFO_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte $A
pathname: .addr pn
access: .byte 0
file_type: .byte 0
aux_type: .word 0
storage_type: .byte 0
blocks_used: .word 0
mod_date: .word 0
mod_time: .word 0
create_date: .word 0
create_time: .word 0
.endproc
.endmacro
.macro DEFINE_SET_MARK_PARAMS name, pos
.proc name
param_count: .byte 2
ref_num: .byte 0
position: .faraddr pos
.endproc
.endmacro
.macro DEFINE_ON_LINE_PARAMS name, un, db
.proc name
param_count: .byte 2
.ifnblank un
unit_num: .byte un
.else
unit_num: .byte 0
.endif
data_buffer: .addr db
.endproc
.endmacro
.macro DEFINE_READ_BLOCK_PARAMS name, db, bn
.proc name
param_count: .byte 3
unit_num: .byte 0
data_buffer: .addr db
block_num: .word bn
.endproc
.endmacro
.macro DEFINE_WRITE_BLOCK_PARAMS name, db, bn
.proc name
param_count: .byte 3
unit_num: .byte 0
data_buffer: .addr db
block_num: .word bn
.endproc
.endmacro
.macro DEFINE_ALLOC_INTERRUPT_PARAMS name, ic
.proc alloc_interrupt_params
param_count: .byte 2
int_num: .byte 0
int_code: .addr ic
.endproc
.endmacro
.macro DEFINE_DEALLOC_INTERRUPT_PARAMS name
.proc dealloc_interrupt_params
param_count: .byte 1
int_num: .byte 0
.endproc
.endmacro
.macro DEFINE_QUIT_PARAMS name, ext, pathname
.proc name
param_count: .byte 4
.ifnblank ext
.byte ext
.else
.byte 0
.endif
.ifnblank pathname
.word pathname
.else
.word 0
.endif
.byte 0
.word 0
.endproc
.endmacro
.macro DEFINE_SET_PREFIX_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 1
pathname: .addr pn
.endproc
.endmacro
.macro DEFINE_GET_PREFIX_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 1
pathname: .addr pn
.endproc
.endmacro
.macro DEFINE_DESTROY_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 1
pathname: .addr pn
.endproc
.endmacro
.macro DEFINE_CREATE_PARAMS name, pn, ac, ft, at, st
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 7
pathname: .addr pn
.ifnblank ac
access: .byte ac
.else
access: .byte 0
.endif
.ifnblank ft
file_type: .byte ft
.else
file_type: .byte 0
.endif
.ifnblank at
aux_type: .word at
.else
aux_type: .word 0
.endif
.ifnblank st
storage_type: .byte st
.else
storage_type: .byte 0
.endif
create_date: .word 0
create_time: .word 0
.endproc
.endmacro
.macro DEFINE_SET_EOF_PARAMS name, eo
.proc name
param_count: .byte 2
ref_num: .byte 0
eof: .faraddr eo
.endproc
.endmacro
.macro DEFINE_GET_EOF_PARAMS name
.proc name
param_count: .byte 2
ref_num: .byte 0
eof: .faraddr 0
.endproc
.endmacro
.macro DEFINE_RENAME_PARAMS name, pn, np
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 2
pathname: .addr pn
new_pathname: .addr np
.endproc
.endmacro

313
ns.clock.system.s Normal file
View File

@ -0,0 +1,313 @@
;;; NS.CLOCK.SYSTEM
;;; Original by "CAP" 04/21/91
;;; http://www.apple2.org.za/gswv/a2zine/GS.WorldView/v1999/Oct/MISC/NSC.Disk.TXT
;;; Modification history available at:
;;; https://github.com/a2stuff/cricket
.setcpu "6502"
.linecont +
.feature string_escapes
.include "apple2.inc"
.include "apple2.mac"
.include "opcodes.inc"
.include "inc/apple2.inc"
.include "inc/macros.inc"
.include "inc/prodos.inc"
;;; ************************************************************
.include "driver_preamble.inc"
;;; ************************************************************
;;; ============================================================
;;;
;;; Driver Installer
;;;
;;; ============================================================
.define PRODUCT "No-Slot Clock"
;;; ============================================================
;;; Ensure there is not a previous clock driver installed.
.proc maybe_install_driver
lda MACHID
and #$01 ; existing clock card?
beq detect_nsc ; nope, check for NSC
rts ; yes, done!
.endproc
;;; ------------------------------------------------------------
;;; Detect NSC. Scan slot ROMs and main ROMs. Try reading
;;; each location several times, and validate results before
;;; installing driver.
.proc detect_nsc
;; Preserve date/time
ldy #3 ; copy 4 bytes
: lda DATELO,y
sta saved,y
dey
bpl :-
;; Check slot ROMs
lda #>$CFFF
ldy #<$CFFF
sta ld4+2
sty ld4+1
sta st4+2
sty st4+1
lda #0
sta slot
lda #3 ; treat slot 0 as slot 3
sloop: ora #$C0 ; A=$Cs
sta st1+2
rloop: sta ld1+2
sta ld2+2
sta st2+2
lda #3 ; 3 tries - need valid results each time
sta tries
try: jsr driver ; try reading date/time
lda DATELO+1 ; check result
ror a
lda DATELO
rol a
rol a
rol a
rol a
and #$0F
beq next
cmp #13 ; month
bcs next
lda DATELO
and #$1F
beq next
cmp #32 ; day
bcs next
lda TIMELO+1
cmp #24 ; hours
bcs next
lda TIMELO
cmp #60 ; minutes
bcs next
dec tries
bne try
beq install_driver ; all tries look valid
next: inc slot
lda slot
cmp #8
bcc sloop ; next slot
bne not_found
;; Not found in slot ROM, try main ROMs ???
lda #>$C015
ldy #<$C015
sta ld4+2
sty ld4+1
ldy #$07
sta st1+2
sty st1+1
dey
sta st4+2
sty st4+1
lda #>$C800
bne rloop
;; Restore date/time
not_found:
ldy #3
: lda saved,y
sta DATELO,y
dey
bpl :-
;; Show failure message
jsr zstrout
scrcode "\r\r\r", PRODUCT, " - Not Found."
.byte 0
rts
saved: .byte 0, 0, 0, 0
tries: .byte 3
slot: .byte 0
.endproc
;;; ------------------------------------------------------------
;;; Install NSC Driver. Copy into address at DATETIME vector,
;;; update the vector and update MACHID bits to signal a clock
;;; is present.
.proc install_driver
ptr := $A5
lda DATETIME+1
sta ptr
clc
adc #(unlock - driver - 1)
sta ld3+1
lda DATETIME+2
sta ptr+1
adc #0
sta ld3+2
lda RWRAM1
lda RWRAM1
ldy #sizeof_driver-1
loop: lda driver,y
sta (ptr),y
dey
bpl loop
;; Set the "Recognizable Clock Card" bit
lda MACHID
ora #$01
sta MACHID
lda #OPC_JMP_abs
sta DATETIME
;; Invoke the driver to init the time
jsr DATETIME
lda ROMIN2
;; Display success message
jsr zstrout
scrcode "\r\r\r", PRODUCT, " - Installed "
.byte 0
;; Display the current date
lda DATELO+1 ; month
ror a
pha
lda DATELO
pha
rol a
rol a
rol a
rol a
and #%00001111
jsr cout_number
lda #HI('/') ; /
jsr COUT
pla ; day
and #%00011111
jsr cout_number
lda #HI('/') ; /
jsr COUT
pla ; year
jsr cout_number
jsr CROUT
rts ; done!
.endproc
;;; ============================================================
;;; NSC driver - modified as needed and copied into ProDOS
;;; ============================================================
driver:
php
sei
ld4: lda $CFFF ; self-modified
pha
st1: sta $C300 ; self-modified
ld1: lda $C304 ; self-modified
ldx #8
;; Unlock the NSC by bit-banging.
uloop:
ld3: lda unlock-1,x ; self-modified
sec
ror a ; a bit at a time
: pha
lda #0
rol a
tay
ld2: lda $C300,y ; self-modified
pla
lsr a
bne :-
dex
bne uloop
;; Read 8 bytes * 8 bits of clock data into $200...$207
ldx #8
bloop: ldy #8
st2:
: lda $C304 ; self-modified
ror a
ror $01FF,x
dey
bne :-
lda $01FF,x ; got 8 bits
lsr a ; BCD to binary
lsr a ; shift out tens
lsr a
lsr a
tay
beq donebcd
lda $01FF,x
and #$0F ; mask out units
clc
: adc #10 ; and add tens as needed
dey
bne :-
sta $01FF,x
donebcd:
dex
bne bloop
;; Now $200...$207 is y/m/d/w/H/M/S/f
;; Update ProDOS date/time.
lda $0204 ; hour
sta TIMELO+1
lda $0205 ; minute
sta TIMELO
lda $0201 ; month
asl a
asl a
asl a
asl a
asl a
ora $0202 ; day
sta DATELO
lda $0200 ; year
rol a
sta DATELO+1
pla
bmi done
st4: sta $CFFF ; self-modified
done: plp
rts
unlock:
;; NSC unlock sequence
.byte $5C, $A3, $3A, $C5
.byte $5C, $A3, $3A, $C5
.byte $00
sizeof_driver := * - driver
.assert sizeof_driver <= 125, error, "Clock code must be <= 125 bytes"
;;; ************************************************************
.include "driver_postamble.inc"
;;; ************************************************************

124
prodos.mod.s Normal file
View File

@ -0,0 +1,124 @@
;;; The Cricket Clock - ProDOS Patcher
;;; Disassembled from /CRICKET/PRODOS.MOD
;;; Original: Street Electronics Corporation (C) 1984
.setcpu "6502"
.include "apple2.inc"
.include "opcodes.inc"
.include "./inc/apple2.inc"
.include "./inc/prodos.inc"
.org $300
.proc install
ptr := $42
;; Copy driver to target in ProDOS
lda DATETIME+1
sta ptr
lda DATETIME+2
sta ptr+1
lda #OPC_JMP_abs ; JMP opcode
sta DATETIME
lda ROMIN ; Write bank 2
lda ROMIN
ldy #sizeof_driver-1
loop: lda driver,y
sta (ptr),y
dey
bpl loop
;; Simple exit when BRUN
rts
.endproc
;; Driver - relocatable code. Called by ProDOS to update date/time bytes
.proc driver
scratch := $3A ; ZP scratch location
;; Initialize
php
sei
lda COMMAND ; save status of command register
pha
;; Configure SSC
lda #%00001011 ; no parity/echo/interrupts, RTS low, DTR low
sta COMMAND
lda #%10011110 ; 9600 baud, 8 data bits, 2 stop bits
sta CONTROL
;; Send command
: lda STATUS
and #(1 << 4) ; transmit register empty? (bit 4)
beq :- ; nope, keep waiting
lda #('@' | $80) ; '@' command
sta TDREG
read_len := 7 ; read 7 bytes (w/m/d/y/H/M/S)
;; Read response, pushing to stack
ldy #(read_len-1)
rloop: ldx #0 ; x = retry loop counter low byte
lda #3 ; scratch = retry loop counter high byte
sta scratch ; ($300 iterations total)
check: lda STATUS ; did we get it?
and #(1 << 3) ; receive register full? (bit 3)
bne ready ; yes, we read the value
inx ; not yet, so keep trying
bne check ; until counter runs out
dec scratch
bne check
;; Read failed - restore stack and exit
reset: cpy #(read_len-1) ; anything left to restore?
beq done ; nope, exit
pla ; yep, clear it off the stack
iny
bne reset
;; Read succeeded - stuff it on the stack and continue
ready: lda RDREG
pha
dey
bpl rloop
;; Convert pushed response to ProDOS time field
pla ; day of week (unused)
pla ; minute
sta TIMELO ; -- stored as-is (TIMELO 5-0)
pla ; hour
sta TIMELO+1 ; -- stored as-is (TIMELO 12-8)
pla ; year
sta DATELO+1 ; -- will be shifted up by 1 (DATELO 15-9)
pla ; day
and #%00011111 ; -- masked, stored as is (DATELO 4-0)
sta DATELO
pla ; month
asl a ; -- shifted up (DATELO 8-5)
asl a
asl a
asl a
asl a
ora DATELO ; -- merge low 5 bits
sta DATELO
rol DATELO+1
pla ; seconds (unused)
;; Restore prior state
done: pla ; restore saved command state
sta COMMAND
plp
rts
.endproc
sizeof_driver := .sizeof(driver)

BIN
release/cricket.dsk Normal file

Binary file not shown.

88
set.date.s Normal file
View File

@ -0,0 +1,88 @@
;;; SET.DATE utility for The Cricket!
;;; Prompts for date and sends Cricket "Set Date" sequence.
.setcpu "6502"
.linecont +
.feature string_escapes
.include "apple2.inc"
.include "apple2.mac"
.include "inc/apple2.inc"
.include "inc/macros.inc"
.org $2000
.proc main
jsr zstrout
scrcode "\rDate: WWW MM/DD/YY\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08"
.byte 0
jsr GETLN2
;; Configure SSC
lda #%00001011 ; no parity/echo/interrupts, RTS low, DTR low
sta COMMAND
lda #%10011110 ; 9600 baud, 8 data bits, 2 stop bits
sta CONTROL
;; Clock Commands
;; Set Date "SD WWW MM/DD/YY"
lda #HI('S')
jsr sendbyte
lda #HI('D')
jsr sendbyte
lda #HI(' ')
jsr sendbyte
ldx #0
loop: lda INPUT_BUFFER,x
jsr sendbyte
inx
cmp #HI($0D) ; = CR
bne loop
rts
.endproc
;; Write byte in A to SSC
.proc sendbyte
pha
: lda STATUS
and #(1 << 4) ; transmit register empty? (bit 4)
beq :- ; nope, keep waiting
pla
sta TDREG
rts
.endproc
;;; ------------------------------------------------------------
;;; Output a high-ascii, null-terminated string.
;;; String immediately follows the JSR.
.proc zstrout
ptr := $A5
pla ; read address from stack
sta ptr
pla
sta ptr+1
bne skip ; always (since data not on ZP)
next: jsr COUT
skip: inc ptr
bne :+
inc ptr+1
: ldy #0
lda (ptr),y
bne next
lda ptr+1 ; restore address to stack
pha
lda ptr
pha
rts
.endproc
;;; ------------------------------------------------------------

88
set.time.s Normal file
View File

@ -0,0 +1,88 @@
;;; SET.TIME utility for The Cricket!
;;; Prompts for time and sends Cricket "Set Time" sequence.
.setcpu "6502"
.linecont +
.feature string_escapes
.include "apple2.inc"
.include "apple2.mac"
.include "inc/apple2.inc"
.include "inc/macros.inc"
.org $2000
.proc main
jsr zstrout
scrcode "\rTime: HH:MM:SS XM\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08\x08"
.byte 0
jsr GETLN2
;; Configure SSC
lda #%00001011 ; no parity/echo/interrupts, RTS low, DTR low
sta COMMAND
lda #%10011110 ; 9600 baud, 8 data bits, 2 stop bits
sta CONTROL
;; Clock Commands
;; Set Time "ST HH:MM:SS:XM"
lda #HI('S')
jsr sendbyte
lda #HI('T')
jsr sendbyte
lda #HI(' ')
jsr sendbyte
ldx #0
loop: lda INPUT_BUFFER,x
jsr sendbyte
inx
cmp #HI($0D) ; = CR
bne loop
rts
.endproc
;; Write byte in A to SSC
.proc sendbyte
pha
: lda STATUS
and #(1 << 4) ; transmit register empty? (bit 4)
beq :- ; nope, keep waiting
pla
sta TDREG
rts
.endproc
;;; ------------------------------------------------------------
;;; Output a high-ascii, null-terminated string.
;;; String immediately follows the JSR.
.proc zstrout
ptr := $A5
pla ; read address from stack
sta ptr
pla
sta ptr+1
bne skip ; always (since data not on ZP)
next: jsr COUT
skip: inc ptr
bne :+
inc ptr+1
: ldy #0
lda (ptr),y
bne next
lda ptr+1 ; restore address to stack
pha
lda ptr
pha
rts
.endproc
;;; ------------------------------------------------------------

199
test.s Normal file
View File

@ -0,0 +1,199 @@
;;; Test program for The Cricket!
;;; * Probes Slot 2 for Super Serial Card (or compatible)
;;; * Initializes SSC
;;; * Sends Cricket ID sequence
.setcpu "6502"
.linecont +
.feature string_escapes
.include "apple2.inc"
.include "apple2.mac"
.include "opcodes.inc"
.include "./inc/apple2.inc"
.include "./inc/macros.inc"
.org $2000
read_delay_hi = $3 * 3 ; ($300 iterations is normal * 3.6MHz)
.proc detect_cricket
;; Check Slot 2 for SSC. ID bytes per:
;; Apple II Technical Note #8: Pascal 1.1 Firmware Protocol ID Bytes
lda $C205
cmp #$38
bne ssc_not_found
lda $C207
cmp #$18
bne ssc_not_found
lda $C20B
cmp #$01
bne ssc_not_found
lda $C20C
cmp #$31
bne ssc_not_found
jsr zstrout
scrcode "SSC found.\r"
.byte 0
jmp init_ssc
ssc_not_found:
jsr zstrout
scrcode "SSC not found.\r"
.byte 0
rts
;; TODO: Write NUL and check for 'C' ... version ... $8D (CR)
;; https://github.com/inexorabletash/cricket/issues/3
init_ssc:
lda COMMAND ; save status of SSC registers
sta saved_command
lda CONTROL
sta saved_control
;; Configure SSC
lda #%00001011 ; no parity/echo/interrupts, RTS low, DTR low
sta COMMAND
lda #%10011110 ; 9600 baud, 8 data bits, 2 stop bits
sta CONTROL
;; Miscellaneous Commands
;; Read Cricket ID code: 00 ($00)
lda #0
jsr sendbyte
;; "The Cricket will return a "C" (195, $C3) followed
;; by a version number (in ASCII) and a carriage return (141,
;; $8D)."
jsr zstrout
scrcode "Reading SSC: "
.byte 0
jsr readbyte
bcs cricket_not_found ; timeout
cmp #HI('C') ; = 'C' ?
bne cricket_not_found
jsr readbyte
bcs cricket_not_found ; timeout
bcc digit
: jsr readbyte
bcs cricket_not_found ; timeout
cmp #HI($0D) ; = CR ?
beq cricket_found
digit: cmp #HI('0') ; < '0' ?
bcc cricket_not_found
cmp #HI('9' + 1) ; > '9' ?
bcs cricket_not_found
bcc :-
jmp cricket_found
cricket_found:
jsr zstrout
scrcode "\rCricket tentatively found.\r"
.byte 0
jmp exit
cricket_not_found:
jsr zstrout
scrcode "\rCricket not identified.\r"
.byte 0
jmp exit
exit:
lda saved_control
sta CONTROL
lda saved_command
sta COMMAND
rts
saved_command: .byte 0
saved_control: .byte 0
.endproc
;; Write byte in A
.proc sendbyte
pha
: lda STATUS
and #(1 << 4) ; transmit register empty? (bit 4)
beq :- ; nope, keep waiting
pla
sta TDREG
rts
.endproc
;; Read byte into A, or carry set if timed out
.proc readbyte
tries := $100 * read_delay_hi
counter := $A5
lda #<tries
sta counter
lda #>tries
sta counter+1
check: lda STATUS ; did we get it?
and #(1 << 3) ; receive register full? (bit 3)
bne ready ; yes, we read the value
dec counter
bne check
dec counter+1
bne check
jsr zstrout
scrcode "... timeout!"
.byte 0
sec ; failed
rts
ready: lda RDREG ; actually read the register
pha
jsr COUT
pla
clc
rts
.endproc
;;; ------------------------------------------------------------
;;; Output a high-ascii, null-terminated string.
;;; String immediately follows the JSR.
.proc zstrout
ptr := $A5
pla ; read address from stack
sta ptr
pla
sta ptr+1
bne skip ; always (since data not on ZP)
next: jsr COUT
skip: inc ptr
bne :+
inc ptr+1
: ldy #0
lda (ptr),y
bne next
lda ptr+1 ; restore address to stack
pha
lda ptr
pha
rts
.endproc
;;; ------------------------------------------------------------