rtsi.com/2014.01.www.rtsi.com.tar/www.rtsi.com/UNIFLEX/UNIFLEX/UniFLEX_Std.Utils1.tar.Z/UniFLEX_Std.Utils1.tar/utils1/find

Text File | 1981-09-01 | 13KB | 627 lines

 nam Find - find string in file(s)
 opt pag
 pag
***  Find - find string in file(s)
 spc 4
***  Program call.
*
*    find <file name(s)> <target string>
 spc 4
**   macro definitions.
 spc 2
 spc 4
**   Local Macro Definitions.
 spc 2
**   msg - define message
*
* tag msg "text"[,terminator]
*
* defines "tag" concatencated with "l" to be length of message
 spc 2
msg macro
 fcc "&1"
 ifnc &2,""
 fcb &2
 endif
&0l equ *-&0
 endm
 spc 2
**   Messag - Write message.
*
*    messag file-descriptor,message-address[,message-length]
*
*    if "message-length" is not specified, the symbol for
*    "message-address", concatenated with an "l", is used.
 spc 2
messag macro
 ldd #&1
 ifnc &3,""
 sys write,&2,&3
 else
 sys write,&2,&2l
 endif
 endm
 spc 4
**   Symbol definitions
 spc 2
 lib sysdef
 lib syserrors
OWNERR equ 255 "own" error

INPUT equ 0 keyboard input file descriptor
OUTPUT equ 1 display output file descriptor
ERROUT equ 2 standard error output
BUFSIZ equ 256 terminal i/o buffer size
FBFSIZ equ 2048 file buffer size
CRGRET equ $d carriage return
 spc 4
**   Variable definitions.
 spc 2
 org 0

ra rmb 2 restart address
trmin rmb 11 keyboard i/o block
trmout rmb 11 display i/o block
filin rmb 11 file i/o block
sa rmb 2 string address
oc rmb 2 occurrence count
fp rmb 2 file pointer
ll rmb 2 line buffer limiting address
ln rmb 2 line number

VARLEN rmb 0 length of variables
 sttl Main program.
 pag
**   Main program.

 org 0

find leay 0,s remember argument address
 ldd #VARLEN

find0 pshs a clear stack
 decb
 bne find0
 leau 0,s set variable pointer
 jsr prs preset

find1 jsr onf open next file
 beq find3 if no more file names
find2 jsr llb load line buffer
 bvs find1 if end of file
 jsr sfo search for occurrence
 bra find2 loop through file

find3 clra terminate normally
 clrb
 sys term
 spc 4
**   abort - error exit
 spc 2
abort ldd #OWNERR
 sys term
 sttl Subroutines.
 pag
**   Subroutines.
 spc 4
**   ccf - close current file.
 spc 2
ccf ldd filin+5,u get descriptor
 beq ccf1 if no file open
 sys close close file
 jsr poc print occurrence count
ccf1 rts return

*
* decst
*
* Convert the number in D into an ascii string
* representing a decimal number.  The string
* is pointed at by X (X should be set on entry!)
* Also on exit, D has the length of the string.
* The second entry point, 'decstn' will not print
* leading spaces for leading zeroes, but will
* suppress all leading zero info.  All strings
* start with a space.
*

decst pshs x save user pointer
 clr 0,-s set suppression flag
 bra decst2
*
decstn pshs x save user pointer
 clr 0,-s
 inc 0,s set for no fielding
decst2 pshs a
 lda #$20 setup leading space
 sta 0,x+ save in buffer
 puls a
 clr 0,-s set up bookkeeping
 clr 0,-s
 ldy #conlst point to constants
decst4 cmpd 0,y compare number to constant
 blo decst5
 subd 0,y do subtraction of constant
 inc 1,s bump digits counter
 bra decst4
decst5 pshs a save number
 tst 2,s zero digit?
 bne decst6
 tst 1,s any numbers output yet?
 bne decst6
 tst 3,s doing suppression?
 bne decst8
 lda #$20 set up space
 bra decst7
decst6 lda 2,s get digit count
 inc 1,s set 'got one' flag
 ora #$30 make ascii
