Add DATE and TYPE commands

This commit is contained in:
Joshua Bell 2021-04-13 19:12:07 -07:00
parent ef8857752f
commit 9085407ac5
9 changed files with 476 additions and 18 deletions

View File

@ -6,7 +6,7 @@ OUTDIR := out
TARGETS := $(OUTDIR)/path.BIN \
$(OUTDIR)/chtype.CMD $(OUTDIR)/chtime.CMD \
$(OUTDIR)/copy.CMD \
$(OUTDIR)/copy.CMD $(OUTDIR)/date.CMD $(OUTDIR)/type.CMD \
$(OUTDIR)/bell.CMD $(OUTDIR)/hello.CMD $(OUTDIR)/echo.CMD $(OUTDIR)/online.CMD
XATTR := $(shell command -v xattr 2> /dev/null)

View File

@ -50,6 +50,8 @@ Sample commands included:
* Useful utilities:
* `ONLINE` - lists online volumes (volume name, slot and drive)
* `COPY` - copy a single file, e.g. `copy /path/to/file,dstfile`
* `TYPE` - show file contents (TXT, BAS, or BIN/other), e.g. `type filename`
* `DATE` - prints the current ProDOS date and time
* `CHTYPE` - change the type/auxtype of a file. e.g. `chtype file,T$F1,A$1234`
* `T` (type) and `A` (auxtype) are optional. If neither is specified, current types are shown.
* `S` and `D` arguments can be used to specify slot and drive.

View File

@ -41,10 +41,12 @@
;;; ============================================================
FN1REF := $D6
FN2REF := $D7
FN1INFO := $2EE
FN1BUF := $4200
FN2BUF := $4600
DATABUF := $4A00
FN2BUF := $4200
DATABUF := $4600
DATALEN = $6000 - DATABUF
execute:
@ -72,9 +74,9 @@ rts1: rts
bpl :-
;; Open FN1
lda #<FN1BUF
lda HIMEM ; Use BI's general purpose buffer
sta OSYSBUF
lda #>FN1BUF
lda HIMEM+1
sta OSYSBUF+1
lda #OPEN
jsr GOSYSTEM
@ -101,7 +103,7 @@ rts1: rts
dey
bpl :-
;; Get FN1 info
;; Get FN2 info
lda #GET_FILE_INFO
jsr GOSYSTEM
bcs :+
@ -195,7 +197,4 @@ finish: jsr close
rts
.endproc
FN1REF: .byte 0
FN2REF: .byte 0
.assert * <= FN1BUF, error, "Too long"
.assert * <= FN2BUF, error, "Too long"

131
date.cmd.s Normal file
View File

@ -0,0 +1,131 @@
;;; ============================================================
;;;
;;; DATE - Print the current date/time
;;;
;;; Usage: DATE
;;;
;;; NOTE: Only supports 2 digit years
;;;
;;; ============================================================
.include "apple2.inc"
.include "more_apple2.inc"
.include "prodos.inc"
;;; ============================================================
.org $4000
start:
jsr CROUT
;;; 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 |
;;; +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
MLI_CALL GET_TIME, 0
lda DATELO
ora DATEHI
beq not_set
;; 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 #'/'|$80 ; /
jsr COUT
pla ; day
and #%00011111
jsr cout_number
lda #'/'|$80 ; /
jsr COUT
pla ; year
jsr cout_number
lda #' '|$80 ;
jsr COUT
jsr COUT
;; Time
lda TIMELO+1 ; hour
and #%00011111
jsr cout_number
lda #':'|$80 ; ':'
jsr COUT
lda TIMELO ; minute
and #%00111111
jsr cout_number
finish: jsr CROUT
clc
rts
not_set:
ldx #0
: lda msg,x
beq finish
ora #$80
jsr COUT
inx
bne :- ; always
msg: .byte "<NO DATE>", 0
;;; ============================================================
;;; Print a 2-digit number, with leading zeros
.proc cout_number
;; Reduce to 2 digits
: cmp #100
bcc :+
sec
sbc #100
bne :-
;; Leading zero?
: ldx #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
ora #'0'|$80 ; convert to digit
jsr COUT
units: pla
ora #'0'|$80 ; convert to digit
jsr COUT
rts
.endproc

