$$ CSECT 00010001 $$ AMODE 31 00020001 $$ RMODE 24 00030001 USING *,12 00040001 LR 12,15 00050001 STM 14,12,12(13) 00060001 ST 13,SAVEAREA+4 00070001 LA 15,SAVEAREA 00080001 ST 15,8(,13) 00090001 LA 13,SAVEAREA 00100001 *********************************************************************** 00110001 * Bible counting pgm - all non alpha treated as spaces 00120001 * except apostrophes which are ignored. 00130001 * input file kjv12.txt from web (vb sequential) 00140001 * output is TSO terminal 00150001 *********************************************************************** 00160001 * File is read from dd INDD into a contiguous memory area. 00170001 * A binary tree is created from contiguous sections of 00180001 * another getmained area. There are actually 26 binary trees, 00190002 * one for each letter, and each tree has a dummy node at the 00191002 * starting at the center of the alphabet (M). 00192002 * 00200001 * The main players, after the I/O is done: 00210001 * 00220001 * R2_TXTPTR : points to current working character 00230001 * R4_LEN : length of current word being scanned 00240001 * R5_TTLWORDS : total word count 00250001 * R6_CURRNODE : Node being examined within tree. 00260002 * R7_NEXTNODE : new node to be added next to tree. The 00270002 * current word is written here and if it 00280001 * is already in the tree, the node is reused. 00290001 * R8_NWORDPTR : ptr to next avail char in new node 00300002 * R9_UNQWORDS : unique word count 00310001 * R10_WORK : work register for very localized uses 00320001 * 00330001 * NWORD : link mapping to new node (via R7) 00340002 * CWORD : link mapping to current node (via R6) 00350002 * 00360001 * No cleanup (task termination does all that) 00370001 * Must be run within TSO to see the messages. 00380001 *********************************************************************** 00390001 START EQU * 00400001 TIMEUSED STORADR=STCKSTRT,CPU=MIC,LINKAGE=SYSTEM 00410001 L 0,=F'400000' 00420001 GETMAIN RU,LV=(0),LOC=31 00430001 LR R6_CURRNODE,1 00440002 USING CNODE,R6_CURRNODE 00450002 MVC 0(256,1),ROOTSTBL 00460001 MVC 0(ROOTSL-256,1),ROOTSTBL+256 00470001 LA R7_NEXTNODE,1+ROOTSL(R6_CURRNODE) 00480002 USING NNODE,R7_NEXTNODE 00490002 L 0,=F'6000000' 00500001 GETMAIN RU,LV=(0),LOC=31 00510001 ST 1,TEXTBUFF 00520001 LR R2_TXTPTR,1 00530001 LA R3_DCB,INDD 00540001 USING IHADCB,R3_DCB 00550001 OPEN ((R3_DCB),(INPUT)) 00560001 READ GET INDD 00570001 LH 4,DCBLRECL 00580001 SH 4,=H'5' 00590001 LTR 4,4 00600001 BL READ 00610001 EX 4,SAVELINE 00620001 LA 4,1(,4) 00630001 AR R2_TXTPTR,4 00640001 MVI 0(R2_TXTPTR),C' ' 00650001 LA R2_TXTPTR,1(R2_TXTPTR) 00660001 B READ 00670001 EOF EQU * 00680001 MVI 0(R2_TXTPTR),C' ' 00690001 LA R2_TXTPTR,1(R2_TXTPTR) 00700001 TIMEUSED STORADR=STCKSTRT2,CPU=MIC,LINKAGE=SYSTEM 00710001 ST R2_TXTPTR,BUFEND 00720001 CLOSE ((R3_DCB)) 00730001 L R2_TXTPTR,TEXTBUFF 00740001 BCTR R2_TXTPTR,0 00750001 XR R5_TTLWORDS,R5_TTLWORDS 00760001 XR R9_UNQWORDS,R9_UNQWORDS 00770001 XR R4_LEN,R4_LEN 00780001 LA R8_NWORDPTR,NWORD 00790002 LA R11_TABL,ADDR_TABLE 00800001 NEXTCHAR EQU * 00810001 LA R2_TXTPTR,1(R2_TXTPTR) 00820001 C R2_TXTPTR,BUFEND 00830001 BE EXIT 00840001 XR R3_BRANCH,R3_BRANCH 00850001 ICM R3_BRANCH,B'0001',0(R2_TXTPTR) 00860001 STCM R3_BRANCH,B'0001',0(R8_NWORDPTR) 00870002 SLL R3_BRANCH,2(0) MULTIPLY CHAR BY 4 00880001 L R3_BRANCH,0(R3_BRANCH,R11_TABL) 00890001 BR R3_BRANCH 00900001 SPACE EQU * 00910001 LTR R4_LEN,R4_LEN 00920001 BZ NOWORD 00930001 LA R5_TTLWORDS,1(R5_TTLWORDS) COUNT TOTAL WORDS 00940001 STH R4_LEN,NWORDLEN 00950001 ** 00960001 LR R10_WORK,R4_LEN SET WORD TO UPPER CASE 00970001 BCTR R10_WORK,0 00980001 EX R10_WORK,CASE 00990001 ** 01000001 * EX 4,MSGSAVE 01010001 * TPUT MSGWORD,(4) 01020001 XR R10_WORK,R10_WORK 01030001 ST R10_WORK,NLEFT 01040001 ST R10_WORK,NRIGHT 01050001 * XC 0(8,R7_NEXTNODE),0(R7_NEXTNODE) 01060002 IC R10_WORK,NWORD 01070001 SLL R10_WORK,2 MULT BY 4 01080001 L R6_CURRNODE,ROOTPTRS(R10_WORK) 01090002 FINDWORD LR R3_CLEN,R4_LEN CLEN=MIN(R4,CWORDLEN) 01100001 CH R4_LEN,CWORDLEN 01110001 BNH MINLEN 01120001 LH R3_CLEN,CWORDLEN 01130001 MINLEN BCTR R3_CLEN,0 SET UP FOR EXECUTE LENGTH 01140001 * 01150001 EX R3_CLEN,COMPARE COMPARE: CWORD(0),NWORD 01160001 BH GOLEFT 01170001 BL GORIGHT 01180001 CH R4_LEN,CWORDLEN EQUAL SO FAR, COMPARE LENGTHS 01190001 BH GORIGHT 01200001 BL GOLEFT 01210001 NOWORD EQU * WORD ALREADY EXISTS IN THE TREE 01220001 SR R4_LEN,R4_LEN 01230001 LA R8_NWORDPTR,NWORD 01240002 B NEXTCHAR 01250001 GOLEFT EQU * 01260001 ICM R10_WORK,B'1111',CLEFT 01270001 BE ADDNODEL 01280001 L R6_CURRNODE,CLEFT 01290002 B FINDWORD 01300001 ADDNODEL EQU * 01310001 LA R9_UNQWORDS,1(,R9_UNQWORDS) BUMP UNIQUE WORDS 01320001 ST R7_NEXTNODE,CLEFT 01330002 LR R6_CURRNODE,R7_NEXTNODE 01340002 LA R7_NEXTNODE,NWORD-NNODE(R4_LEN,R7_NEXTNODE) GO PAST WORD 01350002 B NOWORD 01360001 GORIGHT EQU * 01370001 ICM R10_WORK,B'1111',CRIGHT 01380001 BE ADDNODER 01390001 L R6_CURRNODE,CRIGHT 01400002 B FINDWORD 01410001 ADDNODER EQU * 01420001 LA R9_UNQWORDS,1(,R9_UNQWORDS) BUMP UNIQUE WORDS 01430001 ST R7_NEXTNODE,CRIGHT 01440002 LR R6_CURRNODE,R7_NEXTNODE 01450002 LA R7_NEXTNODE,NWORD-NNODE(R4_LEN,R7_NEXTNODE) GO PAST WORD 01460002 B NOWORD 01470001 LETTER EQU * 01480001 LA R4_LEN,1(R4_LEN) 01490001 LA R8_NWORDPTR,1(R8_NWORDPTR) 01500002 B NEXTCHAR 01510001 EXIT EQU * 01520001 TIMEUSED STORADR=STCKEND,CPU=MIC,LINKAGE=SYSTEM 01530001 CVD R5_TTLWORDS,DOUBLE 01540001 UNPK TOTAL,DOUBLE+4(4) UNPACK THE STUFF 01550001 OI TOTAL+6,C'0' FORCE LAST DIGIT TO NUMERIC 01560001 TPUT TOTALM,TOTALL 01570001 CVD R9_UNQWORDS,DOUBLE 01580001 UNPK UNIQUE,DOUBLE+4(4) UNPACK THE STUFF 01590001 OI UNIQUE+6,C'0' FORCE LAST DIGIT TO NUMERIC 01600001 TPUT UNIQUEM,UNIQUEL 01610001 L 3,STCKEND+4 01620001 L 2,STCKSTRT+4 01630001 SLR 3,2 01640001 ST 3,TIMEWIO 01650001 CVD 3,DOUBLE 01660001 UNPK TIME1,DOUBLE+4(4) UNPACK THE STUFF 01670001 OI TIME1+6,C'0' FORCE LAST DIGIT TO NUMERIC 01680001 TPUT TIME1M,TIME1L 01690001 L 3,STCKEND+4 01700001 L 2,STCKSTRT2+4 01710001 SLR 3,2 01720001 ST 3,TIMENIO 01730001 CVD 3,DOUBLE 01740001 UNPK TIME2,DOUBLE+4(4) UNPACK THE STUFF 01750001 OI TIME2+6,C'0' FORCE LAST DIGIT TO NUMERIC 01760001 L 2,TIMEWIO 01770001 SLR 2,3 01780001 CVD 2,DOUBLE 01790001 UNPK TIME3,DOUBLE+4(4) UNPACK THE STUFF 01800001 OI TIME3+6,C'0' FORCE LAST DIGIT TO NUMERIC 01810001 TPUT TIME3M,TIME3L 01820001 TPUT TIME2M,TIME2L 01830001 L 13,4(,13) 01840001 LM 14,12,12(13) 01850001 XR 15,15 01860001 BR 14 01870001 LTORG 01880001 R2_TXTPTR EQU 2 01890001 R3_DCB EQU 3 01900001 R3_BRANCH EQU 3 01910001 R3_CLEN EQU 3 COMPARISON LENGTH 01920001 R4_LEN EQU 4 01930001 R5_TTLWORDS EQU 5 01940001 R6_CURRNODE EQU 6 01950002 R7_NEXTNODE EQU 7 01960002 R8_NWORDPTR EQU 8 01970002 R9_UNQWORDS EQU 9 01980001 R10_WORK EQU 10 01990001 R11_TABL EQU 11 02000001 SAVEAREA DS 18F 02010001 INDD DCB DDNAME=INDD,LRECL=255,RECFM=VB,MACRF=GL,DSORG=PS, X02020001 EODAD=EOF 02030001 TEXTBUFF DS F 02040001 BUFEND DS A 02050001 SAVELINE MVC 0(0,R2_TXTPTR),4(1) 02060001 COMPARE CLC CWORD(0),NWORD 02070001 MSGSAVE MVC MSGWORD,NWORD 02080001 MSGSAVE2 MVC MSGWORD,CWORD 02090001 MSGWORD DS CL100 02100001 DOUBLE DS D 02110001 TOTALM DC C'total words :' 02120001 TOTAL DS CL7 02130001 TOTALL EQU *-TOTALM 02140001 UNIQUEM DC C'unique words :' 02150001 UNIQUE DS CL7 02160001 UNIQUEL EQU *-UNIQUEM 02170001 TIME1M DC C'elapsed time: ' 02180001 TIME1 DS CL7 02190001 DC C' microseconds including i/o' 02200001 TIME1L EQU *-TIME1M 02210001 TIME2M DC C'elapsed time: ' 02220001 TIME2 DS CL7 02230001 DC C' microseconds excluding i/o' 02240001 TIME2L EQU *-TIME2M 02250001 TIME3M DC C'I/O time: ' 02260001 TIME3 DS CL7 02270001 DC C' microseconds' 02280001 TIME3L EQU *-TIME3M 02290001 STCKSTRT DS D 02300001 STCKSTRT2 DS D 02310001 STCKEND DS D 02320001 TIMEWIO DS F 02330001 TIMENIO DS F 02340001 DELTA DS F 02350001 ADDR_TABLE DC 125A(SPACE) JUNK TURNS TO SPACES 02360001 DC A(NEXTCHAR) 7D QUOTE IS IGNORED 02370001 DC 3A(SPACE) JUNK 02380001 DC 9A(LETTER) 81-89 LOWER A-I 02390001 DC 7A(SPACE) JUNK 02400001 DC 9A(LETTER) 91-99 LOWER J-R 02410001 DC 8A(SPACE) JUNK 02420001 DC 8A(LETTER) A2-99 LOWER S-Z 02430001 DC 23A(SPACE) JUNK 02440001 DC 9A(LETTER) C1-C9 LOWER A-I 02450001 DC 7A(SPACE) JUNK 02460001 DC 9A(LETTER) D1-D9 LOWER J-R 02470001 DC 8A(SPACE) JUNK 02480001 DC 8A(LETTER) E2-E9 LOWER S-Z 02490001 DC 22A(SPACE) JUNK 02500001 DS AL4 02510001 SPACES DC CL256' ' 02520001 DS 0H 02530001 CASE OC NWORD(0),SPACES 02540001 DS 0D 02550001 ROOTSTBL EQU * 02560001 ROOTA DC 2XL4'0',XL2'0003',C'AM ' 02570001 ROOTB DC 2XL4'0',XL2'0003',C'BM ' 02580001 ROOTC DC 2XL4'0',XL2'0003',C'CM ' 02590001 ROOTD DC 2XL4'0',XL2'0003',C'DM ' 02600001 ROOTE DC 2XL4'0',XL2'0003',C'EM ' 02610001 ROOTF DC 2XL4'0',XL2'0003',C'FM ' 02620001 ROOTG DC 2XL4'0',XL2'0003',C'GM ' 02630001 ROOTH DC 2XL4'0',XL2'0003',C'HM ' 02640001 ROOTI DC 2XL4'0',XL2'0003',C'IM ' 02650001 ROOTJ DC 2XL4'0',XL2'0003',C'JM ' 02660001 ROOTK DC 2XL4'0',XL2'0003',C'KM ' 02670001 ROOTL DC 2XL4'0',XL2'0003',C'LM ' 02680001 ROOTM DC 2XL4'0',XL2'0003',C'MM ' 02690001 ROOTN DC 2XL4'0',XL2'0003',C'NM ' 02700001 ROOTO DC 2XL4'0',XL2'0003',C'OM ' 02710001 ROOTP DC 2XL4'0',XL2'0003',C'PM ' 02720001 ROOTQ DC 2XL4'0',XL2'0003',C'QM ' 02730001 ROOTR DC 2XL4'0',XL2'0003',C'RM ' 02740001 ROOTS DC 2XL4'0',XL2'0003',C'SM ' 02750001 ROOTT DC 2XL4'0',XL2'0003',C'TM ' 02760001 ROOTU DC 2XL4'0',XL2'0003',C'UM ' 02770001 ROOTV DC 2XL4'0',XL2'0003',C'VM ' 02780001 ROOTW DC 2XL4'0',XL2'0003',C'WM ' 02790001 ROOTX DC 2XL4'0',XL2'0003',C'XM ' 02800001 ROOTY DC 2XL4'0',XL2'0003',C'YM ' 02810001 ROOTZ DC 2XL4'0',XL2'0003',C'ZM ' 02820001 ROOTSL EQU *-ROOTSTBL 02830001 ROOTPTRS DC 256F'0' 02840001 ORG ROOTPTRS+(C'A'*4) 02850001 DC A(ROOTA) 02860001 DC A(ROOTB) 02870001 DC A(ROOTC) 02880001 DC A(ROOTD) 02890001 DC A(ROOTE) 02900001 DC A(ROOTF) 02910001 DC A(ROOTG) 02920001 DC A(ROOTH) 02930001 DC A(ROOTI) 02940001 ORG ROOTPTRS+(C'J'*4) 02950001 DC A(ROOTJ) 02960001 DC A(ROOTK) 02970001 DC A(ROOTL) 02980001 DC A(ROOTM) 02990001 DC A(ROOTN) 03000001 DC A(ROOTO) 03010001 DC A(ROOTP) 03020001 DC A(ROOTQ) 03030001 DC A(ROOTR) 03040001 ORG ROOTPTRS+(C'S'*4) 03050001 DC A(ROOTS) 03060001 DC A(ROOTT) 03070001 DC A(ROOTU) 03080001 DC A(ROOTV) 03090001 DC A(ROOTW) 03100001 DC A(ROOTX) 03110001 DC A(ROOTY) 03120001 DC A(ROOTZ) 03130001 ORG ROOTPTRS+1024 03140001 NNODE DSECT 03150001 NLEFT DS F 03160001 NRIGHT DS F 03170001 NWORDLEN DS H 03180001 NWORD DS 0C 03190001 CNODE DSECT 03200001 CLEFT DS F 03210001 CRIGHT DS F 03220001 CWORDLEN DS H 03230001 CWORD DS 0C 03240001 DCBD DSORG=PS 03250001 END $$ 03260001