QSTRING

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=