A
ENTRY NEWFIND
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWFIND
NOTES:
1) NOTE ABOUT FILE NAMES. GENERALLY IN THE UTILITIES IN IBM LAND,
SYSPRINT = THE REPORT FILE
SYSUT1 = THE INPUT FILE
SYSUT2 = THE OUTPUT FILE
SYSIN = CONTROL CARD FILE.
THOSE NAMES CAME FROM THE ORIGINAL 360 SYSTEMS, WHEN IBM WAS
STILL WRITING THE 360 OS SOFWARE. BEFORE THAT WAS DONE, IN ORDER
TO USE THE 360 HARDWARE, THE ITILITIES WERE STAND-ALONE PROGRAMS,
(IE EACH CONTAINED A MINIMAL OPERATING SYSTEM WITHIN THE CODE).
THE 2 THAT I LOOKED AT ARE NOW CALLED IEBGENER AND IEHMOVE, AND
BURIED IN THE CODE WERE REFERENCES TO SYSGENER AND SYSMOVE.
GENER WAS COMPLETELY REWRITTEN 40 SOME YEARS AGO, SO THOSE
REFERENDCES ARE LIKELY GONE. LAST I LOOKED, IEHMOVE WAS STILL
SORT OF ORIGINAL. WHEN YOU LOOK AT WHAT IT DOES, SOME OF THE
FUNCTIONS WERE USEFUL BEFORE THERE WAS A WORKING OPERATING SYSTEM,
SO THE FUNCTIONS AND CONTROL CARDS ARE (OR WERE) A TAD HOKEY.
MIND YOU, IT'S BEEN MORE THAN 30 YEARS SINCE I HAD ACCESS TO THE
ORIGINAL IBM CODE. BUT TO USE GENER OR MOVE, YOU'D IPL (BOOT)
THE SYSGENER OR SYSMOVE OPERATING SYSTEM.
2) I LIKE TO CODE. A LOT. IT'S LIKE DOING PUZZLES, AND YOU GET PAID.
WHAT'S NOT TO LIKE? BUT MY ABILITY TO CODE HAS DECLINED
DRAMATICALLY LATELY. I MAKE WAY TOO MANY MISTAKES, BOTH TYPING
MISTAKES, AND ALSO LOGIC MISTAKES. I STARTED IN '68 AT
COLLEGE OF SAN MATEO NIGHT SCHOOL, AND NEVER LOOKED BACK.
MY FIRST CLASSES WERE FORTRAN AND 1401 SPS (ASSEMBLY LANGUAGE).
I LIKED BOTH. THERE WERE 2 1401 ASSEMBLERS, AUTOCODER AND
SPS (SYMBOLIC PROGRAMMING SYSTEM). RIGHT THEN, I LEARNED TO
TOUCH TYPE ON A KEYPUNCH.
--ASSEMBLE, LINK, AND GO -----------------------
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWFIND
SET SYSUT1=C:\USERS\LIN\DOCUMENTS\BUSHSTUFF.TXT
SET SYSUT2=%G%.OUT.TXT
SET SYSIN=%G%.SYSIN.TXT
BAT\ASMLG %G%.MLC TIME(1)
BAT\EZ390 %G%.MLC TEST
--CREATE FILE OF BREAK POINT COMMANDS. --------------
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWFIND
SET LISTING=%G%.PRN
SET SYSPRINT=%G%.BREAK.SYSPRINT.TXT
SET BREAK=%G%.BREAK.BREAK.TXT
SET SYSIN=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK.MLC
--//SYSIN INPUT TO CREATE BREAKPOINT COMMANDS. ------------
LOADLOC=FF000 13R%
LABEL=PRINTR2,ERR*,MSG*,Z,ZS,GETMAIN,TRY*,SET*,SAV*,QFREQ,QS1*,QS9*
LABEL=TES*,EDIT0*,GETIN,WRITOUT,
-----------------------------------------------------------
.START ANOP
* -----------------------------------------------------------
MACRO
&LABEL REVB &COND,&TO
LCLC &C,&B
LCLA &LEN
AIF ('&COND' NE 'B').ADDREM
&LABEL NOP &TO
MEXIT
.ADDREM ANOP
&LEN SETA K'&COND
AIF ('&COND'(2,1) NE 'N').ADD
&B SETC '&COND'(3,&LEN-2)
AGO .DOIT
.ADD ANOP
&B SETC '&COND'(2,&LEN-1)
&B SETC 'N&B'
.DOIT ANOP
&LABEL B&B &TO
MEND
* -----------------------------------------------------------
*
MACRO
QABEND &BC,&TEXT
GBLA &ABE#
LCLA &N
LCLC &L
&ABE# SETA 1+&ABE#
&N SETA &SYSNDX
&L SETC 'SYS&N'
REVB &BC,&L.Z
BAL R1,ABEND
DC AL1(&ABE#,L'&L.M-1)
&L.M DC C&TEXT
&L.Z DS 0H
MEND
*
NEWFIND START 0
YREGS
USING *,13
*
B BEGIN-NEWFIND(15)
DC 17F'0'
DC C'NEWFIND ASM &SYSDATE &SYSTIME'
BEGIN STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R6,0(R1)
LH R14,0(R6)
LA R14,1(R14)
MVC PARM(0),0(R6)
EX R14,*-6
*
*SAYI SAYINIT REGS=(7,8),CSECT=NEWFIND
*
OPEN LA R2,SYSPRINT
BAL R9,OPENOUT
LA R2,SYSUT1
BAL R9,OPENIN
LA R2,SYSUT2
BAL R9,OPENOUT
CLI 1(R6),0
BE TSTSYSIN
LA R2,SYSIN
BAL R9,OPENIN
B TSTSYSIN
*
OPENOUT MVC DCBLINE(8),DCBDDNAM-IHADCB(R2)
CLI DCBRECFM-IHADCB(R2),0
BNE *+16
MVC DCBRECFM-IHADCB+SYSUT2,DCBRECFM-IHADCB+SYSUT1
MVC DCBLRECL-IHADCB+SYSUT2,DCBLRECL-IHADCB+SYSUT1
*
PUSH PRINT
PRINT NOGEN
OPEN ((2),OUTPUT)
MVC DCBLINE+16(3),=C'OUT'
CLC =C'SYSPRINT',DCBLINE
BNE NOTSYSP
MVC LINE(L'IDLINE),IDLINE
PUT SYSPRINT,LINE-1
B NOTSYSP
OPENIN MVC DCBLINE(8),DCBDDNAM-IHADCB(R2)
OPEN ((2),INPUT)
POP PRINT
MVC DCBLINE+16(3),=C' IN'
NOTSYSP UNPK DCBLINE+30(3),DCBRECFM-IHADCB(2,R2)
TR DCBLINE+30(2),HEX-240
MVI DCBLINE+32,C' '
LH R0,DCBLRECL-IHADCB(R2)
CVD R0,12(R13)
OI 19(R13),X'0F'
MVC LINE(L'DCBLINE),DCBLINE
UNPK LINE+L'DCBLINE(5),17(3,R13)
PUT SYSPRINT,LINE-1
BR R9
DCBLINE DC C'........ OPENED OUTPUT, RECFM=.. LRECL='
IDLINE DC C'NEWFIND, ASM &SYSDATE, &SYSTIME'
*
TSTSYSIN DS 0H
* SAY 'TSTSYSIN'
BAL R9,QPARM
BAL R9,QFREQ
BAL R9,SORT
BAL R9,SETUPTRT
BAL R9,FIXUPTRT
B GET
* ------------------------------------
ARECORD DC F'0'
PUT L R0,ARECORD
PUT SYSUT2,(0)
* SAY 'PAST PUT'
AP #OUT,P1
*
GET GET SYSUT1
AP #IN,P1
LA R3,0(R1)
ST R3,ARECORD
* SAY 'PAST GET'
LH R4,DCBLRECL-IHADCB+SYSUT1
AR R4,R3 R4=END OF RECOD
B TRTLOOP
* ----------------------------------------------
* THIS IS THE BUSINESS END OF THE OPERATION.
* TRT TO FIND A VALID CHAR FROM ONE OF THE STRINGS
* WHEN WE FIND ONE, GO TO THE NEXT SECTION TO
* CLC THE STRING. FOUND=PUT NOT FOUND=TRY NEXT STRING
* IF THE SEARCH CHAR IS THE SAME. IF NOT THE SAME,
* GO DO ANOTHER TRT. NOT FOUND = GO READ NEXT RECORD.
* ----------------------------------------------
TRTLOOP LA R15,256 MAX TRT LENG
SR R5,R5 (NO MORE REC TO TEST)
LR R2,R4 END OF REC
SR R2,R3 MINUS BEG
CR R2,R15 Q. OVER MAX
BL *+10 NO
LR R2,R15 YES, USE MAX
LA R5,0(R3,R2) POINT TO NEXT LOC
*
SH R2,=H'1' LENG-1
BM GET 0, GO GET NEXT
AP #TRT,P1
EX R2,TRT TRT TO FIND STRING CHAR
BNZ COMPARE
LTR R3,R5
BZ GET
B TRTLOOP
TRT TRT 0(0,R3),TRTTBL
* -----------------------------------------
USING DSECT,8
TRTCLC CLC STRING(0),0(R6)
COMPARE LA R3,1(R1)
SLL R2,2
L R8,LIST-4(R2)
*
RECOMPAR LR R6,R1
AH R6,ZLEN
CR R6,R4
BH QNEXT
LR R6,R1
SH R6,ALEN
C R6,ARECORD
BL QNEXT CANNOT COMPARE PRIOT TO BEG OF RECORR
*
AP #CLC,P1
EX R14,TRTCLC
BNE QNEXT
AP #FOUND,P1
B PUT
QNEXT CLC CHAR,CHAR+LLIST
BNE TRTLOOP
LA R8,LLIST(R8)
B RECOMPAR
DROP 8
* ---------------------------------------
*
ED15 DC X'402020206B2020206B2020206B2020206B202120'
Z LA R2,#IN
EDLOOP MVC LINE,LINE-1
MVC LINE(16),8(R2)
LA R1,LINE+16+L'ED15-2
MVC LINE+16(L'ED15),ED15
EDMK LINE+16(L'ED15),0(R2)
MVC LINE+16(L'ED15),0(R1)
PUT SYSPRINT,LINE
LA R2,24(R2)
CLI 0(R2),00
BE EDLOOP
*
LA R7,TRTLIST
USING DSECT,7
ED#FND L R1,LEN
MVC LINE,LINE-1
MVC LINE(0),STRING
EX R1,*-6
LA R3,LINE+2(R1)
MVC 0(7,R3),=C'FOUND '
MVC LINE+9(L'ED15),ED15
LA R1,LINE+8+L'ED15
EDMK LINE+9(L'ED15),#FOUND
MVC LINE+10(L'ED15+L'ED15),0(R1)
PUT SYSPRINT,LINE-1
LA R7,LLIST(R7)
CLI 0(R7),X'FF'
BNE ED#FND
*
CLOSE (SYSUT1,,SYSUT2,,SYSPRINT)
* SAY 'CLOSED'
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
LTORG
P0 DC X'0C'
P1 DC X'1C'
#IN DC PL8'0',CL16'RECORDS READ'
#OUT DC PL8'0',CL16'RECORDS WRITTEN'
#TRT DC PL8'0',CL16'TRT INSTS USED'
#CLC DC PL8'0',CL16'CLC INSTS USED'
DC X'FF'
HEX DC C'0123456789ABCDEF'
DW DC 2D'0' '
ZEROS DC XL64'00'
DC H'64,0',C' '
LINE DC CL133' '
SPACES DC CL64' '
ISITHEX EQU *-191
DC 6X'00',41C' ',10X'00',6C' '
PARMWTO DC H'68,0',C'PARM= '
PARM DC CL131' '
PUSH PRINT
PRINT NOGEN
SYSIN DCB DDNAME=SYSIN,DSORG=PS,MACRF=GM,RECFM=FT,LRECL=80,EODAD=Y
SYSUT1 DCB DDNAME=SYSUT1,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=133,EODAD=Z
SYSUT2 DCB DDNAME=SYSUT2,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133
POP PRINT
*
SORT LM R7,R8,LIST-8 LAST, FIRST
SORTCLC CLC 0(LLIST,R8),LLIST(R8)
BL SORTBUMP
MVC 12(LLIST,R13),0(R8)
MVC 0(LLIST,R8),LLIST(R8)
MVC LLIST(LLIST,R8),12(R13)
SORTBUMP LA R8,LLIST(R8)
CR R8,R7
BL SORTCLC
S R7,=A(LLIST)
L R8,LIST-4
CR R8,R7
BL SORTCLC
BR R9
* -------------------------------
SETUPTRT LM R7,R8,LIST-8
LA R1,4
SR R2,R2
LA R3,TRTLIST
*
USING DSECT,R8
SETUPIC IC R2,CHAR
LA R3,TRTTBL(R2)
ST R1,0(R3)
ST R8,TRTLIST
CLCCHAR CLC CHAR,LLIST+CHAR
BE DUPCHAR
LA R3,4(R3)
LA R1,4(R1)
LA R8,LLIST(R8)
CR R8,R7
BL SETUPIC
BR R9
DUPCHAR LA R8,LLIST(R8)
CR R8,R7
MVI 0(R8),X'FF'
BNLR R9
B CLCCHAR
* -------------------------------
FIXUPTRT LM R7,R8,LIST-8
FIXUPT LH R1,LEN
SH R1,ALEN
SH R1,=H'2'
STH R1,ZLEN
LA R7,LLIST(R7)
CR R7,R8
BL FIXUPT
BR R9
* -------------------------------
TRTLIST DS 0F
QFREQ LM R7,R8,LIST-8 R8=START OF LIST, R7=END OF LIST
USING DSECT,R8
QFREQTOP MVI CHARFREQ,255 DEFAULT FREQ
LA R15,STRING
AH R15,XLEN POINT TO END OF STRING
LA R0,STRING POINT TO BEG OF STRING
SR R1,R1
LH R2,LEN # OF TIMES TO LOOP
LA R3,STRING STRING
*
FREQLOOP IC R1,0(R3)
LA R4,FREQTBL(R1)
CLC 0(1,R4),CHARFREQ
BNL NOTLOW
*
MVC CHARFREQ,0(R4)
MVC CHAR,0(R3)
LR R5,R3
SR R5,R0
STH R5,ALEN
*
LR R6,R15
SR R6,R3
STH R6,ZLEN
NOTLOW LA R3,1(R3)
BCT R2,FREQLOOP
LA R8,LLIST(R8)
CR R8,R7
BL QFREQTOP
BR R9
* ---------------------------------------------------
* SEARCH ARG CAN BE SPECIFIED EITHER IN THE PARM, OR IN SYSIN.
* IN THE PARM, ONLY CHAR STRINGS CAN BE SPECIFIED.
* IN SYSIN, EITHER CHARACTER OR HEX STRINGS CAN BE SPECIFIED.
* IF THERE IS NO PARM, THEN USE SYSIN.
* FOR PARM, THE FIRST CHAR LOWER THAN X'80',
* TYPICALLY ',' WILL BE THE DELIMITER.
* BUT YOU CAN USE WHATEVER YOU LIKE.
* AND IF THERE'S ONLY 1 SEARCH ARG, THAT DOESN'T MATTER
* YOU CANNOT MIX BOTH PARM AND SYSIN INPUT.
* ---------------------------------------------------
DC F'0'
QPARM ST R9,QPARM-4 Q. SYSIN
L R8,LIST-4
CLI 1(R6),0 Q. SYSIN
BE PARMGET YES, GO READ
*
PUT SYSPRINT,PARM+2
LH R5,0(R6) NO, LOAD PARMLENGTH
CLI PARM+1,3
QABEND BL,'PARM LENGTH LESS THAN 2'
MVC PARM,PARM+2
LA R5,PARM(R5)
LA R2,PARM AND THE BEGINNING
QPBEGIN MVC LINE,LINE-1
LR R14,R5
SR R14,R2
MVC LINE(0),0(R2)
EX R14,*-6
PUT SYSPRINT,LINE-1
WTO MF=(E,LINE-5)
MVC LINE,LINE-1
LR R14,R2 SAVE BEGIN ADDR
*
QPLOOP LA R2,1(R2)
CR R2,R5 Q. END?
BNL QPEND YES, END DELIM FOUND
CLI DELIM+1,X'FE' Q. HAVE WE FOUND "," YET?
BE QPQCOMMA NO, GO CO THAT
DELIM CLI 0(R2),X'FE'
BNE QPLOOP
B QPEND
*
QPMVC MVC STRING(0),0(R14)
*
QPQCOMMA CLI 0(R2),X'80'
BH QPLOOP
MVC DELIM+1(1),0(R2) SAVE DELIM AND DROP THRU TO FOUND
MVC LINE(1),0(R2)
MVC LINE+1(17),=C' IS THE DELIMITER'
PUT SYSPRINT,LINE-1
WTO MF=(E,LINE-5)
MVC LINE,LINE-1
*
QPEND LA R2,0(R2)
LR R15,R2
SR R15,R14 ABC,
STH R15,LEN
BCTR R15,0
STH R15,XLEN
LTR R15,R15
QABEND BNP,'STRING LENGTH 0 OR SHORT'
EX R15,QPMVC
LA R8,LLIST(R8)
ST R8,LIST-4
C R15,=A(L'STRING-3)
QABEND BNL,'STRING LENGTH TOO LONG'
LA R2,1(R2)
CR R2,R3
BL QPBEGIN
BR R9
* ------------------------------------
* SYSIN IS HARDER THAN PARM, BECAUSE WE CAN HAVE C'ABC' OR X'ABCD'
* ------------------------------------
PARMGET GET SYSIN,PARM
CLI PARM,C' '
BE PARMGET
*
NEXTSTR SR R4,R4
L R7,LIST-8
LA R0,LLIST(R7)
ST R0,LIST-8
*
LA R2,PARM+2
LOOK4QUO LA R2,1(R2)
CLC 0(8,R2),SPACES
QABEND BE,'ENDING DELIM NOT FOUND'
CLC PARM+1(1),0(R2)
BNE LOOK4QUO
LA R4,1(R1) POINT TO THE COMMA OR BLANK
*
LR R3,R2 C'ABC' LENGTH=5
S R3,=A(PARM+2) C'ABC' DATA LENGTH=3
CLI PARM,C'X'
BNE NOTHEX
LA R0,1
OR R0,R3
QABEND BNZ,'ODD # CHARS FOR HEX STRING'
SRL R3,1
*
NOTHEX STH R3,LEN
BCTR R3,0
STH R3,LEN
BCTR R3,0
STH R3,XLEN
LTR R3,R3
QABEND BNP,'STRING LENGTH SHORT'
CLI PARM,C'C'
BE PARMCHAR
CLI PARM,C'X'
BE PARMHEX
QABEND B,'PARM CAN BE EG C''STRING'' OR X"E2E3D9C9D5C9" '
*
MVC STRING,PARM+2
PARMCHAR EX R3,PARMCHAR-6
PARMNEXT ZAP #FOUND,P0
LTR R4,R4
BZ PARMGET
CLI 0(R4),C','
QABEND BNE,'COMMA MISSING AFTER "STRING",'
MVC PARM,1(R4)
B NEXTSTR
*
MAKITHEX EQU *-191
DC X'0A0B0C0D0E0F',CL41' ',X'00010203040506070809'
*
TR PARM+2(0),MAKITHEX
TRT PARM+2(0),ISITHEX
PARMHEX EX R3,PARMHEX-6 CHECK TO SEE IF IT'S GOOD HEX
QABEND BNZ,'INVALID HEX CHAR' NOPE, ABEND
EX R3,PARMHEX-12
*
LH R14,LEN
BCTR R14,0
STH R14,LEN
LH R15,XLEN
BCTR R15,0
STH R15,XLEN
*
L R0,LEN
LA R14,PARM+2
LA R15,STRING
PACKHEX PACK 0(2,R15),0(3,R14)
LA R15,1(R15)
LA R14,2(R14)
BCT R0,PACKHEX
MVI 0(R15),0
B PARMNEXT
*
Y CLOSE SYSIN
L R9,QPARM-4
BR R9
*
* DC AL1(1,L'M1-1)
* M1 DC C'BAD PARM/SYSIN, DELIM'
ABEND MVC ABENDMSG+20(99),ABENDMSG+19
LA R0,0(R1)
SR R0,R13
STH R0,12(R13)
UNPK 20(5,R13),12(3,R13)
TR 20(4,R13),HEX-240
MVC ABENDMSG+11(4),20(R13)
SR R2,R2
IC R2,1(R1)
MVC ABENDMSG+18(0),2(R1)
EX R2,*-6
LA R0,25(R2)
STH R0,ABENDMSG-5
IC R2,0(R1)
STC R2,ABENDMSG+07
TR ABENDMSG+07(1),HEX
MVC LINE(L'ABENDMSG),ABENDMSG
PUT SYSPRINT,LINE
WTO MF=(E,ABENDMSG-5 '
ABEND (2)
DC AL2(L'ABENDMSG+4,0),C' '
ABENDMSG DC CL20'ERROR "?" (....) '
*
DC F'0'
TRTTBL DS 0F
FREQTBL DC X'222120',253X'02' ---- FROM WIKIPEDIA ----
ORG FREQTBL+X'81'
DC AL1(82,15,28,43,97,22,20,61,70)
ORG FREQTBL+X'91'
DC AL1(02,07,40,24,67,75,19,01,60)
ORG FREQTBL+X'A2'
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+C'A'
DC AL1(82,15,28,43,97,22,20,61,70)
ORG FREQTBL+C'J'
DC AL1(02,07,40,24,67,75,19,01,60)
ORG FREQTBL+C'S'
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+C'0'
DC AL1(89,88,87,86,85,84,83,82,81,80)
ORG FREQTBL+C' '
DC AL1(99)
ORG FREQTBL+C'.'
DC AL1(9)
ORG FREQTBL+C','
DC AL1(9)
ORG FREQTBL+C'/'
DC AL1(9)
*
ORG FREQTBL+X'20' ------ ASCII CHARACTERS -----
DC AL1(98)
ORG FREQTBL+X'30'
DC AL1(89,88,87,86,85,84,83,82,81,80)
ORG FREQTBL+X'40'
DC AL1(82,15,28,43,97,22,20,61,70)
DC AL1(02,07,40,24,67,75,19,01,60)
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+X'60'
DC AL1(82,15,28,43,97,22,20,61,70)
DC AL1(02,07,40,24,67,75,19,01,60)
DC AL1(63,91,28,10,24,01,20,01)
ORG
LTORG
*
DC A(LIST,LIST)
LIST EQU *
*
@@PAD#0 EQU *-NEWFIND+4095
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG NEWFIND+@@PAD#2
*
DSECT DSECT 0
CHAR DS C
STRING DS CL35
LEN DS H
XLEN DS H
ALEN DS H
ZLEN DS H
CHAR# DS C
CHARFREQ DS X
TRT# DS X
DS C
#FOUND DS PL8
LLIST EQU *-DSECT
*
* DCBD DEVD=DA
*
END NEWFIND
A