decst7 sta 0,x+ save in buffer
decst8 puls a reset number
 clr 1,s clear out digit
 leay 2,y bump constant ptr
 cmpy #conend end of list?
 bne decst4
 leas 3,s clean up stack
 orb #$30 make last digit
 stb 0,x+ save in buffer
 clr 0,x null terminate string
 tfr x,d
 subd 0,s calculate string length
 puls x,pc return

* constants for convert

conlst fdb 10000
 fdb 1000
 fdb 100
 fdb 10
conend equ * end of list
 spc 4
**   fob - flush output buffer.
*
*    entry (x)=i/o block pointer
 spc 2
fob pshs a,b,y
 ldd 3,x save buffer size
 pshs d
 subd 9,x determine number of characters
 beq fob1 if empty
 std 3,x set character count to write
 ldd 5,x (d)=file descriptor number
 sys indx dump buffer
 bec fob0 if no error
 cmpd #EINTR check error number
 bne fob2 if not "interrupted system call"
fob0 ldd 1,x update character pointer
 std 7,x
fob1 puls d
 std 3,x restore buffer size
 std 9,x reset available space counter
 puls a,b,y,pc return

fob2 leas 4,s remove (a), (b), and saved (d)
 orcc #1 set carry, error encountered
 puls y,pc return, cs
 spc 4
**   getchr - get next character from terminal.
*
*    entry "trmin"=i/o block address for terminal input
*
*    exit  cc if no error, and
*          vc if not end of file, and
*          (a)=character
*
*          Message sent through device "ERROUT" if error detected.
 spc 2
getchr pshs x save (x)
 leax trmin,u (x)=i/o block address
 jsr gnc get character
 bes getch1 if error detected
 puls x,pc return

getch1 messag ERROUT,getca "Input error"
 jmp abort

getca msg "Input Error",CRGRET
 spc 4
**   gnc - get next character.
*
*    entry (x)=i/o block pointer.
*
*    exit  cs if error detected, and
*          (d)=error response
*
*          cc if no error, and
*          vs if end of file
*
*          cc, vc if no end of file, and
*          (a)=character
*
*    All registers not returning a response are preserved.
 spc 2
gnc pshs b,y
 ldd 9,x get remaining character count
 bne gnc1 if characters left in buffer
gnc0 ldd 5,x (d)=file descriptor number
 sys indx reload buffer
 bes gnc3 if error
 std 9,x save character count
 beq gnc2 if end of file
 ldd 1,x reset character pointer
 std 7,x
 ldd 9,x (d)=character count
gnc1 subd #1 count character
 std 9,x
 ldy 7,x get character
 lda 0,y+
 sty 7,x update character pointer
 clrb clear carry, overflow
 puls b,y,pc return

gnc2 orcc #2 set overflow for end of file
 puls b,y,pc return

gnc3 cmpd #EINTR check error
 beq gnc0 if interrupted call, re-issue
 orcc #1 set carry
 leas 1,s remove (b)
 puls y,pc return
 spc 4
**   llb - load line buffer.
*
*    exit  vs if end of file
 spc 2
llb ldy #lbuf preset buffer address

llb1 leax filin,u get character
 jsr gnc
 lbes llb2 if error detected
 bvs llbxit if end of file
 sta 0,y+ store character
 cmpa #CRGRET check character
 bne llb1 if not end of file
 clr 0,-y store string terminator
 sty ll,u
 ldx ln,u advance line number
 leax 1,x
 stx ln,u
llbxit rts return

llb2 jsr pem print error message
 jmp abort
 spc 4
**   onf - open next file.
*    exit  eq set if no more names
 spc 2
onf jsr ccf close current file
 ldx fp,u skip current file name
onf1 lda 0,x+
 bne onf1
 stx fp,u update pointer
 cmpx sa,u check address
 beq onfxit if end of file names
 ldy #0
 lda #open
 pshs a,x,y build function block
 leax 0,s
 sys indx
 leas 5,s
 bes onf2 if error during open
 leax filin,u
 std 5,x save descriptor
 ldd 1,x reset i/o block
 std 7,x
 clra
 clrb
 std 9,x
 std ln,u clear line number
 std oc,u clear occurrence count
 ldd #FBFSIZ
 std 3,x
