Title : Sort / merge the source for the IMS Security Maintenance utility Submitter : Dougie Lawson NATWEST Bank plc Level A/3 Goodmans Fields 74 Alie Street London E1 8HL Release Submitter Details - Y Text :- 2 PL1 programs follow *************** SMUMRG.PLI Starts here *************************************** smumrg: proc options(main) reorder; /*------------------------------------------------------------------*\ ³ This program will sort or merge the source for the IMS Security ³ ³ Maintenance utility. It will remove duplicates where the verb and ³ ³ operand matches but does not do any substitution for abbreviations.³ ³ ³ ³ For example: ³ ³ )( COMMAND ASSIGN and )( COMMAND ASS ³ ³ TERM MASTER TERM MASTER ³ ³ do not match so both would be included in the output. ³ ³ ³ ³ also ³ ³ )( TERM DFSTCFI and )( TERM DFSTCFI ³ ³ COM PST COM PSTOP ³ ³ do not match so both would again be included in the output. ³ ³ ³ ³ If the input is concatenated then the output will be a merge of ³ ³ the two input datasets. ³ ³ ³ ³ The JCL is simple: ³ ³ ³ ³ //JOBCARD1 JOB (ACCT),MSGCLASS=X,REGION=6500K ³ ³ // EXEC PGM=SMUMRG ³ ³ //STEPLIB DD DSN=SMUMRG.LOADLIB,DISP=SHR ³ ³ // DD DSN=PLI.V230.PLILINK,DISP=SHR ³ ³ // DD DSN=PLI.V230.SIBMLINK,DISP=SHR ³ ³ // DD DSN=COBOL.V132.COB2LIB,DISP=SHR ³ ³ //SMUIN DD DSN=IMS.GENSRC(SMU1),DISP=OLD ³ ³ // DD DSN=IMS.GENSRC(SMU2),DISP=OLD ³ ³ //SMUOUT DD DSN=IMS.GENSRC(NEWSMU),DISP=SHR ³ ³ //SYSPRINT DD SYSOUT=* ³ ³ //PLIDUMP DD SYSOUT=* ³ ³ //SYSUDUMP DD SYSOUT=* ³ ³ ³ ³ This program uses a binary tree technique and was prototyped in ³ ³ REXX. Unfortunately REXX cannot handle more than 250 recursions ³ ³ so a conversion to PL/1 was used to implement a working solution. ³ ³ ³ ³ Binary trees are described in "The C Programming Language by ³ ³ Kernighan and Ritchie" in nice simple words and pictures. ³ ³ ³ ³ This program must include the following copyright statement but ³ ³ is placed within the public domain and may be freely distributed ³ ³ printed or copied to any medium. ³ ³ ³ ³ (C) 1994 Copyright National Westminster Bank Plc. ³ ³ ³ ³ Any questions ? ³ ³ ³ ³ Contact me at IBMMAIL(GBMZF9XF) or phone +44 71 860 4118. ³ ³ ³ ³ Dougie Lawson, Senior Systems Programmer, ³ ³ NatWest Bank, Level A/3, Goodmans Fields, ³ ³ 74 Alie Street, London, E1 8HL, United Kingdom. ³ ³ ³ ³ March 1994 ³ \*------------------------------------------------------------------*/ dcl copy_right_thingy char(80) init('(C) 1994 NATIONAL WESTMINSTER BANK PLC'); dcl 1 cobol_bits, 2 smu_rec char(80), 2 cob_1 char(80), 2 cob_2 char(80), 2 cob_3 char(80); dcl (word_1,word_2,word_3) char(8) varying; dcl (name) char(16) varying; dcl smu_end bit(1) init(0B); dcl smuin file; dcl smuout file; dcl recparse external options(cobol); dcl root pointer; dcl cmd_ptr pointer; dcl dat_ptr pointer; dcl cur_ptr pointer static; dcl 1 command based(cmd_ptr), 2 cmd_cname char(16) varying, 2 cmd_sname char(8) varying, 2 cmd_verb char(8) varying, 2 cmd_count bin(15) fixed, 2 cmd_left pointer, 2 cmd_right pointer, 2 cmd_data pointer; dcl 1 datarec based(dat_ptr), 2 dat_cname char(16) varying, 2 dat_sname char(8) varying, 2 dat_verb char(8) varying, 2 dat_data pointer; dcl (null,substr,sysnull,plidump) builtin; on endfile(smuin) smu_end = 1B; on error call plidump('shaftb'); root = null(); do while (smu_end = 0B); read file(smuin) into(smu_rec); /*------------------------------------------------------------------*\ ³ Call a COBOL subroutine to parse the input since PL/1 GET is crap. ³ \*------------------------------------------------------------------*/ call recparse(cobol_bits); word_1 = substr(cob_1,1,8); word_2 = substr(cob_2,1,8); word_3 = substr(cob_3,1,8); name = word_2 ³³ word_3; if word_1 = ')(' then root = cmdtree(root,name); else x = dataadd(name); end; x = treeprt(root); return; cmdtree: proc(p,name) returns(pointer) recursive; dcl p pointer; dcl name char(16) varying; if p = null() then do; allocate command set(p); p->cmd_cname = name; p->cmd_sname = word_3; p->cmd_verb = word_2; p->cmd_count = 0; p->cmd_left = null(); p->cmd_right = null(); p->cmd_data = null(); cur_ptr = p; end; else if name = p->cmd_cname then do; p->cmd_count = p->cmd_count + 1; cur_ptr = p; end; else if name < p->cmd_cname then p->cmd_left = cmdtree(p->cmd_left,name); else p->cmd_right = cmdtree(p->cmd_right,name); return (p); end; dataadd: proc(name); dcl name char(16) varying; dcl p pointer; dcl qprev pointer; dcl q pointer; qprev = null(); p = cur_ptr; q = p->cmd_data; do while (q ª= null()); if q->dat_cname = name then do; q = null(); qprev = sysnull(); end; else do; qprev = q; q = q->dat_data; end; end; if qprev = null() then do; allocate datarec set(q); p->cmd_data = q; end; else if qprev ª= sysnull() then do; allocate datarec set(q); qprev->dat_data = q; end; if qprev ª= sysnull() then do; q->dat_cname = name; q->dat_sname = word_3; q->dat_verb = word_2; q->dat_data = null(); end; return; end; treeprt: proc(p); dcl p pointer; if p ª= null() then do; x = treeprt(p->cmd_left); /*------------------------------------------------------------------*\ ³ Write a SMU control statement to the output file. ³ \*------------------------------------------------------------------*/ put file(smuout) edit(')(',p->cmd_verb,p->cmd_sname) (a(3),a(9),a(9)) skip; x = dataprt(p); x = treeprt(p->cmd_right); end; return; end; dataprt: proc(p); dcl p pointer; dcl q pointer; q = p->cmd_data; do while (q ª= null()); /*------------------------------------------------------------------*\ ³ Write a SMU data statement to the output file. ³ \*------------------------------------------------------------------*/ put file(smuout) edit(' ',q->dat_verb,q->dat_sname) (a(3),a(9),a(9)) skip; q = q->dat_data; end; end; end smumrg; *************** SMUMRG.PLI Ends here ************************* *************** RECPARSE.COBOL starts here ********************* 000100CBL QUOTE,NODYNAM 000101* 000110* (C) 1994 Copyright National Westminster Bank Plc. 000120* 000200 TITLE "STRING PARSER 'COS PLI GET IS CRAP" 000300 IDENTIFICATION DIVISION. 000400 PROGRAM-ID. RECPARSE. 000500 ENVIRONMENT DIVISION. 000600 DATA DIVISION. 000700 WORKING-STORAGE SECTION. 000710 77 COPY-RIGHT PIC X(80) 000720 VALUE "(C) 1994 COPYRIGHT NATIONAL WESTMINSTER BANK PLC.". 000800 LINKAGE SECTION. 000810 01 COBOL-BITS. 000900 02 SMU-REC PIC X(80). 001000 02 WORD-1 PIC X(80). 001100 02 WORD-2 PIC X(80). 001200 02 WORD-3 PIC X(80). 001300 PROCEDURE DIVISION USING COBOL-BITS. 001700 MAIN-LINE. 001800 MOVE SPACES TO WORD-1, WORD-2, WORD-3. 001900 UNSTRING 002000 SMU-REC 002100 DELIMITED BY ALL " " 002200 INTO WORD-1 002300 WORD-2 002400 WORD-3 002500 END-UNSTRING. 002600 GOBACK. *************** RECPARSE.COBOL Ends here **********************