CP/M/CPM_CDROM.iso/enterprs/c128/text/examples.arc/CHECK.A

Text File | 1989-12-01 | 18.1 KB | 490 lines

;check.asm
;=================================
; Command:  check patternlist
;=================================

len         = $005d
tlen        = $0060
blks        = $0024
tblks       = $0026

int04       = $1704
int0a       = $170a
int0b       = $170b
int0e       = $170e
int16       = $1716
int17       = $1717
cl          = $1bf7
cdr         = $1bf8
cdv         = $1bf9
sw1         = $1bfc

fnbank      = $00c7
pntr        = $00ec
hexa        = $b8c2
primm       = $ff7d
second      = $ff93
tksa        = $ff96
acptr       = $ffa5
ciout       = $ffa8
untlk       = $ffab
unlsn       = $ffae
listen      = $ffb1
talk        = $ffb4
setlfs      = $ffba
setnam      = $ffbd
open        = $ffc0
close       = $ffc3
chkin       = $ffc6
chkout      = $ffc9
clrchn      = $ffcc
chrin       = $ffcf
chrout      = $ffd2
stop        = $ffe1

star        = $0b00
            .wor star
            * = star

            jmp check
            dw Date

check       ldx #1                ;check for filename list
            jsr int04
            bcc check0            ;got at least one.
            jsr primm
            .asc 13,"Syntax:  check patternlist",13, 0
            jmp int0e

check0      lda #0
            sta tblks
            sta tblks+1
            sta tlen
            sta tlen+1
            sta tlen+2
            sta tfils
            sta tfils+1
            stx parm              ;start with parameter 1 and work up
            jsr eqwls
            jsr primm
            .asc 13," d:filename          type      bytes blks",13,0
            jsr eqwls
main        ldx parm
            jsr int04             ;make sure parm is there
            bcc chkit             ;got one
sum         jmp smmry             ;parameters all used up

chkit       jsr int16             ;get 1st matching filename
            bcs chknxt            ;no matches. next parameter
            lda cl
            sta cll
            jsr ocmd              ;open "#" file
            bcc chkagn            ;ok
            jsr int0b             ;error opening. print ds$
            jmp int0e             ;and abort
chkagn      jsr chkfil            ;check this file
            jsr prtit             ;display results
            jsr stop              ;check for stop key
            beq sum
            jsr int17             ;check for more matches
            bcc chkagn            ;ok. go again
            jsr ccmd              ;close "#" file
chknxt      inc parm
            bne main              ;always

;-----------------------------------
; Subroutine: get file's statistics
;-----------------------------------

chkfil      lda $1b01             ;1st (track,sector)
            sta ibuf
            lda $1b02
            sta ibuf+1
            lda #0                ;reset length
            sta len
            sta len+1
            sta len+2
            sta blks
            sta blks+1
cf          jsr link              ;get block
            lda ibuf+1            ;maybe length
            sec
            sbc #1
            ldx ibuf
            beq cf0               ;end of file. got length of last block in .a
            lda #254
cf0         clc
            adc len
            sta len
            bcc cf1
            inc len+1
            bne cf1
            inc len+2
cf1         inc blks
            bne cf2
            inc blks+1
cf2         lda ibuf
            bne cf
            clc
            lda len
            adc tlen
            sta tlen
            lda len+1
            adc tlen+1
            sta tlen+1
            lda len+2
            adc tlen+2
            sta tlen+2
            clc
            lda blks
            adc tblks
            sta tblks
            lda blks+1
            adc tblks+1
            sta tblks+1
            inc tfils
            bne tf
            inc tfils+1
tf          rts

;------------------------------------
; subroutine: get next block of file
;------------------------------------

link        lda ibuf              ;track 0
            bne lk0               ;no. go on
            rts

lk0         jsr br                ;get 1st four bytes of block
            lda blks
            ora blks+1
            bne lk1               ;skip if not 1st block of file
            lda ibuf+2
            sta ldad
            lda ibuf+3
            sta ldad+1
lk1         rts

;-------------------
; send disk command
;-------------------

u1          ldy #9                ;store at offset 8
            lda ibuf              ;get track
            jsr d3                ;convert to ascii
            iny
            lda ibuf+1            ;repeat for sector
            jsr d3
            ldy #0                ;and send u1 or u2
sndcmd      lda edv               ;device to exec from
            jsr listen
            lda #$6f
            jsr second
sc0         lda dskcmd,y
            beq sc1
            jsr ciout
            iny
            bne sc0
sc1         jmp unlsn

dskcmd      .asc "u1: 03 0 ttt sss", 0

;-------------------------------------
; convert .a to ascii for b-r and b-w
;-------------------------------------

d3          ldx #$ff              ;print .a as ###
d4          inx
            sec
            sbc #100
            bcs d4
            adc #100
            jsr d5
d2          ldx #$ff              ;print .a as ##
d6          inx
            sec
            sbc #10
            bcs d6
            adc #10
            jsr d5
            tax
d5          pha
            txa
            ora #$30
            sta dskcmd,y
            iny
            pla
            rts

br          jsr u1
            lda edv               ;read in a block
            jsr talk
            lda esa
            ora #$60
            jsr tksa
            ldy #0