onfxit rts return

onf2 pshs d
 messag OUTPUT,onfa
 puls d
 sys term

onfa msg "Error opening data file",CRGRET
 spc 4
**   pcrlf - start new line
 spc 2
pcrlf lda #CRGRET output carriage return
 jmp putchr
 spc 4
**   pem - print error message
*
*    entry (d)=UniFLEX error code
*    exit  message printed with leading and trailing
*          carriage returns.
 spc 2
pem bsr per get message address
 pshs x save message address
 jsr pcrlf start new line
 jsr pstrng print message
 jsr pcrlf terminate line
 puls x restore message address
 cmpx #fatal check address
 lbeq abort if fatal error
 rts return
 spc 4
**   per - process error response.
*    entry (d)=UniFLEX error code
*    exit  (x)=error message address
 spc 2
per leax <pera-2,pcr (x)=message address table
 lslb multiply error code by 2
 rola
 ldx d,x (x)=message address
 cmpd #peral check message number
 bls per1 if legitimate message
 ldx #nomsg "Unknown error"
per1 rts return
 spc 2
**   Error message index table.

pera fdb eio
 fdb fatal
 fdb fatal
 fdb fatal
 fdb edful
 fdb etmfl
 fdb ebadf
 fdb enofl
 fdb emsdr
 fdb eprm
 fdb eflx
 fdb ebarg
 fdb eseek
 fdb exdev
 fdb fatal
 fdb fatal
 fdb fatal
 fdb ebdev
 fdb eargc
 fdb eisdr
 fdb fatal
 fdb fatal
 fdb fatal
 fdb enchd
 fdb etmts
 fdb fatal
 fdb eintr
 fdb fatal
 fdb fatal
 fdb fatal
peral equ *-pera length of address table
 spc 2
**   Error messages.

eio fcc 'I/O error',0
edful fcc 'Disk is full',0
etmfl fcc 'Too many files are open',0
ebadf fcc 'File structure error',0
enofl fcc 'File does not exist',0
emsdr fcc 'Directory does not exist',0
eprm fcc 'Access permission fault',0
eflx fcc 'File already exists',0
ebarg fcc 'Bad argument',0
eseek fcc 'Seek error',0
exdev fcc 'Crossed devices',0
ebdev fcc 'Bad device specified',0
eargc fcc 'Too many arguments specified',0
eisdr fcc 'File is actually a directory',0
enchd fcc 'No child task exists',0
etmts fcc 'Too many tasks are active',0
eintr fcc 'Interrupted system call',0
nomsg fcc 'Unknown error',0
fatal fcc 'Unexpected error, program aborted',0
 spc 4
**   pnc - put next character.
*
*    entry (a)=character
*          (x)=i/o block pointer
*
*    exit  cc if no error, and
*          (a)=character
*          cs if error, and
*          (d)=error code
 spc 2
pnc pshs a,b,y
 ldd 9,x get remaining room count
 bne pnc1 if room left in buffer
 ldd 5,x get file descriptor number
 sys indx dump buffer
 bec pnc0 if no error
 cmpd #EINTR check error
 bne pnc3 if not interrupted call
pnc0 ldd 1,x update character pointer
 std 7,x
 ldd 3,x (d)=new remaining size
pnc1 subd #1 count character
 std 9,x update remaining count
 ldy 7,x store character
 puls a
 sta 0,y+
 sty 7,x update character address
pnc2 puls b,y,pc return

pnc3 leas 2,s remove character and (b)
 orcc #1 set carry, error detected
 puls y,pc return, cs, (d)=error code
 spc 4
**   poc - print occurrence count.
 spc 2
poc ldx #poca preset "No"
 ldd oc,u get count
 beq poc1 if none found
 ldx #nbuf
 jsr decstn convert string
 clr d,x terminate string
 ldx #nbuf
poc1 jsr pstrng print string
 ldx #pocb "occurrence"
 jsr pstrng
 ldd oc,u
 cmpd #1
 bls poc2 if 0 or 1 occurrence
 lda #'s form plural
 jsr putchr