View File

@ -3,9 +3,16 @@
INBUF := $200
;;; ============================================================
;;; Zero Page
LINUM := $1B
;;; ============================================================
;;; Monitor ROM routines
PRTAX := $F941
CROUT := $FD8E
PRBYTE := $FDDA
COUT := $FDED
@ -20,4 +27,6 @@ BELL := $FF3A
;;; ============================================================
;;; Applesoft ROM locations
TOKEN_NAME_TABLE := $D0D0
TOKTABL := $D0D0
LINPRT := $ED24

View File

@ -18,7 +18,7 @@ add_file () {
}
add_file "out/path.BIN" "path#062000"
for file in bell echo hello online chtype chtime copy; do
for file in bell echo hello online chtype chtime copy date type; do
add_file "out/${file}.CMD" "${file}#F04000"
done

10
path.s
View File

@ -136,7 +136,7 @@ page_delta:
.proc handler
ptr := $06 ; pointer into VPATH
tptr := $08 ; pointer into TOKEN_NAME_TABLE
tptr := $08 ; pointer into TOKTABL
lda VPATH1
sta ptr
@ -204,15 +204,15 @@ check_if_token:
;; Check if it's a BASIC token. Based on the AppleSoft BASIC source.
;; Point tptr at TOKEN_NAME_TABLE less one page (will advance below)
lda #<(TOKEN_NAME_TABLE-$100)
;; Point tptr at TOKTABL less one page (will advance below)
lda #<(TOKTABL-$100)
sta tptr
lda #>(TOKEN_NAME_TABLE-$100)
lda #>(TOKTABL-$100)
sta tptr+1
;; These are immediately incremented
dex
ldy #$FF ; (tptr),y offset TOKEN_NAME_TABLE
ldy #$FF ; (tptr),y offset TOKTABL
;; Match loop
mloop: iny ; Advance through token table

View File

@ -3,7 +3,13 @@
MLI := $BF00
DATE := $BF90
DATELO := $BF90
DATEHI := $BF91
TIME := $BF92
TIMELO := $BF92
TIMEHI := $BF93
GET_TIME = $82
CREATE = $C0
SET_FILE_INFO = $C3
GET_FILE_INFO = $C4

311
type.cmd.s Normal file
View File

