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

Text File | 1989-12-01 | 11.8 KB | 309 lines

;dir.asm
;===========================================
; User installable command: dir[/w] pattern
;===========================================

poker       = $0016               ;temp
status      = $0090               ;I/O status byte
stkey       = $0091               ;RUN/STOP flag
la          = $00b8
sa          = $00b9
dv          = $00ba
pntr        = $00ec               ;Cursor column
int02       = $1702               ;get default drive (.a) and unit (.x)
int04       = $1704               ;get 1st char of parameter .x
int08       = $1708               ;open file for read
int0a       = $170a               ;find an unused la
int0c       = $170c               ;check ds$ .. return ds in .a
int0d       = $170d               ;print ds$ after int08
int0e       = $170e               ;program terminate. Close all files then READY.
sw1         = $1bfc               ;command line switch 1. (0=none present)
linprt      = $8e32               ;print .x .a as decimal
primm       = $ff7d
setnam      = $ffbd
open        = $ffc0
chkin       = $ffc6
chrin       = $ffcf
chrout      = $ffd2

star        = $0b00
            .wor star
            * = star

            jmp dir
            dw Date

dir         ldx #1                ;open %1 as a directory
            jsr int04             ;check if parameter is there
            bcc dir9              ;ok...use it
            jsr int02             ;otherwise get default unit,drive
            sta def+1             ;store drive
            stx dv                ;store unit
            jsr int0a             ;find a free la
            sta la
            ldy #0                ;sa=0
            sty sa
            lda #4                ;open "$d:*"
            ldx #<def
            ldy #>def
            jsr setnam
            jsr open
            bcs dirx
            jsr int0c
            ldx la
            bne dir8              ;always

dir9        lda #"$"              ;open as type "$"
            jsr int08             ;open it
dir8        bcc dir0              ;open went ok. continue
            pha
            jsr int0d             ;bad open...print ds$
            pla
dirx        jmp int0e             ;and exit

dir0        jsr chkin             ;setup for input
            bcs dirx              ;error..exit
            lda sw1               ;get switch1
            cmp #"w"
            bne zop
            jmp wdir

zop         jsr crdo              ;next line
            lda #0
            sta status
            ldy #3                ;3rd word in is drive number
            .byt $2c
dir1        ldy #2                ;next time skip only 2
            sty poker
dir2        jsr chrin             ;get word in .a high .x low
            tax
            ldy status
            bne dirxx
            jsr chrin
            ldy status
            bne dirxx
            dec poker
            bne dir2
            pha
            jsr white
            pla
            jsr linprt            ;print drive,#blocks or blocks free
            lda #" "
            jsr chrout
            jsr lgreen
            lda #1
            sta flag
dir3        jsr chrin             ;print the rest of the line
            cmp #34
            bne nq
            dec flag
            bpl nq
dir7        jsr chrout
            jsr chrin
            cmp #" "
            beq dir7
            cmp #">"
            beq dir7
            cmp #"*"
            beq dir7
            dec $f1
            cmp #"s"
            beq nq
            inc $f1
            inc $f1
            inc $f1
            cmp #"p"
            beq nq
            inc $f1
            inc $f1
            inc $f1
            inc $f1
            cmp #"r"
            beq nq
            inc $f1
            cmp #"u"
            beq nq
            inc $f1
nq          cmp #0
            beq dir4              ;next line
            jsr chrout
            jmp dir3

dir4        jsr crdo
            bit stkey             ;run/stop?
            bpl dirxx             ;yes-exit
            jmp dir1              ;otherwise next line

dirxx       jsr crdo
            jmp int0e             ;close all and quit

crdo        lda #13
            jmp chrout

def         .asc "$0:*"

;-----------------------------
; do directory with /w option
;-----------------------------

wdir        lda #0
            sta blt
            sta blt+1
            sta blf
            jsr skp2              ;skip load address
            jsr skp4              ;skip drive number
            jsr skpq              ;skip to quote
            jsr white
            jsr primm
            .asc 13,"disk:", 0
            jsr lcyan
            ldy #0
            jsr prttq             ;print until quote
            sty namlen
            ldy #0
prt9        lda name,y
            jsr chrout
            iny
            cpy namlen
            bne prt9
            jsr crdo
            jsr skp0              ;skip to end of line
wdlp        jsr skp2              ;skip pointer - start of loop for dir entry
            jsr chrin             ;blocks lo
            sta blo
            jsr chrin             ;blocks hi
            sta blh
            jsr skpq              ;skip to quote
            bcs wdx               ;no quote - must be blocks free
            ldy #0
            jsr prttq             ;get file name
            sty namlen
            bcs wdx               ;screwed up directory - better quit than crash
spc         jsr chrin             ;get type
            cmp #" "
            beq spc
            cmp #">"
            beq spc
            jsr setcol
            ldy #0
prtnam      lda name,y
            jsr chrout
            iny
            cpy namlen
            bne prtnam
wd2         lda #" "              ;spc(20-len(filename))
            jsr chrout
            lda pntr              ;get cursor column
            beq wd1
            cmp #20
            beq wd1
            cmp #40
            beq wd1
            cmp #60
            beq wd1
            bne wd2

wd1         jsr skp0
            clc
            lda blo
            adc blt
            sta blt
            lda blh
            adc blt+1
            sta blt+1
            inc blf
            jmp wdlp

wdx         jsr crdo
            jsr white
            lda blt+1
            ldx blt
            jsr linprt
            jsr lcyan
            jsr primm
            .asc " blocks in ", 0
            jsr white
            lda #0
            ldx blf
            jsr linprt
            jsr lcyan
            jsr primm
            .asc " files.",13,0
            jsr white
            lda blh
            ldx blo
            jsr linprt
            jsr lcyan
            jsr primm
            .asc " blocks free.",13,0
            jmp int0e

skpq        jsr chrin
            cmp #0
            beq bdq
            cmp #34
            bne skpq
skpqrt      clc
            rts

prttq       jsr chrin
            cmp #0
            beq bdq
            cmp #34
            beq skpqrt
            sta name,y
            iny
            bne prttq

bdq         sec
            rts

blo         .byt 0
blh         .byt 0
blf         .byt 0
blt         .wor 0

skp4        jsr skp2
skp2        jsr chrin
            jmp chrin

skp0        jsr chrin
            cmp #0
            bne skp0
            rts

white       lda #$8f
            .byt $2c
lgreen      lda #$85
            .byt $2c
dgreen      lda #$84
            .byt $2c
yellow      lda #$8d
            .byt $2c
brown       lda #$8c
            .byt $2c
purple      lda #$8b
            .byt $2c
lcyan       lda #$87
            sta $f1
            rts

flag        .byt 0

setcol      cmp #"*"
            beq white
            cmp #"s"
            beq dgreen
            cmp #"p"
            beq lcyan
            cmp #"r"
            beq purple
            cmp #"u"
            beq brown
            bne yellow

namlen      *=*+1
name        *=*+32

            .end