309 lines
7.1 KiB
ArmAsm
309 lines
7.1 KiB
ArmAsm
;;; ============================================================
|
|
;;;
|
|
;;; 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
|
|
lda #>execute
|
|
sta XTRNADDR+1
|
|
|
|
;; Mark command as external (zero).
|
|
lda #0
|
|
sta XCNUM
|
|
|
|
;; Set accepted parameter flags (Filename)
|
|
|
|
lda #PBitsFlags::FN1 ; Filename
|
|
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 #FT_DIR
|
|
bne :+
|
|
lda #BI_ERR_FILE_TYPE_MISMATCH
|
|
sec
|
|
rts1: rts
|
|
:
|
|
;; Open the file
|
|
lda HIMEM+1 ; Use BI's general purpose buffer (page aligned)
|
|
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 #FT_TXT
|
|
beq Text
|
|
cmp #FT_BAS
|
|
bne :+
|
|
jmp Basic
|
|
:
|
|
|
|
;; fall through
|
|
|
|
;;; ============================================================
|
|
;;; Generic (Binary) file
|
|
|
|
.proc Binary
|
|
repeat: 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
|
|
repeat: jsr ReadByte
|
|
bcs Exit
|
|
|
|
ora #$80
|
|
cmp #$8D ; CR?
|
|
beq :+
|
|
cmp #' '|$80 ; other control character?
|
|
bcc repeat ; yes, ignore
|
|
|
|
: jsr COUT
|
|
jmp repeat
|
|
.endproc
|
|
|
|
;;; ============================================================
|
|
;;; BASIC file
|
|
|
|
.proc Basic
|
|
repeat: 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 repeat ; 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
|
|
|
|
;;; ============================================================
|