qstring start 0
*
* IBM assembler program to scan a file looking for a character string.
* Scan a file for the string in the parm field.
* does trt to find a char in the file that matches the first char
* in the parm field.
* then does clc to see if the rest is a match.
* if the first char of the parm field is blank, it abends,
* because it would run really slowly.
* if there is no parm field, it abends.
*
* coded by Lin Lyons (linlyons @ yahoo, 925-299-1117)
* during my spare time on monday, 2/28/14
* needs jcl to assemble and linkedit and a library to put it in.
*
* one slightly interesting problem is to find the string at the end
* of a record, but not do the CLC past the end of the record.
* I think I have it right, but testing would be good.
*
* When I originally wrote it, I scanned for multiple strings
* at the same time, but doing that, and allowing for strings of
* different lengths, and not going over the end of a record,
* is considerably more complicated. One could also only look
* at selected parts of a record - again, more complicated.
* One could replace a string - still more complicated.
* This is what you get for free. :)
*
* I COULD WRITE A SCAN AND REPLACE. THAT'D BE INTERESTING.
* YOU USE PUT LOCATE, AND MOVE SECTIONS OF THE RECORD.
* Not all that difficult, but does require more thinking.
* And heaven forbid that I engage in real thinking.
* Wait and see if there's any interest.
*
* One might keep in mind that it's been 15 years since I did
* any coding at all. Everything here is completely from memory.
* If it works, that ain't bad. ;)
*
using *,12
stm 14,12,12(13)
la 12,0(15)
la 14,savearea
st 13,4(14)
st 14,8(13)
lr 13,14
*
lh reg3,0(reg1) get parm length + address
ltr reg3,reg3
bz noparm
cli 2(reg1),c' ' first char cannot be space
be abend2
bctr reg3,0
la reg9,0(reg1)
*
sr reg14,reg14 set up trt table to scan for
ic reg14,2(reg9) the first char of parm
la reg14,table(reg14)
mvi 0(reg14),1
LA REG8,12 SET "STRING NOT FOUND" RET-CODE.
*
open (sysut1)
open (sysut2,output)
b get
*
put put SYSUT2,(reg6) write rec if we find string
SR reg8,reg8 indicate that we found at least 1 record
*
* btw, if you're working on this, you can't
* use reg-2 because trt changes it.
get get sysut1
la reg6,0(reg1)
lr reg4,reg6
lh reg5,dcblrecl-ihadcb+sysut1
bctr reg5,0
la reg0,0(reg6,reg5) point to end of rec
bctr reg0,0
*
LOOP lr reg15,reg0 point to end of record
SR reg15,reg4 subtract start addr = length
sr reg15,reg3 subt length of parm to not over-run
Bm GET not enough space for parm, get next.
ch reg15,=h'256' q. real long rec?
bl look4ch no, go do compare.
la reg15,255 yes, only test 256 bytes at a time.
*
look4ch ex reg15,trt find first parm char in record
bnz clcstr when found, go compare entire parm
la reg4,256(reg4) if rec is long, point to next part
cr reg4,reg0 q. past end of rec?
bnl get yes, go get next rec
b loop no, test next section.
*
clcstr ex reg3,clc compare parm to record data
be put found, go write the record
la reg4,1(reg1) no, point past 1st char
b loop and go test next section.
*
SUT1EOD CLOSE (SYSUT1,,SYSUT2)
l 13,4(13)
l 14,12(13)
lr 15,reg8
lm 0,12,20(13)
br 14
*
noparm wto 'no parm specified'
abend 1
abend2 wto 'first parm char cannot be space'
abend 2
*
trt trt 0(0,reg4),table
clc clc 0(0,reg4),2(reg9)
savearea dc 18f'0'
table dc xl256'00'
*
exlst dc 0f'0',x'87',al3(openexit)
openexit DS 0F
using *,15
cli dcbrecfm-ihadcb+sysut2,0
bne *+22
mvc dcbrecfm-ihadcb+sysut2,dcbrecfm-ihadcb+sysut1
mvc dcblrecl-ihadcb+sysut2,dcblrecl-ihadcb+sysut1
mvc dcbblksi-ihadcb+sysut2,dcbblisi-ihadcb+sysut1
sr 15,15
br 14
SYSUT1 DCB DDNAME=SYSUT1,DEVD=DA,DSORG=PS,MACRF=GL,EODAD=SUT1EOD
SYSUT2 DCB DDNAME=SYSUT2,DEVD=DA,DSORG=PS,MACRF=PM,EXLST=EXLST
*
DCBD DSORG=PS,DEVD=DA
END
//*
//TEST1 EXEC PGM=QSTRING,PARM=ABC
//STEPLIB DD DISP=SHR,DSN=
//SYSUT2 DD SYSOUT=*
//SYSUT1 DD *
ABC
ABC
NOT THERE
ABC
ABC
ABC
/*
//*
//TEST2 EXEC PGM=QSTRING,PARM=ABCD
//STEPLIB DD DISP=SHR,DSN=
//SYSUT2 DD SYSOUT=*
//SYSUT1 DD *
ABC
ABC
NOT THERE
ABC
ABC
ABC
/*
//*
//TEST3 EXEC PGM=QSTRING
//STEPLIB DD DISP=SHR,DSN=
//*
//TEST4 EXEC PGM=QSTRING,PARM=' ABD',COND=EVEN
//STEPLIB DD DISP=SHR,DSN=