mirror of
https://github.com/david-schmidt/Davex.git
synced 2024-09-27 13:55:09 +00:00
318 lines
4.9 KiB
NASM
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
|
||
|
;*********************************************
|