I've cleaned it up a bit, but this was one of the first programs I wrote when I realized that the SPFlite editor was available and very similar to the ISPF editor I'd been using for decades. In addition, Z390 is a simulator that allows me to run IBM mainframe assembler on my PC. I've been writing assembler forever, and like it.
JUSTSCAN is a really basic, copy records that contain the string in the PARM field. It is nice in that it runs through the PARM field and selects the character that probably occurs least often in the input file, and only does a compare when it finds that character.
At the bank, 50 years ago, I wrote something similar for my boss, but I searched for the first character of the string (maybe his name) in a 20 reel tape file. I expect that most every systems programmer has written something similar. It's just too easy not to do. In any case, all the stuff at the start is used to run the program on the Z390 simulator. We AGO past that and start with an ERRMSG macro to tell the user he needs to code a PARM field. When searching for "DCB", the report looks like:
JUSTSCAN ASM 10/01/26 21.28, RUN THU 21:31
OPEN SYSPRINT OUTPUT, RECFM=A0, LRECL=00121
OPEN IN INPUT, RECFM=A0, LRECL=00266
OPEN OUT OUTPUT, RECFM=A0, LRECL=00266
C 001 001 002 DCB (SCAN CHAR, # CHARS BEFORE, AFTER, PARM LEN-1, PARM)
0000566 RECORDS READ
0000085 RECORDS COPIED
AGO .START PROFILE OPTIONS WTOR ROUTCDE 11
C:\USERS\LIN\DOCUMENTS\Z390CODE\JUSTSCAN
JUSTSCAN ASM
s ff230.!=C'DCB' (=,!=,<,<=,>,>=)
JUSTSCAN ASM
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\JUSTSCAN
SET SYSPRINT=%G%.SYSPRINT.TXT
SET IN=%G%.PRN
SET OUT=%G%.OUT
SET BREAK=%G%.BREAK.BREAK.TXT
BAT\ASMLG %G%.MLC TIME(2)
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\MUYSCAN
SET LISTING=%G%.PRN
SET SYSIN=%G%.BREAK.SYSIN.TXT
SET BREAK=%G%.BREAK.BREAK.TXT
SET SYSPRINT=%G%.BREAK.SYSPRINT.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
` JUSTSCANB QBREAK
LOADLOC=FF000 BREAK POINTS
LABEL=Z,ZZ
.START ANOP
*DCB
* DCB <== THESE ARE FOR THE TEST RUN TO FIND
* DCB
* DCB
*
*
MACRO
ERRMSG &MSG
LCLA &L
&L SETA K'&MSG-2
MVC LINE+2(&L),=C&MSG
PUT SYSPRINT,LINE-1
MEND
*
JUSTSCAN START 0 FASTER SCAN OF A FILE
USING *,13 LOOKING FOR THE STRING SPECIFIED IN
YREGS , THE PARM FIELD.
B BEGIN-*(15) BRANCH AROUND SAVE AREA
DC 17F'0'
IDMSG DC C'JUSTSCAN ASM &SYSDATE &SYSTIME, RUN ..... '
BEGIN STM 14,12,12(13) GENERAL
ST 15,8(13) START
ST 13,4(15) HOUSE KEEPING
LR 13,15 STUFF
L 8,0(1) LOAD ADDR OF PARM
BAL R9,QDAY
*
LA R2,SYSPRINT
BAL R9,OPENSYSP
LA R2,IN
BAL R9,OPENI
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
LA R2,OUT
BAL R9,OPENO
*
LH R1,0(R8)
MVC PARM-1(0),1(R8)
EX R1,*-6
CLI PARM-1,0
BNE GETFREQ
ERRMSG 'PARM (SCAN STRING) MISSING'
ABEND 1
*
GETFREQ BCTR R1,0
STH R1,PARM-2
LA R14,PREPOST
LA R15,PARM-2
BAL R9,QFREQ
BAL R9,LISTPREP
SR R1,R1
IC R1,PREPOST+4
LA R2,TRTTBL(R1)
MVC 0(0,R2),PREPOST+4
CLI PREPOST+4,0
BNE *+8
MVI 0(R2),C'F'
*
LH R6,DCBLRECL-IHADCB+IN CALC # TIMES TO COMP
LH R7,PARM-2
B GET AND GO READ
*
CLI 1(R8),0
BNE GETPARM
WTO 'PARM=SEARCH ARG MISSING'
ABEND 1
*
PUSH PRINT
PRINT NOGEN
OPENSYSP MVC DW,DCBDDNAM-IHADCB(R2)
OPEN ((2),OUTPUT)
MVC LINE(L'IDMSG),IDMSG
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
B OPENLIST
OPENMSG DC C'OPEN ........ OUTPUT, RECFM=XX, LRECL=12345 '
OPENI MVC DW,DCBDDNAM-IHADCB(R2)
OPEN ((2),INPUT)
MVC OPENMSG+14(3),=C' IN'
B OPENLIST
OPENO MVC DW,DCBDDNAM-IHADCB(R2)
OPEN ((2),OUTPUT)
MVC OPENMSG+14(3),=C'OUT'
OPENLIST MVC OPENMSG+5(8),DW
LH R0,DCBLRECL-IHADCB(R2)
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+38(5),DW+5(3)
*
UNPK OPENMSG+28(3),DCBRECFM-IHADCB(2,R2)
TR OPENMSG+28(2),HEX-240
MVI OPENMSG+30,C','
MVC LINE(L'OPENMSG),OPENMSG
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
POP PRINT
*
LISTPREP LH R14,PARM-2
LH R0,PREPOST
LH R1,PREPOST+2
LA R15,LINE+5
MVC LINE+2(1),PREPOST+4
LA R2,3
*
LISTPCVD CVD R0,DW
OI DW+7,X'0F'
UNPK 0(3,R15),DW+6(2)
LR R0,R1
LR R1,R14
LA R15,4(R15)
BCT R2,LISTPCVD
*
MVC 1(0,R15),PARM
EX R14,*-6
LA R15,3(R14,R15)
MVC 2(L'LISTPQ,R15),LISTPQ
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
LISTPQ DC C'(SCAN CHAR, # CHARS BEFORE, AFTER, PARM LEN-1, PARM)'
*
QDAY LA R2,IDMSG+L'IDMSG-9
TIME DEC
STM R0,R1,12(R13)
ZAP DW,18(2,R13)
CVB R1,DW GET JULIAN DAY OR YEAR
MVO DW,17(1,R13)
CVB R15,DW
SH R15,=H'20'
LR R0,R15 GET YEAR
SRL R0,2
MH R15,=H'365'
SH R15,=H'4'
AR R15,R0
AR R15,R1
SR R14,R14
D R14,=F'7'
SLL R14,2
LA R1,QDAYTBL(R14)
MVC 0(4,R2),0(R1)
MVC 3(6,R2),=X'4021207A2020'
ED 3(6,R2),12(R13)
MVI 9(R2),C' '
BR R9
QDAYTBL DC C'SUN MON TUE WED THU FRI SAT SUN MON THU WED THU '
*
*
DW DC D'0'
PREPOST DC 2H'0',2C' '
DC H'0'
PARM DC CL100' '
MVCPARM MVC PARM-1(0),1(R8)
*
GETPARM LH R5,0(R8)
EX R5,MVCPARM
BCTR R5,0
STH R5,PARM-2
*
LA 15,PARM-2
LA 14,PREPOST
BAL R9,QFREQ
SR 1,1
IC 1,PREPOST+4 FOR 1ST CHAR OF STRING
LA R1,TRTTBL(R1)
MVC 0(1,R1),PREPOST+4
CLI 0(R1),0
BNE *+8
MVI 0(R1),C'F'
* =============================== THIS SECTION IS THE PROGRAM ========
DC F'0'
PUT L R0,PUT-4 WRITE IF FOUND
PUT OUT,(0) WRITE IF FOUND
AP #OUT,P1 COUNT IT
GET GET IN READ
AP #IN,P1
ST R1,PUT-4 SAVE REC ADDR
LR R3,R1
LH R4,DCBLRECL-IHADCB+IN
LA R4,0(R3,R4)
*
TM DCBRECFM-IHADCB+IN,X'80' Q. RECFM=FB
BO NOTVB YES.
LH R4,0(R1) NO, LOAD LENGTH FROM REC
LA R4,0(R4,R3) POINT TO END OF REC
LA R3,4(R3)
NOTVB SH R4,PREPOST+2 BACK UP TO NOT TEST END
AH R3,PREPOST POINT PAST FRONT
* ===================== THIS IS THE BUSINESS SECTION ===============
LOOP LR R2,R4 POINT TO END OF REC
SR R2,R3 CALC LENGTH LEFT TO TEST
BM GET SHORT, GO READ NEXT
CH R2,=H'256'
BL SHORT
TRT 0(256,R3),TRTTBL
BNZ FOUND
LA R3,256(R3)
B LOOP
TRT TRT 0(0,R3),TRTTBL
CLC CLC PARM(0),0(R1) COMPARE STRING TO REC LOCATIONS
SHORT EX R2,TRT SCAN FOR FIRST CHAR OF PARM
BZ GET NOT FOUND, GO READ
FOUND LR R0,R3
LA R3,1(R1)
SH R1,PREPOST
EX R7,CLC FOUND, COMPARE
BE PUT MATCH, GO WRITE
B LOOP AND LOOP
* ================================= END OF THE PROGRAM ===============
*
FINI LA R2,#IN
LA R3,2
FINIMVC MVC LINE,LINE-1
OI 3(R2),X'0F'
UNPK LINE(7),0(4,R2)
MVC LINE+8(16),4(R2)
PUT SYSPRINT,LINE-1
LA R2,20(R2)
BCT R3,FINIMVC
CLOSE (IN,,OUT,,SYSPRINT)
BR R9
*
Z BAL R9,FINI DONE, CLOSE FILES
L 13,4(13) ---------NORMAL HOUSEKEEPING CLEAN UP
LM 14,12,12(13)
SR 15,15
BR 14 EXIT
*
LTORG
EXLST DC A(EXLST+4+X'87000000')
USING *,15
CLI DCBRECFM-IHADCB+IN,0
BNER 14
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
BR 14
DROP 15
*
PUSH PRINT
PRINT NOGEN
* ---------------------------------
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=266,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM ,EXLST=EXLST
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=121
* -------------------------------------------------
*
#IN DC PL4'0',CL16'RECORDS READ'
#OUT DC PL4'0',CL16'RECORDS COPIED'
P1 DC X'1C'
HEX DC C'0123456789ABCDEF '
LINE DC CL121' '
*
POP PRINT
TR 0(0,R3),QFREQTBL
MVC 0(0,R3),2(R15)
QFREQ STM R2,6,58(R13) 15 = STRING
LA R3,8(13) 14 = PRE-LEN, POST-LEN, CHAR
LH R1,0(R15)
EX R1,QFREQ-6 MOVE STRING TO WORK AREA (UP TO 50)
EX R1,QFREQ-12 TRAN TO FREQ VALUES
LR R0,R1 LOAD CHAR COUNT-1
LR R4,R3 POINT TO FIRST FREQ VALUE
LR R5,R3 R5 = PLACE TO SAVE LOWEST
LA R6,1(R3,R1) R6 = LAST TO CALC POST LEN (CHARS AFTER)
QFREQL CLC 0(1,R4),0(R5) Q. IS THIS THE LOWEST SO FAR?
BNL *+6 NO
LR R5,R4 YES, SAVE IT
LA R4,1(R4) BUMP TO NEXT
BCT R0,QFREQL AND LOOP
LR R1,R6 CALC LAST
SR R1,R5 - LOW LOC
BCTR R1,0
STH R1,2(R14) = POST LENG, SAVE IT
LR R0,R5 CALC LOW
SR R0,R3 - FIRST = PRE LENG
STH R0,0(R14) = PRE LENG, SAVE THAT
SR R5,R3 CALC LOC LOC - FIRST = OFFSET OF CHAR
LA R1,2(R5,R15) POINT TO LOW CHAR
MVC 4(1,R14),0(R1) AND SAVE THAT
LM R2,R6,58(R13) RELOAD REGS
BR R9 AND RETURN
*
DS 0D HTTPS://EN.WIKIPEDIA.ORG/WIKI/LETTER_FREQUENCY
QFREQTBL DC X'898887',253X'86' ASCII FIRST (WIKIOPEDIA)
ORG QFREQTBL+X'30'
DC X'59585756555453525150' NUMBERS
ORG QFREQTBL+X'40'
DC X'27161D20291A18222513141F1B242617112123281E151C121910' UPPER
ORG QFREQTBL+X'60'
DC X'47363D40493A38424533343F3B444637314143463E353C323930' LOWER
*
ORG QFREQTBL+X'C1' EBCDIC UPPER
DC X'27161D20291A182225'
ORG QFREQTBL+X'D1'
DC X'13141F1B2426171121'
ORG QFREQTBL+X'E2'
DC X'23281E151C121910'
*
ORG QFREQTBL+X'81' LOWER
DC X'47363D40493A384245'
ORG QFREQTBL+X'91'
DC X'33343F3B4446373141'
ORG QFREQTBL+X'A2'
DC X'43463E353C323930' LOWER
*
ORG QFREQTBL+X'F0'
DC X'59585756555453525150' NUMBERS
ORG
TRTTBL DC XL256'00'
* -------------------------------------------------
* @@PAD#0 EQU *-JUSTSCAN+4095
* @@PAD#1 EQU @@PAD#0/(4097)
* @@PAD#2 EQU (@@PAD#1*4096)
* ORG JUSTSCAN+@@PAD#2
*
* DCBD DEVD=DA
END JUSTSCAN