;;; ============================================================ ;;; ;;; 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+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