poc2 ldx #pocc "found in file "
 jsr pstrng
 ldx fp,u print file name
 jsr pstrng
 jsr pcrlf terminate line
 jsr pcrlf skip a line
 rts return

poca fcc "No",0
pocb fcc " occurrence",0
pocc fcc " found in file ",0
 spc 4
**   prs - preset
*
*     entry (y)=address of arguments
*     exit  (sa)=address of string
*           (fp)=address of program name
 spc 2
prs
 ldd 0,y get argument count
 cmpd #2
 bls prsisf if insufficient arguments
 lslb multiply count by 2
 rola
 ldd d,y get address of string
 std sa,u
 ldd 2,y preset file point to program name
 std fp,u

*    Initialize buffered i/o blocks.

 leax trmin,u (x)=block address
 lda #read
 sta 0,x store i/o function code
 ldy #ibuf
 sty 1,x store buffer fwa
 sty 7,x store first character address
 ldd #INPUT
 std 5,x store descriptor
 ldd #BUFSIZ
 std 3,x store buffer size
 clr 9,x clear character count
 clr 10,x

 leax trmout,u (x)=block address
 ldd #OUTPUT
 std 5,x store descriptor
 lda #write
 sta 0,x store i/o function code
 ldy #obuf
 sty 1,x store buffer fwa
 sty 7,x store first character address
 ldd #BUFSIZ
 std 3,x store buffer size
 std 9,x set available space count

 leax filin,u (x)=block address
 lda #read
 sta 0,x store i/o function code
 ldy #sbuf
 sty 1,x store buffer fwa
 sty 7,x store first character address
 ldd #INPUT
 std 5,x store descriptor
 ldd #FBFSIZ
 std 3,x store buffer size
 clr 9,x clear character count
 clr 10,x
 rts return

prsisf messag ERROUT,prsa
 jmp abort abort program

prsa msg "Insufficient arguments",CRGRET
 spc 4
**   pstrng - print string
*    entry (x)=address of string
 spc 2
pstrn1 jsr putchr output character

pstrng lda 0,x+ get character
 bne pstrn1 if not end of string
 rts return
 spc 4
**   putchr - send character to terminal.
*
*    entry (a)=character
*          "trmout"=i/o block for terminal
*
*    exit  message sent through "ERROUT" if
*          error detected.
 spc 2
putchr pshs x save (x)
 leax trmout,u (x)=i/o block address
 jsr pnc put character
 bes putch2 if error
 cmpa #CRGRET check character
 bne putch1 if not end of line
 jsr fob flush output buffer
putch1 puls x,pc return

putch2 messag ERROUT,putca "Output error"
 jmp abort

putca msg "Output Error",CRGRET
 spc 4
**   sfo - search for occurrence.
 spc 2
sfo ldx #lbuf

sfo1 cmpx ll,u check address
 beq sfoxit if end of string

sfo2 ldy sa,u (y)=string address
 stx ra,u save restart address
sfo4 lda 0,y+ get string character
 beq sfofnd if end of string, match
 cmpa 0,x+ check character
 bne sfo6 if no match
 cmpx ll,u check address
 blo sfo4 if not at end of line
 lda 0,y check next string character
 beq sfofnd if end of string
sfo6 ldx ra,u set restart address
 leax 1,x
 bra sfo1

sfoxit rts return

sfofnd ldx oc,u count occurrence
 leax 1,x
 stx oc,u
 ldx fp,u print file name
 jsr pstrng
 ldx #nbuf print line number
 ldd ln,u
 jsr decst
 clr d,x
 ldx #nbuf
 jsr pstrng
 lda #'= print "="
 jsr putchr
 ldx #lbuf print line
 jsr pstrng
 jmp pcrlf terminate line, return
 sttl Buffers
 pag
**   Buffers.
 spc 2
ibuf rmb BUFSIZ keyboard input buffer
obuf rmb BUFSIZ display output buffer
sbuf rmb FBFSIZ file buffer
nbuf rmb 10 number conversion buffer
lbuf rmb 0 line buffer

 end find