@ -0,0 +1,311 @@
;;; ============================================================
;;;
;;; TYPE - Dump contents of files to the screen
;;;
;;; Usage: TYPE pathname[,S#][,D#]
;;;
;;; Inspiration from OmniType by William H. Tudor, Nibble 2/1989
;;;
;;; ============================================================
.include "apple2.inc"
.include "more_apple2.inc"
.include "prodos.inc"
;;; ============================================================
.org $4000
;; NOTE: Assumes XLEN is set by PATH
;; Point BI's parser at the command execution routine.
lda #<execute
sta XTRNADDR
page_num2 := *+1 ; address needing updating
lda #>execute
sta XTRNADDR+1
;; Mark command as external (zero).
lda #0
sta XCNUM
;; Set accepted parameter flags (Name, Type, Address)
lda #PBitsFlags::FN1 ; Filenames
sta PBITS
lda #PBitsFlags::SD ; Slot & Drive handling
sta PBITS+1
clc ; Success (so far)
rts ; Return to BASIC.SYSTEM
;;; ============================================================
DATABUF := INBUF
execute:
;; Get FN1 info
lda #$A
sta SSGINFO
lda #GET_FILE_INFO
jsr GOSYSTEM
bcs rts1
;; Reject directory file
lda FIFILID
cmp #$F ; DIR
bne :+
lda #$D ; FILE TYPE MISMATCH
sec
rts1: rts
:
;; Open the file
lda HIMEM ; Use BI's buffer above HIMEM
sta OSYSBUF
lda HIMEM+1
sta OSYSBUF+1
lda #OPEN
jsr GOSYSTEM
bcs rts1
;; Prepare the read arguments
lda OREFNUM
sta RWREFNUM
sta CFREFNUM
lda #<DATABUF ; Stash read data here
sta RWDATA
lda #>DATABUF
sta RWDATA+1
lda #<1 ; Read one byte at a time
sta RWCOUNT
lda #>1
sta RWCOUNT+1
lda #0 ; For BASIC
sta LINUM
sta LINUM+1
lda FIFILID ; File type
cmp #$04 ; TXT
beq text
cmp #$FC ; BAS
bne :+
jmp basic
:
;; fall through
;;; ============================================================
;;; Generic (Binary) file
.proc binary
jsr ReadByte
bcc :+
jmp Exit
: pha
;; Line prefix
jsr CROUT
lda #'$'|$80
jsr COUT
ldx LINUM
lda LINUM+1
jsr PRTAX
lda #'-'|$80
jsr COUT
pla
ldx #8 ; 8 bytes at a time
bne byte ; always
;; Line of bytes in hex
bloop: jsr ReadByte
bcc byte
lda #' ' ; at EOF, space it out
sta INBUF,x
ldy #3
bne spaces ; always
byte: sta INBUF,x ; stash bytes
jsr PRBYTE
ldy #1
spaces: jsr PrintYSpaces
dex
bne bloop
;; Character display
lda #'|'|$80
jsr COUT
ldx #8 ; 8 bytes at a time
cloop: lda INBUF,x
ora #$80
cmp #' '|$80 ; control character?
bcs :+
lda #'.'|$80 ; yes, replace with period
: jsr COUT
dex
bne cloop
;; Increment offset
lda #8
clc
adc LINUM
sta LINUM
bcc :+
inc LINUM+1
:
jmp binary
.endproc
;;; ============================================================
;;; Text file
.proc text
jsr ReadByte
bcs Exit
ora #$80
cmp #$8D ; CR?
beq :+
cmp #' '|$80 ; other control character?
bcc text ; yes, ignore
: jsr COUT
jmp text
.endproc
;;; ============================================================
;;; BASIC file
.proc basic
jsr CROUT
jsr ReadByte ; first two bytes are pointer to next line
jsr ReadByte
bcs Exit ; EOF
beq Exit ; null high byte = end of program
;; Line number
jsr ReadByte ; line number hi
bcs Exit
tax
jsr ReadByte ; line number lo
bcs Exit
jsr LINPRT ; print line number
jsr PrintSpace
;; Line contents: EOL, token, or character?
lloop: jsr ReadByte
beq basic ; EOL
bmi token ; token
cout: ora #$80
jsr COUT
jmp lloop
ptr := $06
;; Token
token: and #$7F
tax ; command index
jsr PrintSpace ; space before token
lda #<TOKTABL
sta ptr
lda #>TOKTABL
sta ptr+1
;; Search through token table; last char
;; of each token has high bit set.
ldy #0
cpx #0
beq tloop2
tloop1: lda (ptr),y
bpl :+
dex ; last char, is next it?
beq found
: inc ptr ; nope, advance to next
bne :+
inc ptr+1
: bne tloop1 ; always
found: iny ; past last char of prev token
tloop2: lda (ptr),y
bmi :+
ora #$80
jsr COUT
iny
bne tloop2 ; always
: jsr COUT
lda #' ' ; space after token
bne cout ; always
.endproc
;;; ============================================================
PrintSpace:
ldy #1
;; fall through
.proc PrintYSpaces
lda #' '|$80
: jsr COUT
dey
bne :-
rts
.endproc
;;; ============================================================
.proc Exit
jsr Close
jsr CROUT
clc
rts
.endproc
.proc ExitWithError
pha
jsr Close
pla
sec
rts
.endproc
.proc Close
lda #CLOSE
jsr GOSYSTEM
rts
.endproc
;;; ============================================================
;;; Read a single byte; returns C=1 on EOF
;;; On error, exits.
.proc ReadByte
lda #READ
jsr GOSYSTEM
bcs :+
lda DATABUF
rts
: cmp #5 ; END OF DATA?
beq :+ ; exit with C=1 for EOF
tax ; stash error
pla ; pop return from stack
pla
txa ; unstash error
pha ; re-stash error
jsr Close
pla ; unstash error
: sec ; either w/ error or on EOF
rts
.endproc
;;; ============================================================