Davex/src/xtn/2/blist.asm
2018-09-16 21:01:16 -04:00

318 lines
4.9 KiB
NASM

;*********************************************
;
; BLIST (BASIC list) command for DAVEX
;
; blist <path> -- prints BAS file in ASCII
;
; by Dave Lyons
; 1-Jul-86
;
; Modified 27-Mar-88 DL ==> v1.0
; calls xcheck_wait at end of line
; source -> merlin
;
; Modified 10-Apr-88 DL ==> v1.1
; wraps to next line and indents after
; the wrap margin if -w used
;
; Modified 25-Jul-88 DL ==> v1.2
; Was first blank in a REM even if there
; were nonblank characters before it!
;
;*********************************************
;
; Converted to MPW IIgs 20-Sep-92 DAL
;
;*********************************************
.segment "CODE_A000"
orgadr = $A000
.org orgadr
.include "Common/2/Globals2.asm"
.include "Common/2/Apple.Globals2.asm"
.include "Common/2/Mli.globals2.asm"
.include "Common/Macros.asm"
MyVersion = $12
MinVersion = $10
;*********************************************
tokens = $D0D0 ; token table inside Applesoft
tok_REM = 178
tok_DATA = 131
;*********************************************
rts
.byte $ee,$ee
.byte MyVersion,MinVersion
.byte %00000000 ;hardware req
.addr descr
.addr orgadr
.addr start
.byte 0,0,0,0
; parameters here
.byte 0,t_wildpath
.byte $80+'w',t_int1
.byte 0,0
descr: pstr "LISTs a BAS file"
byte: .res 2
;*********************************************
; xczpage -- 32 locations
myPtr = xczpage ;.res 2
lastchr = myPtr+2 ;.res 1
lasttok = lastchr+1 ;.res 1
hard_wrap = lasttok+1 ;.res 1
soft_wrap = hard_wrap+1 ;.res 1
horiz = soft_wrap+1 ;.res 1
myA = horiz+1 ;.res 1
myX = myA+1 ;.res 1
myY = myX+1 ;.res 1
;*********************************************
start: lda #0
sta lastchr
sta lasttok
jsr xgetparm_n
sta path+1
sty path
sta info_path+1
sty info_path
jsr check_bas
jsr open_it
sta read_ref
lda #0
sta soft_wrap
sta hard_wrap
lda #'w'+$80
jsr xgetparm_ch
bcs no_wrap
cpy #20
bcs good_wrap
jsr xmess
.byte cr
cstr_cr "*** wrap margin must be 20..255"
jmp xerr
good_wrap:
sty hard_wrap
tya
sec
sbc #10
sta soft_wrap
no_wrap:
linelp: jsr do_line
bcc linelp
rts
;*********************************************
open_it:
jsr mli
.byte mli_open
.addr open_p
bcs outa_here
lda open_ref
rts
open_p: .byte 3
path: .res 2
.addr filebuff
open_ref:
.res 1
;*********************************************
check_bas:
jsr mli
.byte mli_gfinfo
.addr info_p
bcs outa_here
lda info_ftype
cmp #tBAS
beq cb_ok
jsr xmess
.byte cr
cstr_cr "*** not BAS file"
jmp xerr
cb_ok: rts
outa_here:
jmp xProDOS_err
info_p: .byte 10
info_path:
.res 2
.res 1
info_ftype:
.res 1
.res 2
.res 1
.res 2
.res 8
;*********************************************
read2: lda #2
jsr reada
lda byte+1
ora byte
php
lda byte+1
ldy byte
plp
rts
read1: lda #1
reada: sta xfercount
jsr mli
.byte mli_read
.addr read_p
bcs outa_here
lda byte
rts
read_p: .byte 4
read_ref:
.res 1
.addr byte
xfercount:
.addr 0
.addr 0
;*********************************************
do_line:
lda #0
sta horiz
jsr read2
bne not_endprog
sec
rts
not_endprog:
jsr line_number
lda #6
sta horiz
jsr line_text
jsr crout
lda #0
sta horiz
jmp xcheck_wait
;*********************************************
line_number:
jsr read2
jsr xprdec_2
jmp blank
;*********************************************
line_text:
jsr read1
beq line_done
bmi do_token
ora #%10000000
sta lastchr
cmp #$A0
bne print_this
ldx lasttok
cpx #tok_REM
beq skip_this
cpx #tok_DATA
beq skip_this
print_this:
ldx #0 ;25-Jul-88
stx lasttok ;25-Jul-88
jsr mycout
jmp line_text
skip_this:
lda #0
sta lasttok
jmp line_text
do_token:
jsr pr_token
jmp line_text
line_done:
rts
;*********************************************
pr_token:
sta lasttok
pha
jsr blankif
pla
sec
sbc #$7f
tax
lda #>tokens
ldy #<tokens
sta myPtr+1
sty myPtr
srchtok:
dex
beq foundtok
jsr nexttok
jmp srchtok
foundtok:
ldy #0
prtokchr:
lda (myPtr),y
pha
ora #%10000000
sta lastchr
jsr mycout
iny
pla
bpl prtokchr
jsr blankif
rts
nexttok:
ldy #0
lda (myPtr),y
bmi hit_end
jsr incPtr
jmp nexttok
hit_end:
incPtr: inc myPtr
bne Ptrok
inc myPtr+1
Ptrok: rts
;*********************************************
blank: lda #$A0
sta lastchr
jmp mycout
;*********************************************
blankif:
lda #$A0
cmp lastchr
bne blank
rts
;*********************************************
mycout: sta myA
stx myX
sty myY
jsr cout
inc horiz
ldx hard_wrap
beq no_wrp
ora #$80
cmp #$A0
bne check_hard
lda horiz
cmp soft_wrap
bcc no_wrp
bcs do_wrap
check_hard:
lda horiz
cmp hard_wrap
bcc no_wrp
do_wrap:
jsr xmess
.byte cr
cstr " "
lda #5
sta horiz
no_wrp: lda myA
ldx myX
ldy myY
rts
;*********************************************