brfb        jsr acptr
            sta ibuf,y
            iny
            cpy #4
            bne brfb
            jmp untlk

ocmd        jsr int0a             ;get free la,sa
            sta ccmd+1
            ldx cdv
            stx edv
            jsr setlfs
            tya
            sta esa
            ldy #4
            jsr d2
            lda cdr
            sta dskcmd+7
            lda #1
            ldx #<num
            ldy #>num
            jsr setnam
            lda #0
            sta fnbank
            jsr open
            bcc ocmd0
ccmd        lda #0
            jsr close
            sec
ocmd0       rts

num         .asc "#"

;-------------------------------
; display results of file check
;-------------------------------

cr          lda #13
            .byt $2c
qt          lda #34
            .byt $2c
sp          lda #" "
            jmp chrout

prtit       jsr cr                ;new line
            jsr qt                ;print "d:filename"
            lda cll               ;recall drive letter
            jsr chrout
            lda #":"
            jsr chrout
            ldy #0
pr0         lda $1b03,y
            cmp #$a0
            beq pr11
            jsr chrout
            iny
            cpy #16
            bne pr0
pr11        jsr qt
pr1         jsr sp
            lda pntr
            cmp #21
            bne pr1
            bit $1b00             ;protected?
            bvc pr2
            lda #">"
            .byt $2c
pr2         lda #" "
            jsr chrout
            lda $1b00
            and #7
            cmp #5
            bcc pr3
            lda #0
pr3         tay
            lda spur,y
            jsr chrout
            lda spur+5,y
            jsr chrout
            lda spur+10,y
            jsr chrout
            jsr sp
            clc                   ;claculate end address
            lda ldad
            adc len
            sta ead
            lda ldad+1
            adc len+1
            sta ead+1
            jsr h2a               ;print length in bytes
            jsr sp
            lda blks+1
            ldx blks
            jsr linprt
            jsr sp
            lda $1b00
            and #7
            cmp #2
            beq prg
            cmp #4
            beq rel
            bne notprg
prg         lda #"$"
            jsr chrout
            lda ldad+1
            jsr hexa
            lda ldad
            jsr hexa
            lda #"-"
            jsr chrout
            sec
            lda ead
            sbc #2
            sta ead
            lda ead+1
            sbc #0
            jsr hexa
            lda ead
            jsr hexa
notprg      rts

rel         jsr primm
            .asc "rl =", 0
            lda #0
            ldx $1b00+21
            jmp linprt


spur        .asc "?spur"
            .asc "?erse"
            .asc "?qgrl"

;-------------------------------
;output a hex # in ascii decimal
;-------------------------------


h2a         ldx #0                ;initialize indexes
            ldy #0
            sty $02
loop        lda #"0"              ;initialize digit
            sta ascii,x
loop2       sec
            lda len
            sbc table,y
            pha                   ;increment the digit?
            lda len+1
            sbc table+1,y
            pha
            lda len+2
            sbc table+2,y
            bcc nxdigt            ;branch if 'no'
            sta len+2
            pla
            sta len+1
            pla                   ;adjust the hex value
            sta len               ;and increment the digit
            lda #$ff
            sta $02
            inc ascii,x
            bne loop2

nxdigt      pla
            pla
            iny                   ;prepare for next digit
            iny
            iny
            iny
            inx
            bit $02
            bmi nadj
            lda #" "
            sta ascii-1,x
nadj        cpx #8
            bcc loop
npr         nop
            ldy #0                ;prepare to send number
loop3       cpy #2
            beq pcom
            cpy #5
            bne nocom
pcom        lda ascii-1,y
            cmp #" "
            beq ppcom
            lda #","
ppcom       jsr chrout
nocom       lda ascii,y
            jsr chrout
            iny
            cpy #8
            bcc loop3
            rts                   ;done, return


table       .wor 38528, 152
            .wor 16960, 15
            .wor 34464, 1
            .wor 10000, 0
            .wor  1000, 0
            .wor   100, 0
            .wor    10, 0
            .wor     1, 0

smmry       jsr cr
            jsr eqwls
            jsr cr
            ldx tfils
            lda tfils+1
            jsr linprt
            jsr primm
            .asc " file(s)", 0
sm0         jsr sp
            lda pntr
            cmp #26
            bne sm0
            lda tlen
            sta len
            lda tlen+1
            sta len+1
            lda tlen+2
            sta len+2
            jsr h2a
            jsr sp
            ldx tblks
            lda tblks+1
            jsr linprt
            jsr cr
            jmp int0e

eqwls       ldy #52
eq          lda #"="
            jsr chrout
            dey
            bne eq
            rts

linprt      ldy #$60
            sty npr
            stx len
            sta len+1
            lda #0
            sta len+2
            jsr h2a
            lda #$ea
            sta npr
            ldy #4
lpt         lda ascii,y
            jsr chrout
            iny
            cpy #8
            bne lpt
            rts

ascii       *=*+8
parm        *=*+1
cll         *=*+1
ibuf        *=*+4
ldad        *=*+2
ead         *=*+2
edv         *=*+1
esa         *=*+1
tfils       *=*+2

            .end