mirror of
https://github.com/a2stuff/chtype.git
synced 2024-09-27 11:59:29 +00:00
296 lines
8.1 KiB
ArmAsm
296 lines
8.1 KiB
ArmAsm
;;; ============================================================
|
|
;;;
|
|
;;; CHTYPE - File type changing command for ProDOS-8
|
|
;;;
|
|
;;; Install:
|
|
;;; -CHTYPE (from BASIC.SYSTEM prompt)
|
|
;;; Usage:
|
|
;;; CHTYPE filename[,Ttype][,Aaux][,S#][,D#]
|
|
;;;
|
|
;;; * filename can be relative or absolute path
|
|
;;; * specify T$nn to set file type
|
|
;;; * specify A$nnnn to set aux type info
|
|
;;; * type can be BIN, SYS, TXT (etc) or $nn
|
|
;;; * with neither T nor A option, prints current values
|
|
;;;
|
|
;;; Build with: ca65 - https://cc65.github.io/doc/ca65.html
|
|
;;;
|
|
;;; ============================================================
|
|
|
|
.org $2000
|
|
|
|
;;; ============================================================
|
|
|
|
INBUF := $200 ; GETLN input buffer
|
|
|
|
;;; ============================================================
|
|
;;; Monitor ROM routines
|
|
|
|
CROUT := $FD8E
|
|
PRBYTE := $FDDA
|
|
COUT := $FDED
|
|
|
|
;;; ============================================================
|
|
;;; ProDOS MLI / Global Page
|
|
|
|
SET_FILE_INFO = $C3
|
|
GET_FILE_INFO = $C4
|
|
|
|
DATE := $BF90
|
|
|
|
;;; ============================================================
|
|
;;; BASIC.SYSTEM Global Page
|
|
|
|
EXTRNCMD := $BE06 ; External command jmp vector
|
|
ERROUT := $BE09 ; Error routine jmp vector
|
|
XTRNADDR := $BE50 ; Ext cmd implementation addr
|
|
|
|
XLEN := $BE52 ; Length of command string minus 1
|
|
XCNUM := $BE53 ; Command number (ext cmd = 0).
|
|
|
|
PBITS := $BE54 ; Command parameter bits
|
|
FBITS := $BE56 ; Found parameter bits
|
|
|
|
.enum PBitsFlags
|
|
;; PBITS
|
|
PFIX = $80 ; Prefix needs fetching
|
|
SLOT = $40 ; No parameters to be processed
|
|
RRUN = $20 ; Command only valid during program
|
|
FNOPT = $10 ; Filename is optional
|
|
CRFLG = $08 ; CREATE allowed
|
|
T = $04 ; File type
|
|
FN2 = $02 ; Filename '2' for RENAME
|
|
FN1 = $01 ; Filename expected
|
|
|
|
;; PBITS+1
|
|
AD = $80 ; Address
|
|
B = $40 ; Byte
|
|
E = $20 ; End address
|
|
L = $10 ; Length
|
|
LINE = $08 ; '@' line number
|
|
SD = $04 ; Slot and drive numbers
|
|
F = $02 ; Field
|
|
R = $01 ; Record
|
|
|
|
;; Setting SD in PBITS+1 enables desired automatic behavior: if
|
|
;; a relative path is given, an appropriate prefix is computed,
|
|
;; using S# and D# options if supplied. Without this, absolute
|
|
;; paths must be used if no prefix is set.
|
|
.endenum
|
|
|
|
VADDR := $BE58 ; Address parameter
|
|
VSLOT := $BE61 ; Slot parameter
|
|
VTYPE := $BE6A ; Type parameter
|
|
VPATH1 := $BE6C ; Pathname buffer
|
|
|
|
GOSYSTEM := $BE70 ; Use instead of MLI
|
|
|
|
SSGINFO := $BEB4 ; Get/Set Info Parameter block
|
|
FIFILID := $BEB8 ; (set size to set=7 or get=$A)
|
|
FIAUXID := $BEB9
|
|
FIMDATE := $BEBE
|
|
GETBUFR := $BEF5
|
|
;;; ============================================================
|
|
|
|
;; Save previous external command address
|
|
lda EXTRNCMD+1
|
|
sta next_command
|
|
lda EXTRNCMD+2
|
|
sta next_command+1
|
|
|
|
;; Request a 1-page buffer
|
|
lda #1
|
|
jsr GETBUFR
|
|
bcc :+
|
|
lda #$C ; NO BUFFERS AVAILABLE
|
|
rts
|
|
:
|
|
;; A = MSB of new page - update absolute addresses
|
|
;; (aligned to page boundary so only MSB changes)
|
|
sta page_num1
|
|
sta page_num2
|
|
sta page_num3
|
|
|
|
;; Install new address in external command address
|
|
sta EXTRNCMD+2
|
|
lda #0
|
|
sta EXTRNCMD+1
|
|
|
|
;; Relocate
|
|
ldx #0
|
|
: lda handler,x
|
|
page_num3 := *+2
|
|
sta $2100,x ; self-modified
|
|
inx
|
|
bne :-
|
|
|
|
;; Complete
|
|
rts
|
|
|
|
;;; ============================================================
|
|
;;; Command Handler
|
|
;;; ============================================================
|
|
|
|
;; Align handler to page boundary for easier
|
|
;; relocation
|
|
.res $2100 - *, 0
|
|
|
|
.proc handler
|
|
|
|
;; Check for this command, character by character.
|
|
ldx #0
|
|
nxtchr: lda INBUF,x
|
|
|
|
and #$7F ; Convert to ASCII
|
|
cmp #'a' ; Convert to upper-case
|
|
bcc :+
|
|
cmp #'z'+1
|
|
bcs :+
|
|
and #$DF
|
|
|
|
page_num1 := *+2 ; address needing updating
|
|
: cmp command_string,x
|
|
bne not_ours
|
|
inx
|
|
cpx #command_length
|
|
bne nxtchr
|
|
|
|
;; A match - indicate end of command string for BI's parser.
|
|
lda #command_length-1
|
|
sta XLEN
|
|
|
|
;; 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::T | PBitsFlags::FN1 ; Filename and Type
|
|
sta PBITS
|
|
|
|
lda #PBitsFlags::AD | PBitsFlags::SD ; Address, Slot & Drive handling
|
|
sta PBITS+1
|
|
|
|
clc ; Success (so far)
|
|
rts ; Return to BASIC.SYSTEM
|
|
|
|
;;; ============================================================
|
|
|
|
not_ours:
|
|
sec ; Signal failure...
|
|
next_command := *+1
|
|
jmp $ffff ; Execute next command in chain
|
|
|
|
;;; ============================================================
|
|
|
|
execute:
|
|
;; Verify required arguments
|
|
|
|
lda FBITS
|
|
and #PBitsFlags::FN1 ; Filename?
|
|
bne :+
|
|
lda #$10 ; SYNTAX ERROR
|
|
sec
|
|
rts1: rts
|
|
:
|
|
|
|
;;; --------------------------------------------------
|
|
|
|
;; Get the existing file info
|
|
lda #$A
|
|
sta SSGINFO
|
|
lda #GET_FILE_INFO
|
|
jsr GOSYSTEM
|
|
bcs rts1
|
|
|
|
;;; --------------------------------------------------
|
|
|
|
;; Apply options
|
|
ldy #0 ; count number of options
|
|
|
|
;; Apply optional Type argument as new file type
|
|
lda FBITS
|
|
and #PBitsFlags::T ; Type set?
|
|
beq :+
|
|
iny
|
|
lda VTYPE
|
|
sta FIFILID
|
|
:
|
|
|
|
;; Apply optional Address argument as new aux type
|
|
lda FBITS+1
|
|
and #PBitsFlags::AD ; Address set?
|
|
beq :+
|
|
iny
|
|
lda VADDR
|
|
sta FIAUXID
|
|
lda VADDR+1
|
|
sta FIAUXID+1
|
|
:
|
|
|
|
;; If no options were used, show current details instead.
|
|
cpy #0
|
|
beq show
|
|
|
|
;; Apply current date/time
|
|
ldx #3
|
|
: lda DATE,x
|
|
sta FIMDATE,x
|
|
dex
|
|
bpl :-
|
|
|
|
;; Set new file info
|
|
lda #$7
|
|
sta SSGINFO
|
|
|
|
lda #SET_FILE_INFO
|
|
jmp GOSYSTEM
|
|
|
|
;;; --------------------------------------------------
|
|
|
|
show:
|
|
lda #'T'|$80
|
|
jsr COUT
|
|
lda #'='|$80
|
|
jsr COUT
|
|
lda #'$'|$80
|
|
jsr COUT
|
|
lda FIFILID
|
|
jsr PRBYTE
|
|
jsr CROUT
|
|
|
|
lda #'A'|$80
|
|
jsr COUT
|
|
lda #'='|$80
|
|
jsr COUT
|
|
lda #'$'|$80
|
|
jsr COUT
|
|
lda FIAUXID+1
|
|
jsr PRBYTE
|
|
lda FIAUXID
|
|
jsr PRBYTE
|
|
jsr CROUT
|
|
|
|
clc
|
|
rts
|
|
|
|
;;; ============================================================
|
|
;;; Data
|
|
|
|
command_string:
|
|
.byte "CHTYPE" ; Command string
|
|
command_length = *-command_string
|
|
|
|
.endproc
|
|
.assert .sizeof(handler) <= $100, error, "Must fit on one page"
|
|
page_num1 := handler::page_num1
|
|
page_num2 := handler::page_num2
|
|
next_command := handler::next_command
|