./ ADD SSI=01010730,NAME=IKFCBL51,SOURCE=0 *$MODULE PHASE51 00007021 * 00014021 * 00021021 * 00028021 * 00035021 * 00042021 * 00049021 * 00056021 * 00063021 * 00070021 * 00077021 * 00084021 * 00091021 * 00098021 * 00105021 * 00112021 * 00119021 * 00126021 * 00133021 * 00140021 * 00147021 * 00154021 * 00161021 * 00168021 * 00175021 IKF501 START 0 PHASE51 STARTS 00182021 ENTRY PH51 00189021 ENTRY PHASE51 00196021 IHBCOB 00203021 IKF501 CSECT 00210021 COMON1 EQU * 00217021 * THE FOLLOWING FIELDS ARE FOR 00224021 * IDENTIFICATION PURPOSES ONLY 00231021 DC C'IKFCBL51' X 00238021 DC C'B' X 00245021 DC AL1(40) X 00252021 TITLE 'PHASE 5 - A BRIEF DESCRIPTION' 00259021 *=1 PH5 C O N T R O L . 00266021 *=3 00273021 *TITLE 'PH5 ' 00280021 *STATUS: CHANGE LEVEL 000 00287021 *FUNCTION/OPERATION: OBTAIN IC TEXT FROM 'PH4 ' AND CONVERT IT 00294021 * A-TEXT ACCEPTABLE TO 'PH6 '. 00301021 * ORGANIZATION OF PHASE... 00308021 * PH5CTL PHASE 5 CONTROL. OBTAINS IC-TEXT AND PROCESSE 00315021 * ALL BUT VERB-STRINGS WHICH ARE ROUTED TO PROP 00322021 * VERB ANALYZERS. 00329021 * A-TEXT GENERATOR. HAS ENTRY POINTS FOR MOST MACHINE 00336021 * INSTRUCTIONS AND BUILDS A-TEXT (PROCEDURE AND 00343021 * OPTIMIZATION) BASED UPON VARIOUS PARAMETERS 00350021 * PROVIDED IT BY THE CALLING ANALYZER OR SUBRTN 00357021 * SUPPLEMENTAL TO THIS PORTION IS 00364021 * THE DIRECT-PROCEDURE-A-TEXT GENERATOR, 00371021 * A SUBROUTINE. 00378021 * VERB-ANALYZERS. SEPERATE ANALYZERS OBTAIN STRINGS FO 00385021 * THEIR PARTICULAR VERBS AND GENERATES A-TEXT 00392021 * REPRESENTING OBJECT CODE FOR THE STATEMENT. 00399021 * SUBROUTINES. NUMEROUS SERVICE SUBROUTINES SUPPORT 00406021 * ALL OTHER PARTS OF THE PHASE. 00413021 * SUBSCRIPTS AND SUBSCRIPT REGISTER ALLOCATION ARE HAN 00420021 * BY SEVERAL SUBROUTINES AND ANALYZERS. 00427021 * TAMER TABLE AND COMMON ARE COMMUNICATION REGIONS IN 00434021 * MAIN-STORAGE THAT ARE USED FOR INTER-PHASE 00441021 * INFORMATION-PASSING, AND ARE NOT PART OF PHAS 00448021 SPACE 3 00455021 *ENTRY POINTS: 00462021 * 'PH5 ' MAIN ENTRY POINT, CALLED BY 'PH0 '. 00469021 *INPUT: IC-TEXT SYSUT2 00476021 * COMMON MAIN-STORAGE 00483021 *OUTPUT: PROCEDURE A-TEXT SYSUT1 00490021 * OPTIMIZATION A-TEXT SYSUT3 00497021 * E-TEXT (ERR MESG'S) SYSUT4 00504021 * COMMON MAIN-STORAGE 00511021 * TABLE: PNUTBL MAIN-STORAGE (TAMER) 00518021 *EXTERNAL ROUTINES: 00525021 * 'PH0 ' CALLS THIS PHASE AND PROVIDES I/O, COMMON + T 00532021 * SUPPORT. 00539021 *EXITS-NORMAL: N/A 00546021 *EXITS-ERROR: N/A 00553021 *TABLES/WORK AREAS: ... THOSE ITEMS THAT ARE VARIABLE OR MIXED 00560021 * CONSTANT-VARIABLE ARE COLLECTED TOGETHER 00567021 * IN AN AREA UNDER BASE REG XRDATA. 00574021 * ... THOSE ITEMS THAT ARE NON-INSTRUCTIONS AN 00581021 * FULLY CONSTANTS ARE COLLECTED UNDER BASE 00588021 * REG XRCONS. 00595021 * 00602021 *ATTRIBUTES: NON-REUSABLE (DUE TO SOME NON-INITIALIZED SWITCHES). 00609021 *NOTES: N/A 00616021 TITLE 'IKFCBL51: PH5CTL - PHASE 51 CONTROL ROUTINE' 00623021 USING COMON1,XRBAS1 00630021 USING COMON3,GBRG1 00637021 USING COMON4,XRCONS 00644021 USING COMON5,XRDATA 00651021 USING COS,XRBAS2 00658021 * PH5CTL 00665021 ******************************************************************* 00672021 * CHECKS THE INPUT OF PHASE 5 TO DETERMINE WHETHER IT IS A 'STRING' 00679021 * OR 'OTHER THAN A STRING'. PUTS 1ST 4 BYTES IN 'HEADER'. 00686021 * I. IF THE INPUT IS A 'STRING' - 00693021 * A. THE STRING HEADER (A 3 BYTE FIELD) IS STORED IN 'HEADER'. 00700021 * 'HEADER+1' IS CALLED 'ANALNO' (ANALYZER NUMBER). 00707021 * 'HEADER+2' IS CALLED 'ELEMCT' (ELEMENT COUNT). 00714021 * B. THE ELEMENTS IN THE STRING ARE PUT IN 'ELEMTB' (ELEMENT TAB 00721021 * C. AFTER ALL ELEMENTS IN A STRING HAVE BEEN STORED IN 'ELEMTB' 00728021 * CONTROL PASSES TO A STRING ANALYZER. 00735021 * D. AFTER AN ANALYZER HAS PROCESSED THE ELEMENT TABLE CONTROL I 00742021 * RETURNED TO PH5CTL 00749021 * II. IF THE INPUT IS 'OTHER THAN A STRING' - 00756021 * A. IF THE INPUT IS A SECTION OR PARAGRAPH NAME IT IS WRITTEN O 00763021 * AND CONTROL IS RETURNED TO 'SEARCH'. (INPUT IS IN 'HEADER') 00770021 * B. IF THE INPUT IS 'EOF' A DUMP IS TAKEN AND PROCESSING IS END 00777021 * C. II(A) AND II(B) WILL BE SPECIFIED IN MORE DETAIL LATER. 00784021 ******************************************************************* 00791021 ******************************************************************* 00798021 * 00805021 * 00812021 * 00819021 * 00826021 EJECT 00833021 PH5CTL DS 0H 00840021 MVI CDNOSW,XX00 00847021 BAL RETRG,GETNXT *LOCATE NEXT ELEMENT TO BE PROCESSED 00854021 MVC ASRLAS(LX1),DX0(RW2) FOR AUTOMATIC STOP RUN 00861021 CLI DX0(RW2),XX84 TEST IF ELEMENT IS STRING HEADER 00868021 BNE PH5CTL RETURN TO CONTROL 00875021 CLI DX1(RW2),XX70 IS THIS SEGM IN INITIAL. ELEMNT. 00882021 BE SEGINT YES 00889021 MVC HEADER(LX4),DX0(RW2) SAVE HEADER 7898 00896021 BAL RETRG,STRTTEST CHECK GENERATION OF START 7898 00903021 MVC GANLNO(LX1),HEADER+NX1 SAVE ANALYZER NO 00910021 LA RW4,DOP1 *SET RW4 TO ADDRESS OF FIRST OPD AREA 00917021 SR RW5,RW5 00924021 IC RW5,HEADER+NX2 GET COUNT OF OPDS TO RW1 00931021 LTR RW5,RW5 TEST IF COUNT IS ZERO 00938021 BZ PH5CT0 YES, BYPASS LOOP 00945021 * NO, LOOP TO GET OPDS TO OPD AREAS 00952021 CTLLP BAL RETRG,GETNXT *GET TO NEXT OPD 00959021 BCTR RW3,RW0 DECR LENGTH BY 1 FOR EX INSTR 00966021 EX RW3,CTLMVC EX TO MOVE OPD FROM BUFFER TO OPD ARE 00973021 LA RW4,OPSIZ(RW4) STEP ADDR TO NEXT OPD AREA FOR NEXT E 00980021 BCT RW5,CTLLP LOOP ON COUNT OF OPDS 00987021 PH5CT0 IC RW5,GANLNO *PUT ANALYZER NUMBER IN REG 00994021 SLL RW5,DX2 MULTIPLY BY 4 TO USE AS INDEX 01001021 L GVERB,ADCN00(RW5) PICK UP ADCON 01008021 BR GVERB GO TO ANALYZER 01015021 SEGINT MVI DX0(RW2),XX44 CHANGE ID-BYTE 01022021 MVI DX1(RW2),XX4C 01029021 LA RW3,DX3 SPECIFY LENGTH 01036021 BAL RW0,WRITE3 WRITE SEGM INIT ELM 01043021 B PH5CTL GET NEXT P2 TEXT 01050021 CTLMVC MVC DX0(LX0,RW4),DX0(RW2) 01057021 SPACE 5 01064021 PH5AOP LA RW2,DX2(RW2) POINT TO TEXT 01071021 SH RW3,HW2 GET COUNT 01078021 MVC ASRLAS(LX1),DX0(RW2) FOR AUTOMATIC GOBACK 01085021 CTLCPY CLI DX0(RW2),PNDEF IF NOT PN, GN, OR VN 01092021 BE PNPROC DEFINITION, IGNORE ELEMENT 01099021 CLI DX0(RW2),GNDEF 01106021 BE GNPROC IF GN DEF, WRITE A TEXT 01113021 CLI DX0(RW2),VNDEF 01120021 BE VNPROC IF UN DEF, WRITE A TEXT 01127021 CLI DX0(RW2),DUMMYPN IS IT DUMMY PN... 2962 01134021 BE DUMPNPRC YES, WRITE A TEXT 2962 01141021 B CHKSEG NONE, TEST FOR X'42' 01148021 NOTSEG DS 0H 7898 01155021 BAL RETRG,STRTTEST CHECK GENERATION OF START 7898 01162021 BAL RW0,WRITE2 WRITE OPT A-TEXT 7898 01169021 B GET GET COUNT OF FOLLOWING BYTES 01176021 PNPROC MVI DX0(RW2),PAPNDEF PROCEEDURE-A CODE FOR PN DE 01183021 MVC PNOUT(LX4),DX0(RW2) SAVE PRIORITY AND PN NO 01190021 MVC PTYNO(LX1),DX1(RW2) SAVE PRIOR FOR PH0 IN COMMON 01197021 B GOPUT WRITE A TEXT ROUTINE 01204021 GNPROC MVI DX0(RW2),PAGNDEF PROCEEDURE-A CODE FOR GN DE 01211021 B GOPUT WRITE A TEXT ROUTINE 01218021 VNPROC MVI DX0(RW2),PAVNDEF PROCEEDURE-A CODE FOR VN DE 01225021 GOPUT EQU * 01232021 BAL RETRG,PUTDEF PUT ELEMENT 01239021 B GET GET COUNT OF FOLLOWING BYTES 01246021 DUMPNPRC DS 0H 2962 01253021 MVC DOP2(LX3),DUMPNDEF 2962 01260021 MVC DOP2+NX3(LX3),DX1(RW2) 2962 01267021 LA RW2,DOP2 2962 01274021 LA RW3,NX6 01281021 BAL RW0,WRITE3 WRITE PROC-A-TEXT 2962 01288021 B PH5CTL RETURN FOR P2 TEXT 2962 01295021 SPACE 3 7898 01302021 STRTTEST DS 0H 7898 01309021 * 7898 01316021 * THIS ROUTINE KEEPS TRACK OF THE GENERATION OF THE START 7898 01323021 * EQUATE AT THAT LOGICAL POINT IN THE OBJECT PROGRAM TO 7898 01330021 * WHICH CONTROL IS TRANSFERRED FROM THE INIT ROUTINES. 7898 01337021 * THIS POINT OF CONTROL IS DETERMINED AND DECIDED BY THE 7898 01344021 * BIT CONFIGURATION OF A SWITCH, STRTSW. 7898 01351021 * 7898 01358021 SPACE 1 7898 01365021 TM STRTSW,HIORDON HAS START BEEN GENERATED... 7898 01372021 BO STRTEXIT YES 7898 01379021 TM STRTSW,BETWPDSD ARE WE BETWEEN THE PROCEDURE 7898 01386021 * DIVISION HEADER AND THE START DECLARATIVES... 7898 01393021 BO STRTCODE YES, GENERATE START 7898 01400021 TM STRTSW,BETWRWPD BETWEEN THE REPORT WRITER 7898 01407021 * HEADER AND PROCEDURE DIVISION HEADER... 7898 01414021 BO STRTEXIT YES 7898 01421021 TM STRTSW,XX03 SHOULD START STILL BE GEN'ED...7898 01428021 BC NOTMXD,STRTEXIT NO 7898 01435021 STRTCODE DS 0H 7898 01442021 ST RETRG,STRTSAVE SAVE REGISTERS 14, 7898 01449021 STM RW2,RW3,STRTSAVE+NX4 2 AND 3 7898 01456021 LA RW2,STRTCN ADDRESS MACRO STRING 7898 01463021 LA RW3,DX2 AND LENGTH 7898 01470021 BAL RETRG,PUTA WRITE A-TEXT 7898 01477021 OI STRTSW,XX80 INDICATE START HAS BEEN GEN'ED 7898 01484021 L RETRG,STRTSAVE RESTORE REGISTERS 14 7898 01491021 LM RW2,RW3,STRTSAVE+NX4 2 AND 3 7898 01498021 STRTEXIT DS 0H 7898 01505021 BR RETRG RETURN TO CALLER 7898 01512021 SPACE 3 7898 01519021 EXECTABL DS 0H 7898 01526021 * 7898 01533021 * THIS IS TABLE OF 4-BYTE INSTR. USED BY AN EXECUTE 7898 01540021 * INSTRUCTION TO ANALYZE THE POSSIBLE PROGRAM BREAKS. 7898 01547021 * 7898 01554021 SPACE 2 7898 01561021 XI STRTSW,XX61 PROCEDURE DIVISION HEADER 7898 01568021 NI STRTSW,XX9C START DECLARATIVES HEADER 7898 01575021 OI STRTSW,XX01 END DECLARATIVES HEADER 7898 01582021 B GET START DEBUG PACKET HEADER 7898 01589021 B PH5AQR START Q-ROUTINES HEADER 7898 01596021 OI STRTSW,XX20 START REPORT WRITER HEADER 7898 01603021 NI STRTSW,XXDF END REPORT WRITER HEADER 7898 01610021 B GET4 END OF SEGMENT HEADER 7898 01617021 EJECT 01624021 * ROUTINE TO GET NEXT LOGICAL ELEMENT 01631021 GETNXT ST RETRG,GETSAV SAVE RETURN ADDR 01638021 GET L RW2,PNTIN *LOAD RW2 WITH ADDR OF CURRENT ELEMENT 01645021 AH RW2,BYTCNT ADD LENGTH OF CURRENT ELEMENT 01652021 ST RW2,PNTIN SAVE ADDR OF NEW ELEMENT 01659021 SR RW3,RW3 01666021 GET1 IC RW3,DX1(RW2) *GET COUNT IN CASE IT FOLLOWS CODE 01673021 TM DX0(RW2),XXC0 TEST IF COUNT IN CODE OF FOLLOWING CO 01680021 BZ GET2 COUNT FOLLOWS CODE 01687021 IC RW3,DX0(RW2) GET COUNT AS INDICATED IN CODE. THIS 01694021 SRL RW3,DX6 COUNT IS 1 LESS THAN COUNT FOR ENTI 01701021 BCTR RW3,RW0 ELEMENT. DECR BY 1 THEN ADD 2. 01708021 GET2 LA RW3,DX2(RW3) ADD 2 TO COUNT TO GET COUNT FOR ENTIR 01715021 STH RW3,BYTES ELEMENT 01722021 STH RW3,BYTCNT SAVE COUNT 01729021 CLI DX0(RW2),XX27 OPT A TEXT? 01736021 BE PH5AOP YES 01743021 CLI DX0(RW2),XX28 PROC A TEXT? 01750021 BE PH5APA YES 01757021 CLI DX0(RW2),XX29 ERROR TEXT? 01764021 BE PH5AER YES 01771021 TM DX0(RW2),XXFF *TEST IF ELEMENT IS END-OF-RCD MARKER 01778021 BO GET5 YES 01785021 B GET8 GO TO EXIT 01792021 CHKSEG CLI DX0(RW2),XX42 CONTROL BREAK? 01799021 BNE NOTSEG NO 01806021 SPACE 2 7898 01813021 * 7898 01820021 * HERE WE HAVE ESTABLISHED THAT THIS IS A PROGRAM BREAK, AND 7898 01827021 * WE USE AN EXECUTE TABLE (EXECTABL) TO DETERMINE PROGRAM 7898 01834021 * FLOW IN ANALYZING THE CRITICAL PROGRAM BREAKS. 7898 01841021 * 7898 01848021 SPACE 2 7898 01855021 SR RW3,RW3 CLEAR REGISTERS 7898 01862021 SR RW5,RW5 3 AND 5 7898 01869021 IC RW3,DX1(RW2) GET TYPE OF BREAK 7898 01876021 SH RW3,H6 SUBTRACT 6 TO GET RID OF MEAN- 7898 01883021 * INGLESS CODES 7898 01890021 SLA RW3,DX2 MULTIPLY BY 4 FOR CORRECT 7898 01897021 * TABLE DISPLACEMENT 7898 01904021 LA RW4,EXECTABL POINT TO INSTRUCTION TABLE 7898 01911021 EX RW5,DX0(RW3,RW4) EXECUTE INSTRUCTION NEEDED 7898 01918021 B GET GET NEXT ELEMENT 7898 01925021 GET4 DS 0H 7898 01932021 CLI SEGSW,XX01 ****************************** 01939021 BNE SSSSSS ****************************** 01946021 MVI DX0(RW2),XX44 YES,PASS IT TO PHASE 6 01953021 MVI DX1(RW2),XX44 01960021 LA RW3,DX2 SPECIFY LENGTH 01967021 BAL RW0,WRITE3 WRITE A-TXT 01974021 BALR RW0,XRBAS2 BR TO PHASE 0 01981021 DC X'C100' COS CODE TO ISSUE NOTE MACRO 01988021 BAL RETRG,SEGENTR INSERT SEGMENT ENTRY 01995021 SSSSSS EQU * 02002021 MVI SEGSW,XX01 ****************************** 02009021 B GET GET NEXT ELEMENT 02016021 GET6 BAL RETRG,PUTA *PUT ELEMENT 02023021 B GET GET NEXT P2 ELEMENT 02030021 GET8 L RETRG,GETSAV *EXIT 02037021 BR RETRG EXIT FROM PHASE 5 02044021 GET9 CLI DX2(RW2),XX00 ERR MSG DEFINITION OR PARAMETER 02051021 BNE GET9A PARAMETER...WRITE OUT 02058021 BAL RETRG,SEVTST DEFINITION...TEST FOR E LEVEL 02065021 GET9A BAL RETRG,PUTMSG PUT ERROR MESSAGE 02072021 B GET GET NEXT P2 ELEMENT 02079021 * MAKE A SEGTBL ENTRY 02086021 SEGENTR L RW1,SEGPRM GET PARLIST ADDRESS 02093021 LR RW6,RETRG 02100021 L XRVAR,XINST 02107021 BALR RETRG,XRVAR BR TO INSERT RTN 02114021 MVC DX0(LX1,RW2),PNOUT+NX1 ENTER PRIORITY 02121021 L RW1,ADSEGSV 02128021 MVC DX1(LX4,RW2),DX0(RW1) ENTER DISKADDR FROM PH0 AREA 02135021 LR RETRG,RW6 02142021 BR RETRG RETURN TO CALLER 02149021 GET5 BAL RW0,READ1 *READ NEXT RECORD 02156021 BZ EOFIN TEST FOR EOF 02163021 LR RW2,RW0 PUT RCD ADDR IN RW2 02170021 ST RW2,PNTIN SAVE RCD ADDR 02177021 SR RW3,RW3 ZERO RW3 (INDICATING NO BYTES PROCESS 02184021 STH RW3,BYTCNT ZERO BYTCNT FOR SAME REASON 02191021 B GET1 EXIT 02198021 * 02205021 PH5APA LA RW2,DX2(RW2) POINT TO TEXT 02212021 SH RW3,HW2 GET CT 02219021 CLI DX0(RW2),XX7C LISTING A-TEXT... 02226021 BE PH5AP2 YES 02233021 CLI DX0(RW2),XX2C CARD NUMBER ID 02240021 BNE PH5AP1 NO, DO NOT MOVE CARD NUMBER 02247021 MVC CARDNO(LX2),DX1(RW2) KEEP CARD NUMBER IN COMMON AREA 02254021 B PH5AP2 BRANCH AROUND MOVE 7898 02261021 PH5AP1 DS 0H 7898 02268021 BAL RETRG,STRTTEST CHECK GENERATION OF START 7898 02275021 PH5AP2 DS 0H 7898 02282021 BAL RETRG,PUTA WRITE PROC A-TEXT 7898 02289021 B GET GET COUNT 02296021 PH5AQR BAL RETRG,ADETER TEST FOR Q ROUTINES 02303021 MVI DX0(RW2),XX44 02310021 MVI DX1(RW2),XX40 02317021 LA RW3,DX2 INDIC 2 BYTES 7898 02324021 BAL RETRG,PUTA PUT A TEXT 02331021 OI QRTNSW,MSWON 02338021 B GET GET COUNT 02345021 * 02352021 PH5AER LA RW2,DX2(RW2) POINT TO TEXT 02359021 SH RW3,HW2 GET CT 02366021 B GET9 PROCESS ETEXT 02373021 QRTNCB DC X'420A' Q ROUTINE 02380021 HW2 DC H'2' 02387021 SPACE 5 02394021 EOFIN BAL RETRG,ADETER GO TO EOF HSK 02401021 LH RW1,VIRCTR STEP VIRCTR DOWN BY 1 02408021 BCTR RW1,RW0 SUBTRACT 1 FROM REG 1 02415021 STH RW1,VIRCTR 02422021 CLI SEGLMT,XXFF IS PROGRAM SEGMENTED... 02429021 BE EOFFF NO 02436021 LA RW3,DX2 LENGTH 02443021 LA RW2,SEGBRK ADDR OF SEGM CONTROL BREAK 02450021 BAL RW0,WRITE3 WRITE LAST SEGM CONTROL BREAK 02457021 BALR RW0,XRBAS2 WRITE 02464021 DC X'C1FF' FINAL NOTE 02471021 BAL RETRG,SEGENTR MAKE LAST ENTRY IN SEGTBL 02478021 L RW1,SEGPRM 02485021 L XRVAR,ADSTAT STATIC SEGTBL 02492021 BALR RETRG,XRVAR BRANCH TO STATIC TBL ROUTINE 02499021 EOFFF EQU * 02506021 L RW1,GNCALPRM 37330 02513021 L XRVAR,RELADD 37330 02520021 BALR RETRG,XRVAR FREE GN CALL TABLE 7330 02527021 L RW1,ARNTBL ADDRESS OF RERUN TABLE 02534021 CLC DX1(LX3,RW1),XC000 IS IT ZERO... 02541021 BE NORERUNI YES, THEN NO RERUN 02548021 L RW1,DX0(RW1) 02555021 CLC DX4(LX2,RW1),XC000 02562021 BE NORERUNI IF 5TH AND 6TH BYT ZERO NO REL 02569021 L RW1,ARNTBL ADDR.OF RUNTBL'S TIB 02576021 L XRVAR,XTABL RELEASE RUNTBL. 02583021 BALR RETRG,XRVAR RELEASE RUNTBL 02590021 NORERUNI DS 0H 02597021 L RW1,AUSETBL ADDR USETBL 43521 02604021 CLC DX1(LX3,RW1),XC000 ADDR TAMM 0... 43521 02611021 BE NOUSEDCL YES 43521 02618021 L RW1,DX0(RW1) 43521 02625021 CLC DX4(LX2,RW1),XC000 ANY BYTES USED... 43521 02632021 BE NOUSEDCL NO 43521 02639021 L RW1,AUSETBL 43521 02646021 L XRVAR,XTABL 43521 02653021 BALR RETRG,XRVAR RELEASE USETBL 43521 02660021 NOUSEDCL DS 0H 43521 02667021 BALR RW0,XRBAS2 RETURN TO PHASE0 02674021 DC X'A0' 02681021 TITLE 'IKFCBL51: C O M M O N S U B R O U T I N E S' 02688021 PUTVIR LH RW1,VIRCTR STEP VIRCTR 02695021 LA RW1,DX1(RW1) 02702021 STH RW1,VIRCTR 02709021 BAL RW0,WRITE2 PUT VIRDEF ELEMENT ON F2 02716021 BR RETRG RETURN TO CALLER 02723021 SPACE 5 02730021 PUTLTL LH RW1,LTLCTR STEP LTLCTR 02737021 LA RW1,DX1(RW1) 02744021 STH RW1,LTLCTR 02751021 BAL RW0,WRITE2 PUT LTLDEF ELEMENT ON F2 02758021 BCR UNCOND,RETRG RETURN TO CALLER 02765021 SPACE 5 02772021 PUTMSG BAL RW0,WRITE4 WRITE ERROR MESSAGE 02779021 BCR UNCOND,RETRG RETURN TO CALLER 02786021 SPACE 5 02793021 PUTA STM RETRG,RW3,PUTSAV 02800021 PUTA04 CLI DX0(RW2),XX44 TEST IF A TEXT TO BE GENERATED WILL CA 02807021 BC EQ,PUTA1 IN-LINE CORE RESERVATION IN OBJECT 02814021 CLI DX0(RW2),XX48 PROGRAM 02821021 BC NOTEQ,PUTA2 BR IF NO 02828021 PUTA1 MVI GNLIST-NX2,XX08 SET CODE INDICATING GNEQU TO BE GENER 02835021 BAL RETRG,PUTEQU GO TO GENERATE GNEQU AND/OR GNDEF 02842021 * DEPENDING ON GNCNT 02849021 PUTA2 BAL RW0,WRITE3 WRITE ORIGINAL ELEMENT ON F3 02856021 LM RETRG,RW3,PUTSAV 02863021 BCR UNCOND,RETRG EXIT 02870021 SPACE 5 02877021 PUTDEF STM RETRG,RW3,PUTSAV 02884021 PUTDF4 CLI DX0(RW2),PAVNDEF TEST IF VNDEF 02891021 BNE PUTDPG BRANCH IF NO 02898021 LA RW3,DX4 02905021 BAL RW0,WRITE3 YES, GO TO WRITE,THEN EXIT 02912021 CLI SEGLMT,XXFF IS PROGRAM SEGMENTED 02919021 BC R8,PUTDXT NO,BR 02926021 MVI DX0(RW2),XX14 CHANGE ID BYTE 02933021 NI DX1(RW2),XX7F GET RID OF SWITCH IN PTY 02940021 LA RW3,DX4 SPECIFY LENGTH 02947021 BAL RW0,WRITE2 WRITE VNDEF IN OPT A-TEXT 02954021 BC UNCOND,PUTDXT LEAVE ROUTINE 02961021 PUTDPG LH RW1,GNCNT NO. ADD PN= OR GN= TO GNLIST 02968021 LA RW0,DX1(RW1) 02975021 STH RW0,GNCNT STEP COUNT OF ='S IN LIST 02982021 SLA RW1,DX1 CALC ADDR OF NEXT ENTRY IN LIST 02989021 LA RW1,GNLIST(RW1) 02996021 CLI DX0(RW2),PAPNDEF TEST FOR PNDEF 03003021 BE PUTPP BRANCH IF YES 03010021 MVC DX0(LX2,RW1),DX1(RW2) ENTER GN INTO GNLIST 03017021 CLC GNCNT,XC012 IS GNLIST FULL...... 03024021 BL PUTDXT NO 03031021 MVI GNLIST-NX2,XX08 YES, SET CODE FOR GNEQU STRING 03038021 B PUTDGO WRITE OUT GNLIST 03045021 PUTPP MVC DX0(LX2,RW1),DX2(RW2) ENTER PN INTO GNLIST 03052021 MVI GNLIST-NX2,XX0C INDICATE PNEQU TO BE GENERATED 03059021 CH RW0,PUTH1 TEST IF PN NOT PRECEDED BY GN'S 03066021 BE PUTDGO YES..IE, NOT PRECEEDED BY GN'S 03073021 MVC DX0(LX2,RW1),GNLIST MOVE FIRST ENTRY TO LAST 03080021 MVC GNLIST(LX2),DX2(RW2) MOVE PNNO TO FIRST ENTRY 03087021 LH RW3,GNLIST PUT PN= IN RW3 AND CALL RTN TO MARK P 03094021 BAL RETRG,PNUSED AS HAVING BEEN USED 03101021 PUTDGO BAL RETRG,PUTEQU GEN PNEQU IF ANY GN='S IN GNLI 03108021 PUTDXT LM RETRG,RW3,PUTSAV 03115021 BCR R15,RETRG RETURN TO CALLER 03122021 SPACE 5 03129021 PUTEQU LH RW1,GNCNT TEST GNCNT 03136021 CH RW1,PUTH1 03143021 BC LO,PUTEXT EXIT IF ZERO 03150021 BC EQ,PUTEEQ BR IF ONE 03157021 STC RW1,GNLIST-NX1 03164021 CLI GNLIST-NX2,XX0C *TEST IF PNEQU INDICATED 03171021 BC EQ,PUTEWR BR IF YES 03178021 BCTR RW1,RW0 TEST FOR LOOPING 03185021 SLL RW1,DX1 * NO, GO THROUGH LOOP TO GET LOWEST G 03192021 PUTELP LH RW3,GNLIST IN FIRST ENTRY IN GNLIST 03199021 LH RW0,GNLIST(RW1) 03206021 CR RW3,RW0 03213021 BL PUTEEL BRANCH AROUND STORE OPERATIONS 03220021 STH RW3,GNLIST(RW1) 03227021 LR RW3,RW0 03234021 STH RW3,GNLIST 03241021 PUTEEL BCTR RW1,RW0 LOOP CONTROL 03248021 BCT RW1,PUTELP GO THROUGH LOOP AGAIN 03255021 PUTEWR LH RW3,GNCNT *PUT = BYTES TO WRITE IN RW3 03262021 LA RW3,DX2(RW3,RW3) 03269021 LA RW2,GNLIST-NX2 PUT ADDR IN RW2 03276021 BAL RW0,WRITE2 WRITE GNEQU OR PNEQU 03283021 PUTEEQ CLI GNLIST-NX2,XX0C IS IT A PNEQU 03290021 BE PUTPN YES 03297021 MVI GNLIST-NX1,PAGNDEF NO, SET CODE FOR GNDEF 03304021 LA RW3,DX3 NUMB OF BYTES TO WRITE IN RW 03311021 B PUTEVN BRANCH AROUND SETTINGS 03318021 PUTPN MVC GNLIST-NX1(NX4),PNOUT SET PNDEF, PRIORTY, NUMB 03325021 LA RW3,DX4 03332021 PUTEVN LA RW2,GNLIST-NX1 ADDR OF AREA TO WRITE IN RW2 03339021 XC GNCNT,GNCNT ZEROUT COUNT 03346021 BAL RW0,WRITE3 WRITE DEF ELEMENT 03353021 PUTEXT LM RW1,RW3,PUTSAV+NX12 RESTORE R1 TO R3 FROM REG SAVE ARE 03360021 BCR R15,RETRG AS SAVED BY PUTA OR PUTDEF WHICH A 03367021 * THE ONLY TWO RTNS TO CALL THIS RTN 03374021 SPACE 5 03381021 PNUSED STM RW1,RW3,PNUSAV SAVE REGISTERS 03388021 L RW1,PNUTBA TIB ADDR TO RW1 03395021 L RW1,DX0(RW1) TAMM ADDR TO RW1 03402021 L RW1,DX0(RW1) TABLE ADDR TO RW1 03409021 SR RW2,RW2 ZERO RW2 FOR DIVIDE 03416021 BCTR RW3,RW0 STEP DOWN PN= TO EFFECT COUNTING FR 03423021 D RW2,PNU32 DIVIDE PN= BY 32 03430021 L RW0,PNUX80 PUT HIGH ORDER BIT ONLY IN RW1 03437021 SRL RW0,DX0(RW2) SHIFT AS MANY PLACES AS INDICATED BY 03444021 SLL RW3,DX2 03451021 O RW0,DX0(RW1,RW3) REMAINDER 03458021 ST RW0,DX0(RW1,RW3) SET BIT ON IN TABLE 03465021 LM RW1,RW3,PNUSAV 03472021 BCR UNCOND,RETRG EXIT 03479021 * 03486021 * 03493021 * 03500021 SPACE 5 03507021 READ1 ST RW0,WRITES 03514021 BALR RW0,XRBAS2 BRANCH TO READ ROUTINE 03521021 DC X'02' READ P2 TEXT FROM FILE 2 03528021 L RW1,WRITES 03535021 BCR R15,RW1 RETURN TO CALLER 03542021 *WRITE1 ST RW0,WRITES 03549021 * BALR 0,10 03556021 * DC X'11' 03563021 * L RW1,WRITES 03570021 * BCR 15,RW1 03577021 WRITE2 ST RW0,WRITES 03584021 BALR RW0,XRBAS2 BRANCH TO READ ROUTINE 03591021 DC X'13' WRITE OPTIMIZATION ATXT ON FILE 03598021 OI PH1BYTE,F3TEXT THERE IS OPT A TXT TO WRITE 7707 03605021 L RW1,WRITES 03612021 BCR R15,RW1 RETURN TO CALLER 03619021 WRITE3 ST RW0,WRITES 03626021 BALR RW0,XRBAS2 BRANCH TO READ ROUTINE 03633021 DC X'11' WRITE PROC-A TEXT ON FILE 1 03640021 L RW1,WRITES 03647021 BCR R15,RW1 RETURN TO CALLER 03654021 WRITE4 ST RW0,WRITES 03661021 BALR RW0,XRBAS2 BRANCH TO READ ROUTINE 03668021 DC X'14' WRITE ERROR TEXT ON FILE 4 03675021 L RW1,WRITES 03682021 BCR R15,RW1 RETURN TO CALLER 03689021 EJECT 03696021 *DEL 5189 03703021 *DEL 5189 03710021 *DEL 5189 03717021 *DEL 5189 03724021 *DEL 5189 03731021 *DEL 5189 03738021 *DEL 5189 03745021 *DEL 5189 03752021 *DEL 5189 03759021 *DEL 5189 03766021 *DEL 5189 03773021 *DEL 5189 03780021 *DEL 5189 03787021 *DEL 5189 03794021 *DEL 5189 03801021 *DEL 5189 03808021 *DEL 5189 03815021 *DEL 5189 03822021 *DEL 5189 03829021 *DEL 5189 03836021 *DEL 5189 03843021 *DEL 5189 03850021 *DEL 5189 03857021 *DEL 5189 03864021 *DEL 5189 03871021 *DEL 5189 03878021 *DEL 5189 03885021 *DEL 5189 03892021 *DEL 5189 03899021 *DEL 5189 03906021 *DEL 5189 03913021 *DEL 5189 03920021 *DEL 5189 03927021 *DEL 5189 03934021 *DEL 5189 03941021 *DEL 5189 03948021 *DEL 5189 03955021 *DEL 5189 03962021 *DEL 5189 03969021 *DEL 5189 03976021 *DEL 5189 03983021 *DEL 5189 03990021 *DEL 5189 03997021 *DEL 5189 04004021 *DEL 5189 04011021 *DEL 5189 04018021 *DEL 5189 04025021 *DEL 5189 04032021 *DEL 5189 04039021 *DEL 5189 04046021 *DEL 5189 04053021 *DEL 5189 04060021 *DEL 5189 04067021 *DEL 5189 04074021 *DEL 5189 04081021 *DEL 5189 04088021 *DEL 5189 04095021 *DEL 5189 04102021 *DEL 5189 04109021 *DEL 5189 04116021 *DEL 5189 04123021 *DEL 5189 04130021 *DEL 5189 04137021 *DEL 5189 04144021 *DEL 5189 04151021 *DEL 5189 04158021 *DEL 5189 04165021 *DEL 5189 04172021 *DEL 5189 04179021 *DEL 5189 04186021 *DEL 5189 04193021 *DEL 5189 04200021 *DEL 5189 04207021 *DEL 5189 04214021 *DEL 5189 04221021 *DEL 5189 04228021 *DEL 5189 04235021 *DEL 5189 04242021 *DEL 5189 04249021 *DEL 5189 04256021 *DEL 5189 04263021 *DEL 5189 04270021 *DEL 5189 04277021 *DEL 5189 04284021 *DEL 5189 04291021 *DEL 5189 04298021 *DEL 5189 04305021 *DEL 5189 04312021 *DEL 5189 04319021 *DEL 5189 04326021 *DEL 5189 04333021 *DEL 5189 04340021 *DEL 5189 04347021 *DEL 5189 04354021 *DEL 5189 04361021 *DEL 5189 04368021 *DEL 5189 04375021 *DEL 5189 04382021 *DEL 5189 04389021 *DEL 5189 04396021 *DEL 5189 04403021 *DEL 5189 04410021 *DEL 5189 04417021 *DEL 5189 04424021 *DEL 5189 04431021 *DEL 5189 04438021 *DEL 5189 04445021 *DEL 5189 04452021 *DEL 5189 04459021 *DEL 5189 04466021 *DEL 5189 04473021 *DEL 5189 04480021 *DEL 5189 04487021 *DEL 5189 04494021 *DEL 5189 04501021 *DEL 5189 04508021 *DEL 5189 04515021 *DEL 5189 04522021 *DEL 5189 04529021 *DEL 5189 04536021 *DEL 5189 04543021 *DEL 5189 04550021 *DEL 5189 04557021 *DEL 5189 04564021 *DEL 5189 04571021 *DEL 5189 04578021 *DEL 5189 04585021 *DEL 5189 04592021 *DEL 5189 04599021 *DEL 5189 04606021 *DEL 5189 04613021 *DEL 5189 04620021 *DEL 5189 04627021 *DEL 5189 04634021 *DEL 5189 04641021 *DEL 5189 04648021 *DEL 5189 04655021 *DEL 5189 04662021 *DEL 5189 04669021 *DEL 5189 04676021 *DEL 5189 04683021 *DEL 5189 04690021 *DEL 5189 04697021 *DEL 5189 04704021 *DEL 5189 04711021 *DEL 5189 04718021 *DEL 5189 04725021 *DEL 5189 04732021 *DEL 5189 04739021 ERRPRO EQU * 04746021 STM XR0,XR15,XGSAV8 04753021 *DEL 5189 04760021 *DEL 5189 04767021 *DEL 5189 04774021 *DEL 5189 04781021 *DEL 5189 04788021 ERRPR1 MVC XMSGDF+NX4(LX1),DX0(XRSUB) 04795021 MVC XMSGDF+NX5(LX2),CARDNO SET BUFFER TO BE OUTPUTED 04802021 MVO XMSGDF+NX7(LX1),DX1(LX1,XRSUB) ON FILE 4. 04809021 LA RW2,XMSGDF 04816021 LA RW3,DX8 04823021 BAL RETRG,SEVTST TEST FOR E LEVEL OR ABOVE 04830021 BAL XR0,WRITE4 WRITE MESSAGE 04837021 TM XMSGDF+NX7,XX80 SEVERITY 8... 04844021 BZ ERRPRX NO, CONTINUE PROCESSING 04851021 BC UNCON,EOFIN YES, GO TO EOFIN RTN 04858021 ERRPRX LM XR0,XR15,XGSAV8 04865021 BC UNCOND,DX2(XRSUB) RETURN TO CALLER 04872021 SEVTST ST XR3,GSVR1 04879021 SR XR3,XR3 04886021 IC XR3,DX7(XR2) PICK UP SEVERITY 04893021 SRL XR3,DX4 GET RID OF PHASE NUMBER 04900021 LA XR3,DX1(XR3) ADD 1 TO SEV SINCE LOWEST SEV 04907021 * IS ZERO 04914021 SLL XR3,DX2 04921021 CH XR3,XC012 04928021 BNH SEVT2 SEVERITY NOT HIGHER THAN 12 04935021 LA XR3,DX16 04942021 SEVT2 STC XR3,GSVR1+NX4 04949021 CLC GSVR1+NX4(LX1),ERRSEV 04956021 BNH SEVEXT SEV NOT HIGHER THAN PREVIOUS HI 04963021 MVC ERRSEV(LX1),GSVR1+NX4 SAVE HIGHEST SEVERITY 04970021 SEVEXT L XR3,GSVR1 04977021 BR RETRG RETURN 04984021 EJECT 04991021 SPACE 5 04998021 XLENGH STM XR0,XR15,XGSAV3 05005021 L XRVAR,XSSDB2 05012021 USING XSUDB2,XRVAR 05019021 BC UNCON,XSUDB2 GO TO BRANCH ROUTINE 05026021 DROP XRVAR 05033021 SPACE 10 05040021 *DEL 5189 05047021 *DEL 5189 05054021 *DEL 5189 05061021 *DEL 5189 05068021 *DEL 5189 05075021 *DEL 5189 05082021 *DEL 5189 05089021 *DEL 5189 05096021 *DEL 5189 05103021 *DEL 5189 05110021 *DEL 5189 05117021 LSPRO STM XR0,XR15,XGSAV1 05124021 LR XR3,RW2 05131021 L XRVAR,FPALOD 05138021 USING LSSPRO,XRVAR 05145021 BC UNCON,LSSPRO GO TO SUBSCRIPT ROUTINE 05152021 DROP XRVAR 01041 05159021 LSPR1 DS 0H 37330 05166021 STM XR0,XR15,XGSAV1 37330 05173021 LR XR6,RW1 37330 05180021 L XRVAR,FPALOD 37330 05187021 USING LSSPRO,XRVAR 37330 05194021 B LSSPR1 GENRATE CALLS TO QRTNS 7330 05201021 DROP XRVAR 37330 05208021 SPACE 5 05215021 SPACE 5 05222021 * TEST DOP FOR VLC OR FIXED LENGTH AND SET ATXT BUFFER ACCORDING. 05229021 * 05236021 SETLEN TM DX2(RW3),XX80 VLC... 05243021 BO SETLEN1 YES 05250021 MVI XCON1+NX16,XX02 SET CODE FOR LITERAL 05257021 MVC XCON1+NX14(LX2),DX5(RW3) 05264021 BR XRSUB RETURN 05271021 SETLEN1 MVI XCNTR1,XX04 SET CODE FOR VLC REFERENCE 05278021 MVC XCNTR1+NX1(LX2),DX5(RW3) 05285021 BR XRSUB RETURN 05292021 SPACE 3 05299021 * 05306021 * 05313021 LOADLIT MVI XREG1,XX01 GEN.. L 1,LITERAL OR 05320021 ST RW6,OP1 L 1,INDEX 05327021 B LOAD ( RETRG ALREADY SET UP ) 05334021 SPACE 3 05341021 SPACE 5 05348021 * CHECK IF ALIGNEMENT IS NEEDED . THIS ONLY FOR RX USED WITH A DA 05355021 * NAME 05362021 * 05369021 * 05376021 AXT017 EQU * 05383021 SR RW2,RW2 05390021 IC RW2,OPCOD CHECK OPCOD FOR AN RX 05397021 SRDL RW2,DX4 INSTRUCTION. 05404021 SRL RW3,DX28 05411021 CH RW3,XC000 05418021 BNE AXT020 IF NOT STORE TYPE BRANCH 4771 05425021 OI GBIT2,AXSTORE IT IS A STORE TYPE INSTRUCT 05432021 OI GBIT1,SFPXXX 05439021 CLI OPCOD,XX60 STD. 05446021 BNE AXT019 NO- 05453021 OI GBIT1,DFPXXX YES, 05460021 AXT019 CLI OPCOD,XX40 STH. 05467021 BNE AXT010 NO 05474021 OI GBIT2,XX01 YES- 05481021 AXT010 EQU * 05488021 TM GBIT1,HFWORD+DFPXXX+SFPXXX 05495021 BNZ AXT000 IF 1,4,OR5 BIT ON, SKIP NXT 05502021 TM GBIT2,XX02+AXSTORE 05509021 BZ AXT001 NO ALIGNT. WANTED. 05516021 AXT000 EQU * 05523021 CH RW2,XC004 RR INSTRUCTION -NO ALIGNT. 05530021 BL AXT001 NO ALLIGNMNT,BR TO ATXT GEN 05537021 CH RW2,XC009 05544021 BE AXT012 IT IS STM OR LM. 05551021 BH AXT001 SS INSTRUCTION -NO ALIGNT. 05558021 AXT018 DS 0H 46186 05565021 LTR OPD1,OPD1 VALID POINTER... 46186 05572021 BZ AXT001 NO, LEAVE ROUTINE 46186 05579021 CLI DX0(OPD1),XGDTN 05586021 BNE AXT001 IS IT A BDISP. 05593021 TM DX7(OPD1),SYNCHRO 05600021 BO AXT001 THIS DATA-NAME IS SYNCHRONI 05607021 * 05614021 * 05621021 TM GBIT2,AXSTORE 05628021 BO AXT002 STORE TYPE INSTRUCTION. 05635021 * 05642021 AXT009 MVI OPCOD,XXD2 05649021 * 05656021 * FOR A NON STORE TYPE INSTRUCTION GENERATE : 05663021 * 05670021 * MVC TEMP(L),DN INSTEAD OF THE ORIGINA 05677021 * OP R,TEMP OP R,DN 05684021 * 05691021 * FOR A STORE TYPE GENERATE : 05698021 * 05705021 * ST R,TEMP INSTEAD OF 05712021 * MVC DN,TEMP ST R,DN. 05719021 * 05726021 TM GBIT2,AXSTMLM 05733021 BZ AXT016 FOR STM OR LM PICK UP PRES 05740021 MVC GABS(LX1),XL2+NX1 LENGTH FROM XL2. 05747021 B AXT006 FOR STM OR LM SKIP NXT CODE 05754021 AXT016 MVI GABS,XX01 05761021 TM GBIT2,XX01 05768021 BO AXT005 HALFWORD BOUNDARY WANTED 05775021 MVI GABS,XX03 05782021 TM GBIT1,DFPXXX 05789021 BZ AXT005 NOT DOUBLE FLOATING PT INSTRUCT 05796021 MVI GABS,XX07 05803021 * 05810021 AXT005 CLC TS3MAX(LX2),XC008 05817021 BH AXT006 IF SIZE OF TEMP AREA LRGE SKIP 05824021 MVC TS3MAX(LX2),XC008 05831021 AXT006 LA RW2,GADPAR 05838021 TM GBIT2,AXSTORE STORE TYPE. 05845021 BO AXT007 YES- 05852021 LA RW2,DX4(RW2) 05859021 * 05866021 AXT007 LH RW3,COUNT 05873021 SH RW3,XC005 05880021 BCTR RW3,RW0 SUBTRACT 1 FROM REG 3 05887021 EX RW3,AXTI00 MOVE 05894021 TM GBIT2,AXSTORE 05901021 BO AXT008 MOVES TEMP STOR ATEXT FOR ST TYP 05908021 MVC GADPAR(LX4),AXTC00 SET UP TEMPORARY STORAGE OP 05915021 * 05922021 * 05929021 * 05936021 AXT011 LA RW2,OPCOD-NX1 05943021 LA RW3,DX8(RW3) 05950021 TM GBIT2,AXSTORE 05957021 BO GNOPT6 MAKE BOUNDARY ALLIGNMENT 05964021 BAL XRSUB,PUTA WRITE A-TEXT 05971021 MVC OPCOD(LX2),OTPT+NX3 GENERATE INITIAL OPERATION. 05978021 AXT002 MVC GADPAR(LX4),AXTC00 05985021 LA RW2,OPCOD-NX1 05992021 LA RW3,DX7 05999021 TM GBIT2,AXSTORE 06006021 BZ GNOPT6 MAKE BOUNDARY ALLIGNMENT 06013021 BAL XRSUB,PUTA WRITE A-TEXT 06020021 B AXT009 MAKE ALLIGNMENT 06027021 * 06034021 * 06041021 AXT008 LA RW2,DX1(RW3,RW2) 06048021 MVC DX0(LX4,RW2),AXTC00 06055021 B AXT011 WRITE BOUNDARY ALLIGNMENT A-TXT 06062021 * FOR STM AND LM COMPUTE LENGTH OF TS2 NEEDED. 06069021 * 06076021 * 06083021 AXT012 OI GBIT2,AXSTMLM 06090021 IC RW2,GABS GET REGISTERS NUMBER IN RW2 06097021 SRDL RW2,DX4 RW3 06104021 SRL RW3,DX28 06111021 CR RW3,RW2 06118021 BL AXT013 IF REG 2 GREATER THAN 1 BRANCH 06125021 SR RW3,RW2 06132021 LA RW3,DX1(RW3) 06139021 AXT015 MH RW3,XC004 06146021 CH RW3,TS3MAX 06153021 BNH AXT014 R3 NOT HIGH, DONT NEED MORE TS 06160021 STH RW3,TS3MAX 06167021 AXT014 BCTR RW3,RW0 SUBTRACT 1 FROM REG 3 06174021 STH RW3,XL2 06181021 B AXT018 PROCESS FOR BOUNDARY ALLIGNMENT 06188021 * 06195021 AXT013 LH RW0,XC015 IN CASE R2 IS GREATER THAN R1 06202021 SR RW0,RW2 06209021 AH RW0,XC002 06216021 AR RW3,RW0 06223021 B AXT015 SEE IF MORE TS3 NEEDED 06230021 AXT020 DS 0H 4771 06237021 CH RW2,XC004 IS IT RX 4771 06244021 BNE AXT010 NO NOT RX TYPE 4771 06251021 CH RW3,XC008 AH, CH, LH, MH, AND SH 4771 06258021 BL AXT010 INSTRUCTIONS 4771 06265021 CH RW3,XC012 SHOULD ALL HAVE ONLY 4771 06272021 BH AXT010 A LENGTH OF 2 GENERATED FOR MVC4771 06279021 OI GBIT2,XX01 SO SET GBIT2 IF IT IS A 4771 06286021 B AXT010 HALF-WORD INSTRUCTION 4771 06293021 EJECT 06300021 * FIXED SUBROUTINES ENTRY POINTS 06307021 *=1 FIXED ENTRY POINT SUBROUTINE FOR NON ARITHMETIC VERB (BILL) 06314021 DIDNIN EQU * 06321021 ST XRVAR,SVWJH1 DIDNIN 06328021 L HCOMSR,ADCON1 06335021 BCR UNCOND,HCOMSR GENERATE DN INFO FOR EACH DNM 06342021 DIINFO EQU * 06349021 ST XRVAR,SVWJH2 DIINFO 06356021 L HCOMSR,ADCON2 06363021 BCR UNCOND,HCOMSR BUILD DATA INFO DN PT BY R2 06370021 DITYPE EQU * 06377021 ST XRVAR,SVWJH3 DITYPE 06384021 L HCOMSR,ADCON3 06391021 BCR UNCOND,HCOMSR BUILD DC TYPE FOR DNM 06398021 DILGTH EQU * 06405021 ST XRVAR,SVWJH4 DILGTH 06412021 L HCOMSR,ADCON4 06419021 BCR UNCOND,HCOMSR BUILDS LENGTH OF DCS 06426021 DIBDIS EQU * 06433021 ST XRVAR,SVWJH5 DIBDIS 06440021 L HCOMSR,ADCON5 06447021 BCR UNCOND,HCOMSR GEN TGT POINTER AND DISP ADCONS 06454021 DICOA1 EQU * 06461021 ST XRVAR,SVWJH6 DICOA1 06468021 L HCOMSR,ADCON6 06475021 BCR UNCOND,HCOMSR GET GN FOR GND,PROD BITS,PCS CD 06482021 DICNOP EQU * 06489021 ST XRVAR,SVWJH7 DICNOP 06496021 L HCOMSR,ADCON7 06503021 BCR UNCOND,HCOMSR GENERATE CNOP 06510021 CLSQDP EQU * 06517021 STM RETRG,XRVAR,SVWJHS 06524021 L HCOMSR,ADCONP 06531021 BCR UNCOND,HCOMSR HANDLE 21,30,31 ELEMNT 06538021 * GENERATES BALR'S 06545021 DIBALR EQU * 06552021 LA RW3,DIA1C1 =A(DISPRT-VIRT-TEXT) 06559021 VBALR1 MVI XREG1,XX01 VBALR1 USES DIBALQ, RW3 SET 06566021 VBALR0 EQU * VBALR0 USES DIBALQ, RW3 SET 06573021 ST XRVAR,SVWJH8 DIBALR 06580021 L HCOMSR,ADCON8 06587021 BCR UNCOND,HCOMSR GENERATE BALR A-TEXT 06594021 VBALRE EQU * VBALRE LOOKS LIKE DIBALR 06601021 MVI XREG1,XX0E EXCEP USES 14 RATHER THAN 1 06608021 BC UNCOND,VBALR0 TO COMMON CODING 06615021 DICOA8 EQU * 06622021 ST XRVAR,SVWJH9 DICOA8 06629021 L HCOMSR,ADCON9 06636021 BCR UNCOND,HCOMSR WRITE GN DEF 06643021 CALCLG EQU * 06650021 ST XRVAR,SVWJHA CALCLG 06657021 L HCOMSR,ADCONA 06664021 BCR UNCOND,HCOMSR CALC LEN OF CURRENT DOP 06671021 GETDOP EQU * 06678021 ST XRVAR,SVWJHB GETDOP 06685021 L HCOMSR,ADCONG 06692021 BCR UNCOND,HCOMSR GET NEXT DOP 06699021 NXTSTR EQU * NXTSTQ IS WITHIN GETDOP ROUTINE 06706021 L RW2,ADCONK 15 ALREADY SAVED IN SVWJHB 06713021 BCR UNCOND,RW2 GO TO NXTSTQ 06720021 GETSW EQU * 06727021 ST XRVAR,SVWJHC GETSW 06734021 L HCOMSR,ADCONH 06741021 BCR UNCOND,HCOMSR GET A SWITCH 06748021 DDISPM EQU * 06755021 ST HCOMSR,SVWJHD NOTE ... SVWJHD USED BY DRELAD SR ALS 06762021 L HCOMSR,ADCONN 06769021 BCR UNCOND,HCOMSR ISOLATE DISPLACEMENT IN GMACDC 06776021 DRELAD EQU * 06783021 ST HCOMSR,SVWJHD NOTE ... SVWJHD USED BY DDISPM SR ALS 06790021 L HCOMSR,ADCONI 06797021 BCR UNCOND,HCOMSR SET UP RELAD1 FOR BL REFS 06804021 ADETER EQU * 06811021 TM QRTNSW,MSWON Q-ROUTINES PRECEEDING... 06818021 BCR ONES,RETRG YES, DO NOT GEN A GOBACK 06825021 ST XRVAR,SVWJHH ADETEQ 06832021 L HCOMSR,ADCONM 06839021 BCR UNCOND,HCOMSR BRANCH TO GENERATE GO BACK 06846021 DBLREF ST RW1,SVWJHM SET UP BLREF1 WITH CURRENT ITEM'S 0IKK 06853021 SR RW1,RW1 06860021 IC RW1,DX4(RW2) 06867021 SLL RW1,DX4 0I 06874021 IC RW1,DX6(RW2) KK 06881021 STH RW1,BLREF1 06888021 L RW1,SVWJHM 06895021 BCR UNCOND,RETRG RETURN TO CALLER 06902021 VBADCE MVI XREG1,XX0E 06909021 BC UNCOND,VBADC0 GEN BAL USING REG 14 06916021 VDADC1 MVI XREG1,XX01 06923021 VBADC0 ST RW3,SVWJHL 06930021 ST RETRG,SVWJHL+NX4 06937021 LR RW3,RETRG 06944021 BAL RETRG,VBALR0 BRANCH TO GENERATE BALR 06951021 L RW3,SVWJHL 06958021 L RETRG,SVWJHL+NX4 06965021 BC UNCON,DX4(XRSUB) RETURN TO CALLER 06972021 SPACE 2 42646 06979021 SRRXSA DS 0H 42646 06986021 * 42646 06993021 * ROUTINE ALLOCATES XSA CELLS FOR SORT 42646 07000021 * 42646 07007021 ST HCOMSR,IOSAVE02 SAVE REGISTER 15 42646 07014021 L HCOMSR,IOADCN01 LOAD ADDRESS OF SORTXSA 42646 07021021 BR HCOMSR AND BRANCH 42646 07028021 SPACE 2 42646 07035021 IOQRTN TM DX3(RW2),XX80 ANY Q-ROUTINES REQUIRED... 07042021 BCR ZERO,RETRG NO, LEAVE AT ONCE 07049021 STM RETRG,RW5,SVWJHR STORE REGS 07056021 SR RW3,RW3 R3=0 07063021 IC RW3,DX1(RW2) PICK UP BYTE COUNT OF DOP 07070021 AR RW3,RW2 ADD ADDRESS OF DOP 07077021 SH RW3,XC004 BACK UP OVER DICT PTR 07084021 CLI GANLNO,XX21 IS IT OPEN 07091021 BNE IOQRTN02 NO 07098021 SH RW3,XC010 BACKUP OVER LABEL & ERROR PN'S 07105021 IOQRTN02 DS 0H 07112021 CLC DX1(LX2,RW3),XC000 IS GN FOR ODO ZERO 07119021 BNE IOQRTN01 NO, THERE IS A VALID NUMBER 07126021 LM RETRG,RW5,SVWJHR RESTORE REGS 07133021 BR RETRG RETURN 07140021 IOQRTN01 DS 0H 07147021 L XRVAR,ADCONB 07154021 BCR UNCOND,XRVAR BRANCH TO IOQRTQ 07161021 IOSTBL EQU * GENERATE ST 1,BL FOR ALL BL'S 07168021 * ASSOCIATED WITH FN POINTED TO BY RW2 07175021 * 07182021 STM RETRG,XRVAR,SVWJHE *** USES SAME SAVE CELLS AS IOQ 07189021 L XRVAR,ADCONC 07196021 BCR UNCOND,XRVAR BRANCH TO IOSTBQ 07203021 * 07210021 * DIRECT A-TEXT GENERATION S.R. GATXTV FOR STRINGS PERMITTING 07217021 * CHANGES BY ANALYZERS, GATXTC FOR OTHERS. SEE WRITE-UP 07224021 * AND CALLING SEQ'S WITH CONSTANTS AT LOC... ATXTBV 07231021 GATXTC STM RETRG,RW3,SVGATX 07238021 LA RW2,ATXTBC 07245021 BC UNCOND,GATX01 BRANCH AROUND ENTRY POINT 07252021 GATXTV STM RETRG,RW3,SVGATX 07259021 LA RW2,ATXTBV 07266021 GATX01 AH RW2,DX0(RETRG) 07273021 LH RW3,DX2(RETRG) 07280021 BAL RETRG,GOPT3C PUTS A-TEXT ON FILE 07287021 LM RETRG,RW3,SVGATX 07294021 BC UNCOND,DX4(RETRG) *** LEAVE GENTRY *** 07301021 * 07308021 * THIS ROUTINE CAUSES ANY SUBSCRIPT CALCULATION 07315021 * THAT RESIDE IN OBJECT REGISTERS 07322021 * BE STORED INTO AN OBJECT-TIME TA 07329021 * CVNLIT CONVERT NUM LITS FOR DISPLAY, EXHIBIT, ETC. 07336021 * 07343021 * 07350021 CVNLIT STM RW1,RW5,SVWJHE 07357021 MVI DX20(RW2),XC0 FILL CHAR = 0 07364021 MVI DX21(RW2),XX20 DIG SELECT TO REST OF FIELD 07371021 MVC DX22(LX19,RW2),DX21(RW2) 07378021 SR RW1,RW1 07385021 SR RW3,RW3 07392021 IC RW1,DX1(RW2) (I + D + S + 1)/2 + 2 07399021 * I = NUM OF INTEGERS, D = NUM OF DEC PL'S, S = 0 OR 1 SLACK 07406021 * SO THAT THE SUM I + D + S IS ODD 07413021 SLL RW1,DX1 I + D + S + 5 07420021 SH RW1,XC005 I + D + S 07427021 LR RW4,RW1 SAVE IN RW1 FOR LATER, USE RW4 N 07434021 IC RW3,DX3(RW2) D 07441021 SR RW1,RW3 I + S S = 0 OR 1 07448021 SR RW5,RW5 07455021 IC RW5,DX2(RW2) I 07462021 SR RW5,RW1 -S ( = 0 OR = -1) 07469021 AR RW1,RW2 I + START OF FIELD - 21 07476021 MVI DX21(RW1),XX22 FIELD SEPERATOR 07483021 MVI DX22(RW1),XX21 RESTART SIG 07490021 LTR RW3,RW3 07497021 BC R8,CVNL02 UP COUNT FOR DEC PT ONLY IF NONI 07504021 LA RW4,DX1(RW4) I + D + S + 1 = SIZE, EDIT PATTE 07511021 CVNL02 EX RW4,CVNLM1 ED 20(1,RW2),4(RW2) 07518021 MVI DX20(RW2),XX60 ASSUME MINUS SIGN 07525021 BL CVNL03 EDIT COND CODE TEST -- OUT IF LT 07532021 MVI DX20(RW2),XX4E 07539021 CVNL03 LTR RW5,RW5 IS THERE A SLACK ZERO... 07546021 BC R8,CVNL01 NO 07553021 MVC DX21(DX24,RW2),DX22(RW2) YES, SQUEEZE IT OUT 07560021 BCTR RW4,RW0 LEAVE LOOP 07567021 BCTR RW1,RW0 LEAVE LOOP 07574021 CVNL01 EQU * 07581021 MVC DX21(LX1,RW1),COMMAD+NX1 INSERT DEC PT (OR COMMA) 07588021 CLI DX20(RW2),XX4E 07595021 BC NOTEQ,CVNL04 BRANCH OUT OF LOOP 07602021 BCTR RW4,RW0 GO THROUGH LOOP AGAIN 07609021 MVC DX20(DX24,RW2),DX21(RW2) IF 0 OR POS,ELIM ASS. SIGN 07616021 CVNL04 EQU * 07623021 MVC DX2(DX21,RW2),DX20(RW2) 07630021 LA RW4,DX1(RW4) 07637021 STC RW4,DX1(RW2) SET LENGTH OF AN LIT FORM 07644021 MVI DX0(RW2),MANLIT 07651021 LM RW1,RW5,SVWJHE 07658021 BCR UNCOND,RETRG RETURN TO CALLER 07665021 CVNLM1 ED DX20(LX1,RW2),DX4(RW2) ** EXECUTED INSTRUCTION** 07672021 * ROUTINES TO RESERVE, FREE AND DESTROY REGS 07679021 GFRRES MVI A48CH2,MRESRV 07686021 GFRRE MVI A48CH1,XX0E 07693021 GFRR ST RETRG,SVWJHT 07700021 BAL RETRG,REGMAC GENERATE MACRO CODING 07707021 L RETRG,SVWJHT 07714021 BCR UNCOND,RETRG RETURN TO CALLER 07721021 GFREE MVI A48CH2,MFREE 07728021 BC UNCOND,GFRRE GO TO START MACRO CODING 07735021 GDES14 MVI A48CH2,MDESTR 07742021 BC UNCOND,GFRRE GO TO START MACRO CODING 07749021 GDES15 MVI A48CH2,MDESTR 07756021 MVI A48CH1,XX0F 07763021 BC UNCOND,GFRR GENERATE MACRO CODING 07770021 GFRRESF DS 0H 43113 07777021 MVI A48CH1,XX0F 43113 07784021 MVI A48CH2,MRESRV 43113 07791021 B GFRR RESERVE 15 43113 07798021 GFREF DS 0H 43113 07805021 MVI A48CH1,XX0F 43113 07812021 MVI A48CH2,MFREE 43113 07819021 B GFRR FREE 15 43113 07826021 REGMAC ST RETRG,SVWJHU 07833021 BAL RETRG,GATXTV FREE, 07840021 DC AL2(ATXT48-ATXTBV) RESERVE, 07847021 DC AL2(ZTXT48-ATXT48) DESTROY MACRO 07854021 L RETRG,SVWJHU 07861021 BCR UNCOND,RETRG RETURN TO CALLER 07868021 SETRECFM DS 0H INITIALIZE RECMODE FIELD 07875021 TM DX3(RW2),XX60 07882021 BO MWSTYP SPANNED 07889021 BZ MWVTYP VTYPE RECORDS 07896021 TM DX3(RW2),XX40 07903021 BO MWUTYP U TYPE RECORDS 07910021 MVI RECMODE,FTYPE 07917021 BR RETRG RETURN TO CALLER 07924021 MWVTYP DS 0H 07931021 MVI RECMODE,VTYPE 07938021 BR RETRG RETURN TO CALLER 07945021 MWUTYP DS 0H 07952021 MVI RECMODE,UTYPE 07959021 BR RETRG RETURN TO CALLER 07966021 MWSTYP DS 0H 07973021 MVI RECMODE,STYPE 07980021 BR RETRG RETURN TO CALLER 07987021 INVKEY ST RETRG,DWB 07994021 MVC IOTXTP1(LX2),DOP2+NX1 GN-INV-KEY 08001021 BAL RETRG,GATXTV * L 4,36(2) 08008021 DC AL2(IOTXTP-ATXTBV) * 08015021 DC AL2(IOTXTQ-IOTXTP) * MVC 25(3,4),GN-INVKEY+1 08022021 L RETRG,DWB 08029021 BCR UNCOND,RETRG RETURN TO CALLER 08036021 SPACE 1 58971 08043021 INVCK DS 0H 58971 08050021 SPACE 1 58971 08057021 * 58971 08064021 * THIS ROUTINE CHECKS IF AN INVALID KEY CLAUSE IS PRESENT, AND IN-58971 08071021 * VALIDATES THE LAST ONE IF NOT. 58971 08078021 * 58971 08085021 SPACE 1 58971 08092021 ST RETRG,INVSAVE SAVE RETURN ADDRESS 58971 08099021 BAL RETRG,ISINVK INVALID KEY PRESENT... 58971 08106021 BE ENDINVCK YES, RETURN 58971 08113021 MVC A08CH1(LX1),DOP1+NX5 INSERT DCB NUMBER 58971 08120021 BAL RETRG,GATXTV * L 1,DCBADDR 58971 08127021 DC AL2(ATXT08-ATXTBV) * L 4,36(1) 58971 08134021 DC AL2(ZTXT08-ATXT08) * OI 27(4),X'01' 58971 08141021 CLI DOP3,XX00 SET RETURN CODE NON-ZERO 58971 08148021 ENDINVCK DS 0H 58971 08155021 L RETRG,INVSAVE 58971 08162021 BR RETRG RETURN TO CALLER 58971 08169021 INVSAVE DS 1F SAVE AREA IN INVKEY ROUTINES 58971 08176021 SPACE 2 08183021 * 08190021 * THIS ROUTINE GENERATES CALLS TO BISAM READ/WRITE MODULES, AND 08197021 * TO THE BISAM CHECK MODULE FOLLOWING THE I/O OPERATION. 08204021 * 08211021 SPACE 2 08218021 BISMRDWT DS 0H 08225021 ST RETRG,DWB SAVE RETURN ADDR 08232021 MVI IOTXIB+NX5,XX4C CHECK DISPL IS 76 08239021 BAL RETRG,GATXTV * GENERATE 01372 08246021 DC AL2(IOTXTI-ATXTBV) * READ/WRITE CHECK 01372 08253021 DC AL2(IOTXTJ-IOTXTI) * SEQUENCE 01372 08260021 * 01372 08267021 TM ANALSW,MSWON WRITE... P6232 08274021 BZ BISMRW01 NO P6232 08281021 TM DOP1+NX10,XX08 SRA... P6232 08288021 BO BISMRW01 YES P6232 08295021 BAL RETRG,GATXTC * P6232 08302021 DC AL2(ATXT84-ATXTBC) * ST 5,12(3) RESTORE AREA ADR P6232 08309021 DC AL2(ZTXT84-ATXT84) * FOR WRITE P6232 08316021 BISMRW01 DS 0H P6232 08323021 NI ANALSW,MSWOFF TURN OFF WRITE INDICATION P6232 08330021 MVI IOTXIA+NX5,XX30 RESTORE ORIGINAL 08337021 MVI IOTXIB+NX5,XX34 DISPLACEMENTS 08344021 L RETRG,DWB RESTORE RETURN ADDR 08351021 BR RETRG RETURN TO CALLER 08358021 ANALSW DC X'00' P6232 08365021 SPACE 2 1139 08372021 ENDINVKY ST RETRG,DWB 08379021 MVC IOTXTR1(LX2),DOP3+NX1 GN-NEXT-SENTENCE 08386021 BAL RETRG,GATXTV * OI 27(4),1 08393021 DC AL2(IOTXTR-ATXTBV) * BC 15,GN-NEXT-SENTENCE 08400021 DC AL2(IOTXTS-IOTXTR) * 08407021 L RETRG,DWB 08414021 BCR UNCOND,RETRG RETURN TO CALLER 08421021 * MOVES FOR I/O 08428021 * THIS R OUTIN E GENERATES CODING FOR READ WITH SAME RECORD AREA 08435021 READMOVE DS 0H 08442021 STM RETRG,XRVERB,IOMOVSAV SAVE ALL REGS I/O VERB USES 08449021 LH RW1,DOP1+NX8 MAX RCD LNGTH 08456021 BAL RETRG,SAVEDOPS SAVE DOP1 AND DOP2 08463021 MVC DOP1(LDOP),DOP4 SENDING FIELD FOR MOVE 08470021 MVC DOP2(LDOP),DOP4 RECEIVING FIELD FOR MOVE 08477021 MVC DOP1+NX4(LX3),DUMMYIDK DUMMY UP SENDING FIELD 08484021 NI DOP1+NX7,XXFC AND OFF QRTN BIT 08491021 NI DOP1+NX3,XX0F ZERO OUT MINOR CODE 08498021 OI DOP1+NX3,XX10 INSERT MINOR CODE OF FL GROUP 08505021 STH RW1,DOP1+NX8 MAKE RCD LNGTH = MAX RCD LNGTH 08512021 LA RW2,DOP1 POINT TO DATANAME 08519021 B ALLIOMOV BRANCH AROUND TO COMMON CODE 08526021 * THIS ROUTI NE GENERATES MOVE CODING FOR (RE)WRITE WITH SAME RECORD 08533021 * AREA OR AD VANCING 08540021 WRITMOVE DS 0H 08547021 STM RETRG,XRVERB,IOMOVSAV SAVE ALL REGS I/O VERB USES 08554021 BAL RETRG,SAVEDOPS SAVE DOP1 AND DOP2 08561021 MVC DOP1(LDOP),DOP5 SENDING FIELD FOR MOVE 08568021 MVC DOP2(LDOP),DOP5 RECEIVING FIELD FOR MOVE 08575021 MVC DOP2+NX4(LX3),DUMMYIDK DUMMY UP RECEIVING FIELD 08582021 LA RW2,DOP2 08589021 ALLIOMOV DS 0H 08596021 MVC RDMVBLSV(LX1),DOP1+NX6 INSERT BL NUMBER 58932 08603021 BAL RETRG,CALCLG GET LNGTH OR VLC NO 08610021 B IOMOV4 NOT DIFFERENT 08617021 IOMOV4 TM LENGTH,XX80 VLC NO 08624021 BO IOMOV3 YES 08631021 CLC LENGTH+NX2(LX2),HW4096 IS LNGTH GT 4096 08638021 BH IOMOV3 YES 58932 08645021 MVZ GTEMP(LX1),DOP2+NX3 ISOLATE RCVNG FIELD MINOR 58932 08652021 CLI GTEMP,XX40 VARIABLE LENGTH GROUP... 58932 08659021 BNE IOMOV1 NO 58932 08666021 IOMOV3 DS 0H 08673021 BAL RETRG,INRIOMOV INIT BLREF1, CHNG IDK TO BLL 08680021 MVI XREG1,XX01 08687021 BAL RETRG,STORE * ST 1,BLL NO 08694021 IOMOV1 DS 0H 08701021 OI IOMOVESW,MSWON TURN ON SW FOR IOMOVE 08708021 MVI GANLNO,XX1D MOVE VERB CODE 08715021 L XRVERB,XALAMA ADDRESS OF MOVE ROUTINE 08722021 BR XRVERB BRANCH TO MOVE ROUTINE 08729021 * CONTR OL RE TURNS HERE FROM MOVE ROUTINE 08736021 IORETURN DS 0H 08743021 LM RETRG,XRVERB,IOMOVSAV RESTORE REGISTERS 08750021 NI IOMOVESW,MSWOFF TURN OFF IOMOVE SWITCH 08757021 NI NREADSW,X'FF'-BLLUSED SWITCH OFF 58932 08764021 MVC DOP1(LX50),DOP3+NX6 RESTORE DOP1 08771021 MVC DOP2(LX3),DOP3+NX3 RESTORE DOP2 08778021 BR RETRG RETURN TO CALLER 08785021 * THIS ROUTI NE SAVES DOP1 AND DOP2 IN THE UNUSED PART OF DOP3 08792021 SAVEDOPS DS 0H 08799021 MVC DOP3+NX3(LX3),DOP2 SAVE DOP2 08806021 MVC DOP3+NX6(LX50),DOP1 SAVE DOP1 08813021 BR RETRG RETURN 08820021 INRIOMOV DS 0H 08827021 LH RW3,IOBLLCON LOAD BLL SAVED 08834021 LTR RW3,RW3 IS IT GT ZERO 08841021 BH INRMV1 YES, NOT FIRST TIME THROUGH 08848021 LH RW3,BLLCTR GET LAST USED BLL NO 08855021 LA RW3,DX1(RW3) INCREMENT BY 1 08862021 STH RW3,BLLCTR RESTORE 08869021 STH RW3,IOBLLCON SAVE BLL NO IN IDK FIELD 08876021 INRMV1 DS 0H 08883021 STH RW3,BLREF1 INIT ATXT ELEMENT 08890021 OI NREADSW,BLLUSED INDICATE BLL USED 58932 08897021 STC RW3,RDMVBLSV SAVE BLL NUMBER 58932 08904021 OI BLREF1,XX01 MAKE IT BLL 08911021 MVC DX4(LX3,RW2),BLLIDK INIT DESIRED IDK IN DOP 08918021 BR RETRG RETURN TO CALLER 08925021 IOMOVSAV DS 12F SAVE AREA FOR IOMOVE ROUTINES 08932021 IOMOVESW DC X'00' SW TELLS MOVE TO COME BACK HERE 08939021 BLLIDK DC X'10' INDICATES BLL 08946021 IOBLLCON DC H'0' BLL NUMBER 08953021 DUMMYIDK DC X'300100' DUMMY IDK POINTS TO REGISTER 1 08960021 RDMVBLSV DC XL1'00' SAVE BL OR BLL NUMBER 58932 08967021 NREADSW DC X'00' READ OPTION SWITCH 58932 08974021 READVSON EQU X'01' V/S MODE READ 58932 08981021 SCNDSRA EQU X'02' SECOND SRA MOVE 58932 08988021 BLLUSED EQU X'04' BLL USED, RATHER THAN BL 58932 08995021 DS 0H 09002021 * BSAM... THIS SR GENERATES 09009021 * CALLING SEQUENCES FOR 09016021 * 'BSAMRT', BSAM WRITE AND CLOSE OTSR. 09023021 IOBS07 DS 0H (OPEN ENTRY) 09030021 MVI GTEMP+NX1,XX02 09037021 B IOBS3X BRANCH TO PROCESSING CODING 09044021 IOBS02 DS 0H (CLOSE ENTRY) 09051021 MVI GTEMP+NX1,XX01 09058021 BC UNCOND,IOBS3X BRANCH TO PROCESSING CODING 09065021 IOBS08 DS 0H (CLOSE REEL ENTRY) 09072021 MVI GTEMP+NX1,XX08 09079021 B IOBS3X BRANCH TO PROCESSING CODING 09086021 IOBS01 DS 0H (WRITE ENTRY) 09093021 MVI GTEMP+NX1,XX04 09100021 IOBS3X DS 0H 09107021 STM RETRG,RW3,SVWJHE SAVE REGS 09114021 MVI GTEMP,XX00 09121021 BAL RETRG,WRKLRG DESTROY REGISTERS 09128021 CLI GANLNO,XX21 OPEN... 58971 09135021 BE IOBS03 YES 58971 09142021 CLI GANLNO,XX22 CLOSE/CLOSE REEL... 58971 09149021 BE IOBS03 YES 58971 09156021 BAL RETRG,INVCK INVALID KEY CODED... 58971 09163021 BNE IOBS03 NO 09170021 MVI XREG1,XX01 09177021 MVC XCNTR1+NX2(LX1),DX5(RW2) 09184021 BAL RETRG,LOAD * L 1,DCBADR 09191021 MVI IOTXTP+NX4,XX10 SET REGISTER TO 1 09198021 BAL RETRG,INVKEY GENERATE INVALID KEY CODING 09205021 MVI IOTXTP+NX4,XX20 RESET REGISTER TO 2 09212021 IOBS03 MVC XCNTR1+NX2(LX1),DX7(RW2) 09219021 MVI XCNTR1,XX14 DECB REFERENCE 09226021 BAL RETRG,LOAD * L 0,DECBADR 09233021 * 09240021 OI GTEMP,XX01 ASSUME RELATIVE TRACK 09247021 TM DX6(RW2),XX04 RELATIVE TRACK 09254021 BO IOBS3XA YES 09261021 XI GTEMP,XX03 CHANGE TO RELATIVE BLOCK 09268021 IOBS3XA EQU * 09275021 TM DX6(RW2),XX08 IS A KEY SPECIFIED 09282021 BNO IOBS3Y NO 09289021 OI GTEMP,XX04 YES 09296021 TM DX6(RW2),XX04 IS IT RELATIVE TRACK 09303021 BNO IOBS3Y NO 09310021 MVC IOTXTBB1(LX3),DX11(RW2) KEY IDK 09317021 BAL RETRG,GATXTV *LA 1,ACT.KEY 09324021 DC AL2(IOTXTBB-ATXTBV) X 09331021 DC AL2(IOTXTCC-IOTXTBB) X 09338021 IOBS3Y EQU * 09345021 LA RW3,BSAMVI = BCD TEXT 'BSAMRT ' 09352021 BAL RETRG,VBALRE * L 15,V(BSAMRT) 09359021 * * BALR 14,15 09366021 * 09373021 BAL RETRG,WRKLRX DESTROY 14, 15 09380021 BAL RETRG,SETRECFM INIT RECMODE FIELD 09387021 OI GTEMP+NX1,XX10 ASSUME F 09394021 TM RECMODE,FTYPE 09401021 BO IOBS05 YES 09408021 XI GTEMP+NX1,XX30 ASSUME V 09415021 TM RECMODE,VTYPE 09422021 BO IOBS05 YES 09429021 XI GTEMP+NX1,XX60 ASSUME U 09436021 TM RECMODE,UTYPE 09443021 BO IOBS05 YES 09450021 XI GTEMP+NX1,XXC0 ASSUME SPANNED 09457021 IOBS05 DS 0H 09464021 TM DX10(RW2),XX02 ARE USER LABELS USED 09471021 BNO IOBS05A NO 09478021 OI GTEMP,XX08 YES SET ON BIT 09485021 IOBS05A DS 0H 09492021 MVC GMACDC+NX1(LX2),GTEMP MOVE CODE TO ATXT FIELD 09499021 MVI GMACDC,XX02 LENGTH OF CODE IS 2 09506021 MVI GMCTYP,MDC 09513021 BAL RETRG,MACRO * BC 0,NN NN = CODE 09520021 LM RETRG,RW3,SVWJHE 09527021 BCR UNCOND,RETRG RETURN TO CALLER 09534021 WRKLRG EQU * KILL SS TBL + DESTROY REG 14, 15. 09541021 WRKLRX ST RETRG,SVWJHQ KILL 14,15 BUT NOT SUB 09548021 WRKLR1 EQU * 09555021 BAL RETRG,GDES14 DESTROY 14 09562021 BAL RETRG,GDES15 DESTROY 15 09569021 L RETRG,SVWJHQ 09576021 BCR UNCOND,RETRG RETURN TO CALLER 09583021 ISINVK CLI DOP3,MRGN TEST IF INV KEY PRESENT 09590021 BCR NOTEQ,RETRG RETURN WITH CON CODE = 0 IF YES 09597021 CLC DOP2(LX3),DOP3 09604021 BC EQ,ISINVK1 FORCE TO NONZERO IF EQUAL 09611021 CLI DOP3,MRGN FORCE COND CODE TO 0 09618021 BCR R15,RETRG RETURN TO CALLER 09625021 ISINVK1 EQU * 09632021 CLI DOP3,XX00 FORCE COND CODE TO NON-ZERO 09639021 BCR R15,RETRG RETURN TO CALLER 09646021 INCRKEY DS 0H THIS SUBRTN RETURNS IDK OF 09653021 * SYMBOLIC PART OF ACTUAL KEY 09660021 STM RETRG,XRVAR,SVWJHR SAVE REGISTERS 09667021 MVC GTEMP(LX3),DX11(RW2) MOVE IDK OF ACT.KEY 09674021 NI GTEMP,XX0F AND OUT I FIELD 09681021 LH RETRG,GTEMP LOAD D FIELD 09688021 LA RETRG,DX4(RETRG) ADD 4 09695021 CH RETRG,HW4096 09702021 BL INCR1 BRANCH AROUND IF GT 4096 09709021 SH RETRG,HW4096 SUBTRACT 4096 09716021 SR XRVAR,XRVAR 09723021 IC XRVAR,DX13(RW2) K FIELD(BL NUMBER) 09730021 LA XRVAR,DX1(XRVAR) INCREMENT BY 1 09737021 STC XRVAR,GTEMP+NX2 RESTORE 09744021 INCR1 DS 0H 09751021 STH RETRG,GTEMP RESTORE D FIELD 09758021 MVZ GTEMP(LX1),DX11(RW2) MOVE I FIELD 09765021 LM RETRG,XRVAR,SVWJHR RESTORE REGISTERS 09772021 BR RETRG RETURN TO CALLER 09779021 BDAMDW EQU * 09786021 ST RETRG,DWB 09793021 BAL RETRG,INCRKEY GET IDK OF ACT.KEY+4 09800021 MVC IOTXTCC1(LX3),GTEMP 09807021 MVC IOTXTCC2(LX3),DOP1+NX11 IDK 09814021 BAL RETRG,GATXTV * LA 1,ACT-KEY+4 09821021 DC AL2(IOTXTCC-ATXTBV) * ST 1,20(3) 09828021 DC AL2(IOTXTDD-IOTXTCC) * MVC 28(4,3),ACT-KEY 09835021 L RETRG,DWB 09842021 BR RETRG RETURN TO CALLER 09849021 * 09856021 * DIWTOR 09863021 * GENERATE WTOR AND WAIT EXPANSIONS... 09870021 * IF RW2 = 0 IF RW2 NOT = 0 09877021 * --------------------------- ---------------------- 09884021 * MVC PARAM=5,LIT (SAME) 09891021 * (NONE) LA 2,DN 09898021 * LA 1,PARAM=1 (SAME) 09905021 * XC 0(16,1),0(1) (SAME) 09912021 * ST 1,8(1) (SAME) 09919021 * LA 1,1(1) (SAME) 09926021 * ST 1,3(1) ST 2,3(1) ( 09933021 * LA 1,3(1) (SAME) 09940021 * MVI 0(1),1 MVI 0(1),LENGTH=DN ( 09947021 * MVI 9(1),28 (SAME) 09954021 * MVI 10(1),X'80' (SAME) 09961021 * SVC 35 (SAME) 09968021 * LA 1,PARAM=1 (SAME) 09975021 * LA 0,1 (SAME) 09982021 * SVC 1 (SAME) 09989021 * 09996021 DIWTOR EQU * 10003021 ST RETRG,SVWJHN 10010021 BAL RETRG,WRKLRG DESTROY REGISTERS 10017021 TM DIWOSW,MSWON IS IT STOP LITERAL 10024021 BO DIWTOR1 YES 10031021 MVC DOP3(LX26),DIWTC1 AWAITING REPLY CONSTANT 10038021 DIWTOR1 DS 0H 10045021 SR RETRG,RETRG 10052021 IC RETRG,DOP3+NX1 PICK UP COUNT 10059021 LA RETRG,DOP3+NX2(RETRG) ADDR OF END OF TEXT 10066021 MVC DX0(LX4,RETRG),MSGCDERP MCS CODE FOR WTOR 10073021 IC RETRG,DOP3+NX1 PICK UP COUNT 10080021 LA RETRG,DX4(RETRG) 10087021 STC RETRG,DOP3+NX1 10094021 STC RETRG,XL1+NX1 10101021 STC RETRG,A67CH3 10108021 LA RETRG,DOP3 10115021 ST RETRG,OP1 10122021 MVI XCNTR1,XX1C 10129021 MVI XCNTR1+NX2,XX05 10136021 BAL RETRG,MVC * MVC PARAM=5,LIT 10143021 CH RW2,GZERO RW2 = 0 10150021 BC EQ,DIWTR1 YES, GO SET UP FOR 1-CHAR REPLY 10157021 ST RW2,OP1 10164021 MVI XREG1,XX02 10171021 BAL RETRG,LA * LA 2,DN 10178021 BAL RETRG,CALCLG FIND LENGTH OF DN 10185021 NOP DX0(RW0) NULL OPERATION 10192021 MVC A67CH2(LX1),LENGTH+NX3 10199021 BC UNCOND,DIWTR2 BRANCH AROUND LA INSTR 10206021 DIWTR1 MVI A67CH2,XX01 10213021 BAL RETRG,GATXTC LA 2,WORKCELL=1 10220021 DC AL2(ATXT89-ATXTBC) * 10227021 DC AL2(ZTXT89-ATXT89) * 10234021 DIWTR2 BAL RETRG,GATXTV CODING GENERATED AS OUTLINED 10241021 DC AL2(ATXT67-ATXTBV) IN HEADING 10248021 DC AL2(ZTXT67-ATXT67) ABOVE 10255021 SR RETRG,RETRG ALTERNATE MESSAGE CASE, 10262021 IC RETRG,DOP3+NX1 OBTAIN ACTUAL PARAM LENGT 10269021 BC UNCOND,DIWTR6 BRANCH AROUND OTHER WTO CODING 10276021 * 10283021 * GEN A WTO 'TEXT IN DOP3...' 10290021 * 10297021 DIWTO EQU * 10304021 ST RETRG,SVWJHN 10311021 BAL RETRG,WRKLRG KILL ALL REG'S 10318021 SR RETRG,RETRG 10325021 STC RETRG,DOP2+NX122 10332021 IC RETRG,DOP3+NX1 10339021 LA RETRG,DX4(RETRG) 10346021 STC RETRG,DOP2+NX123 10353021 MVI DOP2+NX120,MANLIT 10360021 LA RETRG,DX8(RETRG) 10367021 STC RETRG,XL1+NX1 10374021 STC RETRG,DOP2+NX121 RESULT IS... 10381021 IC RETRG,DOP3+NX1 10388021 LA RETRG,DOP3+NX2(RETRG) ADDR END OF MSG 10395021 MVC DX0(LX4,RETRG),MSGCDE MCSCODE FIELD 10402021 * *DOP2... *DOP3... 10409021 XC DOP3(LX2),DOP3 '...34LL00NN0000XXXX...'LL=NN+4 10416021 OI DOP3,XX80 MCSFLAG 10423021 LA RETRG,DOP2+NX120 10430021 ST RETRG,OP1 10437021 MVI XCNTR1,XX1C 10444021 MVI XCNTR1+NX2,XX01 10451021 BAL RETRG,MVC * MVC PARAM=1(L),='NN00TEXT. 10458021 MVI ATXT25+NX4,XX1C INIT ATXT ELEMENT 10465021 MVI A25CH1,XX23 * LA 1,PARAM=1 10472021 BAL RETRG,GATXTV * SVC 35 10479021 DC AL2(ATXT25-ATXTBV) * 10486021 DC AL2(ZTXT25-ATXT25) * 10493021 MVI ATXT25+NX4,XX40 INIT ATXT ELEMENT 10500021 SR RETRG,RETRG 10507021 IC RETRG,DOP2+NX121 10514021 DIWTR6 LA RETRG,DX23(RETRG) ALLOW FOR BASE OF WTO, WTOR 10521021 SRL RETRG,DX2 10528021 CH RETRG,PARMAX 10535021 BC NOTHI,DIWTO1 DONT CHANGE PARMAX 10542021 STH RETRG,PARMAX 10549021 DIWTO1 L RETRG,SVWJHN 10556021 BCR UNCOND,RETRG *** LEAVE DIWTO, DIWTOR 10563021 TITLE ' A-TEXT GENERATOR' 10570021 IKF503 CSECT 10577021 COMON3 EQU * 10584021 * 10591021 *=1 A TEXT GENERATOR 10598021 ******************************************************************* 10605021 * 10612021 * A TEXT GENERATOR 10619021 * 10626021 ******************************************************************* 10633021 * THE A TEXT GENERATOR IS USED BY THE DIFFERENT ANALYZERS 10640021 * 10647021 * THERE ARE VARIOUS ENTRY POINTS TO THE A TEXT GENERATOR 10654021 * 10661021 * THE ENTRY POINT TO BE USED IS DETERMINED BY THE 10668021 * OBJECT INSTRUCTION DESIRED 10675021 * 10682021 * THE LINKAGE TO THE A TEXT GENERATOR IS 10689021 * BAL RETRG,THE PARTICULAR ENTRY POINT 10696021 * 10703021 * THE FOLLOWING WILL DESCRIBE HOW THE WORK AREAS ARE TO BE USED 10710021 * 10717021 * XL1 AND XL2 ARE NEEDED FOR SS TYPE INSTRUCTIONS 10724021 * IF THERE IS ONLY ONE LENGTH PUT IN XL1 10731021 * 10738021 * XWC1 AND XWC2 ARE EACH TWO BYTES LONG 10745021 * IF WE ARE IN A BINARY MODE THE LENGTH IS PUT IN A THIRD BYTE 10752021 * 10759021 * THE FOLLOWING ELEMENTS EACH HAVE TWO DATA AREAS 10766021 * XWC,BDISP,TALLY,XGN,XPN,XCON 10773021 * DATA AREA 1 IS USED IF IT IS THE FIRST ADDRESS OPERAN 10780021 * DATA AREA 2 IS USED IF IT IS THE SECND ADDRESS OPERAN 10787021 * 10794021 * FOR DATA NAMES,ALL LITERALS,FIG CONS POINTERS ARE USED 10801021 * THE POINTERS ARE PUT IN OP1,OP2 AS THEY ARE NEEDED 10808021 * 10815021 ******************************************************************* 10822021 ******************************************************************* 10829021 LOAD MVI OPCOD,XX18 LR OP CODE =18 CHANGED IF L OR LH OR 10836021 GHIBYT STM GR1,GR15,GSVRG 10843021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 10850021 CLC XL2(LX2),GZERO 10857021 BC NOTEQ,GDOSSD BRANCH IF DECIMAL SS CODE 10864021 CLC XWC1(GCNLN2),GZERO 10871021 BC NOTEQ,GSETRX BRANCH IF RX TYPE INSTRUCTION 10878021 C OPD1,GZERO 10885021 BC EQ,SETRR BRANCH IF RR TYPE INSTRUCTION 10892021 GSETRX MVI GBIT1,XXA0 SET BIT FOR HALFWORD WANTED + CONV NUM 10899021 CLI XXREG,XX00 10906021 BC NOTEQ,GFKRG IF INDEX BR TO MOVE REGNO 10913021 BC UNCOND,SETRX GEN RX TYPE OF INSTRUCTION 10920021 SUB MVI OPCOD,XX1B SR OP CODE=1B CHANGED IF S OR SH OR S 10927021 BC UNCOND,GHIBYT GENERATE FORMATTED ATXT 10934021 LPRBI MVI OPCOD,XX10 LPR=10 ST OR STH WILL CHANGE HI ORDE 10941021 STORE EQU LPRBI 10948021 BC UNCOND,GHIBYT GENERATE FORMATTED ATXT 10955021 SETRR1 STM GR1,GR15,GSVRG 10962021 LM OPD1,OPD3,OP1 LD REGS WITH OPND POINTERS 3 WITH GA 10969021 SETRR MVC GABS(LX1),XREG2 GET LO 4 BITS OF OPERAND2 INTO LO 4BIT 10976021 MVO GABS(LX1),XREG1(LX1) LO FOUR BITS INTO HIGH FOUR BITS AB 10983021 BC UNCOND,GNOPT2 GENERATE OUTPUT 10990021 SETRX2 XI OPCOD,XX40 PUT 5 IN OPCOD (1 ALREADY THERE) 10997021 BC UNCOND,SETRX1 HALFWORD NOT WANTED 11004021 SETRX0 STM GR1,GR15,GSVRG 11011021 LM OPD1,OPD3,OP1 LD REGS WITH OPND POINTERS 3 WITH GA 11018021 MVC GABS(LX1),XXREG 11025021 SETRX1 MVI GBIT1,XX00 HALFWORD NOT WANTED 2 ADDRESSES NOT W 11032021 SETRX MVO GABS(LX1),XREG1(LX1) LO 4 BITS INTO HI 4 BITS 11039021 GCHKOP C OPD2,GZERO 11046021 BC NOTEQ,GCKOP2 BRANCH IF OPD2 NOT 0 MUST BE TWO POIN 11053021 GCKOP3 CLC XWC1(LX2),GZERO 11060021 BC NOTEQ,GWC BRANCH IF WC TEMPORARY STORAGE 11067021 CLC BDISP1(LX2),GZERO 11074021 BC NOTEQ,GBDISP BRANCH IF BDISP 11081021 CLC XGN1(LX2),GZERO 11088021 BC NOTEQ,GGN BRANCH IF GENERATED NAME 11095021 CLC XPN1(LX4),GZERO 11102021 BC NOTEQ,GPN BRANCH IF PROCEDURE NAME 11109021 CLC XVN1(LX4),GZERO 11116021 BC NOTEQ,GVN BRANCH IF VARIED NAME 11123021 CLC GDEBG1(LX2),GZERO 11130021 BC NOTEQ,GDEBUG BRANCH IF GTREF1 11137021 CLI XCON1+NX16,XX00 11144021 BC NOTEQ,GCON BRANCH IF CONSTANT(OTHER THAN LITERALS 11151021 * OR FIG CON,SPECIAL FOR ANALYZERS) 11158021 CLI XCON1,XX00 11165021 BC NOTEQ,GDCDEF BRANCH IF DECDEF 11172021 CLC XCNTR1(LX3),GZERO 11179021 BC NOTEQ,GCNTR BRANCH IF GTREF2 11186021 CLC BLREF1(LX2),GZERO 11193021 BC NOTEQ,GBLREF BRANCH IF BLREF 11200021 CLC VIRTC1+NX2(LX2),GZERO 11207021 BC NOTEQ,GVIRT BRANCH IF VIRTUAL 11214021 CLI GVIRT1,XX00 BCDREF USED GVIRT1+2 NOT VIRTC1+2 11221021 BC NOTEQ,GBCDRF BRANCH IF BCDREF 11228021 CLI TALLY1,XX00 11235021 BC NOTEQ,GTALLY BRANCH IF TALLY 11242021 CLC RELAD1(LX4),GZERO 11249021 BC NOTEQ,GRLADR BRANCH IF REL ADR POINTER IF LITERA 11256021 GCKOP2 CLI DX0(OPD1),XX30 11263021 BC EQ,GDN BRANCH IF DATA NAME 11270021 CLI DX0(OPD1),XX36 INDEX-NAME 11277021 BE ATXSET1 YES 11284021 CLI DX0(OPD1),XX34 11291021 BC EQ,GALLIT BRANCH IF ALPHA LITERAL 11298021 CLI DX0(OPD1),XX32 11305021 BC EQ,GNUMLT BRANCH IF NUMERIC LITERAL 11312021 CLI DX0(OPD1),XX33 11319021 BC EQ,GFLTLT BRANCH IF FLOATING POINT LITERAL 11326021 CLI DX0(OPD1),XX75 11333021 BC EQ,GFGCON BRANCH IF FIGURATIVE CONSTANT 11340021 CLI DX0(OPD1),XXFA 11347021 BC EQ,GGTRF2 BRANCH IF GTREF2 11354021 CLI DX0(OPD1),XXF9 11361021 BC EQ,GGTRF1 BRANCH IF GTREF1 11368021 CLI DX0(OPD1),XSTDTN 11375021 BE GTALLY BRANCH IF A TALLY POINTER 11382021 B GBDISP SET UP BDISP FOR ATEXT 11389021 COMPLG MVI OPCOD,XX15 CLR OP CODE IS 15 CHANGED IF CL,OR CL 11396021 GHIBT1 STM GR1,GR15,GSVRG 11403021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 11410021 CLC XL1(LX2),GZERO 11417021 BC NOTEQ,SETLSS BRANCH IF LOGICAL SS TYPE INSTRUCTION 11424021 CLC XWC1(GCNLN2),GZERO 11431021 BC NOTEQ,GSTRX2 BRANCH IF RX TYPE INSTRUCTION 11438021 C OPD1,GZERO 11445021 BC EQ,SETRR BRANCH IF RR TYPE INSTRUCTION 11452021 GSTRX2 CLI XXREG,XX00 11459021 BC NOTEQ,GFKRG2 GENERATE RX TYPE INSTRUCTION 11466021 BC UNCOND,SETRX2 GENERATE RX REG TYPE INSTRUC 11473021 MVC MVI OPCOD,XX12 MVC LO ORDER OF OP FIELD IS 2 11480021 GFXLSS STM GR1,GR15,GSVRG 11487021 LM OPD1,OPD3,OP1 LD REG WITH OPND PTRS 3 WITH GADPAR 11494021 SETLSS MVI GBIT1,XX40 SET BIT FOR SS TYPE 2 ADDRESSES WANT 11501021 XI OPCOD,XXC0 PUT D IN HI ORDER (1 ALREADY THERE) 11508021 LH GXRA,XL1 11515021 BCTR GXRA,RW0 SUBTRACT 1 FROM LENGTH 11522021 STC GXRA,GABS 11529021 STC GXRA,XL1 11536021 BC UNCOND,GCHKOP GENERATE SS INSTR CODE 11543021 ATXSET1 MVI DX0(OPD3),XX64 11550021 MVI DX1(OPD3),INCODE 11557021 MVC DX2(LX2,OPD3),DX3(OPD1) 11564021 LA OPD3,DX4(OPD3) 11571021 MVI DX0(OPD3),XXB4 MOVE XREF FOR INDX-NM 38953 11578021 MVC DX1(LX3,OPD3),DX7(OPD1) ELT TO OUTPUT 38953 11585021 LA OPD3,DX4(OPD3) INCR AREA PTR 38953 11592021 TM GBIT1,HFWORD 11599021 BZ GADNUM IF ADD1 COMPLT BR FOR 2ND SS ADD 11606021 XI OPCOD,XX40 PUT 5 IN HI ORDER,1ALREADY THERE 11613021 B GADNUM COMPLETE ATXT 11620021 GDN CLC DX4(LX3,OPD1),XTALLV+NX4 11627021 BC EQ,GTALLY BRANCH IF TALLY 11634021 TM XDIDK(OPD1),SPREG IS THIS DN A 'SPECIAL REG'... 11641021 BO SPREG1 YES, CHANGE TO BDISP ELEMENT 11648021 CLC DX4(LX3,OPD1),XC000 11655021 BNE MOVE16 IF IDK FIELD NOT ZERO BRANCH 11662021 MVC AXTC01+NX2(LX2),XC001 11669021 MVC DX0(LX4,OPD3),AXTC01 IN CASE OF A FAKE ALPHN.DN 11676021 LA OPD3,DX4(OPD3) FROM THE MOVE VERB -REPLACE 11683021 XR OPD1,OPD1 DN BY TS2 . 11690021 B GADNUM GET ADDRESS FOR ATXT 11697021 MOVE16 EQU * 11704021 TM GBIT1,HFWORD 11711021 * 11718021 BZ GNOLGN CONTINUE 11725021 TM GBIT2,XX01 11732021 BC ONES,GHALF BRANCH IF HALFWORD ENTRY POINT 11739021 CLI DX9(OPD1),XX04 11746021 BC NOTHI,GHALF BRANCH IF HALFWORD INSTRUCTION 11753021 XI OPCOD,XX40 PUT 5 IN HIGH ORDER (1 ALREADY THERE) 11760021 B GNOLGN CONTINUE 11767021 GHALF XI OPCOD,XX50 PUT 4 IN HIGH ORDER (1 ALREADY THERE) 11774021 GNOLGN MVI DX0(OPD3),XX78 11781021 MVC DX1(LX3,OPD3),DX4(OPD1) MOVE ADDRESS PARAMS TO BYTE AFTE 11788021 SR GXRA,GXRA 11795021 IC GXRA,DX1(OPD1) GET 11802021 BCTR GXRA,RW0 DATA NAME 11809021 LA GXRA,DX0(GXRA,OPD1) INTERNAL 11816021 MVC DX4(LX3,OPD3),DX0(GXRA) IDENTIFIER 11823021 LA OPD3,DX7(OPD3) 11830021 GADNUM TM GBIT1,GAD1DN ADDRESS1 DONE 11837021 BC ONES,GPLUS2 BRANCH IF YES. 11844021 CLC PLUS1(LX3),GZERO IS THERE A PLUS ELEMENT 11851021 BC NOTEQ,GPLUS1 BRANCH IF PLUS 11858021 GDOAGN TM GBIT1,TWOADR ARE THERE 2 ADDRESSES (SS INSTRUCTION) 11865021 BC ZERO,GNOTPT BRANCH IF THERE ARE NOT 2 ADDRESSES 11872021 OI GBIT1,GAD1DN 1'ST ADR IS NOW COMPLETED 11879021 C OPD2,GZERO 11886021 BC NOTEQ,GCNGAD BRANCH IF THERE WERE 2 ADDRESS PTRS 11893021 MVC XWC1(GCNLN2),XWC2 CHANGE ALL ADDRESS TWOS TO ADR ONES 11900021 BC UNCOND,GCKOP3 GENERATE ATXT FOR 2ND ADDRESS 11907021 * SPECIAL REGISTER PROCESSING 11914021 SPREG1 EQU * PROCESS SPECIAL REGISTERA 11921021 CLI DX6(OPD1),XGBINR TEST FOR VALID USE 11928021 BL SPRERR INVALID. PUT ERROR MSG 11935021 BE SPREG2 SORT-RETURN IS HALF WORD 11942021 CLI DX6(OPD1),XX10 TEST FOR VALID USE 11949021 BH SPRERR INVALID 11956021 BE SPREG2 RETURN-CODE IS HALF WORD 11963021 SPREG3 EQU * 11970021 SR RW1,RW1 11977021 IC RW1,DX6(OPD1) PICK UP UNIQUE SPEC REG IDENTIF 11984021 SH RW1,XC011 11991021 SLL RW1,DX1 USE AS INDEX TO BASE AND DISPL 11998021 LA RW2,SPREGC TABLE 12005021 AR RW2,RW1 12012021 MVC BDISP1(LX2),DX0(RW2) CHANGE REFERENCE TO BDISP 12019021 B GBDISP PROCESS AS BDISP 12026021 SPREG2 TM OPCOD,XXC0 SS INSTRUCTION... 12033021 BO SPREG3 YES 12040021 OI GBIT1,HFWORD INDICATE HALFWORD INSTR NEEDED 12047021 OI GBIT2,XX01 12054021 B SPREG3 PICK UP BASE DISP FOR ATXT 12061021 SPRERR BAL RETRG,ERRPRO PUT MSG-INVALID USE OF SPEC REG 12068021 DC AL1(ERRN15) 12075021 DC AL1(2) E-LEVEL 12082021 LA RETRG,PH5CTL SET RETURN REG TO PH5 CONTROL SO 12089021 ST RETRG,GSVRG+NX56 THIS STATEMENT WILL BE IGNORED 12096021 B AXT102 REINITIAL. ATXT GEN FOR NEXT USE 12103021 GCNGAD LR OPD1,OPD2 12110021 BC UNCOND,GCKOP2 GENERATE ATXT FOR SPEC REG 12117021 GPLUS2 CLC PLUS2(LX3),GZERO 12124021 BC EQ,GNOTPT BRANCH IF PLUS2 IS ZERO 12131021 C OPD1,GZERO DOES ADRPLUS APPLY... 12138021 BC EQ,GPLUSA NO 12145021 CLC XWC2(ADRPLX),GZERO 12152021 BC NOTEQ,GPLUSA NO 12159021 CLC XVN2(ADRPLY),GZERO 12166021 BC NOTEQ,GPLUSA NO 12173021 CLI DX0(OPD1),MDN 12180021 BC NOTEQ,GPLUSA NO 12187021 MVC GTEMP(LX1),DX4(OPD1) 12194021 NI GTEMP,XX70 ELIM SUBSCRIPT AND TALLY 12201021 CLI GTEMP,XX60 12208021 BC EQ,GPLUSA NO 12215021 CLI GTEMP,XX30 12222021 BC NOTEQ,GPLUSB YES 12229021 GPLUSA EQU * 12236021 MVI DX0(OPD3),XX80 SET UP PLUS ELEMENT 12243021 MVC DX1(LX3,OPD3),PLUS2 FOR A TEXT OUTPUT 12250021 LA OPD3,DX4(OPD3) INCREMENT POINTER 12257021 BC UNCOND,GNOTPT COMPLT AND WRITE ATXT IF 1 ADD 12264021 GPLUS1 C OPD1,GZERO DOES ADRPLUS APPLY... 12271021 BC EQ,GPLUSC NO 12278021 CLC XWC1(ADRPLX),GZERO 12285021 BC NOTEQ,GPLUSC NO, OPD1 IS FOR ADDR2 12292021 CLC XVN1(ADRPLY),GZERO 12299021 BC NOTEQ,GPLUSC NO 12306021 CLI DX0(OPD1),MDN 12313021 BC NOTEQ,GPLUSC NO 12320021 MVC GTEMP(LX1),DX4(OPD1) 12327021 NI GTEMP,XX70 12334021 CLI GTEMP,XX60 12341021 BC EQ,GPLUSC NO 12348021 CLI GTEMP,XX30 12355021 BC NOTEQ,GPLUSD YES 12362021 GPLUSC MVI DX0(OPD3),XX80 SET UP PLUS A-TEXT HEADER 12369021 MVC DX1(LX3,OPD3),PLUS1 ELEMENT FOR A TEXT OUTPUT 12376021 LA OPD3,DX4(OPD3) INCREMENT POINTER 12383021 BC UNCOND,GDOAGN GET NXT DNM AND GENERATE ATXT 12390021 GPLUSB LA RETRG,PLUS2 SET UP PLUS 2 POINTERS 12397021 LA XRVAR,GNOTPT 12404021 BC UNCOND,GPLUSZ SKIP NXT TO PT TO PLUS2 POINTER 12411021 GPLUSD LA RETRG,PLUS1 SET UP PLUS 1 POINTERS 12418021 LA XRVAR,GDOAGN 12425021 GPLUSZ SH OPD3,XC007 CONVERT ADR ELEMENT TO ADRPLUS E 12432021 MVI DX0(OPD3),XXA4 ADRPLUS HEADER 12439021 MVC DX7(LX3,OPD3),DX0(RETRG) MOVE IN PLUS VALUE 12446021 MVC GTEMP+NX1(LX3),DX0(RETRG) 12453021 MVI GTEMP,XX00 12460021 STM RW0,RW2,SVWJHQ 12467021 L RW1,GTEMP PLUS VALUE 12474021 MVC GTEMP(LX2),DX4(OPD1) 12481021 NI GTEMP,XX0F 12488021 AH RW1,GTEMP DDD + PLUS 12495021 SR RW2,RW2 12502021 IC RW2,DX6(OPD1) KK (BL NUMBER) 12509021 SR RW0,RW0 12516021 D RW0,FW4096 (DDDD+PLUS) / 4096 = Q + R 12523021 AR RW2,RW1 UP BL BY Q 12530021 STC RW2,DX3(OPD3) KK 12537021 STH RW0,GTEMP R REPLACES DDD 12544021 NI DX1(OPD3),XXF0 12551021 OC DX1(LX1,OPD3),GTEMP 12558021 MVC DX2(LX1,OPD3),GTEMP+NX1 12565021 LA OPD3,DX10(OPD3) 12572021 LM RW0,RW2,SVWJHQ 12579021 BCR UNCOND,XRVAR BRANCHES TO COMPLETE ATXT 12586021 GDCDEF MVI DX0(OPD3),XX6C 12593021 SR GXRA,GXRA 12600021 IC GXRA,XCON1 12607021 EX GXRA,GDC1 MOVE 12614021 LA OPD3,DX2(GXRA,OPD3) 12621021 BC UNCOND,GNOTPT COMPLT ATXT FOR 1 ADDRESS 12628021 GCNTR MVI DX0(OPD3),XX64 SET UP GTREF2 12635021 MVC DX1(LX3,OPD3),XCNTR1 12642021 TM GBIT1,HFWORD 12649021 BC ZERO,GADD4 INCREM PTR AND GEN ATXT FOR DNM 12656021 CLI XCNTR1,XX04 VLC 12663021 BC EQ,GCNTR2 GEN ST INSTRUC FOR VLC 12670021 CLI XCNTR1,XX34 VLC-OUT-OF-LINE 12677021 BC NOTEQ,GCNTR1 GEN STH FOR DNM 12684021 MVI DX1(OPD3),XX38 12691021 BC EQ,GCNTR2 IF VLC-OUT-OF-LINE GEN ST INSTR 12698021 GCNTR1 XI OPCOD,XX40 12705021 BC UNCOND,GADD4 INCREM PTR AND GEN ATXT FOR DNM 12712021 GCNTR2 XI OPCOD,XX50 12719021 BC UNCOND,GADD4 INCREM PTR AND GEN ATXT FOR DNM 12726021 * VIRTUALS 12733021 GVIRT LA RW2,VIRTC1 12740021 LA RW3,DX12 12747021 BAL RETRG,PUTVIR DEFINE NEW VIRTUAL 12754021 MVI DX0(OPD3),XX58 VIR REF 12761021 MVC DX1(LX2,OPD3),VIRTC1+NX2 12768021 TM GBIT1,HFWORD 12775021 BC ZERO,GADD3 GENERATE ATXT FOR DNM 12782021 XI OPCOD,XX40 FULL WORD INSTRUCTION 12789021 BC UNCOND,GADD3 GENERATE ATXT FOR DNM 12796021 GBLREF MVI DX0(OPD3),XX5C SET UP 12803021 MVC DX1(LX2,OPD3),BLREF1 BLREF 12810021 BC UNCOND,GGN1 ELEMENT FOR A TEXT OUTPUT 12817021 GBCDRF MVI DX0(OPD3),XX7C SET UP 12824021 MVI DX1(OPD3),XX08 BCDREF 12831021 MVC DX2(LX8,OPD3),GVIRT1 ELEMENT 12838021 LA OPD3,DX10(OPD3) INCREMENT POINTER 12845021 BC UNCOND,GADNUM GENERATE ATXT FOR DNM 12852021 GRLADR CLI RELAD1,XX2C 12859021 BC NOTEQ,GFNRAD BRANCH IF NOT LITERAL REL ADR 12866021 OI GBIT2,XX80 HAVE REL ADR 12873021 BC UNCOND,GCKOP2 LOOK FOR DUPS AND GENERATE ATXT 12880021 GRELIT MVC RELAD1+NX2(LX2),LTLCTR SET LITERAL ID NUMB 12887021 GFNRAD TM RELAD1+NX1,XXFE TEST ALL BITS EXCEPT BIT1 12894021 BC NOTEQ,GFNRA NO, BRANCH 12901021 MVI DX0(OPD3),XXB0 SETUP CALLING SEQ.DISP.ELEM 12908021 BC UNCOND,GFNR12 SKIP NEXT 2 INSTR 12915021 GFNRA CLI RELAD1+NX1,XX02 TEST IF SS=2 MEANS DICT PTR ELEME 12922021 BC EQ,CSDIPT BRANCH IF SS=2 12929021 MVI DX0(OPD3),XX84 12936021 GFNR12 MVC DX1(LX4,OPD3),RELAD1 SAVE 12943021 LA OPD3,DX5(OPD3) INCREMENT POINTER 12950021 BC UNCOND,GADNUM GENERATE ATXT FOR DNM 12957021 CSDIPT CLI RELAD1,XX80 XREF ELE... 12964021 BNE CDIPT1 NO 12971021 MVI DX0(OPD3),FREF SET XREF CODE 12978021 B CDIPT2 MOVE DICTRY POINTER INTO ELEM 12985021 CDIPT1 MVI DX0(OPD3),XXB4 12992021 CDIPT2 MVC DX1(LX3,OPD3),RELAD1+NX2 MOVE DICT PTR INTO ELEMENT 12999021 BC UNCOND,GADD4 INCREM PTR AND GEN ATXT FOR DNM 13006021 GWC TM GBIT1,HFWORD 13013021 BC ZERO,GNOLN2 BRANCH IF HALFWORD TEST NOT WANTED 13020021 CLI XWC1+NX2,XX02 13027021 BC NOTHI,GHALF2 BRANCH IF HALFWORD 13034021 XI OPCOD,XX40 PUT 5 IN HI ORDER (1 THERE ALREADY) 13041021 BC UNCOND,GNOLN2 SET UP TS ELEM FOR ATXT OUTPUT 13048021 GHALF2 XI OPCOD,XX50 PUT 4 IN HI ORDER (1 THERE ALREADY) 13055021 GNOLN2 MVI DX0(OPD3),XX64 SET UP WC ELEMENT FOR A TEXT OUTPUT 13062021 MVI DX1(OPD3),XX24 TEMPORARY STORAGE 13069021 LH GXRA,XWC1 13076021 SH GXRA,GSEVEN 13083021 STH GXRA,XWC1 13090021 MVC DX2(LX2,OPD3),XWC1 13097021 GADD4 LA OPD3,DX4(OPD3) INCREMENT POINTER 13104021 BC UNCOND,GADNUM GENERATE ATXT FOR DNM 13111021 * CONSTANTS 13118021 GCON TM GBIT2,XX40 13125021 BC ONES,GDCDEF PUT OUT DC DEF IN ATXT 13132021 CLI XCON1+NX16,XX02 13139021 BC HI,GCON3 TEST FURTHER FOR TYPE OF CONST 13146021 BC EQ,GCON4 TEST FURTHER FOR TYPE DNM ATXT 13153021 GCON5 MVI DX1(OPD3),XX01 HEX NO BOUNDARY REQ 13160021 GCON6 SR RETRG,RETRG 13167021 IC RETRG,XCON1+NX16 13174021 SH RETRG,GSXTEN 13181021 LCR RETRG,RETRG 13188021 IC GXRA,XCON1+NX16 13195021 LA RETRG,XCON1(RETRG) 13202021 EX GXRA,GCONMV MOVE 13209021 BC UNCOND,GFNCON GENERATE LITERAL ELEMT ATXT 13216021 GCON3 CLI XCON1+NX16,XX04 13223021 BC HI,GCON7 TEST FURTHER FOR TYPE DNM ATXT 13230021 BC EQ,GCON8 TEST FURTHER FOR TYPE DNM ATXT 13237021 BC UNCOND,GCON5 GEN LIT ELEM ATXT HEX,NO ALLIGN 13244021 GCON4 TM GBIT1,HFWORD 13251021 BC ZERO,GCON44 NO,TEST FOR BINARY INSTRUCTION 13258021 XI OPCOD,XX50 13265021 GCON44 TM GBIT1,XXA0 BINARY INSTRUCTION 13272021 BC ZERO,GCON45 GEN LIT ELEM ATXT HEX,NO ALLIGN 13279021 MVI DX1(OPD3),XX41 HEX HFWORD BNDRY 13286021 BC UNCOND,GCON6 GEN ATXT WITH HFWORD ALLIGNMNT 13293021 GCON45 MVI DX1(OPD3),XX01 HEX NO BNDRY 13300021 BC UNCOND,GCON6 GEN LIT ELEM ATXT 13307021 GCON7 CLI XCON1+NX16,XX08 13314021 BC NOTEQ,GCON5 GEN ATXT WITHOUT ALLIGNMNT 13321021 TM GBIT1,XX18 FLOATING POINT 13328021 BC XNOEQ,GCON72 GEN ATXT WITH DBL WD BOUNDRY 13335021 TM GBIT1,XXA0 L BINARY 13342021 BC NOTZER,GCON8 TEST FURTHER 13349021 TM GBIT2,XX02 13356021 BC ONES,GCON8A GEN ATXT WITH FULL WD BOUNDRY 13363021 BC UNCOND,GCON45 GEN ATXT WITHOUT BNDRY ALLIGN 13370021 GCON72 MVI DX1(OPD3),XXC1 HEX DBL WORD BNDRY 13377021 BC UNCOND,GCON6 GEN ATXT FOR CONSTANT 13384021 GCON8 TM GBIT1,HFWORD 13391021 BC ZERO,GCON88 NOT A HALFWD INSTRUCTION 13398021 XI OPCOD,XX40 13405021 GCON88 TM OPCOD,XX50 RX TYPE INSTRUCTION... 13412021 BC NOTONE,GCON89 NO 13419021 TM OPCOD,XXA0 13426021 BC ZERO,GCON8A YES, REQUIRES WORD BOUNDARY 13433021 GCON89 TM GBIT1,XXB8 BINARY OR FLOATING POINT 13440021 BC ZERO,GCON45 GEN ATXT WITHOUT BNDRY ALLIGN 13447021 GCON8A MVI DX1(OPD3),XX81 HEX FULL WORD BOUNDARY 13454021 BC UNCOND,GCON6 GEN ATXT FOR CONSTANT 13461021 GBDISP MVI DX0(OPD3),XX70 SET UP 13468021 MVC DX1(LX2,OPD3),BDISP1 BDISP ELEMENT 13475021 BC UNCOND,GGN1 FOR A TEXT OUTPUT 13482021 * GN'S, PN'S, VN'S 13489021 GGN MVI DX0(OPD3),XX50 SET UP 13496021 MVC DX1(LX2,OPD3),XGN1 GN ELEMENT 13503021 GGN1 TM GBIT1,HFWORD 13510021 BC ZERO,GADD3 GEN ATXT FOR DATA NAME 13517021 TM GBIT2,XX01 13524021 BC ZERO,GGN2 BRANCH IF NOT HALFWORD 13531021 XI OPCOD,XX50 PUT 4 IN HI ORDER 13538021 BC UNCOND,GADD3 GEN ATXT FOR DNM 13545021 GGN2 XI OPCOD,XX40 PUT 5 IN HI ORDER 13552021 GADD3 CLI DX0(OPD3),PAPNREF CHECK FOR PN AND VN REFS WHICH 13559021 BE GADD4 HAVE EXTRA BYTE 13566021 CLI DX0(OPD3),PAVNREF 13573021 BE GADD4 INCREM PTR AND GEN ATXT FOR DNM 13580021 LA OPD3,DX3(OPD3) INCREMENT POINTER 13587021 B GADNUM GENERATE ATXT FOR DNM 13594021 GPN MVI DX0(OPD3),PAPNREF SET UP PN ELEMENT 13601021 MVC DX1(LX3,OPD3),XPN1+NX1 13608021 LH RW3,XPN1+NX2 SET BIT ON IN PNUTBL 13615021 BAL RETRG,PNUSED SET BIT ON IN TBL FOR PNUSED 13622021 BC UNCOND,GGN1 COMPLT ATXT AND WRITE OUT 13629021 GVN MVI DX0(OPD3),PAVNREF SET UP VN 13636021 MVC DX1(LX3,OPD3),XVN1+NX1 ELEMENT 13643021 BC UNCOND,GGN1 COMPLT ATXT AND WRITE OUT 13650021 GDEBUG MVI DX0(OPD3),XX60 GTREF1 13657021 MVC DX1(LX2,OPD3),GDEBG1 13664021 BC UNCOND,GGN1 COMPLT ATXT AND WRITE OUT 13671021 GGTRF1 MVC GDEBG1(LX2),DX1(OPD1) GTREF1 13678021 BC UNCOND,GDEBUG GEN GTREF FOR DEBUG 13685021 GGTRF2 MVC XCNTR1(LX3),DX1(OPD1) GTREF2 13692021 BC UNCOND,GCNTR ELEMENT 13699021 GTALLY TM GBIT1,HFWORD 13706021 BC ZERO,GNOLN3 BRANCH IF HALFWORD NOT WANTED 13713021 XI OPCOD,XX40 PUT 5 IN HIGH ORDER (1 ALREADY THERE) 13720021 GNOLN3 MVI DX0(OPD3),XX60 SET UP TALLY 13727021 MVI DX1(OPD3),XX06 13734021 MVI DX2(OPD3),XX00 13741021 BC UNCOND,GADD3 GEN ATXT FOR DNM 13748021 GALLIT MVI DX1(OPD3),XX10 CONST IS BCD NO BOUNDARY REQUIREMENT 13755021 SR GXRA,GXRA 13762021 IC GXRA,DX1(OPD1) 13769021 BCTR GXRA,RW0 SUBTRACT ONE FROM GXRA 13776021 EX GXRA,CHNGL1 INSERT LENGTH OF LITERAL 13783021 LA GXRA,DX1(GXRA) 13790021 BC UNCOND,GFNCON GEN LITERAL ATXT 13797021 GFLTLT TM GBIT1,DBLFPT 13804021 BC ZERO,GSGLFP GEN SINGLE FLOATING PT ATXT LIT 13811021 MVI DX1(OPD3),XXE0 DOUBLE PRECISION FLOATING POINT CONST 13818021 LA GXRA,DX7 13825021 BC UNCOND,GFNFPT MOVE LIT TO OUTPUT AND GEN ATXT 13832021 GSGLFP MVI DX1(OPD3),XXA0 SINGLE PRECISION FLOATING POINT CONST 13839021 LA GXRA,DX3 13846021 GFNFPT EX GXRA,CHNGL1 MOVE FLTNG PT LIT TO OUTPUT AREA 13853021 LA GXRA,DX1(GXRA) 13860021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 13867021 * FIGCONS 13874021 GFGCON CLI DX1(OPD1),XXF0 13881021 BC NOTEQ,GFGCLN BRANCH IF FIGCON IS NOT ZERO 13888021 TM GBIT1,DECBIN 13895021 BC ONES,GFGCNB BRANCH IF FIGCON IS IN BINARY MODE 13902021 TM GBIT1,DECOP 13909021 BC ONES,GFGCND BRANCH IF FIGCON IS IN DECIMAL MODE 13916021 TM GBIT1,XX18 13923021 BC ONES,GFCNFP BRANCH IF FIGCON IS IN FLOATING POINT 13930021 GFGCLN MVI DX1(OPD3),XX10 CONST IS BCD NO BOUNDARY REQUIREMENT 13937021 MVC DX3(LX1,OPD3),DX1(OPD1) BCD FIG CON 13944021 SR GXRA,GXRA 13951021 TM GBIT1,TWOADR FIGCON EXTERNAL DEC 13958021 BC ZERO,GEXDC1 BRANCH IF THERE ARE NOT TWO ADDRESSES 13965021 TM GBIT1,GAD1DN 13972021 BC ZERO,GEXDC2 BRANCH IF 1ST ADR IS NOT COMPLETED 13979021 TM GBIT1,DECOP 13986021 BC ZERO,GEXDC2 BRANCH IF THERE ARE NOT 2 LENGTH FIELD 13993021 LH GXRA,XL2 14000021 CH GXRA,XC001 14007021 GEXDC4 BC HI,GEXDC3 IF MORE THAN LEN01,ZERO FLD 14014021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14021021 GEXDC3 SH GXRA,GTWO 14028021 EX GXRA,CHNGL4 MOVE OTHER BCD ZEROES 14035021 LA GXRA,DX2(GXRA) 14042021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14049021 GEXDC1 TM GBIT2,XX80 14056021 BC ONES,GEXDC7 BRANCH IF RELADR LGN EQUALS 1 14063021 GEXDC2 IC GXRA,XL1 XL1 ALREADY DECREMENTED 14070021 LA GXRA,DX1(GXRA) 14077021 CLI XL1,XX00 14084021 BC UNCOND,GEXDC4 PROP ZEROS IF NEC AND GEN ATXT 14091021 GFCNFP TM GBIT1,DBLFPT 14098021 BC ZERO,GFLPT1 BRANCH IF NOT DBL PRECISION 14105021 LA GXRA,DX7 14112021 MVI DX1(OPD3),XXE0 FLOATING PT DBL WD BOUNDARY 14119021 BC UNCOND,GFLPT2 GEN DBLWD FLOATING PT LITDEF 14126021 GFLPT1 LA GXRA,DX3 14133021 MVI DX1(OPD3),XXA0 FLOATING PT FULL WD BNDRY 14140021 GFLPT2 EX GXRA,CHNGL5 MOVE FLOATING PT ZERO 14147021 LA GXRA,DX1(GXRA) 14154021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14161021 GFGCND MVI DX3(OPD3),XX0F ID ZERO 14168021 MVI DX1(OPD3),XX04 ID CONST NO BOUNDARY REQUIREMENT 14175021 GEXDC7 LA GXRA,DX1 14182021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14189021 GFGCNB TM GBIT1,HFWORD 14196021 BC ZERO,GBI1 BRANCH IF HFWORD NOT WANTED 14203021 XI OPCOD,XX40 PUT 5 IN HI ORDER (1 ALREADY THERE) 14210021 GBI1 MVC DX3(LX4,OPD3),GZERO FULL WD BINARY ZERO 14217021 MVI DX1(OPD3),XX88 BINARY FULL WORD BOUNDARY CONSTANT 14224021 LA GXRA,DX4 14231021 GFNCON MVI DX0(OPD3),XX04 LTL ELEMENT 14238021 TM MADCSW,MSWON LIT POINTED TO BY AN ADCON... 14245021 BC ZERO,GFNCO1 NO 14252021 MVI DX0(OPD3),XX10 YES,CHANGE TO 10 (DSPLTL ELEMEN 14259021 NI MADCSW,MSWOFF RESET ADCON LIT SW 14266021 GFNCO1 EQU * 14273021 ST OPD3,GLTSAV 14280021 STC GXRA,GHFWD+NX1 14287021 MVC DX2(LX1,OPD3),GHFWD+NX1 LENGTH 14294021 LA OPD3,DX3(OPD3) 14301021 AH OPD3,GHFWD 14308021 S OPD3,GLTSAV 14315021 L RW2,GLTSAV 14322021 LR RW3,OPD3 14329021 BAL RETRG,PUTLTL UP LIT CNTR AND PUT ATXT OPTIM 14336021 L OPD3,GLTSAV 14343021 TM GBIT2,XX80 14350021 BO GRELIT LITERAL 14357021 MVI DX0(OPD3),XX68 LTL ELEMENT 14364021 MVC DX1(LX2,OPD3),LTLCTR SET LIT ID NUMBER 14371021 LA OPD3,DX3(OPD3) 14378021 BC UNCOND,GADNUM GEN ATXT ADD FOR DNM 14385021 * 14392021 GNUMLT SR GXRA,GXRA 14399021 IC GXRA,DX1(OPD1) 14406021 SH GXRA,GTHREE 14413021 TM GBIT1,DECBIN 14420021 BC ONES,GBILIT IF BINARY INSTRUCTION, BRANCH 14427021 MVI DX1(OPD3),XX04 INT DEC NO BOUNDARY REQUIREMENT 14434021 EX GXRA,CHNGL2 MOVE ACTUAL LITERAL 14441021 LA GXRA,DX1(GXRA) 14448021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14455021 GBILIT CLI DX1(OPD1),XX07 14462021 BC NOTHI,GBILT7 IF LITERAL LESS THAN 7 BYTS,BR 14469021 LA RETRG,GBILT8 14476021 BC UNCOND,GBILT2 IF LITERAL MORE THAN 6 BYTS,BR 14483021 GBILT7 EX GXRA,GZAP ZAP 14490021 CVB GRX1,GTEMP FROM ID TO BIN 14497021 EX GXRA,GBICHG COMPARE 14504021 BL GBIFUL IF GT MAX BIN HW VALUE GEN FWD 14511021 BC EQ,GBIHAF IF EQ MAX HWD VAL GEN HALFWD 14518021 EX GXRA,GBICG2 COMPARE 14525021 BC HI,GBIFUL IF LT MIN BIN HWD VAL GEN FLWD 14532021 GBIHAF TM GBIT1,HFWORD 14539021 BC ZERO,GBIHF2 IF NOT DBL FLPT,SKIP NXT 14546021 XI OPCOD,XX50 PUT 4 IN HI ORDER (1 ALREADY THERE) 14553021 GBIHF2 MVI DX1(OPD3),XX48 BINARY HALFWORD CONSTANT 14560021 STH GRX1,GFLWD 14567021 MVC DX3(LX2,OPD3),GFLWD 14574021 LA GXRA,DX2 14581021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14588021 GBIFUL TM GBIT1,HFWORD 14595021 BC ZERO,GBIFL2 IF NOT DBL FLPT SKIP NXT 14602021 XI OPCOD,XX40 PUT FIVE IN HI ORDER (1 ALREADY THERE) 14609021 GBIFL2 MVI DX1(OPD3),XX88 BINARY FULLWORD CONSTANT 14616021 ST GRX1,GFLWD 14623021 MVC DX3(LX4,OPD3),GFLWD 14630021 LA GXRA,DX4 14637021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14644021 GJOHN STM GRY,GR15,GSVRG 14651021 LA GXRA,DX9 14658021 LR OPD1,GRX1 14665021 S OPD1,GFOUR 14672021 BAL RETRG,GBILT2 CONVERT DNM TO BINARY 14679021 LM GRY,GR15,GSVRG 14686021 BCR UNCOND,RETRG RETURN TO CALLER 14693021 GBILT2 AR OPD1,GXRA CONVERT 14700021 ZAP GTEMP(LX8),DX0(LX5,OPD1) 14707021 CVB GRX,GTEMP 6 TO 10 BYTES 14714021 SRDA GRX,DX32 ID TO 14721021 MVN GTEMP+NX7(LX1),DX4(OPD1) SET SIGN IN CASE OF 9 TRAILING 14728021 SR OPD1,GXRA 14735021 SH GXRA,GFIVE BINARY 14742021 EX GXRA,GMOVE MVO 14749021 CVB GRY1,GTEMP 14756021 M GRY,TENPW9 14763021 ALR GRX1,GRY1 14770021 BC R12,GBILT3 BRANCH IF NO CARRY 14777021 AH GRX,XC001 14784021 GBILT3 AR GRX,GRY 14791021 BCR UNCOND,RETRG RETURN TO CALLER 14798021 GBILT8 LA GXRA,DX5(GXRA) 14805021 EX GXRA,GBILT4 COMPARE 14812021 BC LO,GBIL64 IF GR THAN MAX FULLWD,GEN DBLWD 14819021 BC HI,GBILT5 IF LT MAX FULLWD, TEST FURTHER 14826021 GBIL64 MVI DX1(OPD3),XXC8 BINARY DOUBLE WORD CONSTANT 14833021 TM GBIT1,HFWORD 14840021 BC ZERO,GBI64 IF NOT DBL FLPT SKIP NXT 14847021 XI OPCOD,XX40 PUT 5 IN HI ORDER (1 ALREADY THERE) 14854021 GBI64 LA GXRA,DX8 14861021 ST GRX,GFLWD 14868021 MVC DX3(LX4,OPD3),GFLWD 14875021 ST GRX1,GFLWD 14882021 MVC DX7(LX4,OPD3),GFLWD 14889021 BC UNCOND,GFNCON GEN LITERAL DEF ATXT 14896021 GBILT5 EX GXRA,GBILT6 COMPARE 14903021 BC HI,GBIL64 IF LT MIN FLWD VAL,GEN DBLWD 14910021 BC UNCOND,GBIFUL OTHERWISE, GEN FULLWORD 14917021 * 14924021 GNOPT7 LA RW2,OPCOD 14931021 BC UNCOND,GNOPT8 GENERATE ATXT FOR MACRO 14938021 GNOTPT LA GXRA,GADPAR 14945021 SR OPD3,GXRA 14952021 LA OPD3,DX5(OPD3) 14959021 STH OPD3,COUNT 14966021 ST GXRA,OP3 14973021 TM GBIT2,XX40 14980021 BC ONES,GNOP04 BR TO NEXT EX INSTR 14987021 BCTR OPD3,RW0 SUBTRACT 1 FROM REG6. 14994021 GNOP04 EX OPD3,CHNGL9 MOVE 15001021 GNOPT4 EQU * 15008021 GNOPT9 STM RW1,RW3,GCOSAV 15015021 L RW1,COSADR 15022021 TM GBIT2,XX40 15029021 BC ONES,GNOPT7 FOR MACRO BRANCH 15036021 * 15043021 B AXT017 CHECK TYPE OF INSTRUC AND ALLIGN 15050021 AXT001 EQU * 15057021 LA RW2,OPCOD-NX1 15064021 GNOPT8 LH RW3,COUNT 15071021 TM GBIT2,XX40 15078021 BC ONES,GNOPT5 IF MACRO SUBTRACT 3 FROM COUNT 15085021 SH RW3,GTWO 15092021 GNOPT6 BAL RETRG,PUTA WRITE OUT ATEXT 15099021 TM GBIT2,XX04 15106021 BZ AXT102 FINISH P2TXT,RESTOR REGS,RETURN 15113021 XI GBIT2,XX04 15120021 L OPD3,OP3 15127021 MVI OPCOD,XXD2 MOVE TEMP TO TS2. 15134021 MVI GABS,XX03 SET LENGTH. 15141021 TM GBIT2,XX01 15148021 BZ AXT103 IF NOT HFWD INSTRUC,BR FOR FLWD 15155021 MVI GABS,XX01 15162021 AXT104 MVC DX0(LX4,OPD3),AXTC01 FIRST OPERAND OF MOVE. 15169021 LA OPD3,DX4(OPD3) 15176021 CLC PLUS1(LX3),GZERO TAKE CARE OF PLUS ELEMENT I 15183021 BNE AXT105 ANY. 15190021 MVI DX0(OPD3),XX80 15197021 MVC DX1(LX3,OPD3),PLUS1 15204021 LA OPD3,DX4(OPD3) 15211021 * 15218021 AXT105 MVC DX0(LX4,OPD3),AXTC02 2ND OPERAND OF MOVE 15225021 LA OPD3,DX4(OPD3) 15232021 B GNOTPT FILL IN MORE ATXT 15239021 * 15246021 AXT103 CLI OTPT+NX3,XX90 STM 15253021 BNE AXT104 NO 15260021 MVI GABS,XX07 YES,SET LENGTH TO8. 15267021 B AXT104 FILL IN OPERANDS FOR ATXT 15274021 AXT102 EQU * 15281021 XC OP1(LX8),OP1 15288021 MVI XL1,XX00 15295021 MVC XL1+NX1(GCNLGN),XL1 15302021 MVI GABS,XX00 15309021 MVC COUNT(LX2),GFIVE 15316021 MVI OPCOD-NX1,XX48 15323021 LM GR1,GR15,GSVRG 15330021 BCR UNCOND,RETRG FIN P2TXT ELM,RESTR REGS,RETURN 15337021 GNOPT5 SH RW3,GTHREE 15344021 BC UNCOND,GNOPT6 WRITE MACRO ATXT 15351021 GNOPT2 MVC OTPT(LX5),COUNT 15358021 BC UNCOND,GNOPT4 GEN INSTRUC AND WRITE ATXT 15365021 GNOPT3 MVC OTPT(LX5),GLGNCN 15372021 STM RETRG,RW3,PUTSAV 15379021 LA RW2,GLGNCN+NX2 15386021 B PUTDF4 BR TO PUTDEF 15393021 GOPT3C EQU PUTA 15400021 BCR UNCOND,RETRG RETURN TO CALLER 15407021 * INSTRUCTION ENTRY POINTS 15414021 ADD MVI OPCOD,XX1A AR OP CODE=1A CHANGED IF A OR AH OR A 15421021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15428021 ADDLBI MVI OPCOD,XX1E ALR OP CODE=1E CHANGED IF AL 15435021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15442021 SUBLBI MVI OPCOD,XX1F SLR OP CODE=1F CHANGED IF SL 15449021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15456021 COMP MVI OPCOD,XX19 CR OP CODE=19 CHANGED IF C OR CH OR 15463021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15470021 MULT MVI OPCOD,XX1C MR OP CODE=1C CHANGED IF M OR MH OR M 15477021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15484021 DIV MVI OPCOD,XX1D DR OP CODE=1D CHANGED IF D OR DP 15491021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15498021 LTRBI MVI OPCOD,XX12 LTR OP CODE=12 CHANGED IF PACK 15505021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15512021 LNRBI MVI OPCOD,XX11 LNR OP CODE=11 CHANGED IF MVO 15519021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15526021 LCRBI MVI OPCOD,XX13 LCR OP CODE=13 CHANGED IF UNPACK 15533021 BC UNCOND,GHIBYT GEN ATXT FOR INSTRUC 15540021 CVBBI MVI OPCOD,XX4F CVB OP CODE=4F 15547021 BC UNCOND,SETRX0 GEN ATXT FOR RX INSTRUC 15554021 CVDBI MVI OPCOD,XX4E CVD OP CODE=4E 15561021 MVI GBIT1,XX20 WANT TO CONVERT NUMLIT TO BINARY IF AN 15568021 STM GR1,GR15,GSVRG 15575021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPA 15582021 BC UNCOND,SETRX GEN ATXT FOR RX INSTRUC 15589021 ORLG MVI OPCOD,XX16 OR OP=16 CHANGE IF O,OR OC 15596021 BC UNCOND,GHIBT1 GEN ATXT FOR LOGICL INSTRUC 15603021 EXORLG MVI OPCOD,XX17 XR OP=17 CHANGE IF X,OR XC 15610021 BC UNCOND,GHIBT1 GEN ATXT FOR LOGICL INSTRUC 15617021 ANDLG MVI OPCOD,XX14 NR OP=14 CHANGE IF N,OR NC 15624021 BC UNCOND,GHIBT1 GEN ATXT FOR LOGICL INSTRUC 15631021 MVN MVI OPCOD,XX11 MVN LO ORDER OP FIELD=1 15638021 BC UNCOND,GFXLSS GEN ATXT FOR LOGICL SS INSTRUC 15645021 MVI MVI OPCOD,XX92 MVI OP CODE =92 15652021 BC UNCOND,GHIBT4 GEN ATXT FOR SI INSTRUC 15659021 CLI MVI OPCOD,XX95 CLI OP CODE=95 15666021 BC UNCOND,GHIBT4 GEN ATXT FOR SI INSTRUC 15673021 OI MVI OPCOD,XX96 OI OP CODE=96 15680021 BC UNCOND,GHIBT4 GEN ATXT FOR SI INSTRUC 15687021 XI MVI OPCOD,XX97 XI OP CODE=97 15694021 BC UNCOND,GHIBT4 GEN ATXT FOR SI INSTRUC 15701021 NI MVI OPCOD,XX94 NI OP CODE=94 15708021 BC UNCOND,GHIBT4 GENERATE ATXT FOR SI INSTRUC 15715021 TM MVI OPCOD,XX91 TM OP CODE=91 15722021 GHIBT4 STM GR1,GR15,GSVRG 15729021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 15736021 MVC GABS(LX1),IMM 15743021 MVI GBIT1,XX00 15750021 BC UNCOND,GCHKOP GEN ATXT FOR RX OPERAND2 15757021 GDOSSD XI OPCOD,XXE0 PUT F IN HI ORDER (1 ALREADY THERE) 15764021 MVI GBIT1,XX44 SET BIT FOR 2 ADR AND DEC OP 15771021 LH GXRA,XL2 SUBTRACT 15778021 BCTR GXRA,RW0 ONE FROM LENGTH2 15785021 STC GXRA,GABS AND STORE IN HI 4 BITS OF GABS 15792021 LH GXRA,XL1 SUBTRACT 15799021 BCTR GXRA,RW0 ONE FROM LENGTH1 15806021 STC GXRA,XL1 AND STORE IN 15813021 MVO GABS(LX1),XL1(LX1) HI 4 BITS OF GABS 15820021 BC UNCOND,GCHKOP GEN ATXT FOR SS OPERANDS 15827021 * 15834021 MVZ MVI OPCOD,XX13 MVZ OP CODE=D3 15841021 BC UNCOND,GFXLSS GEN ATXT FOR LOGICL SS INSTRUC 15848021 TR MVI OPCOD,XX1C TR OP CODE=DC 15855021 BC UNCOND,GFXLSS GEN ATXT FOR LOGICL SS INSTRUC 15862021 TRT MVI OPCOD,XX1D TRT OP CODE=DD 15869021 BC UNCOND,GFXLSS GEN ATXT FOR LOGICL SS INSTRUC 15876021 EDIT MVI OPCOD,XX1E ED OP CODE=DE 15883021 BC UNCOND,GFXLSS GEN ATXT FOR LOGICL SS INSTRUC 15890021 EDMARK MVI OPCOD,XX1F EDMK OP CODE=DF 15897021 BC UNCOND,GFXLSS GEN ATXT FOR LOGICL SS INSTRUC 15904021 LHALF OI GBIT2,XX01 15911021 BC UNCOND,LOAD GEN ATXT FOR LH INSTRUC 15918021 STHALF OI GBIT2,XX01 15925021 BC UNCOND,STORE GEN ATXT FOR STH INSTRUC 15932021 SHALF OI GBIT2,XX01 15939021 BC UNCOND,SUB GEN ATXT FOR SH INSTRUC 15946021 MHALF OI GBIT2,XX01 15953021 BC UNCOND,MULT GEN ATXT FOR MH INSTRUC 15960021 IC MVI OPCOD,XX43 IC OP CODE=43 15967021 BC UNCOND,SETRX0 GEN ATXT FOR RX INSTRUC 15974021 STC MVI OPCOD,XX42 STC OP CODE=42 15981021 BC UNCOND,SETRX0 GEN ATXT FOR RX INSTRUC 15988021 LA MVI OPCOD,XX41 LA OP CODE=41 15995021 BC UNCOND,SETRX0 GEN ATXT FOR RX INSTRUC 16002021 *SLA MVI OPCOD,X'8B' SLA OPCODE=8B 16009021 * BC UNCOND,SETRX0 16016021 *SRA MVI OPCOD,X'8A' SRA OP CODE=8A 16023021 * BC UNCOND,SETRX0 16030021 *SLDA MVI OPCOD,X'8F' SLDA OP CODE=8F 16037021 * BC UNCOND,SETRX0 16044021 SRDA MVI OPCOD,XX8E SRDA OP CODE=8E 16051021 BC UNCOND,SETRX0 GEN ATXT FOR RX INSTRUC 16058021 *SLL MVI OPCOD,X'89' SLL OP CODE=89 16065021 * BC UNCOND,SETRX0 16072021 *SRL MVI OPCOD,X'88' SRL OP CODE=88 16079021 * BC UNCOND,SETRX0 16086021 *SLDL MVI OPCOD,X'8D' SLDL OP CODE=8D 16093021 * BC UNCOND,SETRX0 16100021 *SRDL MVI OPCOD,X'8C' SRDL OP CODE=8C 16107021 * BC UNCOND,SETRX0 16114021 *EX MVI OPCOD,X'44' EX OP CODE=44 16121021 * BC UNCOND,SETRX0 16128021 *BXLE STM GR1,GR15,GSVRG 16135021 * LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 16142021 * BAL RETRG,GTSTNM 16149021 * MVI OPCOD,X'87' BXLE OP CODE IS 98 16156021 * BC UNCOND,SETRSB 16163021 * MVI GCGBR2+1,X'87' BXLE OP CODE 16170021 * BC UNCOND,GOTBR2 16177021 *BXH STM GR1,GR15,GSVRG 16184021 * LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 16191021 * BAL RETRG,GTSTNM 16198021 * MVI OPCOD,X'86' BXH OP CODE IS 86 16205021 * BC UNCOND,SETRSB 16212021 * MVI GCGBR2+1,X'86' BXH OP CODE 16219021 *GOTBR2 MVC GCGBR2+2(1),XREG2 16226021 * MVO GCGBR2+2(1),XREG1(1) 16233021 * MVI GCNGBR+1,X'0D' 16240021 * MVC COUNT(8),GCNGBR 16247021 * MVC COUNT+8(5),GCGBR2 16254021 * BC UNCOND,GNOPT9 16261021 LM MVI OPCOD,XX98 LM OP CODE=98 16268021 BC UNCOND,SETRS GEN ATXT FOR RS INSTRUC 16275021 STM MVI OPCOD,XX90 STM OP CODE=90 16282021 SETRS STM GR1,GR15,GSVRG 16289021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 16296021 XI GBIT2,XX02 16303021 MVC GABS(LX1),XREG2 LO 4 BITS OPND2 TO LO 4 BITS 16310021 BC UNCOND,SETRX1 COMPLT ATXT FOR RS INSTRUC 16317021 BRANCH STM GR1,GR15,GSVRG 16324021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 16331021 BAL RETRG,GTSTNM FOR BR OF PN,VN MOD DIRECT ATXT 16338021 MVI OPCOD,XX07 BCR OP CODE IS 07 CHANGED IF BC 16345021 BC UNCOND,GHBT3B BR TO GEN ATXT FOR BRANCH 16352021 MVI GCNGBR+NX9,XX07 BCR OP CODE 16359021 B GOUTBR FOR PN MOVE BR STRING TO OUTAREA 16366021 GTSTNM CLC XGN1(LX2),GZERO 16373021 BC EQ,GTSTN2 BRANCH IF NOT GN 16380021 MVI GCNGBR+NX5,XX50 16387021 MVC GCNGBR+NX6(LX2),XGN1 16394021 B DX8(XR0,RETRG) PUT OUT DIRECT A-TEXT 16401021 GTSTN2 CLC XVN1(LX4),GZERO SET VNREF CODE 16408021 BC NOTEQ,GTSTN3 BRANCH IF VN 16415021 CLC XPN1(LX4),GZERO 16422021 BCR EQ,RETRG BR IF NOT PN 16429021 MVI GCPNVNBR+NX5,PAPNREF INSERT PRIORITY & PN NUMBER 16436021 MVC GCPNVNBR+NX6(LX3),XPN1+NX1 16443021 LA RETRG,GOUTBR2 SET 14 FOR RETURN FROM PNUSED R 16450021 LH RW3,XPN1+NX2 GO TO MARK PNUTBL 16457021 BC R15,PNUSED FOR THIS PN= 16464021 GTSTN3 MVI GCPNVNBR+NX5,PAVNREF INSERT PRIORITY AND 16471021 MVC GCPNVNBR+NX6(LX3),XVN1+NX1 VN NUMBER 16478021 B GOUTBR2 FOR VN COMPLT BR ATXT AND WRITE 16485021 BRNLNK STM GR1,GR15,GSVRG 16492021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 16499021 BAL RETRG,GTSTNM FOR PN OR VN MOD DIRECT ATXT 16506021 MVI OPCOD,XX05 BALR OP CODE IS 05 CHANGED IF BAL 16513021 BC UNCOND,GHBT3B BR TO GEN ATXT FOR BALR 16520021 MVI GCNGBR+NX9,XX05 BCR OP CODE 16527021 BC UNCOND,GOUTBR FOR PN COMPLT ATXT,MOVE TO OUT 16534021 BRNCNT STM GR1,GR15,GSVRG 16541021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 16548021 BAL RETRG,GTSTNM FOR PN OR VN MOD DIRECT ATXT 16555021 MVI OPCOD,XX06 BCTR OP CODE IS 06 CHANGED IF BCT 16562021 BC UNCOND,GHBT3B BR TO GEN ATXT FOR BCTR 16569021 MVI GCNGBR+NX9,XX06 BCTR OP CODE 16576021 GOUTBR BAL RETRG,GDES15 DESTROY 15 16583021 MVO GCNGBR+NX10(LX1),XREG1(LX1) 16590021 MVI GCNGBR+NX1,XX0B 16597021 MVC COUNT(LX11),GCNGBR 16604021 BC UNCOND,GNOPT9 WRITE OUT ATXT 16611021 GOUTBR2 BAL RETRG,GDES15 DESTROY REG 15 16618021 MVO GCPNVNBR+NX11(LX1),XREG1(LX1) 16625021 MVI GCPNVNBR+NX1,XX0C SET LENGTH 16632021 MVC COUNT(LX12),GCPNVNBR MOVE BRANCH STRING TO OUTPUT AR 16639021 B GNOPT9 WRITE OUT ATXT 16646021 LDFLL MVI OPCOD,XX28 LDR OP CODE=28 CHANGED IF LD 16653021 GHBT2 MVI GBIT1,XX10 DOUBLE PRECISION FLOATING POINT CONSTA 16660021 GHIBT2 OI GBIT1,XX08 FLOATING POINT. 16667021 BC UNCOND,GHIBT3 SAVE REGS AND BR TO GEN ATXT 16674021 GHBT3B MVI GBIT1,XX00 16681021 BC UNCOND,GHBT3C BR TO GEN ATXT 16688021 GHIBT3 STM GR1,GR15,GSVRG 16695021 LM OPD1,OPD3,OP1 LD REGS WITH OPND PTRS 3 WITH GADPAR 16702021 GHBT3C CLC XWC1(GCNLN2),GZERO 16709021 BC NOTEQ,GSTRX3 BRANCH IF RX TYPE INSTRUCTION 16716021 C OPD1,GZERO 16723021 BC EQ,SETRR BRANCH IF RR TYPE INSTRUCTION 16730021 GSTRX3 XI OPCOD,XX40 PUT 4 IN HI ORDER (0 OR 2 OR 3 THERE N 16737021 CLI XXREG,XX00 16744021 BC EQ,SETRX IF REG0, BR TO GEN RX DOP ATXT 16751021 GFKRG MVC GABS(LX1),XXREG 16758021 BC UNCOND,SETRX GENERATE ATXT FOR RX INSTRUC 16765021 GFKRG2 XI OPCOD,XX40 16772021 BC UNCOND,GFKRG MOVE IN REGNO,BR TO GEN INSTRUC 16779021 LDFLS MVI OPCOD,XX38 LER OP CODE=38 CHANGED IF LE 16786021 BC UNCOND,GHIBT2 GEN FLPT ATXT INSTRUC 16793021 ADFLS MVI OPCOD,XX3A AER OP CODE=3A CHANGED IF AE 16800021 BC UNCOND,GHIBT2 GEN SGL FLPT ATXT INSTRUC 16807021 ADFLL MVI OPCOD,XX2A ADR OP CODE=2A CHANGED IF AD 16814021 BC UNCOND,GHBT2 GEN DBL FLPT ATXT INSTRUC 16821021 *ADUNS MVI OPCOD,X'3E' AUR OP CODE=3E CHANGED IF AU 16828021 * BC UNCOND,GHIBT2 16835021 *ADUNL MVI OPCOD,X'2E' AWR OP CODE=2E CHANGED IF AW 16842021 * BC UNCOND,GHBT2 16849021 SUBNS MVI OPCOD,XX3B SER OP CODE=3B CHANGED IF SE 16856021 BC UNCOND,GHIBT2 GEN FLPT ATXT INSTRUC 16863021 SUBNL MVI OPCOD,XX2B SDR OP CODE=2B CHANGED IF SD 16870021 BC UNCOND,GHBT2 GEN DBL FLPT ATXT INSTRUC 16877021 SUBUNS MVI OPCOD,XX3F SUR OP CODE=3F CHANGED IF SU 16884021 BC UNCOND,GHIBT2 GEN SNGL FLPT ATXT INSTRUC 16891021 SUBUNL MVI OPCOD,XX2F SWR OP CODE=2F CHANGED IF SW 16898021 BC UNCOND,GHBT2 GEN DBL FLPT ATXT INSTRUC 16905021 CMPFLS MVI OPCOD,XX39 CER OP CODE=39 CHANGED IF CE 16912021 BC UNCOND,GHIBT2 GEN SNGL FLPT ATXT INSTRUC 16919021 CMPFLL MVI OPCOD,XX29 CDR OP CODE=29 CHANGED IF CD 16926021 BC UNCOND,GHBT2 GEN DBL FLPT ATXT INSTRUC 16933021 PNBCD STM RETRG,RW3,PUTSAV 16940021 LA RW3,DX1 16947021 LA RW2,GADPAR 16954021 MVI GADPAR,XX3C PNBCD 16961021 B PUTA04 BR TO PUT A TRN 16968021 MACRO STM GR1,GR15,GSVRG 16975021 LM OPD1,OPD3,OP1 16982021 MVI GBIT2,XX40 HAVE MACRO 16989021 MVI OPCOD,XX44 MACRO 16996021 MVC GABS(LX1),GMCTYP 17003021 NI MADCSW,MSWOFF 17010021 CLI GMCTYP,MADCON ADCON... 17017021 BC NOTEQ,GCKOP3 NO 17024021 CLI DX0(OPD1),MANLIT 17031021 BC NOTEQ,GCKOP3 NOT ALPHANUM LIT,GEN PROPER ATXT 17038021 OI MADCSW,MSWON YES, SET ADCON SW 17045021 BC UNCOND,GCKOP3 GEN ATXT FOR ADCON 17052021 SVC MVI OPCOD,XX0A SVC OPCODE 17059021 BC UNCOND,CNOP2 SKIP NXT TO KEEP SVC OP CODE 17066021 CNOP MVI OPCOD,XX00 CNOP OP CODE 17073021 CNOP2 STM GR1,GR15,GSVRG 17080021 LM OPD1,OPD3,OP1 17087021 MVC GABS(LX1),IMM 17094021 BC UNCOND,GNOPT2 WRITE OUT SVC DIRECT ATXT 17101021 MULTS MVI OPCOD,XX3C MER OP CODE=3C CHANGED IF ME 17108021 BC UNCOND,GHIBT2 GEN SNGL FLPT ATXT INSTRUC 17115021 MULTFL MVI OPCOD,XX2C MDR OP CODE=2C CHANGED IF MD 17122021 BC UNCOND,GHBT2 GEN DBL FLPT ATXT INSTRUC 17129021 DIVFLS MVI OPCOD,XX3D DER OP CODE=3D CHANGED IF DE 17136021 BC UNCOND,GHIBT2 GEN SNGL FLPT ATXT INSTRUC 17143021 DIVFLL MVI OPCOD,XX2D DDR OP CODE=2D CHANGED IF DD 17150021 BC UNCOND,GHBT2 GEN DBL FLPT ATXT INSTRUC 17157021 STORFS MVI OPCOD,XX70 STE OP CODE=70 17164021 BC UNCOND,SETRX0 GEN ATXT FOR RX INSTRUC 17171021 STORFL MVI OPCOD,XX60 STD OP CODE=60 17178021 BC UNCOND,SETRX0 GEN ATXT FOR RX INSTRUC 17185021 HALVEL MVI OPCOD,XX24 HDR OP CODE=24 17192021 BC UNCOND,SETRR1 GEN ATXT FOR RR INSTRUC 17199021 HALVES MVI OPCOD,XX34 HER OP CODE=34 17206021 BC UNCOND,SETRR1 GEN ATXT FOR RR INSTRUC 17213021 LDNEGS MVI OPCOD,XX31 LNER OP CODE=31 17220021 BC UNCOND,SETRR1 GEN ATXT FOR RR INSTRUC 17227021 *LDNEGL MVI OPCOD,X'21' LNDR OP CODE=21 17234021 * BC UNCOND,SETRR1 17241021 *LDPOSL MVI OPCOD,X'20' LPDR OP CODE=20 17248021 * BC UNCOND,SETRR1 17255021 *LDPOSS MVI OPCOD,X'30' LPER OP CODE=30 17262021 * BC UNCOND,SETRR1 17269021 *LDCMPL MVI OPCOD,X'23' LCDR OP CODE=23 17276021 * BC UNCOND,SETRR1 17283021 *LDCMPS MVI OPCOD,X'33' LCER OP CODE=33 17290021 * BC UNCOND,SETRR1 17297021 LDTSTL MVI OPCOD,XX22 LTDR OP CODE=22 17304021 BC UNCOND,SETRR1 GEN ATXT FOR RR INSTRUC 17311021 LDTSTS MVI OPCOD,XX32 LTER OP CODE=32 17318021 BC UNCOND,SETRR1 GEN ATXT FOR RR INSTRUC 17325021 GNSTEP LH GR14,FIVEGN 17332021 LA GR14,DX1(GR14) 17339021 STH GR14,FIVEGN 17346021 BCR UNCOND,RETRG RETURN TO CALLER 17353021 GCONMV MVC DX3(LX1,OPD3),DX0(RETRG) 17360021 * THE FOLLOWING INSTRUCTIONS ARE EXECUTED BY THE EX INSTRUCTION 17367021 GBILT4 CP GFLHI(LX10),DX4(LX1,OPD1) 17374021 GBILT6 CP GFLLO(LX10),DX4(LX1,OPD1) 17381021 CHNGL1 MVC DX3(LX1,OPD3),DX2(OPD1) FOR ALPHA LIT + FLTNG PT LIT 17388021 CHNGL4 MVC DX4(LX1,OPD3),DX3(OPD3) FOR FIG CON BCD 17395021 CHNGL2 MVC DX3(LX1,OPD3),DX4(OPD1) FOR NUM LIT 17402021 CHNGL5 MVC DX3(LX1,OPD3),GZERO FOR FIG CON FLTNG PT 17409021 CHNGL9 MVC OTPT(LX1),COUNT 17416021 GZAP ZAP GTEMP(LX8),DX4(LX1,OPD1) 17423021 GBICHG CP GHFHI(LX5),DX4(LX1,OPD1) 17430021 GBICG2 CP GHFLO(LX5),DX4(LX1,OPD1) 17437021 AXTI00 MVC DX0(LX0,RW2),OTPT+NX5 17444021 GMOVE MVO GTEMP+NX3(LX5),DX4(LX1,OPD1) 17451021 GDC1 MVC DX1(LX1,OPD3),XCON1 17458021 DNTOR1 EQU * 17465021 GDNCNG ST RETRG,EXHIBP 17472021 CLC DX4(LX3,RW3),XTALLV+NX4 TEST IF TALLY 17479021 BC NOTEQ,GODP5 BRANCH IF NOT TALLY 17486021 MVI TALLY1,XX05 17493021 BC UNCOND,GODP6X GEN LOAD INSTRUC AND BR 17500021 GODP5 NI DX3(RW3),XXF0 17507021 CLI DX3(RW3),XXB0 TEST MINOR CODE 17514021 ST RW3,OP1 17521021 BC EQ,GODP6 BINARY 17528021 MVI XL1+NX1,XX08 17535021 MVI XCNTR1,XX30 TEMP STORAGE OTHER THAN ARITH 17542021 MVI XCNTR1+NX2,XX01 17549021 BC HI,GOPID ID 17556021 MVC XL2+NX1(LX1),DX9(RW3) 17563021 LH RETRG,XL2 17570021 SH RETRG,XC016 17577021 BL GODPCK IF LT 16, NO DBL PACK NEEDED 17584021 STH RETRG,PLUS2+NX1 17591021 MVI XL2+NX1,XX10 17598021 GODPCK EQU * 17605021 BAL RETRG,PACK DO A PACK GTREF2(8),DN(L2) 17612021 BC UNCOND,GODP2 UP TS TO 8 AND GEN CUB ATXT 17619021 GOPID IC RETRG,DX9(RW3) 17626021 SRL RETRG,DX1 17633021 LA RETRG,DX1(RETRG) 17640021 STC RETRG,XL2+NX1 17647021 BAL RETRG,ZAP DO A ZAP GTREF2(8),DN(L2) 17654021 GODP2 MVI XREG1,XRC 17661021 CLC TS2MAX(LX2),XC008 17668021 BC LO,GFXTS2 IF TS2 LT 8,INCREASE TO 8 17675021 GFXTS3 MVI XCNTR1,XX30 17682021 MVI XCNTR1+NX2,XX01 17689021 BAL RETRG,CVBBI DO A CVB XRC,GTREF2 17696021 L RETRG,EXHIBP 17703021 BCR UNCOND,RETRG RETURN TO CALLER 17710021 GFXTS2 MVC TS2MAX(LX2),XC008 17717021 BC UNCOND,GFXTS3 AFTER UPPING TS2,GEN CVB ATXT 17724021 GODP6 SR RETRG,RETRG 17731021 IC RETRG,DX9(RW3) 17738021 CH RETRG,XC009 DOUBLE PRECISION... 17745021 BC NOTHI,GODP6X NO 17752021 MVI PLUS1+NX2,XX04 YES, SET UP A-TEXT BUFFER FOR ' 17759021 GODP6X MVI XREG1,XRC 17766021 BAL RETRG,LOAD DO A LH XRC,DN 17773021 L RETRG,EXHIBP 17780021 BCR UNCOND,RETRG RETURN TO CALLER 17787021 * END OF A-TEXT GENERATOR 17794021 TITLE 'IKFCBL51: COMMON I-O ANALYZER SUBROUTINES' 42646 17801021 IKF511 CSECT 42646 17808021 SPACE 3 42646 17815021 ***************************************************************** 42646 17822021 * * 42646 17829021 * THIS CSECT CONTAINS NEW AND THROUGHLY REVISED COMMON SUB- * 42646 17836021 * ROUTINES USED BY THE INPUT-OUTPUT VERB ANALYZERS. * 42646 17843021 * * 42646 17850021 ***************************************************************** 42646 17857021 SPACE 2 42646 17864021 USING *,HCOMSR 42646 17871021 SORTXSA DS 0H 42646 17878021 SPACE 1 42646 17885021 * 42646 17892021 * THIS ROUTINE ALLOCATES THREE XSA CELLS FOR USE BY SORT UPON 42646 17899021 * FIRST ENTRY, AND SETS UP THE CELL NUMBERS IN THREE HALFWORDS. 42646 17906021 * IT ALSO SETS UP A-TEXT FOR THE SORT AND RELEASE ANALYZERS. 42646 17913021 * 42646 17920021 * CALLED BY: SORT, RELEASE, RETURN. 42646 17927021 * 42646 17934021 * CALLS: N/A. 42646 17941021 * 42646 17948021 SPACE 1 42646 17955021 TM SORTSW1,CELLALOC HAVE THE CELLS BEEN INITED... 42646 17962021 BO SORTXSA1 YES 42646 17969021 * NOW WE MAKE SURE A WORD BOUNDARY IS MADE AVAILABLE 42646 17976021 ST RW3,IOSAVE03 SAVE REG 3 42646 17983021 LH RW3,XSACTR ENOUGH 42646 17990021 X RW3,FWDTHR XSA CELLS 42646 17997021 LA RW3,DX2(RW3) ARE SKIPPED 42646 18004021 N RW3,FWDTHR TO ENSURE 42646 18011021 AH RW3,XSACTR ALIGNMENT 42646 18018021 * INITIALIZE THE THREE CELLS USED BY SORT PROCESSING VERBS 42646 18025021 STH RW3,XSARTRN INITIALIZE CELL FOR RETURN 42646 18032021 LA RW3,DX4(RW3) 42646 18039021 STH RW3,XSARLSE INITIALIZE CELL FOR RELEASE 42646 18046021 LA RW3,DX4(RW3) 42646 18053021 STH RW3,XSASORT INITIALIZE CELL FOR SORT 42646 18060021 LA RW3,DX4(RW3) 42646 18067021 STH RW3,XSACTR COUNTER NOW SET 42646 18074021 L RW3,IOSAVE03 42646 18081021 OI SORTSW1,CELLALOC INDICATE CELLS ALLOCATED 42646 18088021 SORTXSA1 DS 0H 42646 18095021 ST RETRG,IOSAVE01 SAVE REG 14 42646 18102021 TM SORTSW1,SORTRTRN WERE WE CALLED BY RETURN... 42646 18109021 BO SORTXSA2 YES, DO NOT SET UP 42646 18116021 * SET UP ADDRESSING PARAMETERS IN A-TEXT FOR SORT VERB 42646 18123021 MVI XCNTR1,XX18 42646 18130021 MVI XREG1,XX0E (14,XSACELL) 42646 18137021 MVC XCNTR1+NX1(LX2),XSASORT SORT VERB 42646 18144021 SORTXSA2 DS 0H 42646 18151021 LM RETRG,HCOMSR,IOSAVE01 RESTORE REGS 42646 18158021 BR RETRG RETURN TO CALLER 42646 18165021 SPACE 3 42646 18172021 TITLE 'EVAL VERB ANALYZER' 18179021 IKF502 CSECT 18186021 * 18193021 USING *,XRVERB 18200021 VIRTDEF MVI DOP3,VIRTCODE 18207021 MVC DOP3+DX1(LX3),DOP2+DX2 GEN ATXT ELEM AS FOLLOWS... 18214021 MVC DOP3+DX4(LX8),DOP1+DX2 '18/DISPL/BCDNAME' 18221021 LA RW3,DX12 18228021 LA RW2,DOP3 18235021 BAL RW0,WRITE2 WRITE ATEXT 18242021 B PH5CTL RETURN TO CONTROL 18249021 VIRTCODE EQU X'18' 18256021 USING LSSPRO,XRVAR 18263021 LSSPRO SR XR6,XR6 CALL Q-ROUTINES 18270021 IC XR6,DX1(XR3) ** L 2,GNREF 18277021 SH XR6,XC004 ** BALR 2,2 18284021 AR XR6,XR3 AND AS MANY BALR 2,2 AS 18291021 LSSPR1 DS 0H 37330 18298021 MVI XREG1,XX02 SPECIFIED IN ATTRIBUTE 18305021 MVC XGN1(LX2),DX1(XR6) 18312021 BAL XRSUB,LOAD GEN L 18319021 SR XR1,XR1 18326021 IC XR1,DX0(XR6) 18333021 LA XR1,DX1(XR1) 18340021 BAL XRSUB,WRKLRG DESTROY 14,15 18347021 XSSP03 MVI XREG1,XX02 18354021 MVI XREG2,XX02 18361021 BAL XRSUB,BRNLNK BARL 2,2 18368021 BCT XR1,XSSP03 LOOP 18375021 LM XR0,XR15,XGSAV1 18382021 BR XRSUB RETURN 18389021 DROP XRVAR 18396021 EJECT 18403021 USING XSUDB2,XRVAR 18410021 XSUDB2 EQU * 18417021 MVC XIDBY(LX12),XC000 RESET OUTPUT AREA 18424021 MVC XGTEM2+DX5(LX3),XGSCIN(XR3) PICK LENGTH FOR GROUP ITEM 18431021 * NOT SIGNIFICANT FOR ELEMENTARY 18438021 UNPK XGTEM2(LX1),XGMINC(LX1,XR3) 18445021 NI XGTEM2,XX0F 18452021 CLI XGTEM2,XGGPFL 18459021 BC XZERO,XLEN00 FIXED LENGTH GROUPT 18466021 * 18473021 * 18480021 CLI XGTEM2,XGALN 18487021 BC XLOEQ,XLEN01 ALPHA ITEM 18494021 CLI XGTEM2,XGGPVL 18501021 BC XZERO,XLEN02 VARIABLE LENGTH GROUP 18508021 CLI XGTEM2,XX06 18515021 BC XLOEQ,XLEN06 REPORT ITEM 18522021 CLI XGTEM2,XGEXFP 18529021 BC XZERO,XLEN04 EXTRRNAL FLOATING POINT ITEM 18536021 CLI XGTEM2,XGINFP 18543021 BC XZERO,XLEN05 INTERNAL FLOATING POINT ITEM 18550021 CLI XGTEM2,XX0D 18557021 BC XZERO,XLEN07 STERLING NON-REPORT 18564021 CLI XGTEM2,XGANE 18571021 BE XLEN16 ALPHANUMEEIC EDITED 18578021 * IT IS NOW A NUMERIC ITEM-BI,ID OR ED 18585021 SPACE 2 18592021 SR XR1,XR1 18599021 IC XR1,XGDGLG(XR3) GET NUMBER OF DIGITS 18606021 MVI XBDBY+DX1,XX02 18613021 CH XR1,XC004 18620021 BC XLOEQ,XLEN09 HALF WORD 18627021 MVI XBDBY+DX1,XX04 18634021 CH XR1,XC009 18641021 BC XLOEQ,XLEN09 WORD 18648021 MVI XBDBY+DX1,XX08 DOUBLE WORD 18655021 * 18662021 * 18669021 XLEN09 STH XR1,XIDDN SET NUMBER OF DIGIT CELL 18676021 SRA XR1,DX1 SET ID LENGTH 18683021 LA XR1,DX1(XR1) X 18690021 STH XR1,XIDBY Z 18697021 MVC XOPLGH+DX2(LX2),XBDBY 18704021 CLI XGTEM2,XGBINR BINARY 18711021 BC XZERO,XLEN10 EXIT 18718021 CLI XGTEM2,XX07 INDEX DATA ITEM... 18725021 BE XLEN10 YES 18732021 MVC XOPLGH+DX2(LX2),XIDBY 18739021 CLI XGTEM2,XGINDC 18746021 BE XLEN10 YES 18753021 MVC XOPLGH+DX2(LX2),XIDDN ED 18760021 * 18767021 * 18774021 XLEN10 LM XR0,XR15,XGSAV3 18781021 BCR UNCON,XRSUB X 18788021 SPACE 2 18795021 XLEN00 NC XGTEM2+DX4(LX2),XC001 FIXED LENGTH GROUOP LENGTH 18802021 XLEN14 MVC XOPLGH(LX4),XGTEM2+DX4 X 18809021 B XLEN10 * 18816021 SPACE 2 18823021 XLEN01 NC XGTEM2+DX4(LX2),XC000 18830021 BC UNCON,XLEN14 ALPHA ITEM LENGTH 18837021 SPACE 2 18844021 XLEN02 NC XGTEM2+DX4(LX3),XSUMK5 18851021 MVC XOPVLC(LX2),XGTEM2+NX6 VALIABLE LENGTH GROUP 18858021 BC UNCON,XLEN10 EXIT 18865021 SPACE 2 18872021 XLEN04 NC XGTEM2+DX4(LX3),XC000 EXTERNAL FLOATING POINT 18879021 BC UNCON,XLEN14 EXIT 18886021 SPACE 2 18893021 XLEN05 MVI XOPLGH+DX3,XX04 INTERNAL FLOATING POINT 18900021 TM XGDGLG(XR3),XX01 18907021 BC XZERO,XLEN10 EXIT 18914021 * 18921021 XLEN15 MVI XOPLGH+DX3,XX08 18928021 BC UNCON,XLEN10 X 18935021 SPACE 2 18942021 XLEN06 MVC XOPLGH+DX3(LX1),DX11(XR3) 18949021 BC UNCON,XLEN10 REPORT ITEM 18956021 SPACE 2 18963021 XLEN07 EQU * 18970021 MVC XOPLGH+DX3(LX1),DX10(XR3) 18977021 NI XOPLGH+DX3,XX1F STERLING NON-REPOT 18984021 BC UNCON,XLEN10 EXIT 18991021 XLEN16 MVC XOPLGH+DX2(LX2),DX9(XR3) 18998021 B XLEN10 ALPHANUM.EDIT.PICK UP LENGTH 19005021 TITLE 'IKFCBL51: NONNUMERIC COMPARE VERB ANALYZER' 19012021 *DEL 19019021 *DEL 19026021 IKF50G CSECT P6232 19033021 *DEL 19040021 *DEL 19047021 *DEL 19054021 *DEL 19061021 * 19068021 * A SEPERATE ENTRY POINT EXISTS FOR EACH TYPE OF IF...IE 19075021 * EQ, NOT EQ, LT, NOT LT, GT, NOT GT. 19082021 * 19089021 * AT EACH ENTRY POINT THE ADDRESS OF THE TABLE FOR THAT 19096021 * TYPE OF COMPARISON IS PUT INTO RW6. THEN CONTROL IS GIVEN TO 19103021 * THE COMMON IF ANALYZER. 19110021 * 19117021 * AFTER ANALYSIS OF OPERANDS IS COMPLETE CONTROL IS GIVE 19124021 * TO IMGEN WHICH GENERATES INSTRUCTIONS FOR BOTH ALPHANUMERIC 19131021 * MOVE AND IF. 19138021 * 19145021 * THERE ARE ALWAYS THREE OPDS SUPPLIED. OPDS 1 AND 2 ARE 19152021 * THE OPDS TO BE COMPARED. OPD3 IS THE GN TO BE BRANCHED TO IF 19159021 * THE CONDITION INDICATED BY THE VERB IS MET. 19166021 * 19173021 * P2TEXT VERB OPD1,OPD2,GN 19180021 * 19187021 * VERB IS EQ, NEQ, LT, NLT, GT, NGT 19194021 * 19201021 * OPD1 IS A FIGCON, ALPHA LITERAL, GROUP DAT 19208021 * OR ALPHA DATA 19215021 * 19222021 * OPD2 IS AS OPD1 19229021 * 19236021 * 19243021 * IF OPD1 IS A FIGCON IT IS SWAPPED WITH THE SECOND OPD. 19250021 * IF OPD1 IS LONGER THAN OPD2 THEN THE OPDS ARE SWAPPED 19257021 * WHENEVER OPDS ARE SWAPPED THE RELATIONAL IS INVERTED. 19264021 * IS ACCOMPLISHED BY CHANGING THE ADDR IN RW6. THIS IS DONE BY 19271021 * LOADING RW6 WITH THE FIRST WORD OF TABLE ADDRESSED AT THAT T 19278021 * BY RW6. SINCE THE FIRST WORD OF EACH TABLE CONTAINS THE ADDR 19285021 * OF THE TABLE FOR THE OPPOSITE RELATIONAL THE EFFECT OF INVER 19292021 * RELATIONALS IS ACCOMPLISHED. 19299021 * 19306021 * IF THE LENGTH OF OPD2 IS GREATER THAN OPD1 THEN IF THE 19313021 * FIRST BYTE OF THE TABLE ADDRESSED BY RW6 IS ZERO THE EXCESS 19320021 * LENGTH OF THE SECOND OPD IS IGNORED. SUCH WOULD BE THE CASE, 19327021 * FOR EXAMPLE, IF THE INPUT WERE 'GT A,B,GN' WHERE THE LENGTH 19334021 * B IS GREATER THAN THE LENGTH OF A. IN THE SUBJECT CASE A IS 19341021 * GREATER THAN B ONLY IF BY COMPARING THE NUMBER OF BYTES COM 19348021 * TO BOTH A AND B YIELD A GT B. IF THE RELATION WERE LT THAN T 19355021 * EXCESS IN B WOULD HAVE TO BE COMPARED IF THE COMPARISON OF T 19362021 * COMMON BYTES YIELDS AN EQUAL. 19369021 * 19376021 * THE USE OF THE TABLE IS INDICATED BY THE COMMENTS WITH 19383021 * DEFINITION OF TABLES. 19390021 *DEL 19397021 * 19404021 *NOTE........ALL LABELS ASSOCIATED SOLELY WITH THE ALPHA IF PROCESS 19411021 * BEGIN WITH THE CHARACTER 'IF'. 19418021 * 19425021 * LABELS IN THE COMMON IF-MOVE ROUTINES BEGIN WITH THE 19432021 * CHARACTERS 'IM'. 19439021 * 19446021 EJECT 19453021 USING *,GVERB 19460021 PEQNNU LA RW6,IFEQT 19467021 BC UNCOND,IFANAL BR TO INIT ANALYZE RTN 19474021 USING *,GVERB 19481021 NEQNNU LA RW6,IFNEQT 19488021 BC UNCOND,IFANAL BR TO INIT ANALYZE RTN 19495021 USING *,GVERB 19502021 PGTNNU LA RW6,IFGTT 19509021 BC UNCOND,IFANAL BR TO INIT ANALYZE RTN 19516021 USING *,GVERB 19523021 NGTNNU LA RW6,IFNGTT 19530021 BC UNCOND,IFANAL BR TO INIT ANALYZE RTN 19537021 USING *,GVERB 19544021 PLTNNU LA RW6,IFLTT 19551021 BC UNCOND,IFANAL BR TO INIT ANALYZE RTN 19558021 USING *,GVERB 19565021 NLTNNU LA RW6,IFNLTT 19572021 * 19579021 * COMMON ANALYSIS FOR IF 19586021 * 19593021 IFANAL BALR GVERB,RW0 ESTABLISH ADDRESSABILITY REG9 19600021 USING *,GVERB 19607021 MVC IMCONS(LX14),IFCONS SET COMMON AREA TO 'IF' 19614021 TM PHZSW,ZWB STRIP SIGN 19621021 BZ IFANAL2 NO 19628021 LA RW2,DOP1 19635021 BAL XRSUB,CALCLG GET MINOR CODE OF DOP1 19642021 B PH5CTL ERROR CONDITION 19649021 MVC SAVTYP(LX1),DNMINR SAVE DOP1 TYPE 19656021 CLI DNMINR,XGEXDC IS DOP1 ED 19663021 BNE IFANAL1 NO 19670021 LA RW2,DOP2 19677021 BAL XRSUB,CALCLG GET DOP2 TYPE 19684021 B PH5CTL ERROR CONDITION 19691021 CLI DNMINR,XGGPVL IS DOP2 VAR LEN GRP 19698021 BE IFANAL3 YES 19705021 CLI DNMINR,XGGPFL IS DOP2 FIX LEN GRP 19712021 BE IFANAL3 YES 19719021 LA RW2,DOP1 NO, 19726021 BAL XRSUB,CALCLG RESET LENGTH FIELD 19733021 B PH5CTL IMPOSSIBLE CONDITION 19740021 BAL XRSUB,CNVNUM YES, MOVE IT TO TS2 AND TREAT 19747021 B IFANAL2 IT AS THOUGH IT WERE ALPHANUM 19754021 IFANAL3 DS 0H 19761021 NI DOP1+XGMINC,XX0F CHANGE DOP1 TO ALPHANUMERIC 19768021 OI DOP1+XGMINC,XX30 19775021 NI DOP1+XGSCIN,XXFE 19782021 XC DOP1+XGSCAL(LX1),DOP1+XGSCAL 19789021 B IFANAL2 CONTINUE 19796021 IFANAL1 DS 0H 19803021 LA RW2,DOP2 19810021 BAL XRSUB,CALCLG GET MINOR CODE OF DOP2 19817021 B PH5CTL ERROR CONDITION 19824021 CLI DNMINR,XGEXDC IS DOP2 ED 19831021 BNE IFANAL2 NO 19838021 CLI SAVTYP,XGGPVL IS DOP1 VAR LEN GRP 19845021 BE IFANAL4 YES 19852021 CLI SAVTYP,XGGPFL IS DOP1 FIX LEN GRP 19859021 BE IFANAL4 YES 19866021 XC DOP1(LDOP),DOP2 YES, SWITCH DOPS FOR CNVNUM 19873021 XC DOP2(LDOP),DOP1 19880021 XC DOP1(LDOP),DOP2 19887021 BAL XRSUB,CNVNUM MOVE DOP2 TO TS2 AND TREAT IT 19894021 XC DOP1(LDOP),DOP2 AS THOUGH IT WERE ALPHANUMERIC 19901021 XC DOP2(LDOP),DOP1 RESET DOPS 19908021 XC DOP1(LDOP),DOP2 19915021 B IFANAL2 CONTINUE 19922021 IFANAL4 DS 0H 19929021 NI DOP2+XGMINC,XX0F CHANGE DOP2 TO ALPHANUMERIC 19936021 OI DOP2+XGMINC,XX30 19943021 NI DOP2+XGSCIN,XXFE 19950021 XC DOP2+XGSCAL(LX1),DOP2+XGSCAL 19957021 IFANAL2 DS 0H 19964021 BAL RETRG,IMINIT EXECUTE INIT RTN... LISTED ABOUT 6 PA 19971021 * HENCE 19978021 STM RW4,RW5,IMPTR1 SAVE OPD PTRS 19985021 BC EQ,IFEQ BR IF L2 EQ L1 19992021 BC HI,IFHI BR IF L2 GT L1 19999021 * 20006021 * 20013021 * 20020021 * RTN FOR L2 LT L1 20027021 * 20034021 * 20041021 LR RW0,RW4 SWAP OPD PTRS 20048021 LR RW4,RW5 20055021 LR RW5,RW0 20062021 L RW6,DX0(RW6) SWAP RELATIONAL (SEE COMMENTS FOR SAME OPE 20069021 LR RW0,RW1 IN IMINIT RTN AT LABEL 'IMSWAP') 20076021 LR RW1,RW2 SWAP LENGTHS 20083021 LR RW2,RW0 20090021 * 20097021 STM RW4,RW5,IMPTR1 SAVE OPD PTRS 20104021 * RTN FOR L2 GT L1 20111021 * 20118021 IFHI DS 0H 20125021 ST RW3,IMLFC SAVE NUMBER OF EXCESS CHARS 20132021 ST RW1,IMIFC2 SAVE DISPLACEMENT OF EXCESS CHARS 20139021 BC UNCOND,IFSVL1 NORMAL PROCESS OF IF VERB 20146021 * 20153021 * RTN FOR L1 EQ L2 20160021 * 20167021 * 20174021 IFEQ DS 0H 20181021 CLI DX0(RW5),XX75 TEST IF OPD2 IF FIGCON 20188021 BC NOTEQ,IFSVL1 BR IF NO 20195021 ST RW1,IMLFC SAVE NUMBER OF CHARS TO BE COMPARED 20202021 ST RW4,IMPTR2 SET OPD PTRS BOTH TO POINT TO OPD1 20209021 SH RW6,H4 SUBTRACT FROM RW6 TO COMPENSATE FOR 20216021 * LA BELOW WHICH IS NOT WANTED IN 20223021 * THIS CASE 20230021 TM DX4(RW6),XX0D NOT EQUAL COMPARISON 20237021 BZ IFGENF YES 20244021 BCT RW1,IFGENE BR IF MORE THAN ONE CHAR TO COMPARE 20251021 BC R15,IFGENF BR IF ONE CHAR TO COMPARE 20258021 IFSVL1 ST RW1,IMLCH SAVE NUMBER OF CHARS TO BE COMPARED 20265021 TM DX0(RW6),XX0D NOT EQUAL COMPARISON 20272021 BZ IFGENF YES 20279021 CH RW1,H256 TEST IF THERE ARE EITHER GT 256 COMMO 20286021 BC HI,IFGENE CHARS OR THERE IS A NON-ZERO EXCESS 20293021 LTR RW3,RW3 20300021 BC ZERO,IFGENF IF NO EXCESS CHARS SKIP THIS 20307021 IFGENE MVI XREGNO,XX01 20314021 BAL RETRG,GNSTEP GENERATE GN NUMBER 20321021 MVC GLGNCN+NX3(LX2),FIVEGN 20328021 MVC XGN1(LX2),FIVEGN 20335021 MVI XREG1,XX01 20342021 BAL RETRG,LOAD GENERATE L 1,GN2 20349021 OI IMIFSW,XX01 WHERE GN2 IS CREATED AT THIS POI 20356021 IFGENF MVI XREGNO,XX02 20363021 MVC XGN1(LX2),DOP3+NX1 GENERATE L 2,GN1 OR PN 20370021 MVI XREG1,XX02 WHERE GN1 IS OPD3 AS GIVEN BY P 20377021 BAL RETRG,LOAD GENERATE LOAD ATEXT 20384021 LA RW6,DX4(RW6) STEP RW6 TO POINT PAST ADCON IN TABLE 20391021 MVC IMPTR3,IMPTR2 20398021 BC UNCOND,IMGEN GO TO COMMON RTN FOR IF AND MOVE ALPH 20405021 TITLE 'IKFCBL51: NONNUMERIC MOVE VERB ANALYZER' 20412021 * 20419021 *=1 ANALYZER FOR ALPHANUMERIC MOVE 20426021 * 20433021 * THIS ANALYZER IS GIVEN CONTROL BY THE MOVE ANALYZER WH 20440021 * IT DETERMINES THAT A CHARACTER MOVE IS CALLED FOR. 20447021 * 20454021 * AFTER ANALYSIS OF THE OPDS CONTROL IS GIVEN TO IMGEN 20461021 * WHICH GENERATES INSTRUCTIONS FOR BOTH ALPHANUMERIC MOVE AND 20468021 * 20475021 * THE INPUT ALWAYS CONTAINS TWO OPDS. OPD2 IS ALWAYS A 20482021 * DATA-NAME. OPD1 IS EITHER A LITERAL, FIGCON, OR DATA-NAME. 20489021 * 20496021 * 20503021 *NOTE........ALL LABELS ASSOCIATED SOLELY WITH THE ALPHA MOVE 20510021 * PROCESSING BEGIN WITH THE CHARACTERS 'MV'. 20517021 * 20524021 * LABELS IN THE COMMON IF-MOVE RTNS BEGIN WITH THE 20531021 * CHARACTERS 'IM'. 20538021 * 20545021 * 20552021 SPACE 5 20559021 USING *,GVERB 20566021 XALAMV MVC IMCONS(LX14),MVCONS 20573021 * 20580021 LA RW2,DOP2 20587021 BAL XRSUB,CALCLG CALCULATE LENGTH OF DOP2 20594021 B PH5CTL IF LENGTH ERROR DONT PROCESS 20601021 MVC SAVTYP,DNMINR 20608021 MVC XLEN2(LX2),LENGTH+NX2 20615021 LA RW2,DOP1 20622021 L XRVAR,AIMINIT0 20629021 USING IMINIT0,XRVAR 20636021 BAL RETRG,IMLIT CONVERT TO ALPHA IF INTRNL DEC 20643021 DROP XRVAR 20650021 CLI DNMINR,XGGPVL 20657021 BE XALMV12 VARIABLE LEN MOVE WO CNVSN 20664021 CLI DNMINR,XGGPFL 20671021 BE XALMV12 REC IS GROUP MOVE WITHOUT 20678021 * CONVERSION. 20685021 BAL XRSUB,CALCLG CALCULATE LENGTH OF DOP1 20692021 B PH5CTL IF LEN ERROR DONT PROCESS 20699021 CLI DNMINR,XX01 FIXED GROUP REC 20706021 BE XALMV12 YES 20713021 CLI DIMINR,XX04 VAR GROUP REC 20720021 BE XALMV12 YES 20727021 CLC XIDBY(LX6),XC000 NUM SENDING 20734021 BE XALMGL NO 20741021 BAL XRSUB,CNVNUM YES, CONVERT TO ALPHANUMERIC 20748021 XALMGL CLI SAVTYP,XGANE ALPHA. EDITED MOVE. 20755021 BE ANANE CALL SUBRTN FOR ALPHA EDIT MOVE 20762021 XALMV12 EQU * 20769021 CLI DOP1,PLFCON 20776021 BE MOVE30 BRANCH TO HANDLE FIG CON ALL 20783021 BAL RETRG,IMINIT EXECUTE INIT RTN...LISTED ABOUT 4 PAG 20790021 * HENCE 20797021 ST RW5,IMPTR1 SAVE OPD PTRS 20804021 ST RW4,IMPTR2 20811021 ST RW5,IMPTR3 20818021 BC EQ,MVEQ BR IF L2 EQ L1 20825021 BC LO,MVLO BR IF L2 LT L1 20832021 * RTN FOR L2 GT L1 20839021 * 20846021 CLI SAVTYP,XGRPT REPORT ITEM 20853021 BE NOJUSTHI YES, NO RIGHT JUSTIFIED 20860021 TM DOP2+NX7,XX01 RIGHT JUSTIFIED 20867021 BC ONES,MVHIJ BR IF YES 20874021 NOJUSTHI DS 0H 20881021 ST RW3,IMLFC SAVE # OF EXCESS BYTES 20888021 ST RW1,IMIFC2 SAVE DISPLACEMENT OF EXCESS BYTES 20895021 BC UNCOND,MVSVL SAVE NUMBER COMMON BYTES ROUTINE 20902021 * 20909021 * 20916021 MVHIJ ST RW3,IMLFC SAVE NUMBER OF COMMON BYTES 20923021 ST RW3,IMICH2 SAVE DISPLACEMENT OF COMMON BYTES 20930021 BC UNCOND,MVSVL SAVE NUMBER COMMON BYTES ROUTINE 20937021 * RTN FOR L2 LT L1 20944021 * 20951021 MVLO DS 0H 20958021 CLI SAVTYP,XGRPT REPORT ITEM 20965021 BE NOJUSTLO YES, NO RIGHT JUSTIFIED 20972021 TM DOP2+NX7,XX01 JUSTIFIED 20979021 BO MVLOJ YES 20986021 NOJUSTLO DS 0H 20993021 ST RW2,IMLCH 21000021 B IMGEN BRANCH TO GENERATE A-TEXT 21007021 * 21014021 * 21021021 MVLOJ ST RW2,IMLCH SAVE NUMBER COMMON CHARS 21028021 ST RW3,IMICH1 SAVES DISPLACEMENT OF COMMON CHARS 21035021 BC UNCOND,IMGEN BRANCH TO GENERATE ATEXT 21042021 * RTN FOR L2 EQ L1 21049021 * 21056021 MVEQ CLI DOP1,XX75 TEST IF OPD1 IS A FIGCON 21063021 BC NOTEQ,MVSVL BR IF NO 21070021 ST RW1,IMLFC SAVE NUMBER BYTES TO BE FILLED WITH F 21077021 BC UNCOND,IMGEN BRANCH TO GENERATE ATEXT 21084021 MVSVL ST RW1,IMLCH SAVE NUMBER COMMON BYTES 21091021 BC UNCOND,IMGEN BRANCH TO GENERATE ATEXT 21098021 * * * * * * * * * * * * * * * * 21105021 EJECT 21112021 * ALPHANUMERIC EDITED MOVE GENERATE A CALL TO SUBROUTINE. 21119021 * 21126021 * 21133021 * L RW0,=LENGTH-OF-SEND. 21140021 * LA RW1,SENDING 21147021 * LA RW2,REC. 21154021 * LA RW3,MASK FOR EDITING 21161021 * L 15,V(ANE0) 21168021 * BALR 14,15 21175021 * DC X'00' FLAG BYTE 21182021 * DC X'00' LENGTH OF MASK 21189021 * DC X'0000' LENGTH OF REC. 21196021 * 21203021 * FLAG BYTE BIT0 RIGTH JUSTIFIED RECEIV. 21210021 * BIT1 SEND. IS A FIGCON. 21217021 * OTHER BIT UNUSED. 21224021 * 21231021 * 21238021 SPACE 3 21245021 ANANE XC X1VAL(LX4),X1VAL 21252021 CLI DOP1,PLFCON TEST FOR FIGCON SENDING. 21259021 BE MOVE31 CNVRT FIG CON TO ALPHA LITERAL 21266021 CLI DOP1,XGFCT 21273021 BE MOVE32 FOR ALPHA FIG CON 21280021 MOVE35 LA RW6,MOVE38 21287021 LA RW2,DOP1 GET SENDING LENGTH. 21294021 MOVE40 BAL R14,CALCLG CALCULATE LEN OF DN RTN 21301021 B MOVE02A DATA ERROR ROUTINE 21308021 TM LENGTH,XX80 21315021 BO MOVE33 VARIABLE LENGTH SENDING. 21322021 MVI XCON1+NX16,XX02 21329021 SR R14,R14 CLEAR OUT R14 43090 21336021 A R14,C32767 R14=MAX LENGTH IN HALFWORD 43090 21343021 C R14,LENGTH HALFWORD LARGE ENOUGH? 43090 21350021 BH MOVELEN YES 43090 21357021 MVI XCON1+NX16,XX04 NO-FULLWORD 43090 21364021 MOVELEN MVC XCON1+NX12(LX4),LENGTH 43090 21371021 B MOVE34 L 0,LENGTH OF SENDING. 21378021 C32767 DC F'32767' MAX LENGTH IN HALFWORD 43090 21385021 MOVE33 MVI XCNTR1,XX04 21392021 MVC XCNTR1+NX1(LX2),LENGTH+NX2 21399021 MOVE34 BAL R14,LOAD GENERATE LOAD ATEXT 21406021 BR RW6 RETURN TO CALLER 21413021 * SET ADDRESS OF SENDING. 21420021 * 21427021 MOVE38 MVI XREG1,XX01 21434021 MVC OP1(LX4),XAOPE1 21441021 BAL R14,LA GENERATE LOAD ADDRESS ATEXT 21448021 * 21455021 * SET ADDRESS OF EDITING MASK. 21462021 * 21469021 MVI DOP3,XGALC SET A NON-NUMERIC LITERAL 21476021 MVC DOP3+NX2(LX90),DOP2+NX11 WITH THE MASK. 21483021 SR RW1,RW1 21490021 IC RW1,DOP2+NX8 21497021 BCTR RW1,R0 DECREMENT BY ONE 21504021 BCTR RW1,R0 DECREMENT BY ONE 21511021 STC RW1,X1VAL+NX1 SAVE LENGTH OF MASK. 21518021 STC RW1,DOP3+NX1 21525021 MVI XREG1,XX03 21532021 MVC OP1(LX4),XAOPE3 LA 3,MASK 21539021 BAL R14,LA GENERATE LOAD ADDRESS ATEXT 21546021 * 21553021 * SET ADDRESS OF RECEIVING 21560021 * 21567021 MVC OP1(LX4),XAOPE2 21574021 MVI XREG1,XX02 21581021 BAL R14,LA LA 2,RECEIVING 21588021 BAL R14,VBADCE L 15,V(ANE0) 21595021 DC C'ANE0' BALR 14,15 21602021 * 21609021 * SET UP THE DC'S. 21616021 * 21623021 LA RW2,DOP2 21630021 BAL R14,CALCLG CACULATE LENGTH OF DN RTN 21637021 B MOVE02A DATA ERROR ROUTINE 21644021 MVC X1VAL+NX2(LX2),LENGTH+NX2 21651021 TM DOP2+NX7,XX01 21658021 BZ MOVE36 BRANCH IF NOT RIGHT JUSTIFIED 21665021 OI X1VAL,XX80 RIGTH JUSTIFIED. 21672021 MOVE36 MVI XCON1,XX04 21679021 MVC XCON1+NX1(LX4),X1VAL GENERATE THE DC'S. 21686021 MVI XIMM,MDC 21693021 BAL R14,MACRO GENERATE DC ATEXT 21700021 B PH5CTL PROCESS NEXT P2TEXT 21707021 SPACE 3 21714021 * 21721021 * TAKE CARE OF SENDING FIGCON. 21728021 * 21735021 MOVE31 MVI DOP1,XGALC CHANGE FIGCON TO ALPHA-LIT. 21742021 OI X1VAL,XX40 FIGCON FLAG. 21749021 B MOVE35 PROCESS ALPHA MOVE 21756021 SPACE 2 21763021 MOVE32 MVC DOP1+NX2(LX1),DOP1+NX1 21770021 MVI DOP1+NX1,XX01 21777021 B MOVE31 CNVRT FIGCON TO ALPHA LITERAL 21784021 SPACE 5 21791021 * PLURAL FIGCON TO ALPHANUM. 21798021 * 21805021 SPACE 2 21812021 MOVE30 MVI DOP1,XGALC 21819021 MVI XREG1,XX02 21826021 MVC OP1(LX4),XAOPE1 LA 2,FIGCON 21833021 BAL R14,LA GENERATE LOAD ADDRESS ATEXT 21840021 LA RW2,DOP2 21847021 BAL RW6,MOVE40 L 0,LENGTH-RECEIV. 21854021 MVI XREG1,XX01 21861021 MVC OP1(LX4),XAOPE2 21868021 BAL R14,LA LA 1,REC. 21875021 BAL R14,VBADCE L 15,V(ANF0) 21882021 DC C'ANF0' BALR 14,15 21889021 SR RW0,RW0 21896021 IC RW0,DOP1+NX1 21903021 MVI XCON1,XX02 FLAG 21910021 STC RW0,XCON1+NX2 DC X'0000' LENGTH OF FIGCON. 21917021 TM DOP2+NX7,XX01 21924021 BZ MOVE41 IF NOT RIGHT JUSTIFIED BRANCH 21931021 OI XCON1+NX1,XX80 21938021 MOVE41 MVI XIMM,MDC 21945021 BAL R14,MACRO GENERATE DCS IN ATEXT 21952021 B PH5CTL PROCESS NEXT P2 TEXT 21959021 TITLE ' IKFCBL51: COMMON NONNUMERIC ROUTINES' 21966021 * 21973021 * CONVERT BINARY AND ID TO ED AND THEN CHANGE THE DATA-NAME 21980021 * FORMAT TO ALPHANUMERIC. 21987021 * 21994021 * GET TYPE OF SENDING 22001021 SPACE 2 22008021 CNVNUM DS 0H 22015021 STM XRSUB,XRVAR,IMSAVE 22022021 BALR XRVAR,RW0 SET UP ADDRESSABILITY 22029021 USING *,XRVAR 22036021 L RW2,LENGTH 22043021 LA RW3,DOP1 22050021 CLI DNMINR,XGBINR 22057021 BE MOVE00 BINARY 22064021 CLI DNMINR,XGINDC 22071021 BE MOVE01A ID 22078021 CLI DNMINR,XGEXDC 22085021 BNE MOVE02A SHOULD NOT HAPPEN 22092021 SPACE 2 22099021 * CHANGE DATA-NAME FORMAT TO 22106021 MOVE03A NI DOP1+NX3,XX0F ALPHA NUM. - SET MINOR CODE 22113021 OI DOP1+NX3,XX30 22120021 ST RW2,XGTEM2 22127021 MVC DOP1+NX8(LX2),XGTEM2+NX2 SET LENGTH. 22134021 SPACE 2 22141021 CLC DOP1+NX4(LX3),XC000 22148021 BNE MOVE20 IF IDK FIELD NOT ZERO BRANCH 22155021 MOVE23 EQU * 22162021 LH RW0,XIDDN RESET SIGN TO F 22169021 STC RW0,XCNTR1+NX2 X 22176021 MVI XCNTR1,XX30 X 22183021 MVI IMM,XXF0 X 22190021 BAL R14,OI X 22197021 MOVE21 EQU * 22204021 NI DOP1+NX7,XXFE GET RID OF SIGN BIT. 22211021 LM XRSUB,XRVAR,IMSAVE 22218021 BR XRSUB RETURN 22225021 MOVE20 TM DOP1+NX7,XX01 22232021 BZ MOVE21 IF NOT RIGHT JUSTIFIED BRANCH 22239021 CH RW2,TS2MAX 22246021 BNH MOVE22 IF DOP NOT GRTHN MAXCORE SKIP 22253021 STH RW2,TS2MAX 22260021 MOVE22 ST RW3,OP1 22267021 MVI XCNTR1,XX30 22274021 MVI XCNTR1+NX2,XX01 22281021 STH RW2,XL1 22288021 BAL R14,MVC GENERATE MVC FOR MOVE 22295021 XC DOP1+NX4(LX3),DOP1+NX4 22302021 B MOVE23 RESET SIGN TO F 22309021 SPACE 2 22316021 MOVE02A BAL R14,ERRPRO LOGIC ERROR - UNEXPECTED INPUT. 22323021 DC AL1(ERRN05) 22330021 DC AL1(8) 22337021 SPACE 2 22344021 MOVE01A ST RW3,OP1 SENDING IS ID. 22351021 MOVE08A LH RW0,XIDDN UNPACK IN TS2. 22358021 CH RW0,TS2MAX 22365021 BNH MOVE05A IF ENOUGH STORAGE SKIP NXT INSTR 22372021 STH RW0,TS2MAX SET TS2 MAX. LENGHT IF NEC. 22379021 MOVE05A MVI XCNTR1,XX30 22386021 MVI XCNTR1+NX2,XX01 22393021 CH RW0,XC016 MORE THAN 16 DIGITS 22400021 BH MOVE04A YES TWO UNPK ARE NECESSARY. 22407021 STH RW0,XL1 22414021 STH RW2,XL2 22421021 BAL R14,LCRBI GENERATE UNPK TS2(L), DN(LL) 22428021 MOVE06A LH RW2,XIDDN L= NUMBER OF DIGITS. 22435021 XC DOP1+NX4(LX3),DOP1+NX4 LL = PACK DECIMAL LENGTH. 22442021 B MOVE03A CHANGE DN FORMAT TO ALPHANUM 22449021 SPACE 2 22456021 MOVE04A SH RW0,XC002 IF MORE THAN 16 DIGITS TO UNPACK 22463021 STH RW0,XL1 GENERATE : 22470021 BCTR RW2,R0 DECREMENT BY ONE 22477021 STH RW2,XL2 UNPK TS2(L-2),DN(LL-1) 22484021 BAL R14,LCRBI UNPK TS2+L-3(3),DN+LL-2(2) 22491021 BCTR RW2,R0 DECREMENT BY ONE 22498021 CLI XBDBY+NX1,XX00 22505021 BNE MOVE09A IF NO CNUSM SKIP NXT CODE 22512021 MVI BDISP2,XXD0 SET BDISP ELEMENT IF COMING BACK 22519021 AR RW6,RW2 22526021 STC RW6,BDISP2+NX1 FROM BI TO ID CONVERSION. 22533021 B MOVE11 IF CNVSN SKIP NXT CODE 22540021 MOVE09A ST RW3,OP1 22547021 STC RW2,PLUS2+NX2 22554021 MOVE11 STC RW0,XCNTR1+NX2 22561021 MVI XCNTR1,XX30 22568021 MVI XL1+NX1,XX03 22575021 MVI XL2+NX1,XX02 22582021 BAL R14,LCRBI GENERATE UNPK A-TEXT 22589021 B MOVE06A CHANGE DN FORMAT TO ALPHANUM 22596021 SPACE 2 22603021 * DN IS BINARY 22610021 MOVE00 LH RW0,XBDBY 22617021 MVI XBDBY+NX1,XX00 22624021 ST RW3,OP1 22631021 CH RW0,XC004 IF BINARY SIZE IS < 4BYTES GENERATE 22638021 BH MOVE07A IF NOT LT 4 BYTES GENERATE LM 22645021 BAL R14,LOAD L 0, DN 22652021 MVI BDISP1,XXD0 CVD 0,WC 22659021 MVI BDISP1+NX1,WORKAB 22666021 BAL R14,CVDBI GENERATE CVD A-TEXT 22673021 LA RW6,WORKAB+NX8 SET SECOND OPERAND CELL FOR 22680021 MOVE10 MVI BDISP2,XXD0 UNPACK ROUTINE 22687021 LH RW2,XIDBY 22694021 SR RW6,RW2 22701021 STC RW6,BDISP2+NX1 22708021 B MOVE08A GENERATE UNPK ATEXT 22715021 SPACE 2 22722021 MOVE07A MVI XREGNO,XX01 22729021 MVI XREG2,XX01 BINARY SIZE IS 8 - GENERATE 22736021 BAL R14,LM LM 0,1,DN 22743021 BAL R14,VBADCE L 15,V(BID1) 22750021 DC C'BID1' BALR 14,15 22757021 LA RW6,WORKAB+NX10 CONVERTED RESULT IS AT WORKAB(13) 22764021 B MOVE10 AND IS 10 BYTES LONG. 22771021 EJECT 22778021 *=1 ALPHA GENERATION ROUTINE. COMMON TO BOTH ALPHA IF AND MOVE 22785021 * 22792021 * 22799021 MOVE EQU XALAMV 22806021 * 22813021 * 22820021 IMGEN BALR GVERB,RW0 ESTABLISH ADDRESSABILITY 22827021 USING *,GVERB 22834021 LM RW1,RW3,IMLCH LOAD RW1 THRU RW3 22841021 LH RW5,H256 22848021 LR RW4,RW1 SET RW4 EQUAL NUMBER COMMON BYTES PLU 22855021 A RW4,IMLFC NUMBER EXCESS BYTES...IF, TOTAL NUM 22862021 * OF BYTES TO BE ACCOUNTED FOR 22869021 * 22876021 * 22883021 * 22890021 IMGEN1 CR RW1,RW5 TEST IF GT 256 BYTES LEFT 22897021 BC NOTLO,IMGEN2 BR IF YES 22904021 LTR RW5,RW1 PUT NUMBER BYTES LEFT IN RW5 22911021 BC ZERO,IMGEN4 BR IF ZERO BYTES LEFT 22918021 * 22925021 * 22932021 IMGEN2 MVC OP1(LX8),IMPTR1 SET UP TO GENERATE 22939021 ST RW2,PLUSST 22946021 MVC PLUS2(LX3),PLUSST+NX1 22953021 ST RW3,PLUSST 22960021 MVC PLUS1(LX3),PLUSST+NX1 22967021 STH RW5,XL1 OR OPD2+I2(N),OPD1+I1 22974021 L RETRG,IMIRTN CLC 22981021 BALR RETRG,RETRG WHERE N IS IN RW5 22988021 AR RW2,RW5 I2 IS I 22995021 AR RW3,RW5 I1 IS I 23002021 SR RW1,RW5 23009021 SR RW4,RW5 23016021 IMGEN3 EQU * 23023021 CLI IMVRBC,XCM TEST IF VERB IS MOVE RATHER THAN IF 23030021 BC EQ,IMGEN1 BR IF YES 23037021 LTR RW4,RW4 23044021 BC NOTZER,IMG3B IF NOT YET ALL BYTES SKIP NXT 23051021 IMG3A LA RW6,DX2(RW6) 23058021 IMG3B CLI DX0(RW6),XX00 23065021 BC EQ,IMG3C IF 1ST WORD OF TBL 0 SKIP NXT CD 23072021 MVI XREG2,XX02 23079021 MVC XREG1(LX1),DX0(RW6) 23086021 BAL RETRG,BRANCH GENERATE BRANCH INSTRUCTION 23093021 IMG3C CLI DX1(RW6),XX00 23100021 BC EQ,IMGEN1 IF MORE BYTES PROCESS 23107021 MVI XREG2,XX01 23114021 MVC XREG1(LX1),DX1(RW6) 23121021 BAL RETRG,BRANCH GENERATE BRANCH INSTRUCTION 23128021 B IMGEN1 GENERATE A-TEXT 23135021 SPACE 5 23142021 SPACE 5 23149021 IMGEN4 LH RW5,H256 RESTORE RW5 TO 256 23156021 LA RW6,DX4(RW6) STEP TO NEXT WORD IN TABLE FOR 'IF' 23163021 LM RW1,RW3,IMLFC LOAD REGS FOR PROCESSING EXCESS 23170021 XC IMLFC(LX4),IMLFC ZERO FIELD SO NEXT TIME THRU RW1 GETS 23177021 LTR RW4,RW1 TEST IF ANY BYTES TO BE PROCESSED 23184021 BC ZERO,IMEND BR IF NO 23191021 MVC IMPTR2,IMPTR3 SET OPD1 AND OPD2 EQUAL 23198021 MVC IMPTR1,IMPTR3 SET UP TO GENERATE 23205021 MVC IMM,IMCHAR 23212021 MVC OP1,IMPTR1 MVI 23219021 STH RW3,PLUS1+NX1 OR OPD2+I2,C'FIGCON' 23226021 L RETRG,IMIRTN+NX4 CLI 23233021 BALR RETRG,RETRG GENERATE CLI INSTRUCTION 23240021 BCTR RW1,RW0 SUBTRACT 1 FROM REG 1 23247021 BCTR RW4,RW0 SUBTRACT 1 FROM REG 1 23254021 LR RW2,RW3 23261021 LA RW3,DX1(RW3) 23268021 B IMGEN3 BRANCH TO IMGEN3 23275021 SPACE 5 23282021 IMEND CLI IMVRBC,XCM TEST IF VERB IS MOVE RATHER THAN IF 23289021 BC NOTEQ,IMENDI BR IF NO 23296021 TM IOMOVESW,MSWON IS THIS AN IOMOVE? 23303021 BO IORETURN YES 23310021 BC UNCOND,PH5CTL RETURN TO PH5 CTL 23317021 IMENDI TM IMIFSW,XX01 TEST IF GN REF GENERATED EARLIER BY P 23324021 BC NOTONE,PH5CTL BR IF NO 23331021 BAL RETRG,GNOPT3 GENERATE GN DEFINITION 23338021 BC UNCOND,PH5CTL PROCESS NXT P2 TEXT 23345021 EJECT 23352021 IMINIT STM RETRG,XRVAR,IMSAVE 23359021 BALR XRVAR,RW0 ESTABLISH ADDRESSABILITY 23366021 *=1 ALPHA INITIALIZATION ROUTINE. DOES INIT FOR ALPHA IF AND MO 23373021 SPACE 3 23380021 USING *,XRVAR 23387021 IMINIT0 XC IMAREA(LX25),IMAREA 23394021 MVI IMCHAR,XX40 23401021 LA RW4,DOP1 ADDR OPD1 TO RW4 23408021 LA RW5,DOP2 ADDR OPD2 TO RW5 23415021 CLI IMVRBC,XCM MOVE... 23422021 BE IMCONT YES 23429021 CLI DOP1,PLFCON PLURAL FIGCON IN 'IF'... 23436021 BE IFALL1 YES 23443021 IMCONT EQU * 23450021 LR RW2,RW4 PUT OPD 1 ADDR IN RW2 FOR NEXT CALLS 23457021 BAL RETRG,IMLIT EXECUTE TO TEST FOR AND PROCESS NUM L 23464021 BAL RETRG,CALCLG CALL RTN TO GET LENGTH 23471021 BC UNCOND,PH5CTL ERROR RETURN 23478021 L RW3,LENGTH PUT LENGTH IN RW3 23485021 CLI LENGTH,XX00 TEST IF VARIABLE LENGTH 23492021 BC NOTEQ,IMVAR0 BR IF YES 56141 23499021 CLI DOP2,PLFCON PLURAL FIGCON... 23506021 BE IFALL2 YES 23513021 CH RW3,XC4096 LENGTH GR THAN 4096.... 23520021 BH IMVAR0 YES, GEN CALL TO SUBR 56141 23527021 LR RW2,RW5 PUT OP2 ADDR IN R2 FOR NEXT CALLS 23534021 BAL RETRG,IMLIT EXECUTE TO TEST FOR AND PROCESS NUM L 23541021 BAL RETRG,CALCLG CALL RTN TO GET LENGTH 23548021 BC UNCOND,PH5CTL ERROR RETURN 23555021 CLI LENGTH,XX00 TEST IF VARIABLE LENGTH 23562021 BC NOTEQ,IMVARL BR IF YES 23569021 L RW2,LENGTH L2 TO RW2 23576021 CH RW2,XC4096 LENGTH GR THAN 4096.... 23583021 BH IMVARL YES, GEN CALL TO SUBR 23590021 LR RW1,RW3 L1 TO RW1 23597021 CLI DOP2,XX75 TEST IF OPD2 IS FIGCON 23604021 BC NOTEQ,IM1NFC BR IF NO 23611021 MVC IMCHAR,DOP2+NX1 SAVE FIGCON CHAR 23618021 LR RW2,RW1 SET L2 EQ L1 23625021 IM1NFC CLI DOP1,XX75 TEST IF OPD1 IS FIGCON 23632021 BC NOTEQ,IM2NFC BR IF NO 23639021 LR RW1,RW2 SET L1 EQ L2 23646021 MVC IMCHAR,DOP1+NX1 SAVE FIGCON CHAR 23653021 CLI IMVRBC,XCM TEST IF VERB IS MOVE 23660021 BC EQ,IM2NFC BR IF YES 23667021 LR RW0,RW5 SWAP OPDS SO THAT FOR IF, IF A FI 23674021 LR RW5,RW4 IS PRESENT IT IS THE SECOND OPD 23681021 LR RW4,RW0 23688021 L RW6,DX0(RW6) SWAP RELATIONAL...SINCE OPDS WERE 23695021 * SWAPPED RELATIONAL MUST BE SWAP 23702021 * FOR PROPER GENERATION. RW6 POIN 23709021 * TO A TABLE USED FOR GENERATION 23716021 * BC INSTRUCTIONS. THE FIRST WORD 23723021 * THE TABLE CONTAINS THE ADDR OF 23730021 * TABLE FOR THE OPPOSITE RELATION 23737021 * HENCE THE SUBJECT INSTRUCTION H 23744021 * THE EFFECT OF SWAPPING THE RELA 23751021 IM2NFC SR RW3,RW2 L1 - L2 TO RW3 23758021 LPR RW3,RW3 FORCE POSITIVE NUMBER 23765021 CR RW2,RW1 SET COND CODE 23772021 * AT THIS POINT RW1 THRU RW5 ARE SET AS FOLLOWS 23779021 * 23786021 * RW1 LENGTH OF OPD1 23793021 * RW2 LENGTH OF OPD2 23800021 * RW3 ABSOLUTE VALUE OF DIFFERENCE OF LENGTHS 23807021 * RW4 POINTER TO OPD1 23814021 * RW5 POINTER TO OPD2 23821021 * RW6 POINTER TO TABLE...USED FOR IF ONLY. 23828021 * 23835021 * ALSO, CONDITION CODE IS SET AS FOLLOWS 23842021 * 23849021 * HI IF L2 GT L1 23856021 * LO IF L2 LT L1 23863021 * EQ IF L2 EQ L1 23870021 * 23877021 * 23884021 LM RETRG,XRVAR,IMSAVE RESTORE RETRG 23891021 BCR UNCOND,RETRG RETURN 23898021 * 23905021 * 23912021 IMLIT CLI DX0(RW2),XX32 RTN TO TEST IF OPD IS INTERNAL DECIMA 23919021 BCR NOTEQ,RETRG LITERAL AND IF IT IS CONVERT IT TO 23926021 STM RW2,RW3,IMLSAV ALPHANUMERIC LITERAL 23933021 SR RW0,RW0 23940021 SR RW1,RW1 23947021 UNPK IMWORK(LX15),DX4(LX8,RW2) THESE 2 UNPACK INSTR'S UNPACK 23954021 UNPK IMWORK+NX14(LX7),DX11(LX4,RW2) BYTES...EVEN IF LTL REQUI 23961021 IC RW1,DX1(RW2) GET NUMBER OF BYTES ACTUALLY USED TO 23968021 SH RW1,XC002 EXPRESS THE LITERAL 23975021 SLL RW1,DX1 CALCULATE ADDRESS OF BYTE 23982021 LA RW3,IMWORK-NX2(RW1) INTO WHICH LAST DIGIT OF LTL WAS UN 23989021 IC RW1,DX2(RW2) CALCULATE ACTUAL NUMBER OF DIGITS 23996021 IC RW0,DX3(RW2) SPECIFIED IN SOURCE LITERAL 24003021 AR RW1,RW0 24010021 STC RW1,DX1(RW2) STORE NUMBER AS LNG OF ALPHA LTL 24017021 SR RW3,RW1 CALCULATE ADDR OF BYTE PRECEDING FIRS 24024021 MVC DX2(LX18,RW2),DX1(RW3) BYTE OF UNPACKED LTL...THEN MOVE 24031021 MVI DX0(RW2),XX34 MOVE CODE SPECIFYING ALPHANUM LITERAL 24038021 LM RW2,RW3,IMLSAV OPRND AREA POINTED TO BY RW2 NOW LOOK 24045021 BCR R15,RETRG LIKE //CODE/LENGTH/UNPACKED LITERA 24052021 * 24059021 * 24066021 * PLURAL FIGCON WILL APPEAR ONLY IF VERB IS 'IF'. IN 'MOVE' IT IS 24073021 * INTERCEPTED BEFORE THIS POINT. 24080021 IMVAR0 EQU * SF VAR LENGTH OR GT 4096 56141 24087021 LR RW2,RW5 PUT OPD2 ADDR IN R2 FOR NEXT CALLS 56141 24094021 BAL RETRG,IMLIT EXECUTE TO TEST FOR AND PROCESS NUM L56141 24101021 BAL RETRG,CALCLG CALL RTN TO GET LENGTH 56141 24108021 BC UNCOND,PH5CTL ERROR RETURN 56141 24115021 IMVARL EQU * 24122021 CLI DOP2,PLFCON 24129021 BE IFALL2 CALL OTSR 24136021 CLI IMVRBC,XCM IS VERB MOVE 24143021 BNE IMVAR2 FOR IF SKIP NEXT CODE 24150021 CLI DNMINR,XX01 FIXED GRP REC 40180 24157021 BE IMVAR2 YES 40180 24164021 CLI DNMINR,XX04 VAR GRP REC 40180 24171021 BE IMVAR2 YES 40180 24178021 TM DOP2+NX7,XX01 TEST IF OPD2 JUSTIFIED 24185021 BC ZERO,IMVAR2 BR IF NO 24192021 MVI IMOTS+NX3,XXF1 RIGHT JUSTIFIED - ILBOVMO1 40180 24199021 IMVAR2 EQU * 24206021 L GVERB,IMADCN 24213021 L XRVAR,IMSAVE+NX4 24220021 LA RW3,IMOTS 24227021 BAL RETRG,VBALR1 GENERATE L 15,=V(VLXXXX 24234021 LA RW2,DOP1 BALR 1,15 24241021 BAL RETRG,DIINFO GENERATE PARAM FOR OPD1 24248021 LA RW2,DOP2 24255021 BAL RETRG,DIINFO GENERATE PARAM FOR OPD2 24262021 CLI IMVRBC,XCM TEST IF VERB IS MOVE 24269021 BC EQ,IMEND BR IF YES 24276021 IMVAR1 EQU * 24283021 LA RW6,DX4(RW6) STEP PAST ADCON IN TABLE 24290021 SR RW1,RW1 24297021 ST RW1,IMLFC 24304021 MVC XGN1(LX2),DOP3+NX1 GENERATE L 15,GN1 24311021 MVI XREG1,XX02 24318021 BAL RETRG,LOAD BRANCH TO GENERATE LOAD ATEXT 24325021 L GVERB,IMADCN 24332021 L XRVAR,IMSAVE+NX4 24339021 BC UNCOND,IMG3A RETURNS TO IF MOVE ROUTINE 24346021 * IFALL- COMPARE OF DATA NAME AND PLURAL FIGCON. 24353021 * IF FIGCON IS 2ND OPD ENTRY IS AT IFALL2. GENERATES 24360021 * CALL TO OBJECT TIME SUBR 'XXXXIVL0' FOR THE COMPARE. 24367021 IFALL1 LR RW2,RW5 SWAP OPDS SO FIGCON IS 2ND OPD 24374021 LR RW5,RW4 24381021 LR RW4,RW2 24388021 L RW6,DX0(RW6) SWAP RELATIONALS TOO 24395021 BAL RETRG,CALCLG GET LENGTH OF NON-FIGCON OPD 24402021 B PH5CTL ERROR RETURN 24409021 IFALL2 EQU * 24416021 MVI DX0(RW5),XX34 CHANGE FIGCON TO ALPHA LITERAL 24423021 SR RW2,RW2 24430021 IC RW2,DX1(RW5) 24437021 LR RW3,RW2 24444021 STC RW2,XL1+NX1 SET LENGTH OF FIGCON FOR MVC 24451021 MVI XCNTR1,XX1C 24458021 MVI XCNTR1+NX2,XX01 SET CODE FOR PRAM1 24465021 ST RW5,OP1 24472021 BAL RETRG,MVC * MVC PARM1(FCON LNGTH)FCON 24479021 LA RW2,DX3(RW2) 24486021 SRL RW2,DX2 GET NUMB OF PARM CELLS USED 24493021 CH RW2,PARMAX IS IT MORE THAN CURRENT MAX.. 24500021 BNH IFALL3 NO 24507021 STH RW2,PARMAX YES, SET NEW PARMAX 24514021 IFALL3 STC RW3,XCON1+NX15 24521021 MVI XCON1+NX16,XX02 24528021 BAL RETRG,LOAD * L R0,FIGCON-LNGTH 24535021 CLI LENGTH,XX00 FIXED LENGTH OPD... 24542021 BE IFALL4 YES 24549021 MVI XCNTR1,XX04 NO, SET ATXT FOR VLC 24556021 MVC XCNTR1+NX1(LX2),LENGTH+NX2 24563021 B IFALL5 GENERATE LOAD OF LEN INTO REG 1 24570021 IFALL4 MVI XCON1+NX16,XX02 SET ATXT FOR LIT=LEN DATA OPD 24577021 MVC XCON1+NX14(LX2),LENGTH+NX2 24584021 IFALL5 MVI XREG1,XX01 24591021 BAL RETRG,LOAD * L R1,LNGTH DATA OPD 24598021 MVI XREG1,XX02 24605021 MVI XCNTR1,XX1C 24612021 MVI XCNTR1+NX2,XX01 24619021 BAL RETRG,LA * LA R2,PARM1(LOCAT OF FCON) 24626021 MVI XREG1,XX03 24633021 ST RW4,OP1 24640021 BAL RETRG,LA * LA R3,DATA OPD 24647021 BAL RETRG,VBADCE * L R15,V(XXXXIVL0) 24654021 DC C'IVL0' * BALR 14,15 24661021 B IMVAR1 BRANCH TO GENERATE L TO BRANCH 24668021 TITLE 'IKFCBL51: CLASS TEST ANALYZER C L A S S T E S T' 24675021 IKF50H CSECT 24682021 * 24689021 *=1 CLASS TEST ANALYZER 24696021 * 24703021 * A SEPERATE ENTRY POINT EXISTS FOR EACH TYPE OF CLASS T 24710021 * IE, ALPHA, NOT ALPHA, NUMERIC, NOT NUMERIC. 24717021 * 24724021 * THE ENTRY POINT IS DETERMINED BY THE VALUE OF THE VERB CODE. 24731021 * THIS CODE MAY APPEAR TO BE DIFFERENT FROM THE VERB USED IN 24738021 * THE SOURCE STATEMENT. PHASE4 FLIPS THE VERB EG. NUMERIC BECOM 24745021 * NOT NUMERIC, IN SIMPLE 'IF'. IN COMPOUND IF VERBS MAY OR MAY 24752021 * BE CHANGED BY PHASE4. 24759021 * AT EACH ENTRY POINT THE ADDRESS OF THE TABLE FOR THAT 24766021 * TYPE OF CLASS TEST IS PUT INTO RW6. THEN CONTROL IS GIVEN TO 24773021 * THE COMMON CLASS TEST RTN. 24780021 * 24787021 * THE INPUT ALWAYS HAS TWO OPDS. OPD1 IS A DATA-NAME AND 24794021 * THE FIELD TO BE TESTED. OPD2 IS THE GN TO TRANSFER TO IF THE 24801021 * RELATIONAL IS SATISFIED. 24808021 * 24815021 * 24822021 *NOTE........ALL LABELS ASSOCIATED SOLELY WITH THIS ANALYZER BEGIN 24829021 * THE CHARACTERS 'CL'. 24836021 SPACE 5 24843021 USING *,GVERB 24850021 PALFA LA RW6,CLATB SET RW6 TO ADDR OF TABLE FOR IF ALPHA 24857021 MVI CLSSW,XX01 INDICATE ALPHABETIC TEST 24864021 B CLANAL BRANCH TO CLANAL RTN 24871021 USING *,GVERB 24878021 NALFA LA RW6,CLNATB SET RW6 TO ADR OF TBL FOR 'IF NOT ALP 24885021 MVI CLSSW,XX01 INDICATE ALPHABETIC TEST 24892021 B CLANAL BRANCH TO CLANAL RTN 24899021 USING *,GVERB 24906021 PNUMRC EQU * 24913021 MVI CLCOND,XX08 24920021 LA RW6,NORNNT 24927021 B CLANAL BRANCH TO COMMON TEST ROUTINE 24934021 USING *,GVERB 24941021 NNUMRC LA RW6,NORNNT SET RW6 TO ADR OF 1BYTE TABLE FO 24948021 * NAME OF TABLE 24955021 MVI CLCOND,XX07 24962021 CLANAL BALR GVERB,RW0 ESTABLISH ADDRESSABILITY 24969021 USING *,GVERB 24976021 CLANAB EQU * 24983021 MVI NORNNT,XCE 24990021 LA RW2,DOP1 24997021 BAL RETRG,CALCLG GET LENGTH OF OPD1 25004021 B PH5CTL RETURN TO PH5 CONTROL 25011021 CLI CLSSW,XX01 ALPHABETIC TEST... 25018021 MVI CLSSW,XX00 25025021 BE CLAN05 YES 25032021 CLI DNMINR,XFIVE 25039021 BNH CLAN01 OPD IS NUMERIC EDITED,FIXED OR 25046021 * VAR LENGTH GP OR ALPHANUMERIC-TREATED AS UNSIGNED ED. 25053021 CLI DNMINR,XGANE 25060021 BE CLAN01 ALPHANUMERIC EDITED 25067021 CLI DNMINR,XGEXDC 25074021 BNE CLAN04 NOT XTERNAL DECIMAL, BRANCH 25081021 TM XGSCIN(RW2),XX01 SIGNED EXTERNAL DECIMAL... 25088021 BO CLAN05 YES 25095021 CLAN01 MVI DX0(RW6),XCW UNSIGNED ED 25102021 B CLAN05 GENERATE CONSTANT ATEXT 25109021 CLAN04 CLI DNMINR,XGINDC 25116021 BNE CLAN05 IF NOT INTERNAL DEC GEN A TEXT 25123021 TM XGSCIN(RW2),XX01 SIGNED INTERNAL DECIMAL... 25130021 MVI DX0(RW6),XCI 25137021 BO CLAN05 YES 25144021 MVI DX0(RW6),XCU UNSIGNED ID 25151021 CLAN05 EQU * 25158021 * 25165021 * 25172021 MVC CLTBNM+NX4(LX1),DX0(RW6) 25179021 MVC GVIRT1(LX8),CLTBNM MOVE TABLE NAME FOR GENERATION 25186021 * 25193021 MVC VIRTC1+NX2(LX2),VIRCTR 25200021 MVI XREG1,XX02 25207021 BAL RETRG,LOAD GEN L 2,=V(XTBL) 25214021 CLI LENGTH,XX00 TEST IF VARIABLE LNG X=A I O 25221021 BC NOTEQ,CLVL BR IF YES 25228021 CLI LENGTH+NX2,XX00 TEST IF LENGTH GT 256 25235021 BC NOTEQ,CLVL BR IF YES 25242021 MVC XL1(LX2),LENGTH+NX2 25249021 MVI BDISP2,XX20 25256021 ST RW2,OP1 25263021 BAL RETRG,TRT GEN TRT OPD1(LNG),0( 25270021 * 25277021 * 25284021 VLCLRT EQU * 25291021 MVC XGN1(LX2),DOP2+NX1 25298021 MVI XREG1,XX01 25305021 BAL RETRG,LOAD GEN L 1,GN 25312021 CLI DX0(RW6),XXC1 IS TEST ALPHA OR NUM 25319021 BE VLCLR1 ALPHA 25326021 CLI CLTBNM+NX4,XCW WTB0 CALLS TREATED AS ALPHA 25333021 BNE NNNTST NUMERIC 25340021 VLCLR1 EQU * 25347021 MVC XREG1(LX1),DX1(RW6) 25354021 MVI XREG2,XX01 25361021 BAL RETRG,BRANCH GEN BCR COND,1 25368021 * 25375021 * 25382021 B QRETCL QUPDATE IF NEX AND PROC NXT P2 25389021 NNNTST MVI XREGNO,XX03 FREE REG 3 FOR NUM ORNOT NUM 25396021 MVI XREG1,XX04 25403021 MVC XCON1+NX15(LX2),CLCNF1 GEN L 4,=1 25410021 BAL RETRG,LOAD GENERATE LOAD INSTRUCTION 25417021 MVI XREG1,XX03 BALR 3,0 25424021 BAL RETRG,BALR GENERATE BALR INSTRUCTION 25431021 CLI GANLNO,XX0F IS VERB EQ NUM OR NOT-NUM 25438021 BC NOTEQ,NUM BRANCH IF NUM 25445021 CLI DX0(RW6),XXC5 IS IT ED OR ID 25452021 BC NOTEQ,IDNNM BRANCH IF ID 25459021 BAL RETRG,GATXTC ED,NOT-NUM 25466021 DC AL2(ATXT78-ATXTBC) 25473021 DC AL2(ZTXT78-ATXT78) 25480021 BAL RETRG,GATXTC COMPLETE ATEXT 25487021 DC AL2(ATXT76-ATXTBC) 25494021 DC AL2(ZTXT76-ATXT76) 25501021 QRETCL TM QRETSW,XX01 RETURN TO QUPDAT 25508021 BZ PH5CTL NO 25515021 L GVERB,ADCN43 YES-RESTORE R15 25522021 USING QUPDAT,GVERB 25529021 B QBINR UPDATE QUEUE 25536021 DROP GVERB 25543021 USING CLANAB,GVERB 25550021 IDNNM BAL RETRG,GATXTC ID,NOT-NUM 25557021 DC AL2(ATXT73-ATXTBC) 25564021 DC AL2(ZTXT76-ATXT73) 25571021 B QRETCL QUPDATE IF NEC AND PROC NXT P2 25578021 NUM CLI DX0(RW6),XXC5 IS IT ID OR ED 25585021 BC NOTEQ,IDNUM BRANCH IF ID 25592021 BAL RETRG,GATXTC FILL IN A TEXT 25599021 DC AL2(ATXT79-ATXTBC) 25606021 DC AL2(ZTXT79-ATXT79) 25613021 BAL RETRG,GATXTC FILL IN A TEXT 25620021 DC AL2(ATXT77-ATXTBC) 25627021 DC AL2(ZTXT77-ATXT77) 25634021 B PH5CTL RETURN TO PH5 CONTROL 25641021 IDNUM BAL RETRG,GATXTC ID,NUM 25648021 DC AL2(ATXT74-ATXTBC) 25655021 DC AL2(ZTXT77-ATXT74) 25662021 B PH5CTL RETURN TO PH5 CONTROL 25669021 * RTN FOR OPD1 BEING VARIABLE LENGTH 25676021 * 25683021 CLVL LA RW3,CLVLNM 25690021 BAL RETRG,VBALR1 GO TO GEN L 15,=V(VLCLAS 25697021 LA RW2,DOP1 BALR 1,15 25704021 BAL RETRG,DIINFO GO TO GEN PARAM FOR OPD1 25711021 BC UNCOND,VLCLRT GENERATE A TEXT 25718021 TITLE 'TRANSFORM VERB ANALYZER T R A N S F O R M' 25725021 * 25732021 * 25739021 *=1 TRANSFORM ANALYZER 25746021 * 25753021 * THE TRANSFORM ANALYZER IS GIVEN CONTROL BY PH5CTL WHENEVER A 25760021 * TRANSFORM STRING HAS BEEN ENCOUNTERED. 25767021 * 25774021 * THE INPUT TO THIS ANALYZER CONSISTS OF 4 OPERANDS. THE 25781021 * FIRST OPERAND IS AN 'INFO' TYPE OPD AND IS NOT USED. THE THI 25788021 * OPERAND IS THE 'FROM' OPD, THE FOURTH OPD THE 'TO' OPD AND T 25795021 * SECOND OPD IS THE DATA-NAME TO BE TRANSFORMED. 25802021 * 25809021 * THE GENERATION CONSISTS OF TWO PARTS. PART1 GENERATES 25816021 * TO SET UP A TRANSLATE TABLE AND PART2 GENERATES CODE TO DO 25823021 * TRANSLATION. 25830021 * 25837021 * THE GENERATION FOR PART1 ALWAY BEGINS WITH 25844021 * 25851021 * L 2,=V(TRTBL) 25858021 * MVC TS2(256),0(2) 25865021 * 25872021 * 'TRTBL' IS AN OBJECT 'SUBROUTINE' WHICH CONSISTS SOLELY OF A 25879021 * TRANSLATE TABLE WHERE BYTE 0 IS 00, BYTE 1 IS 01, ETC UP TO 25886021 * BYTE 255 IS FF. TS2 IS A TEMPORARY STORAGE AREA. THE REST OF 25893021 * THE CODING GENERATED IN PART1 CAUSES THE TRANSLATE TABLE TO 25900021 * MODIFIED IN THE TS2 AREA AS INDICATED BY OPDS 3 AND 4. 25907021 * THE REST OF THE CODING GENERATED IN PART 1 DEPENDS ON THE TY 25914021 * OF OPERANDS THAT OPD2 AND OPD3 ARE 25921021 * 25928021 * 1.IF OPD3 IS A 1-BYTE FIGCON OR LTL AND OPD4 IS A DATA 25935021 * 25942021 * MVC TS2+N(1),OPD4 25949021 * 25956021 * WHERE N IS THE VALUE OF THE FIGCON OR LTL 25963021 * 25970021 * 2.IF OPD3 IS A LITERAL NOT GREATER THAN 8 BYTES 25977021 * AND OPD4 IS A FIGCON OR LTL OF 1 BYTE. 25984021 * 25991021 * MVI TS2+N1,X'OPD4' 25998021 * MVI TS2+N2,X'OPD4' 26005021 * . 26012021 * . 26019021 * . 26026021 * THAT IS, AN MVI IS GENERATED FOR EACH BYTE OF OPD3. 26033021 * N1 IS THE VALUE OF THE 1ST BYTE OF THE LITERAL, N2 26040021 * IS THE VALUE OF THE 2ND BYTE OF THE LITERAL, ETC. 26047021 * 26054021 * 3. IF OPD3 AND OPD4 ARE LITERALS NOT GREATER THAN 8 BY 26061021 * BOTH OF EQUAL LENGTH AND GREATER THAN 1 BYTE. 26068021 * 26075021 * MVI TS2+N1,'OPD4' 26082021 * MVI TS2+N2,'OPD4+1' 26089021 * . 26096021 * . 26103021 * . 26110021 * SEE COMMENTS FOR =2 ABOVE. 26117021 * 26124021 * 4. IF OPD3 IS DATA-NAME GT 1 OR LITERAL GT 8 26131021 * 26138021 * LA 1,LENGTH-OF-OPD3 26145021 * SR 2,2 26152021 * BALR 3,0 26159021 * IC 0,OPD4(X) X= 0 IF OPD4 IS 1 BYTE LONG 26166021 * IC 2,OPD3(1) ' OTHERWISE X = 1 26173021 * STC 0,TS2(2) 26180021 * BCTR 1,0 26187021 * LTR 1,1 26194021 * BCR NOTNEG,3 26201021 * 26208021 * 5. IF OPD3 IS DATA-NAME 1-BYTE LONG 26215021 * 26222021 * SR 1,1 26229021 * IC 0,OPD4 26236021 * IC 1,OPD3 26243021 * STC 0,TS2(1) 26250021 * 26257021 * PART 2 OF THE CODING IS VARIABLE DEPENDING ON THE LENG 26264021 * OF OPD2. IF OPD2 IS NOT VARIABLE LENGTH THEN 26271021 * 26278021 * TR OPD2(256),TS2 26285021 * TR OPD2+256(256),TS2 26292021 * TR OPD2+512(256),TS2 26299021 * . 26306021 * . 26313021 * . 26320021 * TR OPD2+N(LENGTH),TS2 26327021 * 26334021 * WHERE N IS SOME MULTIPLE OF 256 AND LENGTH IS THE 26341021 * REMAINDER OF THE DIVISION OF THE TOTAL LENGTH BY 256. 26348021 * OF COURSE, IF THE TOTAL LENGTH IS NOT OT 256 ONLY THE 26355021 * LAST INSTRUCTION IS GENERATED. 26362021 * 26369021 * IF OPD 2 IS VARIABLE LENGTH THEN 26376021 * 26383021 * LA 2,TS2 26390021 * L 15,=V(TRVL) 26397021 * BALR 1,15 26404021 * PARAMETER FOR OPD2 26411021 * 26418021 * 26425021 * 26432021 USING *,GVERB 26439021 TRANSF MVI XREGNO,XX01 FREE REGISTERS 1 AND 2 26446021 BAL RETRG,GDES14 DESTORY REGISTER 14 26453021 BAL RETRG,GDES15 DESTROY REGISTER 15 26460021 LH RW1,H256 26467021 CH RW1,TS2MAX 26474021 BNH TRAAA SKIP NEXT INSTRUCTION 26481021 STH RW1,TS2MAX 26488021 TRAAA EQU * 26495021 MVC GVIRT1(LX8),TRNAM 26502021 MVC VIRTC1+NX2(LX2),VIRCTR 26509021 MVI XREG1,XX02 26516021 BAL RETRG,LOAD GENERATE L 2 ,=V(TRTBL) 26523021 MVI XCNTR1,XX30 26530021 MVI XCNTR1+NX2,XX01 26537021 LA RW0,DX256 26544021 STH RW0,XL1 26551021 MVI BDISP2,XX20 26558021 BAL RETRG,MVC GENERATE MVC TS2(256),0(2 26565021 LA RW2,DOP3 GET LENGTH OF OPD3 26572021 BAL RETRG,CALCLG GET LENGTH OF DOP3 26579021 BC UNCOND,PH5CTL RETURN TO PHASE 5 CONTROL 26586021 SPACE 2 26593021 MVC TRLNG3(LX2),LENGTH+NX2 SAVE LENGTH 26600021 LA RW2,DOP4 GET LENGTH OF OPD4 26607021 BAL RETRG,CALCLG GET LENGTH OF DOP4 26614021 BC UNCOND,PH5CTL RETURN TO PHASE 5 CONTROL 26621021 CLI DOP3,XX75 TEST IF OPD3 IS FIGCON 26628021 BC NOTEQ,TRA IF NOT FIGCON, BRANCH... 26635021 MVI DOP3,XX34 YES, CONVERT TO ALPHAN LITERAL 26642021 MVC DOP3+NX2(LX1),DOP3+NX1 26649021 MVI DOP3+NX1,XX01 26656021 TRA CLI DOP4,XX75 DITTO FOR OPD4 26663021 BC NOTEQ,TRB IF NOT FIGCON, BRANCH... 26670021 MVI DOP4,XX34 26677021 MVC DOP4+NX2(LX1),DOP4+NX1 26684021 MVI DOP4+NX1,XX01 26691021 TRB MVI TRINC4+NX1,XX00 INIT FIELD TO ZERO 26698021 CLI LENGTH+NX3,XX01 AND THEN SET IT TO 1 IF OPD4 IS 26705021 BE TRBBB LONGER THAN 1 BYTE 26712021 MVI TRINC4+NX1,XX01 26719021 TRBBB EQU * 26726021 CLI TRLNG3+NX1,XX01 TEST IF OPD3 HAS LENGTH OF 1 BYTE 26733021 BC NOTEQ,TRC BR IF NO 26740021 CLI DOP3,XX34 TEST IF OPD3 A LITERAL 26747021 BC NOTEQ,TRDN1 BR IF NO 26754021 BC UNCOND,TR1 GO TO RTN FOR OPD3 HAVING LNG OF 1 26761021 * AT THIS POINT IT IS KNOWN THAT OPD3 GT 1 B 26768021 TRC CLI DOP3,XX34 TEST IF OPD3 IS LITERAL 26775021 BC NOTEQ,TRDN BR IF NO 26782021 CLI TRLNG3+NX1,XX08 TEST IF LITERAL LENGTH GT 8 26789021 BC HI,TRDN BR IF YES 26796021 TR1 SR RW3,RW3 26803021 SR RW4,RW4 26810021 * 26817021 * RTN FOR GENERATING CODE FOR SETTING UP TRA 26824021 * TABLE FOR OPD3 LITERAL 8 BYTES OR LESS 26831021 TR1LP IC RW0,DOP3+NX2(RW3) PICK UP NEXT CHAR OF OPD3 LITERAL 26838021 STC RW0,PLUS1+NX2 AND PUT IT AS PLUS FACTOR IN NEXT I 26845021 * TO BE GENERATED 26852021 MVI XCNTR1,XX30 SET UP SO THAT TEMP STORAGE-2 WILL BE 26859021 MVI XCNTR1+NX2,XX01 OPD 1 OF NEXT INSTR GENERATED 26866021 CLI DOP4,XX34 TEST IF OPD4 IS A LITERAL 26873021 BC EQ,TR1A BR IF YES 26880021 STH RW4,PLUS2+NX1 NO, SET UP PLUS ELEMENT FOR OPD2 OF N 26887021 MVI XL1+NX1,XX01 INSTR TO BE GENERATED...ALSO SET LE 26894021 LA RW0,DOP4 SET UP OPD2 OF NEXT INSTR TO BE GENER 26901021 ST RW0,OP1 AS DATA NAME 26908021 BAL RETRG,MVC GENERATE MVC TS2+N(1),DN+ 26915021 BC UNCOND,TR1B SKIP NEXT FEW INSTRUCTIONS 26922021 TR1A IC RW0,DOP4+NX2(RW4) GET NEXT CHAR OF OPD4 LITERAL AND PUT 26929021 STC RW0,IMM AS IMMEDIATE CHAR OF NEXT INSTR TO 26936021 BAL RETRG,MVI GENERATED...THEN GENERATE 26943021 TR1B LA RW3,DX1(RW3) MVI TS2+N,CHAR 26950021 AH RW4,TRINC4 STEP REGS FOR NEXT GO-ROUND 26957021 CH RW3,TRLNG3 TEST IF DONE 26964021 BC NOTEQ,TR1LP LOOP IF NO 26971021 BC UNCOND,TRP2 GO TO TRP2 26978021 SPACE 2 26985021 * RTN FOR GENERATING CODE TO SET UP TRANSLAT 26992021 * TABLE WHEN OPD3 IS DN GT 1 OR LITERAL GT8. 26999021 TRDN EQU * 27006021 LH RW0,TRLNG3 27013021 BCTR RW0,RW0 DECREMENT ONE OF CONTENT OF RW3 27020021 STH RW0,TRLNG3 27027021 MVC A56CH1(LX2),TRLNG3 * LA 1,LENGTH-1 27034021 BAL RETRG,GATXTV * SR 2,2 27041021 DC AL2(ATXT56-ATXTBV) * FREE GPR3 27048021 DC AL2(ZTXT56-ATXT56) * BALR 3,0 27055021 MVC XXREG(LX1),TRINC4+NX1 SET INDEX REG FOR NEXT GENERATED I 27062021 LA RW0,DOP4 TO 0 OR 1. 27069021 ST RW0,OP1 SET UP SO THAT OPD4 IS REFERENCED IN 27076021 BAL RETRG,IC NEXT GENERATED INSTR AND GENERATE 27083021 * IC 0,OPD4(X) 27090021 * X= 0 OR 27097021 MVI XREG1,XX02 27104021 LA RW0,DOP3 27111021 ST RW0,OP1 27118021 MVI XXREG,XX01 27125021 BAL RETRG,IC GENERATE IC 2,OPD3(1) 27132021 BAL RETRG,GATXTC * STC 0,TS2(2) 27139021 DC AL2(ATXT57-ATXTBC) * BCTR 1,0 27146021 DC AL2(ZTXT57-ATXT57) * LTR 1,1 27153021 * * BCR NOTNEG,3 27160021 BC UNCOND,TRP2 GO TO TRP2 27167021 * 27174021 * RTN FOR GENERATING CODE TO SET UP TRANSLAT 27181021 * TABLE IF OPD3 DATA-NAME WITH LENGTH OF 1 27188021 * 27195021 TRDN1 MVI XREG1,XX01 27202021 MVI XREG2,XX01 27209021 BAL RETRG,SR GENERATE SR 1,1 27216021 LA RW0,DOP4 27223021 ST RW0,OP1 27230021 BAL RETRG,IC GENERATE IC 0,OPD4 27237021 MVI XREG1,XX01 27244021 LA RW0,DOP3 27251021 ST RW0,OP1 27258021 BAL RETRG,IC GENERATE IC 1,OPD3 27265021 MVI XXREG,XX01 27272021 MVI XCNTR1,XX30 27279021 MVI XCNTR1+NX2,XX01 27286021 BAL RETRG,STC GENERATE STC 0,TS2(1) 27293021 * 27300021 * 27307021 * 27314021 * 27321021 * 27328021 * 27335021 TRP2 LA RW2,DOP2 GET LENGTH OPD2 27342021 BAL RETRG,CALCLG GET LENGTH OF DOP2 27349021 BC UNCOND,PH5CTL RETURN TO PHASE 5 CONTROL 27356021 SPACE 3 27363021 CLI LENGTH,XX00 TEST IF VARIABLE LENGTH 27370021 BC NOTEQ,TRVL BR IF YES 27377021 L RW1,LENGTH NO, PUT LENGTH IN RW1 27384021 SR RW2,RW2 27391021 LA RW5,DX256 27398021 LA RW3,DOP2 27405021 TRLOOP CR RW1,RW5 TEST IF MORE THAN 255 BYTES LEFT 27412021 BC HI,SKIP6 BR IF YES 27419021 LR RW5,RW1 NO, PUT NUMBER BYTES IN RW5 27426021 SKIP6 STH RW5,XL1 NO. OF BYTES IN XL1 27433021 LA RW0,DOP2 27440021 ST RW0,OP1 27447021 STH RW2,PLUS1+NX1 27454021 MVI XCNTR2,XX30 27461021 MVI XCNTR2+NX2,XX01 GENERATE TR OPD2+N(LNG),TS2 27468021 BAL RETRG,TR PUT A TEXT TR INST. 27475021 AR RW2,RW5 INCR RW2 SO NEXT PLUS WILL BE 256 27482021 SR RW1,RW5 DECR LNGTH BY NUMBER BYTES TRANSL 27489021 BC NOTZER,TRLOOP LOOP IF MORE TO BE TRANSLATED 27496021 BC UNCOND,TREND GO TO TREND AFTER TRANS. 27503021 * 27510021 * 27517021 * 27524021 * 27531021 TRVL EQU * 27538021 MVI XREG1,XX02 27545021 MVI XCNTR1,XX30 27552021 MVI XCNTR1+NX2,XX01 27559021 BAL RETRG,LA GENERATE LA 2,TS2 27566021 LA RW3,TRVLNM 27573021 BAL RETRG,VBALR1 GENERATE L 15,=V(TRVL) 27580021 LA RW2,DOP2 BALR 1,15 27587021 BAL RETRG,DIINFO GENERATE PARAM FOR OPERAND 27594021 TREND B PH5CTL RETURN 27601021 TITLE 'EXAMINE VERB ANALYZER E X A M I N E' 27608021 *=1 ANALYZER FOR EXAMINE 27615021 * THIS ANALYZER GENERATES CODING FOR THE EXAMINE VERB. T 27622021 * GENERATED CODE VARIES DEPENDING ON THE SOURCE OPIONS 27629021 * SPECIFIED. 27636021 * 27643021 * THE GENERATED CODE IS AS FOLLOWS 27650021 * SR 0,0 ONLY IF TALLY INDICATED 27657021 * LA 1,OPD2 27664021 * L 4,=1 27671021 * LA 2,LENGTH ONLY IF FIXED LENGTH 27678021 * LH 2,VLC ONLY IF VARIABLE LENGTH 27685021 * BALR 3,0 27692021 * SR 2,4 27699021 * BC NEG,D3(3) ONLY IF OPD3 NOT NUM, SIGNED 27706021 * BC ZERO,D2(3)ONLY IF OPD3 NUMERIC, SIGNED 27713021 * CLI 0(1),CHAR1 27720021 * * BC COND,DX(3) 27727021 * MVC 0(1),CHAR2 ONLY IF REPLACING 27734021 * BCTR 0,0 ONLY IF TALLY INDICATED 27741021 * BC 15,DISP3(3) ONLY IF FIRST INDICATED 27748021 * ** LA 1,1(1) 27755021 * BCR 15,3 27762021 * 27769021 * *** TM 0(1),CHAR1 ONLY IF NUM SIGNED 27776021 * BC NOTONE,D4(3) DITTO 27783021 * TM 0(1),15-CHAR1 DITTO 27790021 * ***** BC COND,D3(3) DITTO 27797021 * ****** MVN 0(1,1),=X'CHAR2' DITTO AND REPLACING 27804021 * BCTR 0,0 DITTO AND TALLY INDICA 27811021 * **** LCR 0,0 ONLY IF TALLY INDICATED 27818021 * ST 0,TALLY ONLY IF TALLY INDICATED 27825021 * 27832021 * * CONDITION CODE AND DISPLACEMENT VARIES ACCORDING T 27839021 * TYPE OF EXAMINE. BEFORE GENERATING ANY INSTRUCT 27846021 * THE ANALYZER DETERMINES THE DISPLACEMENTS 27853021 * NECESSARY FOR THE BC INSTRUCTIONS TO BE GENERAT 27860021 * THE DISPLACEMENT OF THE LA INSTR (MARKED WITH T 27867021 * DOUBLE *) IS SAVED IN EXDSP1. THE DISP OF THE R 27874021 * TO TEST THE LAST CHAR FOR SIGNED NUM EXAMINES 27881021 * (MARKED WITH THE DOUBLE *) IS SAVED IN EXDSP2. 27888021 * THE DISPLACEMENT OF THE INSTRUCTION TO BRANCH T 27895021 * WHEN THE EXAMINE LOOP IS TO BE TERMINATED IS SA 27902021 * IN EXDSP3. 27909021 * 27916021 * IF EXAMINE IS FOR UNTIL COND CODE IS 8...OTHERW 27923021 * IT IS 7. IF EXAMINE IS FOR ALL OR FIRST DX IS S 27930021 * TO EXDSP1. IF FOR UNTIL OR LEADING THE DX IS S 27937021 * TO EXDSP3. 27944021 * CHAR1 IS AN OPD SPECIFYING CHAR BEING TESTED FO 27951021 * CHAR2 IS AN OPD SPECIFYING CHAR FOR REPLACING 27958021 * DN IS THE OPD INDICATING THE FIELD TO BE EXAMIN 27965021 * 27972021 * IN THE ILLUSTRATION ABOVE D3 MEANS EXDSP3 AND D 27979021 * MEANS EXDSP2. 27986021 * 27993021 * ** THIS INSTRUCTION'S DISPLACEMENT IS SAVED IN EXDSP1 28000021 * AND IS USED IN THE BC INSTR (MARKED WITH THE SI 28007021 * *) IF ALL OR FIRST IS INDICATED. 28014021 * 28021021 * *** THE DISPLACEMENT FOR THIS INSTRUCTION IS SAVED IN 28028021 * EXDSP2 AND APPEARS IN THE BC ZERO, INSTRUCTION 28035021 * 28042021 * ****THE DISPLACEMENT FOR THIS INSTRUCTION IS SAVED IN 28049021 * EXDSP3. 28056021 * ***** CONDITION CODE VARIES. IT IS '7' IF NOT UNTIL F 28063021 * OTHERWISE IT IS '8'. 28070021 * ******THIS INSTRUCTION'S DISPLACEMENT IS SAVED IN EXDS 28077021 * IF UNTIL FIRST, OTHERWISE EXDSP4 IS SET EQUAL T 28084021 * EXDSP3. EXDSP4 IS USED IN BC INSTR (FOLLOWING T 28091021 * INSTRUCTION MARKED WITH TRIPLE *) 28098021 * 28105021 * THE INPUT TO THE ANALYZER IS OF THE FOLLOWING FORMAT.. 28112021 * 28119021 * EXAMINE INFO, CHAR1, CHAR2, DN 28126021 * 28133021 * THE INFO OPD CONTAINS A BYTE AS FOLLOWS 28140021 * 28147021 * BIT 0 ON IF TALLYING 28154021 * 1 ON IF REPLACING 28161021 * 2 ON IF ALL 28168021 * 3 ON IF LEADING 28175021 * 4 ON IF UNTIL FIRST 28182021 * 5 ON IF FIRST 28189021 SPACE 5 28196021 USING *,GVERB 28203021 EXAMIN CLI DOP2,XX75 IF OPD2 OR OPD3 LITERAL, MOVE CHAR TO 28210021 BC EQ,SKIP10 SAME POSITION IT WOULD BE IN FOR 28217021 MVC DOP2+NX1,DOP2+NX2 FIGCON 28224021 SKIP10 CLI DOP3,XX75 DOP3 = X'75' ? 28231021 BE SKIP0A SKIP NEXT INSTRUCTION 28238021 MVC DOP3+NX1,DOP3+NX2 28245021 SKIP0A DS 0H 28252021 SR RW1,RW1 GET MINOR CODE 28259021 IC RW1,DOP4+NX3 28266021 SRL RW1,DX4 28273021 CH RW1,XC008 EXTERNAL DECIMAL... 28280021 BNE EXNSG NO 28287021 TM DOP4+NX3,XX80 TEST IF OPD4 IS NUMERIC 1 28294021 BC NOTONE,EXNSG NO BRANCH 1 28301021 TM DOP4+NX7,XX01 TEST IF OPD4 IS SIGNED 28308021 BC ZERO,EXNSG BR IF NO 28315021 OI DOP1+NX2,XX01 28322021 EXNSG EQU * 28329021 XC EXDSP1(LX8),EXDSP1 28336021 SR RW1,RW1 28343021 SR RW2,RW2 28350021 TM DOP1+NX2,XX40 TEST IF REPLACING INDICATED 28357021 BC ONES,EXR BR IF YES 28364021 SH RW1,H4 28371021 EXR TM DOP1+NX2,XX04 TEST IF FIRST INDICATED 28378021 BC NOTONE,EXNF1 IF NOT FIRST, BRANCH... 28385021 LA RW1,DX4(RW1) 28392021 EXNF1 TM DOP1+NX2,XX80 TEST IF TALLY INDICATED 28399021 BC NOTONE,EXNT1 BR IF NO 28406021 LA RW1,DX2(RW1) 28413021 EXNT1 TM DOP1+NX2,XX01 TEST IF LAST CHAR TO BE TESTED FOR SI 28420021 BC NOTONE,EXNN1 BR IF NO 28427021 LA RW2,DX22 28434021 TM DOP1+NX2,XX80 TEST IF TALLY INDICATED 28441021 BC NOTONE,EXNT2 BR IF NO 28448021 LA RW2,DX2(RW2) 28455021 EXNT2 EQU * 28462021 TM DOP1+NX2,XX40 TEST IF REPLACING INDICATED 28469021 TM DOP1+NX2,XX40 TEST IF REPLACING INDICATED 28476021 BC ONES,EXNN1 BR IF YES 28483021 SH RW2,H6 28490021 EXNN1 LH RW3,EX3012 CALCULATE DISPS FOR DIFFERENT 28497021 AR RW3,RW1 OPTIONS 28504021 STH RW3,EXDSP1 28511021 STH RW3,EXDSPX 28518021 LA RW3,DX6(RW3) 28525021 STH RW3,EXDSP2 28532021 AR RW3,RW2 28539021 STH RW3,EXDSP3 28546021 STH RW3,EXDSP4 28553021 MVI EXCND2,XX07 28560021 MVI EXCOND,XX07 AT THIS POINT EXCOND SET CORRECTLY FO 28567021 * ALL, FIRST, AND LEADING AND EXDSPX 28574021 * CORRECTLY FOR ALL AND FIRST 28581021 * ALSO EXCND2 AND EXDSP4 ARE SET 28588021 * CORRECTLY FOR EVERYTHING EXCEPT UNT 28595021 TM DOP1+NX2,XX10 TEST IF LEADING INDICATED 28602021 BC ONES,EXL BR IF YES 28609021 TM DOP1+NX2,XX08 TEST IF UNTIL FIRST INDICATED 28616021 BC NOTONE,EXL+NX6 BR IF NO 28623021 MVI EXCOND,XX08 YES, SET EXCOND FOR UNTIL FIRST 28630021 LH RW3,EXDSP2 28637021 LA RW3,DX16(RW3) SET EXDSP4 FOR UNTIL FIRST 28644021 STH RW3,EXDSP4 28651021 MVI EXCND2,XX08 SET EXCND2 FOR UNTIL FIRST 28658021 EXL MVC EXDSPX,EXDSP3 SET EXDSP3 FOR UNTIL, LEADING 28665021 TM DOP1+NX2,XX80 TALLY INDICATED 28672021 BC NOTONE,EXLLL BR IF NO 28679021 BAL RETRG,SR YES, GENERATE SR 0,0 28686021 EXLLL TM DOP4+NX3,XX0C IS DATA OPERAND SUBSCRIPTED 28693021 BZ EXLL1 NO, SKIP NEXT INSTRUCTION 28700021 BAL RETRG,WRKLRX YES - DESTROY MACRO R14, R15 28707021 EXLL1 EQU * 28714021 LA RW2,DOP4 GENERATE LA 1,DN 28721021 ST RW2,OP1 28728021 MVI XREG1,XX01 28735021 BAL RETRG,LA ** LA 1,DN 28742021 MVI XREG1,XX04 28749021 MVC XCON1+NX15(LX2),CLCNF1 28756021 BAL RETRG,LOAD ** LOAD 4,XX 28763021 BAL RETRG,CALCLG GET OPD2 LENGTH 28770021 B PH5CTL RETURN TO PH5 CONTROL 28777021 SPACE 3 28784021 CLI LENGTH,XX00 TEST IF VAR LENGTH 28791021 MVI XREG1,XX02 28798021 BC NOTEQ,EXVL BR IF YES 28805021 CLC LENGTH+NX2(LX2),XC4095 IS LENGTH > 4095 1 28812021 BC XTWO,EXMLD YES BRANCH 1 28819021 MVC BDISP1(LX2),LENGTH+NX2 NO, GENERATE LA 2,LENGTH 28826021 * 28833021 BAL RETRG,LA ** LA 2,LENGTH 28840021 B EXBALR PUT A TEXT BALR 28847021 SPACE 3 28854021 EXMLD EQU * 28861021 MVC XCON1+NX14(LX2),LENGTH+NX2 1 28868021 MVI XCON1+NX16,XX02 1 28875021 BAL RETRG,LH LH 2,=LENGTH 1 28882021 BC UNCOND,EXBALR GO TO EXBALR 28889021 SPACE 3 28896021 EXVL MVC XCNTR1+NX1(LX2),LENGTH+NX2 YES, GEN.. LH 2,VLC 28903021 MVI XCNTR1,XX04 28910021 BAL RETRG,LH PUT A TEXT LH INSTRUCTION 28917021 EXBALR MVI XREG1,XX03 GENERATE BALR 3,0 28924021 BAL RETRG,BALR PUT A TEXT BALR INSTRUCTION 28931021 MVI XREG1,XX02 GENERATE S 2,=1 28938021 MVI XREG2,XX04 28945021 BAL RETRG,SR PUT A TEXT SR INSTRUCTION 28952021 TM DOP1+NX2,XX01 TEST IF LAST CHAR TO BE TESTED FOR SI 28959021 BC NOTONE,EXNN1A BR IF NO 28966021 MVI XREG1,XX08 YES, GENERATE BC ZERO,DISP2(3 28973021 MVC BDISP1(LX2),EXDSP2 28980021 BAL RETRG,BC PUT A TEXT BC INSTRUCTION 28987021 B EXNN2 SKIP NEXT INST. 28994021 SPACE 3 29001021 EXNN1A MVI XREG1,XX04 GENERATE BC NEG,DISP3(3) 29008021 MVC BDISP1(LX2),EXDSP3 29015021 BAL RETRG,BC PUT A TEXT BC INSTRUCTION 29022021 EXNN2 MVC IMM(LX1),DOP2+NX1 GENERATE CLI 0(1),CHAR1 29029021 MVI BDISP1,XX10 29036021 BAL RETRG,CLI PUT A TEXT CLI INST. 29043021 MVC XREG1(LX1),EXCOND GENERATE BC COND,DISPX(3 29050021 MVC BDISP1(LX2),EXDSPX 29057021 BAL RETRG,BC PUT A TEXT BC INST. 29064021 TM DOP1+NX2,XX40 TEST IF REPLACING INDICATED 29071021 BC NOTONE,EXNR1 BR IF NO 29078021 MVC IMM(LX1),DOP3+NX1 YES, GENERATE MVI 0(1),CHAR2 29085021 MVI BDISP1,XX10 29092021 BAL RETRG,MVI PUT A TEXT MVI INSTRUCTION 29099021 EXNR1 TM DOP1+NX2,XX80 TEST IF TALLY INDICATED 29106021 BC NOTONE,EXNT3 BR IF NO 29113021 BAL RETRG,BCTR YES, GENERATE BCTR 0,0 29120021 EXNT3 TM DOP1+NX2,XX04 TEST IF FIRST INDICATED 29127021 BC NOTONE,EXNF2 BR IF NO 29134021 MVI XREG1,XX0F YES, GENERATE BC 15,DISP3(3) 29141021 MVC BDISP1(LX2),EXDSP3 29148021 BAL RETRG,BC PUT A TEXT BC INST. 29155021 * 29162021 EXNF2 MVI XREG1,XX01 GENERATE LA 1,1(1) 29169021 MVI BDISP1,XX10 29176021 MVI BDISP1+NX1,XX01 29183021 BAL RETRG,LA PUT A TEXT LA INST. 29190021 MVI XREG1,XX0F GENERATE BCR UNCOND,3 29197021 MVI XREG2,XX03 29204021 BAL RETRG,BC PUT A TEXT BC INST. 29211021 TM DOP1+NX2,XX01 TEST IF LAST CHAR TO BE TESTED FOR SI 29218021 BC NOTONE,EXNN3 BR IF NO 29225021 MVI BDISP1,XX10 YES, GENERATE TM 0(1),CHAR1 29232021 MVC IMM(LX1),DOP2+NX1 29239021 NI IMM,XX0F 29246021 BAL RETRG,TM PUT A TEXT TM INSTRUCTION 29253021 MVI XREG1,XX0E BC NOTONE,DISP4 29260021 MVC BDISP1(LX2),EXDSP4 29267021 BAL RETRG,BC PUT A TEXT BC INST. 29274021 MVI BDISP1,XX10 TM 0(1),15-CHAR 29281021 XI DOP2+NX1,XXFF 29288021 MVC IMM(LX1),DOP2+NX1 29295021 BAL RETRG,TM PUT A TEXT TM INST. 29302021 MVC XREG1,EXCND2 BC COND,DISP3(3 29309021 MVC BDISP1(LX2),EXDSP3 29316021 BAL RETRG,BC PUT A TEXT BC INST. 29323021 TM DOP1+NX2,XX40 TEST IF REPLACING INDICATED 29330021 BC NOTONE,EXNR2 BR IF NO 29337021 MVI XL1+NX1,XX01 YES , GENERATE MVN 0(1,1),=C'CH 29344021 MVI BDISP1,XX10 29351021 MVI DOP3,XX75 29358021 LA RW0,DOP3 29365021 ST RW0,OP1 29372021 BAL RETRG,MVN PUT A TEXT MVN INSTRUCTION 29379021 EXNR2 TM DOP1+NX2,XX80 TEST IF TALLY INDICATED 29386021 BC NOTONE,EXNT4 BR IF NO 29393021 BAL RETRG,BCTR YES, GENERATE BCTR 0,0 29400021 EXNN3 TM DOP1+NX2,XX80 TEST IF TALLY INDICATED 29407021 BC NOTONE,EXNT4 BR IF NO 29414021 BAL RETRG,LCR YES, GENERATE LCR 0,0 29421021 MVI TALLY1,XX06 ST 0,TALLY 29428021 BAL RETRG,ST PUT A TEXT ST INST. 29435021 EXNT4 B PH5CTL RETURN 29442021 TITLE 'IKFCBL51: USE (DECL) VERB ANALYZER U S E (D E C L)' 29449021 *=1 ANALYZERS FOR USE AND BEGIN RAND PROC. DECL. 29456021 * 29463021 * 29470021 USING *,GVERB 29477021 USE1 EQU * BEGIN LABEL PROCESSING 29484021 OI DECLSW,INDCL INDICATE WITHIN DECLARATIVE 43113 29491021 CLC SA2CTR,XC001 CTR LESS THAN 1 29498021 BNL USE1B NO 29505021 MVC SA2CTR,XC001 MAKE IT 1 29512021 USE1B EQU * 29519021 BAL RETRG,WRKLRG DESTRY 14,15/STORE SUBSCRIPTS 29526021 BAL RETRG,GFRRES RESERVE 14 29533021 L RW1,AUSETBL ADDR USETBL TIB 43521 29540021 L RW1,DX0(RW1) ADDR TAMM 43521 29547021 L RW1,DX0(RW1) ADDR TABLE 43521 29554021 LA RW1,DX0(RW1) CLEAR HIGH ORDER BYTE 43521 29561021 LH RW2,LBDCLCTR NUMBER OF DECLARATIVE 43521 29568021 MH RW2,XC003 INDEX INTO TABLE 43521 29575021 AR RW1,RW2 BUMP TABLE TO THE ENTRY 43521 29582021 LA RW1,DX2(RW1) POINT TO ATTRIBUTE BYTE 43521 29589021 * RW1 NOW POINTS TO THE CORRECT TABLE ENTRY FOR THIS DCL 43521 29596021 TM DX0(RW1),XX1A IS THIS DECLARATIVE FOR BEFORE,43521 29603021 * REEL, OR BEGINNING KEYWORDS... 43521 29610021 BNZ USE1D YES, DO NOT GENERATE TEST 43521 29617021 TM DX0(RW1),XX05 ARE THE KEYWORDS FILE AND 43521 29624021 * ENDING BOTH SPECIFIED... 43521 29631021 BNO USE1D NO, DO NOT ISSUE TEST 43521 29638021 BAL RETRG,GATXTC GENERATE 43521 29645021 DC AL2(ATXT94E-ATXTBC) ENTRY CODING AND 43521 29652021 DC AL2(ATXT94A-ATXT94E) EOF TEST 43521 29659021 B USE1E BYPASS OTHER GENERATION 43521 29666021 USE1D DS 0H 43521 29673021 BAL RETRG,GATXTC GENERATE ENTRY CODING 29680021 DC AL2(ATXT94-ATXTBC) X 29687021 DC AL2(ATXT94A-ATXT94) X 29694021 USE1E DS 0H 43521 29701021 BAL RETRG,GATXTC * LR 2,1 29708021 DC AL2(ATXT95-ATXTBC) * GETMAIN, MOVE SA1 29715021 DC AL2(ATXT95B-ATXT95) * CHAIN PTRS,SAVE DCBADR,BL 29722021 BAL RETRG,GATXTC * INIT BLL1,2 29729021 DC AL2(ATXT94C-ATXTBC) X 29736021 DC AL2(ATXT94D-ATXT94C) X 29743021 BAL RETRG,GFREE FREE 14 29750021 TM DOP1+NX2,XX80 BEFORE OPTION 29757021 BC NOTONE,DON IF NOT BEFORE OPTION, RETURN 29764021 MVI LBLSW,XX01 29771021 BAL RETRG,GATXTC * MVI 422(13),C'0' 29778021 DC AL2(ATXT108-ATXTBC) X 29785021 DC AL2(ZTXT108-ATXT108) X 29792021 LH RW2,LBDCLCTR 43521 29799021 LA RW2,DX1(RW2) BUMP COUNTER BY ONE 43521 29806021 STH RW2,LBDCLCTR UPDATE COUNTER 43521 29813021 B PH5CTL CONTINUE PROCESSING 43521 29820021 * 29827021 * 29834021 SPACE 2 43521 29841021 USING *,GVERB 43521 29848021 * 43521 29855021 * ANALYZER FOR USE BEFORE REPORTING DECLARATIVE 43521 29862021 * 43521 29869021 USE4 DS 0H 43521 29876021 LH RW2,LBDCLCTR NUMBER OF DECLARATIVE 43521 29883021 LA RW2,DX1(RW2) BUMP COUNTER BY ONE 43521 29890021 STH RW2,LBDCLCTR UPDATE COUNTER 43521 29897021 B PH5CTL PROCESS NEXT ELEMENT 43521 29904021 SPACE 2 43521 29911021 * 43521 29918021 * 43521 29925021 USING *,GVERB 29932021 USE5 EQU * USE... STD ERROR 29939021 OI DECLSW,INDCL INDICATE WITHIN DECLARATIVE 43113 29946021 CLC SA2CTR,XC001 CTR LESS THAN 1 29953021 BNL USE5B NO 29960021 MVC SA2CTR,XC001 MAKE IT 1 29967021 USE5B EQU * 29974021 LH RW2,LBDCLCTR NUMBER OF DECLARATIVE 43521 29981021 LA RW2,DX1(RW2) BUMP COUNTER BY ONE 43521 29988021 STH RW2,LBDCLCTR UPDATE COUNTER 43521 29995021 BAL RETRG,WRKLRG DESTROY 14,150STORE SUBSCRIPTS 30002021 BAL RETRG,GFRRES RESERVE 14 30009021 NI USESW,XX00 TURN OFF SWITCH 30016021 TM DOP1+NX2,XX01 FILE OPTION 30023021 BC NOTONE,USE5A NO 30030021 CLC DOP2(LX2),ONZERO GIVING DATANAME-1 30037021 BC EQ,USE5A NO 30044021 LA RW2,DOP2 YES 30051021 ST RW2,OP1 XXXX 30058021 MVI XL1+NX1,XX88 X 30065021 MVI BDISP2,XX10 * MVC DN1(136),0(1) 30072021 BAL RETRG,MVC XXXX 30079021 CLC DOP3(LX2),ONZERO GIVING DATANAME-1,DATANAME2 30086021 BC EQ,USE5A NO 30093021 NI DOP3+NX2,XX0F AND OUT COUNT FIELD 30100021 CLI DOP3+NX2,XX05 IS DN-2 IN LINKAGE SECTION? 30107021 BE USE5C YES, INIT BLL 30114021 OI USESW,XX01 TURN ON SWITCH 30121021 MVC DOP1(LDOP),DOP3 SET UP FOR MOVE 30128021 MVC DOP2(LDOP),DOP3 SET UP FOR MOVE 30135021 LA RW2,DOP1 POINT TO ELEMENT TO BE CHNGED 30142021 BAL RETRG,INRIOMOV INIT BLREF1, CHNG IDK TO BLL 30149021 B USE5D INIT OUR OWN BLL 30156021 USE5C DS 0H 30163021 LA RW2,DOP3 INIT BLREF1 30170021 BAL RETRG,DBLREF X 30177021 USE5D DS 0H 30184021 MVI BDISP2,XX10 XXXX 30191021 MVI XL1+NX1,XX04 30198021 MVI BDISP2+NX1,XX08 * MVC BLL-DN2(4),8(1) 30205021 BAL RETRG,MVC XXXX 30212021 TM USESW,XX01 DN2 IN W-S? 30219021 BO USE5A YES 30226021 LA RW3,DOP3 POINT TO DN-2 30233021 USE5A DS 0H 30240021 BAL RETRG,GDES15 DESTROY 15 30247021 BAL RETRG,GATXTC GENERATE FOLLOWING A TEXT 30254021 * * LR 4,14 30261021 DC AL2(ATXT111-ATXTBC) * LR 13,0 30268021 * * LA 15,X'FF' 30275021 * * SLL 15,24 30282021 DC AL2(ZTXT111-ATXT111) * SVC 68 30289021 BAL RETRG,GATXTC * GETMAIN,MOVE SA2,CHAIN PTRS 30296021 DC AL2(ATXT95E-ATXTBC) X 30303021 DC AL2(ATXT95A-ATXT95E) X 30310021 BAL RETRG,GFREE FREE 14 30317021 TM USESW,XX01 DN2 IN W-S? 30324021 BNO DON NO, END PROCESSING 30331021 * THIS CODE SETS UP DOPS FOR A DUMMY MOVE 30338021 MVI HEADER+NX1,XX1D 30345021 L XRVERB,XALAMA ADDRESS OF MOVE ROUTINE 30352021 BR XRVERB BRANCH TO MOVE 30359021 * 30366021 * 30373021 * 30380021 USING *,GVERB 30387021 ENDUS1 EQU * END LABEL PROCESSING 30394021 BAL RETRG,WRKLRG DESTROY 14,15/STORE SUBSCRIPTS 30401021 BAL RETRG,GFRRES RESERVE 14 30408021 BAL RETRG,GATXTC INSERT RETURN CODE INTO R5 30415021 DC AL2(ATXT96-ATXTBC) X 30422021 DC AL2(ZTXT96-ATXT96) X 30429021 TM LBLSW,XX01 NSL 30436021 MVI LBLSW,XX00 INITIALIZE 30443021 BNO ENDUS1A NO 30450021 BAL RETRG,GATXTC * BALR 14,0 30457021 DC AL2(ATXT98-ATXTBC) * CLI 422(13),C'0' 30464021 DC AL2(ZTXT98-ATXT98) * BE 12(14) 30471021 ENDUS1A DS 0H * LA 5,16 30478021 BAL RETRG,GATXTC RESTORE BLL1,2, RECHAIN PTR 30485021 DC AL2(ATXT95B-ATXTBC) RESTORE SA1, EXIT 30492021 DC AL2(ATXT95F-ATXT95B) 30499021 BAL RETRG,GATXTC * LR 15,5 30506021 DC AL2(ATXT112-ATXTBC) * BR 4 30513021 DC AL2(ZTXT112-ATXT112) 30520021 BAL RETRG,GFREE FREE 14 30527021 NI DECLSW,X'FF'-INDCL TURN OFF SWITCH 43113 30534021 B PH5CTL CONTINUE PROCESSING 43113 30541021 * 30548021 * 30555021 ENDUS5 EQU * 30562021 BAL RETRG,WRKLRG DESTROY 14,15/STORE SUBSCRIPTS 30569021 BAL RETRG,GFRRES RESERVE 14 30576021 BAL RETRG,GATXTC * L 1,SA2 30583021 DC AL2(ATXT96-ATXTBC) X 30590021 DC AL2(ATXT96A-ATXT96) X 30597021 BAL RETRG,GATXTC RESTORE SA1 30604021 DC AL2(ATXT95B-ATXTBC) X 30611021 DC AL2(ATXT95C-ATXT95B) X 30618021 BAL RETRG,GATXTC RECHAIN PTRS, FREEMAIN, EXI 30625021 DC AL2(ATXT95D-ATXTBC) X 30632021 DC AL2(ZTXT95-ATXT95D) X 30639021 BAL RETRG,GATXTC * LR 14,4 30646021 DC AL2(ATXT112A-ATXTBC) * LM 2,5,28(13) 30653021 DC AL2(ZTXT112-ATXT112A) * BCR 15,14 30660021 BAL RETRG,GFREE FREE 14 30667021 NI DECLSW,X'FF'-INDCL TURN OFF SWITCH 43113 30674021 B PH5CTL CONTINUE PROCESSING 43113 30681021 TITLE 'DISPLAY VERB ANALYZER D I S P L A Y' 30688021 * VERBS AND BODY PORTIONS (NOT ENTRY POINTS) OF SR'S. 30695021 *=1 DISPLAY VERB 30702021 ******************************************** 30709021 * 30716021 * D I S P L A Y 30723021 * 30730021 * INPUT STRINGS... DISPLAY OP1 OP2 OP3 OP4 OP5 UPON SYSOUT. 30737021 * DISPLAY 05 FIRST SYSOUT OP1 OP2 OP3 30744021 * DISPLAY 03 OP4 OP5 END 30751021 * 30758021 * PRECEDED BY MOVES FOR FLOATING-POINT ITEMS WHICH ARE CONVER 30765021 * AT OBJECT TIME FROM IFP DATA ITEMS TO SET EFP FORMS IN THE 30772021 * PARAM AREA. 30779021 * 30786021 ******************************************** 30793021 * 30800021 USING *,GVERB 30807021 DISPLA EQU * 30814021 CLC DOP1(LX2),CBFRST CONTINUATION STRING... 30821021 BC NOTEQ,NXTSTR YES, GO BACK TO GETDOP ROUTINE 30828021 CLC DOP2(LX2),CBCNSL SPECIAL CASE... CONSOLE W/ONE AN 30835021 BC NOTEQ,DISP02 IF NOT SPECIAL CASE, GO... 30842021 CLI DOP3,MANLIT 30849021 BC NOTEQ,DISP02 IF NOT, BRANCH.. 30856021 CLC DOP4(LX2),CBEND 30863021 BC NOTEQ,DISP02 IF NOT, BRANCH... 30870021 BAL RETRG,DIWTO YES, * WTO 'TEXT...' 30877021 BC UNCOND,DON RETURN PHASE 5 CONTROL 30884021 SPACE 5 30891021 DISP02 EQU * NO, SET UP FOR OTSR CALL 30898021 LH RW1,DIFPNN SET PARMAX AT LEAST 30905021 LA RW1,DX3(RW1) BEYOND ANY EFP 30912021 AH RW1,DIPARE ALLOW FOR LAST FP CONV, IF ANY 30919021 SRL RW1,DX2 AREAS USED 30926021 CH RW1,PARMAX 30933021 BC NOTHI,DISP01 IF NOT HIGH, SKIP NEXT INST. 30940021 STH RW1,PARMAX 30947021 DISP01 OI DIFPSW,MSWON SET DISPLAY/EXHIBIT SW 30954021 SR RW1,RW1 30961021 STH RW1,DIFPNN SET N = 0 30968021 STH RW1,DIPARE 30975021 CLC DOP2(LX2),CBSYSP PUNCH... 30982021 BC NOTEQ,DISP08 NO 30989021 MVC DOP1+NX10(LX8),PROGID YES, MAKE LIT OF PROG-ID 30996021 MVI DOP1+NX8,XX34 31003021 MVI DOP1+NX9,XX08 31010021 LA RETRG,DOP1+NX8 31017021 ST RETRG,OP1 31024021 MVI XREG1,XX02 31031021 BAL RETRG,LA * LA 2,='PROG-ID ' FOR PCH 31038021 DISP08 EQU * 31045021 * * L 15,V=(DISPRT) 31052021 BAL RETRG,DIBALR BALR 1,15 31059021 NI DISPS1,MSWOFF TERMINATOR SW OFF 31066021 * FIND DEVICE CODE 31073021 LA RW1,MCNSLE CONSOLE... 31080021 CLC DOP2(LX2),CBCNSL 31087021 BC EQ,DISP03 YES 31094021 LA RW1,MSYSPH SYSPCH... 31101021 CLC DOP2(LX2),CBSYSP 31108021 BC EQ,DISP03 YES 31115021 LA RW1,MSYSOU SYSOUT IS THE DEFAULT OPTION 31122021 DISP03 ST RW1,GFLWD 31129021 MVC XCON1+NX1(LX2),GFLWD+NX2 31136021 MVI XCON1,XX02 31143021 MVI GMCTYP,MDC 31150021 BAL RETRG,MACRO PUT A TEXT 31157021 SR RW3,RW3 31164021 ST RW3,DISPNN INIT OPERAND COUNT TO 0 31171021 LA RW4,LDOP+LDOP DISPLACEMENT OF FIRST OPERAND 31178021 BAL RETRG,DIDNIN GEN... ON INFO FOR ALL DN'S 31185021 MVC GMACDC(LX3),DISPC1 31192021 MVI GMCTYP,MDC 31199021 BAL RETRG,MACRO PUT A TEXT 31206021 NI DIFPSW,XX00 RESET ALL BITS OF SW 31213021 BC UNCOND,DON *** RETURN TO PHASE 5 CONTROL 31220021 TITLE 'IKFCBL51: STOP VERB PROCESSOR S T O P' 31227021 ***************************************************************** 31234021 * * 31241021 * STOP VERB ANALYZER... * 31248021 * 'STOP (LITERAL)' AND 'STOP RUN' ARE ANALYZED. * 31255021 * 'STOP (LITERAL)' RESULTS IN A WTO WITH REPLY (2 SVCS). * 31262021 * 'STOP RUN' RESULTS IN TERMINATION CODING, I.E. A BRANCH * 31269021 * TO ILBOSTP1 AND RETURN TO THE SUPERVISOR. * 31276021 * * 31283021 ***************************************************************** 31290021 SPACE 2 31297021 USING *,GVERB 31304021 STOP DS 0H 31311021 BAL RETRG,WRKLRG DESTORY 14,15/STORE SUBSCRIPTS 31318021 CLC DOP1(LX2),CBRUN STOP RUN... 31325021 BE STOP01 YES 31332021 CLI DOP1,MNLIT NUMERIC LITERAL... 47015 31339021 BNE STOP02 NO 47015 31346021 LA RW2,DOP1 YES, ADDRESS LITERAL 47015 31353021 BAL RETRG,CVNLIT CONVERT TO PRINTABLE FORM 47015 31360021 STOP02 DS 0H 47015 31367021 SR RW2,RW2 NO, STOP 'TEXT...' 31374021 IC RW2,DOP1+NX1 LENGTH OF LIT 31381021 MVC DOP3+NX11(LX120),DOP1+NX2 TEXT 31388021 MVC DOP3+NX2(LX9),STOPC1 = 'IKF000D, ' 31395021 LA RW2,DX9(RW2) 31402021 STC RW2,DOP3+NX1 =NN 31409021 MVI DOP3,MANLIT ='34' 31416021 OI DIWOSW,MSWON SET ALTERNATE MESSAGE SW (DOP3) 31423021 SR RW2,RW2 31430021 BAL RETRG,DIWTOR WTOR 'IKF000A, TEXT...' 31437021 NI DIWOSW,MSWOFF 31444021 * MACROS ARE EXPANDED... * WAIT 31451021 B PH5CTL RETURN FOR NEXT STRING 31458021 SPACE 2 31465021 STOP01 DS 0H STOP RUN...GENERATE TERMINATION CODING 31472021 MVC VIRTNO(LX2),VIRCTR 31479021 LA RW2,VIRDEFI 31486021 LA RW3,DX12 31493021 BAL R0,WRITE2 PERFORM WRITE2 31500021 MVC A103CH1(LX2),VIRCTR 31507021 LH RW2,VIRCTR 31514021 LA RW2,DX1(RW2) 31521021 STH RW2,VIRCTR 31528021 BAL RETRG,GATXTV * L 15,=V(ILBOSTP1) 31535021 * * DESTROY 15 * 31542021 DC AL2(ATXT103-ATXTBV) * BCR 15,15 31549021 DC AL2(ZTXT103-ATXT103) 31556021 BC UNCOND,DON RETURN TO PHASE 5 CONTROL 31563021 TITLE 'IKFCBL51: GOBACK VERB ANALYZER G O B A C K' 31570021 ****************************************************************** 31577021 * * 31584021 * GOBACK VERB ANALYZER... * 31591021 * GENERATES RETURN CODING WHICH ENABLES COBOL PROGRAM TO ACT * 31598021 * AS MAIN PROGRAM OR SUBPROGRAM, RETURNING TO CALLING PROGRAM* 31605021 * WHICH MAY BE ANOTHER PROBLEM PROGRAM, OR THE SYSTEM. * 31612021 * OUTPUT INVOLVES TEST FOR MAIN/SUB PROGRAM STATUS, RESTORA- * 31619021 * TION OF REGISTERS AND A RETURN. * 31626021 * * 31633021 ****************************************************************** 31640021 SPACE 2 43113 31647021 * 43113 31654021 * CODE GENERATED -- 43113 31661021 * 43113 31668021 ****** 43113 31675021 * PART1: 43113 31682021 * RESERVE 15 43113 31689021 * L 15,432(13) 43113 31696021 * STM 0,14,SAVEP2 43113 31703021 * L 1,SAVE2 43113 31710021 * BALR 15,0 43113 31717021 * TM SWITCH,X'10' 43113 31724021 * BZ 14(15) 43113 31731021 * L 15,=V(ILBOSTP1) 43113 31738021 * BR 15 43113 31745021 ****** 43113 31752021 * PART2: GENERATED IF VERB IS WITHIN A DECLARATIVE. 43113 31759021 * TM 75(1),X'01' 43113 31766021 * BO 30(15) 43113 31773021 * L 1,72(1) 43113 31780021 * B 14(15) 43113 31787021 * MVC 4(68,13),4(1) 43113 31794021 ****** 43113 31801021 * PART3: 43113 31808021 * LH 15,92(13) 43113 31815021 * L 13,4(13) 43113 31822021 * LM 0,12,20(13) 43113 31829021 * L 14,12(13) 43113 31836021 * BR 14 43113 31843021 * DESTROY 14 43113 31850021 * FREE 15 43113 31857021 * 43113 31864021 SPACE 2 31871021 USING *,GVERB 31878021 GOBACK DS 0H 31885021 BAL RETRG,WRKLRG DESTROY 14,15/STORE SUBSCRIPTS 31892021 MVC VIRTNO(LX2),VIRCTR 31899021 LA RW2,VIRDEFI 31906021 LA RW3,DX12 31913021 BAL RW0,WRITE2 WRITE OPT ATXT ON F-3 31920021 MVC A100CH1(LX2),VIRCTR 31927021 LH RW2,VIRCTR 31934021 LA RW2,DX1(RW2) 31941021 STH RW2,VIRCTR 31948021 BAL RETRG,GATXTV * GENERATE 43113 31955021 DC AL2(ATXT100-ATXTBV) * PART 1 43113 31962021 DC AL2(ZTXT100-ATXT100) * CODING 43113 31969021 TM DECLSW,INDCL VERB WITHIN DECLARATIVE... 43113 31976021 BZ GOBACK1 NO 43113 31983021 BAL RETRG,GATXTV * GENERATE 43113 31990021 DC AL2(ATXT04-ATXTBV) * PART 2 43113 31997021 DC AL2(ZTXT04-ATXT04) * CODING 43113 32004021 GOBACK1 DS 0H 43113 32011021 BAL RETRG,GATXTV * GENERATE 43113 32018021 DC AL2(ATXT101-ATXTBV) * PART 3 43113 32025021 DC AL2(ZTXT101-ATXT101) * CODING 43113 32032021 *DEL 4311 32039021 *DEL 4311 32046021 *DEL 4311 32053021 *DEL 4311 32060021 *DEL 4311 32067021 *DEL 4311 32074021 *DEL 4311 32081021 *DEL 4311 32088021 *DEL 4311 32095021 *DEL 4311 32102021 *DEL 4311 32109021 *DEL 4311 32116021 *DEL 4311 32123021 *DEL 4311 32130021 *DEL 4311 32137021 *DEL 4311 32144021 TM ADESW2,MSWON GOBACK ENTERED FROM ADETER... 32151021 BZ PH5CTL NO, RETURN TO PHASE CONTROL 32158021 NI ADESW2,MSWOFF YES, RETURN VIA RETURN REG 32165021 LM RETRG,RW4,SVWJHI 32172021 L XRVAR,SVWJHH 32179021 L STNGR,SVWJHJ 32186021 BR RETRG RETURN TO CALLER 32193021 TITLE 'IKFCBL51: EXIT PROGRAM VERB ANALYZER E X I T P G M' 32200021 ****************************************************************** 32207021 * * 32214021 * EXIT PROGRAM ANALYZER... * 32221021 * GENERATES CODING WHICH IS AN EFFECTIVE NOOP WITHIN A MAIN * 32228021 * PROGRAM, BUT WHICH RETURNS CONTROL TO THE CALLER WITHIN A * 32235021 * SUBPROGRAM. * 32242021 * OUTPUT INVOLVES TEST FOR MAIN/SUB PROGRAM STATUS, RESTORA- * 32249021 * TION OF REGISTERS AND A RETURN. * 32256021 * * 32263021 ****************************************************************** 32270021 SPACE 2 43113 32277021 * 43113 32284021 * CODE GENERATED -- 43113 32291021 * 43113 32298021 ****** 43113 32305021 * PART1: 43113 32312021 * RESERVE 15 43113 32319021 * L 1,SAVE2 43113 32326021 * BALR 15,0 43113 32333021 * TM SWITCH,X'10' 43113 32340021 * BO 30.OR.58(15) 43113 32347021 * L 15,432(13) 43113 32354021 * STM 0,14,SAVEP2 43113 32361021 ****** 43113 32368021 * PART2: GENERATED IF VERB IS WITHIN A DECLARATIVE. 43113 32375021 * BALR 15,0 43113 32382021 * TM 75(1),X'01' 43113 32389021 * BO 16(15) 43113 32396021 * L 1,72(1) 43113 32403021 * B 0(15) 43113 32410021 * MVC 4(68,13),4(1) 43113 32417021 ****** 43113 32424021 * PART3: 43113 32431021 * LH 15,92(13) 43113 32438021 * L 13,4(13) 43113 32445021 * LM 0,12,20(13) 43113 32452021 * L 14,12(13) 43113 32459021 * BR 14 43113 32466021 * DESTROY 14 43113 32473021 * FREE 15 43113 32480021 * 43113 32487021 SPACE 2 32494021 USING *,GVERB 32501021 EXITPGM DS 0H 32508021 BAL RETRG,WRKLRG DESTROY 14,15/STORE SUBSCRIPTS 32515021 TM DECLSW,INDCL VERB WITHIN DECLARATIVE... 43113 32522021 BZ EXITPGM1 NO 43113 32529021 MVI A04CH1,XX10 SETUP 43113 32536021 MVI A04CH2,XX00 DISPLACEMENTS 43113 32543021 MVI A102CH1,XX3A IN CODE 43113 32550021 EXITPGM1 DS 0H 43113 32557021 BAL RETRG,GATXTV * GENERATE 43113 32564021 DC AL2(ATXT102-ATXTBV) * PART 1 43113 32571021 DC AL2(ZTXT102-ATXT102) * CODING 43113 32578021 TM DECLSW,INDCL VERB WITHIN DECLARATIVE... 43113 32585021 BZ EXITPGM2 NO 43113 32592021 BAL RETRG,GATXTV * GENERATE 43113 32599021 DC AL2(ATXT04A-ATXTBV) * PART2 43113 32606021 DC AL2(ZTXT04-ATXT04A) * CODING 43113 32613021 MVI A04CH1,XX1E RESTORE 43113 32620021 MVI A04CH2,XX0E ORIGINAL 43113 32627021 MVI A102CH1,XX22 DISPLACEMENTS 60604 32634021 EXITPGM2 DS 0H 43113 32641021 BAL RETRG,GATXTV * GENERATE 43113 32648021 DC AL2(ATXT101-ATXTBV) * PART 3 43113 32655021 DC AL2(ZTXT101-ATXT101) * CODING 43113 32662021 B PH5CTL PROCESS NEXT VERB 43113 32669021 *DEL 4311 32676021 *DEL 4311 32683021 *DEL 4311 32690021 *DEL 4311 32697021 *DEL 4311 32704021 *DEL 4311 32711021 *DEL 4311 32718021 *DEL 4311 32725021 *DEL 4311 32732021 *DEL 4311 32739021 *DEL 4311 32746021 *DEL 4311 32753021 *DEL 4311 32760021 *DEL 4311 32767021 TITLE 'IKFCBL51: DEBUG PACKET ANALYZER D E B U G' 32774021 *=1 *DEBUG CONTROL CARD FOR DEBUG PACKET 32781021 ******************************************************************* 32788021 * 32795021 * D E B U G 32802021 * 32809021 * DEBUG PACKET INTRODUCTORY STATEMENT *DEBUG INS-PT (TRY) 32816021 * INPUT STRING... DEBUG 02 RPD LGN 32823021 ******************************************************************* 32830021 USING *,GVERB 32837021 ADEBUG EQU * 32844021 MVC DOP4(LX3),DOP2 SAVE OPERANDS 32851021 MVC DOP5(LX3),DOP1 32858021 BAL RETRG,ADETER TERM PREV PACKET OR MAIN PROGRAM 32865021 OI ADESW1,MSWON 32872021 MVC GLGNCN+NX3(LX2),DOP4+NX1 32879021 BAL RETRG,GNOPT3 * GN EQU * 32886021 MVC LSTDBG(LX2),DOP4+NX1 THE GN NUMBER AFTER THIS ONE IS 32893021 LH RW2,LSTDBG THE ADDRESS TO RETURN TO AT THE 32900021 LA RW2,DX1(RW2) END OF THIS DEBUG. 32907021 STH RW2,LSTDBG SAVE FOR USE IN RTNE ADETER. 32914021 * 32921021 * RPD PROCESSING GOES IN HERE EVENTUALLY 32928021 * 32935021 BC UNCOND,DON RETURN TO PHASE 5 CONTROL 32942021 TITLE 'EXHIBIT VERB ANALYZER E X H I B I T' 32949021 *=1 EXHIBIT VERB 32956021 ***************************************************************** 32963021 * *** E X H I B I T V E R B *** 32970021 * 32977021 * INPUT IS SEGMENTED STRINGS, USES DISPLAY VERB 32984021 * SUBROUTINES FREELY. 32991021 * EXAMPLE... EXHIBIT NAMED CHANGED OP1 OP2 OP3. 32998021 * INPUT STRINGS... 33005021 * EXHIBIT 05 FIRST NAMED CHANGED OP1 OP2 33012021 * EXHIBIT 02 OP3 END 33019021 * EXHIBIT 05 FIRST NAMED CHANGED OP1 OP2 33026021 * EXHIBIT 02 OP3 END 33033021 * 33040021 * INTERNAL FP OPERANDS ARE TREATED AS IN DISPLAY. 'CHANGED' 2- 33047021 * PARAMETERS ARE PUT IN PARAM AREA AFTER THE CONVERTED ITEMS. 33054021 * 33061021 ***************************************************************** 33068021 * 33075021 USING *,GVERB 33082021 EXHIBI EQU * 33089021 TM FLAGSW,MSWON SECOND STRING... 33096021 BC ONES,EXHI01 YES, GO DEVELOP DISPLAY CODING 33103021 CLC DOP1(LX2),CBFRST CONTINUATION STRING... 33110021 BC NOTEQ,NXTSTR YES, GO BACK TO GETDOP ROUTINE 33117021 LH RW4,DIFPNN CONVERT BYTE DISPLACEMENT TO 33124021 LA RW4,DX3(RW4) NEXT HIGHEST WORD DISPLACEMENT 33131021 AH RW4,DIPARE ALLOW FOR LAST FP CONV, IF ANY 33138021 SRL RW4,DX2 33145021 STH RW4,EXPARC START PARAM CT BEYOND N 33152021 OI DIFPSW,MSWON SET DISPLAY/EXHIBIT SW 33159021 NI EXHBSC,MSWOFF 33166021 NI EXHBSN,MSWOFF 33173021 XC DISPNN(LX2),DISPNN USE DISPNN AS XSA CTR FOR IFP 33180021 LA RW4,LDOP DISPLACEMENT OF FIRST OPERAND 33187021 LA RW2,DOP1(RW4) 33194021 EXHB03 CLC DX0(LX2,RW2),CBCHGD 33201021 BC EQ,EXHB01 BRANCH TO EXHB01 33208021 EXHB04 CLC DX0(LX2,RW2),CBNAMD 33215021 BC EQ,EXHB02 BRANCH TO EXHB02 33222021 TM EXHBSC,MSWON 33229021 BC ZERO,EXHI02 NIF NOT CHANGED, GO TO EXHI02 33236021 LH RW5,SWCOUN GET AN XSASW NUMBER FOR 33243021 LA RW5,DX1(RW5) THIS EXHIBIT CHANGED STATEME 33250021 STH RW5,SWCOUN 33257021 * INITIALIZE FOR LOOPS 33264021 EXHI03 MVI XREG1,XRA 33271021 MVI XREG2,XRA 33278021 BAL RETRG,SUB * SR XRA,XRA 33285021 EXHI02 EQU * UNCHANGED ENTERS HERE 33292021 SR RW5,RW5 33299021 ST RW5,EXHIBP INIT BP 33306021 L RW5,EXHIC1 ='80000000' 33313021 EXHI04 CLC DX0(LX2,RW2),HTERM TERMINATOR... 33320021 BC EQ,EXHI05 YES, FINISH UP 33327021 CLI DX0(RW2),XX35 NAME OF DN... 33334021 BC EQ,EXHI06 YES BYPASS 33341021 CLI DX0(RW2),MDN DN... 33348021 BC EQ,EXHI07 YES 33355021 CLC DX4(LX3,RW2),XTALLV+NX4 TALLY... 33362021 BC EQ,EXHI07 YES, FALLTHRU WILL BE LIT, FIGC 33369021 CLI DX0(RW2),MPARMA IFP IN PARAM AREA... 33376021 BC EQ,EXHI07 YES, TREAT AS DN 33383021 SRL RW5,DX2 33390021 EXHI08 BAL RETRG,GETDOP GET NEXT DN,ETC. 33397021 LA RW2,DOP1(RW4) 33404021 C RW5,GZERO 33411021 BC EQ,EXHI09 BRANCH TO EXHI09 33418021 BC UNCOND,EXHI04 GO TO EXHI04 33425021 SPACE 3 33432021 * DN, FIGCON OR LITERAL FOUND. GENERATE CODE. 33439021 EXHI07 BAL RETRG,CALCLG GET LENGTH 33446021 BC UNCOND,EXHI05 ILLEGAL, TERMINATE 33453021 LR RW1,RW5 SET UP BIT PATTERN (BP) 33460021 O RW1,EXHIBP 33467021 ST RW1,EXHIBP 33474021 SRL RW5,DX1 33481021 TM EXHBSC,MSWON 33488021 BC ZERO,EXHI3C NOT CHANGED 33495021 BAL RETRG,EXHI0A SET UP FOR... 33502021 BAL RETRG,COMPLG * CLC XSA(N),DN 33509021 ST RW5,MYSAVE SET UP LIT-Q IN DIRECT A-TEXT 33516021 MVC A99CH1(LX4),MYSAVE 33523021 BAL RETRG,GATXTV GENERATE A-TEXT FOR BRANCHING ON 33530021 DC AL2(ATXT99-ATXTBV) THE CLC & OR'ING LIT-Q WITH R1 33537021 DC AL2(ZTXT99-ATXT99) 33544021 BAL RETRG,EXHI0A SET UP FOR... 33551021 TM DX0(RW2),XXFA CONVERTED IFP... 33558021 BC NOTEQ,EXHI16 NO 33565021 LH RETRG,DISPNN 33572021 AH RETRG,LENGTH+NX2 33579021 STH RETRG,DISPNN BOOKKEEP XSA CELLS FOR IFP ITEM 33586021 EXHI16 EQU * 33593021 BAL RETRG,MVC * MVC XSA(N),DN 33600021 SRL RW5,DX1 33607021 LH RW1,XSACTR 33614021 AH RW1,LENGTH+NX2 33621021 STH RW1,XSACTR 33628021 BC UNCOND,EXHI08 GO TO EXHI08 33635021 SPACE 3 33642021 EXHI3C SRL RW5,DX1 33649021 BC UNCOND,EXHI08 GO TO EXHI08 33656021 SPACE 3 33663021 * FIRST STRING DONE, GO TO GET SECOND ONE. 33670021 EXHI05 BAL RETRG,EXHI0B TERM INNER LOOP FIRST 33677021 OI FLAGSW,MSWON 33684021 BC UNCOND,DON *** LRETURN TO PHASE 5 CONTROL 33691021 SPACE 2 33698021 EXHI09 BAL RETRG,EXHI0B GO TO EXHI03 33705021 B EXHI03 BRANCH TO EXHI03 (INIT. LOOP) 33712021 SPACE 3 33719021 * 35 WORD FOUND, BYPASS AT THIS TIME. 33726021 EXHI06 BAL RETRG,GETDOP GET NEXT 33733021 LA RW2,DOP1(RW4) 33740021 CLC PR35C1(LX3),DX0(RW2) LEFT PARAN FOUND... 33747021 BC NOTEQ,EXHI04 NO, NO SUBSCRIPTS, CONTINUE 33754021 EXHI12 BAL RETRG,GETDOP YES, DISCARD SUBSCRIPT NAME INF 33761021 LA RW2,DOP1(RW4) 33768021 CLC PR35C2(LX3),DX0(RW2) RIGHT PARAN... 33775021 BC NOTEQ,EXHI12 NO, DISCARD 33782021 BC UNCOND,EXHI08 YES, CONTINUE WITH A GETDOP 33789021 * START PROCESSING OF DUPL STRING,BYPASS TILL 1ST. DN, ETC. 33796021 EXHI01 NI FLAGSW,MSWOFF 33803021 LA RW4,LDOP 33810021 LA RW2,DOP1(RW4) LOCATE FIRST OPERAND 33817021 BC UNCOND,EXHI10 BRANCH TO EXHI10 33824021 EXHI11 BAL RETRG,GETDOP GET NEXT 33831021 LA RW2,DOP1(RW4) 33838021 EXHI10 CLC DX0(LX2,RW2),CBCHGD 33845021 BC EQ,EXHI11 GO TO EXHI11 33852021 CLC DX0(LX2,RW2),CBNAMD 33859021 BC EQ,EXHI11 DISCARD TILL 1ST OPERAND 33866021 TM EXHBSC,MSWON CHANGED CASES WHICH NEED ... 33873021 BC ZERO,EXHI13 IF NOT CHANGED CASES, GO TO 33880021 MVC A59CH1(LX2),SWCOUN 33887021 MVC A59CH2(LX2),SWCOUN 33894021 BAL RETRG,GATXTV * SR XRD,XRD 33901021 DC AL2(ATXT59-ATXTBV) * IC XRD,XSASW 33908021 DC AL2(ZTXT59-ATXT59) * OI XSASW,MSWON 33915021 EXHI13 LH RW3,DIFPNN RELATIVE PARAM POINTER TO 33922021 AH RW3,DIPARE 33929021 XC DIFPNN(LX2),DIFPNN CLEAR TO ZERO 33936021 XC DIPARE(LX2),DIPARE CLEAR TO ZERO 33943021 LA RW3,DX7(RW3) USE PARAM 1 OR FIRST BEYOND FP CONV 33950021 SRL RW3,DX2 33957021 STH RW3,GTEMP 33964021 MVC XCNTR1+NX1(LX2),GTEMP 33971021 MVI XCNTR1,XX1C 33978021 MVI XREG1,XX02 33985021 BAL RETRG,LA PUT A TEXT LA INST. 33992021 BAL RETRG,DIBALR PUT A TEXT BALR INST. 33999021 SR RW3,RW3 34006021 ST RW3,DISPNN 34013021 MVI XCON1,XX02 34020021 MVI XCON1+NX1,XX80 34027021 MVI XCON1+NX2,XX01 34034021 MVI GMCTYP,MDC 34041021 BAL RETRG,MACRO PUT A TEXT MACRO 34048021 BAL RETRG,DIDNIN GENERATE BODY OF DISPLAY CALL SE 34055021 MVC GMACDC(LX3),DISPC1 34062021 MVI GMCTYP,MDC 34069021 BAL RETRG,MACRO * DC XL2'FFFF' 34076021 XC DIFPNN(LX2),DIFPNN CLEAR TO ZERO 34083021 CLC PARMAX(LX2),EXPARC IF LOCAL CT EXCEEDS PREVIOUS 34090021 BC NOTLO,DON *** LEAVE EXHIBIT VERB *** 34097021 MVC PARMAX(LX2),EXPARC COUNTS REPLACE PARMAX BY IT. 34104021 BC UNCOND,DON *** FRETURN TO PHASE 5 CONTROL 34111021 SPACE 3 34118021 * LOCAL SR'S FOR EXHIBIT VERB 34125021 EXHI0A MVI XCNTR1,XX18 SET UP... 34132021 CLC LENGTH+NX2(LX2),H256 IS LENGTH GT 256 34139021 BNH EXHLOK GO TO EXHLOK 34146021 ST XRSUB,IMGSAV SAVE RETURN ADD 34153021 BAL XRSUB,ERRPRO ERROR,PUT OUT MSG 34160021 DC AL1(ERRN17) 34167021 DC AL1(1) 34174021 L XRSUB,IMGSAV RELOAD RETURN ADD 34181021 MVC LENGTH+NX2(LX2),H256 MAKE LENGTH = 256 34188021 EXHLOK EQU * 34195021 MVC XL1(LX2),LENGTH+NX2 34202021 MVC XCNTR1+NX1(LX2),XSACTR XCA(N) AS FIRST OPERAND 34209021 CLI DX0(RW2),XXFA CONVERTED FP IN PARAM AREA... 34216021 BC NOTEQ,EXHI1A NO 34223021 MVI DX1(RW2),XX1C YES, MAKE INTO GTREF FOR PARAM 34230021 MVI DX3(RW2),XX01 PARAM=1 34237021 MVC PLUS2+NX1(LX2),DISPNN +NN 34244021 MVI XL1+NX1,FPLENS SET LENGTH FOR SHORT 34251021 CLI LENGTH+NX3,XX04 . OR . 34258021 BC EQ,EXHI2A SKIP NEXT INSTRUCTION 34265021 MVI XL1+NX1,FPLENL LONG PRECISION 34272021 EXHI2A MVC LENGTH+NX3(LX1),XL1+NX1 ADJUST LENGTH FOR LATER USE 34279021 EXHI1A EQU * 34286021 ST RW2,OP1 SECOND OPERAND DN OR TALLY... 34293021 BCR UNCOND,RETRG LET MAIN CODE SELECT OP 34300021 * GEN CODING TO PUT QUARTER-BYTE SW'S IN PARAM AREA. 34307021 EXHI0B ST RETRG,SVWJHG 34314021 TM EXHBSC,MSWON 34321021 BC ONES,EXHI1B GO TO EXHI1B 34328021 MVI XREG1,XRA 34335021 L RETRG,EXHIBP 34342021 SRL RETRG,DX1 MAKE AN 'ALL CHANGED' 34349021 O RETRG,EXHIBP BIT PATTERN 34356021 ST RETRG,XCON1+NX12 34363021 MVI XCON1+NX16,XX04 34370021 BAL RETRG,LOAD * L XRA,LIT-BP 34377021 BC UNCOND,EXHI3B AVOID GENERATING THE O INSTR. 34384021 EXHI1B EQU * 34391021 MVI XREG1,XRA 34398021 MVC XCON1+NX12(LX4),EXHIBP 34405021 MVI XCON1+NX16,XX04 34412021 BAL RETRG,ORLG * O XRA,LIT-BP 34419021 EXHI3B EQU * 34426021 LH RETRG,EXPARC UP LOCAL PARAM CTR 34433021 LA RETRG,DX1(RETRG) 34440021 STH RETRG,EXPARC 34447021 MVC XCNTR1+NX1(LX2),EXPARC 34454021 MVI XCNTR1,XX1C 34461021 MVI XREG1,XRA 34468021 BAL RETRG,STORE * ST XRA,PARAM 34475021 L RETRG,SVWJHG 34482021 BCR UNCOND,RETRG RETURN TO CALLER 34489021 EXHB01 OI EXHBSC,MSWON SET CHANGED SW 34496021 LA RW4,LDOP(RW4) 34503021 LA RW2,LDOP(RW2) 34510021 BC UNCOND,EXHB04 GO TO EXHB04 34517021 EXHB02 OI EXHBSN,MSWON SET NAMED SW 34524021 LA RW4,LDOP(RW4) 34531021 LA RW2,LDOP(RW2) 34538021 BC UNCOND,EXHB03 GO TO EXHB03 34545021 TITLE 'ON VERB ANALYZER O N' 34552021 IKF50I CSECT 34559021 *=1 ON VERB 34566021 **************************** 34573021 * 34580021 * PHASE 5 ON VERB ANALYZER 34587021 * 34594021 * EXAMPLE... ON 3 UNTIL 9...ELSE... 34601021 * INPUT STRING... ON 04 3 ZERO 9 LGN 34608021 **************************** 34615021 USING *,GVERB 34622021 ON EQU * 34629021 XC ONSWIT(LX10),ONSWIT CLEAR SWITCHES ONESW, ONBSW, ON1 34636021 * ON13SW,ONGFSW,ONSWSW,ONSWNU,ON 34643021 CLC DOP2(LX2),ONZERO =FIGCON ZERO... 34650021 BC NOTEQ,ON1 TO NORMALIZE I2, PUT IN ADOP2 34657021 OI ONI2SW,MSWON SET I2 SW 34664021 ON1R CLC DOP3(LX2),ONZERO = FIGCON ZERO ... 34671021 BC NOTEQ,ON2 TO NORMALIZE I3, PUT IN ADOP3 34678021 OI ONI3SW,MSWON SET I3 SW 34685021 ON2R IC RW3,DOP1+NX1 NORMALIZE I1 AND 34692021 SH RW3,GTHREE PUT INTO DOP1 34699021 EX RW3,ONCNV1 ZAP 34706021 CVB RW3,GTEMP 34713021 ST RW3,DOP1 34720021 CLC DOP2(LX4),FW002 34727021 BC NOTEQ,ON3 SKIP SPECIAL CASES 34734021 TM ONI3SW,MSWON 34741021 BC ZERO,ON3 SKIP SPECIAL CASES 34748021 C RW3,FW002 34755021 BC EQ,ON16C SPECIAL CASE,ON 2 AND EVERY 2 34762021 C RW3,FW001 34769021 BC EQ,ON16B SPECIAL CASE,ON 1 AND EVERY 2 34776021 ON3 TM ONI3SW,MSWON WAS I3 GIVEN... 34783021 BC ONES,ON4 NO 34790021 L RW1,DOP3 C = I3 - 2 34797021 C RW1,DOP1 IS I3 G.T. I1... 34804021 BC HI,ON11 YES, OK 34811021 L RW1,DOP1 NO, FORCE I3 = I1 + 1 34818021 LA RW1,DX1(RW1) 34825021 ST RW1,DOP3 34832021 ON11 SH RW1,G2 34839021 ST RW1,ONCCON 34846021 TM ONI2SW,MSWON WAS I2 GIVEN... 34853021 BC ONES,ON5 NO 34860021 ON6 L RW1,DOP2 YES, 34867021 SH RW1,G1 B = I2 - 1 34874021 ST RW1,ONBCON 34881021 ON7 EQU * 34888021 ON8 BAL RETRG,ONGETC GET AN ON-COUNTER 34895021 STH RW1,ONCOUH SAVE ON-COUNTER HI-LVL 34902021 MVI XREG1,XRA L XRA,ON-COUNTER-HI 34909021 MVI XCNTR1,XX08 34916021 MVC XCNTR1+NX1(LX2),ONCOUH 34923021 BAL RETRG,LOAD GENERATE LOAD INSTRUCTION 34930021 TM ONESW,MSWON JUST I3 = 0 34937021 BC ONES,ON9 YES, ELIM UPPER LIMIT CODING 34944021 MVI XREG1,XRA C XRA,C UPPER LIMIT CODIN 34951021 MVC XCON1+NX12(LX4),ONCCON 34958021 MVI XCON1+NX16,XX04 34965021 BAL RETRG,COMP GENERATE COMPARE INSTRUCTION 34972021 OI ONGFSW,MSWON 34979021 MVC XGN1(LX2),DOP4+NX1 34986021 MVI XREG1,XRB 34993021 BAL RETRG,LOAD GENERATE LOAD INSTRUCTION 35000021 MVI XREG1,HI 35007021 MVI XREG2,XRB 35014021 BAL RETRG,BRANCH GENERATE BRANCH INSTRUCTION 35021021 * 35028021 ON9 MVC A62CH1(LX2),ONCOUH 35035021 BAL RETRG,GATXTV * LA XRA,1(XRA) 35042021 DC AL2(ATXT62-ATXTBV) * ST XRA,ONCTR=HI 35049021 DC AL2(ZTXT62-ATXT62) * 35056021 TM ONBSW,MSWON 35063021 BC ZERO,ON13 BRANCH IF ONBSW NOT ON 35070021 CLC DOP1(LX4),HWDONE 35077021 BC EQ,DON BRANCH IF EQUAL TO PH5CTL 35084021 ON13 EQU * 35091021 CLC DOP2(LX4),FW002 IN THE SPECIAL CASE OF... 35098021 BC NOTEQ,ON13A ON 1 AND EVERY 2 UNTIL ... 35105021 CLC DOP1(LX4),HWDONE THERE IS NO NEED TO GENERATE 35112021 BC EQ,ON16D THE COMPARE, RATHER USE 16D 35119021 ON13A EQU * SPECIAL CASE CODING. 35126021 MVI XREG1,XRA C XRA,A (A IS IN ADOP1) 35133021 MVC XCON1+NX12(LX4),DOP1 35140021 MVI XCON1+NX16,XX04 35147021 BAL RETRG,COMP GENERATE COMPARE INSTRUCTION 35154021 CLC DOP1(LX4),HWDONE 35161021 BC EQ,ON12 DO NOT ISSUE IF I1 = 1 35168021 BAL RETRG,ONLGNF * L XRB,GN=F CONDITIONALL 35175021 ON14 MVI XREG1,LO 35182021 MVI XREG2,XRB 35189021 BAL RETRG,BRANCH * BCR LO,XRB 35196021 ON12 EQU * 35203021 TM ONBSW,MSWON WAS 'ON I1' ONLY... 35210021 BC ONES,DON YES, ALL DONE 35217021 BAL RETRG,ONLGNF * L XRB,GN=F CONDITIONALL 35224021 CLC DOP2(LX4),FW002 IS AND EVERY 2 ... 35231021 BC EQ,ON16D SPECIAL CASE 'AND EVERY 2' 35238021 BAL RETRG,GNSTEP GET A PHASE 5 GN 35245021 MVC A63CH2(LX2),FIVEGN STORE IN A-TEXT 35252021 MVC A66CH3(LX2),FIVEGN 35259021 BAL RETRG,ONGETC GET AN ON CTR 35266021 STH RW1,ONCOUL SAVE LO-LEVEL CTR 35273021 MVC A63CH1(LX2),ONCOUL * L 15,GN=Z 35280021 MVC A66CH1(LX2),ONCOUL * DESTROY GPR15 35287021 MVC A66CH2(LX2),ONCOUL * BCR EQ,R15 35294021 BAL RETRG,GATXTV * L XRA,ONCTR=LO 35301021 DC AL2(ATXT63-ATXTBV) * 35308021 DC AL2(ZTXT63-ATXT63) * 35315021 MVI XREG1,XRA C XRA,B 35322021 MVC XCON1+NX12(LX4),ONBCON 35329021 MVI XCON1+NX16,XX04 35336021 BAL RETRG,COMP GENERATE COMPARE INSTRUCTION 35343021 BAL RETRG,GATXTV * BCR EQ,R15 35350021 DC AL2(ATXT66-ATXTBV) * LA XRA,1(XRA) 35357021 DC AL2(ZTXT66-ATXT66) * ST XRA,ONCTR=LO 35364021 * * BCR UNCOND,XRB 35371021 * * GNZ EQU * 35378021 * * SR XRA,XRA 35385021 * * ST XRA,ONCTR=LO 35392021 BC UNCOND,DON *** LEAVE ON GENERATOR *** 35399021 ON4 TM ONI2SW,MSWON IS I2 MISSING 35406021 BC ZERO,ON10 NO 35413021 L RW1,DOP1 YES, ASSUME AN UPPER LIMIT 35420021 C RW1,FW001 CHECK FOR ON 1 SPECIAL CASE 35427021 BC EQ,ON16A ANALYZE SPECIAL CASES 35434021 LA RW1,DX1(RW1) I3 = I1 + 1 35441021 ST RW1,DOP3 35448021 SH RW1,GTWO 35455021 ST RW1,ONCCON C = I3 - 2 35462021 ON5 LA RW1,DX1 I2 = 1 35469021 ST RW1,DOP2 35476021 OI ONBSW,MSWON SET B SW 35483021 BC UNCOND,ON8 NEXT ANALYSIS 35490021 ON10 OI ONESW,MSWON 35497021 BC UNCOND,ON6 NEXT ANALYSIS 35504021 ONGETC LH RW1,ONCTRN UP ON-COUNTER COUNTER 35511021 LA RW1,DX1(RW1) AND ASSIGN NEW ONE 35518021 STH RW1,ONCTRN IN RW1 35525021 BCR UNCOND,RETRG RETURN TO CALLER 35532021 ON1 IC RW3,DOP2+NX1 NORMALIZE I2 AND 35539021 SH RW3,GTHREE PUT INTO DOP2 35546021 EX RW3,ONCNV2 ZAP 35553021 CVB RW3,GTEMP 35560021 ST RW3,DOP2 35567021 CH RW3,XC001 35574021 BC NOTEQ,ON1R GO THROUGH ON-CODING AGAIN 35581021 OI ONBSW,MSWON 35588021 BC UNCOND,ON1R GO THROUGH ON-CODING AGAIN 35595021 ON2 IC RW3,DOP3+NX1 NORMALIZE I3 AND 35602021 SH RW3,GTHREE PUT INTO DOP3 35609021 EX RW3,ONCNV3 ZAP 35616021 CVB RW3,GTEMP 35623021 ST RW3,DOP3 35630021 BC UNCOND,ON2R GO THRU ON-CODE W SWITCHES SET 35637021 * SPECIAL CASES 35644021 ON16A BAL RETRG,ONLGNF * L XRB,GN=F 35651021 BAL RETRG,ONTSTZ * CLI XSASW,X'01' 35658021 * * BCR EQ,XRB 35665021 BAL RETRG,ONOISW * OI XSASW,X'01' 35672021 BC UNCOND,DON *** LEAVE ON, SP CASE 'A' *** 35679021 ON16D EQU * 35686021 ON16B BAL RETRG,ONLGNF * L XRB,GN=F 35693021 BAL RETRG,ONXISW * XI XSASW,X'01' 35700021 BAL RETRG,ONTSTO * CLI XSASW,X'01' 35707021 * * BCR NOTEQ,XRB 35714021 BC UNCOND,DON RETURN TO PH5CTL FOR NEXT ELEM 35721021 ON16C BAL RETRG,ONLGNF * L XRB,GN=F 35728021 BAL RETRG,ONXISW * XI XSASW,X'01' 35735021 BAL RETRG,ONTSTZ * CLI XSASW,X'01' 35742021 * * BCR EQ,XRB 35749021 BC UNCOND,DON RETURN TO PH5CTL FOR NEXT ELEM 35756021 ONTSTO STM RETRG,RW1,SVWJHE 35763021 LA RW1,NOTEQ 35770021 BC UNCOND,ONTST1 AVOID SECOND ENTRY 35777021 ONTSTZ STM RETRG,RW1,SVWJHE 35784021 LA RW1,EQ 35791021 ONTST1 TM ONSWSW,MSWON XSA SW ALREADY RESERVED... 35798021 BC ONES,ONTST2 YES 35805021 LH RETRG,XSWCTR NO, RESERVE ONE 35812021 OI ONSWSW,MSWON INDICATE XSA SW ALREADY FOUND 35819021 LA RETRG,DX1(RETRG) 35826021 STH RETRG,ONSWNU 35833021 STH RETRG,XSWCTR 35840021 ONTST2 MVI XCNTR1,XX28 35847021 MVC XCNTR1+NX1(LX2),ONSWNU 35854021 MVI IMM,MSWON 35861021 CLI ONTYSW,XX00 OI OR XI ... 35868021 BC NOTEQ,ONTST3 YES 35875021 BAL RETRG,CLI NO,* CLI XSASW,MSWON 35882021 STC RW1,XREG1 35889021 MVI XREG2,XRB 35896021 BAL RETRG,BRANCH * BCR EQ,XRB OR NOTEQ,XRB 35903021 ONTST4 LM RETRG,RW1,SVWJHE 35910021 MVI ONTYSW,XX00 RESTORE TYPE SWITCH 35917021 BCR UNCOND,RETRG RETURN TO CALLER 35924021 ONTST3 CLI ONTYSW,XX01 XI... 35931021 BC EQ,ONTST5 YES 35938021 BAL RETRG,OI NO, * OI XSASW,X'01' 35945021 BC UNCOND,ONTST4 EXIT FROM ROUTINE 35952021 ONTST5 BAL RETRG,XI * XI XSASW,X'01' 35959021 BC UNCOND,ONTST4 EXIT FROM ROUTINE 35966021 ONXISW MVI ONTYSW,XX03 (SAVE A BC) 35973021 ONOISW XI ONTYSW,XX02 XI = 1, OI = 2 35980021 BC UNCOND,ONTSTZ BRANCH TO SECOND ENTRY POINT 35987021 ONLGNF TM ONGFSW,MSWON L GNF ALREADY DONE... 35994021 BCR ONES,RETRG YES, GET OUT 36001021 ST RETRG,SVWJHE NO, DO IT 36008021 MVC XGN1(LX2),DOP4+NX1 36015021 MVI XREG1,XRB 36022021 BAL RETRG,LOAD * L XRB,GN=F 36029021 OI ONGFSW,MSWON 36036021 L RETRG,SVWJHE 36043021 BCR UNCOND,RETRG RETURN TO CALLER 36050021 ONCNV1 ZAP GTEMP(LX8),DOP1+NX4(LX0) ** EXECUTED INSTRUCTIONS ** 36057021 ONCNV2 ZAP GTEMP(LX8),DOP2+NX4(LX0) **EXECUTED INSTRUCTIONS ** 36064021 ONCNV3 ZAP GTEMP(LX8),DOP3+NX4(LX0) **EXECUTED INSTRUCTIONS ** 36071021 TITLE 'TRACE VERB ANALYZER T R A C E' 36078021 *=1 TRACE FOR PN'S 36085021 USING *,GVERB 36092021 TRACE EQU * 36099021 ******************************************************************* 36106021 * GEN CODE TO TEST OBJECT-TIME TRACE SW AND, IF SET, DISPLAY 36113021 * CURRENT PN. 36120021 * 36127021 * INPUT STRING... TRACE 01 RPD 36134021 ******************************************************************* 36141021 BAL RETRG,DIBALR BALR 1,15 36148021 MVI XCON1+NX2,XX01 DC XL2'0001' SYSOUT 36155021 MVI XCON1+NX3,XX40 DC XL1'40' 36162021 MVI XCON1,XX03 36169021 MVI GMCTYP,MDC 36176021 BAL RETRG,MACRO GENERATE MACRO CODING 36183021 BAL RETRG,PNBCD DC XL1' X - 1 ' X=LENGTH 36190021 * DC XLX'PN-IN-BCD...' OF NAME 36197021 BC UNCOND,DON *** EXIT FROM TRACE *** 36204021 EJECT 36211021 *=1 RESET AND READY VERBS 36218021 ******************************************************************* 36225021 * R E A D Y, R E S E T 36232021 * INPUT STRING READY 00 36239021 * RESET 00 36246021 USING *,GVERB 36253021 RESET EQU * 36260021 MVI IMM,XXBF 36267021 MVI GDEBG1,XX04 36274021 BAL RETRG,NI NI TRACES,X'BF' RESET 36281021 BC UNCOND,DON *** LEAVE RESET *** 36288021 USING *,GVERB 36295021 READY EQU * 36302021 MVI IMM,XX40 36309021 MVI GDEBG1,XX04 36316021 BAL RETRG,OI OI TRACES,X'04' READY 36323021 BC UNCOND,DON *** LEAVE READY *** 36330021 TITLE 'IKFCBL51: CALL/LINK VERB PROCESSOR C A L L / L I N K' 36337021 *=1 ENTER VERB (CALL OPTION) 36344021 ******************************************************************* 36351021 * C A L L, L I N K (ENTRY HAS SAME STRUCTURE OF INPUT) 36358021 * USES CONTINUED STRINGS 36365021 * EXAMPLE... CALL 'XN' USING OP1 OP2 OP3 OP4. 36372021 * INPUT STRING... CALL 05 FIRST XN OP1 OP2 OP3 36379021 * CALL 02 04 END 36386021 ******************************************************************* 36393021 USING *,GVERB 36400021 CALL EQU * 36407021 CLI DOP1,MRGN CALL GN ... 36414021 BC EQ,CALLGN YES, SPECIAL CASE, NO VIRTUAL 36421021 MVI XSTRSW,XX01 INDICATE BEGINNING OF A STRING 36428021 CLC DOP1(LX2),CBFRST CONTINUATION STRING... 36435021 BC NOTEQ,NXTSTR YES, GO BACK TO GETDOP ROUTINE 36442021 OI CALLSW,MSWON 36449021 CALL01 SR RW4,RW4 36456021 STH RW4,DISPNN OPERAND COUNT = 1 36463021 STH RW4,EXPARC LOCAL PARAM COUNT INITIALIZED TO 36470021 LA RW4,LDOP 36477021 LA RW2,DOP1(RW4) 36484021 MVC CALLXN(LX10),DX0(RW2) SAVE XN FOR LATER USEAGE 36491021 CALL02 BAL RETRG,GETDOP GET NEXT ELEMENT 36498021 LA RW2,DOP1(RW4) 36505021 CLC DX0(LX2,RW2),HTERM TERMINATOR... 36512021 BC EQ,CALL03 YES 36519021 CLI XSTRSW,XX01 NO. BEGINNING OF A STRING? 36526021 BC NOTEQ,CALL2A NO 36533021 MVI XSTRSW,XX00 YES 36540021 CALL2A MVI XREG1,XX01 36547021 CLI DX0(RW2),MFN FN... 36554021 BC NOTEQ,CALL06 NO 36561021 TM DX6(RW2),XXE0 IS ACCESS METHOD BASIC? 36568021 BC ZERO,CALL11 NO - DON'T NEED DECB INFO 36575021 MVC XCNTR1+NX2(LX1),DX7(RW2) DECB NUMBER 36582021 MVI XCNTR1,XX14 PASS DECB CODE 36589021 BC UNCOND,CALL07 GENERATE LOAD INSTRUCTION 36596021 CALL11 MVC XCNTR1+NX2(LX1),DX5(RW2) YES, SET UP FOR FN 36603021 BC UNCOND,CALL07 GENERATE LOAD INSTRUCTION 36610021 CALL06 CLI DX0(RW2),PNREF RPN? 36617021 BC NOTEQ,CALL08 NO, MUST BE DN OR TALLY 36624021 MVC XPN1+NX1(LX3),DX1(RW2) 36631021 CALL07 BAL RETRG,LOAD * L 1,RPNADR OR 1,DCBA 36638021 BC UNCOND,CALL09 BRANCH AROUND LA INSTRUCTION 36645021 CALL08 DS 0H 37330 36652021 LR RW6,RW2 37330 36659021 ST RW2,OP1 37330 36666021 BAL RETRG,LA * LA 1,DN 36673021 TM DX7(RW6),XX02 ANY QRTNS NECESSARY... 7330 36680021 BC ONES,GNRTN YES 7330 36687021 CALL09 EQU * 36694021 MVI XCNTR1,XX1C 36701021 LH RETRG,EXPARC 36708021 LA RETRG,DX1(RETRG) UP LOCAL PARAM CT BY ONE 36715021 STH RETRG,EXPARC 36722021 MVC XCNTR1+NX1(LX2),EXPARC 36729021 MVI XREG1,XX01 36736021 BAL RETRG,STORE ST 1,PARAMI 36743021 BC UNCOND,CALL02 GO GET NEXT OPERAND 36750021 CALL03 EQU * 36757021 CLC EXPARC(LX2),GZERO ANY PARAM'S USED... 36764021 BC EQ,CALL10 NO 36771021 MVI XCNTR1,XX1C 36778021 MVC XCNTR1+NX1(LX2),EXPARC YES, SET HI-ORDER BIT OF LAST O 36785021 MVI IMM,XX80 36792021 BAL RETRG,OI * OI PARAM=LAST,X'80' 36799021 MVI XCNTR1+NX2,XX01 36806021 MVI XCNTR1,XX1C 36813021 MVI XREG1,XX01 36820021 BAL RETRG,LA * LA 1,PARAM-1 36827021 CALL10 L RW3,SPACES 36834021 CLC EXPARC(LX2),GZERO ANY PARAMETERS USED... 36841021 BNE CALL13 YES 36848021 BAL RETRG,GATXTC * 36855021 DC AL2(ATXT119-ATXTBC) * SR 1,1 36862021 DC AL2(ZTXT119-ATXT119) * 36869021 CALL13 DS 0H 36876021 ST RW3,GVIRT1 PAD VIRT WITH BLANKS 36883021 ST RW3,GVIRT1+NX4 36890021 SR RW3,RW3 36897021 IC RW3,CALLXN+NX1 CHAR COUNT 36904021 BCTR RW3,RW0 REDUCE CHAR COUNT BY ONE 36911021 EX RW3,CALLMV MOVE IN PROPER NUMBER OF CHAR'S 36918021 MVC VIRTC1+NX2(LX2),VIRCTR ASSUME CALL 36925021 TM CALLSW,MSWON 36932021 BC ONES,CALL04 IF CALL, NOT LINK 36939021 MVI VIRTC1+NX1,XX01 CHANGE TO LINK 36946021 CALL04 MVI XREG1,XX0F 36953021 BAL RETRG,LOAD L 15,ADCON-VIRT-XN 36960021 BAL RETRG,GATXTC * BALR 14,15 36967021 DC AL2(ATXT55-ATXTBC) * STH 15,92(13) 36974021 DC AL2(ZTXT55-ATXT55) (SAVE RETURN CODE) 36981021 BAL RETRG,WRKLRG DESTROY REGISTERS 36988021 B GENERGN LOOP THRU GNCALTBL 7330 36995021 CALL12 DS 0H 37330 37002021 CLC PARMAX(LX2),EXPARC IF OLD PARAM CT HIGEST, 37009021 BC NOTLO,DON *** LEAVE CALL/LINK *** 37016021 MVC PARMAX(LX2),EXPARC ELSE RELACE BY LOCAL PARAM CT AN 37023021 BC UNCOND,DON *** LEAVE CALL/LINK *** 37030021 CALLGN MVC XGN1(LX2),DOP1+NX1 37037021 MVI XREG1,XX0F 37044021 BAL RETRG,LOAD * L 15,GN-DEBUG-PACKER 37051021 MVI XREG1,XX0E 37058021 MVI XREG2,XX0F 37065021 BAL RETRG,BAL * BALR 14,15 37072021 BAL RETRG,WRKLRG DESTROY REGISTERS 37079021 BC UNCOND,DON *** LEAVE CALL GN *** 37086021 CALLMV MVC GVIRT1(LX0),CALLXN+NX2 ** EXECUTED INSTRUCTION ** 37093021 SPACE 3 37330 37100021 GNRTN DS 0H 37330 37107021 * THIS ROUTINE INSERTS AN ENTRY INTO THE GNCALTBL FOR 37330 37114021 * EVERY OBJECT OF AN ODO WHICH IS USED IN A CALL STATEMENT. 37330 37121021 STM RW1,RW2,GNSAVE 37330 37128021 L RW1,GNCALPRM 37330 37135021 L XRVAR,AINSRT 37330 37142021 BALR RETRG,XRVAR TAMER - INSERT ENTRY 7330 37149021 * RW2 HAS ADDRESS OF NEXT TABLE SLOT 37330 37156021 MVC DX0(LX3,RW2),DX10(RW6) 37330 37163021 LM RW1,RW2,GNSAVE 37330 37170021 B CALL09 RETURN TO CALLER 7330 37177021 SPACE 3 37330 37184021 GENERGN DS 0H 37330 37191021 * THIS ROUTINE GOES THRU GNCALTBL AND BRANCHES TO QRTNS 37330 37198021 * ARE GENERATED TO UPDATE FIELDS WHICH WERE POSSIBLY CHANGED 37330 37205021 * IN A SUBPROGRAM. 37330 37212021 STM RW1,RW2,GNSAVE 37330 37219021 L RW1,GNCALPRM ADDRESS OF TIB 7330 37226021 L RW1,DX0(RW1) ADDRESS OF TAMM 7330 37233021 ST RW1,TAMSAV SAVE ADDRESS OF TAMM 01041 37240021 LH RW2,DX4(RW1) LENGTH OF TABLE 7330 37247021 L RW1,DX0(RW1) ADDRESS OF TABLE 7330 37254021 LA RW1,DX0(RW1) CLEAR HIGH-ORDER BYTE 7330 37261021 AR RW2,RW1 37330 37268021 GENERGN1 DS 0H 37330 37275021 CR RW1,RW2 END OF TABLE... 7330 37282021 BE GENERGN2 YES 7330 37289021 BAL RETRG,LSPR1 NO, CHECK QRTNS 7330 37296021 LA RW1,DX3(RW1) BUMP POINTER 7330 37303021 B GENERGN1 LOOP THRU AGAIN 7330 37310021 GENERGN2 DS 0H 37330 37317021 L RW1,TAMSAV 01041 37324021 XC DX4(LX2,RW1),DX4(RW1) SET TABLE LENGTH TO ZERO 01041 37331021 LM RW1,RW2,GNSAVE 37330 37338021 B CALL12 RETURN TO CALLER 7330 37345021 USING *,GVERB 37352021 *=1 ENTER VERB (LINK OPTION) 37359021 LINKK EQU * 37366021 CLC DOP1(LX2),CBFRST CONTINUATION STRING... 37373021 BC NOTEQ,NXTSTR YES, GO BACK TO GETDOP ROUTINE 37380021 NI CALLSW,MSWOFF 37387021 L GVERB,ADCALL USE CALL COMMON CODING 37394021 L RW4,ADCONL A(CALL01) 37401021 BCR UNCOND,RW4 ENTER COMMON CODE 37408021 TITLE 'IKFCBL51: RETURN VERB ANALYZER R E T U R N' 37415021 * 37422021 ******************************************************************* 37429021 * R E T U R N 37436021 * 37443021 * INPUT STRINGS...(SORT)...RETURN 01 SORT-FILE-NAME 37450021 * 37457021 * (MOVE - IF RETURN 'INTO') 37464021 * 37471021 * RETURN 01 GN=NEXT SENTENCE 37478021 * OR 37485021 * RETURN 01 END (IF NO AT-END CLAUSE) 37492021 * 37499021 * 37506021 ******************************************************************* 37513021 USING *,GVERB 37520021 RETURN DS 0H 42646 37527021 CLI DOP1,MSFN FIRST TIME THRU... 37534021 BNE SORE02 NO, GEN 2ND TIME CODE 37541021 * GENERATE... 37548021 * * L 15,5GN= AT-END ADDR 37555021 * * ST 15,SORTSAVE 37562021 * * L 14,XSA 37569021 * * BALR 2,14 RETURN TO SORT SR 37576021 * * L 15,SORTSAVE AT-END RET FROM SORT 37583021 * * BCR 15,15 37590021 * * ST 14,XSA NORMAL RET FROM SORT 37597021 OI SORTSW1,SORTRTRN INDICATE RETURN VERB 42646 37604021 BAL RETRG,SRRXSA UPDATE XSA TABLE 37611021 MVC A65CH1(LX2),XSASORT 42646 37618021 MVC A65CH3(LX2),XSASORT 42646 37625021 BAL RETRG,GNSTEP BUMP GNCTR BY 1 37632021 MVC A65CH2(LX2),FIVEGN 37639021 BAL RETRG,GATXTV GENERATE 37646021 DC AL2(ATXT65-ATXTBV) ATEXT AS 37653021 DC AL2(ZTXT65-ATXT65) IN HEADING 37660021 TM SORTSW1,SORTVERB SORT GIVING FILE... 42646 37667021 * IF THIS TEST IS POSITIVE, WE ARE WITHIN A DUMMY OUTPUT PRO- 42646 37674021 * CEDURE FOR A SORT GIVING FILE. 42646 37681021 BZ SORE03 NO 42646 37688021 MVC A68CH1(LX2),XSARTRN YES, INSERT CELL NUMBER 42646 37695021 BAL RETRG,GATXTV * 7882 37702021 DC AL2(ATXT68-ATXTBV) * ST 1,XSA-CELL 7882 37709021 DC AL2(ZTXT68-ATXT68) * 7882 37716021 SORE03 DS 0H 7882 37723021 LA RW2,DOP1 SET UP POINTER TO SFN 37730021 TM DX9(RW2),SORTSRA SAME RECORD AREA OPERATIVE... 39847 37737021 BO SORE04 YES DONT STORE BLLS 39847 37744021 BAL RETRG,IOSTBL * ST 1,BL 37751021 SORE04 DS 0H 39847 37758021 BAL RETRG,IOQRTN GENERATE QRTN CALLS 39847 37765021 B PH5CTL END OF FIRST TIME PROCESSING 37772021 SORE02 EQU * 37779021 * SECOND TIME THRU 37786021 CLC DOP1(LX2),HTERM AT END = NEXT SENTENCE... 37793021 BE SORE01 YES, BYPASS NORMAL RETURN 42646 37800021 MVC XGN1(LX2),DOP1+NX1 37807021 MVI XREG1,XX0F 37814021 BAL RETRG,LOAD * L 15,GN=NEXT SENTENCE 37821021 MVI XREG1,XX0F 37828021 MVI XREG2,XX0F 37835021 BAL RETRG,BRANCH * BCR 15,15 37842021 BAL RETRG,GDES15 DESTROY 15 37849021 SORE01 MVC GLGNCN+NX3(LX2),A65CH2 37856021 BAL RETRG,GNOPT3 * GN=X EQU * 37863021 BAL RETRG,GFRRES RESERVE 14 37870021 MVI XREG1,XX0E 37877021 MVC XCNTR1+NX1(LX2),A65CH1 37884021 MVI XCNTR1,XX18 37891021 MVI XREG1,XX0E 37898021 BAL RETRG,STORE * ST 14,XSA 37905021 BAL RETRG,GFREE FREE 14 37912021 NI SORTSW1,X'FF'-SORTRTRN LEAVING RETURN 42646 37919021 B PH5CTL CONTINUE PROCESSING 42646 37926021 TITLE 'IKFCBL51: RELEASE VERB ANALYZER R E L E A S E' 37933021 *=1 RELEASE VERB 37940021 ******************************************************************* 37947021 * R E L E A S E 37954021 * 37961021 * INPUT STRING... RELEASE 00 37968021 ******************************************************************* 37975021 USING *,GVERB 37982021 RELEES DS 0H 42646 37989021 BAL RETRG,GFRRES RESERVE 14 42646 37996021 OI SORTSW1,SORTRLSE INDICATE RELEASE VERB 42646 38003021 BAL RETRG,CALCLG CALCULATE LENGTH OF VN/VLC 38010021 NOP DX0(RW0) NULL OPERATION 38017021 TM LENGTH,XX80 VLC INDICATED... 42646 38024021 BZ RELE03 NO, BUT MAY BE VARIABLE 42646 38031021 MVI XCNTR1,XX04 SET CODE FOR VLC 38038021 MVC XCNTR1+NX1(LX2),LENGTH+NX2 SET VLC NUMBER 38045021 B RELE02 BYPASS FIXED LENGTH CODE 38052021 RELE03 DS 0H 42646 38059021 TM SORTSW1,SORTVERB IS THIS DUMMY OUTPUT PROC... 42646 38066021 BZ RELE01 NO, REGULAR INLINE CODE 42646 38073021 * 42646 38080021 * HERE WE HAVE ESTABLISHED THAT WE ARE WITHIN A DUMMY OUTPUT 42646 38087021 * PROCEDURE, AND WE MUST GENERATE A TEST TO DETERMINE IF WE HAVE 42646 38094021 * VARIABLE OR FIXED LENGTH RECORDS, AND WIND UP WITH REGISTER 3 42646 38101021 * CONTAINING THE APPROPRIATE LENGTH. 42646 38108021 * 42646 38115021 BAL RETRG,GNSTEP BUMP GN COUNTER 42646 38122021 MVC RLSEGN1(LX2),GNCTR SAVE FIRST GN 42646 38129021 BAL RETRG,GNSTEP BUMP GN COUNTER 42646 38136021 MVC RLSEGN2(LX2),GNCTR SAVE SECOND GN 42646 38143021 MVC XGN1(LX2),RLSEGN1 42646 38150021 MVI XREG1,XX0E 42646 38157021 BAL RETRG,LOAD * L 14,GN(FIXED-LENGTH) 42646 38164021 MVC A05CH1(LX2),XSARLSE INSERT XSA CELL 42646 38171021 MVC A05CH2(LX2),XSARLSE NUMBERS INTO A-TEXT 42646 38178021 BAL RETRG,GATXTV * GENERATE 42646 38185021 DC AL2(ATXT05-ATXTBV) * INLINE RECMODE 42646 38192021 DC AL2(ZTXT05-ATXT05) * TEST 42646 38199021 MVI XCON1+NX15,XX04 42646 38206021 MVI XCON1+NX16,XX02 42646 38213021 MVI XREG1,XX03 42646 38220021 BAL RETRG,SHALF SH 3,=H'4' 42646 38227021 MVC XGN1(LX2),RLSEGN2 42646 38234021 MVI XREG1,XX0E 42646 38241021 BAL RETRG,LOAD * L 14,GN(BYPASS-FIXED) 42646 38248021 MVI XREG1,XX0F 42646 38255021 MVI XREG2,XX0E 42646 38262021 BAL RETRG,BRANCH * BCR 15,14 42646 38269021 MVC GLGNCN+NX3(LX2),RLSEGN1 42646 38276021 BAL RETRG,GNOPT3 * GN(FIXED-LENGTH) EQU * 42646 38283021 RELE01 DS 0H 38290021 MVI XCON1+NX16,DX2 SET LITERAL LENGTH 38297021 MVC XCON1+NX14(LX2),LENGTH+NX2 AND VALUE 38304021 RELE02 DS 0H 38311021 MVI XREG1,XX03 38318021 BAL RETRG,LOAD * L R3,RECORD LENGTH (OR VLC) 38325021 TM SORTSW1,SORTVERB IS THIS DUMMY OUTPUT PROC... 42646 38332021 BZ RELE04 NO 42646 38339021 TM LENGTH,XX80 VLC... 38346021 BO RELE04 YES 38353021 MVC GLGNCN+NX3(LX2),RLSEGN2 42646 38360021 BAL RETRG,GNOPT3 * GN(BYPASS-FIXED) EQU * 42646 38367021 RELE04 DS 0H 42646 38374021 BAL RETRG,SRRXSA UPDATE XSA TABLE 38381021 BAL RETRG,LOAD * L 14,XSA 38388021 MVI XREG1,XX02 38395021 MVI XREG2,XX0E 38402021 BAL RETRG,BAL * BALR 2,14 38409021 BAL RETRG,SRRXSA UPDATE XSA TABLE 38416021 BAL RETRG,STORE * ST 14,XSA 38423021 BAL RETRG,GFREE GENERATE FREE MACRO 38430021 B PH5CTL CONTINUE PROCESSING 42646 38437021 TITLE 'IKFCBL51: SORT VERB ANALYZER S O R T' 38444021 *=1 SORT 38451021 ******************************************************************* 38458021 * S O R T S T A T E M E N T 38465021 * USES CONTINUED STRINGS. PERFOR 38472021 * STRINGS ARE INTER-MIXED IF INP 38479021 * EXAMPLE... OR OUTPUT PROCEDURES ARE SPECI 38486021 * SORT S-F-N ASCENDING KEY-1 DESCENDING KEY-2, INPUT PROCEDURE 38493021 * PN1 THRU PN-2, GIVING F-N. 38500021 * INPUT STRINGS 38507021 * SORT 03 FIRST BCD-NAME S-F-N 38514021 * SORT 03 ASCENDING KEY-1 DESCENDING 38521021 * SORT 03 KEY-2 ZERO GIVNG 38528021 * SORT 01 END 38535021 * (NORMAL PERFORM STRINGS FOR 'PERFORM PN-1 THRU PN-2', PROCE 38542021 * BY OTHER ANALYZERS) 38549021 * AND 38556021 * (STRINGS FOR OPEN OUTPUT-FILE, RETURN, WRITE ON 38563021 * OUTPUT-FILE, CLOSE OUTPUT-FILE TO BE GENERATED 38570021 * IN-LINE) 38577021 * SORT 01 END 38584021 * NOTE... THE PARAM AREA IS REFERENCED HERE AS BYTE NUMBERS, 38591021 * WHICH ARE CONVERTED TO A-TEXT CONVENTION I STPARM 38598021 ******************************************************************* 38605021 USING *,GVERB 38612021 SORT DS 0H 42646 38619021 TM SORTSW,SINPT AFTER AN INPUT PROCEDURE 38626021 BC ONES,SORT01 YES 38633021 TM SORTSW,SOTPT AFTER AN OUTPUT PROCEDURE 38640021 BC ONES,SORT02 YES 38647021 CLC DOP1(LX2),CBFRST CONTINUATION STRING... 38654021 BC NOTEQ,NXTSTR YES, GO BACK TO GETDOP ROUTINE 38661021 * FIRST TIME THRU SORT 38668021 * 7882 38675021 OI SORTSW1,SORTVERB INDICATE MIDDLE OF SORT 42646 38682021 * TO OTHER ANALYZERS 42646 38689021 TM SWITCH+NX1,SORTRTN DID USER TEST SORT RETURN... 38696021 BO SORT09 YES 38703021 MVI SRTNME,XX40 RESET OBJ TIME MSG PARAMETER 38710021 MVC SRTNME+NX1(LX31),SRTNME 38717021 SR RW1,RW1 38724021 IC RW1,DOP2+NX1 38731021 BCTR RW1,RW0 DECREASE COUNT BY 1 38738021 EX RW1,BCDMVC MOVE SORT-FILE-NAME IN BCD TO MSG 38745021 SORT09 EQU * 38752021 LA RW2,DOP3 SET UP POINTER TO SORT FN 38759021 * 38766021 * INITIALIZE WORK AREAS AND CONTROL CARD FIELDS 38773021 * 38780021 OI SORTSW,SFIRST SET ON FOR FIRST TIME LOGIC 38787021 TM DX9(RW2),SORTSRA SAME RECORD AREA SPECIFIED... 42646 38794021 BZ SORT11 NO 4774 38801021 OI SORTSW1,SORTSRA INDICATE SO FOR SORT USE 42646 38808021 SORT11 DS 0H 4774 38815021 MVC SBEGIN(LX16),SORLIT 38822021 MVI RECLIT+NX13,XCF SET RECORD TYPE TO F 38829021 MVI A52CH3,XX1D SET MIN LITERAL LENGTH, CHANGED 38836021 * IF RECORD TYPE=V 38843021 LA RW3,DX16 38850021 STH RW3,SDISPL INITIALIZE DISPL FOR WK BUFFER 38857021 MVC SORSFN(LX5),DX0(RW2) SAVE FOR LATER USE 38864021 LA RW6,SORLG1 38871021 MVC GTEMP(LX2),DX5(RW2) GET MAX RECORD LENGTH 38878021 LH RW5,GTEMP 38885021 TM DX3(RW2),XX60 FIXED LENGTH RECS... 38892021 BM SORT26 YES 38899021 * SPANNED RECS TREATED AS VARIABLE 38906021 SORT28 LA RW5,DX4(RW5) ALLOW FOR CHAR-COUNT WORD 38913021 SORT26 CVD RW5,GTEMP 38920021 UNPK DX0(LX5,RW6),GTEMP+NX5(LX3) 38927021 OI DX4(RW6),XXF0 SET SIGN ZONE TO 'F' 38934021 TM DX3(RW2),XX60 38941021 BM SORT27 FIXED LENGTH INIT IS DONE 38948021 TM SORTSW,SORTVL HAS MIN LENGTH BEEN PICKED UP.. 38955021 BO SORT27 YES 38962021 OI SORTSW,SORTVL INDICATE VARIABLE LENGTH OR 38969021 LA RW6,SORLG2 SPANNED RECORDS 38976021 MVC GTEMP(LX2),DX7(RW2) PICK UP MINIMUM RECORD LENGTH 38983021 LH RW5,GTEMP 38990021 B SORT28 PROCESS MIN.RECD.LENGTH 38997021 SORT27 EQU * 39004021 LA RW4,LDOP*2 39011021 SORT03 BAL RETRG,GETDOP GO TO NEXT OPERAND 39018021 LA RW2,DOP1(RW4) 39025021 CLI DX0(RW2),MSDN BUILD CARDS FOR... 39032021 BC EQ,SORT04 SDN 39039021 CLC DX0(LX2,RW2),CBASCD 39046021 BNE SORT3A NOT ASCENDING KEY 39053021 OI SORTSW,SASCEN ASCENDING KEY 39060021 B SORT03 CHECK NEXT OPERAND 39067021 SORT3A CLC DX0(LX2,RW2),CBDSCD 39074021 BNE SORT3B NOT DESCENDING KEY 39081021 NI SORTSW,X'FF'-SASCEN DESCENDING KEY 42646 39088021 B SORT03 CHECK NEXT OPERAND 39095021 SORT3B EQU * 39102021 CLC DX0(LX2,RW2),CBUSIN USING... 39109021 BE SORT08 YES, CODE GENERATED IN-LINE 39116021 * BY ELIMINATION, INPUT PROCEDURE. 39123021 SORT08 BAL RETRG,GETDOP GET NEXT DOP 39130021 LA RW2,DOP1(RW4) 39137021 CLC DX0(LX2,RW2),CBGIVG GIVING... 39144021 BE SORT10 YES, CODE GEN IN-LINE 39151021 SORT10 EQU * 39158021 SORT24 BAL RETRG,GETDOP SYNCH STRINGS BEFORE PERFORMS 39165021 LA RW2,DOP1(RW4) 39172021 CLC DX0(LX2,RW2),HTERM 39179021 BC NOTEQ,SORT24 SEARCH FURTHER FOR TERMINATOR 39186021 * 39193021 * ALL KEYS FINISHED. FINISH SORT LITERAL 39200021 * 39207021 LH RW3,SDISPL 39214021 LA RW6,SBEGIN(RW3) 39221021 TM SWITCH+NX1,RERUNN SORT RERUN... 39228021 BZ SORT29 NO 39235021 MVC DX0(LX7,RW6),SCHKPT * '),CKPT ' 39242021 LA RW3,DX5(RW3) 39249021 B SORT30 BRANCH AROUND RERUN CLOSE 39256021 SORT29 MVC DX0(LX2,RW6),SORCL3 * ') ' 39263021 SORT30 EQU * 39270021 BCTR RW3,RW0 DECREASE COUNT BY 1 39277021 STC RW3,A52CH1 SET END OF SRT LIT IN DIRCT ATXT 39284021 * IE DISPL FROM BEG OF SORT LITERAL. 39291021 * R3 IS 2 BYTES LESS THAN THE LNGTH 39298021 * OF DATA IN WORK BUFFER SINCE 39305021 * '34CT' AT BEGIN. OF BUFFER IS 39312021 * NOT PART OF THE ACTUAL LITERAL. 39319021 LA RW3,DX15(RW3) ALLOW 15 BYTES WORK SPACE IN 39326021 * PARAMS 39333021 * 39340021 * BUILD RECORD LITERAL. MOVE SORT AND RECORD CARD IMAGE 39347021 * LITERAL TO PARAM CELLS. 39354021 * 39361021 LA RW6,SBEGIN+NX2 ALLOW FOR 2 EXTRA BYTES IE 39368021 * '34CT' THAT R3 DOESNT ACCOUNT FOR 39375021 AR RW3,RW6 RW3 NOW HAS BEG ADDR OF REC LIT 39382021 * IN WORK BUFFER 39389021 LR RW2,RW3 R2 HAS BEG ADDR OF REC LIT 39396021 MVC DX0(LX23,RW3),RECLIT * ' RECORD TYPE=F,LENGTH=(' 39403021 MVC DX23(LX5,RW3),SORLG1 * 'MAX LENGTH' 39410021 LA RW3,DX28(RW3) 39417021 TM SORTSW,SORTVL VARIABLE LENGTH RECS... 39424021 BZ SORT33 NO 39431021 MVI A52CH3,XX25 INCR LITERAL LENGTH COUNT 39438021 MVI DX13(RW2),XCV CHANGE TYPE TO V 39445021 MVC DX0(LX8,RW3),SORCL4 * ',,,MIN LENGTH' 39452021 LA RW3,DX8(RW3) 39459021 SORT33 MVC DX0(LX2,RW3),SORCL3 * ') ' 39466021 LA RW3,DX2(RW3) 39473021 LA RW6,SBEGIN+NX2 39480021 SR RW3,RW6 R3 HAS ACTUAL LITERAL LENGTH 39487021 STH RW3,XL1 SET LENGTH FOR MVC 39494021 STC RW3,SBEGIN+NX1 SET LENGTH IN LITERAL DEF. 39501021 LA RW2,SBEGIN 39508021 ST RW2,OP1 39515021 MVI XCNTR1,XX1C SET CODE FOR PARAM1 39522021 TM SORTSW1,SORTSRA SAME RECORD AREA OPERATIVE... 42646 39529021 BZ SORT34 NO 4774 39536021 MVI XCNTR1+NX2,XX02 INDICATE PARAM2 CELL 4774 39543021 B SORT38 BYPASS OTHER MVI 4774 39550021 SORT34 DS 0H 4774 39557021 MVI XCNTR1+NX2,XX01 INDICATE PARAM CELL 1 4774 39564021 SORT38 DS 0H 4774 39571021 BAL RETRG,MVC * MVC PARAM1(LIT LNGTH),LITERAL 39578021 * 39585021 LA RW3,DX9(RW3) ALLOW 6 BYTES WORK SPACE AFTER 39592021 * REC LIT + 3 TO ALIGN PARAM CELL 39599021 SRL RW3,DX2 39606021 * GET TOTAL NUMB PARAM CELLS USED 39613021 CH RW3,PARMAX 39620021 BNH SORT35 UP PARMAX IN COMMON IF IT IS 39627021 STH RW3,PARMAX TOO SMALL 39634021 SORT35 BAL RETRG,GNSTEP GET GN= FOR INPUT PROC 39641021 MVC SORGN3,FIVEGN 39648021 MVC A52CH4(LX2),FIVEGN 39655021 BAL RETRG,GNSTEP GET GN= FOR OUTPUT PROC 39662021 MVC SORGN4,FIVEGN 39669021 MVC A52CH5(LX2),FIVEGN 39676021 * GENERATE CALLING SEQUENCE TO SORT SUBROUTINE (SEE ATXT52) 39683021 TM SORTSW1,SORTSRA SAME RECORD AREA OPERATIVE... 42646 39690021 BZ SORT36 NO, DONT PUT OUT MVC, LNR 4774 39697021 MVC A52CH2(LX1),SORSFN+NX4 INSERT FIRST BL NUMBER 4774 39704021 MVI A52CH6+NX1,XX02 DENOTE SECOND PARAM CELL 4774 39711021 BAL RETRG,GATXTV * 4774 39718021 DC AL2(ATXT52A-ATXTBV) * SEE ATEXT CODE LISTINGS 4774 39725021 DC AL2(ZTXT52-ATXT52A) * 4774 39732021 MVI A52CH6+NX1,XX01 DENOTE FIRST PARAM CELL 4774 39739021 B SORT37 GO TO COMMON CODING 4774 39746021 SORT36 DS 0H 4774 39753021 BAL RETRG,GATXTV * LA 0,PARAM1 4774 39760021 DC AL2(ATXT52-ATXTBV) * LR 1,0 4774 39767021 DC AL2(ATXT52B-ATXT52) * LA 1,XXX(1) 4774 39774021 * * LA 2,15(1) 4774 39781021 BAL RETRG,GATXTV * LA 3,YYY(2) 4774 39788021 DC AL2(ATXT52C-ATXTBV) * L 4,GN(INPUT PROC) 4774 39795021 DC AL2(ZTXT52-ATXT52C) * L 5,GN(OUTPUT PROC) 4774 39802021 SORT37 DS 0H 4774 39809021 LA RW3,SORTVI * L 15,VIRT-SORT SUBR. 39816021 BAL RETRG,VBALRE * BALR 14,15 39823021 BAL RETRG,GNSTEP BUMP GNCTR BY 1 39830021 MVC XGN1(LX2),FIVEGN 39837021 MVC DISGND(LX2),FIVEGN GND DEFINES STATEMENT AFTER SORT 39844021 MVI XREG1,XX01 39851021 BAL RETRG,LOAD * L R1,GND 39858021 MVI XREG1,XX0F 39865021 MVI XREG2,XX01 39872021 BAL RETRG,BC * BCR UNCOND,R1 39879021 B SORT15 GEN CODING BEFORE INPUT PROC 39886021 SORT19 TM SORTSW,SNDONE DOES OUTPUT CODING FOLLOW... 39893021 BO SORT16 YES, GO GEN CODE 39900021 BAL RETRG,DICOA8 * GND EQU * 39907021 * IF 'SORT-RETURN' CELL IN TGT IS NOT TESTED IN COBOL PGM, GENERATE 39914021 * CODE AFTER EACH SORT TO TEST IT FOR A 0 VALUE. IF VALUE IS NON 0 39921021 * AN OBJECT TIME MSG IS WRITTEN ON THE CONSOLE. 39928021 TM SWITCH+NX1,SORTRTN HAS USER TESTED SORT RETURN... 39935021 BO SORTEX YES, EXIT. 39942021 BAL RETRG,GNSTEP GET GN E 39949021 MVC A115CH1,FIVEGN * SR 0,0 39956021 BAL RETRG,GATXTV * CH 0,SORT-RETURN 39963021 DC AL2(ATXT115-ATXTBV) * L 1,GNE 39970021 DC AL2(ZTXT115-ATXT115) * BCR EQUAL,1 39977021 MVC XL1+NX1(LX1),STLNG SET MSG LENGTH FOR MVC 39984021 MVI XCNTR1,XX1C 39991021 MVI XCNTR1+NX2,XX01 39998021 LA RW0,STOMSG 40005021 ST RW0,OP1 40012021 BAL RETRG,MVC * MVC PARM1,MESSAGE 40019021 MVI XREG1,XX01 40026021 MVI XCNTR1,XX1C 40033021 MVI XCNTR1+NX2,XX01 40040021 BAL RETRG,LA * LA 1,PARM1 40047021 MVI IMM,XX23 40054021 BAL RETRG,SVC * SVC 35 40061021 MVC GLGNCN+NX3(LX2),FIVEGN 40068021 BAL RETRG,GNOPT3 * GNE EQU * 40075021 BC UNCOND,SORTEX EXIT FROM ROUTINE 40082021 SORT15 MVC GLGNCN+NX3(LX2),SORGN3 40089021 BAL RETRG,GNOPT3 * GN3 EQU * 40096021 BAL RETRG,WRKLRG KILL REGS 40103021 BAL RETRG,GFRRES GENERATE RESERVE MACRO 40110021 TM SORTSW1,SORTSRA SAME RECORD AREA SPECIFIED... 42646 40117021 BO SORT17 YES, DO NOT STORE BL'S 4774 40124021 LR RW5,RW2 40131021 LA RW2,SORSFN 40138021 BAL RETRG,IOSTBL * ST 1,BL 40145021 SORT17 DS 0H 4774 40152021 LR RW2,RW5 40159021 BAL RETRG,SRRXSA UPDATE XSA TABLE 40166021 BAL RETRG,STORE * ST 14,XSA 40173021 BAL RETRG,GFREE GENERATE FREE MACRO 40180021 OI SORTSW,SINPT 40187021 B PH5CTL CONTINUE PROCESSING 42646 40194021 SORT01 DS 0H 42646 40201021 NI SORTSW,X'FF'-SINPT 42646 40208021 OI SORTSW,SNDONE INDICATE INPUT CODE DONE 40215021 SORT21 DS 0H 42646 40222021 MVC XCNTR1+NX1(LX2),XSASORT INSERT 42646 40229021 MVI XCNTR1,XX18 40236021 MVI XREG1,XX0E 40243021 BAL RETRG,LOAD * L 14,XSA 40250021 MVI XREG1,UNCOND 40257021 MVI BDISP1,XXE0 40264021 MVI BDISP1+NX1,XX04 40271021 BAL RETRG,BRANCH * BCR UNCOND,14 40278021 BAL RETRG,GFREE GENERATE FREE MACRO 40285021 BC UNCOND,SORT19 CHECK FOR OUTPUT CODING 40292021 SORT16 MVC GLGNCN+NX3(LX2),SORGN4 40299021 BAL RETRG,GNOPT3 * GN4 EQU * 40306021 BAL RETRG,GFRRES * RESERVE 14 51889 40313021 BAL RETRG,GDES15 * DESTROY 15 51889 40320021 BAL RETRG,SRRXSA UPDATE XSA TABLE 40327021 BAL RETRG,STORE * ST 14,XSA 40334021 OI SORTSW,SOTPT 40341021 BAL RETRG,GFREE * FREE 14 51889 40348021 NI SORTSW,X'FF'-SNDONE 42646 40355021 B PH5CTL CONTINUE PROCESSING 42646 40362021 SORT02 BAL RETRG,GFRRES BACK FROM PERFORMS 40369021 NI SORTSW,X'FF'-SOTPT 42646 40376021 BC UNCOND,SORT21 COMMON CODING WITH I/P 40383021 * SORT04 40390021 * BUILD SORT KEY ENTRIES IN WORK BUFFER 40397021 * ENTRY FOR A KEY- 4 BYTES OFFSET FROM BEG OF RECORD 40404021 * 1 BYTE , 40411021 * 3 BYTES KEY LENGTH 40418021 * 1 BYTE , 40425021 * 2 BYTES KEY TYPE 40432021 * 1 BYTE , 40439021 * 1 BYTE SEQUENCE (ASCEND OR DESCEND) 40446021 * 1 BYTE , (ONLY IF ENTRY FOLLOWING) 40453021 * 40460021 SORT04 BAL RETRG,CALCLG GET SORT KEY LENGTH IN 'LENGTH' 40467021 BC UNCOND,DON IMPOSSIBLE 40474021 BAL RETRG,DDISPM GET OFFSET IN XCON1+1 40481021 MVC GTEMP(LX2),XCON1+NX1 40488021 XC XCON1(LX3),XCON1 40495021 LH RW5,GTEMP 40502021 LA RW5,DX1(RW5) CONVERT DISPLACEMENT TO BYTE NUM 40509021 TM SORTSW,SORTVL VARIABLE LENGTH... 40516021 BC ZERO,SORT0B NO 40523021 LA RW5,DX4(RW5) YES, UP BYTE NUMBER BY 4 40530021 SORT0B EQU * 40537021 CVD RW5,GTEMP CONVERT BYTE NUMBER TO ZD FORMAT 40544021 UNPK GTEMP(LX4),GTEMP+NX5(LX3) 40551021 LH RW3,SDISPL DISPLACEMENT INTO WORK BUFFER 40558021 * WHERE CONTROL CARD IMAGES BUILT 40565021 LA RW6,SBEGIN(RW3) 40572021 TM SORTSW,SFIRST IS THIS THE FIRST KEY ENTRY... 40579021 BO SORT0A YES 40586021 MVI DX0(RW6),XX6B NO, DELIMIT LAST KEY ENTRY 40593021 LA RW3,DX1(RW3) 40600021 LA RW6,DX1(RW6) 40607021 SORT0A MVC DX0(LX4,RW6),GTEMP DDDD MAX DISP = 4092 40614021 NI SORTSW,X'FF'-SFIRST 42646 40621021 OI DX3(RW6),XXF0 40628021 MVI DX4(RW6),XX6B , 40635021 L RW5,LENGTH 40642021 CVD RW5,GTEMP 40649021 UNPK GTEMP(LX3),GTEMP+NX6(LX2) 40656021 MVC DX5(LX3,RW6),GTEMP LLL MAX LENGTH = 255 40663021 OI DX7(RW6),XXF0 40670021 MVI DX8(RW6),XX6B , 40677021 CLI DIMINR,XX07 BY MINOR... 40684021 BC LO,SORC0B CHAR 40691021 CLI DIMINR,XX09 40698021 BC EQ,SORC0B CHAR 40705021 CLI DIMINR,XX0A 40712021 BC EQ,SORC0D FL PT 40719021 CLI DIMINR,XX0B 40726021 BC EQ,SORC0E BINARY 40733021 CLI DIMINR,XX0C 40740021 BC EQ,SORC0C PD 40747021 MVC DX9(LX2,RW6),SORBZD ZD 40754021 BC UNCOND,SORC0F BRANCH TO COMMON CODING 40761021 SORC0E MVC DX9(LX2,RW6),SORBBI 40768021 BC UNCOND,SORC0F BRANCH TO COMMON CODING 40775021 SORC0B MVC DX9(LX2,RW6),SORBCH 40782021 BC UNCOND,SORC0F BRANCH TO COMMON CODING 40789021 SORC0D MVC DX9(LX2,RW6),SORBFL 40796021 BC UNCOND,SORC0F BRANCH TO COMMON CODING 40803021 SORC0C MVC DX9(LX2,RW6),SORBPD 40810021 SORC0F MVI DX11(RW6),XX6B 40817021 MVI DX12(RW6),XCA ASSUME ASCENDING 40824021 TM SORTSW,SASCEN IS THIS TRUE... 40831021 BO SORC0G YES 40838021 MVI DX12(RW6),XCD CHANGE TO 'D' 40845021 SORC0G LA RW3,DX13(RW3) 40852021 STH RW3,SDISPL NEW DISPL INTO WORK BUFFER 40859021 B SORT03 GET NEXT OPERAND 40866021 SORTEX BAL RETRG,GFREE GENERATE FREE MACRO 40873021 LA RW2,USCON3 INIT MACRO-LOAD PERM REGS 40880021 LA RW3,DX2 40887021 BAL RETRG,PUTA WRITE PROC ATXT ELEMENT 40894021 BAL RETRG,GDES14 DESTROY 14 40901021 BAL RETRG,GDES15 DESTROY 15 40908021 XC SORLG1(SLENGT),SORLG1 ZERO OUT LENGTHS, SORTSW 40915021 OI SORTSW1,CELLALOC RESET ALLOCATION INDICATOR 42646 40922021 B PH5CTL RETURN FOR NEXT ELEMENT 4774 40929021 BCDMVC MVC SRTNME(LX0),DOP2+NX2 40936021 TITLE 'IKFCBL51: ENTRY VERB ANALYZER E N T R Y' 40943021 *=1 ENTER VERB (ENTRY OPTION) 40950021 ******************************************************************* 40957021 * E N T R Y 40964021 * INPUT IS SAME FORM AS FOR CALL. SEE CALL 40971021 * ANALYZER HEADINGS FOR DETAILS. 40978021 ******************************************************************* 40985021 USING *,GVERB 40992021 ENTRY EQU * 40999021 BAL RETRG,GFRRES GENERATE FREE MACRO 41006021 CLC DOP1(LX2),CBFRST CONTINUATION STRING... 41013021 BC NOTEQ,NXTSTR YES, GO BACK TO GETDOP ROUTINE 41020021 TM ENTSW,FRSTON FIRST TIME THROUGH... 41027021 BO ENTRYC NO, BYPASS CODE 41034021 OI ENTSW,FRSTON TURN ON FIRST TIME SWITCH 41041021 L RW3,SPACES CLEAR 1155 41048021 ST RW3,ENTRSPAC COMPARISON 1155 41055021 ST RW3,ENTRSPAC+NX4 AREA 1155 41062021 IC RW3,DOP2+NX1 GET LENGTH OF VIRTUAL 41069021 BCTR RW3,RW0 DECREASE COUNT FOR COMPARE 41076021 EX RW3,ENTRYMVC MOVE TO BLANK AREA 1155 41083021 CLC ENTRSPAC(LX8),PROGID COMPARE EPNAME W/ PROGID 1155 41090021 BNE ENTRYD THEY ARE NOT THE SAME 41097021 OI ENTSW,ENTRYGN INDIC NO GN TO BE GEN'ED 41104021 B ENTRYC BYPASS GN BRANCH CODING 41111021 ENTRYD DS 0H 41118021 BAL RETRG,GNSTEP BUMP GNCTR 41125021 MVC IOTXTII1+NX4(LX2),GNCTR INSERT GN NO 41132021 MVC GLGNCN+NX3(LX2),GNCTR INTO ATXT CODE 41139021 BAL RETRG,GATXTV GENERATE 41146021 DC AL2(IOTXTII1-ATXTBV) * L 15,GN-BYPASS 41153021 DC AL2(IOTXTII2-IOTXTII1) * BCR 15,15 41160021 ENTRYC DS 0H 41167021 MVI IMM,XX04 41174021 BAL RETRG,CNOP * CNOP 0,4 41181021 MVI GMCTYP,MENTRY 41188021 L RW3,SPACES 41195021 ST RW3,GVIRT1 41202021 ST RW3,GVIRT1+NX4 41209021 SR RW3,RW3 41216021 IC RW3,DOP2+NX1 41223021 BCTR RW3,RW0 DECREMENT BY ONE 41230021 EX RW3,ENTRY1 MOVE BCD REF INTO BCDREF 41237021 OI ENTSW,MSWON INDIC UNIQUE ENTRY PT 7898 41244021 CLC GVIRT1(LX8),PROGID 41251021 BNE ENTRYB NO, UNIQUE ENTRY PT 7898 41258021 NI ENTSW,MSWOFF YES, INDIC NON-UNIQUE 7898 41265021 OI STRTSW,HIORDON INDIC AT PROC HEADER 7898 41272021 ENTRYB EQU * 41279021 BAL RETRG,MACRO ENTRY 'ENTRY-POINT' 41286021 TM ENTSW,XX01 41293021 BZ ENTRYA DO NOT GEN CALL TO INIT1 41300021 NI ENTSW,MSWOFF 41307021 BAL RETRG,GATXTC GENERATE A-TEXT 41314021 DC AL2(ATXT46-ATXTBC) * STM 14,12,12(13) 41321021 DC AL2(ZTXT46-ATXT46) * LR 5,13 41328021 * * BALR 15,0 41335021 * * BAL 14,8(15) 41342021 * * DC A(INIT1) 41349021 * * L 15,0(14) 41356021 * * LM 9,15,8(15) .OR. 16(15) 41363021 * * DESTROY 15 41370021 * * BALR 14,15 41377021 ENTRYA EQU * 41384021 CLC DOP3(LX2),HTERM ANY USING... 41391021 BC EQ,ENTRY7 NO 41398021 BAL RETRG,GATXTC GENERATE A TEXT 41405021 DC AL2(ATXT47-ATXTBC) * L 4,4(13) 41412021 DC AL2(ZTXT47-ATXT47) * L 4,24(4) 41419021 SR RW3,RW3 OPERAND COUNTER 41426021 LA RW4,LDOP+LDOP DISPLACEMENT OF FIRST OPERAND 41433021 ENTRY3 LA RW2,DOP1(RW4) 41440021 CLI DX0(RW2),MDN 41447021 BC NOTEQ,ENTRY7 NOT EQUAL, GO TO ENTRY7 41454021 MVI XREG1,XX01 41461021 STH RW3,BDISP1 SET IN PARAM DISPLACEMENT 41468021 OI BDISP1,XX40 41475021 BAL RETRG,LOAD * L 1,0(4) .OR. 4(4), ETC. 41482021 BAL RETRG,CALCLG SET UP LENGTH FOR LATER CHECK 41489021 NOP DX0(RW0) NULL OPERATION 41496021 TM LENGTH,XX80 VARIABLE LENGTH 49549 41503021 BO ENTRY2 YES 49549 41510021 L RW5,LENGTH NO, DETERMINE NUMBER 49549 41517021 BCTR RW5,RW0 OF BLL'S 49549 41524021 SRL RW5,DX12 TO BE INITIALIZED 49549 41531021 B ENTRY4 CONTINUE 49549 41538021 ENTRY2 DS 0H 49549 41545021 SR RW5,RW5 DETERMINE NUMBER 49549 41552021 IC RW5,DX8(RW2) OF BLL'S 49549 41559021 SRL RW5,DX4 TO BE INITIALIZED 49549 41566021 ENTRY4 DS 0H 49549 41573021 LA RW5,DX1(RW5) MUST BUMP NUMBER OF 49549 41580021 B ENTRY5 BLL'S BY ONE 49549 41587021 ENTRY6 DS 0H 49549 41594021 IC RETRG,DX6(RW2) INCREMENT BLL NUMBER 49549 41601021 LA RETRG,DX1(RETRG) 49549 41608021 STC RETRG,DX6(RW2) 49549 41615021 MVI XCON1+NX14,XX10 49549 41622021 MVI XCON1+NX16,XX02 49549 41629021 MVI XREG1,XX01 49549 41636021 BAL RETRG,ADD GEN AH 1,=H'4096' 49549 41643021 ENTRY5 DS 0H 49549 41650021 MVI XREG1,XX01 41657021 BAL RETRG,DBLREF SET UP BLREF1 41664021 BAL RETRG,STORE ST 1,BL=OPERAND 41671021 BAL RETRG,DBLREF SET UP BLREF1 41678021 MVI GMCTYP,MBLCHG 41685021 BAL RETRG,MACRO BLCHNG=BL 41692021 BCT RW5,ENTRY6 LOOP 49549 41699021 TM DX7(RW2),XX02 IS Q-BIT ON 41706021 BZ ENTRY8 NO 49549 41713021 BAL RETRG,LSPRO GENERATE Q-RTNS 41720021 ENTRY8 DS 0H 49549 41727021 *DEL 4954 41734021 *DEL 4954 41741021 *DEL 4954 41748021 *DEL 4954 41755021 *DEL 4954 41762021 *DEL 4954 41769021 *DEL 4954 41776021 *DEL 4954 41783021 *DEL 4954 41790021 *DEL 4954 41797021 *DEL 4954 41804021 *DEL 4954 41811021 *DEL 4954 41818021 BAL RETRG,GETDOP GET NEXT DOP 41825021 LA RW3,DX4(RW3) UP PARAM DISPLACEMENT BY 4 41832021 B ENTRY3 BRANCH TO ENTRY3 41839021 ENTRY7 EQU * 41846021 BAL RETRG,GFREE GENERATE FREE MACRO 41853021 TM ENTSW,ENTRYGN IS GN TO BE GEN'ED 41860021 BO ENTRYE NO 41867021 BAL RETRG,GNOPT3 * GN(BYPASS ENTRY) EQU * 41874021 ENTRYE DS 0H 41881021 NI ENTSW,FRSTOFF TURN OFF FIRST TIME SWITCH 41888021 * AND GN SWITCH (IF ON) 41895021 B PH5CTL *** LEAVE ENTRY *** 41902021 ENTRY1 MVC GVIRT1(LX0),DOP2+NX2 *** EXECUTED INSTRUCTION *** 41909021 ENTRYMVC MVC ENTRSPAC(LX0),DOP2+NX2 EXECUTED MOVE 1155 41916021 TITLE 'IKFCBL51: OPEN/CLOSE VERB ANALYZER O P E N/C L O S E' 41923021 IKF50J CSECT 41930021 *=1 CLOSE VERB COMMON CODING WITH OPEN 41937021 ******************************************************************* 41944021 * CLOSE INPUT IS SIMILAR TO THAT FOR OPEN. 41951021 * 41958021 ******************************************************************* 41965021 USING *,GVERB 41972021 CLOSE EQU * 41979021 OI CLOSSW,MSWON FLAG AS CLOSE 41986021 CLC DOP1(LX2),CBFRST FIRST TIME THRU... 41993021 BC NOTEQ,CLOS14 NO 42000021 TM OPENSW,MSWON 42007021 BC ONES,CLOS14 NO 42014021 BAL RETRG,GDES14 DESTROY 14 42021021 BAL RETRG,GDES15 DESTORY 15 42028021 CLOS14 EQU * 42035021 L GVERB,ADCN21 SET UP TO ENTER OPEN ANALYZER 42042021 USING OPEN,GVERB 42049021 BC UNCOND,CLOSIN BRANCH TO OPEN RTN 42056021 TITLE 'OPEN VERB PROCESSOR O P E N' 42063021 *=1 OPEN VERB 42070021 OPENGNDS DSECT 42077021 USING *,RW3 42084021 STDERRGN DS H 42091021 BOFGN DS H 42098021 EOFGN DS H 42105021 EOVGN DS H 42112021 BOVGN DS H 42119021 IKF50J CSECT 42126021 USING *,GVERB 42133021 OPEN EQU * 42140021 ******************************************************************* 42147021 * 42154021 * INPUT IS TWO IDENTICAL SETS OF STO5 STRINGS, E.G... 42161021 * 42168021 * OPEN05 FN1 FN2 FN3FN4 FN5 OPEN03 FN6 FN7 TERM 42175021 * OPEN05 FN1 FN2 FN3FN4 FN5 OPEN03 FN6 FN7 TERM 42182021 * 42189021 * THE FIRST GENERATES CODING PRIOR TO SVC 19, THE LATTER 42196021 * THE CODING FOLLOWING SVC 19. 42203021 * 42210021 ******************************************************************* 42217021 NI CLOSSW,MSWOFF FLAG AS OPEN 42224021 CLOSIN EQU * CLOSE JOINS HERE 42231021 TM OPENSW,MSWON SECOND SET OF STRINGS... 42238021 BC ONES,OPEN13 YES 42245021 CLC DOP1(LX2),CBFRST CONTINUATION STRING... 42252021 BC NOTEQ,NXTSTR YES, GO BACK TO GETDOP ROUTINE 42259021 MVI IOCODE,XXFF 42266021 LA RW4,DX1 42273021 STH RW4,IOPARM 42280021 LA RW4,LDOP BYPASS 'FIRST' 42287021 BC UNCOND,OPEN16 SKIP NEXT INST. 42294021 OPEN01 BAL RETRG,GETDOP GET NEXT DOP 42301021 OPEN16 LA RW2,DOP1(RW4) 42308021 CLC DX0(LX2,RW2),HTERM TERMINATOR... 42315021 BC EQ,OPEN02 YES, SET TERMINATOR BIT 42322021 BAL RETRG,SETRECFM SET RECORDING KODE 50761 42329021 CLI IOCODE,XXFF FIRST TIME THRU... 42336021 BC EQ,OPEN04 YES, DO NOT ISSUE MVI 42343021 OPEN03 TM CLOSSW,MCLCLR CLOSE BUT NOT CLOSE REEL... 42350021 BC MIXED,OPEN04 NO, CLOSE REEL 42357021 NI CLOSSW,SSWOFF 42364021 MVC IMM(LX1),IOCODE 42371021 MVI XCNTR1,XX40 42378021 MVC XCNTR1+NX1(LX2),IOPARM 42385021 BAL RETRG,MVI * MVI PARAM=1,X'CODE' 42392021 LH RETRG,IOPARM 42399021 LA RETRG,DX1(RETRG) 42406021 STH RETRG,IOPARM UP PARAMETER BY ONE 42413021 OPEN04 CLC DX0(LX2,RW2),HTERM 42420021 BC EQ,OPEN07 IF END, GO TO OPEN07 42427021 TM CLOSSW,MSWON CLOSE... 42434021 BC ONES,CLOS04 YES 42441021 TM DX6(RW2),XX20 BISAM OPEN 42448021 BC ONES,OPEN05 YES 42455021 CLOS04 EQU * 42462021 TM DX6(RW2),MNOQQI QSAM OR QISAM FILE... 42469021 BC ZERO,OPEN06 YES 42476021 OPEN08 EQU * 42483021 TM DX2(RW2),MCLREL CLOSE REEL 42490021 BC NOTONE,OPEN08A NO 42497021 MVC IOTXTGG2(LX1),DX5(RW2) 42504021 MVC IOTXTGG1(LX1),DX2(RW2) 42511021 NI IOTXTGG1,XX7F 42518021 BAL RETRG,GATXTV * LA 1,CODE 42525021 DC AL2(IOTXTGG-ATXTBV) * SLL 1,24 42532021 DC AL2(IOTXTHH-IOTXTGG) * O 1,DCBADR 42539021 B EOVCLOSE CLOSE REEL RTN 42546021 OPEN08A EQU * 42553021 MVI XREG1,XX01 42560021 MVC XCNTR1+NX2(LX1),DX5(RW2) 42567021 BAL RETRG,LOAD * L 1,DCBADR=CURRENT FN 42574021 TM CLOSSW,MSWON CLOSE? 42581021 BNO OPEN08C NO 42588021 TM DX6(RW2),MBISAM+NX8 BISAM AND REORGANIZATION? 42595021 BNO EOVCLOSE NO 42602021 MVC REORGDN+NX4(LX3),DX11(RW2) INIT REORG DN WITH IDK 42609021 SR RW5,RW5 42616021 LA RW1,REORGDN POINT TO DUMMY DATANAME 42623021 BAL RETRG,REORGEN INIT ATXT GENATR FIELDS 42630021 MVI BDISP2+NX1,XXE0 42637021 MVI XL1+NX1,XX02 42644021 BAL RETRG,MVC * MVC DN(2),224(1) 42651021 BAL RETRG,REORGEN TO PUT VALUES IN A TEXT 42658021 MVI BDISP2+NX1,XXCE 42665021 BAL RETRG,MVC * MVC DN+2(2),206(1) 42672021 BAL RETRG,REORGEN TO PUT VALUES IN A TEXT 42679021 MVI BDISP2+NX1,XX98 42686021 BAL RETRG,MVC * MVC DN+4(4),152(1) 42693021 B EOVCLOSE CLOSE REEL RTN 42700021 OPEN08C DS 0H 42707021 BC ONES,EOVCLOSE YES 42714021 TM DX6(RW2),XXF0 QSAM? 42721021 BNZ OPEN08E NO 42728021 TM DX3(RW2),XX60 MODE S? 42735021 BNO OPEN08E NO 42742021 TM DX10(RW2),XX0C SA OR SRA? 42749021 BZ OPEN08E NO 42756021 MVI ZB1CHNG,XX00 YES 42763021 TM DX10(RW2),XX08 SRA? 42770021 BZ OPEN08D NO 42777021 MVI ZB1CHNG,XX40 YES 42784021 OPEN08D BAL RETRG,GATXTV PUT A TEXT 42791021 DC AL2(IOTXTZB1-ATXTBV) 42798021 DC AL2(IOTXTZB2-IOTXTZB1) 42805021 OPEN08E DS 0H 42812021 LA RW1,MACRTABL VALUES OF DCBMACR FIELD BY 42819021 * ACCESS METHOD AND OPEN OPTION 42826021 TM DX2(RW2),XX0E OPEN OPTION 42833021 BZ OPEN50 INPUT 42840021 LA RW1,DX10(RW1) 42847021 BO OPEN50 OUTPUT 42854021 LA RW1,DX10(RW1) I/O 42861021 OPEN50 DS 0H 42868021 LA RW6,DX4 42875021 IC RW5,DX6(RW2) ACCESS METHOD 42882021 SLL RW5,DX23 42889021 OPEN51 DS 0H 42896021 SLL RW5,DX1 42903021 LTR RW5,RW5 IS BIT 31 A ONE? 42910021 BL OPEN52 YES, REGISTER RW1 NOW HAS 42917021 * DISPLACEMENT DEPENDING ON ACCESS METHOD 42924021 BCT RW6,OPEN51 NOT 1, SUBTRACT 1 AND TRY AGAIN 42931021 OPEN52 DS 0H 42938021 SLL RW6,DX1 MULTIPLY BY 2 42945021 AR RW1,RW6 OPN OPTN + ACCESS METH DISPLACEM 42952021 MVC XCON2+NX14(LX2),DX0(RW1) MOVE VALUE FROM TABLE 42959021 MVI XCON2+NX16,XX02 LENGTH IS 2 42966021 MVI XL1+NX1,XX02 DITTO 42973021 MVI BDISP1,XX10 REGISTER1 42980021 MVI BDISP1+NX1,XX32 DCB+50 42987021 TM DX6(RW2),XX84 BDAM DIRECT 42994021 BNO OPEN55 NO, WE HAVE ASSUMED RELATIVE 43001021 TM DX2(RW2),XX0F OUTPUT? 43008021 BO OPEN52A YES 43015021 XI XCON2+NX14,XX18 CHANGE TO DIRECT 43022021 OPEN52A DS 0H 43029021 TM DX2(RW2),XX0E INPUT? 43036021 BZ OPEN52B YES 43043021 XI XCON2+NX15,XX18 CHANGE TO DIRECT 43050021 OPEN52B DS 0H 43057021 OPEN55 DS 0H 43064021 TM DX3(RW2),XX60 SPANNED? 43071021 BNO OPEN56 NO. 43078021 TM DX6(RW2),XX84 BDAM DIRECT? 43085021 BNO OPEN55B NO. 43092021 TM DX10(RW2),XX04 SA? 43099021 BNO OPEN56 NO. 43106021 B OPEN55C BRANCH TO OPEN55C 43113021 OPEN55B TM DX6(RW2),XX44 BSAM DIRECT? 43120021 BNO OPEN56 NO. 43127021 TM DX2(RW2),XX0F OUTPUT? 43134021 BNO OPEN56 NO. 43141021 OPEN55C OI XCON2+NX15,XX01 SEG-WK SUPPLIED BY COBOL. 43148021 OPEN56 DS 0H 43155021 TM DX6(RW2),XX18 QISAM WITH START 43162021 BNO OPEN53 NO 43169021 OI XCON2+NX15,XX82 YES, SET ONE SETL BITS 43176021 B OPEN54 CONTINUE 43183021 OPEN53 DS 0H 43190021 TM DX6(RW2),XX21 BISAM WITH FREE 43197021 BNO OPEN54 NO 43204021 OI XCON2+NX14,XX04 SET BITS FOR DYNAMIC BUFFERING 43211021 OPEN54 DS 0H 43218021 BAL RETRG,MVC * MVC 50(2,1),LITERAL 43225021 TM DX6(RW2),XX20 BISAM? 43232021 BZ OPEN58 NO 43239021 MVI XIMM,XX0E 43246021 TM DX2(RW2),XX0E OPEN I-O? 43253021 BM OPEN57 YES 43260021 MVI XIMM,XX00 NO. 43267021 OPEN57 DS 0H 43274021 MVI BDISP1,XX10 43281021 MVI BDISP1+NX1,XX35 43288021 BAL RETRG,MVI MVI 53(1),'00' OR '0E' 43295021 * 43302021 OPEN58 DS 0H 43309021 BAL RETRG,OPENTEST PERFORM PENTEST 43316021 TM DX6(RW2),XX44 DIRECT BSAM? 43323021 BNO OPEN58CC NO. 43330021 MVC IOTXTA+NX6(LX1),DX7(RW2) DECB NO. 43337021 BAL RETRG,GATXTV L R3,DECBADR 43344021 DC AL2(IOTXTA-ATXTBV) 43351021 DC AL2(IOTXTB-IOTXTA) 43358021 TM DX3(RW2),XX60 SPANNED? 43365021 BNO OPEN58CC NO 43372021 TM DX2(RW2),XX0E D-BSAM. FILE OPENED OUTPUT? 43379021 BNO OPEN58BB NO, INPUT. 43386021 BAL RETRG,GATXTC YES. 43393021 DC AL2(ATXT116A-ATXTBC) MVC DCB+76(4),DCB+92 43400021 DC AL2(ZTXT116A-ATXT116A) MVC DECB+12(4),DCB 43407021 B OPEN58CC BRANCH TO OPEN58CC 43414021 OPEN58BB DS 0H 43421021 BAL RETRG,GATXTC L R4,DCB+92 A(SEG WK) 43428021 DC AL2(ATXT117A-ATXTBC) LA R4,18(R4) 43435021 DC AL2(ZTXT117A-ATXT117A) ST R4,12(R3) 43442021 OPEN58CC DS 0H 43449021 TM DX6(RW2),XXF0 QSAM 43456021 BNZ OPEN09E NO 43463021 TM DX6(RW2),XX09 ADVANCING? 43470021 BZ OPEN58BC NO 43477021 OI DX10(RW2),XX08 TURN ON SRA BIT 43484021 OPEN58BC DS 0H 43491021 TM DX2(RW2),XX0E INPUT/OUTPUT/I-O 43498021 BZ OPEN09E INPUT 43505021 MVI BDISP1,XX10 43512021 MVI BDISP1+NX1,XX60 43519021 BO OPEN09A OUTPUT 43526021 TM DX6(RW2),XX02 APPLY WRITE-ONLY? 43533021 BO OPEN58B YES 43540021 TM DX3(RW2),XX60 S? 43547021 BO OPEN58A YES. 43554021 TM DX10(RW2),XX08 SAME RECORD AREA? 43561021 BZ OPEN58A NO 43568021 OPEN58B MVC XCON2+NX10(LX6),PUTIOSRA YES 43575021 MVI XCON2+NX16,XX06 * MVC 96(6,1),=X'181045E0F004' 43582021 MVI XL1+NX1,XX06 43589021 B OPEN09B GO TO OPEN09B TO PUT A TEXT 43596021 OPEN58A MVC XCON2+NX12(LX4),PUTIOCN I-O, NO SRA 43603021 MVI XCON2+NX16,XX04 * MVC 96(4,1),=X'45E0F004' 43610021 MVI XL1+NX1,XX04 43617021 B OPEN09B GO TO OPEN09B TO PUT A TEXT 43624021 OPENTEST DS 0H 43631021 TM DX3(RW2),XX60 SPANNED? 43638021 BNO OPENRETN NO 43645021 TM DX10(RW2),XX04 SAME AREA? 43652021 BNO OPENRETN NO 43659021 MVI IOTXTOP2,XX64 ASSUME BDAM FILE 43666021 TM DX6(RW2),MBDAM BDAM FILE? 43673021 BO GENRCODE YES 43680021 TM DX6(RW2),MBSAM BSAM FILE? 43687021 BNO OPENRETN NO 43694021 MVI IOTXTOP2,XX5C CHANGE DISP FROM 100 TO 92 43701021 * 43708021 * THE FOLLOWING CODING GENERATES INSTRUCTIONS TO INITIALIZE THE 43715021 * BUFFER CONTROL BLOCK FOR BDAM OR BSAM SPANNED RECORDS WITH 43722021 * THE SAME AREA CLAUSE 43729021 * FOR BSAM FILES THE DISPLACEMENT IS 92 OFF DCB ADDRESS 43736021 * FOR BDAM FILES THE DISPLACEMENT IS 100 OFF DCB ADDRESS 43743021 * 43750021 GENRCODE DS 0H 43757021 ST RETRG,HOLDREG STORE REGISTER FOR RETURN 43764021 BAL RETRG,GATXTV PUT A TEXT 43771021 DC AL2(IOTXTOP1-ATXTBV) 43778021 DC AL2(IOTXTOP3-IOTXTOP1) 43785021 L RETRG,HOLDREG RESTORE RETURN ADDRESS 43792021 OPENRETN DS 0H 43799021 BR RETRG GO BACK 43806021 HOLDREG DC F'0' 43813021 OPEN09A DS 0H 43820021 TM DX3(RW2),XX60 S? 43827021 BO OPEN09C YES,BALR 14,15 IN DCB+96 43834021 TM DX6(RW2),XX02 APPLY WRITE-ONLY? 43841021 BZ OPEN58D NO 43848021 B OPEN58C YES 43855021 OPEN58D DS 0H 43862021 TM DX10(RW2),XX08 SAME RECORD AREA? 43869021 BZ OPEN09C NO 43876021 OPEN58C MVC XCON2+NX12(LX4),PUTOUTCN YES 43883021 MVI XCON2+NX16,XX04 * MVC 96(4,1),=X'05EF0700' 43890021 MVI XL1+NX1,XX04 43897021 B OPEN09B GO TO OPEN09B 43904021 OPEN09C DS 0H 43911021 MVC XCON2+NX14(LX2),PUTOUTCN OUTPUT 43918021 MVI XCON2+NX16,XX02 * MVC 96(2,1),=X'05EF' 43925021 MVI XL1+NX1,XX02 43932021 OPEN09B DS 0H 43939021 BAL RETRG,MVC GENERATE MOVE 43946021 OPEN09E DS 0H 43953021 TM DX3(RW2),XX10 USE AFTER STD ERROR? 43960021 BO OPEN09D YES 43967021 TM DX10(RW2),XX02 USER LABELS? 43974021 BNO CLOS01 NO, DONT LOAD EXITLIST ADDRESS 43981021 OPEN09D DS 0H 43988021 BAL RETRG,GATXTV * L 4,36(1) 43995021 DC AL2(IOTXTS-ATXTBV) X 44002021 DC AL2(IOTXTS1-IOTXTS) X 44009021 BAL RETRG,GETELGNS RW3 NOW POINTS TO FIRST GN 44016021 TM DX3(RW2),XX10 USE AFTER STD ERROR? 44023021 BNO USERLABL NO, TEST FOR USER LABELS 44030021 MVI BDISP1,XX40 44037021 CLC STDERRGN,GZERO STD ERROR GN 44044021 BNE STDERR1 YES 44051021 MVI BDISP1+NX1,XX1F 44058021 MVI IMM,XX01 * OI 31(4),1 44065021 BAL RETRG,OI PUT A TEXT 44072021 B USERLABL TEST FOR USERLABELS 44079021 STDERR1 DS 0H 44086021 MVI BDISP1+NX1,XX1D 44093021 MVC XPN2+NX2(LX2),STDERRGN * MVC 29(3,4),PN+1 44100021 BAL RETRG,MOVEGN PUT A TEXT MVC INST 44107021 USERLABL DS 0H 44114021 TM DX10(RW2),XX02 USERLABELS? 44121021 BNO CLOS01 NO 44128021 * ASSUME INPUT 44135021 TM DX2(RW2),XX0E TEST 44142021 BC ZERO,OPTN3 INPUT 44149021 BC NOTONE,OPTN2 I/O 44156021 MVI IMM,XX04 OUTPUT 44163021 BC UNCOND,OPTN3 SKIP NEXT INST 44170021 OPTN2 MVI IMM,XX08 I/O CODE 44177021 OPTN3 MVI BDISP1+NX1,XX25 44184021 MVI BDISP1,XX40 X 44191021 BAL RETRG,MVI * MVI 37(4),CODE 44198021 CLC BOFGN,GZERO BOF GN 44205021 BC NOTEQ,BOF1 YES 44212021 BAL RETRG,INACTXL * NI 0(4),X'80' 44219021 BC UNCOND,EOV3 SKIP TO EOV TESTING 44226021 BOF1 DS 0H 44233021 MVC XPN2+NX2(LX2),BOFGN XXXX 44240021 MVI BDISP1+NX1,XX01 X 44247021 BAL RETRG,MOVEGN * MVC 1(3,4),BOFGN+1 44254021 * XXXX 44261021 MVI IMM,XX01 X 44268021 TM DX2(RW2),XX0F OUTPUT 44275021 BC NOTONE,BOF2 NO 44282021 MVI IMM,XX02 44289021 BOF2 MVI BDISP1,XX40 * MVI 0(4),CODE 44296021 BAL RETRG,MVI XXXX 44303021 EOV3 EQU * 44310021 BAL RETRG,GETCODE DETERMINES EOV AND EOF CODE 44317021 CLC EOVGN,GZERO EOV GN 44324021 BC NOTEQ,EOV1 YES 44331021 MVI BDISP1+NX1,XX04 XXXX 44338021 BAL RETRG,INACTXL * NI 4(4),X'80' 44345021 * XXXX 44352021 BC UNCOND,EOFLABL XXXX 44359021 EOV1 MVI BDISP1+NX1,XX05 XXXX 44366021 MVC XPN2+NX2(LX2),EOVGN * MVC 5(3,4),EOVPN+1 44373021 * 44380021 BAL RETRG,MOVEGN XXXX 44387021 MVI BDISP1,XX40 XXXX 44394021 MVI BDISP1+NX1,XX04 X 44401021 MVC IMM,CODE EOV CODE 44408021 BAL RETRG,MVI * MVI 4(4),EOV CODE 44415021 EOFLABL CLC EOFGN,GZERO EOF GN 44422021 BC NOTEQ,EOF1 YES 44429021 MVI BDISP1,XX40 XXXX 44436021 MVI BDISP1+NX1,XX0B 44443021 MVI IMM,XX01 44450021 BAL RETRG,OI * OI 11(4),1 44457021 * XXXX 44464021 NI CODE,XX80 NO EOF SPECIFIED 44471021 BC UNCOND,EOF2 INACTIVATE EOF CODE 44478021 EOF1 MVI BDISP1+NX1,XX09 XXXX 44485021 MVC XPN2+NX2(LX2),EOFGN * MVC 9(3,4),EOFPN+1 44492021 BAL RETRG,MOVEGN XXXX 44499021 MVC IMM,CODE 43521 44506021 MVI BDISP1,XX40 43521 44513021 MVI BDISP1+NX1,XX08 43521 44520021 BAL RETRG,MVI * MVI 8(4),CODE 43521 44527021 B EOF3 AVOID INVALIDATION 43521 44534021 EOF2 DS 0H 43521 44541021 MVI BDISP1+NX1,XX08 43521 44548021 BAL RETRG,INACTXL * NI 8(4),X'80' 43521 44555021 EOF3 DS 0H 43521 44562021 MVI BDISP1+NX1,XX78 44569021 MVI BDISP1,XX10 44576021 MVC IMM,CODE EOF CODE 44583021 BAL RETRG,MVI * MVI 120(1),CODE-SAVES EOF IN DCB 44590021 B CLOS01 CONTINUE PROCESSING 43521 44597021 GETCODE EQU * 44604021 MVI CODE,XX04 ASSUME OUTPUT 44611021 TM DX2(RW2),XX0F IS IT OUTPUT? 44618021 BO GETBACK YES 44625021 MVI CODE,XX0C ASSUME SUL INPUT OR I-O 44632021 TM DX10(RW2),XX01 NON STANDARD LABELS? 44639021 BNO IFBDAM NOPE 44646021 MVI CODE,XX0D CHANGE TO NSL INPUT OR I-O 44653021 IFBDAM EQU * 44660021 TM DX6(RW2),MBDAM BDAM FILE ? 44667021 BNO GETBACK NOPE 44674021 MVI CODE,XX03 CHANGE TO OLD CODE FOR BDAM 44681021 GETBACK BR RETRG RETURN 44688021 EOVCLOSE TM DX2(RW2),MCLREL CLOSE REEL 44695021 BC ONES,EOV2CLOS YES 44702021 NI DX2(RW2),XXFE TURN OFF LOCK BIT FOR FIRST 44709021 TM DX10(RW2),XX02 USER LABELS? 44716021 BNO EOV2CLOS NO 44723021 BAL RETRG,GATXTV PUT A TEXT 44730021 DC AL2(IOTXTS-ATXTBV) ACTIVATE EOF ENTRY IN EXITLI 44737021 DC AL2(IOTXTT-IOTXTS) 44744021 EOV2CLOS DS 0H 44751021 NI CLOSSW,SSWOFF 44758021 TM DX6(RW2),MBSAM BSAM... 44765021 BC ZERO,CLOS13 NO 44772021 TM DX2(RW2),MCLREL CLOSE REEL 44779021 BC NOTONE,CLOS13A NO 44786021 * BSAM CALLING SEQ 44793021 BAL RETRG,IOBS08 GO TO BSAM CLOSE REEL ENTRY 44800021 B OPEN01 PROCESS NEST FILE 44807021 CLOS13A EQU * 44814021 BAL RETRG,IOBS02 YES, GEN 'BSAM' OTSR CALLING SE 44821021 CLOS13 EQU * 44828021 TM DX2(RW2),MCLREL CLOSE REEL 44835021 BO CLOS02 YES 44842021 OI CLOSSW,SSWON 44849021 B OPEN08B BRANCH OPEN08B 44856021 CLOS01 EQU * 44863021 TM DX6(RW2),MBISAM BISAM? 44870021 BNO CLOS01A NO 44877021 MVI BDISP1,XX10 44884021 MVI BDISP1+NX1,XXFC 44891021 MVI IMM,XX80 44898021 TM DX2(RW2),XX0E INPUT? 44905021 BZ CLOS01B YES 44912021 MVI IMM,XX20 44919021 CLOS01B DS 0H 44926021 BAL RETRG,MVI * MVI 252(1),CODE 44933021 CLOS01A DS 0H 44940021 TM DX6(RW2),MBDAM BDAM ACCESS METHOD 44947021 BC NOTONE,OPEN08B NO 44954021 TM DX2(RW2),XX0F OUTPUT 44961021 BC NOTONE,OPEN08B NO 44968021 MVC XCON1+NX14(LX2),DX8(RW2) 44975021 MVI XCON1+NX16,XX02 44982021 MVI XREG1,XX03 44989021 BAL RETRG,LOAD * LH 3,MAX-RCD-LNGTH+KEYLN 44996021 BAL RETRG,IOBS07 GEN CALLING SEQ TO BSAMRTN 45003021 MVI DX2(RW2),XX14 CHANGE TO I/O 45010021 OPEN08B EQU * 45017021 MVI XCNTR1,XX40 SA3 CELL 45024021 MVC XCNTR1+NX1(LX2),IOPARM 45031021 MVI XREG1,XX01 45038021 BAL RETRG,STORE * ST 1,PARAM=K 45045021 TM CLOSSW,MSWON CLOSE... 50761 45052021 BZ OPEN08BB NO 50761 45059021 TM DX6(RW2),MBDAM BDAM... 43124 45066021 BO OPEN08BB YES, NO NEED TO SET LRECL 43124 45073021 TM RECMODE,FTYPE F-MODE... 50761 45080021 BO OPEN08BB YES 50761 45087021 MVI BDISP1,XX10 INDICATE REG1 45094021 MVI BDISP1+NX1,XX52 OFFSET 82 IN DCB 45101021 TM RECMODE,UTYPE U-MODE.... 50761 45108021 BZ OPEN09 NO 50761 45115021 MVC XCON2+NX14(LX2),DX8(RW2) INSERT MAX LRECL 5962 45122021 B OPEN12 BYPASS V-MODE CODE 5962 45129021 OPEN09 DS 0H 5962 45136021 MVC LRECLTMP(LX2),DX8(RW2) GET MAXIMUM RECORD LENGTH 45143021 LH RW5,LRECLTMP 5962 45150021 LA RW5,DX4(RW0,RW5) BUMP MAX LRECL BY 4 FOR RDW 5962 45157021 STH RW5,LRECLTMP 5962 45164021 MVC XCON2+NX14(LX2),LRECLTMP STORE MAX RECORD LENGTH 45171021 OPEN12 DS 0H 5962 45178021 MVI XCON2+NX16,XX02 LENGTH OF MVC = 2 45185021 MVI XL1+NX1,XX02 45192021 BAL RETRG,MVC * MVC 52(2,1),MAXRECDLNGTH 45199021 OPEN08BB MVC IOCODE,DX2(RW2) 45206021 B OPEN01 PROCESS NEXT FILE 45213021 OPEN02 EQU * 45220021 OI IOCODE,XX80 45227021 BC UNCOND,OPEN03 BRANCH TO OPEN03 45234021 SPACE 2 45241021 * 45248021 * BISAM OPEN 45255021 * 45262021 * 45269021 SPACE 2 45276021 OPEN05 DS 0H 45283021 TM DX6(RW2),XX04 IS THERE 'TRK-AREA IS INT'... 45290021 BNO OPEN08 NO 45297021 MVC A03CH1(LX1),DX5(RW2) INSERT DCB NO. 45304021 BAL RETRG,GNSTEP BUMP GNCTR 45311021 MVC GLGNCN+NX3(LX2),GNCTR SAVE FOR GN DEF 45318021 BAL RETRG,GATXTV * GENERATE CONDITIONAL GET- 45325021 DC AL2(ATXT03-ATXTBV) * MAIN FOR TRACK-AREA IS INT 45332021 DC AL2(ATXT03A-ATXT03) * SPACE REQUESTED 45339021 MVI XREG1,XX0E 45346021 MVC XGN1,GNCTR 45353021 BAL RETRG,LOAD * L 14,GN(NO STORE) 45360021 BAL RETRG,GATXTV GENERATE 45367021 DC AL2(ATXT03A-ATXTBV) REST OF GETMAIN 45374021 DC AL2(ZTXT03-ATXT03A) SEQUENCE 45381021 BAL RETRG,GNOPT3 * GN(NO SPACE) EQU * 45388021 CLC PARMAX(LX2),XC003 CHECK NUMBER OF PARAM CELLS 45395021 * ALREADY RESERVED 45402021 BH OPEN08 MORE THAN WE NEED HERE 45409021 MVC PARMAX(LX2),XC003 NO, SO RESERVE 3 45416021 B OPEN08 CONTINUE PROCESSING 45423021 SPACE 2 45430021 OPEN06 TM CLOSSW,MSWON CLOSE... 45437021 BC ONES,CLOS05 YES 45444021 TM DX10(RW2),XX0C NO. OPEN WITH SA OR SRA? 45451021 BC ZERO,OPEN08 NO 45458021 TM DX3(RW2),XX60 SPANNED? 45465021 BNO OPEN06B NO. 45472021 MVC XCON2+NX8(LX8),MODCON 45479021 MVI XCON2+NX16,XX0C 45486021 MVI XCNTR1,XX20 45493021 MVI XCNTR1+NX2,XX05 WORKING CELL NUMBER 5 45500021 MVI XL1+NX1,XX0C 45507021 BAL RETRG,MVC * MVC WORKCELL,LITERAL 45514021 MVC IOTXTZA2,DX5(RW2) DCB NUMBER 45521021 BAL RETRG,GATXTV PUT A TEXT 45528021 DC AL2(IOTXTZA1-ATXTBV) 45535021 DC AL2(IOTXTZA3-IOTXTZA1) 45542021 BAL RETRG,WRKLRG DESTROY 14, 15 45549021 B OPEN08 BRANCH TO OPEN08 45556021 OPEN06B EQU * 45563021 TM DX10(RW2),XX04 SA? 45570021 BZ OPEN08 NO. 45577021 MVI XREG1,XX03 QSAM, QISAM SAME AREA 'PRIOR' 45584021 MVC XCNTR1+NX2(LX1),DX5(RW2) CODING. 45591021 BAL RETRG,LOAD * L 3,DCBADR=FN 45598021 MVI XREG1,XX01 45605021 MVI BDISP1+NX1,XX14 45612021 MVI BDISP1,XX30 45619021 BAL RETRG,LOAD * L 1,20(3) 45626021 MVI XREG1,XX02 45633021 MVI BDISP1+NX1,XX6C 45640021 TM DX6(RW2),MQISAM QISAM... 45647021 BC ZERO,OPEN10 NO 45654021 MVI BDISP1+NX1,XXFC YES, QISAM USES 252, NOT 108 OFF DCB 45661021 OPEN10 MVI BDISP1,XX30 45668021 BAL RETRG,LHALF * LH 2,108(3) OR 252(3) 45675021 MVI XREG1,XX03 45682021 MVI A22CH1,XX6E QSAM USES 110 OFF DCB 45689021 TM DX6(RW2),MQISAM QISAM... 45696021 BC ZERO,OPEN11 YES 45703021 MVI A22CH1,XXFE NO, QISAM USES 254 RATHER THAN 45710021 OPEN11 BAL RETRG,GATXTV PUT A TEXT 45717021 DC AL2(ATXT22-ATXTBV) 45724021 DC AL2(ZTXT22-ATXT22) 45731021 BC UNCOND,OPEN08 GO ON TO NEXT OPERAND 45738021 OPEN07 LH RW5,IOPARM SET COMMON PARMAX CTR 45745021 CH RW5,XC001 ANY JPARAM'S SET UP ... 45752021 BC EQ,CLOS15 NO, SKIP SVC GENERATION 45759021 CH RW5,SA3CTR 45766021 BC NOTHI,OPEN15 SKIP NEXT INST 45773021 STH RW5,SA3CTR 45780021 OPEN15 MVI A25CH1,XX13 ASSUME OPEN 45787021 TM CLOSSW,MSWON CLOSE... 45794021 BC ZERO,CLOS09 NO 45801021 MVI A25CH1,XX14 CHANGE TO CLOSE 45808021 CLOS09 BAL RETRG,GATXTV PUT A TEXT INST 45815021 DC AL2(ATXT25-ATXTBV) * L 1,PARAM=1 45822021 DC AL2(ZTXT25-ATXT25) * SVC 19 ...OR... 20 45829021 BAL RETRG,WRKLRG DESTROY 14, 15 45836021 CLOS15 EQU * 45843021 OI OPENSW,MSWON 45850021 BC UNCOND,DON *** GO GET SECOND STRING SET *** 45857021 OPEN13 EQU * *** G O T I T *** 45864021 NI OPENSW,MSWOFF 45871021 LA RW4,LDOP 45878021 B OPEN18 SKIP NEXT INST 45885021 OPEN14 EQU * 45892021 OPN14X EQU * 45899021 BAL RETRG,GETDOP GET DOP 45906021 OPEN18 LA RW2,DOP1(RW4) 45913021 CLC DX0(LX2,RW2),HTERM 45920021 BC EQ,OPENEX IF END, GO TO OPENEX 45927021 TM CLOSSW,XX01 45934021 BC NOTONE,OPEN13B IF NOT, GLAGED CLOSE, GO TO. 45941021 TM DX2(RW2),MCLOSLCK CLOSE WITH LOCK 45948021 BC NOTONE,OPEN13A IF NO, GO TO OPEN13A 45955021 MVC XCNTR1+NX2(LX1),DX5(RW2) DCB NUMBER 45962021 MVI XREG1,XX02 45969021 BAL RETRG,LOAD * L 1,DCBADR 45976021 MVI BDISP1,XX20 45983021 MVI BDISP1+NX1,XX30 45990021 MVI IMM,XXFD 45997021 BAL RETRG,NI * NI 48(1),X'FD' 46004021 OPEN13A EQU * 46011021 TM DX6(RW2),XXC0 BSAM/BDAM? 46018021 BNZ OPN14X YES 46025021 TM DX6(RW2),XXF0 QSAM? 46032021 BNZ OPEN13C NO 46039021 TM DX6(RW2),MAWO APPLY WRITE ONLY? 46046021 BO OPN14X IF APPLY WRITE ONLY, GO TO.. 46053021 OPEN13C DS 0H 46060021 B CLOS10 BRANCH CLOSE10 46067021 OPEN13B EQU * 46074021 MVI XREG1,XX01 * L 1,DCBADR 46081021 MVC XCNTR1+NX2(LX1),DX5(RW2) 46088021 BAL RETRG,LOAD PUT A TEXT LOAD INST 46095021 TM DOP1+NX6,XX88 BDAM-D... 47962 46102021 BO OPEN13D YES 47962 46109021 BAL RETRG,GNSTEP INCREMENT GNCTR 46116021 LR RW6,RW2 46123021 MVC IOTXTFF7,MSGCDE MCS CODE FIELD 46130021 LA RW2,IOTXTFF POINT TO LITERAL DEF 46137021 LA RW3,IOTXTFF0-IOTXTFF 46144021 BAL RETRG,PUTLTL PUT A TEXT LTLDEF 46151021 MVC IOTXTFF6(LX2),LTLCTR SET LIT ID IN ATXT 46158021 LR RW2,RW6 46165021 MVC IOTXTFF5(LX2),GNCTR 46172021 MVC IOTXTFF4(LX2),GNCTR 46179021 BAL RETRG,GATXTV * TM 48(1),X'10' 46186021 DC AL2(IOTXTFF0-ATXTBV) * BC 1,GN 46193021 DC AL2(IOTXTGG-IOTXTFF0) * MVC TS2#1,LITERAL 46200021 * * MVC TS2#15,DDNAME 46207021 * * LA 1,TS2#1 46214021 * * SVC 35 46221021 OPEN13D DS 0H 47962 46228021 TM DX10(RW2),XX02 USER LABELS 46235021 BC NOTONE,BOV9 NO 46242021 * ***** ***** ***** PROCESSING FOR BOV 46249021 TM DX6(RW2),XXB0 QISAM,BISAM, OR BDAM 46256021 BC NOTZER,BOV9 DO NOT INACT BOF ENTRY IN X 46263021 MVI XREG1,XX01 XXXX 46270021 MVC XCNTR1+NX2(LX1),DX5(RW2) X 46277021 BAL RETRG,LOAD * L 1,DCBADR XXXXX 46284021 BAL RETRG,GATXTV * L 4,36(1) 46291021 DC AL2(IOTXTS-ATXTBV) X 46298021 DC AL2(IOTXTS1-IOTXTS) X 46305021 BAL RETRG,GETELGNS RW3 NOW POINTS TO FIRST GN 46312021 CLC BOVGN,GZERO IS GN-BOV ZERO 46319021 BC NOTEQ,BOV1 NO 46326021 BAL RETRG,INACTXL * NI 0(4),X'80' 46333021 BC UNCOND,BOV9 XXXX 46340021 BOV1 DS 0H 46347021 MVC XPN2+NX2(LX2),BOVGN X 46354021 MVI BDISP1+NX1,XX01 * MVC 1(3,4),BOVGN+1 46361021 BAL RETRG,MOVEGN XXXX 46368021 BOV9 EQU * 46375021 TM DX2(RW2),XX0F OUTPUT FILE 46382021 BC NOTONE,OPEN14 NO, DO NOT GEN BL STORES 46389021 TM DX6(RW2),MNOQQI QSAM OR QISAM ... 46396021 BC NOTZER,OPEN19 NO, NOT A QUEUED FILE, NO ST BL' 46403021 TM DX6(RW2),XX02 WRITE ONLY APPLIED... 46410021 BO OPEN14 YES, SKIP CALL TO Q-ROUTINES 46417021 OPEN18AA EQU * 46424021 TM DX6(RW2),XXF0 QSAM 46431021 BNZ OPEN18BB NO 46438021 TM DX6(RW2),XX09 ADVANCING OPTION 46445021 BC NOTZER,OPEN14 YES 46452021 * 46459021 OPEN18BB DS 0H 46466021 TM DX3(RW2),XX60 S? 46473021 BO OPEN18CC YES. 46480021 TM DX10(RW2),XX08 SAME RECORD AREA 46487021 BC ONES,OPEN14 YES 46494021 OPEN18CC DS 0H 46501021 BAL RETRG,WRKLRG DESTROY 14, 15 46508021 MVC IOTXTAA1(LX1),DX5(RW2) * L 1,DCBADR 46515021 BAL RETRG,GATXTV * LR 2,1 46522021 DC AL2(IOTXTAA-ATXTBV) 46529021 DC AL2(IOTXTBB-IOTXTAA) 46536021 TM DX2(RW2),MCLREL CLOSE REEL 46543021 BC ZERO,CLOS17 NO - OPEN 46550021 BAL RETRG,GNSTEP YES- CODING TO TEST IF OUTPUT A 46557021 MVC GLGNCN+NX3(LX2),FIVEGN OBJECT TIME.CREATE GN FOR NON-O 46564021 MVC A35LGN+NX4(LX2),FIVEGN * L 3,44(1) 46571021 BAL RETRG,GATXTV * TM 12(3),X'0F' 46578021 DC AL2(ATX35A-ATXTBV) * L 5,GN (BRANCH ARO 46585021 DC AL2(ZTX35A-ATX35A) * BCR 14,5 EXTRA PUT) 46592021 CLOS17 EQU * 46599021 BAL RETRG,GATXTV PUT A TEXT 46606021 DC AL2(IOTXTG-ATXTBV) 46613021 DC AL2(IOTXTH-IOTXTG) 46620021 BAL RETRG,WRKLRX DESTROY 14, 15 46627021 TM DX3(RW2),XX60 VAR LENGTH... 46634021 BC MIXED,OPEN21 NO 46641021 MVI XREG1,XX01 YES 46648021 MVI BDISP1,XX10 46655021 MVI BDISP1+NX1,XX04 46662021 BAL RETRG,LA * LA 1,4(1) ** VAR LEN ONLY 46669021 OPEN21 EQU * 46676021 MVC OPNOPTNS,DX2(RW2) SAVE OPEN OPTIONS 46683021 TM DX10(RW2),XX08 SAME RECORD AREA ? 46690021 BO OPEN19 YES. 46697021 MVI DX2(RW2),XX00 ZERO OUT MAJOR CODE FOR IOST 46704021 BAL RETRG,IOSTBL STORE ALL BL'S 46711021 MVC DX2(LX1,RW2),OPNOPTNS RESTORE OPEN OPTIONS 46718021 OPEN19 BAL RETRG,IOQRTN GEN CALLS ON Q-ROUTINES 46725021 TM CLOSSW,MCLCLR CLOSE REEL? 46732021 BNM OPEN14 NO 46739021 BAL RETRG,GNOPT3 YES, DEFINE GN 46746021 BC UNCOND,OPEN14 BRANCH OPEN14 46753021 CLOS05 EQU * CLOSE... QSAM, QISAM PRIOR TO SVC 20 46760021 TM DX6(RW2),XXF0 QSAM 46767021 BNZ CLOS05A NO 46774021 TM DX6(RW2),MAWO+NX9 ADVANCING OR AWO 46781021 BNZ OPEN08 YES, SKIP NEGATE LAST PUT 46788021 CLOS05A DS 0H 46795021 TM DX3(RW2),XX60 S? 46802021 BO CLOS05B YES. 46809021 TM DX10(RW2),XX08 SAME RECORD AREA 46816021 BC ONES,OPEN08 YES 46823021 CLOS05B DS 0H 46830021 MVI XREG1,XX01 46837021 MVC XCNTR1+NX2(LX1),DX5(RW2) 46844021 BAL RETRG,LOAD * L 1,DCBADR=FN 46851021 MVI A35CH1,XX08 SET UP N FOR QISAM 46858021 TM DX6(RW2),MQISAM QISAM... 46865021 BC ONES,CLOS06 YES 46872021 MVI A35CH1,XX10 CHANGE N TO QSAM FX LEN 46879021 TM DX3(RW2),XX60 VAR LEN... 46886021 BC NOTMXD,CLOS08 VAR OR SPANNED? 46893021 CLOS06 BAL RETRG,GATXTV PUT A TEXT 46900021 DC AL2(ATXT35-ATXTBV) * L 2,44(1) 46907021 DC AL2(ZTXT35-ATXT35) * TM 12(2),X'0F' 46914021 * * BALR 5,0 46921021 * * BC 14,**(5) ** = N 46928021 TM DX6(RW2),MQISAM QISAM... 46935021 BC ONES,CLOS07 YES 46942021 BAL RETRG,GATXTC PUT A TEXT 46949021 DC AL2(ATXT37-ATXTBC) * L 2,76(1) 46956021 DC AL2(ZTXT37-ATXT37) * SH 2,82(1) 46963021 * * ST 2,76(1) 46970021 BC UNCOND,OPEN08 GO TO OPEN08 46977021 SPACE 2 46984021 CLOS07 MVI IMM,XX40 46991021 MVI BDISP1,XX10 46998021 MVI BDISP1+NX1,XX51 47005021 BAL RETRG,OI * OI 81(1),X'40' 47012021 BC UNCOND,OPEN08 GO TO OPEN08 47019021 SPACE 2 47026021 CLOS08 EQU * 47033021 BAL RETRG,GNSTEP CREATE BRANCH-AROUND GN FOR 47040021 MVC GLGNCN+NX3(LX2),FIVEGN NON OUTPUT FILES 47047021 MVC A35LGN+NX4(LX2),FIVEGN * L 2,44(1) 47054021 BAL RETRG,GATXTV * TM 12(2),X'0F' 47061021 DC AL2(ATX35A-ATXTBV) * L 5,GN 47068021 DC AL2(ZTX35A-ATX35A) * BCR 14,5 47075021 MVC BLREF1+NX1(LX1),DX4(RW2) 47082021 MVI XREG1,XX02 47089021 BAL RETRG,LOAD * L 2,BL=FN (1ST BL ONLY) 47096021 MVI XCON1+NX15,XX04 47103021 MVI XCON1+NX16,XX02 47110021 MVI XREG1,XX02 47117021 BAL RETRG,SHALF * SH 2,='0004' 47124021 MVI XL1+NX1,XX02 47131021 MVI BDISP1,XX20 47138021 MVI BDISP2,XX20 47145021 BAL RETRG,EXORLG * XC 0(2,2),0(2) 47152021 BAL RETRG,GNOPT3 GENR BRANCH-AROUND GN 47159021 BC UNCOND,OPEN08 BRANCH TO OPEN08 47166021 SPACE 2 47173021 CLOS10 TM DX2(RW2),MCLREL CLOSE REEL 47180021 BO OPEN18AA YES, BYPASS FREEPOOL 47187021 TM DX6(RW2),MNOQQI QSAM OR QISAM 47194021 BC ZERO,CLOS11 YES 47201021 TM DX6(RW2),XX20 BISAM... 37374 47208021 BZ OPEN14 NO 37374 47215021 TM DX6(RW2),XX06 HAS TRACK-AREA IS INTEGER 37374 47222021 * OR APPLY CORE-INDEX BEEN SPECIFIED FOR THIS FILE... 37374 47229021 BZ OPEN14 NO 37374 47236021 * 37374 47243021 * HERE WE GENERATE THE FREEMAINS FOR AREAS OF STORAGE WHICH 37374 47250021 * WERE GETMAINED FOR THE BISAM OPTIONS 'TRACK-AREA IS INTE- 37374 47257021 * GER' AND 'APPLY CORE-INDEX'. 37374 47264021 * 37374 47271021 TM DX2(RW2),MCLOSLCK CLOSE LOCK 47278021 BO CLOS10A YES, SKIP NEXT INST 47285021 MVI XREG1,XX02 47292021 MVC XCNTR1+NX2(LX1),DX5(RW2) 47299021 BAL RETRG,LOAD * L 1,DCBADR=FN 47306021 SPACE 2 41095 47313021 CLOS10A DS 0H 37374 47320021 TM DX6(RW2),XX02 APPLY CORE-INDEX... 37374 47327021 BZ CLOS10B NO 37374 47334021 BAL RETRG,CLOS03 GENERATE FREEMAIN 37374 47341021 CLOS10B DS 0H 37374 47348021 TM DX6(RW2),XX04 TRACK-AREA IS INTEGER... 37374 47355021 BZ CLOS10C NO 37374 47362021 MVI A02CH1,XX46 INDICATE OFFSETS OF 70 37374 47369021 MVI A02CH3,XX47 41095 47376021 MVI A02CH4,XX40 41095 47383021 MVI A02CH5,XX40 41095 47390021 MVI A02CH2,XX40 AND 64 INTO DCB 37374 47397021 BAL RETRG,CLOS03 GENERATE FREEMAINS 37374 47404021 MVI A02CH1,XX44 RESTORE ORIGINAL 41095 47411021 MVI A02CH3,XX45 41095 47418021 MVI A02CH2,XX48 OFFSETS INTO DCB 41095 47425021 MVI A02CH4,XX48 41095 47432021 MVI A02CH5,XX48 41095 47439021 CLOS10C DS 0H 37374 47446021 B OPEN14 CONTINUE PROCESSING 37374 47453021 SPACE 2 47460021 CLOS11 DS 0H 47467021 TM DX10(RW2),XX04 SAME AREA? 47474021 BC ONES,OPEN14 YES, NO SECOND STRING ACTION 47481021 TM DX2(RW2),MCLOSLCK CLOSE LOCK 47488021 BO CLOS11A YES 47495021 MVI XREG1,XX02 47502021 MVC XCNTR1+NX2(LX1),DX5(RW2) 47509021 BAL RETRG,LOAD * L 2,DCBADR=FN 47516021 CLOS11A EQU * 47523021 MVI ATXT380,XX08 ASSUME NON S 47530021 TM DX3(RW2),XX60 S? 47537021 BNO CLOS11B NO 47544021 TM DX10(RW2),XX08 SRA 47551021 BO OPEN14 YES. 47558021 MVI ATXT380,XX10 47565021 CLOS11B DS 0H 47572021 BAL RETRG,GATXTC * L 1,20(2) 47579021 DC AL2(ATXT38-ATXTBC) * OI 23(2),1 47586021 DC AL2(ZTXT38-ATXT38) * LH 4,4(1) 47593021 * * MH 4,6(1) 47600021 * * LA 0,8(4) * LA 1,0(1) 47607021 * * SVC 10 47614021 BAL RETRG,WRKLRX DESTROY 14, 15 47621021 BC UNCOND,OPEN14 GO TO OPEN14 47628021 SPACE 2 47635021 CLOS02 EQU * 47642021 BAL RETRG,GATXTV * L 4,36(1) 47649021 DC AL2(IOTXTS-ATXTBV) 47656021 DC AL2(IOTXTS1-IOTXTS) 47663021 BAL RETRG,GATXTV PUT A-TEXT 47670021 SPACE 2 47677021 DC AL2(IOTXTZ9-ATXTBV) 47684021 DC AL2(IOTXTZ99-IOTXTZ9) 47691021 BAL RETRG,WRKLRX DESTROY 14, 15 47698021 B OPEN01 GO TO OPEN01 47705021 SPACE 3 37374 47712021 CLOS03 DS 0H 37374 47719021 ST RETRG,SVWJHF SAVE 14 37374 47726021 BAL RETRG,GATXTV * FREEMAINS FOR AREAS 37374 47733021 DC AL2(ATXT02-ATXTBV) * GETMAINED DURING 37374 47740021 DC AL2(ATXT02A-ATXT02) * GETMAINED PREVIOUSLY 41095 47747021 BAL RETRG,GNSTEP BUMP GNCTR 41095 47754021 MVC GLGNCN+NX3(LX2),FIVEGN SAVE GN NUM FOR GN DEF 41095 47761021 MVI XREG1,XX0F 41095 47768021 MVC XGN1,GNCTR 41095 47775021 BAL RETRG,LOAD * L 15,GN(NO FREEMAIN) 41095 47782021 BAL RETRG,GATXTV GENERATE 41095 47789021 DC AL2(ATXT02A-ATXTBV) END OF FREEMAIN 41095 47796021 DC AL2(ZTXT02-ATXT02A) SEQUENCE 41095 47803021 BAL RETRG,WRKLRX DESTROY 14,15 41095 47810021 BAL RETRG,GNOPT3 GN DEFINITION 41095 47817021 L RETRG,SVWJHF RESTORE 14 37374 47824021 BR RETRG RETURN TO CALLER 37374 47831021 SPACE 3 37374 47838021 OPENEX EQU * 47845021 TM CLOSSW,XX01 IS IT OPEN 47852021 BC ONES,DON NO 47859021 LA RW3,IOTXTFF0-IOTXTFF1 TOTL LNGTH OF LITERAL 47866021 CH RW3,TS2MAX 47873021 BC NOTHI,DON RETURN TO PHASE 5 CONTROL 47880021 STH RW3,TS2MAX 47887021 BC UNCOND,DON RETURN TO PHASE 5 CONTROL 47894021 GETELGNS SR RW3,RW3 47901021 IC RW3,DX1(RW2) PICK UP COUNT 47908021 AR RW3,RW2 ADD ADDRESS OF FILE ATTRIBU 47915021 SH RW3,XC011 BACK UP 11 BYTES 47922021 BCR UNCOND,RETRG RETURN 47929021 INACTXL ST RETRG,DWB MUST INIT BDISP+1 BEFORE EN 47936021 MVI IMM,XX80 XXXX 47943021 MVI BDISP1,XX40 X 47950021 BAL RETRG,NI * NI 0(4),X'80' 47957021 L RETRG,DWB X 47964021 BCR UNCOND,RETRG XXXX 47971021 MOVEGN ST RETRG,DWB XXXX 47978021 MVI BDISP1,XX40 X 47985021 MVI PLUS2+NX2,XX01 MUST INIT XGN2 & BDISP1+1 47992021 MVI XL1+NX1,XX03 X 47999021 BAL RETRG,MVC * MVC DISPL(3,4),GN+1 48006021 L RETRG,DWB X 48013021 BCR UNCOND,RETRG XXXX 48020021 REORGEN DS 0H 48027021 ST RW1,OP1 INIT ATXT FIELD 48034021 MVI BDISP2,XX10 48041021 STC RW5,PLUS1+NX2 48048021 STC RW5,XL1+NX1 48055021 LA RW5,DX2(RW5) 48062021 BR RETRG RETURN CALLER 48069021 REORGDN DC X'300804B0000000FFFFFF' DUMMY DN FOR ATXT GENRATOR 48076021 OPNOPTNS DS C STORAGE AREA FOR OPEN OPTIONS 48083021 MACRTABL EQU * THIS TABLE MUST STAY TOGETHER 48090021 DC X'48004800220020002900' X 48097021 DC X'0048004800000028012A' X 48104021 DC X'4848484422200000292A' X 48111021 * THE ABOVE TABLE HAS THE FOLLOWING FORMAT 48118021 * QSAM QISAM BISAM BSAM BDAM 48125021 * INPUT 48132021 * OUTPUT 48139021 * I/O 48146021 TITLE 'IKFCBL51: START VERB PROCESSOR S T A R T' 48153021 *=1 START 48160021 ******************************************************************* 48167021 * START VERB ANALYZER 48174021 * 48181021 * NON SEGMENTED STRING INPUT 48188021 * 48195021 * START 48202021 * 48209021 * FILENAME 48216021 * 48223021 * GN - INVALID - KEY 48230021 * 48237021 * GN - NEXT - SENTENCE 48244021 * 48251021 ******************************************************************* 48258021 START DS 0H 48265021 USING *,GVERB 48272021 BAL RETRG,WRKLRG DESTROY 14,15 STORE SUBSCR 48279021 MVC IOTXTAA1(LX1),DOP1+NX5 DCB NUMBER 48286021 BAL RETRG,GATXTV * L 1,DCBADR 48293021 DC AL2(IOTXTAA-ATXTBV) * LR 2,1 48300021 DC AL2(IOTXTBB-IOTXTAA) 48307021 BAL RETRG,INVCK INVALID KEY CODED... 58971 48314021 BC NOTEQ,START01 NO 48321021 BAL RETRG,INVKEY * MVC DCB-8(4),GN-INV-KEY 48328021 START01 DS 0H 48973 48335021 BAL RETRG,GATXTV * ESETL 48342021 DC AL2(IOTXTT-ATXTBV) * SETL 48349021 DC AL2(IOTXTU-IOTXTT) X 48356021 BAL RETRG,WRKLRX DESTROY 14, 15 48363021 BAL RETRG,ISINVK INVALID KEY 48370021 BC NOTEQ,DON RETURN PHASE 5 CONTROL 48377021 BAL RETRG,ENDINVKY * OI DCB-5,1 48384021 * * BC 15,GN-NEXT-SENTENCE 48391021 BC UNCOND,DON EXIT 48398021 TITLE 'IKFCBL51: CHECKPOINT PROCESSOR C H E C K P O I N T' 48405021 * CPREAD AND CPWRIT 48412021 ***************************************************************** 48419021 * INTERCEPT FOR READ AND WRITE WHEN RERUN IS INVOLVED. 48426021 * 48433021 * VERB STRING IS IDENTICAL TO READ (OR WRITE) EXCEPT FOR 48440021 * VERB CODE. AFTER OBJECT CODE IS PUT OUT TO HANDLE 48447021 * THE CHECKPOINT, CONTROL IS PASSED TO READ (OR WRITE) 48454021 * FOR NORMAL PROCESSING. 48461021 * 48468021 ***************************************************************** 48475021 USING *,GVERB 48482021 READCHCK DS 0H 48489021 OI CPFLAG,XX01 SET FLAG FOR READ 45673 48496021 TM READSW,MSWON SECOND STRING? 48503021 BC ONES,CPSKIP YES. 48510021 L GVERB,ADCN72 ADJUST BASE REG. 48517021 USING CPWRIT,GVERB 48524021 BC UNCOND,CPBOTH BRANCH TO CPBOTH 48531021 CPSKIP L GVERB,ADCN72 48538021 BC UNCOND,DONE4 GO TO DONE4 48545021 * 48552021 * 48559021 * 48566021 USING *,GVERB 48573021 WRITCHCK DS 0H 48580021 CPWRIT DS 0H 45673 48587021 OI CPFLAG,XX02 SET FLAG FOR WRITE 45673 48594021 TM DOP1+NX6,MBDAM+NX8 BDAM-D 48601021 BO CPW YES - COMEBACK AFTER WRITE 48608021 TM WRITSW,MSWON SECOND STRING? 48615021 BC ONES,DONE4 YES 48622021 CPBOTH EQU * BDAM-D WILL ENTER HERE FROM WRITE 48629021 STM RW2,RW6,SVWJHE SAVE REGISTERS 48636021 BAL RETRG,WRKLRG DESTROY 14,15 STORE SUBSCR 48643021 LA RW2,DOP1 48650021 L RW3,ARNTBL ADDR.OF RUNTBL TIB. 48657021 CLC DX1(LX3,RW3),XC000 IS A(TAMM) FIELD ZERO? 48664021 BC ZERO,RNRWDN YES, NO TABLE. 48671021 SR RW4,RW4 CLEAR RW4 48678021 IC RW4,DX0(RW3) ENTRY LENGTH IN RW4. 48685021 L RW3,DX0(RW3) ADDR.OF RUNTBL TAMM 48692021 CLC XC000(LX2),DX4(RW3) CHECK N1 48699021 BC EQ,RNRWDN BRANCH IF NO ENTRIES USED. 48706021 LH RW5,DX4(RW3) NO.OF BYTES USED IN RW5 48713021 L RW3,DX0(RW3) ADDR.OF TABLE IN RW3. 48720021 N RW3,XEMK1 AND OFF HIGH ORDER BYTE. 48727021 AR RW5,RW3 ADDR.OF END OF TABLE. 48734021 SR RW5,RW4 ADDR.OF LAST ENTRY IN RW5 48741021 LA RW6,DX1(RW0) RW6=1 48748021 RNSCN CLC DX5(LX1,RW2),DX1(RW3) COMPARE DCB#S. DOP VS.RUNTBL. 48755021 BE RUNRW BRANCH IF EQUAL 48762021 LA RW6,DX1(RW6) INCREMENT ENTRY# COUNTER. 48769021 BXLE RW3,RW4,RNSCN LOOP.. TO RNSCN 48776021 BC UNCOND,RNRWDN GO TO RNRWDN 48783021 RUNRW STH RW6,HALFWD ENTRY NO. 48790021 LR RW5,RW3 48797021 MVC A106CH1+NX5(LX2),HALFWD MOVE IT INTO GLOBAL TABLE 48804021 MVC A106CH3+NX5(LX2),DX2(RW3) MOVE DCB # OF CKPT FILE 48811021 TM DOP1+NX6,XXF0 QSAM? 48818021 BNZ NOTQSAM IF NOT QSAM, GO TO.. 48825021 TM CPFLAG,XX02 WRITE... 45673 48832021 BZ NOTQSAM NO, READ 45673 48839021 MVC XCNTR1+NX2(LX1),DOP1+NX5 DCB NUMBER OF FILE 48846021 MVI XREG1,XX01 48853021 BAL RETRG,LOAD * L 1,DCBADR 48860021 MVC XCON2+NX14(LX2),PUTOUTCN 48867021 MVI XCON2+NX16,XX02 48874021 MVI XL1+NX1,XX02 48881021 MVI BDISP1,XX10 48888021 MVI BDISP1+NX1,XX60 48895021 BAL RETRG,CLC * CLC 96(2,1),LIT=X'05EF' 48902021 BAL RETRG,GNSTEP INCREMENT GNCTR 48909021 MVC DOP2+NX30(LX2),GNCTR SAVE GN NUMBER 48916021 MVI XREG1,XX01 48923021 MVC XGN1,GNCTR 48930021 BAL RETRG,LOAD * L 1,GN-NEXT-SENT 48937021 MVI XREG1,XX07 BRANCH NOT EQUAL 48944021 MVI XREG2,XX01 48951021 BAL RETRG,BRANCH * BCR EQ,1 48958021 NOTQSAM DS 0H 48965021 BAL RETRG,GNSTEP INCREMENT GNCTR 48972021 MVC A106CH2(LX2),GNCTR 48979021 BAL RETRG,GATXTV * L 1,CHKPTSV 48986021 DC AL2(ATXT106-ATXTBV) * L 2,GN-NEXT-SENTENCE 48993021 DC AL2(ZTXT106-ATXT106) * BCTR 1,2 49000021 * * L 1,DCBADR 49007021 LA RW3,CHPTCON * L 15,=V(CHKPNT) 49014021 BAL RETRG,VBALRE * BALR 14,15 49021021 BAL RETRG,WRKLRX DESTROY 14, 15 49028021 MVC XCON1+NX12(LX4),DX4(RW5) INTEGER 49035021 MVI XCON1+NX16,XX04 49042021 MVI XREG1,XX01 49049021 BAL RETRG,LOAD * L 1,CHKPNTCTR 49056021 MVC GLGNCN+NX3(LX2),GNCTR 49063021 BAL RETRG,GNOPT3 GN DEF 49070021 MVI XCNTR1,XX50 TGT CHKPNT CELL 49077021 MVC XCNTR1+NX1(LX2),HALFWD CELL NUMBER 49084021 MVI XREG1,XX01 49091021 BAL RETRG,STORE * ST 1,CHKPNTCELL 49098021 TM DOP1+NX6,XXF0 QSAM? 49105021 BNZ RNRWDN NO 49112021 TM CPFLAG,XX01 READ.... 45673 49119021 BO RNRWDN YES 45673 49126021 MVC GLGNCN+NX3(LX2),DOP2+NX30 GN FOR QSAM 49133021 BAL RETRG,GNOPT3 GNDEF 49140021 RNRWDN LM RW2,RW6,SVWJHE RESTORE REGISTERS 49147021 DONE4 EQU * 49154021 TM CPFLAG,XX02 WRITE... 45673 49161021 BO CPWR YES 45673 49168021 NI CPFLAG,X'FF'-XX01 TURN OFF READ 45673 49175021 L GVERB,ADCN20 READ 49182021 BCR UNCOND,GVERB RETURN TO NORMAL PROCESSING. 49189021 CPWR DS 0H 45673 49196021 NI CPFLAG,X'FF'-XX02 TURN OFF WRITE 45673 49203021 TM DOP1+NX6,MBDAM+NX8 BDAM-D... 45673 49210021 BNO CPW NO 49217021 L GVERB,ADCN23 YES, ADCON FOR WRITE 49224021 USING WRITE,GVERB 49231021 B REWR08 FINISH UP WRITE CODING 49238021 USING WRITCHCK,GVERB 49245021 CPW L GVERB,ADCN23 WRITE 49252021 BCR UNCOND,GVERB RETURN TO NORMAL PROCESSING. 49259021 TITLE 'IKFCBL51: READ VERB ANALYZER R E A D' 49266021 *=1 READ 49273021 ******************************************************************* 49280021 * R E A D V E R B A N A L Y Z E R 49287021 * 49294021 * NON-SEGMENTED STRING INPUT... 49301021 * 49308021 * READ 49315021 * 49322021 * FILENAME 49329021 * GN - AT END / GN - INVALID KEY / GN - NEXT SENTENCE 49336021 * 49343021 * GN - NEXT SENTENCE 49350021 * 49357021 * RECORD NAME 49364021 * 49371021 * DATANAME (FOR INTO OPTION) / FIGCON-ZERO (X'75F0') 49378021 * 49385021 * 49392021 * 49399021 * 49406021 ******************************************************************* 49413021 USING *,GVERB 49420021 READ EQU * 49427021 BAL RETRG,WRKLRX DESTROY 14, 15 49434021 LA RW2,DOP1 RW2 USED BY SR'S 49441021 TM READSW,MSWON SECOND STRING? 49448021 BC ONES,READ23 YES, GO GEN TERMINAL CODING 49455021 BAL RETRG,SETRECFM INITIALIZE RECORD MODE 49462021 MVC IOTXTA+NX6(LX1),DOP1+NX7 SET UP ATXT VARIABLES IN CAS 49469021 MVC IOTXTF+NX7(LX2),DOP2+NX1 THEY ARE USED IS GENERATIO 49476021 MVC IOTXTE+NX6(LX1),DOP1+NX5 49483021 TM DOP1+NX6,XXE0 QSAM OR QISAM 49490021 BC ZERO,READ04 YES 49497021 TM DOP1+NX6,XX20 BISAM 49504021 BC ONES,READ02 YES 49511021 TM DOP1+NX6,XX80 BDAM 49518021 BC ONES,READ03 YES 49525021 * 49532021 * GENERATE CODE FOR BSAM READ 49539021 * 49546021 MVI GTEMP,XX00 49553021 TM DOP1+NX6,XX44 DIRECT BSAM? 49560021 BNO READ01 NO 49567021 TM RECMODE,STYPE SPANNED? 49574021 BNO READ01 NO 49581021 TM DOP1+NX6,XX08 WAS A KEY SPECIFIED? 49588021 BNO READSPAN NO 49595021 BAL RETRG,GATXTV MVC 33(3,2),GN FOR AT END 49602021 DC AL2(IOTXTE-ATXTBV) 49609021 DC AL2(IOTXTG-IOTXTE) 49616021 MVC IOTXTBB1(LX3),DX11(RW2) KEY IDK 49623021 BAL RETRG,GATXTV * LA 1,ACTUAL KEY 49630021 DC AL2(IOTXTBB-ATXTBV) * 49637021 DC AL2(IOTXTCC-IOTXTBB) * 49644021 MVI GTEMP,XX01 INDICATE A KEY ENTRY 49651021 READSPAN DS 0H 49658021 MVC XCNTR1+NX2(LX1),DX7(RW2) 49665021 MVI XCNTR1,XX14 DECB REFERENCE 49672021 MVI XREG1,XX03 49679021 BAL RETRG,LOAD * L 3,DECB ADDRESS 49686021 LA RW3,BSAMREAD ADDRESS OF BSAM READ NAME 49693021 BAL RETRG,VBALRE GENERATE BRANCH TO ILBOSAMR 49700021 BAL RETRG,WRKLRX DESTROY 14 & 15 49707021 MVC GMACDC+NX1(LX2),GTEMP MOVE CODE TO ATEXT FIELD 49714021 MVI GMACDC,XX02 LENGTH OF CODE IS 2 49721021 MVI GMCTYP,MDC 49728021 BAL RETRG,MACRO * BC 0,NN NN = FUNCTION CODE 49735021 BC UNCOND,READ06 GENERATE POST READ CODE 49742021 READ01 MVI IOTXTC+NX2,XX80 49749021 BAL RETRG,GATXTV PUT A TEXT 49756021 DC AL2(IOTXTA-ATXTBV) 49763021 DC AL2(IOTXTD-IOTXTA) 49770021 BAL RETRG,GATXTC 'S' FOR LENGTH OPERAND FOR READ 49777021 DC AL2(ATXT85-ATXTBC) * MVI 4(3),X'80' 49784021 DC AL2(ZTXT85-ATXT85) 49791021 BAL RETRG,GATXTV * MVC 33(3,2),GN-EOD 49798021 DC AL2(IOTXTF-ATXTBV) 49805021 DC AL2(IOTXTG-IOTXTF) 49812021 BAL RETRG,GATXTV PUT A TEXT 49819021 DC AL2(IOTXTH-ATXTBV) 49826021 DC AL2(IOTXTJ-IOTXTH) 49833021 TM DOP1+NX6,XX0C DIRECT AND KEY 49840021 BC NOTONE,READ06 NO 49847021 SR RW4,RW4 49854021 IC RW4,DOP1+NX14 LENGTH OF KEY 49861021 BCTR RW4,R0 DECREMENT BY ONE 49868021 STC RW4,IOTXTJ1 49875021 BAL RETRG,INCRKEY GET IDK OF ACT.KEY+4 49882021 MVC IOTXTJ2(LX3),GTEMP MOVE IT INTO ATXT 49889021 * * L 5,12(3) 49896021 * * MVC ACT-KEY+4(L),BUFFER 49903021 BAL RETRG,GATXTV PUT A TEXT 49910021 DC AL2(IOTXTJ-ATXTBV) 49917021 DC AL2(IOTXTL-IOTXTJ) 49924021 B READ06 BRANCH TO READ06 49931021 * 49938021 * GENERATE CODE FOR BISAM READ 49945021 * 49952021 READ02 EQU * 49959021 BAL RETRG,GATXTV PUT A TEXT 49966021 DC AL2(IOTXTA-ATXTBV) * L 3,DECBADR 49973021 DC AL2(IOTXTC-IOTXTA) * L 2,8(3) 49980021 BAL RETRG,GATXTV SET TYPE2 FIELD OF DECB 49987021 DC AL2(ATXT69-ATXTBV) X 49994021 DC AL2(ZTXT69-ATXT69) X 50001021 * * MVC 5(1,3),252(2) 50008021 BAL RETRG,INVCK INVALID KEY CODED... 58971 50015021 BC NOTEQ,READ02C GO TO READ02C 50022021 BAL RETRG,INVKEY YES 50029021 READ02C DS 0H 50036021 MVI IOTXIA+NX5,XX58 READ OFFSET IS 88 50043021 BAL RETRG,BISMRDWT GEN READ/CHECK INSTRS. 50050021 BAL RETRG,GATXTC PUT A TEXT 50057021 DC AL2(ATXT60-ATXTBC) * L 1,16(3) 50064021 DC AL2(ZTXT60-ATXT60) 50071021 BAL RETRG,GNSTEP BUMP GNCTR 31139 50078021 MVC IOTXTQA(LX2),GNCTR INSERT GN NUM IN LOAD 31139 50085021 MVC GLGNCN+NX3(LX2),GNCTR SAVE FOR GN DEF 31139 50092021 BAL RETRG,GATXTV * TM 24(3),X'FD' 31139 50099021 DC AL2(IOTXTQ-ATXTBV) * L 14,GN(NO BL'S) 31139 50106021 DC AL2(IOTXTR-IOTXTQ) * BCR 7,14 31139 50113021 TM RECMODE,STYPE SPANNED? 50120021 BO READ2B YES 50127021 TM RECMODE,VTYPE VARIABLE? 50134021 BNO READ4A NO 50141021 READ2B EQU * 50148021 MVI BDISP1,XX10 50155021 MVI BDISP1+NX1,XX04 50162021 MVI XREG1,XX01 50169021 BAL RETRG,LA * LA 1,4(1) 50176021 BC UNCOND,READ4A GO STORE BL'S, CALL Q-ROUTINES 50183021 * 50190021 * GENERATE CODE FOR BDAM READ 50197021 * 50204021 READ03 MVI IOTXTC+NX2,XX48 MOVE CODE FOR SUBSEQUENT GENERATION 50211021 TM DOP1+NX6,XX04 X'48' FOR REL RCD 50218021 BC ZERO,SKIP08 X'4C' FOR REL TRK 50225021 MVI IOTXTC+NX2,XX4C 50232021 SKIP08 BAL RETRG,GATXTV PUT A-TEXT 50239021 DC AL2(IOTXTA-ATXTBV) 50246021 DC AL2(IOTXTD-IOTXTA) 50253021 BAL RETRG,INVCK INVALID KEY CODED... 58971 50260021 BNE READ03C NO 50267021 BAL RETRG,INVKEY YES 50274021 READ03C DS 0H 50281021 TM DX6(RW2),XX04 DIRECT 50288021 BO READ03A YES 50295021 BAL RETRG,GATXTC * L 1,20(3) 50302021 DC AL2(ATXT109-ATXTBC) * MVC 28(4,3),0(1) 50309021 DC AL2(ZTXT109-ATXT109) 50316021 B READ03B BRANCH TO READ03B 50323021 READ03A DS 0H 50330021 BAL RETRG,BDAMDW GO TO BDAMDW FOR BDAM 50337021 TM DOP1+NX6,XX08 BDAM-D 50344021 BNO READ03B NO, BDAM-W 50351021 MVC IOTXTEE2(LX3),DOP1+NX11 IDK 50358021 SR RW4,RW4 50365021 IC RW4,DOP1+NX14 KEY LENGTH 50372021 LA RW4,DX3(RW4) 50379021 STC RW4,IOTXTEE1 KL+4 50386021 BAL RETRG,GATXTV * L 5,36(3) 50393021 DC AL2(IOTXTEE-ATXTBV) * MVC 0(LK+4,5),ACT-KEY 50400021 DC AL2(IOTXTFF-IOTXTEE) 50407021 READ03B DS 0H 50414021 MVI IOTXIB+NX5,XX34 RESTORE DISPLACEMENT 50421021 BAL RETRG,GATXTV PUT A TEXT 50428021 DC AL2(IOTXTI-ATXTBV) 50435021 DC AL2(IOTXTJ-IOTXTI) 50442021 B READ06 GO TO READ06 50449021 * 50456021 * GENERATE CODE FOR QSAM QISAM READ 50463021 * 50470021 READ04 DS 0H 58932 50477021 TM RECMODE,STYPE+VTYPE S OR V MODE... 58932 50484021 BZ READ05 NO 58932 50491021 OI NREADSW,READVSON YES,INDICATE SO 58932 50498021 READ05 DS 0H 58932 50505021 BAL RETRG,GATXTV * 58932 50512021 DC AL2(IOTXTE-ATXTBV) 50519021 DC AL2(IOTXTG-IOTXTE) 50526021 TM RECMODE,STYPE 50533021 BC NOTONE,READ04C IF NOT SPANNED, SKIP TO READ04C 50540021 MVC BLREF1+NX1(LX1),DOP1+NX4 BL NUMBER 50547021 BAL RETRG,LOAD PUT A TEXT LOAD INST 50554021 READ04C BAL RETRG,GATXTV PUT A TEXT 50561021 DC AL2(IOTXTG-ATXTBV) 50568021 DC AL2(IOTXTH-IOTXTG) 50575021 TM SORTSW1,SORTVERB ARE WE IN THE MIDDLE OF A SORT 42646 50582021 * INPUT PROCEDURE... 42646 50589021 BZ READ04A NO 42646 50596021 MVC A06CH1(LX2),XSARLSE INSERT RELEASE XSACELL 42646 50603021 MVC A06CH3(LX2),XSARLSE 42646 50610021 TM RECMODE,STYPE+VTYPE V OR S MODE... 57809 50617021 BO READ04B YES 42646 50624021 MVI A06CH2,XX80 INDICATE F-MODE FILE 42646 50631021 MVI A06CH4,XX96 INDICATE OI INSTR 42646 50638021 B READ04E COMMON CODE 42646 50645021 READ04B DS 0H 42646 50652021 MVI A06CH2,XX7F INDICATE V MODE 42646 50659021 MVI A06CH4,XX94 INDICATE NI INSTR 42646 50666021 READ04E DS 0H 42646 50673021 BAL RETRG,GATXTV * ST 1,XSARLSE 42646 50680021 DC AL2(ATXT06-ATXTBV) * 42646 50687021 DC AL2(ZTXT06-ATXT06) * OI XSARLSE,FLAG 42646 50694021 READ04A DS 0H 42646 50701021 TM RECMODE,STYPE SPANNED? 50708021 BO READ04D YES 50715021 TM RECMODE,VTYPE V TYPE RCD 50722021 BC NOTONE,READ4A NO 50729021 READ04D EQU * 50736021 MVI XREG1,XX01 50743021 MVI BDISP1+NX1,XX04 50750021 MVI BDISP1,XX10 50757021 BAL RETRG,LA PUT A TEXT LA INST 50764021 READ4A EQU * 50771021 TM DOP1+NX10,XX08 SAME RECORD AREA 50778021 BC ONES,READ06 YES 50785021 BAL RETRG,IOSTBL GENERATE ST 1,BL 50792021 * 50799021 * 50806021 * GENERATE POST-READ CODE 50813021 * 50820021 READ06 DS 0H 39824 50827021 MVC RDMVBLSV(LX1),DOP1+NX4 STORE BL NUMBER FOR MOVE 58932 50834021 TM DOP1+NX6,XX20 BISAM... 39824 50841021 BO READ06C YES 39824 50848021 TM DOP1+NX6,XX80 BDAM... 39824 50855021 BZ READ06C NO 39824 50862021 BAL RETRG,ISINVK INVALID KEY... 39824 50869021 BNE READ06C NO 39824 50876021 BAL RETRG,GATXTV * 39824 50883021 DC AL2(IOTXTR-ATXTBV) * OI 27(4),1 39824 50890021 DC AL2(IOTXTRPR-IOTXTR) * 39824 50897021 READ06C DS 0H 39824 50904021 TM DOP1+NX6,XXC0 BSAM OR BDAM... 39824 50911021 BNZ READ06B YES 50918021 TM RECMODE,STYPE S? 50925021 BO READ06B YES, NO MOVE 50932021 TM DOP1+NX10,XX08 SAME RECORD AREA 50939021 BC NOTONE,READ06B IF NOT, GO TO READ06B 50946021 BAL RETRG,READMOVE GENERATE MOVE CODING 50953021 OI NREADSW,SCNDSRA INDICATE SECOND SRA MOVE 58932 50960021 B READ06A GO TO READ06A 50967021 READ06B EQU * 50974021 BAL RETRG,IOQRTN GEN Q-RTNS FOR FILE 50981021 READ06A EQU * 50988021 LA RW3,DOP4 50995021 TM DX7(XR3),XX02 RECORD QRTNS... 53600 51002021 BZ READ07 NO 53600 51009021 LA XRSUB,READ07 RETURN ADDRESS 53600 51016021 STM XR0,XR15,XGSAV1 SAVE REGS 53600 51023021 L XRVAR,FPALOD AND GET ADDRESSABILITY 53600 51030021 USING LSSPRO,XRVAR 53600 51037021 B LSSPRO GENERATE Q-ROUTINES 53600 51044021 READ07 DS 0H 53600 51051021 CLC DOP5(LX2),ONZERO IS A MOVE COMING... 51058021 BC NOTEQ,READ22 YES 51065021 READ23 DS 0H 51072021 NI NREADSW,X'FF'-(READVSON+SCNDSRA) ALL OFF 58932 51079021 NI READSW,MSWOFF 51086021 TM DOP1+NX6,XX80 BDAM... 1139 51093021 BO READ24 YES, SKIP BAD BL DEF OF GN 1139 51100021 TM DOP1+NX6,XX20 BISAM... 1139 51107021 BZ READ23A NO 1139 51114021 BAL RETRG,GNOPT3 * GN(NO BL'S) EQU * 1139 51121021 READ24 DS 0H 1139 51128021 BAL RETRG,ISINVK INVALID KEY 39824 51135021 BNE READEX NO 51142021 TM DOP1+NX6,XX20 BISAM... 39824 51149021 BZ READ05C NO 39824 51156021 BAL RETRG,GATXTV * 49518 51163021 DC AL2(IOTXTP-ATXTBV) * L 4,36(2) 49518 51170021 DC AL2(IOTXTP2-IOTXTP) * 49518 51177021 BAL RETRG,GATXTV * 39824 51184021 DC AL2(IOTXTR-ATXTBV) * OI 27(4),1 39824 51191021 DC AL2(IOTXTRPR-IOTXTR) * 39824 51198021 READ05C DS 0H 39824 51205021 READ23A DS 0H 51212021 MVC IOTXTR1(LX2),DOP3+NX1 GN-NEXT-SENTENCE 51219021 BAL RETRG,GATXTV * L 15,GN 51226021 DC AL2(IOTXTRPR-ATXTBV) * BR 15 51233021 DC AL2(IOTXTS-IOTXTRPR) 51240021 B READEX GO TO READEX TO RETURN 51247021 READ22 DS 0H 51254021 OI READSW,MSWON 51261021 READEX B PH5CTL RETURN TO PHASE 5 CTL 51268021 TITLE 'REWRITE VERB PROCESSOR R E W R I T E' 51275021 *=1 REWRITE 51282021 ******************************************************************* 51289021 * R E W R I T E 51296021 * SAME FORM OF INPUT AS WRITE, IN WRITE ANALYZE 51303021 ******************************************************************* 51310021 USING *,GVERB 51317021 REWRIT EQU * 51324021 OI REWRSW,MSWON TURN ON REWRITE SWITCH 51331021 TM DOP1+NX6,XXF0 QSAM? 51338021 BNO REWRIT01 NO 51345021 NI DOP1+NX6,XXFD TURN OFF APPLY WRITE-ONLY BIT SINCE IT 51352021 * MEANINGLESS FOR REWRITE CODING 51359021 REWRIT01 DS 0H 51366021 L GVERB,ADCN23 BODY OF ANALYZER WITH WRITE 51373021 USING WRITE,GVERB 51380021 BC UNCOND,REWR00 GO TO WRITE RTN 51387021 TITLE 'IKFCBL51: WRITE VERB PROCESSOR W R I T E/R E W R I T E' 51394021 *=1 WRITE 51401021 ******************************************************************* 51408021 * WRITE RN...FROM...INVALID KEY...AFTER 51415021 * 51422021 * 51429021 * WRITE 51436021 * 51443021 * FILENAME 51450021 * 51457021 * GN - INVALID KEY / GN - NEXT SENTENCE 51464021 * 51471021 * GN - NEXT SENTENCE 51478021 * 51485021 * DATANAME / FIGCON-ZERO (X'75F0') 51492021 * 51499021 * RECORD NAME 51506021 * 51513021 * 51520021 * FOR A WRITE WITH ADVANCING OR POSITIONING 51527021 * DOP2 AND DOP3 BECOME 51534021 * 51541021 * GN-NEXT-SENTENCE 51548021 * 51555021 * INTEGER / MNEUMONIC / DATANAME 51562021 * 51569021 * 51576021 * THE FOURTH ELEMENT HAS EITHER THE 'FROM' DN OR 51583021 * THE DUMMY ELEMENT (A FIGCON ZERO). 51590021 * IF DN, 2 IDENTICAL STRINGS ARE PROVIDED WITH 51597021 * MOVE STRINGS BETWEEN THEM. 51604021 * 51611021 ******************************************************************* 51618021 IKF50K CSECT 51625021 USING *,GVERB 51632021 WRITE EQU * 51639021 NI REWRSW,MSWOFF 51646021 REWR00 NI WRSW01,MSWOFF 51653021 MVC IOTXTA+NX6(LX1),DOP1+NX7 51660021 LA RW2,DOP1 ** RW2 MUST STAY AT DOP1 ** 51667021 * ** FOR SR'S TO WORK PROPERLY.** 51674021 BAL RETRG,SETRECFM INITIALIZE RECORD MODE 51681021 TM DOP1+NX6,XXF0 QSAM 51688021 BNZ WRIT23 NO 48426 51695021 TM DOP1+NX6,XX09 ADVANCING OPTION 51702021 BC NOTZER,MWRIT01A YES 51709021 MWRIT01B DS 0H 51716021 TM DOP1+NX10,XX08 SAME RECORD AREA 51723021 BNO WRIT12 NO 48426 51730021 NI DOP1+NX6,XXFD TURN OFF APPLY WRITE ONLY BIT 51737021 B WRIT23 GO TO WRITE23 51744021 WRIT12 DS 0H 48426 51751021 TM DOP1+NX6,MAWO APPLY WRITE-ONLY... 48426 51758021 BZ WRIT23 NO 48426 51765021 TM DOP1+NX6,XX04 POSITIONING... 48426 51772021 BZ WRIT23 NO 48426 51779021 B WRIT13 YES, AWO + POS ROUTINE 48426 51786021 MWRIT01A EQU * 51793021 TM WRITSW,XX01 YES, IS IT SECOND STRING 51800021 BC ONE,MWRIT01 YES 51807021 OI WRITSW,XX01 NO 51814021 CLC DOP4(LX2),ONZERO IS MOVE EXPECTED 51821021 BC NOTEQ,DON YES 51828021 MWRIT01 NI WRITSW,MSWOFF 51835021 CLI DOP3,XX32 ADVANCING INTEGER LINES 51842021 BC NOTEQ,MWRIT02 NO 51849021 SR RW2,RW2 51856021 IC RW2,DOP3+NX2 LENGTH OF INTEGER 51863021 BCTR RW2,R0 DECREMENT BY ONE 51870021 EX RW2,ZAPMM MOVE INTEGER TO DOUBLEWORD BOUNDARY 51877021 CVB RW2,DWB 51884021 ST RW2,INTEGER 51891021 TM DOP1+NX6,XX09 51898021 BO SPACCLNG IF ADVANCING OPT, GO TO SPACCLN 51905021 CH RW2,XC003 IS ING 51912021 BC NOTHI,MSUB2 NO, GENERATE ** MVI RN,CODE ** 51919021 BC UNCOND,SPACCLNG YES,GENERATE SUBRTN CALLING SEQ 51926021 MWRIT02 CLI DOP3,XX30 DATANAME LINES 51933021 BC EQ,SPACCLNG YES, ELSE MNEUMONIC NAME LINES 51940021 TM DOP5+NX7,XX80 IS THIS A REPORT RCD WITH CODE 51947021 BC ONES,SPACCLNG YES,GENERATE SUBRTN CALLING SEQ 51954021 TM DOP1+NX6,XX09 MIXED? 51961021 BNZ SPACCLNG YES- CALL ILBOSPA0 51968021 SR RW2,RW2 * MVI RN,MNEMONIC-CODE 51975021 IC RW2,DOP3+NX1 51982021 LA RW2,MNCTABLE(RW2) 51989021 TM DOP1+NX2,XX80 BEFORE OPTION 51996021 BC ZERO,MSUB3A NO 52003021 LA RW2,DX15(RW2) YES 52010021 MSUB3A MVC IMM(LX1),DX0(RW2) 52017021 LA RETRG,DOP5 52024021 ST RETRG,OP1 52031021 BAL RETRG,MVI PUT A TEXT MVI INST 52038021 BC UNCOND,MWRIT03 GO TO MWRITE03 52045021 SPACCLNG BAL RETRG,TSTEOP TEST FOR GN-CODE 52052021 BNE SPACCLN2 IF NOT, GO TO SPACCLNG2 52059021 BAL RETRG,WRIS02 IF YES, PERFORM WRIS02 52066021 SPACCLN2 MVC OPTNBYTE,RECMODE 52073021 TM DOP1+NX2,XX80 BEFORE OPTION 52080021 BO SPAC01 YES 52087021 OI OPTNBYTE,XX10 52094021 SPAC01 CLI DOP3,XX55 MNEUMONIC OPTION 52101021 BC NOTEQ,SPAC02 NO 52108021 CLI DOP3+NX1,XX00 SUPPRESS SPACING CODE? 52115021 BNE SPAC01A NO 52122021 MVC DOP3(LX5),CSPSUBST MOVE IN CONVERTED CSP CODE 52129021 B MWRIT01 PROCESS AS INTEGER 52136021 SPAC01A DS 0H 52143021 OI OPTNBYTE,XX40 YES 52150021 CLI DOP3+NX1,XX0C CODE GREATER THAN 12 52157021 BC HI,SPAC03 YES, BYPASS MIXED TEST 52164021 SPAC02 TM DOP1+NX6,XX09 MIXED 52171021 BNO SPAC03 IF ADVANCING OPT. GO TO SPAC0 52178021 OI OPTNBYTE,XX80 YES 52185021 SPAC03 TM DOP5+NX7,XX80 IS THIS A REPORT RECORD WITH CODE 52192021 BC ZERO,SPAC04 NO 52199021 OI OPTNBYTE,XX20 YES 52206021 SPAC04 MVC IOTXTOA(LX1),DOP1+NX4 MOVE BLI NO. TO PARAMETER LIST 52213021 PACK IOTXTOA1(LX1),DOP5+NX4 MOVE BL TYPE TO TEXT 52220021 NI IOTXTOA1,XX0F 52227021 MVC IOTXTOC(LX1),OPTNBYTE 52234021 MVC IOTXTOB(LX1),DOP1+NX5 52241021 BAL RETRG,GATXTV * MVC PARAM#1,BLI 52248021 DC AL2(IOTXTO-ATXTBV) 52255021 DC AL2(IOTXTOD-IOTXTO) * MVI PARAM#1,OPTNBYTE 52262021 * * MVC PARAM#3,DCBADR 52269021 TM RECMODE,FTYPE 52276021 BC ONES,SPAC05 GO TO SPAC05 52283021 MVI XREG1,XX01 52290021 BAL RETRG,WRIS04 * L 14,RCDLNGTH 52297021 MVI IOTXTOE,XX04 52304021 BAL RETRG,GATXTV * ST 14,PARAM#4 52311021 DC AL2(IOTXTOD-ATXTBV) 52318021 DC AL2(IOTXTOF-IOTXTOD) 52325021 SPAC05 CLI DOP3,XX32 INTEGER LINES 52332021 BC NOTEQ,SPAC06 NO, THEN MUST BE DATANAME OR MNEUMONI 52339021 MVC IOTXTOG+NX1(LX1),INTEGER+NX3 52346021 BAL RETRG,GATXTV * LA 14,INTEGER 52353021 DC AL2(IOTXTOF-ATXTBV) 52360021 DC AL2(IOTXTOH-IOTXTOF) 52367021 MVI IOTXTOE,XX02 52374021 BAL RETRG,GATXTV * ST 14,PARAM#2 52381021 DC AL2(IOTXTOD-ATXTBV) 52388021 DC AL2(IOTXTOF-IOTXTOD) 52395021 BC UNCOND,SPAC10 GO TO SPAC10 52402021 SPACE 2 52409021 SPAC06 CLI DOP3,XX55 MNEUMONIC 52416021 BC NOTEQ,SPAC07 NO,DATANAME OPTION 52423021 MVC IOTXTOI(LX1),DOP3+NX1 52430021 BAL RETRG,GATXTV * MVI PARAM#2+3,CODE 52437021 DC AL2(IOTXTOH-ATXTBV) 52444021 DC AL2(IOTXTOJ-IOTXTOH) 52451021 BC UNCOND,SPAC10 GO TO SPAC10 52458021 SPACE 2 52465021 SPAC07 LA RW3,DOP3 POINT TO DATANAME 52472021 BAL RETRG,GDNCNG *CVB IF NOT BIN, LOAD INTO REG1 52479021 BAL RETRG,GATXTC * STC 1,PARAM#2+3 52486021 DC AL2(ATXT92-ATXTBC) 52493021 DC AL2(ZTXT92-ATXT92) 52500021 SPAC10 LA RW2,DX4 52507021 CH RW2,PARMAX PARMAX LESS THAN 4 52514021 BC NOTHI,SPAC11 NO 52521021 STH RW2,PARMAX YES, RESET TO 4 52528021 SPAC11 BAL RETRG,GATXTC * LA 1,PARAM#1 52535021 DC AL2(ATXT93-ATXTBC) 52542021 DC AL2(ZTXT93-ATXT93) 52549021 LA RW3,SPACCON 52556021 BAL RETRG,VBALRE GEN BRANCH TO ILBOSPAC 52563021 BAL RETRG,WRKLRX DESTROY 14, 15 52570021 BC UNCOND,REWREX EXIT TO PH5CNTRL 52577021 MWRIT03 EQU * GENERATE INLINE PUTL CALLING SEQUENCE 52584021 SPACE 3 52591021 OI DOP1+NX10,XX08 TURN ON SAME RECORD AREA BIT 52598021 B WRIT20 GO TO WRIT20 52605021 SPACE 2 52612021 WRIT23 DS 0H 52619021 LA RW2,DOP1 52626021 TM WRITSW,MSWON 52633021 BC ONES,WRIT26 THIS IS SECOND STRING, FOR POST- 52640021 OI WRITSW,MSWON 52647021 TM DOP1+NX6,MNOQQI EITHER QSAM OR QISAM... 52654021 BC NOTZER,WRIT01 NO 52661021 TM DOP1+NX6,XX02 APPLY WRITE ONLY... 52668021 BC ONES,WRIT03 YES, DO NO SET UP CARR CONTROL 52675021 CLC DOP4(LX2),ONZERO IS MOVE EXPECTED 52682021 BC NOTEQ,DON YES 52689021 WRIT21 EQU * 52696021 NI WRITSW,MSWOFF 52703021 BAL RETRG,WRKLRG KILL 0-5, 14, 15 52710021 TM DOP1+NX6,XX02 APPLY WRITE ONLY... 52717021 BC ONES,WRIT02 YES 52724021 CLI DOP3,MRGN AFTER POSITIONING 52731021 BC EQ,WRIT20 NO 52738021 CLI DOP3,MDN AFTER POSITIONING DN 52745021 BC EQ,WRIT04 YES 52752021 BAL RETRG,WRIS01 * MVI RN,C'N' 52759021 WRIT20 EQU * 52766021 WRIT03 BAL RETRG,WRIS02 * L 1,DCBADR 52773021 BAL RETRG,INVCK INVALID KEY CODED... 58971 52780021 BC NOTEQ,WRIT05 IF NOT, SKIP NEXT INST 52787021 BAL RETRG,INVKEY PUT A TEXT FOR INVALID KEY 52794021 WRIT05 DS 0H 52801021 TM REWRSW,MSWON REWRITE? 52808021 BO REWR01 YES 52815021 TM RECMODE,FTYPE F TYPE RCD? 52822021 BNO WRIT05A NO 43505 52829021 TM DOP1+NX6,XXF0 QSAM... 43505 52836021 BZ WRIT40A YES 43505 52843021 B WRIT06A NO 43505 52850021 WRIT05A DS 0H 43505 52857021 TM SORTSW1,SORTVERB ARE WE IN THE MIDDLE OF A SORT 43150 52864021 * OUTPUT PROCEDURE FOR A GIVING FILE... 7882 52871021 BZ WRIT09 NO 7882 52878021 * 7882 52885021 MVC A71CH1(LX2),XSARTRN INSERT XSACELL NUMBER 43150 52892021 BAL RETRG,GATXTV * 7882 52899021 DC AL2(ATXT71-ATXTBV) L 4,XSA-CELL 43150 52906021 DC AL2(ZTXT71-ATXT71) * 7882 52913021 * 7882 52920021 MVI XREG1,XX04 43150 52927021 MVI XCON1+NX15,XX04 7882 52934021 MVI XCON1+NX16,XX02 7882 52941021 BAL RETRG,SHALF SH 4,=H'4' 43150 52948021 * 7882 52955021 BAL RETRG,GATXTV SR 3,3 43150 52962021 DC AL2(ATXT75-ATXTBV) IC 3,0(0,4) 43150 52969021 DC AL2(ZTXT75-ATXT75) SLL 3,8 43150 52976021 * IC 3,1(0,4) 43150 52983021 B WRIT37 GO THRU FURTHER TESTS 7882 52990021 WRIT09 DS 0H 7882 52997021 MVI XREG1,XX03 53004021 BAL RETRG,WRIS04 * LH 3,RCDLNGTH 53011021 TM RECMODE,STYPE SPANNED? 53018021 BC ONES,WRIT05B YES 53025021 TM RECMODE,VTYPE V TYPE RCD 53032021 BNO WRIT37 IF NOT VTYPE, GO TO WRIT37 53039021 WRIT05B DS 0H 53046021 MVI XREG1,XX03 53053021 MVI BDISP1,XX30 53060021 MVI BDISP1+NX1,XX04 53067021 BAL RETRG,LA * LA 3,4(3) 53074021 WRIT37 DS 0H 53081021 TM RECMODE,STYPE S? 53088021 BO WRIT07 YES. 53095021 TM DOP1+NX6,MAWO APPLY WRITE ONLY 53102021 BNZ WRIT08 YES 53109021 TM DOP1+NX10,XX08 SRA OR ADVANCING 53116021 BNZ WRIT08 YES 53123021 TM RECMODE,VTYPE V TYPE RCD 53130021 BO WRIT07 YES 53137021 BAL RETRG,GATXTC * A 3,76(1) 53144021 DC AL2(ATXT87-ATXTBC) * SH 3,82(1) 53151021 DC AL2(ZTXT87-ATXT87) * ST 3,76(1) 53158021 * * ST 3,72(1) 53165021 B WRIT06 GO TO WRIT06 53172021 WRIT08 DS 0H 53179021 BAL RETRG,GATXTC * STH 3,82(2) 53186021 DC AL2(ATXT105-ATXTBC) 53193021 DC AL2(ZTXT105-ATXT105) 53200021 B WRIT06 GO TO WRIT06 53207021 WRIT07 DS 0H 53214021 MVI XREG1,XX05 53221021 MVC BLREF1+NX1(LX1),DX4(RW2) 53228021 BAL RETRG,LOAD * L 5,BL#FILE 53235021 MVI XREG1,XX05 53242021 MVI XCON1+NX15,XX04 53249021 MVI XCON1+NX16,XX02 53256021 BAL RETRG,SHALF * SH 5,=H'4' 53263021 BAL RETRG,GATXTC PUT A TEXT 53270021 DC AL2(ATXT40-ATXTBC) * STC 3,1(5) 53277021 DC AL2(ZTXT40-ATXT40) * SRL 3,8 53284021 * * STC 3,0(5) 53291021 * * MVI 2(5),X'00' 53298021 * * MVI 3(5),X'00' 53305021 WRIT06 DS 0H 53312021 TM DOP1+NX6,XXF0 QSAM 53319021 BZ WRIT40 YES 53326021 WRIT06A DS 0H 43505 53333021 BAL RETRG,GATXTV IF NOT QSAM, PUT A TEXT 53340021 DC AL2(IOTXTG-ATXTBV) 53347021 DC AL2(IOTXTH-IOTXTG) 53354021 WRIT41 DS 0H QSAM RETURNS HERE 53361021 TM DOP1+NX6,XX10 QISAM... 1139 53368021 BZ WRIT31 NO 1139 53375021 BAL RETRG,GNSTEP BUMP GN COUNTER 1139 53382021 MVC GLGNCN+NX3(LX2),GNCTR SAVE FOR LATER GN DEF 1139 53389021 MVC IOTXTZZ2(LX2),GNCTR INSERT IN LOAD INSTRUCTION 1139 53396021 BAL RETRG,GATXTV * TM 81(2),X'C0' 1139 53403021 DC AL2(IOTXTZZ1-ATXTBV) * L 14,GN(NO BL'S) 1139 53410021 DC AL2(IOTXTZZ3-IOTXTZZ1) * BCR 7,14 1139 53417021 WRIT31 DS 0H 1139 53424021 TM DOP1+NX10,XX08 ADVANCING OR SAME RCD AREA 53431021 BC NOTZER,WRIT06B YES 53438021 TM DOP1+NX6,MAWO APPLY WRITE ONLY... 53445021 BC ZERO,WRIT29 NO, SKIP GATX41 53452021 WRIT06B EQU * 53459021 TM RECMODE,STYPE SPANNED? 53466021 BO WRIT29 IF SPANNED, GO TO WRIT29 53473021 TM RECMODE,VTYPE V TYPE RECORD 53480021 BC NOTONE,WRIT06D NO 53487021 BAL RETRG,GATXTC YES, 53494021 DC AL2(ATXT41-ATXTBC) * STH 3,0(1) 53501021 DC AL2(ZTXT41-ATXT41) * MVI 2(1),C' ' 53508021 * * MVI 3(1),C' ' 53515021 WRIT29 DS 0H 53522021 TM RECMODE,STYPE SPANNED? 53529021 BO WRIT290 IF SPANNNED, GO TO WRIT290 53536021 TM RECMODE,VTYPE V TYPE RECORDS 53543021 BNO WRIT06D NO 53550021 B WRIT29A BRANCH TO WRIT29A 53557021 WRIT290 TM DOP1+NX10,XX08 SRA? 53564021 BO REWREX YES; NO BL CHANGE - NO MOVE. 53571021 WRIT29A DS 0H 53578021 MVI BDISP1,XX10 53585021 MVI BDISP1+NX1,XX04 * LA 1,4(1) 53592021 MVI XREG1,XX01 53599021 BAL RETRG,LA PUT A TEXT LA INST 53606021 WRIT06D EQU * 53613021 TM DOP1+NX10,XX08 ADVANCING OR SAME RCD AREA 53620021 BZ WRIT30 NO 53627021 BAL RETRG,WRITMOVE GENERATE MOVE CODING 53634021 TM DOP1+NX6,MQISAM QISAM? 53641021 BO REWREX YES 53648021 B WRIT42 BRANCH TO WRIT42 53655021 WRIT30 DS 0H 48401 53662021 TM DOP1+NX6,XXF0 QSAM... 48401 53669021 BNZ WRIT10 NO 48401 53676021 MVC A07CH1(LX1),DOP1+NX5 INSERT DCB NUMBER 48401 53683021 BAL RETRG,GNSTEP BUMP GNCTR 48401 53690021 MVC GLGNCN+NX3(LX2),GNCTR 48401 53697021 MVC A07CH2(LX2),GNCTR INSERT GN NUMBER 48401 53704021 * * L 2,DCBADR 48401 53711021 BAL RETRG,GATXTV * TM 121(DCB),X'40' 48401 53718021 DC AL2(ATXT07-ATXTBV) * L 3,GN(IOERROR) 48401 53725021 DC AL2(ZTXT07-ATXT07) * MVI 121(DCB),X'00' 48401 53732021 * * BCR 1,3 48401 53739021 WRIT10 DS 0H 48401 53746021 LA RW2,DOP1 53753021 BAL RETRG,IOSTBL * ST 1,BL=FN FOR EACH BL 53760021 TM DOP1+NX6,XXF0 QSAM... 48401 53767021 BNZ WRIT11 NO 48401 53774021 BAL RETRG,GNOPT3 * GN(IOERROR) EQU * 48401 53781021 WRIT11 DS 0H 48401 53788021 TM DOP1+NX6,MAWO 53795021 BO WRIT25 IF YES, GO TO WRIT25 53802021 BAL RETRG,IOQRTN * Q-ROUTINE CALLS 53809021 B REWREX GO TO REWREX (RETURN TO PH5CTL) 53816021 * 53823021 * DEVELOP CODING FOR WRITE BISAM FILES 53830021 * 53837021 WRIT01 DS 0H 53844021 TM DOP1+NX6,MBISAM BISAM 53851021 BC NOTONE,WRIT24 NO 53858021 BAL RETRG,IOQRTN * Q-ROUTINE CALLS 53865021 BC UNCOND,WRIT25 MOVE ANALYZER IF NECESSARY 53872021 * POST-MOVE, SECOND STRING 53879021 WRBI00 EQU * 53886021 BAL RETRG,GATXTV PUT A TEXT 53893021 DC AL2(IOTXTA-ATXTBV) * L 3,DECBADR 53900021 DC AL2(IOTXTC-IOTXTA) * L 2,8(3) 53907021 TM DOP1+NX10,XX08 SAME RECORD AREA 53914021 BC NOTONE,WRBI00A NO 53921021 MVI XREG1,XX01 XXXX 53928021 MVI BDISP1,XX30 X 53935021 TM REWRSW,MSWON REWRITE 53942021 BC ONES,WRBI00B YES 53949021 MVI BDISP1+NX1,XX0C * L 1,12(3) 53956021 BAL RETRG,LOAD XXXX 53963021 MVI XREG1,XX01 XXXX 53970021 MVI XCON1+NX15,XX10 X 53977021 MVI XCON1+NX16,XX02 * AH 1,=H'16' 53984021 BAL RETRG,ADD XXXX 53991021 B WRBI00C SKIP AROUND 53998021 WRBI00B DS 0H 54005021 MVI BDISP1+NX1,XX10 54012021 BAL RETRG,LOAD * L 1,16(3) 54019021 WRBI00C DS 0H 54026021 BAL RETRG,WRITMOVE GENERATE MOVE CODING 54033021 WRBI00A EQU * 54040021 TM REWRSW,MSWON IS IT REWRITE 54047021 BC ZERO,WRBI10 NO 54054021 MVI IOTXIA+NX5,XX58 WRITE-KU DISPL 54061021 MVI ATXT70+NX2,XX08 WRITE-KU CODE FOR REWRITE DECB 54068021 BC UNCOND,WRBI15 GO TO WRBI15 54075021 WRBI10 EQU * 54082021 OI ANALSW,MSWON INDICATE A WRITE P6232 54089021 TM DOP1+NX10,XX08 SRA? 54096021 BO WRBI10A YES 54103021 SR RW2,RW2 PUT BL INTO ATEXT SLOT 54110021 IC RW2,DOP5+NX4 54117021 SRL RW2,DX4 54124021 STC RW2,ATX82B+NX4 54131021 MVC ATX82B+NX5(LX1),DOP5+NX6 54138021 BAL RETRG,GATXTC PUT A TEXT 54145021 DC AL2(ATXT82-ATXTBC) * L 5,12(3) 54152021 DC AL2(ZTXT82-ATXT82) * L 1,BL= 54159021 MVI XCON1+NX15,XX10 54166021 MVI XCON1+NX16,XX02 54173021 MVI XREG1,XX01 54180021 BAL RETRG,SHALF * SH 1,=16 (SET AREA AD 54187021 BAL RETRG,GATXTC = REC. AD.- 54194021 DC AL2(ATXT83-ATXTBC) 54201021 DC AL2(ZTXT83-ATXT83) * ST 1,12(3) 54208021 * 54215021 WRBI10A DS 0H 54222021 MVI ATXT70+NX2,XX04 WRITE KN CODE FOR WRITE 54229021 MVI IOTXIA+NX5,XX5C WRITE KN DISPL 54236021 WRBI15 DS 0H 58971 54243021 BAL RETRG,INVCK INVALID KEY CODED... 58971 54250021 BC NOTEQ,WRBI15A IF NOT, GO TO WRBI15A 54257021 BAL RETRG,INVKEY YES 54264021 WRBI15A BAL RETRG,GATXTV IT 54271021 DC AL2(ATXT70-ATXTBV) * MVI 5(3),CODE 54278021 DC AL2(ZTXT70-ATXT70) 54285021 BAL RETRG,BISMRDWT GEN WRITE/CHECK INSTRS. 54292021 B REWREX EXIT FROM ROUTINE 54299021 * 54306021 * DEVELOP CODING FOR WRITE BDAM FILES 54313021 * 54320021 WRIT24 EQU * 54327021 TM DOP1+NX6,MBDAM BDAM 54334021 BC NOTONE,WRIT16 NO 54341021 CLC DOP4(LX2),ONZERO IS MOVE EXPECTED... 54348021 BE WRIT34 NO 54355021 BAL RETRG,IOQRTN CALL QRTNS 54362021 B DON RETURN TO PHASE 5 CONTROL 54369021 SPACE 3 54376021 WRIT34 NI WRITSW,MSWOFF NO, OR COMPLETED 54383021 MVI IOTXTC+NX2,XX02 DECTYPE CODE FOR WRITE 54390021 TM REWRSW,MSWON X'42' FOR REWRITE 54397021 BC ZERO,REWR07 X'44' FOR REL TRK 54404021 MVI IOTXTC+NX2,XX04 DECTYPE CODE FOR REL TRK REWRITE 54411021 TM DOP1+NX6,XX04 54418021 BC ONES,REWR07 SKIP NEXT INST 54425021 MVI IOTXTC+NX2,XX00 DECTYPE CODE FOR REL RCD REWRITE 54432021 REWR07 DS 0H 54439021 TM RECMODE,UTYPE U TYPE RECORD? 54446021 BO REWR07A YES 54453021 OI IOTXTC+NX2,XX40 SET 'S' FOR F/V RCD WRITE/REWRITE 54460021 REWR07A DS 0H 54467021 BAL RETRG,GATXTV PUT A TEXT 54474021 DC AL2(IOTXTA-ATXTBV) 54481021 DC AL2(IOTXTC-IOTXTA) * L 3,DECBADR 54488021 * * L 2,8(3) 54495021 TM DX6(RW2),XX04 DIRECT 54502021 BO REWR07C YES 54509021 BAL RETRG,GATXTC * L 1,20(3) 54516021 DC AL2(ATXT109-ATXTBC) * MVC 28(4,3),0(1) 54523021 DC AL2(ZTXT109-ATXT109) 54530021 B REWR07D GO TO REWR07D 54537021 SPACE 2 54544021 REWR07C DS 0H 54551021 BAL RETRG,BDAMDW * LA 1,ACT-KEY+4 54558021 * * ST 1,20(3) 54565021 * * MVC 28(4,3),ACT-KEY 54572021 TM REWRSW,MSWON REWRITE? 54579021 BO REWR08 YES 54586021 TM DOP1+NX6,XX08 BDAM 'D' 54593021 BNO REWR08 NO 54600021 MVC IOTXTDD1+NX2(LX1),IOTXTC+NX2 CODE=WRITE-ADD 54607021 XI IOTXTDD1+NX2,XX06 CODE=WRITE-UPDATE 54614021 MVC IOTXTDD2+NX7(LX3),DOP1+NX11 ACT-KEY IDK 54621021 SR RW4,RW4 54628021 IC RW4,DOP1+NX14 KEY LENGTH 54635021 LA RW4,DX3(RW4) 54642021 STC RW4,IOTXTDD2+NX2 KL+4 54649021 BAL RETRG,GNSTEP INCREMENT GN CTR 54656021 MVC IOTXTDD3(LX2),GNCTR 54663021 MVC GLGNCN+NX3(LX2),GNCTR 54670021 BAL RETRG,GNSTEP INCREMENT GN COUNTER 54677021 MVC IOTXTDD4(LX2),GNCTR MOVE GN NUMBER 54684021 BAL RETRG,GATXTV * TM 5(3),X'08' 54691021 DC AL2(IOTXTDD-ATXTBV) * L 5,GN 54698021 DC AL2(IOTXTEE-IOTXTDD) * BCR NOTONE,5 54705021 * * L 1,36(3) 54712021 * * MVI 5(3),WRITE-UPDATE-CO 54719021 * * CLC 0(KL+4,1),ACT-KEY 54726021 * * L 5,GN2 54733021 * * BCR EQ,5 54740021 BAL RETRG,GNOPT3 GNDEF 54747021 REWR07D DS 0H 54754021 TM CPFLAG,XX02 CHECKPOINT WRITE... 45673 54761021 BZ REWR08 NO 45673 54768021 L GVERB,ADCN72 54775021 USING WRITCHCK,GVERB 54782021 B CPBOTH GO TO CPBOTH IN CHECKPINT READ 54789021 USING WRITE,GVERB 54796021 * CHECKPOINT BDAM-D WRITE ENTERS HERE 54803021 REWR08 EQU * 54810021 BAL RETRG,GATXTV * MVI 5(3),WRITE-ADD-CODE 54817021 DC AL2(IOTXTC-ATXTBV) 54824021 DC AL2(IOTXTD-IOTXTC) 54831021 TM REWRSW,MSWON REWRITE... 54838021 BO REWR07E YES 54845021 TM DOP1+NX6,XX08 BDAM-D? 54852021 BNO REWR07E NO, SKIP GN DEF 54859021 MVC GLGNCN+NX3(LX2),IOTXTDD4 54866021 BAL RETRG,GNOPT3 GN2DEF 54873021 REWR07E DS 0H 54880021 BAL RETRG,INVCK INVALID KEY CODED... 58971 54887021 BNE REWR07B NO INVALID KEY 54894021 BAL RETRG,INVKEY YES 54901021 REWR07B DS 0H 54908021 TM RECMODE,UTYPE 54915021 BC ONES,WRIT17 YES 54922021 TM RECMODE,STYPE SPANNED? 54929021 BC ONES,REWR07F YES 54936021 TM RECMODE,VTYPE 54943021 BC NOTONE,WRIT22 IF NOT VTYPE, GO TO WRIT22 54950021 REWR07F DS 0H 54957021 MVI XREG1,XX01 54964021 BAL RETRG,WRIS04 * L 1,RCDLNGTH 54971021 BAL RETRG,GATXTV PUT A TEXT 54978021 DC AL2(IOTXTL-ATXTBV) 54985021 DC AL2(IOTXTM-IOTXTL) 54992021 BC UNCOND,WRIT22 GO TO WRIT22 54999021 SPACE 2 55006021 WRIT17 DS 0H 55013021 MVI XREG1,XX01 55020021 BAL RETRG,WRIS04 * L 1,RCDLNGTH 55027021 BAL RETRG,GATXTC * STH 1,6(4) 55034021 DC AL2(ATXT86-ATXTBC) 55041021 DC AL2(ZTXT86-ATXT86) 55048021 WRIT22 BAL RETRG,GATXTV PUT A TEXT 55055021 DC AL2(IOTXTI-ATXTBV) 55062021 DC AL2(IOTXTJ-IOTXTI) 55069021 BAL RETRG,WRKLRX DESTROY 14, 15 55076021 B REWREX GO TO REWREX 55083021 * 55090021 * BSAM BY DEFAULT 55097021 * 55104021 WRIT16 CLC DOP4(LX2),ONZERO IS MOVE EXPECTED... 55111021 BE WRIT35 NO 55118021 BAL RETRG,IOQRTN CALL QRTNS 55125021 B DON RETURN PHASE 5 CONTROL 55132021 SPACE 3 55139021 WRIT35 NI WRITSW,MSWOFF NO, OR COMPLETED 55146021 TM RECMODE,VTYPE+UTYPE+STYPE 55153021 BC ZERO,WRIT35AA GO TO WRIT35AA 55160021 MVI XREG1,XX02 55167021 BAL RETRG,WRIS04 * L 2,RCD-LNG 55174021 WRIT35AA LA RW2,DOP1 55181021 BAL RETRG,IOBS01 GENERATE CALLING SEQ TO 'BSAMRT' 55188021 BC UNCOND,REWREX GO TO REWREX FOR EXIT 55195021 SPACE 2 55202021 WRIT02 NI WRSW01,MSWOFF INDICATE PATH THRU WRIT03 SEQUEN 55209021 BC UNCOND,WRIT03 GO TO WRIT03 55216021 SPACE 2 55223021 WRIT04 BAL RETRG,WRIS05 * MVC RN(1),DN+LENGTH-1 55230021 BC UNCON,WRIT20 GO TO WRIT20 55237021 * THESE ROUTINES DEVELOP A-TEXT FOR THE 55244021 * MORE INVOLVED GENERATED INSTRUCTIONS. 55251021 WRIS01 ST RETRG,SVWJHE COMMON SAVER 55258021 SR RETRG,RETRG 55265021 IC RETRG,DOP3+NX4 DETERMINE CARRIAGE CONTROL CHARACTER 55272021 SRL RETRG,DX4 55279021 LA RETRG,WRISC1(RETRG) 55286021 MVC IMM(LX1),DX0(RETRG) 55293021 LA RETRG,DOP5 55300021 ST RETRG,OP1 55307021 BAL RETRG,MVI * MVI RCD-NAME,X'C-C' 55314021 L RETRG,SVWJHE 55321021 BCR UNCON,RETRG GO TO CALLER 55328021 WRIS02 ST RETRG,SVWJHE 55335021 MVC IOTXTAA1(LX1),DOP1+NX5 DCB NO. 55342021 BAL RETRG,GATXTV PUT A TEXT 55349021 DC AL2(IOTXTAA-ATXTBV) * L 1,DCBADR 55356021 DC AL2(IOTXTBB-IOTXTAA) * LR 2,1 55363021 TM REWRSW,MSWON REWRITE... 49529 55370021 BO WRIS02A YES 49529 55377021 BAL RETRG,TSTEOP TEST FOR GEN CODE 55384021 BC NOTEQ,WRIS02A IF NOT GO TO WRIS02A 55391021 TM DOP1+NX6,MAWO AWO 55398021 BO WRIS02C YES 55405021 TM DOP1+NX10,XX08 SRA OR ADVANCING 55412021 BZ WRIS02B NO 55419021 WRIS02C DS 0H 55426021 MVI XCON1+NX12,XX40 55433021 MVI XCON1+NX16,XX04 55440021 MVI XREG1,XX02 55447021 BAL RETRG,ORLG * O 2,=X'40000000' 55454021 * SIGNA L TO ILBOPTV FOR SPECIAL TREATMENT 55461021 WRIS02B DS 0H 55468021 LA RW3,PTOVCON1 55475021 BAL RETRG,VBALRE GEN BRANCH TO ILBOPTV1 55482021 BAL RETRG,WRKLRX DESTROY 14, 15 55489021 WRIS02A EQU * 55496021 L RETRG,SVWJHE 55503021 BCR UNCOND,RETRG RETURN TO CALLER 55510021 WRIS04 STM RETRG,RW4,SVWJHE 55517021 B WRS044 EXIT FROM ROUTINE 44682 55524021 BNZ WRS044 NO 55531021 TM DOP1+NX6,MAWO APPLY WRITE ONLY? 55538021 BNO WRS044 NO 55545021 LA RW2,DOP5 POINT TO RN 55552021 MVC DOP2+NX30(LX1),XREG1 SAVE XREG1 55559021 BAL RETRG,CALCLG GET LENGTH OR VLC 55566021 B WRS044 NOT A PROPER ITEM 55573021 TM LENGTH,XX80 ODO? 55580021 BNO WRS044 NO SKIP SPECIAL PROCESSING 55587021 MVC XCNTR1+NX1(LX2),LENGTH+NX2 VLC NUMBER 55594021 MVI XCNTR1,XX04 55601021 LA RW2,DOP4 POINT TO DN 55608021 BAL RETRG,CALCLG GET VLC NUMBER FOR DN 55615021 B WRS044 NOT A PROPER ITEM 55622021 TM LENGTH,XX80 ODO? 55629021 BNO WRS047 NO, MUST BE A CONSTANT 55636021 MVC XCNTR2+NX1(LX2),LENGTH+NX2 VLC NUMBER 55643021 MVI XCNTR2,XX04 55650021 B WRS048 GO TO WRS048 55657021 SPACE 2 55664021 WRS047 DS 0H 55671021 MVC XCON2+NX14(LX2),LENGTH+NX2 LENGTH IS CONSTANT 55678021 MVI XCON2+NX16,XX02 LENGTH OF CONSTANT IS 2 55685021 WRS048 DS 0H 55692021 MVI XL1+NX1,XX02 LENGTH OF RECEIVING FIELD IS 2 55699021 BAL RETRG,MVC * MVC VLC-FOR-FILE,CONSTANT 55706021 * OR * MVC VLC-FOR-FILE,VLC-FOR-DN 55713021 MVC XREG1,DOP2+NX30 RESTORE XREG1 55720021 WRS044 DS 0H 55727021 LA RW2,DOP5 POINTER TO RECORD, ASSUMED VL 55734021 BAL RETRG,CALCLG OBTAIN LENGTH VLC 55741021 BC UNCOND,WRS041 NOT PROPER ITEM, BYPASS 55748021 TM LENGTH,XX80 IS THIS PARTICULAR REC VL... 55755021 BC ZERO,WRS042 NO 55762021 MVC XCNTR1+NX1(LX2),LENGTH+NX2 VLC NUMBER 55769021 MVI XCNTR1,XX04 55776021 WRS043 EQU * * LH 0,LIT=LENGTH ... OR . 55783021 BAL RETRG,LOAD * L 0,VLC=RECORD 55790021 WRS041 LM RETRG,RW4,SVWJHE 55797021 BCR UNCON,RETRG RETURN TO CALLER 55804021 WRS042 MVC XCON1+NX14(LX2),LENGTH+NX2 55811021 MVI XCON1+NX16,XX02 55818021 BC UNCOND,WRS043 GO TO WRS04 55825021 SPACE 2 55832021 WRIS05 STM RETRG,RW2,SVWJHE 55839021 MVI XL1+NX1,XX01 55846021 LA RW2,DOP5 55853021 ST RW2,OP1 55860021 LA RW2,DOP3 55867021 ST RW2,OP2 55874021 BAL RETRG,CALCLG GET LENGTH OF DN IN DOP3 55881021 BC UNCOND,WRIT19 IMPOSSIBLE 55888021 WRIT19 L RW2,LENGTH GET DISPL OF LOW ORDER 55895021 BCTR RW2,RW0 BYTE OF DN 55902021 ST RW2,GTEMP 55909021 MVC PLUS2(LX3),GTEMP+NX1 55916021 BAL RETRG,MVC * MVC RN(1),DN+LENGTH-1 55923021 LM RETRG,RW2,SVWJHE 55930021 BCR UNCON,RETRG RETURN TO CALLER 55937021 REWR01 DS 0H 55944021 * ***************************************** 55951021 * * QSAM/QISAM REWRITE WITH SRA * 55958021 * ***************************************** 55965021 * 55972021 TM DOP1+NX10,XX08 SRA... 49529 55979021 BZ REWR04 NO 49529 55986021 TM DOP1+NX6,XXF0 QSAM ? (TO REWRITE WSAM RECORD) 55993021 BNZ REWR02 NO, GO TO REWR02 56000021 BAL RETRG,GATXTC * L 1,76(1) DCBRECAD 56007021 DC AL2(ATXT116-ATXTBC) 56014021 DC AL2(ZTXT116-ATXT116) 56021021 TM RECMODE,VTYPE VARIABLE TYPE RECORD OF QSAM ? 56028021 BNO REWR03 NO, GO TO REWR03 56035021 BAL RETRG,GATXTV * LA 1,4(1) ACTUAL RECAD 56042021 DC AL2(IOTXTL1-ATXTBV) 56049021 DC AL2(IOTXTL2-IOTXTL1) 56056021 B REWR03 GO TO REWR03 56063021 SPACE 2 56070021 REWR02 DS 0H TO REWRITE QISAM RECORD 56077021 BAL RETRG,GATXTC * L 3,228(1) POINTER TO WA 56084021 DC AL2(ATXT117-ATXTBC) * L 1,112(3) DCBDBUFN 56091021 DC AL2(ZTXT117-ATXT117) 56098021 REWR03 DS 0H PLUG IN UPDATED RECORD IN BUFFER 56105021 BAL RETRG,WRITMOVE FOR QISAM AND QSAM REWRITE 56112021 *DEL 4952 56119021 *DEL 4952 56126021 *DEL 4952 56133021 BAL RETRG,WRIS02 LOAD DCB ADRESS 49529 56140021 REWR04 DS 0H 49529 56147021 BAL RETRG,GATXTC PUT A TEXT 56154021 DC AL2(ATXT72-ATXTBC) * L 15,48(1) 56161021 DC AL2(ZTXT72-ATXT72) * BAL 14,4(15) 56168021 REWREX DS 0H 56175021 TM REWRSW,MSWON REWRITE... 56182021 BZ REWREX3 NO 56189021 NI REWRSW,MSWOFF YES, TURN OFF REWRITE SWITCH 56196021 B REWREX2 BYPASS GN CODING 56203021 REWREX3 DS 0H 56210021 TM DOP1+NX6,XX10 QISAM... 1139 56217021 BZ REWREX2 NO 1139 56224021 BAL RETRG,GNOPT3 * GN(NO BL'S) EQU * 1139 56231021 REWREX2 DS 0H 1139 56238021 MVI A48CH2,MFREE 56245021 BAL RETRG,REGMAC PUT A TEXT FOR MACRO 56252021 BAL RETRG,ISINVK INVALID KEY ??? 56259021 BC NOTEQ,REWREX1 IF NOT INVALID KEY 56266021 BAL RETRG,ENDINVKY IF INVALID, PUT A TEXT 56273021 REWREX1 EQU * 56280021 BAL RETRG,TSTEOP TEST FOR GN-CODE 56287021 BC NOTEQ,DON NO 56294021 MVC XGN1(LX2),DX1(RW5) YES 56301021 BAL RETRG,LOAD * L 0,GN-EOP 56308021 MVI XREG1,XX01 56315021 MVC XGN1(LX2),DOP2+NX1 56322021 BAL RETRG,LOAD * L 1,GN-NOT-EOP 56329021 LA RW3,PTOVCON2 56336021 BAL RETRG,VBALRE VBALRE XXXXX 56343021 BAL RETRG,WRKLRX DESTROY 14, 15 56350021 BC UNCOND,DON *** LEAVE REWRITE *** 56357021 WRIT25 EQU * APPLY WRITE ONLY 56364021 CLC DOP4(LX2),ONZERO MOVE EXPECTED... 56371021 BC NOTEQ,DON YES, GO PROCESS MOVE 56378021 WRIT26 NI WRITSW,MSWOFF NO, CONTINUE 56385021 BAL RETRG,WRKLRG KILL 0-5, 14, 15 56392021 TM DOP1+NX6,MNOQQI QSAM OR QISAM... 56399021 BC NOTZER,WRIT33 NO 56406021 TM DOP1+NX6,XX02 APPLY WRITE ONLY... 56413021 BC ZERO,WRIT21 NO 56420021 CLI DOP3,MRGN APPLY WRITE ONLY, AFTER POSI 56427021 BE WRIT42 NO 56434021 CLI DOP3,MDN AWO, AFTER POSITIONING DN 56441021 BC EQ,WRIT28 YES 56448021 BAL RETRG,WRIS01 * MVI RN,C'N' 56455021 B WRIT42 BRANCH TO WRIT42 TO PUT A TEXT 56462021 WRIT28 BAL RETRG,WRIS05 * MVC RN(1),DN+LENGTH-1 56469021 B WRIT42 BRANCH TO WRIT42 TO PUT A TEXT 56476021 WRIT33 TM DOP1+NX6,MBISAM 56483021 BC ONES,WRBI00 BISAM 2ND STRING 56490021 TM DOP1+NX6,MBDAM 56497021 BC ONES,WRIT34 B D A M SECOND STRING 56504021 BC UNCOND,WRIT35 B S A M SECOND STRING 56511021 WRIT40 DS 0H 56518021 MVC IOTXTAA1(LX1),DOP1+NX5 DCB NUMBER 56525021 BAL RETRG,GATXTV * 56532021 DC AL2(IOTXTAA-ATXTBV) * L R1,DCBADR 56539021 DC AL2(IOTXTAB-IOTXTAA) * 56546021 WRIT40A DS 0H 43505 56553021 BAL RETRG,GATXTC * L 15,48(1) 56560021 DC AL2(ATXT107-ATXTBC) * EX 0,96(1) 56567021 DC AL2(ZTXT107-ATXT107) 56574021 B WRIT41 RETURN TO INLINE CODE 56581021 WRIT42 DS 0H 56588021 BAL RETRG,GATXTV PUT A TEXT 56595021 DC AL2(IOTXTAA-ATXTBV) 56602021 DC AL2(IOTXTBB-IOTXTAA) 56609021 BAL RETRG,GATXTC PUT A TEXT 56616021 DC AL2(ATXT118-ATXTBC) 56623021 DC AL2(ZTXT118-ATXT118) 56630021 B REWREX GO TO REWREX 56637021 TSTEOP EQU * 56644021 SR RW5,RW5 56651021 IC RW5,DOP5+NX1 56658021 LA RW5,DOP5-NX1(RW5) 56665021 CLI DX0(RW5),MRGN 56672021 BCR UNCOND,RETRG RETURN TO CALLER 56679021 SPACE 2 56686021 MSUB2 TM DOP1+NX2,XX80 BEFORE OPTION 56693021 BC ZERO,MSUB2A NO,AFTER OPTION 56700021 LA RW2,DX4(RW2) POINT TO SECOND HALF OF TABLE 56707021 MSUB2A LA RW2,CCTABLE(RW2) 56714021 MVC IMM(LX1),DX0(RW2) 56721021 LA RW2,DOP5 56728021 ST RW2,OP1 56735021 BAL RETRG,MVI ** MVI RN,CODE ** 56742021 BC UNCOND,MWRIT03 GO TO MWRIT03 56749021 SPACE 3 48426 56756021 WRIT13 DS 0H 48426 56763021 SPACE 1 48426 56770021 * 48426 56777021 * ROUTINE TO HANDLE APPLY WRITE-ONLY AND POSITIONING 48426 56784021 * 48426 56791021 SPACE 1 48426 56798021 TM WRITSW,MSWON 2ND ENTRY 48426 56805021 BO WRIT14 YES 48426 56812021 OI WRITSW,MSWON INDICATE FIRST TIME ENTRY 48426 56819021 BAL RETRG,WRIS02 LOAD DCB ADDR, CALL PTV1 48426 56826021 MVI XREG1,XX03 INDICATE REG 3 48426 56833021 BAL RETRG,WRIS04 INSERTION OF LENGTH 48426 56840021 BAL RETRG,GATXTC * 48426 56847021 DC AL2(ATXT104-ATXTBC) * LA 3,4(3) 48426 56854021 DC AL2(ZTXT105-ATXT104) * STH 3,82(2) 48426 56861021 BAL RETRG,GATXTC * 48426 56868021 DC AL2(ATXT107-ATXTBC) * GENERATE PUT SEQUENCE 48426 56875021 DC AL2(ZTXT107-ATXT107) * 48426 56882021 MVI BDISP1,XX10 48426 56889021 MVI BDISP1+NX1,XX04 48426 56896021 MVI XREG1,XX01 48426 56903021 BAL RETRG,LA * LA 1,4(1) 48426 56910021 MVC A07CH1(LX1),DOP1+NX5 INSERT DCB NUMBER 48426 56917021 BAL RETRG,GNSTEP BUMP GNCTR 48426 56924021 MVC GLGNCN+NX3(LX2),GNCTR INSERT AND SAVE 48426 56931021 MVC A07CH2(LX2),GNCTR GN NUMBER 48426 56938021 BAL RETRG,GATXTV * 48426 56945021 DC AL2(ATXT07-ATXTBV) * GENERATE ERROR TEST 48426 56952021 DC AL2(ZTXT07-ATXT07) * 48426 56959021 BAL RETRG,IOSTBL BL UPDATE 48426 56966021 BAL RETRG,GNOPT3 * GN(IOERROR) EQU * 48426 56973021 MVI XREG1,XX01 48426 56980021 MVC BLREF1+NX1(LX1),DX4(RW2) 48426 56987021 BAL RETRG,LOAD * L 1,BL-FILE 48426 56994021 MVI XREG1,XX01 48426 57001021 MVI XCON1+NX15,XX04 48426 57008021 MVI XCON1+NX16,XX02 48426 57015021 BAL RETRG,SHALF * SH 1,=H'4' 48426 57022021 BAL RETRG,GATXTC * 48426 57029021 DC AL2(ATXT41-ATXTBC) * SETUP RDW FOR PUT 48426 57036021 DC AL2(ZTXT42-ATXT41) * 48426 57043021 CLC DOP4(LX2),ONZERO MOVE EXPECTED... 48426 57050021 BNE PH5CTL YES, DO SO 48426 57057021 SPACE 3 48426 57064021 WRIT14 DS 0H 48426 57071021 SPACE 1 48426 57078021 * 48426 57085021 * SECOND STRING FOR APPLY WRITE-ONLY AND POSITIONING 48426 57092021 * 48426 57099021 SPACE 1 48426 57106021 NI WRITSW,MSWOFF TURN OFF SWITCH 48426 57113021 BAL RETRG,WRKLRG * DESTROY 14,15 48426 57120021 CLI DOP3,MDN DATANAME POSITIONING... 48426 57127021 BNE WRIT18 NO, MUST BE INTEGER 48426 57134021 BAL RETRG,WRIS05 * MVC RECORD(1),DN+LEN-1 48426 57141021 B WRIT27 COMMON CODE 48426 57148021 WRIT18 DS 0H 48426 57155021 BAL RETRG,WRIS01 * MVI RECORD,X'C-C' 48426 57162021 WRIT27 DS 0H 48426 57169021 BAL RETRG,IOQRTN Q-ROUTINES 48426 57176021 B REWREX1 EXIT CODING, LEAVE ROUTINE 48426 57183021 INTEGER DS F 57190021 ZAPMM ZAP DWB,DOP3+NX4(LX0) 57197021 CCTABLE DC C'+ 0-' AFTER OPTION 57204021 DC X'01091119' BEFORE OPTION 57211021 MNCTABLE DC C'+123456789' AFTER OPTION 57218021 DC X'C1C2C3E5E6' * 57225021 DC X'01899199A1A9B1B9C1C9D1D9E1E5E6' BEFORE OPTION 57232021 OPTNBYTE DS XL1 57239021 DC X'00' 57246021 VTYPE EQU X'08' 57253021 FTYPE EQU X'04' 57260021 UTYPE EQU X'02' 57267021 STYPE EQU X'01' 57274021 CSPSUBST DC X'320301000F' 57281021 B ZAPZAP ZAPZAP 57288021 B ZAPZAP2 ZAPZAP2 57295021 TITLE 'ACCEPT VERB ANALYZER A C C E P T' 57302021 *=1 ACCEPT VERB ACCEPT DN DEVICE HTERM 57309021 ******************************************************************* 57316021 * A C C E P T 57323021 ******************************************************************* 57330021 * INPUT STRINGS... ACCEPT 03 DN DEVICE END 57337021 * OR... ACCEPT 02 DN END 57344021 * (LATTER CASE, DEVICE = CONSOLE) 57351021 ACCEPT EQU * OR ACCEPT DN HTERM (DEV=CONSO 57358021 USING *,GVERB 57365021 CLC DOP2(LX2),CBCNSL CONSOLE... 57372021 BC NOTEQ,ACCE04 NO 57379021 ACCE05 LA RW2,DOP1 YES 57386021 ST RW2,OP1 PRE-PAD ITEM TO BE ACCEPTED INTO 57393021 MVI IMM,XX40 57400021 BAL RETRG,MVI * MVI DN,X' ' 57407021 BAL RETRG,CALCLG GET LENGTH OF ITEM 57414021 NOP DX0(RW0) NULL OPERATION 57421021 LH RETRG,LENGTH+NX2 57428021 BCTR RETRG,RW0 LENGTH + 2 - 1 57435021 LTR RETRG,RETRG IF LENGTH = 1 PADDING IS COMPLET 57442021 BC EQ,ACCE07 YES 57449021 STC RETRG,XL1+NX1 57456021 ST RW2,OP1 57463021 ST RW2,OP2 57470021 MVI PLUS1+NX2,XX01 57477021 BAL RETRG,MVC * MVC DN+1(L-1),DN 57484021 ACCE07 BAL RETRG,DIWTOR * WTOR 57491021 * * WAIT 57498021 BC UNCOND,ACCE06 BYPASS CONSOLE CODING 57505021 ACCE04 CLC DOP2(LX2),CBEND CONSOLE IMPLIED... 57512021 BC EQ,ACCE05 YES 57519021 * NO 57526021 LA RW3,ACCPVI * L 15,VIRT='ACCPRT' 57533021 BAL RETRG,VBALR1 * BALR 1,15 57540021 MVI XCON1+NX2,MSYSIN 57547021 MVI XCON1,XX02 57554021 MVI GMCTYP,MDC 57561021 BAL RETRG,MACRO * DC XL2'DEVICE' 57568021 LA RW2,DOP1 POINTER TO DN 57575021 BAL RETRG,DIINFO * DC XL10'OPERAND-INFO' 57582021 ACCE06 DS 0H 51302 57589021 TM DX7(RW2),XX02 GENERATE CALL TO Q-RTNS 51302 57596021 BZ PH5CTL NO 51302 57603021 BAL XRSUB,LSPRO YES 51302 57610021 B PH5CTL RETURN 51302 57617021 *DEL 5130 57624021 *DEL 5130 57631021 TITLE ' Q - R O U T I N E V E R B S ' 57638021 IKF50L CSECT 57645021 *=1 Q-ROUTINE VERBS... INIT, INCRA, STEP, UPDATE, QCALL, QRET,Q 57652021 USING *,GVERB 57659021 QINITV DS 0H I N I T ... 57666021 MVI XREG1,QR INDICATE REGISTER 1 57673021 MVC XCON1+NX14(LX2),DOP2+NX1 57680021 MVI XCON1+NX16,XX02 57687021 BAL RETRG,LOAD * LH R,LIT=... (DOP2) 57694021 MVC XCNTR1(LX3),DOP1+NX1 57701021 MVI XREG1,QR 57708021 BAL RETRG,STORE * STH R,VLC=... (DOP1) 57715021 B PH5CTL RETURN FOR NEXT STRING 57722021 USING *,GVERB 57729021 QINCRA DS 0H I N C R A ... 57736021 MVI XREG1,QR 57743021 MVC OP1(LX4),XAOPE1 57750021 BAL RETRG,LA * LA R,ON=... (DOP1) 57757021 MVI XREG1,QR 57764021 MVC XCNTR1(LX3),DOP2+NX1 57771021 BAL RETRG,ADD * AH R,VLC=... (DOP2) 57778021 MVI XREG1,QR 57785021 MVC BLREF1(LX2),DOP3+NX2 57792021 BAL RETRG,STORE * ST R,SBL=... (DOP3) 57799021 CLI DOP4+NX2,XX00 MORE THAN ONE SBL? 475 57806021 BE PH5CTL NO, RETURN FOR NEXT STRING 4758 57813021 SR RW1,RW1 YES, GEN INSTR'S FOR EACH ONE 4758 57820021 IC RW1,DOP3+NX3 GET SBL NUMBER 475 57827021 SR RW2,RW2 4758 57834021 IC RW2,DOP4+NX2 GET SBL COUNT 475 57841021 QINCR1 DS 0H 4758 57848021 LA RW1,DX1(RW1) INCREASE SBL NUMBER 4758 57855021 STC RW1,SBLOP+NX1 SAVE FOR STORE INSTR 475 57862021 MVI XCON1+NX14,XX10 475 57869021 MVI XCON1+NX16,XX02 475 57876021 MVI XREG1,QR 4758 57883021 BAL RETRG,ADD AH QR,=4096 4758 57890021 MVI XREG1,QR 4758 57897021 MVC BLREF1(LX2),SBLOP 475 57904021 BAL RETRG,STORE ST QR,SBL=... 4758 57911021 BCT RW2,QINCR1 LOOP CONTROL 4758 57918021 B PH5CTL RETURN FOR NEXT STRING 57925021 USING *,GVERB 57932021 QSTEPV DS 0H S T E P ... 57939021 MVI XREG1,QR 57946021 MVC XCNTR1(LX3),DOP1+NX1 57953021 BAL RETRG,LOAD * LH R,VLC... (DOP1) 57960021 MVI XREG1,QR 57967021 CLI DOP2,XXBB 57974021 BE QESTP BYPASS AH AND STH INSTRS 57981021 MVC XCNTR1(LX3),DOP2+NX1 57988021 QESTP2 DS 0H 57995021 BAL RETRG,ADD * AH R,VLC... OR LIT... (D 58002021 MVI XREG1,QR 58009021 MVC XCNTR1(LX3),DOP1+NX1 58016021 BAL RETRG,STORE * STH R,VLC... (DOP1) 58023021 B PH5CTL RETURN FOR NEXT STRING 58030021 QESTP DS 0H 58037021 MVC XCON1+NX14(LX2),DOP2+NX1 58044021 MVI XCON1+NX16,XX04 58051021 B QESTP2 GO TO QESTP2 58058021 * UPDATE VERB 58065021 USING *,GVERB 58072021 QUPDAT DS 0H U P D A T E ... 58079021 CLI DOP2,XX30 IS ITEM A DATA NAME 58086021 BNE QUPD3 NO 58093021 TM DOP2+NX2,XX04 IS ITEM IN WORKING-STORAGE 58100021 BO QUPD4 YES, DO NOT GEN LA, TM 58107021 QUPD3 DS 0H 58114021 CLC DOP1+NX1(LX2),GZERO IS MAX OCCURS SIGNIFICANT... 58121021 BE QUPD4 NO 58128021 MVC XCON1+NX14(LX2),DOP1+NX1 58135021 MVI XCON1+NX16,XX02 58142021 MVI XREG1,XX01 58149021 BAL RETRG,LH * LH 1,LIT=MAX REC SIZE 58156021 BAL RETRG,GNSTEP BUMP GN COUNTER 58163021 MVC A51CH2(LX2),FIVEGN 58170021 MVC GNSTRE(LX2),FIVEGN SAVE GN 58177021 BAL RETRG,GATXTV * TM SWITCH+1,X'01' 58184021 DC AL2(ATXT51-ATXTBV) * L 15,GN(MAX-REC-SIZE) 58191021 DC AL2(ZTXT51-ATXT51) * BCR 1,15 58198021 QUPD4 DS 0H 58205021 MVC QRETGN(LX2),DOP1+NX1 SAVE DOP1 58212021 MVI XREG1,QR 58219021 CLI DOP2,XX30 ON 58226021 BE QEDN1 IF SAME GO TO QEDN1 58233021 MVC XCNTR1(LX3),DOP2+NX1 58240021 BAL RETRG,LOAD * LH R,VLC... OR DN... (DOP 58247021 QEDN4 DS 0H 58254021 CLC QRETGN(LX2),GZERO WAS REF TO GNX GENERATED 58261021 BE QUPD5 NO 58268021 CLI DOP2,XX30 IS ITEM A DATA NAME 58275021 BNE QUPD6 NO 58282021 TM DOP2+NX2,XX04 IS ITEM IN WORKING-STORAGE 58289021 BO QUPD5 YES, DO NOT GEN GN DEF 58296021 QUPD6 DS 0H 58303021 MVC GLGNCN+NX3(LX2),GNSTRE RESTORE GN DATA 58310021 BAL RETRG,GNOPT3 * GNXXXX EQU * 58317021 QUPD5 DS 0H 58324021 MVI XREG1,QR 58331021 CLI DOP3,XXBB 58338021 BE QUPD1 IF SAME GO TO QUPD1 58345021 MVC XCNTR1(LX3),DOP3+NX1 58352021 QUPD2 DS 0H 58359021 BAL RETRG,MULT * MH R,LIT... OR VLC... (DO 58366021 MVI XREG1,QR 58373021 MVC OP1(LX4),XAOPE4 58380021 BAL RETRG,ADD * AH R,VLC... (DOP 58387021 MVI XREG1,QR 58394021 MVC XCNTR1(LX3),DOP4+NX1 58401021 BAL RETRG,STORE * STH R,VLC... (DOP 58408021 TM QRETSW,XX02 WAS STM GENED... 9030 58415021 BZ QEDN3 NO 9030 58422021 BAL RETRG,GNSTEP YES, BUMP GN CTR 9030 58429021 MVC A51CH2(LX2),FIVEGN INSERT GN NUMBER 9030 58436021 MVC GNLMSV(LX2),FIVEGN SAVE GN NUMBER 9030 58443021 MVI ATXT51A+NX8,XXFF INDIC COND OF 15 9030 58450021 BAL RETRG,GATXTV * GENERATE: 9030 58457021 DC AL2(ATXT51A-ATXTBV) * L 15,GN(FOR LM) 9030 58464021 DC AL2(ZTXT51-ATXT51A) * BCR 15,15 9030 58471021 MVI ATXT51A+NX8,XX1F INDIC COND OF 1 9030 58478021 QEDN3 DS 0H 9030 58485021 TM QRETSW,XX01 WAS IF NUM GENERATED... 9030 58492021 BZ QEDN2 NO 9030 58499021 NI QRETSW,XXFE 9030 58506021 MVC GLGNCN+NX3(LX2),GNRETU GN DEF 9030 58513021 BAL RETRG,GNOPT3 GENERATE GN DEF 9030 58520021 QEDN2 DS 0H 9030 58527021 TM QRETSW,XX02 WAS STM GENED... 9030 58534021 BZ QEDN5 NO, DONT GEN LM 9030 58541021 NI QRETSW,XXFD TURN OFF STM INDICATOR 9030 58548021 BAL RETRG,GATXTC * 9030 58555021 DC AL2(ATXT114-ATXTBC) * LM 2,4,96(13) 9030 58562021 DC AL2(ZTXT114-ATXT114) * 9030 58569021 MVC GLGNCN+NX3(LX2),GNLMSV INSERT GN NUMBER 9030 58576021 BAL RETRG,GNOPT3 * GN(LM) EQU * 9030 58583021 QEDN5 DS 0H 9030 58590021 B PH5CTL RETURN FOR NEXT STRING 58597021 QUPD1 DS 0H 58604021 MVC XCON1+NX14(LX2),DOP3+NX1 58611021 MVI XCON1+NX16,XX02 58618021 B QUPD2 GO TO QUPD2 58625021 QEDN1 DS 0H 58632021 TM DOP2+NX3,XXB0 IS IT BINARY... 58639021 BO QBIN YES 58646021 BAL RETRG,GATXTC * 58653021 DC AL2(ATXT113-ATXTBC) * STM 2,4,96(13) 58660021 DC AL2(ZTXT113-ATXT113) * 58667021 OI QRETSW,XX02 INDIC STM GENED 9030 58674021 MVI GANLNO,XX0F NO-GENERATE IF NUMERIC 58681021 MVC DOP1(LX124),DOP2 MOVE DATANAME TO DOP1 58688021 BAL RETRG,GNSTEP GET GN FOR IF NUM 58695021 MVC DOP2+NX1(LX2),FIVEGN STORE GN IN DOP2 58702021 MVC GNRETU(LX2),FIVEGN SAVE GN FOR DEF IN QRETUV 58709021 OI QRETSW,XX01 TURN ON QUPDAT SW 58716021 L GVERB,ADCN0F GO TO 58723021 BR GVERB NUMERIC CLASS TEST 58730021 QBINR DS 0H 58737021 MVC DOP2+NX1(LX2),DOP1+NX1 RESTORE DOP2 58744021 QBIN DS 0H 58751021 LA RW3,DOP2 58758021 BAL XRSUB,DNTOR1 TALLY CODING 58765021 TM QRETSW,XX02 WAS STM GENED... 9030 58772021 BZ QEDN4 NO, DONT GEN LM 9030 58779021 BAL RETRG,GATXTC * 9030 58786021 DC AL2(ATXT114-ATXTBC) * LM 2,4,96(13) 9030 58793021 DC AL2(ZTXT114-ATXT114) * 9030 58800021 B QEDN4 CHECK IF GN GEN'ED,ETC 9030 58807021 USING *,GVERB QCALL 58814021 QCALLV DS 0H 58821021 MVI XREG1,QR3 58828021 MVC XGN1(LX2),DOP1+NX1 58835021 BAL RETRG,LOAD * L R3,GN... (DOP1) 58842021 MVI XREG1,QR3 58849021 MVI XREG2,QR3 58856021 BAL RETRG,BRNLNK * BALR R3,R3 58863021 B PH5CTL RETURN FOR NEXT STRING 58870021 USING *,GVERB Q R E T 2 58877021 QRET2V DS 0H 58884021 MVI XREG1,QR2 58891021 MVI XREG2,QR2 58898021 BAL RETRG,BRNLNK * BALR 2,2 58905021 B PH5CTL RETURN FOR NEXT STRING 58912021 USING *,GVERB Q R E T 58919021 QRETUV DS 0H 58926021 MVI XREG1,UNCOND 58933021 MVI XREG2,QR3 58940021 BAL RETRG,BRANCH * BCR UNCOND,R3 58947021 BC UNCOND,DON BACK TO PH5CTL FOR NEXT STRING 58954021 * 58961021 USING *,GVERB 58968021 * Q RTNE FOR RENAMES 58975021 * EX- A RENAMES B THRU C 58982021 * FORMULA- LENGTHOF A= ADDR C-ADDR B+LENGTH OF C 58989021 QRNAM DS 0H 58996021 MVI XREG1,RW1 59003021 MVC BLREF1(LX2),DOP2+NX2 59010021 BAL RETRG,LOAD * L R1,SBL OR BL FOR C 59017021 MVI XREG1,XX01 59024021 MVC BLREF1(LX2),DOP3+NX2 59031021 BAL RETRG,SUB * S R1,SBL OR BL FOR C 59038021 CLI DOP4,XXFA IS DOP4 A VLC REF... 59045021 BNE QRNAM1 NO,A DUMMY-(C IS FIXED LENGTH) 59052021 MVI XREG1,RW1 59059021 MVC XCNTR1(LX3),DOP4+NX1 59066021 BAL RETRG,ADD * A R1,VLC 59073021 QRNAM1 DS 0H 59080021 MVI XREG1,XX01 59087021 MVI XCON1+NX16,XX02 59094021 MVC XCON1+NX14(LX2),DOP5+NX1 59101021 BAL RETRG,ADD * A R1,LITERAL 59108021 * IF DOP4 IS A DUMMY LITERAL REPRESENTS 59115021 * ADDRC - ADDRB + LENGTHC 59122021 * IF DOP4 IS A VLC LITERAL REPRESENTS 59129021 * ADDRC - ADDRB 59136021 MVI XREG1,RW1 59143021 MVC XCNTR1(LX3),DOP1+NX1 59150021 BAL RETRG,STORE * ST R1,VLC FOR A 59157021 B PH5CTL EXIT 59164021 TITLE 'DISPLAY/EXHIBIT/STOP/TRACE SUBROUTINES' 59171021 *=2 SUBROUTINES TO BUILD DN - INFO PARAMETER STRINGS 59178021 *= FOR DISPLAY, EXHIBIT, STOP AND TRACE. 59185021 * 59192021 * GENERATE THE DC PARAMER STRING (IN LINE) FOR DISPLAY SR 59199021 * CALLING SEQUENCES. BEFORE ENTERING DO... 59206021 * LA RW4,N*LOPD 59213021 * WHERE N IS THE OPERAND (0 TO 4) 59220021 * WHICH IS TO BE FIRST. 59227021 * 59234021 * USED BY DISPLAY, EXHIBIT, STOP 59241021 * 59248021 USING *,HCOMSR 59255021 DIDNIQ STM RETRG,RW2,SVDIS5 GEN... DN-INFO FOR EACH DN 59262021 DISP07 LA RW2,DOP1(RW4) 59269021 CLC DX0(LX2,RW2),HTERM END OF OPERANDS... 59276021 BC EQ,DISP05 YES 59283021 BAL RETRG,DIINFO GEN... 12 BYTES OF DN-INFO 59290021 BAL RETRG,GETDOP UPDATE DISPLACEMENT REGISTER 59297021 BC UNCOND,DISP07 LOOP BACK FOR NEXT DN, ETC. 59304021 DISP05 LM RETRG,RW2,SVDIS5 59311021 L XRVAR,SVWJH1 DIDNIN 59318021 BCR UNCOND,RETRG *** LEAVE DIDNIN *** 59325021 EJECT 59332021 * BUILD 12 BYTES OF DATA INFO FOR DN 59339021 * POINTED TO BY RW2. A-TEXT IS GENERATED. 59346021 * 59353021 USING *,HCOMSR 59360021 DIINFQ ST RETRG,SVDIS4 59367021 CLI DX0(RW2),MDNNM 35 TYPE AN LIT... 59374021 BC NOTEQ,DIINF1 NO 59381021 MVC PR35M(LX2),XC002 INITIALIZE 35 BUILDER, M = 2 59388021 MVI DOP5,XX34 HEADER, MAKE 34 59395021 BAL RETRG,PR3501 MOVE IN THIS 35 59402021 BAL RETRG,GETDOP GET NEXT ELEMENT 59409021 LA RW2,DOP1(RW4) 59416021 CLC PR35C1(LX3),DX0(RW2) =X'35014D' LEFT PARAN... 59423021 BC NOTEQ,PR3503 NO 59430021 BAL RETRG,PR3501 YES, ADD TO BUILD 59437021 BC UNCOND,PR3509 BYPASS COMMA INSERTION FOR FIRST 59444021 PR3505 BAL RETRG,PR3501 YES, ADD IT TO BUILD 59451021 LA RW2,PR35CB =', ' 59458021 BAL RETRG,PR3501 ADD ', ' TO BUILD 59465021 PR3509 BAL RETRG,GETDOP GET NEXT ELEMENT 59472021 LA RW2,DOP1(RW4) 59479021 CLI DX0(RW2),MNLIT NUM LIT... 59486021 BC EQ,PR3504 YES 59493021 CLC PR35C2(LX3),DX0(RW2) =X'35015D' RIGHT PARAN... 59500021 BC NOTEQ,PR3505 NO, MUST BE 35 FOR DN, ADD TO B 59507021 LH RW1,PR35M NEGATE LAST ', ' 59514021 SH RW1,XC002 59521021 STH RW1,PR35M 59528021 BAL RETRG,PR3501 RIGHT PARAN ALWAYS SENT BY PH4. 59535021 PR3506 LH RW1,PR35M M 59542021 SH RW1,XC002 M-2 59549021 STC RW1,DOP5+NX1 SET AS LENGTH OF BUILD (MAX 120) 59556021 ST RW2,PR35SV SAVE CURRENT RW2 59563021 LA RW2,DOP5 SET RW2 POINTING TO BUILT 35 (34 59570021 DIINF1 EQU * 59577021 BAL RETRG,DITYPE GENERATE APPROPRIATE DC 59584021 BAL RETRG,DILGTH GENERATE APPROPRIATE DC 59591021 BAL RETRG,DIBDIS GENERATE APPROPRIATE DC 59598021 BAL RETRG,CLSQDP GENERATE APPROPRIATE DC 59605021 CLC PR35SV(LX4),GZERO IS RW2 A DUMMY FOR EXHIBIT... 59612021 BC EQ,DIINF2 NO 59619021 L RW2,PR35SV YES, RESTORE RW2 59626021 MVC PR35SV(LX4),GZERO 59633021 DIINF2 L RETRG,SVDIS4 59640021 L XRVAR,SVWJH2 DIINFO 59647021 BCR UNCOND,RETRG RETURN TO CALLER 59654021 PR3503 OI LOOKAH,MSWON INDICATE A LOOK-AHEAD IS IN EFFE 59661021 BC UNCOND,PR3506 CHECK M, WITH LOOK-AHEAD 59668021 PR3504 BAL RETRG,CVNLIT CONVERT NUM LIT TO ZD W/DEC PT 3 59675021 BC UNCOND,PR3505 LAID OVER ORIG NUM LIT. 59682021 PR3501 STM RW4,RW6,SVWJHE 59689021 CLI PR35M+NX1,XX7A ALREADY STORED 120 CHAR? 59696021 BCR EQ,RETRG YES, DONT STORE ANY MORE 59703021 SR RW5,RW5 59710021 IC RW5,DX1(RW2) GET LENGTH N OF BCD TEXT 59717021 BCTR RW5,RW0 N-1 59724021 LH RW6,PR35M 59731021 LA RW6,DOP5(RW6) 59738021 LA RW4,DX1(RW5) CALCULATE NUMBER WE CAN STORE 59745021 AH RW4,PR35M WITHOUT GOING OVER 120 CHAR 59752021 CH RW4,XC0122 59759021 BNH PR35X2 LESS THAN 122 59766021 BAL RETRG,ERRPRO PUT OUT MSG. MORE THAN 59773021 DC AL1(ERRN18) 120 CHARACTERS. 59780021 DC AL1(0) 59787021 LH RW5,XC0122 59794021 SH RW5,PR35M 59801021 BCTR RW5,RW0 DECREMENT BY ONE 59808021 LH RW4,XC0122 59815021 PR35X2 STH RW4,PR35M 59822021 EX RW5,PR35MV MOVE 59829021 LM RW4,RW6,SVWJHE 59836021 BCR UNCOND,RETRG RETURN TO CALLER 59843021 PR35MV MVC DX0(LX1,RW6),DX2(RW2) *** EXECUTED MVC *** 59850021 * 59857021 *********************************************************** 59864021 * LA RW2,DOP-I TYPE DC BUILDER 59871021 * BAL RETRG,DITYPE 59878021 * 59885021 * 59892021 USING *,HCOMSR 59899021 DITYPQ STM RETRG,RW4,SVDIS1 59906021 CLI DX0(RW2),MDN 59913021 BC EQ,DITY01 DN FOUND 59920021 CLI DX0(RW2),MNLIT 59927021 BC EQ,DITY10 NUM LIT 59934021 CLI DX0(RW2),MFPLIT 59941021 BC EQ,DITY11 FP LIT 59948021 CLI DX0(RW2),MANLIT 59955021 BC EQ,DITY03 AN LITERAL 59962021 CLI DX0(RW2),MFIGC 59969021 BC EQ,DITY09 FIGCON 59976021 CLI DX0(RW2),MPARMA IFP IN PARAM AREA... 59983021 BC EQ,DITY04 YES 59990021 B DITYEX GENERATE SAVE MACRO 59997021 DITY01 CLC DX4(LX3,RW2),XTALLV+NX4 TALLY... 60004021 BC EQ,DITY16 YES 60011021 SR RW3,RW3 NO, NORMAL DN 60018021 IC RW3,DX3(RW2) 60025021 SRL RW3,DX4 MINOR*2 FOR INDEXED LOAD 60032021 SLL RW3,DX1 60039021 LH RW4,DITYTB(RW3) 60046021 CH RW3,G20 SPECIAL CASES... 60053021 BC LO,DITYEX NO, GET OUT 60060021 BC EQ,DITY07 YES, SET PRECISION BIT 60067021 CH RW3,XC028 IS IT ANE... 60074021 BE DITYEX YES 60081021 TM DX7(RW2),XX01 YES, CHECK FOR S IN PICTURE 60088021 BC ZERO,DITYEX GENERATE SAVE MACRO 60095021 DITY08 O RW4,GFOUR SET SIGNED/DOUBLE PRECISION BIT 60102021 BC UNCOND,DITYEX *** LEAVE DITYPE *** 60109021 DITY07 TM DX9(RW2),XX01 DOUBLE PRECISION... 60116021 BC ONES,DITY08 YES 60123021 BC UNCOND,DITYEX NO 60130021 MVI DX0(RW2),MANLIT MAKE NUM AND FP LITS LOOK LIKE 60137021 DITY04 DS 0H 60144021 LA RW4,XX1F NUM, FP LITS AND FP DN'S 60151021 BC UNCOND,DITYEX GENERATE SAVE MACRO 60158021 DITY09 DS 0H 60165021 LA RW4,XX90 SET FIGCON BIT,TYPE DIRECT BIT 60172021 BC UNCOND,DITYEX GENERATE SAVE MACRO 60179021 DITY03 DS 0H 60186021 LA RW4,XX10 DIRECT,READY-TO-PRINT,BREAKABLE 60193021 DITYEX STH RW4,DITYSV SAVE TYPE 60200021 STH RW4,GMACDC GEN... DC XL1'TYPE' 60207021 MVI GMACDC,XX01 60214021 TM NREADSW,READVSON+SCNDSRA V/S READ,NO SRA... 58932 60221021 BNM DITY02 NOT SUITABLE CONDITIONS 58932 60228021 OI GMACDC+NX1,XX40 SIGNAL RECORD TO VMO 58932 60235021 DITY02 DS 0H 58932 60242021 MVI GMCTYP,MDC 60249021 BAL RETRG,MACRO GENERATE MACRO CODING 60256021 LM RETRG,RW4,SVDIS1 60263021 L XRVAR,SVWJH3 DITYPE 60270021 BCR UNCOND,RETRG RETURN TO CALLER 60277021 DITY10 BAL RETRG,CVNLIT CONVERT NUM LIT TO AN FORMAT 60284021 BC UNCOND,DITY04 GIVE NUM TYPE 60291021 DITY11 MVI DX0(RW2),MANLIT CHANGE HEADER FROM FP TO AN LIT 60298021 TM DX2(RW2),XX90 HI-SIGN OK... 60305021 BC NOTMXD,DITY04 YES 60312021 TM DX2(RW2),XXE0 S/B '+'... 60319021 BC NOTONE,DITY12 NO 60326021 MVI DX2(RW2),XX4E 60333021 BC UNCOND,DITY04 REVERT TO SAVE MACRO 60340021 DITY12 TM DX2(RW2),XX70 S/B '-'... 60347021 BC ONES,DITY13 YES 60354021 CLI DX2(RW2),XX4B FIRST CHAR '.'... 60361021 BC NOTEQ,DITY13 NO, JUST CHANGE TO '-' 60368021 SR RETRG,RETRG 60375021 IC RETRG,DX1(RW2) SHIFT TO NEW AREA, LEAVE LEADIN 60382021 LA RETRG,DX1(RETRG) IN DOP CELL 60389021 STC RETRG,DX33(RW2) FOR SIGN 60396021 MVC DX0(LX1,RW2),DX32(RW2) 60403021 MVC DX2(LX30,RW2),DX35(RW2) 60410021 MVC DX0(LX32,RW2),DX32(RW2) MOVE BACK TO START OF CURRENT DO 60417021 DITY13 MVI DX2(RW2),XX60 60424021 BC UNCOND,DITY04 REVERT TO SAVE MACRO 60431021 DITY16 DS 0H 60438021 LA RW4,XX11 TALLY, DIRECT, AND BINARY 60445021 BC UNCOND,DITYEX GENERATE SAVE MACRO 60452021 EJECT 60459021 * 60466021 * LENGTH DC BUILDER 60473021 * 60480021 * 60487021 USING *,HCOMSR 60494021 DILGTQ STM RETRG,RW3,SVDIS2 60501021 BAL RETRG,CALCLG DN'S, FIND LENGTH OR VLC 60508021 NOP DX0(RW0) NULL OPERATION 60515021 SKPSTR TM DITYSV+NX1,XX20 TEST TYPE 60522021 BC ONES,DILG02 VL W/VLC NUMBER IN LENGTH 60529021 TM DITYSV+NX1,XX03 60536021 BC NOTMXD,DILG03 NOT ID AND NOT BIN 60543021 SR RW1,RW1 ID OR BIN, OBTAIN 9'S LENGTH 60550021 IC RW1,DX9(RW2) 9'S LENGTH 60557021 L RW3,LENGTH COMBINE THE 2 LENGTHS 60564021 SLL RW3,DX16 60571021 OR RW3,RW1 60578021 DILG07 ST RW3,GMACDC 60585021 MVI GMACDC,XX03 GEN... DC XL1'BYTE-LENGTH' 60592021 MVI GMCTYP,MDC DC XL2'9-LENGTH' 60599021 DILG04 BAL RETRG,MACRO GENERATE MACRO CODING 60606021 LM RETRG,RW3,SVDIS2 60613021 L XRVAR,SVWJH4 DILGTH 60620021 BCR UNCOND,RETRG *** LEAVE DILGTH *** 60627021 DILG03 L RW3,LENGTH GEN... DC XL3'LENGTH' 60634021 CLI DX0(RW2),MPARMA IFP IN PARAM AREA... 60641021 BC NOTEQ,DILG07 NO 60648021 LA RW3,FPLENS YES, PUT EFP LENGTH IN RW3 60655021 CLI DX1(RW2),XX1D SINGLE PREC FP... 60662021 BC EQ,DILG07 SIMGE PREC = 14 60669021 LA RW3,FPLENL DOUBLE PREC = 23 60676021 BC UNCOND,DILG07 COMMON CODING 60683021 DILG02 MVC GMADCN(LX2),DILGC1 VL C1=X'1C00' 60690021 MVC GMADCN+NX2(LX2),LENGTH+NX2 60697021 MVI GMCTYP,MADCON 60704021 BC UNCOND,DILG04 GEN... DC AL3(VLC) 60711021 * GEN TGT POINTER AND DISPLACEMENT ADCONS 60718021 USING *,HCOMSR 60725021 DIBDIQ STM RETRG,RW1,SVDIS3 60732021 BAL RETRG,DRELAD GO SET UP RELAD1 FOR CURR UNIT 60739021 MVI GMCTYP,MADCON 60746021 BAL RETRG,MACRO * DC AL4(TGT-CELL) 60753021 BAL RETRG,DDISPM GO SET UP GMACDC WITH 60760021 MVI GMCTYP,MDC 60767021 BAL RETRG,MACRO * DC XL2'DISP' 60774021 LM RETRG,RW1,SVDIS3 60781021 L XRVAR,SVWJH5 DIBDIS 60788021 BCR UNCOND,RETRG *** LEAVE DIBDIS *** 60795021 * SET UP RELAD1 FOR THE VARIOUS BL REFERENCES 60802021 USING *,HCOMSR 60809021 DRELAQ EQU * 60816021 ST RW1,SVWJHK 60823021 CLI DX0(RW2),MPARMA IFP IN PARAM AREA... 60830021 BC EQ,DREL01 YES 60837021 CLI DX0(RW2),MDN DN... 60844021 BC NOTEQ,DIBD01 NO 60851021 CLC DX4(LX3,RW2),XTALLV+NX4 TALLY... 60858021 BC EQ,DREL03 YES 60865021 TM DX4(RW2),XX70 YES 60872021 BC ZERO,DIBD02 BL 60879021 TM DX4(RW2),XX60 SUBSCTRIPED... 60886021 BC ONES,DIBD0A YES 60893021 TM DX4(RW2),XX10 60900021 BC ONES,DIBD03 BLL 60907021 TM DX4(RW2),XX20 60914021 BC ONES,DIBD04 BLS 60921021 LA RW1,XX14 SBL BY ELIMINATION 60928021 DIBD05 EQU * 60935021 DIBD06 SLL RW1,DX8 60942021 STH RW1,GMADCN SET TT CODE 60949021 MVI GMADCN+NX1,XX01 SET BASE CODE FOR CALLING S 60956021 MVC GMADCN+NX3(LX1),DX6(RW2) SET NUMBER 60963021 DIBD09 L HCOMSR,SVWJHD 60970021 L RW1,SVWJHK 60977021 BCR UNCOND,RETRG *** LEAVE DRELAD SR *** 60984021 DIBD02 DS 0H 60991021 LA RW1,XX0C BL 60998021 BC UNCOND,DIBD05 I/O CHECK 61005021 DIBD03 DS 0H 61012021 LA RW1,XX28 BLL 61019021 BC UNCOND,DIBD06 BYPASS I/O CHECK 61026021 DIBD04 DS 0H 61033021 LA RW1,XX24 SBL 61040021 BC UNCOND,DIBD06 BYPASS I/O CHECK 61047021 DIBD0A MVI GMADCN,XX60 SUBSCRIPT TT 61054021 MVI GMADCN+NX1,XX01 SET BASE CODE FOR CALLING S 61061021 MVC GTEMP(LX2),DX5(RW2) SUBSCRIPT CELL (SBS) NO. 61068021 NI GTEMP,XX0F CLEAR OUT I OF IDK FIELD 61075021 MVC GMADCN+NX2(LX2),GTEMP CELL NUMBER IS IN D PART OF IDK 61082021 BC UNCOND,DIBD09 EXIT FROM ROUTINE 61089021 DIBD01 EQU * 61096021 MVI GMADCN,XX2C NO, ASSUME LITERAL OR FIGCON 61103021 MVI GMADCN+NX1,XX01 SET BASE CODE FOR CALLING S 61110021 ST RW2,OP1 61117021 BC UNCOND,DIBD09 EXIT FROM ROUTINE 61124021 DREL01 MVI GMADCN,XX08 SET UP PARAM ADCON 61131021 MVI GMADCN+NX1,XX01 SET BASE CODE FOR CALLING S 61138021 MVC PLUS1+NX1(LX2),DIFPNN 61145021 MVI GMADCN+NX3,XX01 61152021 LH RW1,DIFPNN UP N BY LENGTH OF EFP 61159021 LA RW1,FPLENS(RW1) 61166021 CLI DX1(RW2),XX1D SINGLE PRECISION... 61173021 BC EQ,DREL02 YES 61180021 LA RW1,FPLENL-FPLENS(RW1) 61187021 DREL02 STH RW1,DIFPNN 61194021 BC UNCOND,DIBD09 EXIT FROM ROUTINE 61201021 DREL03 MVI GMADCN,XX04 TALLY RELAD SETUP 61208021 MVI GMADCN+NX1,XX01 SET BASE CODE FOR CALLING S 61215021 BC UNCOND,DIBD09 EXIT FROM ROUTINE 61222021 * ISOLATE DISPLACEMENT AND PUT IT INTO CELL GMACDC (XCON1) 61229021 * 61236021 * *** DOES NOT SAVE REGISTERS. DO NOT CHANGE TO USE REG'S *** 61243021 * 61250021 USING *,HCOMSR 61257021 DDISPQ CLI DX0(RW2),MDN DN... 61264021 BC NOTEQ,DIBD10 NO, LIT FIGCON TALL ALL DISP = 61271021 CLC DX4(LX3,RW2),XTALLV+NX4 TALLY... 61278021 BC EQ,DIBD10 YES, DISPLACEMENT = 0 61285021 TM DX4(RW2),XX60 SUBSCRIPTED... 61292021 BC ONES,DIBD10 YES, DISPLACEMENT = 0 FOR SUBSC 61299021 MVC GMACDC+NX1(LX2),DX4(RW2) ISOLATE DISPLACEMENT 61306021 NI GMACDC+NX1,XX0F CLEAR OUT BL PORTION OF BDISP 61313021 DIBD10 MVI GMACDC,XX02 61320021 L HCOMSR,SVWJHD 61327021 NI DIFPSW,SSWOFF CANCEL FP SPECIAL CASE SW 61334021 BCR UNCOND,RETRG *** EXIT FROM DDISPM *** 61341021 EJECT 61348021 * CODING S.R.'S -PRODUCE BITS AND PIECES 61355021 * OF CODING. 61362021 USING *,HCOMSR 61369021 DICO1Q ST RETRG,SVDIS6 61376021 MVI XREG1,XX0E * L 14,GND 61383021 BAL RETRG,GNSTEP GET A GN FOR GND 61390021 MVC XGN1(LX2),FIVEGN 61397021 MVC DISGND,FIVEGN 61404021 BAL RETRG,LOAD L 14,GND 61411021 BAL RETRG,GDES14 DESTROY REGISTERS 61418021 L RETRG,SVDIS6 61425021 L XRVAR,SVWJH6 DICOA1 61432021 BCR UNCOND,RETRG RETURN TO CALLER 61439021 USING *,HCOMSR 61446021 DICNOQ ST RETRG,SVDIS6 61453021 MVI IMM,XX08 CODE FOR '2,4' FOR CNOP 61460021 BAL RETRG,CNOP GEN... CNOP 2,4 61467021 L RETRG,SVDIS6 61474021 L XRVAR,SVWJH7 DICNOP 61481021 BCR UNCOND,RETRG RETURN TO CALLER 61488021 USING *,HCOMSR 61495021 CLSQDQ TM DX0(RW2),XXCE TO SEE IF 21,30,31 ELEMENT 61502021 BC NOTEQ,CLSQRT NO,RETURN 61509021 ST RW6,CLSSV 61516021 SR RW6,RW6 61523021 IC RW6,DX1(RW2) 61530021 BCTR RW6,RW0 DECREASE COUNT BY 1 61537021 LA RW6,DX0(RW6,RW2) 61544021 MVC GMADCN+NX2(LX3),DX0(RW6) 61551021 MVI GMCTYP,MADCON 61558021 MVI GMADCN+NX1,XX02 61565021 ST RW2,OP1 61572021 BAL RETRG,MACRO GENERATE MACRO CODING 61579021 L RW6,CLSSV 61586021 CLSQRT LM RETRG,XRVAR,SVWJHS 61593021 BCR UNCOND,RETRG RETURN TO CALLER 61600021 USING *,HCOMSR 61607021 DIBALQ ST RETRG,SVDIS6 61614021 * UPON ENTRY, RW3 POINTS TO LAST 4 CHAR OF VIRT. XREG1 ALREADY SET 61621021 CLC GVIRT1(LX8),GZERO VIRT ALREADY SET UP... 61628021 BC NOTEQ,DIBA01 YES, USE IT 61635021 MVC GVIRT1(LX4),VIRTHD FIRST 4 CHAR OF VIRT 61642021 MVC GVIRT1+NX4(LX4),DX0(RW3) LAST 4 CHAR OF VIRT 61649021 DIBA01 EQU * 61656021 MVC VIRTC1+NX2(LX2),VIRCTR SET VIRTUAL NUMBER 61663021 IC RW3,XREG1 SAVE XREG1 FOR BALR 61670021 CLI XREG1,XX0D 61677021 BC HI,DIBAQ1 REG 14 OR 15 ... 61684021 ST RW4,SVWJHP PRESERVE REG'S OVER XFREER 61691021 L RW4,SVWJHP PRESERVE REG'S OVER XFREER 61698021 DIBAQ2 EQU * 61705021 MVI XREG1,XX0F 61712021 BAL RETRG,LOAD * L 15,VIRTUAL 61719021 STC RW3,XREG1 RESTORE XREG1 FOR BALR 61726021 MVI XREG2,XX0F 61733021 BAL RETRG,BAL * BALR X,15 WHERE X = 1 OR 1 61740021 BAL RETRG,GDES15 DESTROY REGISTERS 61747021 L RETRG,SVDIS6 61754021 L XRVAR,SVWJH8 DIBALR 61761021 BCR UNCOND,RETRG RETURN TO CALLER 61768021 DIBAQ1 STC RW3,A48CH1 61775021 MVI A48CH2,MDESTR 61782021 BAL RETRG,GATXTV * 61789021 DC AL2(ATXT48-ATXTBV) *MACRO CODING GENERATION 61796021 DC AL2(ZTXT48-ATXT48) * 61803021 BC UNCOND,DIBAQ2 GENERATE LOAD AND BALR 61810021 USING *,HCOMSR 61817021 DICO8Q ST RETRG,SVDIS6 61824021 MVC GLGNCN+NX3(LX2),DISGND GND EQU * 61831021 BAL RETRG,GNOPT3 GENERATE GN CODING 61838021 L RETRG,SVDIS6 61845021 L XRVAR,SVWJH9 DICOA8 61852021 BCR UNCOND,RETRG RETURN TO CALLER 61859021 EJECT 61866021 *=2 CALCLG CALCULATE THE CURRENT DN'S LENGTH 61873021 USING *,HCOMSR 61880021 * 61887021 * 61894021 * CALCULATES THE LENGTH OF CURRENT UNIT. 61901021 CALCLQ EQU * 61908021 STM RETRG,RW3,SVSO14 61915021 SR RW1,RW1 61922021 STC RW1,DNMINR 61929021 LR RW1,RW2 61936021 CLI DX0(RW1),MDN MUST BE A DN 61943021 BC NOTEQ,CALG01 NOT A DN 61950021 * FIND THE LENGTH FROM MINOR,DN'S ONLY 61957021 LR RW3,RW2 SET UP RW3 FOR NEXT SR 61964021 BAL RETRG,XLENGH GET LENGTH OF DN 61971021 CLC GZERO(LX2),XOPVLC VLC... 61978021 MVC DNMINR(LX1),XGTEM2 SAVE MINOR 61985021 BC EQ,SOR24 NO 61992021 LH RW2,XOPVLC YES, PUT VLC NUMBER INTO LENGTH 61999021 O RW2,EXHIC1 SET HI ORDER (SIGN) BIT 62006021 BC UNCOND,SOR22 ALREADY HAVE LENGTH 62013021 SOR24 L RW2,XOPLGH 62020021 SOR22 ST RW2,LENGTH SAVE LENGTH 62027021 SOREX1 LM RETRG,RW3,SVSO14 62034021 L XRVAR,SVWJHA 62041021 BC UNCOND,DX4(RETRG) LENGTH FOUND EXIT 62048021 SOR21 SR RW2,RW2 ERROR 62055021 ST RW2,LENGTH MAKE LENGTH = 0 62062021 LM RETRG,RW3,SVSO14 62069021 L XRVAR,SVWJHA 62076021 BR RETRG ERROR EXIT 62083021 O RW2,EXHIC1 SET VAR LEN BIT (HIGH ORDER BIT) 62090021 CALG01 CLI DX0(RW1),MNLIT 62097021 BC EQ,CALG02 NUM LIT 62104021 CLI DX0(RW1),MFLIT 62111021 BC EQ,CALG02 FL PT LIT 62118021 CLI DX0(RW1),MALIT 62125021 BC EQ,CALG02 AN LIT 62132021 CLI DX0(RW1),XXFA CONVERTED FP IN PRM AREA... 62139021 BC EQ,CALG05 YES 62146021 CLI DX0(RW1),PLFCON 62153021 BE CALG06 BRANCH TO DOP LENGTH 62160021 CLI DX0(RW1),MFGCON 62167021 BC NOTEQ,SOR21 NOT A TYPE ITEM THAT HAS LENGTH 62174021 MVI LENGTH+NX3,XX01 FIG-CON, LENGTH = 1 62181021 XC LENGTH(LX3),LENGTH 62188021 BC UNCOND,SOREX1 TAKE 'YES' EXIT 62195021 CALG02 EQU * 62202021 SR RW2,RW2 62209021 IC RW2,DX1(RW1) 62216021 BC UNCOND,SOR22 ALREADY HAVE LENGTH 62223021 CALG05 LA RW2,DX4 SINGLE PREC FP LEN 62230021 TM DX1(RW1),XX01 SINGLE PREC... 62237021 BC ONES,SOR22 YES 62244021 LA RW2,DX8 NO, DOUBLE PREC IFP LEN 62251021 BC UNCOND,SOR22 ALREADY HAVE LENGTH 62258021 CALG06 SR RW2,RW2 62265021 IC RW2,DOP1+NX1 62272021 B SOR22 ALREADY HAVE LENGTH 62279021 EJECT 62286021 USING *,HCOMSR 62293021 ADETEQ EQU * 62300021 STM RETRG,RW4,SVWJHI 62307021 TM ADESW1,MSWON FOLLOWS A DEBUG PACKET... 62314021 BC ONES,ADET01 YES 62321021 CLI ASRLAS,PNDEF LAST HEADER PN... 62328021 BE ADET03 YES, GOBACK REQUIRED 62335021 CLI ASRLAS,GNDEF LAST HEADER GN... 62342021 BE ADET03 YES, GOBACK REQUIRED 62349021 CLI GANLNO,XX11 LAST INSTR 'GO'... 62356021 BC EQ,ADET02 YES, GOBACK NOT REQUIRED 62363021 CLI GANLNO,XX6F LAST INSTR SEGMENTATN GO TO.. 62370021 BE ADET02 YES, GOBACK NOT REQUIRED 62377021 CLI GANLNO,XX10 STOP... 62384021 BNE ADET04 NOT A STOP 62391021 CLC DOP1(LX2),CBRUN YES,WAS IT A STOP 'RUN' 62398021 BC EQ,ADET02 YES,SKIP REDUNDANT GOBACK 62405021 ADET04 EQU * 62412021 CLI GANLNO,XX73 LAST INSTR A GOBACK... 62419021 BE ADET02 YES, SKIP REDUNDANT GOBACK 62426021 CLI GANLNO,XX74 LAST INSTR AN EXIT PGM... 62433021 BE ADET02 YES, SKIP GOBACK 62440021 ADET03 EQU * 62447021 OI ADESW2,MSWON NO, GENERATE A GOBACK 62454021 ST STNGR,SVWJHJ 62461021 L STNGR,ADCN73 =A(GOBACK) 62468021 BCR UNCOND,STNGR SIMULATE A GOBACK TO ANALYZER 62475021 * 62482021 * 62489021 * GENERATE RETURN FROM A DEBUG PACKET. THE GN BRANCHED TO WAS 62496021 * SAVED BY THE DEBUG VERB ANALYZER. 62503021 ADET01 MVC XGN1(LX2),LSTDBG 62510021 MVI XREG1,XRVAR * L 15,GN 62517021 BAL RETRG,BRANCH * BCR 15,15 62524021 * ('BRANCH' PUTS OUT DESTROY FOR R15) 62531021 ADET02 EQU * 62538021 LM RETRG,RW4,SVWJHI 62545021 L XRVAR,SVWJHH 62552021 BCR UNCOND,RETRG *** EXIT ADETER *** 62559021 ******************************************************************* 62566021 * 62573021 * GETDOP ROUTINE DEVELOPS IN RW4 THE DISPLACEMENT OF THE 62580021 * NEXT DOP AREA. IF END OF STRING IT GETS NEXT ONE. 62587021 ******************************************************************* 62594021 * 62601021 USING *,HCOMSR 62608021 GETDOQ EQU * 62615021 ST RETRG,SVGETD ENTRY WHEN OPERAND COUNT NEEDED 62622021 TM LOOKAH,MSWON IN A LOOK AHEAD... 62629021 BC ZERO,GETD04 NO 62636021 NI LOOKAH,MSWOFF YES 62643021 BC UNCOND,GETD03 EXIT FROM ROUTINE 62650021 GETD04 EQU * 62657021 L RETRG,DISPNN UP OPERAND COUNTER BY 1 62664021 LA RETRG,DX1(RETRG) 62671021 ST RETRG,DISPNN 62678021 L RETRG,SVGETD 62685021 CLI GANLNO,XX36 SORT SPECIAL CASE ... 62692021 BE GETD05 YES 62699021 CLI GANLNO,XX27 EXHIBIT... 62706021 BE GETD02 YES, SPECIAL CASE 62713021 CH RW4,GETDC1 NO 62720021 BC EQ,GETD01 NEED NEXT STRING 62727021 LA RW4,LDOP(RW4) UP DOP DISPLACEMENT 62734021 GETD03 L XRVAR,SVWJHB 62741021 BCR UNCOND,RETRG *** LEAVE GETDOP *** 62748021 GETD01 STM RW0,XRVAR,SVGETD SAVE ALL REG'S 62755021 BC UNCOND,DON ENTER SUPER FOR NEXT STRING 62762021 NXTSTQ LM RW0,XRVAR,SVGETD RETURN FROM SUPER, REINSTATE REG 62769021 SR RW4,RW4 INITIALIZE DOP DISP = 0 62776021 L XRVAR,SVWJHB GETDOP 62783021 BCR UNCOND,RETRG *** LEAVE GETDOP *** 62790021 GETD02 LA RW4,LDOP(RW4) 62797021 CH RW4,GETDC1 62804021 BE GETD01 NEED ANOTHER EXAMINE STRING 62811021 BC UNCOND,GETD03 OK 62818021 GETD05 LA RW4,LDOP(RW4) SORT SPECIAL CASE, ONLY 3 DOPS 62825021 CH RW4,GETDC2 ARE PASSED TO PH5 AT ONE TIME 62832021 BE GETD01 NEED ANOTHER SORT STRING 62839021 B GETD03 OK 62846021 * THIS ROUTINE GETS A SW NUMBER FROM XSASW AND UPS XSASW 62853021 USING *,HCOMSR 62860021 GETSWQ ST RW2,SVGETS UP COMMON'S XSA SW COUNTER 62867021 LH RW2,XSWCTR AFTER PLACING NEXT 62874021 STH RW2,SWCOUN XSA CTR NUMBER INTO 62881021 LA RW2,DX1(RW2) SWCOUN 62888021 STH RW2,XSWCTR 62895021 L RW2,SVGETS 62902021 L XRVAR,SVWJHC GETSW 62909021 BCR UNCOND,RETRG RETURN TO CALLER 62916021 USING *,XRVAR 62923021 IOQRTQ DS 0H 62930021 BAL RETRG,WRKLRG KILL SS, 14, 15 62937021 NI IODOSW,MSWOFF RESET ODO CONTROL SW 62944021 CLI GANLNO,XX23 WRITE... 62951021 BC EQ,IOQD01 YES 62958021 CLI GANLNO,XX72 CHECKPOINT WRITE? 62965021 BC EQ,IOQD01 YES. 62972021 CLI GANLNO,XX21 OPEN... 62979021 BC NOTEQ,IOQD02 NO 62986021 TM DX2(RW2),XX0F OPENED OUTPUT? 62993021 BC NOTONE,IOQD02 NO 63000021 IOQD01 TM DX6(RW2),XXC0 BSAM OR BDAM 63007021 BC NOTZER,IOQD03 YES 63014021 TM DX6(RW2),XX02 APPLY WRITE ONLY 63021021 BC ONES,IOQD02 YES 63028021 IOQD03 EQU * 63035021 OI IODOSW,MSWON SET ODO CONTROL SW 63042021 MVI IMM,XX01 63049021 MVI GDEBG1,XX04 63056021 MVI GDEBG1+NX1,XX01 63063021 BAL RETRG,OI * OI SWITCH+1,X'01' 63070021 IOQD02 SR RW5,RW5 63077021 IC RW5,DX0(RW3) GN COUNT FOR ODO 63084021 MVC XGN1(LX2),DX1(RW3) FIRST GN NUMBER 63091021 MVI XREG1,XX02 63098021 BAL RETRG,LOAD * L 2,GN=XX 63105021 LA RW5,DX1(RW5) 63112021 IOQR01 DS 0H 63119021 MVI XREG1,XX02 63126021 MVI XREG2,XX02 63133021 BAL RETRG,BALR * BALR 3,2 63140021 BCT RW5,IOQR01 TEST FOR MORE BALR'S 63147021 TM IODOSW,MSWON WAS SW SET... 63154021 BC ZERO,IOQD04 NO 63161021 MVI IMM,XXFE YES, GEN RESET 63168021 MVI GDEBG1,XX04 63175021 MVI GDEBG1+NX1,XX01 63182021 BAL RETRG,NI * NI SWITCH+1,X'FE' 63189021 IOQD04 EQU * 63196021 LM RETRG,RW5,SVWJHR RESTORE REGISTERS 63203021 BCR UNCOND,RETRG *** LEAVE IOQRTN *** 63210021 USING *,XRVAR 63217021 IOSTBQ STM RW5,RW6,SVWJHE+NX8 *** USES SAME SAVE CELLS AS IOQRTN ** 63224021 LM RW5,RW6,GZERO 63231021 MVC GTEMP(LX1),DX3(RW2) 63238021 NI GTEMP,XX0F 63245021 IC RW5,GTEMP 63252021 IC RW6,DX4(RW2) 63259021 IOSTB2 STH RW6,BLREF1 63266021 TM DX2(RW2),XX01 SD... 63273021 BC ZERO,IOSTB3 NO 63280021 OI BLREF1,XX01 YES, SET I=1 (BLL) 63287021 LH RW6,BLREF1 REFLECT NEW I REF IN RW6 63294021 IOSTB3 EQU * 63301021 MVI XREG1,XX01 63308021 BAL RETRG,STORE * ST 1,BL 63315021 MVI GMCTYP,MBLCHG 63322021 STH RW6,BLREF1 63329021 BAL RETRG,MACRO BLCHNG FOR THIS BL 63336021 BCT RW5,IOSTB1 TEST FOR MORE BL'S 63343021 LM RW5,RW6,SVWJHE+NX8 63350021 LM RETRG,XRVAR,SVWJHE 63357021 BCR UNCOND,RETRG *** LEAVE IOSTBL *** 63364021 IOSTB1 LA RW6,DX1(RW6) 63371021 MVI XCON1+NX14,XX10 =4096 IN DEC 63378021 MVI XCON1+NX16,XX02 63385021 MVI XREG1,XX01 63392021 BAL RETRG,ADD * AH 1,=4096 63399021 BC UNCOND,IOSTB2 GO THRU ST, BLCHNG LOOP AGAIN 63406021 EJECT 63413021 BALR STNGR,RW0 SET UP ADDRESSABILITY 63420021 USING *,STNGR 63427021 EOS EQU * 63434021 COMPUT EQU * 63441021 ALTER EQU * 63448021 EXIT EQU * 63455021 ENTER EQU * 63462021 RETUR EQU * 63469021 GENERA EQU * 63476021 TERMIN EQU * 63483021 ELSE EQU * 63490021 IF EQU * 63497021 USE EQU * 63504021 BC UNCOND,PH5CTL BACK TO PH5CTL FOR NEXT STRING 63511021 TITLE 'GO TO VERB ANALYZER G O T O' 63518021 DS 0F 63525021 USING *,STNGR 63532021 *=1 GO ANALYZER 63539021 * 63546021 * PNREF, GNREF OR VNREF IN DOP1 63553021 * 63560021 * 63567021 GO EQU * 63574021 CLI DOP1,PNREF PN... 63581021 BC NOTEQ,BGO2 NO 63588021 MVC XPN1+NX1(LX3),DOP1+NX1 63595021 BC UNCOND,BGO3 BRANCH TO PN CODING 63602021 BGO2 CLI DOP1,XXAA 63609021 BC EQ,BGO4 BRANCH IF GN 63616021 CLC DOP1,MSKMORLB MORE-LABELS 63623021 BC NOTEQ,BGO5 NO,MUST BE VN 63630021 BAL RETRG,GATXTC SET RETURN CODE IN REG 15 63637021 DC AL2(ATXT96-ATXTBC) X 63644021 DC AL2(ZTXT96-ATXT96) X 63651021 MVI XREG1,XX05 63658021 MVI BDISP1,XX50 63665021 MVI BDISP1+NX1,XX04 * LA 5,4(5) 63672021 BAL RETRG,LA XXXX 63679021 BAL RETRG,GATXTC GEN CODE TO RESTORE BLL1,2, 63686021 DC AL2(ATXT95B-ATXTBC) RECHAIN PTRS,RESTORE SA1,EX 63693021 DC AL2(ATXT95F-ATXT95B) X 63700021 BAL RETRG,GATXTC * LR 15,5 / LR 14,4 63707021 DC AL2(ATXT112-ATXTBC) * LM 2,5,28(13) 63714021 DC AL2(ZTXT112-ATXT112) BCR 15,14 63721021 BC UNCOND,DON RETURN TO PH5CTL 63728021 BGO5 EQU * 63735021 MVC XVN1+NX1(LX3),DOP1+NX1 63742021 CLI SEGLMT,XXFF IS PROGRAM SEGMENTED... 63749021 BE BGO3 NO, NORMAL PROCESSING 63756021 BAL RETRG,LOAD GGEN..L R0,VN-NO. 63763021 BAL RETRG,VBADCE L R15,V(SGM0) 63770021 DC C'SGM2' BALR 14,15 59713 63777021 MVI XCON1,XX02 DC XL2'PTY00' 63784021 MVC XCON1+NX1(LX1),PNOUT+NX1 (CALL TO SEGMENTATION OBJECT 63791021 MVI GMCTYP,MDC TIME SUBROUTINE) 63798021 BAL RETRG,MACRO GENERATE MACRO CODING 63805021 B PH5CTL RETURN TO PH5CTL 63812021 BGO4 MVC XGN1(LX2),DOP1+NX1 63819021 BGO3 MVI XREG1,XRA 63826021 BAL RETRG,LOAD DO L XRA,PN OR VN 63833021 MVI XREG1,UNCOND 63840021 MVI XREG2,XRA 63847021 BAL RETRG,BRANCH DO BCR UNCOND,XRA 63854021 BC UNCOND,DON EXIT 63861021 SPACE 2 63868021 *=1 GODEP1 ANALYZER 63875021 * 63882021 * COUNT OF PN S IN DOP1+2 63889021 * DN IN DOP2 63896021 * 63903021 * 63910021 DS 0F 63917021 USING *,STNGR 63924021 GODEP1 MVI XREGNO,XX01 63931021 * GEN. L R1,DN, PLUS ANY CODING NECESS TO CONVERT DN TO BINARY 63938021 LA RW3,DOP2 63945021 BAL RETRG,DNTOR1 ATXT GENERATOR PROCESSING 63952021 MVI XREG1,XX03 63959021 MVC XPN1,FW001 63966021 BAL RETRG,LA LA 3,PN1 63973021 MVI XREG1,XRA 63980021 MVC XCON1+NX14(LX2),DOP1+NX2 COUNT OF PN S 63987021 MVI XCON1+NX16,XX02 63994021 BAL RETRG,COMP CH 1,=N 64001021 SR RW1,RW1 CALCULATE NUMBER OF PN'S 64008021 LH RW1,DOP1+NX2 MULT BY 2 PLUS 26 FOR DISP 10 64015021 SLL RW1,DX1 TO NEXT STATEMENT-USED IN BC 64022021 LA RW1,DX26(RW1) INSTRUCTIONS 64029021 CLI SEGLMT,XXFF IS PROGRAM SEGMENTED... 64036021 BE GODEP2 NO 64043021 LA RW1,DX6(RW1) DISPL INCL CALL TO SUBROUTINE 64050021 GODEP2 EQU * 64057021 STH RW1,GOCON1+NX4 64064021 OI GOCON1+NX4,XX20 64071021 MVC GOCON2+NX4(LX2),GOCON1+NX4 64078021 LA RW2,GOCON 64085021 CLI SEGLMT,XXFF 64092021 BNE GODEP3 PROGRAM IS SEGMENTED 64099021 LA RW3,DX42 64106021 MVI GOCON2+NX11,XX18 SET DISPL IN GENERATED TEXT 64113021 BAL RETRG,PUTA GO TO GENERATE RTN (SEE CONSTANT 64120021 BC UNCOND,PH5CTL FOR DESCR OF INSTRUCTIONS GENE 64127021 GODEP3 LA RW3,DX39 GEN ATXT WITHOUT 'BCR 15,1' 64134021 MVI GOCON2+NX11,XX1E SET DISPL IN GENERATED TEXT 64141021 BAL RETRG,PUTA WRITE PROC-ATXTX ELEMENT 64148021 MVI XREG2,XX01 64155021 BAL RETRG,LR * LR 0,1 59713 64162021 MVC GVIRT1(LX4),VIRTHD L 15,V(SEGM) 64169021 MVC GVIRT1+NX4(LX4),SEGMDC BCR 15,15 64176021 * SEGMDC IS DEFINED IN THE CALL TO SEGMENTATION INIT. ROUTINE 64183021 MVC VIRTC1+NX2(LX2),VIRCTR ...CALL TO SEGMENTATION 64190021 MVI XREG1,XX0F INITIALIZATION OBJECT TIME 64197021 BAL RETRG,LOAD SUBROUTINE... 64204021 BAL RETRG,GDES15 DESTROY 15 64211021 MVI XREG1,XX0F 64218021 MVI XREG2,XX0F 64225021 BAL RETRG,BRANCH GENERATE BRANCH INSTR. 64232021 B PH5CTL RETURN TO PH5CTL 64239021 EJECT 64246021 *=1 GODEPM ANALYZER 64253021 * 64260021 * PN IN DOP1 64267021 * 64274021 * 64281021 DS 0F 64288021 USING *,STNGR 64295021 GODEPM EQU * 64302021 GODEPL EQU * 64309021 MVI GMCTYP,MADCON 64316021 MVC XPN1+NX1(LX3),DOP1+NX1 64323021 MVC OP1(LX4),XAOPE1 STORE 'DOP1 IN OP1 64330021 BAL RETRG,MACRO GENERATE MACRO FOR ADCON OF 64337021 BC UNCOND,DON RETURN TO PH5CTL 64344021 SPACE 2 64351021 *=1 MOVE4 ANALYZER 64358021 * 64365021 * PN, VN, GN, OR PFMSAV IN DOP1 64372021 * VN OR PFMSAV IN DOP2 64379021 * 64386021 * 64393021 USING *,STNGR 64400021 MOVE4 EQU * 64407021 CLI DOP1,PFMSAV PERFORM SAVE AREA...... 64414021 BC EQ,MOVE4B BR IF YES 64421021 CLI DOP1,VNREF 64428021 BC EQ,MOVE4D BRANCH IF VN 64435021 CLI DOP1,GNREF 64442021 BC EQ,MOVE4L GRANCH IF GN 64449021 MVC XPN1+NX1(LX3),DOP1+NX1 MOVE PN 64456021 MOVE4M BAL RETRG,LOAD GENERATE L 0,GN OR PN 64463021 CLI DOP2,PFMSAV BRANCH IF PFMSAV 64470021 BC EQ,MOVE4E BRANCH IF PFMSAV 64477021 BC UNCOND,MOVE4F NOT PFMSAV 64484021 MOVE4D MVC XVN1+NX1(LX3),DOP1+NX1 MOVE VN TO ADDR OPERAND 64491021 BAL RETRG,LOAD GENERATE L 0,VN 64498021 MOVE4E MVC OP1(LX4),XAOPE2 64505021 MOVE4C EQU * 64512021 BAL RETRG,STORE GENERATE ST 0,PFMSAV OR 64519021 BC UNCOND,DON RETURN TO PH5CTL 64526021 MOVE4B MVC OP1(LX4),XAOPE1 64533021 BAL RETRG,LOAD GENERATE L 0,PFMSAV 64540021 MOVE4F MVC XVN1+NX1(LX3),DOP2+NX1 64547021 BC UNCOND,MOVE4C BRANCH TO GEN. ST INSTR. 64554021 MOVE4L MVC XGN1(LX2),DOP1+NX1 64561021 BC UNCOND,MOVE4M BRANCH TO GEN. L INSTR. 64568021 EJECT 64575021 *=1 EQUATE ANALYZER 64582021 * 64589021 * VN IN DOP1 64596021 * GN OR PN IN DOP2 64603021 * 64610021 * 64617021 USING *,STNGR 64624021 EQUATE MVI DOP1,PAVNDEF VNDEF.... 64631021 LA RW2,DOP1 64638021 BAL RETRG,PUTDEF PUT OUT TEXT DEF. 64645021 MVI GMCTYP,XX00 EQUATE 64652021 CLI DOP2,XXAA IS IT A GN 64659021 BC EQ,EEQ002 YES 64666021 MVC XPN1+NX1(LX3),DOP2+NX1 MOVE PN 64673021 EEQ001 EQU * 64680021 BAL RETRG,MACRO DO AN EQU PN 64687021 BC UNCOND,DON RETURN TO PH5CTL 64694021 EEQ002 EQU * 64701021 MVC XGN1(LX2),DOP2+NX1 DO AN EQU GN 64708021 BC UNCOND,EEQ001 GENERATE CORRECT MACRO 64715021 SPACE 2 64722021 *=1 PERFORM X TIMES ANALYZER 64729021 * 64736021 * PN IN DOP1 64743021 * DN,LIT, OR TALLY IN DOP2 (THE 'X' TIMES) 64750021 * LGN IN DOP3 64757021 * 64764021 * 64771021 USING *,STNGR 64778021 PERFOR EQU * 64785021 CLI DOP2,XX32 64792021 BC EQ,PEFRM2 BR IF LIT 64799021 LA RW3,DOP2 64806021 BAL RETRG,DNTOR1 ATXT GENERATOR PROCESSING 64813021 PEFRM3 MVI XREG1,XRC 64820021 MVI XCNTR1,XX0C PFMCTL 64827021 LH RETRG,PFMCTR STEP PFMCTR BY 1 64834021 LA RETRG,DX1(RETRG) 64841021 STH RETRG,PFMCTR 64848021 STH RETRG,GTEMP 64855021 MVC XCNTR1+NX1(LX2),GTEMP 64862021 BAL RETRG,STORE DO A ST XRC,PRMCTL 64869021 MVC GLGNCN+NX3(LX2),DOP3+NX1 64876021 BAL RETRG,GNOPT3 DO AN LGN 64883021 CLI SEGLMT,XXFF 64890021 BNE PEFRM4 BR,PROGRAM IS SEGMENTED 64897021 MVC PFMCON+NX5(LX2),GTEMP MOVE PFMCTR NUM TO DIRECT A-TEXT 64904021 MVC PFMCN1+NX5(LX2),GTEMP 64911021 LA RW2,PFMCON (SEE PFMCON FOR DESCR OF A-TEXT) 64918021 LA RW3,DX20 64925021 BAL RETRG,PUTA GO TO GENERATE DIRECT A-TEXT 64932021 MVI XREG1,NOTNEG 64939021 MVC XPN1+NX1(LX3),DOP1+NX1 MOVE PN 64946021 BAL RETRG,BRANCH DO A BCR NOTNEG,PN 64953021 BC UNCOND,DON RETURN TO PH5CTL 64960021 PEFRM2 MVI XREG1,XRC 64967021 MVC OP1(LX4),XAOPE2 64974021 LA RETRG,PEFRM3 64981021 BC UNCOND,LOAD GEN. PROPER L INSTR. 64988021 * SEGMENTED PROGRAM 64995021 PEFRM4 MVC A110CH1(LX3),DOP1+NX1 MOVE PN TO DIRECT ATXT 65002021 MVC A110CH2(LX2),GTEMP MOVE PFMCTR TO DIRECT ATXT 65009021 MVC A110CH3(LX2),GTEMP 65016021 BAL RETRG,GATXTV GEN ATXT 65023021 DC AL2(ATXT110-ATXTBV) SEE ATXT FOR DESCRIPTION 65030021 DC AL2(ZTXT110-ATXT110) * 65037021 MVC GTEMP(LX2),DOP1+NX2 65044021 LH RW3,GTEMP 65051021 BAL RETRG,PNUSED MARK PN AS BEING REFERENCED 65058021 MVC GVIRT1(LX4),VIRTHD 65065021 MVC GVIRT1+NX4(LX4),SEGMDC SET UP VIRTUAL 65072021 * 65079021 * SEGMDC IS DEFINED IN ROUTINE 'SEGCAL' KEEP THIS RTNE 65086021 * IN SAME CSECT. 65093021 * 65100021 MVC VIRTC1+NX2(LX2),VIRCTR 65107021 MVI XREG1,XX0F 65114021 BAL RETRG,LOAD * L 15,V(SGM0) 65121021 BAL RETRG,GDES15 DESTROY 15 65128021 MVI XREG1,NOTNEG 65135021 MVI XREG2,XX0F 65142021 BAL RETRG,BC * BCR NOTNEG,15 65149021 B PH5CTL EXIT 65156021 EJECT 65163021 ******************************************************************* 65170021 * -SEGCAL- * 65177021 * GENERATE A CALL TO THE OBJECT TIME SUBROUTINE 'XXXXSEGM'* * 65184021 * WHICH LOADS A PROGRAM SEGMENT INTO CORE. * 65191021 * INPUT...IN DOP1-PNDEF,PRIORITY,PN-NO. 65198021 * OUTPUT..GENERATED CODE- L 0,PN-NO. 65205021 * LCR 0,0 * 65212021 * L 15,V(XXXSGM0)* * 65219021 * BALR 14,15 * 65226021 * * XXXX= VIRTHD * 65233021 * * 65240021 * KEEP THIS ROUTINE IN THE SAME CSECT AS 'GO DEPENDING ON'. 65247021 * AND 'PERFORM X TIMES'. 65254021 * 'SEGMDC' IS USED BY BOTH ROUTINES 65261021 ******************************************************************* 65268021 SEGCAL MVC XPN1+NX2(LX2),DOP1+NX2 65275021 BAL RETRG,LOAD GEN.. L R0,PN-NO. 65282021 *DEL 65289021 BAL RETRG,VBADCE GEN... L R15,V(XXXXSGM0) 65296021 SEGMDC DC C'SGM1' BALR 14,15 59713 65303021 B PH5CTL RETURN TO PH5CTL 65310021 TITLE 'REPORT WRITER ROUTINES' 65317021 * 65324021 *=1 ANALYZERS FOR SPECIAL REPORT WRITER VERBS 65331021 * 65338021 * 65345021 * REPORT CALL 65352021 * 65359021 USING *,XRVERB 65366021 RPTCAL MVI A48CH1,XX0F 65373021 MVI A48CH2,XX30 65380021 BAL RETRG,GATXTV GEN... DESTROY REG 15 65387021 DC AL2(ATXT48-ATXTBV) 65394021 DC AL2(ZTXT48-ATXT48) 65401021 * 65408021 MVC XGN1(LX2),DOP1+NX1 65415021 MVI XREG1,XX0F 65422021 BAL XRSUB,LOAD L 15,GNREF 65429021 * 65436021 MVI XREG1,XX01 65443021 MVI XREG2,XX0F 65450021 BAL XRSUB,BALR BALR 1,15 65457021 * 65464021 BC UNCOND,PH5CTL GET NXT P2TXT ELEMENT 65471021 * 65478021 * REPORT SAVE 65485021 * 65492021 USING *,XRVERB 65499021 RPTSV SR XR6,XR6 65506021 MVI XCNTR1,XX44 65513021 IC XR6,HEADER+NX1 65520021 SH XR6,SXC04F 65527021 STC XR6,XCNTR1+NX2 65534021 MVI XREG1,XX01 65541021 BAL XRSUB,STORE ST 1,GTREF 65548021 BC UNCOND,PH5CTL GET NXT P2TXT ELEMENT 65555021 * 65562021 * REPORT RETURN 65569021 * 65576021 USING *,XRVERB 65583021 RPTRET SR XR6,XR6 65590021 MVI XCNTR1,XX44 65597021 IC XR6,HEADER+NX1 65604021 SH XR6,SXC055 65611021 STC XR6,XCNTR1+NX2 65618021 MVI XREG1,XX01 65625021 BAL XRSUB,LOAD L 1,GTREF 65632021 * 65639021 MVI XREG1,XX0F 65646021 MVI XREG2,XX01 65653021 BAL XRSUB,BRANCH BCR UNCOND,1 65660021 * 65667021 BC UNCOND,PH5CTL GET NXT P2TXT ELEMENT 65674021 * 65681021 * REPORT MACRO ORIGIN 65688021 * 65695021 USING *,XRVERB 65702021 RPTORG LA XR2,RPTMOG 65709021 LA XR3,DX2 65716021 BAL RW0,WRITE3 4438 MACRO-ORIGIN 65723021 LA XR2,DOP1 65730021 LA XR3,DX3 65737021 MVI DOP1,XX50 65744021 BAL RW0,WRITE3 50NNNN GNREF 65751021 MVC DOP1(LX4),PNUX80 65758021 CLC DOP2(LX2),RPWZER 65765021 BC EQ,RPTOG1 IF FIGCON EQ ZERO,SKIP NXT INS. 65772021 MVI DOP1+NX3,XX04 65779021 RPTOG1 LA XR3,DX4 65786021 LA XR2,DOP1 65793021 BAL RW0,WRITE3 PLUS 0 OR 4 65800021 MVC XPN1+NX1(LX3),DOP3+NX1 MOVE PN 65807021 MVI XREG1,XX02 65814021 BAL XRSUB,LOAD L 2,PNREF 65821021 BC UNCOND,PH5CTL GET NXT P2TXT ELEMENT 65828021 DS 0H 65835021 USING *,XRVERB 65842021 ENDUS4 LA XR2,RPTNDU 65849021 LA XR3,DX10 65856021 BAL RETRG,PUTA PUT OUT A-TEXT 7898 65863021 BC UNCOND,PH5CTL GET NXT P2TXT ELEMENT 65870021 RPTNDU DC X'48582064440007' 65877021 DC X'4807F2' 65884021 * 65891021 * REPORT MACRO RE-ORIGIN 65898021 * 65905021 USING *,XRVERB 65912021 RPTRRG LA XR2,RPTMRG 65919021 LA XR3,DX9 65926021 BAL RW0,WRITE3 443C MACRO-REORIGIN 65933021 BC UNCOND,PH5CTL GET NXT P2TXT ELEMENT 65940021 USING *,XRVERB 65947021 RPTNOP LA XR6,DX10 65954021 MVI BDISP1,XX10 65961021 CLC DOP1(LX2),RPWZER 65968021 BC NOTEQ,RPTNO2 IF FIGCON NOT ZERO,SKIP NXT INS 65975021 LA XR6,DX4(XR6) 65982021 MVI BDISP1,XXF0 65989021 RPTNO2 STC XR6,BDISP1+NX1 65996021 MVI XREG1,UNCOND 66003021 BAL XRSUB,BRANCH GEN ATXT FOR BRANCH INSTRUC 66010021 MVI XREG1,XX02 66017021 MVI XREG2,XX02 66024021 BAL XRSUB,BALR GEN ATXT FOR BALR INSTRUC 66031021 MVI XREG1,NOP 66038021 MVI BDISP1+NX1,XX00 66045021 MVI BDISP1,XX10 66052021 CLC DOP1(LX2),RPWZER 66059021 BC NOTEQ,RPTNO3 FIGCON NOT ZERO,SKIP NXT INS 66066021 MVI BDISP1,XXF0 66073021 RPTNO3 BAL XRSUB,BRANCH GENERATE DUMMY BRANCH 66080021 BC UNCOND,PH5CTL GET NXT P2TXT ELEM 66087021 TITLE 'IKFCBL51: SET VERB ANALYZERS S E T' 51894 66094021 * 66101021 * 66108021 * 66115021 * SET FORMAT-1: THE FOLLOWING FORMULAS ARE USED 66122021 * INDEX1 = INDEX2 * L1 / L2. 66129021 * INDEX1 = INDEX-DATA-ITEM2 66136021 * INDEX1 =(IDENTIFIER2 - 1)* L1. 66143021 * INDEX-DATA-ITEM= OPERAND2. 66150021 * IDENTIFIER1= INDEX2 /L2 +1. 66157021 * INPUT: DOP1= RECEIVING DOP2 = SENDING 66164021 * 66171021 * 66178021 IKF50M CSECT 66185021 * 66192021 * 66199021 USING *,XRVERB 66206021 SET1 MVI XREGNO,XX01 66213021 LA RW4,DOP1 66220021 LA RW6,DOP2 66227021 CLI DX0(RW4),XX36 FIRST OP IS INDEX-NAME. 66234021 BNE SET100 NO 66241021 CLI DX0(RW6),XX36 2ND OP IS INDEX-NAME. 66248021 BNE SET101 NO 66255021 CLC DX2(LX1,RW4),DX2(RW6) SAME TYPE OF INDEX-NAME. 66262021 BNE SET102 NO 66269021 CLC DX5(LX2,RW4),DX5(RW6) SAME ENTRY LENGTH 66276021 BNE SET102 ATXT TO SET INDEXNM TO INNM TBL 66283021 * 66290021 * 66297021 SET104 ST RW4,OP1 MVC OP1(4),OP2 - MOVE WITH 66304021 ST RW6,OP2 CONVERSION. 66311021 MVI XL1+NX1,XX04 66318021 BAL XRSUB,MVC GEN ATXT FOR MVC INSTRUC 66325021 B SET114 KILL SUBS & INDX OPTIMIZ TBL 66332021 * 66339021 * INDEX-NAME SET TO AN INDEX-NAME FROM AN OTHER TABLE. 66346021 * 66353021 * L 1,INDX2 66360021 * LH 2,L1 66367021 * MR 0,2 66374021 * LH 2,L2 66381021 * DR 0,2 66388021 * ST 0,INDX1 66395021 * 66402021 * 66409021 SET102 MVI XREGNO,XX02 66416021 LR RW3,RW4 PRESERVE R4 OVER XFREER 66423021 MVI XREG1,XX01 66430021 ST RW6,OP1 L 1,INDX2 66437021 BAL XRSUB,LOAD GEN ATXT FOR LOAD INSTRUC 66444021 LR RW4,RW3 RESTORE R4 66451021 BAL XRSUB,SETLEN LH 2,L1 66458021 MVI XREG1,XX02 66465021 BAL XRSUB,LHALF GEN ATXT FOR LH INSTRUC 66472021 MVI XREG2,XX02 66479021 BAL XRSUB,MULT MR 0,2 66486021 SET109 LR RW3,RW6 66493021 BAL XRSUB,SETLEN SET ATXT BUFFER FOR LIT OR VLC 66500021 MVI XREG1,XX02 66507021 BAL XRSUB,LHALF LH 2,L2 66514021 MVI XREG2,XX02 66521021 BAL XRSUB,DIV DR 0,2 66528021 * 66535021 * 66542021 MVI XREG1,XX01 66549021 CLI DX0(RW4),XX36 66556021 BE SET110 FOR INDXNMREF,GEN ST 1,INDX1 66563021 MVI XCON1+NX16,XX02 IF RECEIVING IS AN IDENTIF 66570021 MVI XCON1+NX15,XX01 GENERATE: 66577021 BAL XRSUB,ADD AH 1,=1 . 66584021 CLI XGTEM2,XGBINR IS RECEIVING BINARY... 66591021 BE SET111 YES, GEN A DIRECT ST INTO RECEIV 66598021 MVI XREG1,XX01 66605021 MVI XCNTR1,TS2CODE 66612021 MVI XCNTR1+NX2,XX01 66619021 BAL XRSUB,CVD * CVD 1,TEMP-STOR2 66626021 CLC TS2MAX(LX2),XC008 66633021 BNL SET112 IF CTR FOR TS2 IS LOWER THAN 8, 66640021 MVI TS2MAX+NX1,XX08 SET IT TO 8 66647021 SET112 MVC XL1+NX1(LX1),XOPLGH+NX3 SET LENGTH 66654021 MVI XL2+NX1,XX08 66661021 ST RW4,OP1 66668021 MVI XCNTR2,TS2CODE 66675021 MVI XCNTR2+NX2,XX01 66682021 CLI XGTEM2,XGINDC IS RECEIV INTERNAL DEC... 66689021 BNE SET113 NO, MUST BE EXT DEC 66696021 BAL XRSUB,ZAP * ZAP RECEIV,TEMP-STOR2 66703021 SET114 EQU * 66710021 B PH5CTL EXIT 66717021 SET113 MVI XL2+NX1,XX08 66724021 BAL XRSUB,LCRBI * UNPK RECEIV,TS2 66731021 TM XGSCIN(RW4),XX01 RF SIGNED... 66738021 BO SET114 YES 66745021 ST RW4,OP1 NO, GEN OI 66752021 MVI IMM,XXF0 66759021 CLI XGTEM2,XGINDC ID 66766021 BNE SET130 NO 66773021 MVI IMM,XX0F 66780021 SET130 DS 0H 66787021 LH RW5,XOPLGH+NX2 GET LENGTH 66794021 BCTR RW5,RW0 SUBTRACT ONE 66801021 STC RW5,PLUS1+NX2 66808021 BAL XRSUB,OI GENERATE OI 66815021 B SET114 CLEAN UP AND EXIT 66822021 SET111 MVI XREG1,XX01 66829021 SET110 ST RW4,OP1 66836021 BAL XRSUB,STORE ST 1,INDX1. 66843021 B SET114 OR 66850021 * ST 1,IDENTIFIER1. 66857021 * 66864021 * INDEX -NAME SET TO INDEX-DATA ITEM OR IDENTIFIER OR LITER 66871021 * 66878021 SET101 LR RW3,RW6 66885021 CLI DX0(RW6),XX32 66892021 BE SET106 IF NUMLIT,GEN L,BCTR,MH,ST,L INS 66899021 CLI DX0(RW6),XGFCT FIGCON... 66906021 BNE SET101A NO 66913021 MVC DX0(LX4,RW6),SCHLIT YES,CHANGE TO LITERAL OF 0 WHICH 66920021 MVI DX4(RW6),XX0C IS ONLY VALID FIGCON USE HERE 66927021 B SET106 AND PROCESS AS LITERAL 66934021 SET101A EQU * 66941021 BAL XRSUB,XLENGH GET LENGTH OF DNM 66948021 CLI XGTEM2,SETINDI 66955021 BE SET104 INDEX TO INDEX DATA ITEM. 66962021 * 66969021 * INDEX TO IDENTIFIER OR LITERAL 66976021 * 66983021 BAL XRSUB,DNTOR1 LOAD AND CONVERT TO BI IF N 66990021 * L 1,IDENT1 66997021 SET107 MVI XREG1,XX01 67004021 BAL XRSUB,BRNCNT BCTR 1,0 67011021 LR RW3,RW4 67018021 BAL XRSUB,SETLEN SET ATXT BUFFER FOR FXED OR VLC 67025021 MVI XREG1,XX01 67032021 BAL XRSUB,MULT MH 1,L1 67039021 B SET111 ST 1,INDX1 67046021 SET106 BAL RETRG,LOADLIT L 1,LITERAL 67053021 B SET107 GEN BCTR,MH,ST FOR LITERAL 67060021 * 67067021 * INDEX DATA ITEM TO INDEX NAME OR 67074021 * IDENTIFIER TO INDEX NAME. 67081021 * 67088021 SET100 LR RW3,RW4 67095021 BAL XRSUB,XLENGH GET LENGTH OF DNM 67102021 CLI XGTEM2,SETINDI 67109021 BE SET104 INDEX DATA ITEM IS REC. 67116021 * 67123021 * RECEIVING IS IDENTIFIER 67130021 LR RW4,RW3 RESTORE R4 AFTER XFREER 67137021 BAL XRSUB,SUB SR 0,0 67144021 BAL RETRG,LOADLIT L 1,INDX2 67151021 B SET109 LH 2,L2 67158021 * DR 0,2 67165021 * AH 1,=1 67172021 * ST 1,IDENT1 67179021 * 67186021 SETINDI EQU 7 67193021 EJECT 67200021 * 67207021 * SET FORMAT2 FORMULAS USED : 67214021 * 67221021 * 1) UP BY INDX1 = INDX1+(IDENT2 )* L1. 67228021 * 2) DOWN BY INDX1 = INDX1-(IDENT2 )* L1. 67235021 *INPUT: DOP1= INDX1 DOP2= IDENT2 67242021 * 67249021 USING *,XRVERB 67256021 SET2UP SR RW2,RW2 67263021 B SETCOM BR TO GEN UP BY CODE 67270021 * 67277021 * 67284021 USING *,XRVERB 67291021 SET2DOWN LR RW2,XRVERB 67298021 B SETCOM BR TO GEN DOWN BY CODE 67305021 * 67312021 * 67319021 SETCOM BALR XRVERB,RW0 ESTABLISH ADDRESSABILITY 67326021 USING *,XRVERB 67333021 * 67340021 * 67347021 LA RW4,DOP1 67354021 LA RW3,DOP2 67361021 CLI DX0(RW3),XX32 67368021 BE SET200 IF DOP NUMLIT,GEN L 1,LIT 67375021 BAL XRSUB,DNTOR1 L 1,IDENT2 67382021 SET202 LR RW3,RW4 67389021 BAL XRSUB,SETLEN SET ATXT BUFFER FOR DOPS 67396021 MVI XREG1,XX01 MH 1,L1 67403021 BAL XRSUB,MULT GEN ATXT FOR MULTIPLY INSTRUC 67410021 ST RW4,OP1 67417021 MVI XREG1,XX01 67424021 LA XRSUB,SET201 67431021 LTR RW2,RW2 A 1,INDX1 67438021 BZ ADD ST 1,INDX1 67445021 BAL XRSUB,SUB OR 67452021 MVI XREG1,XX01 67459021 MVI XREG2,XX01 S 1,INDX1 67466021 BAL XRSUB,LCRBI LCR 1,1 67473021 SET201 ST RW4,OP1 ST 1,INDX1 67480021 MVI XREG1,XX01 67487021 BAL XRSUB,STORE GEN ATXT FOR STORE INSTR 67494021 B PH5CTL GEN NXT P2TXT ELEMENT 67501021 * 67508021 SET200 LR RW6,RW3 IF OP1 IS A LITERAL... 67515021 BAL RETRG,LOADLIT L 1,LITERAL 67522021 B SET202 GEN ATXT FOR MH 1,L1 67529021 EJECT 67536021 *DEL 5189 67543021 *DEL 5189 67550021 *DEL 5189 67557021 *DEL 5189 67564021 *DEL 5189 67571021 *DEL 5189 67578021 *DEL 5189 67585021 *DEL 5189 67592021 *DEL 5189 67599021 *DEL 5189 67606021 *DEL 5189 67613021 *DEL 5189 67620021 *DEL 5189 67627021 *DEL 5189 67634021 *DEL 5189 67641021 *DEL 5189 67648021 *DEL 5189 67655021 *DEL 5189 67662021 *DEL 5189 67669021 *DEL 5189 67676021 *DEL 5189 67683021 *DEL 5189 67690021 *DEL 5189 67697021 *DEL 5189 67704021 *DEL 5189 67711021 *DEL 5189 67718021 *DEL 5189 67725021 *DEL 5189 67732021 *DEL 5189 67739021 *DEL 5189 67746021 *DEL 5189 67753021 *DEL 5189 67760021 *DEL 5189 67767021 *DEL 5189 67774021 *DEL 5189 67781021 *DEL 5189 67788021 *DEL 5189 67795021 *DEL 5189 67802021 *DEL 5189 67809021 *DEL 5189 67816021 *DEL 5189 67823021 *DEL 5189 67830021 *DEL 5189 67837021 *DEL 5189 67844021 *DEL 5189 67851021 *DEL 5189 67858021 *DEL 5189 67865021 *DEL 5189 67872021 *DEL 5189 67879021 *DEL 5189 67886021 *DEL 5189 67893021 *DEL 5189 67900021 *DEL 5189 67907021 *DEL 5189 67914021 *DEL 5189 67921021 *DEL 5189 67928021 *DEL 5189 67935021 *DEL 5189 67942021 *DEL 5189 67949021 *DEL 5189 67956021 *DEL 5189 67963021 *DEL 5189 67970021 *DEL 5189 67977021 *DEL 5189 67984021 *DEL 5189 67991021 *DEL 5189 67998021 *DEL 5189 68005021 *DEL 5189 68012021 *DEL 5189 68019021 *DEL 5189 68026021 *DEL 5189 68033021 *DEL 5189 68040021 *DEL 5189 68047021 *DEL 5189 68054021 *DEL 5189 68061021 *DEL 5189 68068021 *DEL 5189 68075021 *DEL 5189 68082021 *DEL 5189 68089021 *DEL 5189 68096021 *DEL 5189 68103021 *DEL 5189 68110021 *DEL 5189 68117021 *DEL 5189 68124021 *DEL 5189 68131021 *DEL 5189 68138021 *DEL 5189 68145021 *DEL 5189 68152021 *DEL 5189 68159021 *DEL 5189 68166021 *DEL 5189 68173021 *DEL 5189 68180021 *DEL 5189 68187021 *DEL 5189 68194021 *DEL 5189 68201021 *DEL 5189 68208021 *DEL 5189 68215021 *DEL 5189 68222021 *DEL 5189 68229021 *DEL 5189 68236021 *DEL 5189 68243021 *DEL 5189 68250021 *DEL 5189 68257021 *DEL 5189 68264021 *DEL 5189 68271021 *DEL 5189 68278021 *DEL 5189 68285021 *DEL 5189 68292021 *DEL 5189 68299021 *DEL 5189 68306021 *DEL 5189 68313021 *DEL 5189 68320021 *DEL 5189 68327021 *DEL 5189 68334021 *DEL 5189 68341021 *DEL 5189 68348021 *DEL 5189 68355021 *DEL 5189 68362021 *DEL 5189 68369021 *DEL 5189 68376021 *DEL 5189 68383021 *DEL 5189 68390021 *DEL 5189 68397021 *DEL 5189 68404021 *DEL 5189 68411021 *DEL 5189 68418021 *DEL 5189 68425021 *DEL 5189 68432021 *DEL 5189 68439021 *DEL 5189 68446021 *DEL 5189 68453021 *DEL 5189 68460021 *DEL 5189 68467021 *DEL 5189 68474021 *DEL 5189 68481021 EJECT 51894 68488021 * THESE VERBS SHOULD NOT BE PASSED TO PHASE 51 68495021 XOTADD EQU 0 68502021 XOTSUB EQU 0 68509021 XOTMUL EQU 0 68516021 XOTDIV EQU 0 68523021 EXPONE EQU 0 68530021 STOREE EQU 0 68537021 SEARCHAL EQU 0 68544021 POVFLO EQU 0 68551021 PEQNUM EQU 0 68558021 NEQNUM EQU 0 68565021 PGTNUM EQU 0 68572021 NGTNUM EQU 0 68579021 PLTNUM EQU 0 68586021 NLTNUM EQU 0 68593021 XEVAL EQU 0 68600021 SSCRPT EQU 0 68607021 ENDSCHAL EQU 0 68614021 EQUSCHR EQU 0 68621021 IFINEQUA EQU 0 51894 68628021 IFINNEQU EQU 0 51894 68635021 IFINGREA EQU 0 51894 68642021 IFINNGRE EQU 0 51894 68649021 IFINLESS EQU 0 51894 68656021 IFINNLES EQU 0 51894 68663021 RPMOVE EQU 0 68670021 *DEL 5189 68677021 *DEL 5189 68684021 *DEL 5189 68691021 *DEL 5189 68698021 *DEL 5189 68705021 *DEL 5189 68712021 *DEL 5189 68719021 *DEL 5189 68726021 *DEL 5189 68733021 *DEL 5189 68740021 *DEL 5189 68747021 *DEL 5189 68754021 *DEL 5189 68761021 *DEL 5189 68768021 *DEL 5189 68775021 *DEL 5189 68782021 *DEL 5189 68789021 EJECT 51894 68796021 IKF504 CSECT 68803021 COMON4 EQU * 68810021 USING *,XRCONS 68817021 ZAPZAP DS 100F ************ USE FOR SUPERZAP ************ 68824021 COSADR DC A(0) 68831021 ******** VERB TRANSFER VECTOR TABLE ** KEEP TOGETHER ****************** 68838021 ADCN00 DC A(XOTADD) ADCN00 68845021 DC A(XOTSUB) ADCN01 68852021 ADCN02 DC A(XOTMUL) ADCN02 68859021 ADCN03 DC A(XOTDIV) ADCN03 68866021 DC A(EXPONE) ADCN04 68873021 DC A(STOREE) ADCN05 68880021 DC A(PEQNUM) ADCN06 68887021 DC A(NEQNUM) ADCN07 68894021 DC A(PGTNUM) ADCN08 68901021 DC A(NGTNUM) ADCN09 68908021 DC A(PLTNUM) ADCN0A 68915021 DC A(NLTNUM) ADCN0B 68922021 DC A(PALFA) ADCN0C 68929021 DC A(NALFA) ADCN0D 68936021 DC A(PNUMRC) ADCN0E 68943021 ADCN0F DC A(NNUMRC) ADCN0F 68950021 DC A(STOP) ADCN10 68957021 DC A(GO) ADCN11 68964021 DC A(GODEP1) ADCN12 68971021 DC A(GODEPM) ADCN13 68978021 DC A(GODEPL) ADCN14 68985021 DC A(XEVAL) ADCN15 68992021 DC A(PEQNNU) ADCN16 68999021 DC A(NEQNNU) ADCN17 69006021 DC A(PGTNNU) ADCN18 69013021 DC A(NGTNNU) ADCN19 69020021 DC A(PLTNNU) ADCN1A 69027021 DC A(NLTNNU) ADCN1B 69034021 DC A(MOVE4) ADCN1C 69041021 ADCN1D DC A(MOVE) ADCN1D 69048021 DC A(EXAMIN) ADCN1E 69055021 DC A(TRANSF) ADCN1F 69062021 ADCN20 DC A(READ) ADCN20 69069021 ADCN21 DC A(OPEN) ADCN21 69076021 DC A(CLOSE) ADCN22 69083021 ADCN23 DC A(WRITE) ADCN23 69090021 DC A(REWRIT) ADCN24 69097021 DC A(ACCEPT) ADCN25 69104021 DC A(DISPLA) ADCN26 69111021 DC A(EXHIBI) ADCN27 69118021 DC A(RESET) ADCN28 69125021 DC A(READY) ADCN29 69132021 DC A(RETURN) ADCN2A 69139021 DC A(ON) ADCN2B 69146021 DC A(ENTRY) ADCN2C 69153021 ADCN2D DC A(CALL) ADCN2D 69160021 DC A(ENTER) ADCN2E 69167021 DC A(PH5CTL) ADCN2F 69174021 DC A(PH5CTL) ADCN30 69181021 DC A(USE) ADCN31 69188021 DC A(EXIT) ADCN32 69195021 DC A(RPTNOP) ADCN33 69202021 DC A(PH5CTL) ADCN34 69209021 DC A(PH5CTL) ADCN35 69216021 DC A(SORT) ADCN36 69223021 DC A(RELEES) ADCN37 69230021 DC A(PERFOR) ADCN38 69237021 ADCN39 DC A(SSCRPT) ADCN39 69244021 DC A(LINKK) ADCN3A 69251021 DC A(ADEBUG) ADCN3B 69258021 DC A(PH5CTL) ADCN3C 69265021 DC A(TRACE) ADCN3D 69272021 DC A(EQUATE) ADCN3E 69279021 DC A(PH5CTL) ADCN3F MOVE1(RPT WRITER) 69286021 DC A(QINITV) ADCN40 69293021 DC A(QINCRA) ADCN41 69300021 DC A(QSTEPV) ADCN42 69307021 ADCN43 DC A(QUPDAT) ADCN43 69314021 DC A(USE5) ADCN44 69321021 DC A(ENDUS5) ADCN45 69328021 DC A(USE1) ADCN46 69335021 DC A(ENDUS1) ADCN47 69342021 DC A(PH5CTL) ADCN48 69349021 DC A(PH5CTL) ADCN49 69356021 DC A(USE4) ADCN4A (RPT DECL) 43521 69363021 DC A(ENDUS4) ADCN4B END USE BEFORE REPTING 69370021 DC A(QCALLV) ADCN4C 69377021 DC A(QRET2V) ADCN4D 69384021 DC A(QRETUV) ADCN4E 69391021 DC A(RPTCAL) ADCN4F 69398021 DC A(RPTSV) ADCN50 69405021 DC A(RPTSV) ADCN51 69412021 DC A(RPTSV) ADCN52 69419021 DC A(RPTSV) ADCN53 69426021 DC A(RPTSV) ADCN54 69433021 DC A(RPTSV) ADCN55 69440021 DC A(RPTRET) ADCN56 69447021 DC A(RPTRET) ADCN57 69454021 DC A(RPTRET) ADCN58 69461021 DC A(RPTRET) ADCN59 69468021 DC A(RPTRET) ADCN5A 69475021 DC A(RPTRET) ADCN5B 69482021 DC A(RPTORG) ADCN5C 69489021 DC A(RPTRRG) ADCN5D 69496021 * 69503021 DC A(SEARCHAL) ADCN5E 69510021 DC A(ENDSCHAL) ADCN5F 69517021 DC A(SET1) ADCN60 69524021 DC A(SET2UP) ADCN61 69531021 DC A(PH5CTL) ADCN62 69538021 DC A(PH5CTL) ADCN63 69545021 DC A(START) ADCN64 69552021 DC A(PH5CTL) ADCN65 69559021 DC A(IFINEQUA) ADCN66 69566021 DC A(IFINNEQU) ADCN67 69573021 DC A(IFINGREA) ADCN68 69580021 DC A(IFINNGRE) ADCN69 69587021 DC A(IFINLESS) ADCN6A 69594021 DC A(IFINNLES) ADCN6B 69601021 DC A(VIRTDEF) ADCN6C 69608021 DC A(EQUSCHR) ADCN6D 69615021 DC A(SET2DOWN) ADCN6E 69622021 DC A(SEGCAL) ADCN6F 69629021 DC A(PH5CTL) ADCN70 69636021 DC A(READCHCK) ADCN71 69643021 ADCN72 DC A(WRITCHCK) ADCN72 69650021 ADCN73 DC A(GOBACK) ADCN73 69657021 DC A(EXITPGM) ADCN74 69664021 DC A(PH5CTL) ADCN75 69671021 DC A(QRNAM) ADCN76 69678021 * 69685021 *DEL 5189 69692021 *DEL 5189 69699021 XFIVE EQU 5 69706021 XSTRSW DS 1C SW TO IND BEG OF STRING IN CALL 69713021 XGTEM2 DS 2D SAVE AREA 69720021 XREGNO DS 1C REG NO NEWLY ASSIGNED 69727021 *DEL 5189 69734021 *DEL 5189 69741021 XSUMK5 DC X'00000F' 69748021 *DEL 5189 69755021 *DEL 5189 69762021 *DEL 5189 69769021 *DEL 5189 69776021 *DEL 5189 69783021 *DEL 5189 69790021 DS 0F 69797021 GZERO DC XL15'0' 69804021 DC XL15'0' 69811021 DC XL15'0' 69818021 DC XL15'0' 69825021 FW001 DC F'1' FULL WORD CONSTANT = 1 69832021 FW002 DC F'2' FULL WORD CONSTANT = 2 69839021 FW4096 DC F'4096' 69846021 * 69853021 * 69860021 GFOUR DC F'4' 69867021 G20 DC XL2'14' 69874021 * 69881021 DS 0F 69888021 GHFHI DC X'000032767C' MAXIMUM BINARY HALFWORD VALUE 69895021 GHFLO DC X'000032768D' MINIMUM BINARY HALFWORD VALUE 69902021 GFLHI DC X'0000000002147483647C' MAXIMUM BINARY FULLWORD VALUE 69909021 GFLLO DC X'0000000002147483648D' MINIMUM BINARY FULLWORD VALUE 69916021 TENPW9 DC F'1000000000' 10 TO THE NINTH POWER 69923021 *DEL 5189 69930021 *DEL 5189 69937021 * 69944021 * SAVE AREAS - PRESERVE INDEXES FOR SUBROUTINES 69951021 ********************************** 69958021 SVWJHE DS 4D USED BY MUTUALLY EXCLUSIVE IO SR' 69965021 XGSAV1 DS 16F X 69972021 *DEL 5189 69979021 XGSAV3 DS 16F X 69986021 *DEL 5189 69993021 *DEL 5189 70000021 *DEL 5189 70007021 *DEL 5189 70014021 XGSAV8 DS 16F X 70021021 *DEL 5189 70028021 *DEL 5189 70035021 *DEL 5189 70042021 *DEL 5189 70049021 *DEL 5189 70056021 *DEL 5189 70063021 ********************************** 70070021 * 70077021 * REGISTER SAVERS 70084021 SVDIS1 DS 7F X 70091021 SVDIS2 DS 6F X 70098021 SVDIS3 DS 4F X 70105021 SVDIS4 DS 1F X 70112021 SVDIS5 DS 6F X 70119021 SVDIS6 DS 1F X 70126021 SVGETD DS 16F GETDOP SAVER 70133021 SVGETS DS 1F SAVE GETSW RW2 70140021 SVWJH1 DS 1F X 70147021 SVWJH2 DS 1F X 70154021 SVWJH3 DS 1F X 70161021 SVWJH4 DS 1F X 70168021 SVWJH5 DS 1F X 70175021 SVWJH6 DS 1F X 70182021 SVWJH7 DS 1F X 70189021 SVWJH8 DS 1F X 70196021 SVWJH9 DS 1F X 70203021 SVWJHA DS 1F X 70210021 SVWJHB DS 1F X 70217021 SVWJHC DS 1F X 70224021 SVWJHD DS 1F X 70231021 SVWJHF DS 1F X 37374 70238021 SVWJHG DS 1F X 70245021 SVWJHH DS 1F X 70252021 SVWJHI DS 7F SAVER FOR ADETER 70259021 SVWJHJ DS 1F X 70266021 SVWJHK DS 1F X 70273021 SVWJHL DS 2F X 70280021 SVWJHM DS 1F X 70287021 SVWJHN DS 1F X 70294021 SVWJHO DS 1F X 70301021 SVWJHP DS 7F SAVE REG'S OVER XFREER 70308021 SVWJHQ DS 3F X 70315021 SVWJHR DS 8F 70322021 SVWJHS DS 2F X 70329021 SVWJHT DS 1F X 70336021 SVWJHU DS 1F SAVER FRO REGMAC RTN 70343021 SVSO14 DS 6F CALCLG SAVER 70350021 SVGATX DS 6F X 70357021 DWB DS 1D I/O SAVE AREA 70364021 CLSSV DS 1F X 70371021 LRECLTMP DS 1H WORK AREA FOR DCBLRECL CALC 5962 70378021 EJECT 70385021 *DEL 5189 70392021 *DEL 5189 70399021 *DEL 5189 70406021 *DEL 5189 70413021 *DEL 5189 70420021 *DEL 5189 70427021 *DEL 5189 70434021 *DEL 5189 70441021 *DEL 5189 70448021 *DEL 5189 70455021 *DEL 5189 70462021 XTALLV DC X'300B00B0300D4C040005FFFFFF' 70469021 SPACE 2 70476021 *DEL 5189 70483021 *DEL 5189 70490021 *DEL 5189 70497021 *DEL 5189 70504021 *DEL 5189 70511021 *DEL 5189 70518021 *DEL 5189 70525021 *DEL 5189 70532021 *DEL 5189 70539021 *DEL 5189 70546021 *DEL 5189 70553021 *DEL 5189 70560021 *DEL 5189 70567021 *DEL 5189 70574021 *DEL 5189 70581021 *DEL 5189 70588021 ******************************* 70595021 * INTEGER CONSTANTS 70602021 DS 0D 70609021 XC000 DC 4F'0' FOUR FULL WORDS OF 0 70616021 XC001 EQU FW001+2 HALF WD = 1 70623021 XC002 EQU FW002+2 HALF WD = 2 70630021 XC003 DC 1H'3' HALF WD = 3 70637021 XC004 EQU GFOUR+2 HALF WD = 4 70644021 XC005 DC 1H'5' 70651021 XC006 DC 1H'6' 70658021 XC007 DC 1H'7' 70665021 XC008 DC 1H'8' 70672021 XC009 DC 1H'9' 70679021 XC010 DC 1H'10' 70686021 XC011 DC 1H'11' 70693021 XC012 DC 1H'12' 70700021 XC014 DC 1H'14' 70707021 XC015 DC 1H'15' 70714021 XC016 DC 1H'16' 70721021 XC018 DC 1H'18' 70728021 XC028 DC H'0028' 70735021 XC029 DC 1H'29' 70742021 XC030 DC 1H'30' 70749021 XC032 DC 1H'32' 70756021 XC060 DC 1H'60' 70763021 XC0122 DC 1H'122' 70770021 XC0255 DC 1H'255' 70777021 XC4095 DC 1H'4095' 70784021 XC4096 EQU FW4096+2 HALF WD = 4096 70791021 ****************************** 70798021 GTWO EQU XC002 70805021 GTHREE EQU XC003 70812021 GFIVE EQU XC005 70819021 GSEVEN EQU XC007 70826021 GSXTEN EQU XC016 70833021 SPACE 2 70840021 XLEN1 DS 1H 70847021 XLEN2 DS 1H LGTH RECEIV FLD IN ALPHA MVE 70854021 SAVTYP DC X'00' RECEIV FLD DATA TYPE-ALPHA MVE 70861021 GNSAVE DS 2F SAVE REGS FOR CALL QRTNS 7330 70868021 TAMSAV DS 1F SAVE ADDRESS OF TAMM 01041 70875021 SPACE 2 70882021 ****************************** 70889021 * VARIOUS MASKS 70896021 DS 0F 70903021 XEMK1 DC X'00FFFFFF' 70910021 XREMK6 DC X'000080' 70917021 SPACE 10 70924021 * VARIOUS ADCON . 70931021 * 70938021 * 70945021 XSSDB2 DC A(XSUDB2) 70952021 *DEL 5189 70959021 *DEL 5189 70966021 XAOPE1 DC A(DOP1) INPUT BUFFER ADDRESSES 70973021 XAOPE2 DC A(DOP2) 70980021 XAOPE3 DC A(DOP3) 70987021 XAOPE4 DC A(DOP4) 70994021 XAOPE5 DC A(DOP5) 71001021 AIMINIT0 DC A(IMINIT0) 71008021 SPACE 2 71015021 FPALOD DC A(LSSPRO) 71022021 XALAMA DC A(XALAMV) 71029021 * TAMER PARAMETER LIST 71036021 * 71043021 DS 0F 71050021 XAAVAL EQU * 71057021 PARAV DC X'02' AVAIL. TABLE PARAM.LIST FOR PRIME. 71064021 DC AL3(XAVAL) X 71071021 DC X'0190' X 71078021 DC X'0028' X 71085021 SPACE 2 71092021 XAINTR EQU * 71099021 PARAM DC X'20' INT. RES. TABLE PARAM.LIST FOR PRIME. 71106021 DC AL3(XINTR) X 71113021 DC X'0C80' X 71120021 DC X'0280' X 71127021 SPACE 2 71134021 PNUPRM DC X'04' PARAM LIST FOR PNUTBL 71141021 DC AL3(PNUTBL) X 71148021 DC H'0' X 71155021 DC H'4' X 71162021 PNUTBA EQU PNUPRM X 71169021 SEGPRM DC X'05' SEGMENT ADDR TABLE 71176021 DC AL3(XSEGM) X 71183021 DC H'30' X 71190021 DC H'20' X 71197021 ****************************** 71204021 SPACE 3 37330 71211021 GNCALPRM DS 0F PARM LIST FOR GNCALTBL 7330 71218021 DC X'03' X 7330 71225021 DC AL3(GNCALTBL) X 7330 71232021 DC H'9' X 7330 71239021 DC H'3' X 7330 71246021 EJECT 71253021 * NON-ARITHMETIC CONSTANT AREA 71260021 * 71267021 VIRTHD DC C'ILBO' FIRST 4 CHAR OF ALL SUBROUTINES 71274021 DIA1C1 DC C'DSP0' DISPLAY VIRTUAL NAME 71281021 DIFPVI DC C'TEF3' IFP TO EFP - - 71288021 SORTC1 DC C'SRT0' SORT INTERFACE - - 71295021 ACCPVI DC C'ACP0' ACCEPT - - 71302021 BSAMVI DC C'SAM0' BSAM 71309021 SPACCON DC C'SPA0' SPACE SUBR 71316021 BSAMREAD DC C'SAMR' BSAM SPANNED READ ROUTINE 71323021 PTOVCON1 DC C'PTV1' 71330021 PTOVCON2 DC C'PTV2' 71337021 ERBICON DC C'ERR5' 71344021 CHPTCON DC C'CKP0' CHECKPOINT SUBRTN 71351021 SPACES DC CL4' ' 71358021 ADCON1 DC A(DIDNIQ) COMMONLY 71365021 ADCON2 DC A(DIINFQ) USED 71372021 ADCON3 DC A(DITYPQ) SUB- 71379021 ADCON4 DC A(DILGTQ) ROUTINES 71386021 ADCON5 DC A(DIBDIQ) WITH- 71393021 ADCON6 DC A(DICO1Q) IN 71400021 ADCON7 DC A(DICNOQ) THE 71407021 ADCON8 DC A(DIBALQ) PHASE 71414021 ADCON9 DC A(DICO8Q) X 71421021 ADCONA DC A(CALCLQ) X 71428021 ADCONB DC A(IOQRTQ) X 71435021 ADCONC DC A(IOSTBQ) X 71442021 ADCONG DC A(GETDOQ) X 71449021 ADCONH DC A(GETSWQ) X 71456021 ADCONI DC A(DRELAQ) X 71463021 ADCONK DC A(NXTSTQ) X 71470021 ADCONL DC A(CALL01) X 71477021 ADCONM DC A(ADETEQ) X 71484021 ADCONN DC A(DDISPQ) X 71491021 ADCONP DC A(CLSQDQ) X 71498021 HWDONE DC XL4'00000001' FULL WORD CONSTANT OF ONE 71505021 EXHIC1 DC XL4'80000000' FULL WD CONSTANT FOR EXHIBIT 71512021 FWDTHR DC XL4'3' FULL WORD CONSTANT OF 3 71519021 HW4096 EQU FW4096+2 71526021 LBLSW DC X'00' NONSTANDARD LABEL SWITCH 71533021 DS 0H 71540021 GETDC1 DC AL2(4*LDOP) DISPLACEMENT OF LAST OF 5 O 71547021 GETDC2 DC AL2(3*LDOP) 71554021 STOPRU DC XL2'3408' ** DUMMY AN LIT FOR STOP RUN ** 71561021 DC CL8'STOP RUN' ** KEEP TWO DC'S TOGETHER ** 71568021 DILGC1 DC XL2'1C00' 71575021 DILGC2 DC XL2'2000' 71582021 DITYTB DC 1H'00' THIS TABLE 71589021 DC XL2'00' MUST REMAIN 71596021 DC XL2'00' INTACT. 71603021 DC XL2'00' . .... 71610021 DC XL2'20' . 71617021 DC XL2'0F' . 71624021 DC XL2'0F' . 71631021 DC XL2'00' 71638021 DC XL2'0F' . 71645021 DC XL2'0F' . 71652021 DC XL2'08' . 71659021 DC XL2'01' . 71666021 DC XL2'02' . 71673021 DC XL2'0F' . 71680021 DC XL2'00' . 71687021 DISPC1 DC XL3'02FFFF' 71694021 ENTRC1 DC XL4'00040000' 71701021 VIRDEFI DC XL2'0000' USED BY 'STOP' VERB 71708021 VIRTNO DC XL2'0000' HOLDS VIRTUAL ID NUMBER 71715021 DC CL8'ILBOSTP1' 'STOP' SUBR 71722021 * COBOL WORDS NEEDED BY PHASE 5 71729021 DS 0H 71736021 CBASCD DC XL2'548D' ASCENDING 71743021 CBCHGD DC XL2'548F' CHANGED 71750021 CBCNSL DC XL2'5478' CONSOLE C.W. 71757021 CBDSCD DC XL2'548C' DESCENDING 71764021 CBEND DC XL2'54A1' END 71771021 CBFRST DC XL2'5496' 'FIRST' USED AS AN ID FOR CONT 71778021 CBGIVG DC XL2'5481' GIVING 71785021 CBNAMD DC XL2'5490' NAMED 71792021 CBRUN DC XL2'5485' RUN 71799021 CBSYSP DC XL2'5477' SYSPCH C.W. 71806021 CBUSIN DC XL2'5489' USING 71813021 ONZERO DC XL2'75F0' F.C. ZERO 71820021 * 71827021 * NON-ALLIGNED CONSTANTS 71834021 SORBZD DC CL2'ZD' SORT KEY TYPE CODES 71841021 SORBCH DC CL2'CH' SORT KEY TYPE CODES 71848021 SORBFL DC CL2'FL' SORT KEY TYPE CODES 71855021 SORBPD DC CL2'PD' SORT KEY TYPE CODES 71862021 SORBBI DC CL2'FI' SIGNED BINARY 71869021 SEGBRK DC X'4444' PROC ATXT FOR SEGM CONTROL BREAK 71876021 DIWTC1 DC XL2'3418' *** KEEP TOGETHER *** 71883021 DC CL8'IKF990D,' *** KEEP TOGETHER *** 71890021 DC CL16' AWAITING REPLY.' *** KEEP TOGETHER *** 71897021 STOPC1 DC CL9'IKF000A, ' STOP 'LIT' MESSAGE CODE 71904021 RECLIT EQU * 71911021 DC C' RECORD TYPE=F,LENGTH=(' 71918021 SORLIT DC XL2'3400' SORT CONTROL 71925021 DC C' SORT FIELDS=(' CARD 71932021 SORCL3 DC C') ' LITERALS 71939021 SCHKPT DC C'),CKPT ' X 71946021 SORCL4 DC C',,,' X 71953021 SORLG2 DS XL5'0' MINIMUM RECORD LENGTH-SORT 71960021 WRISC1 DC CL4'1 0-' CARR CONTROL CHAR SET 71967021 PR35C1 DC XL3'35014D' 71974021 PR35C2 DC XL3'35015D' 71981021 DS 0D *** KEEP TOGETHER 71988021 DIFPC2 DS 0D 71995021 DC X'475F5E1000000000' 72002021 DC X'4F16345785D8A000' 72009021 DIFPC1 DC X'080E0700' ***** KEEP TOGETHER *** 72016021 DC X'11170700' ***** KEEP TOGETHER *** 72023021 PR35CB DC XL2'3502' **** KEEP TOGETHE 72030021 DC CL2', ' **** KEEP TOGETHE 72037021 * KEEP NEXT 6 CARDS TOGETHER 72044021 SPREGC DC X'D05E' BASE & DISPL FOR SORT-RETURN 72051021 DC X'D058' - - - SORT-CORE-SIZE 72058021 DC X'D190' - - - SORT-FILE-SIZE 72065021 DC X'D194' - - - SORT-MODE-SIZE 72072021 DC X'D1A6' BASE & DISPL FOR LABEL-RETURN 72079021 DC X'D05C' - - - RETURN-CODE 72086021 * KEEP ABOVE SIX CARDS TOGETHER. 72093021 CODE DC X'00' CODE FOR EOV AND EOF 72100021 LBDCLCTR DC H'0' USED TO INDEX USETBL - INDI 43521 72107021 * CATES THE CURRENT DECLARATIVE BEING PROCESSED (IN 43521 72114021 * NUMERICAL ORDER AS THEY APPEAR IN THE SOURCE). 43521 72121021 SPACE 2 72128021 TITLE 'IKFCBL51: CONSTANT A-TEXT C O N S T A N T' 72135021 * DIRECT A-TEXT WRITE OUT CONSTANTS. THOSE DIRECT A-TEXT STRINGS 72142021 * REQUIRING CHANGES ARE IN VARIABLE DATA AREA. 72149021 * 72156021 ATXTBC EQU * START OF CONSTANT DIRECT A-TEXT 72163021 ATXT01 DC XL3'4805EF' BALR 14,15 72170021 ZTXT01 EQU * Z'S USED TO CALCULATE LENGTH IN EQU 72177021 ATXT37 EQU * 72184021 DC XL6'48582070104C' * L 2,76(1) 72191021 DC XL6'484B20701052' * SH 2,82(1) 72198021 DC XL6'48502070104C' * ST 2,76(1) 72205021 ZTXT37 EQU * 72212021 ATXT38 EQU * 72219021 DC XL6'485810702014' * L 1,20(2) 72226021 DC XL6'489601702017' * OI 23(2),1 72233021 DC XL3'481B44' * SR 4,4 37073 72240021 DC XL6'484340701005' * IC 4,5(1) 37073 72247021 DC XL6'484C40701006' * MH 4,6(1) 72254021 DC XL5'4841007040' LA 0,8 OR 16(4) 72261021 ATXT380 DC XL1'00' 72268021 DC XL6'484110701000' * LA 1,0(1) 72275021 DC XL3'480A0A' * SVC 10 72282021 ZTXT38 EQU * 72289021 ATXT40 EQU * 72296021 DC X'484230705001' * STC 3,1(5) 72303021 DC XL6'488830700008' * SRL 3,8 72310021 DC X'484230705000' * STC 3,0(5) 72317021 DC X'489200705002' * MVI 2(5),X'00' 72324021 DC X'489200705003' * MVI 2(3),X'00' 72331021 ZTXT40 EQU * 72338021 ATXT41 EQU * 72345021 DC XL6'484230701001' * STC 3,1(1) 72352021 DC XL6'488830700008' * SRL 3,8 72359021 DC XL6'484230701000' * STC 3,0(1) 72366021 ZTXT41 EQU * 72373021 ATXT42 EQU * 48426 72380021 DC X'489200701002' * MVI 2(1),X'00' 48426 72387021 DC X'489200701003' * MVI 3(1),X'00' 48426 72394021 DC X'484110701004' * LA 1,4(0,1) 48426 72401021 ZTXT42 EQU * 48426 72408021 ATXT46 EQU * 72415021 DC XL6'4890EC70D00C' * STM 14,12,12(13) 72422021 DC XL3'48185D' * LR 5,13 72429021 DC X'4805F0' * BALR 15,0 72436021 DC X'4845E070F008' * BAL 14,8(15) 72443021 DC X'44188400040000' * DC A(INIT1) 72450021 DC X'4858F070E000' * L 15,0(14) 72457021 DC XL6'48989F70F01C' * LM 9,15,28(15) 72464021 DC X'4430A00F' * DESTROY 15 72471021 DC XL3'4805EF' * BALR 14,15 72478021 ZTXT46 EQU * 72485021 ATXT47 EQU * 72492021 DC XL6'48584070D004' * L 4,4(13) 72499021 DC XL6'485840704018' * L 4,24(4) 72506021 ZTXT47 EQU * 72513021 ATX50A EQU * 72520021 DC X'484100700001' LA 0,1 72527021 DC X'480A01' SVC 1 72534021 ATX50B EQU * 72541021 ATXT55 EQU * 72548021 DC X'4805EF' * BALR 14,15 72555021 DC X'4840F070D05C' * STH 15,92(13) 72562021 ZTXT55 EQU * 72569021 ATXT57 EQU * 72576021 DC X'48420264300001' * STC 2,TS2=1 72583021 DC X'480610' * BCTR 1,0 72590021 DC X'481211' * LTR 1,1 72597021 DC X'4807B3' * BCR 11,3 72604021 ZTXT57 EQU * 72611021 ATXT60 DC X'485810703010' * L 1,16(3) 72618021 ZTXT60 EQU * 72625021 * 72632021 ATXT72 EQU * 72639021 DC X'4858F0701030' * L 15,48(1) 72646021 DC X'4845E070F004' * BAL 14,4(15) 72653021 ZTXT72 EQU * 72660021 ATXT73 DC X'4807C1' BCR 12,1 72667021 ZTXT73 EQU * 72674021 ATXT76 DC X'481424' NR 2,4 72681021 DC X'480771' BCR 7,1 72688021 ZTXT76 EQU * 72695021 ATXT74 DC X'4847C0703008' BC 12,8(3) 72702021 ZTXT74 EQU * 72709021 ATXT77 DC X'481424' NR 2,4 72716021 DC X'480781' BCR 8,1 72723021 ZTXT77 EQU * 72730021 ATXT78 DC X'480741' BCR 4,1 72737021 DC X'48478070300A' BC 8,10(3) 72744021 ZTXT78 EQU * 72751021 ATXT79 DC X'480781' BCR 8,1 72758021 DC X'48474070300A' BC 4,10(3) 72765021 ZTXT79 EQU * 72772021 ATXT82 EQU * 72779021 DC X'48585070300C' * L 5,12(3) 72786021 ATX82B DC X'4858105C0000' * L 1,BL= 72793021 ZTXT82 EQU * 72800021 ATXT83 EQU * 72807021 DC X'48501070300C' * ST 1,12(3) 72814021 ZTXT83 EQU * 72821021 ATXT84 EQU * 72828021 DC X'48505070300C' * ST 5,12(3) 72835021 ZTXT84 EQU * 72842021 * 72849021 ATXT85 DC X'489280703004' * MVI 4(3),X'80' 72856021 ZTXT85 EQU * 72863021 ATXT86 EQU * 72870021 DC X'484010703006' * STH 1,6(3) 72877021 ZTXT86 EQU * 72884021 ATXT87 DC XL6'485A3070104C' * A 3,76(1) 72891021 DC XL6'484B30701052' * SH 3,82(1) 72898021 DC XL6'48503070104C' * ST 3,76(1) 72905021 DC XL6'485030701048' * ST 3,72(1) 72912021 ZTXT87 EQU * 72919021 * 72926021 ATXT89 DC XL7'48412064200001' * LA 2,WORKCELL=1 72933021 ZTXT89 EQU * 72940021 ATXT92 EQU * 72947021 DC X'484210641C000280000003' * STC 1,PARAM#2+ 72954021 ZTXT92 EQU * 72961021 ATXT93 EQU * 72968021 DC X'484110641C0001' * LA 1,PARAM#1 72975021 ZTXT93 EQU * 72982021 ATXT94E EQU * 43521 72989021 DC X'489180701004' TM 4(1),X'80' 43521 72996021 DC X'48078E' BCR 0,14 43521 73003021 ATXT94 EQU * 73010021 DC X'481BFF' * SR 15,15 73017021 DC X'489400701000' * NI 0(1),0 73024021 DC X'4859F0701000' * C 15,0(1) 73031021 DC X'48078E' * BCR EQ,14 73038021 DC X'489180701008' * TM 8(1),X'80' 73045021 DC X'48071E' * BCR ONE,14 73052021 ATXT94A EQU * 73059021 ATXT94C EQU * 73066021 DC X'48D2025C0101' * MVC BLL1+1(3),1(2) 73073021 DC X'80000001702001' 73080021 DC X'48D2025C0102' * MVC BLL2+1(3),13(2) 73087021 DC X'8000000170200D' 73094021 ATXT94D EQU * 73101021 DC X'48071E' * BCR 1,14 73108021 ZTXT94 EQU * 73115021 ATXT95 EQU * 73122021 DC X'48184E' * LR 4,14 73129021 DC X'481821' * LR 2,1 73136021 ATXT95E EQU * 73143021 DC XL6'484100700088' LA 0,136(0) 34733 73150021 DC X'481110' * LNR 1,0 73157021 DC X'480A0A' * SVC 10 73164021 DC X'48D203701048643C0001' * MVC 72(4,1),SA2 73171021 DC X'485010643C0001' * ST 1,SA2 73178021 DC X'485040701000' * ST 4,0(1) 73185021 DC X'48D24370100470D004' * MVC 4(68,1),4(13) 73192021 DC XL9'48D23B70104C70D128' MVC 76(60,1),316(13) 34733 73199021 ATXT95A EQU * 73206021 DC X'48D203701054702004' * MVC 84(4,1),4(2) 73213021 DC X'48D20770104C5C0101' * MVC 76(8,1),BLL1 73220021 ATXT95B EQU * 73227021 DC X'485840701000' * L 4,0(1) 73234021 DC X'48D24370D004701004' * MVC 4(68,13),4(1) 73241021 DC XL9'48D23B70D12870104C' MVC 316(60,13),76(1) 34733 73248021 ATXT95C EQU * 73255021 DC X'48D2035C010170104C' * MVC BLL1(4),76(1) 73262021 DC X'48D2035C0102701050' * MVC BLL2(4),80(1) 73269021 ATXT95D EQU * 73276021 DC X'48D203643C0001701048' * MVC SA2(4),72(1) 73283021 DC XL6'484100700088' LA 0,136(0) 34733 73290021 DC X'480A0A' * SVC 10 73297021 ATXT95F EQU * 73304021 ZTXT95 EQU * 73311021 ATXT96 EQU * LOAD LBL-RE 73318021 DC X'485810643C0001' * L 1,SA2 CODE INTO 73325021 ATXT96A EQU * X 73332021 DC X'481B55' * SR 5,5 X 73339021 DC X'485820701054' * L 2,84(1) X 73346021 DC X'485820702024' * L 2,36(2) X 73353021 DC X'484350702025' * IC 5,37(2) X 73360021 ZTXT96 EQU * X 73367021 ATXT98 EQU * 73374021 DC X'4805E0' * BALR 14,0 73381021 DC X'4895F070D1A6' * CLI 422(13),C'0' 73388021 DC X'48478070E00C' * BE 12(14) 73395021 DC X'484150700010' * LA 5,16 73402021 ZTXT98 EQU * 73409021 ATXT104 EQU * 48426 73416021 DC X'484130703004' * LA 3,4(0,3) 48426 73423021 ZTXT104 EQU * 48426 73430021 ATXT105 EQU * 73437021 DC X'484030702052' * STH 3,82(2) 73444021 ZTXT105 EQU * 73451021 ATXT107 EQU * 73458021 DC X'48580070104C' X L 0,76 73465021 DC XL4'4428A00F' * RESERVE 15 73472021 DC X'4858F0701030' * L 15,48(1) 73479021 DC X'484400701060' * EX 0,96(1) 73486021 DC XL4'4430A00E' * DESTROY 14 73493021 DC XL4'442CA00F' * FREE 15 73500021 ZTXT107 EQU * 73507021 ATXT108 EQU * 73514021 DC X'4892F070D1A6' * MVI 422(13),C'0' 73521021 ZTXT108 EQU * 73528021 ATXT109 EQU * 73535021 DC X'485810703014' * L 1,20(3) 73542021 DC X'48D20370301C701000' * MVC 28(4,3),0(1) 73549021 ZTXT109 EQU * 73556021 ATXT111 EQU * 73563021 DC X'48184E' * LR 4,14 73570021 DC X'4818D0' * LR 13,0 73577021 DC X'4841F07000FF' * LA 15,X'FF' 73584021 DC X'4889F0700018' * SLL 15,24 73591021 DC X'480A44' * SVC 68 73598021 ZTXT111 EQU * 73605021 ATXT112 EQU * 73612021 DC X'4818F5' * LR 15,5 73619021 ATXT112A EQU * 73626021 DC X'4818E4' * LR 14,4 73633021 DC X'48982570D138' LM 2,5,312(13) 44674 73640021 DC X'4807FE' * BCR 15,14 73647021 ZTXT112 EQU * 73654021 ATXT113 EQU * 73661021 DC X'48902464200001' * STM 2,4,96(13) WORKING CLLS 73668021 ZTXT113 EQU * 73675021 ATXT116A EQU * 73682021 DC X'48D20370104C70105C' MVC 76(4,1)92(1) R1=DCB 73689021 DC X'48D20370300C701064' MVC 12(4,3),100(1) R3=DECB 73696021 ZTXT116A EQU * 73703021 ATXT117A EQU * 73710021 DC X'48584070105C' L R4,92(R1) R1=DCB 73717021 DC X'484140704012' LA R4,18(R4) 73724021 DC X'48504070300C' ST R4,12(R3) R3=DECB 73731021 ZTXT117A EQU * 73738021 ATXT118 EQU * 73745021 *DEL 4350 73752021 DC XL4'4428A00F' * RESERVE 15 73759021 DC X'4858F0701030' X L 15,48(1) 73766021 DC X'484400701062' * EX 0,98(1) 73773021 DC XL4'442CA00F' * FREE 15 73780021 ZTXT118 EQU * 73787021 ATXT114 EQU * 73794021 DC X'48982464200001' * LM 2,4,96(13) WKNG CELLS 73801021 ZTXT114 EQU * 73808021 ATXT116 EQU * 73815021 DC X'48581070104C' * L 1,76(1) 73822021 ZTXT116 EQU * 73829021 ATXT117 EQU * 73836021 DC X'4858307010E4485810703070' * L 3,228(1) 73843021 * * L 1,112(3) 73850021 ZTXT117 EQU * 73857021 ATXT119 EQU * 73864021 DC X'481B11' SR 1,1 73871021 ZTXT119 EQU * 73878021 ARPPTM DC A(RPPATM) 73885021 * 73892021 *** 73899021 *** PATCH AREA FOR CONSTANT ATEXT 73906021 *** MUST BE KEPT AT END OF TEXT AREA 73913021 *** 73920021 CTXTPTCH DC CL50' ' PATCH AREA 73927021 * CONSTANTS FOR SPECIAL REPORT WRITER VERBS 73934021 SPACE 2 73941021 * 73948021 DS 0H 73955021 SXC04F DC X'004F' 73962021 SXC055 DC X'0055' 73969021 RPTMOG DC X'4438' REPORT MACRO ORIGIN 73976021 RPTMRG DC X'443C' REPORT MACRO RE-ORIGIN 73983021 DC X'48502064440007' * ST 2,RPTSAV=7 73990021 RPWZER DC X'75F0' FIGCON ZERO 73997021 * 74004021 DUMPNDEF DC XL3'44504C' DUMMY PN CODE FOR XREF 74011021 EJECT 74018021 * 74025021 * 74032021 * TABLES FOR ALPHANUMERIC IF 74039021 * 74046021 * TABLE FORMAT IS AS FOLLOWS 74053021 * WORD 0 74060021 * BYTE 0 74067021 * BIT 1 IS 1 IF EXTRA LENGTH AFFECTS CO 74074021 * BITS 4-7 IS CODE INDICATING RELATIONA 74081021 * 1 FOR EQ 74088021 * 2 FOR NOT EQ 74095021 * 3 FOR LT 74102021 * 4 FOR NOT LT 74109021 * 5 FOR GT 74116021 * 6 FOR NOT GT 74123021 * BYTES 1-3 CONTAINS ADDR OF TABLE FOR OPPOSITE 74130021 * BYTES 1-3 CONTAIN ADDR OF TABLE FOR OPPOSITE 74137021 * RELATIONAL 74144021 * 74151021 * WORDS 1-2 INDICATE BRANCHES TO BE GENERATE FOLLOWING 74158021 * COMPARISON. THE FIRST WORD IS USED IF 74165021 * COMPARE WAS NOT FOR TRAILING SPACES. THE 74172021 * SECOND WORD IS USED IF THE COMPARE WAS FOR 74179021 * TRAILING SPACES. WITHIN EACH WORD THE FIRS 74186021 * HALF-WORD IS USED IF THERE ARE MORE COMPAR 74193021 * TO BE GENERATED (IE, THE AREA BEING COMPAR 74200021 * IS GT 256 BYTES AND THE COMPARE JUST GENER 74207021 * DOES NOT COMPARE THE LAST PART OF THE AREA 74214021 * WITHIN EACH HALF-WORD THE VALUES ARE USED 74221021 * FOLLOWS 74228021 * BYTE 0 IS THE COND CODE TO BE USED IN THE BRAN 74235021 * TO THE GN CREATED BY PH5. IF IT IS ZERO 74242021 * THE BRANCH IS NOT GENERATED. 74249021 * BYTE 1 IS THE COND CODE TO BE USED IN THE BRAN 74256021 * TO THE GN WHICH PH4 PASSED TO PH5 IN TH 74263021 * VERB STRING. IF IT IS ZERO NO BRANCH IS 74270021 * GENERATED. 74277021 DS 0F 74284021 IFEQT DC X'41' 74291021 DC AL3(IFEQT) 74298021 DC X'0007' 74305021 DC X'0800' 74312021 DC X'0007' 74319021 DC X'0800' 74326021 IFNEQT DC X'42' 74333021 DC AL3(IFNEQT) 74340021 DC X'0700' 74347021 DC X'0700' 74354021 DC X'0700' 74361021 DC X'0700' 74368021 IFNLTT DC X'43' 74375021 DC AL3(IFNGTT) 74382021 DC X'0204' 74389021 DC X'0B00' 74396021 DC X'0402' 74403021 DC X'0D00' 74410021 IFGTT DC X'44' 74417021 DC AL3(IFLTT) 74424021 DC X'0204' 74431021 DC X'0200' 74438021 DC X'0402' 74445021 DC X'0400' 74452021 IFNGTT DC X'45' 74459021 DC AL3(IFNLTT) 74466021 DC X'0402' 74473021 DC X'0D00' 74480021 DC X'0204' 74487021 DC X'0B00' 74494021 IFLTT DC X'46' 74501021 DC AL3(IFGTT) 74508021 DC X'0402' 74515021 DC X'0400' 74522021 DC X'0204' 74529021 DC X'0200' 74536021 TITLE 'PHASE INITIALIZATION ROUTINE' 74543021 * 74550021 * PHASE INITIALIZATION 74557021 * 74564021 PH51 DS 0H 74571021 PHASE51 EQU * 74578021 IKFCBL51 EQU PH51 74585021 STM R14,R12,DX12(R13) SAVE REG'S IN PHO SAVE AREA 74592021 BALR RW6,RW0 PICK UP LOCA-CTR INTO REG6 74599021 USING *,RW6 74606021 LR RW2,R13 74613021 L R13,PHAS5X SET UP REG 13 AS BASE FOR PH5SAV 74620021 ST R14,DX12(R13) SAVE SYSTEM RETURN ADR IN PHASE SV AREA 74627021 ST RW2,DX4(R13) PUT PTR TO PH0 SV AREA IN PHASE SV AREA 74634021 ST R13,DX8(RW2) PUT PTR TO PHASE SV AREA IN PH0 SV AREA 74641021 L XRBAS1,ACOMN1 74648021 LM GBRG1,XRDATA,ACOMN3 74655021 LR RW3,RW1 74662021 L RW1,DX0(RW1) 74669021 ST RW1,COSADR 74676021 L RW1,SEGSAV(RW3) SAVE ADDR OF AREA IN PH0 WHICH 74683021 ST RW1,ADSEGSV WILL HAVE DISKADR FOR SEGTBL 74690021 L XRBAS2,COSADR 74697021 L RW1,ACOMN1 74704021 BALR RW0,XRBAS2 PERFORM PH0 74711021 DC X'06' 74718021 *DEL 5189 74725021 *DEL 5189 74732021 * PRIME TABLES USED BY PHASE5 74739021 L RW1,COSADR 'RELOCATE' TIB ADDRESS 74746021 L RW2,ARNTBL FOR RUNTBL. 74753021 AR RW2,RW1 74760021 ST RW2,ARNTBL 74767021 L RW2,AUSETBL RELOCATE TIB 43521 74774021 AR RW2,RW1 ADDRESS FOR 43521 74781021 ST RW2,AUSETBL USETBL 43521 74788021 LA RW1,GNCALPRM 37330 74795021 L XRVAR,XPRIM 37330 74802021 BALR RETRG,XRVAR PRIME GNCALTBL 7330 74809021 CLI SEGLMT,XXFF IS PROGRAM SEGMENTED 74816021 BC R8,HSKLP1 NO,BRANCH 74823021 LA RW1,SEGPRM YES,GET PARLIST ADDRESS 74830021 L XRVAR,XPRIM 74837021 BALR RETRG,XRVAR PRIME SEGTBL 74844021 HSKLP1 EQU * 74851021 LH RW3,PNCTR CALC NUM BYTES REQUIRED FOR TABLE 74858021 SR RW2,RW2 = BYTES CALCULATED AS NUMBER OF WOR 74865021 D RW2,PNU32 PLUS 1 TIMES 4 TO INSURE MULTIPLE O 74872021 LA RW3,DX1(RW3) 4 74879021 LR RW4,RW3 PUT = WORDS IN RW3 74886021 SLL RW3,DX2 74893021 STH RW3,PNUPRM+NX4 SAVE AS PRIME FACTOR 74900021 LA RW1,PNUPRM PRIME 74907021 L XRVAR,XPRIM 74914021 BALR RETRG,XRVAR PERFORM SUB PRIM IN PH0 74921021 * LOOP TO INSURE ENTIRE TABLE SET TO ZERO 74928021 HSKLP L RW1,PNUTBA INSERT 74935021 L XRVAR,XINST 74942021 BALR RETRG,XRVAR PERFORM SUB PRIM IN PH0 74949021 XC DX0(LX4,RW2),DX0(RW2) SET ENTRY TO ZERO 74956021 BCT RW4,HSKLP LOOP TO ZERO EACH ENTRY 74963021 *DEL 5189 74970021 *DEL 5189 74977021 LA RW3,ELEMTB SET REG EQ TO BASE OF OUTPUT AREA 74984021 MVI WCMAX,XX03 74991021 L RW1,COSADR 74998021 BALR RW0,RW1 PERFORM PHASE 0 TO READ 75005021 DC X'02' READ P-2 TEXT FROM FILE 2 75012021 ST RW0,PNTIN 75019021 B PH5CTL RETURN TO PHASE 5 CONTROL 75026021 SPACE 4 75033021 ACOMN1 DC A(COMON1) BEGIN OF FIRST CSECT 75040021 ACOMN3 DC A(COMON3) BEGIN OF THIRD CSECT 75047021 DC A(COMON4) BEG OF CONSTANTS CSECT 75054021 DC A(COMON5) BEG OF DATA AREA CSECT 75061021 PHAS5X DC A(PH5SAV) BEG OF DATA AREA CSECT 75068021 ARNTBL DC A(RUNTBL) 75075021 AUSETBL DC A(USETBL) 43521 75082021 TITLE 'A-TEXT GENERATOR AND ARITHMETIC CONSTANTS' 75089021 DS 0F 75096021 IKF505 CSECT 75103021 COMON5 EQU * 75110021 USING *,XRDATA 75117021 ****************************** DATA AREA ********************* 75124021 *=1 DATA AREA. 75131021 PH5SAV DS 18F USED BY PHASE0 TO SAVE PH5 REGS 75138021 ZAPZAP2 DS 25F ************ USE FOR SUPERZAP ************ 75145021 EJECT 75152021 DS 0H 75159021 BYTCNT DC XL2'0' BYTE COUNT OF CURRENT ENTITY 75166021 CARDNO EQU CURCRD CURRENT CARD NUMBER 75173021 PNTIN DC A(0) PTR TO NXT ELEM OF P2 TEXT 75180021 BYTES DC XL2'0' LNGTH OF CURRENT ELEM 75187021 GANLNO DC X'00' CODE OF VERB BEING PROCESSED 75194021 DECLSW DC XL1'00' USED IN DELCARATIVES 43113 75201021 INDCL EQU X'01' INDICATES WITHIN DECLARATIVE 43113 75208021 SPACE 1 43113 75215021 ADSEGSV DC A(0) ADDR OF AREA IN PH0 WHICH WILL 75222021 * WILL CONTAIN RESULT OF 'NOTE' 75229021 SEGSW DC X'0' ****************************** 75236021 STRTSW DC X'00' INDICATOR FOR START MACRO 7898 75243021 HIORDON EQU X'80' SWITCH FOR HIGH-ORDER BYTE 7898 75250021 STRTCN DC X'4420' PROC-A TXT=START 75257021 BETWPDSD EQU X'40' 7898 75264021 BETWRWPD EQU X'20' 7898 75271021 STRTSAVE DS 3F 7898 75278021 H6 DC H'6' 7898 75285021 ******************************************************************* 75292021 * RESERVE STORAGE AREAS 75299021 AXTLENG DC H'0' LGTH ALL KEYS IN SEARCH ALL 75306021 AXTKEYN DC H'0' NUMB OF KEYS IN SEARCH ALL 75313021 AXTCKEY DC H'0' 75320021 AXTDISP DC H'0' 75327021 AXTC01 DC X'64300000' PROC-A CODE FOR TEMPSTOR 2 75334021 AXTC02 DC X'64240000' PROC-A CODE FOR TEMP STORAGE 75341021 DS 0F 75348021 HEADER DS 1F HOLDS VERB STRING HEADER 75355021 CONSTS DS F 75362021 GSVR1 DS F ERRPRO SAVES R3 HERE 75369021 DS 1C ***** KEEP WITH GSVR1******* 75376021 GSVRG DS 16F 75383021 GCOSAV DS 6F 75390021 * PARAMETERS USED AS INPUT TO THE A-TEXT GENERATOR 75397021 * 75404021 OP1 DC F'0' FIRST DATA OPERAND 75411021 OP2 DC F'0' SECOND DATA OPERAND 75418021 OP3 DC A(GADPAR) ADDR OF OUTPUT AREA 75425021 DS 0D 75432021 XL1 DC H'0' LENGTH IN INSTR WHICH REQUIRE 75439021 * A-TXT GEN WILL SUBTRACT 1 FROM THIS LENGTH FOR YOU 75446021 XWC1 DC XL3'0' TEMP STORAGE REFERENCE 75453021 TALLY1 DC X'00' TALLY REF 75460021 BDISP1 DC XL2'0' BASE AND DISPL 75467021 RELAD1 DC F'0' RELATIVE ADDR 75474021 VIRTC1 DC F'0' VIRTUAL ID NUMBER 75481021 GVIRT1 DC 2F'0' VIRTUAL NAME IN BCD 75488021 XCON1 DC XL14'0' LITERALS AND 75495021 DC XL3'0' DC'S 75502021 XGN1 DC H'0' GN REF 75509021 XPN1 DC F'0' HOLDS PN PRIORITY AND NUMBE 75516021 XCNTR1 DC XL3'0' GLOBAL TBL-VARIABLE PORTION 75523021 PLUS1 DC XL3'0' ADDRESS INCREMENT 75530021 XVN1 DC F'0' VN REF 75537021 GDEBG1 DC XL2'0' GLOBAL TBL-FIXED PORTION 75544021 BLREF1 DC XL2'0' BASE LOCATOR 75551021 XREG1 DC XL1'0' REGISTER NUMBER 75558021 IMM DC X'00' 'IMMEDIATE' FLD IN INSTR 75565021 XXREG DC X'00' INDEX REG 75572021 DS 0D 75579021 XL2 DC H'0' SAME 75586021 XWC2 DC XL3'0' AS 75593021 TALLY2 DC X'00' XL1 75600021 BDISP2 DC XL2'0' THRU 75607021 RELAD2 DC F'0' XREG1 75614021 VIRTC2 DC F'0' BUT 75621021 GVIRT2 DC 2F'0' FOR 75628021 XCON2 DC XL14'0' SECOND 75635021 DC XL3'0' OPERAND 75642021 XGN2 DC H'0' X 75649021 XPN2 DC F'0' X 75656021 XCNTR2 DC XL3'0' X 75663021 PLUS2 DC XL3'0' X 75670021 XVN2 DC F'0' X 75677021 GDEBG2 DC XL2'0' X 75684021 BLREF2 DC XL2'0' X 75691021 XREG2 DC X'00' X 75698021 GFLWD DC F'0' FOR INTERMEDIATE RESULTS 75705021 GBIT1 DC X'00' THE BITS OF GBIT1 HAVE THE FOLLOWING MEANING 75712021 * BIT0 HALFWORD TEST WANTED 75719021 * BIT1 SS TYPE INSTR (2ADDRESSES WANTED) 75726021 * BIT2 BINARY INSTR (IF NUMLIT CONVERT TO BINARY) 75733021 * BIT3 DOUBLE FLOATING POINT INSTR 75740021 * BIT4 FLOATING POINT INSTR 75747021 * BIT5 DECIMAL MODE WANTED 75754021 * BIT7 ADDRESS 1 COMPLETED 75761021 GBIT2 DC X'00' BIT 0 ON MEANS REL ADR 75768021 * BIT1 ON MEANS MACRO 75775021 * BIT 6 ON MEANS FULL WD ALIGNMENT 75782021 * BIT 7 ON MEANS DEFINITE HALFWD INSTR 75789021 COUNT DC H'5' COUNT THRU GADPAR IS WHERE A TEXT FORMS OUTPUT 75796021 DC X'48' OPCODE 75803021 OPCOD DS CL1 75810021 GABS DC X'00' 75817021 GADPAR DS CL256 75824021 GLTSAV DC F'0' 75831021 GHFWD DC H'0' FOR INTERMEDIATE RESULTS 75838021 MSKMORLB DC X'5463' COBOL WORD 'MORE-LABELS' 75845021 PUTIOSRA DC X'1810' * LR 1,0 75852021 PUTIOCN DC X'45E0F004' * BAL 14,4(15) 75859021 PUTOUTCN DC X'05EF' * BALR 14,15 75866021 DC X'0700' * BCR 0,0 75873021 GLGNCN DC X'0005340000' 75880021 GCNGBR DC X'00004858F000000048000F' 75887021 GCPNVNBR DC X'00004858F00000000048070F' 'BCR' WITH PN OR VN REF 75894021 PNOUT DS F 75901021 SCHOLD DS F SAVE XRVERB FROM SEARCHAL 75908021 SCHLD2 DS F SAVE R14 FROM SEARCHAL TO SSCRPT 75915021 GNHOLD DC XL3'0' 75922021 SCHLIT DC X'320301001C' P2 TXT FOR LIT=1 75929021 DS 0D 75936021 GTEMP DC XL8'0' FOR CONVERSIONS 75943021 DS 0F 75950021 SYNCHRO EQU X'40' 75957021 AXTE00 DS 1F 75964021 AXTC00 DC X'64540001' PROC-A TXT FOR TEMP STOR 3 #1 75971021 AXSTORE EQU X'20' 75978021 AXSTMLM EQU X'10' 75985021 DFPXXX EQU X'10' 75992021 SFPXXX EQU X'08' 75999021 DS 0F 76006021 OTPT DS 24F ATXT GEN OUTPUT AREA 76013021 *=1 DATA AREA FOR ARITHMETIC. 76020021 WRITES DS F 76027021 DS 0H 76034021 PUTSAV DS 6F REG SAVER 76041021 PUTH1 DC H'1' 76048021 GNCNT DC H'0' NO. GN'S IN EQUATE STRING TBL 76055021 DS 0F 76062021 DC H'0' HOLDS CODE FOR EQUATE STRINGS 76069021 GNLIST DS 6F PN GN EQUATE STRINGS BUILT HERE 76076021 GETSAV DS F 76083021 PNUSAV DS 3F 76090021 PNU32 DC F'32' 76097021 PNUX80 DC X'80000000' USED BY PNUSED ROUTINE 76104021 SBLOP DC X'0400' USED FOR MORE THAN ONE SBL 4758 76111021 * CONSTANTS FOR TRANSFORM 76118021 DS 0F 76125021 TRNAM DC C'ILBOTRN0' TRANSFORM TBL VIRTUAL NAME 76132021 TRVLNM DC C'VTR0' VL TRANSFORM VIRTUAL NAME 76139021 TRINC4 DC H'0' 76146021 TRLNG3 DC H'0' 76153021 * CONSTANTS FOR IF CLASS TEST 76160021 CLVLNM DC C'CLS0' VL CLASS TEST VIRTUAL NAME 76167021 CLATB DC X'C108' CLASS TEST SR NAME & BRANCH CDE 76174021 CLNATB DC X'C107' CLASS TEST SR NAME & BRANCH CDE 76181021 NORNNT DC X'C5' CLASS TEST SR NAME & BRANCH CDE 76188021 CLCOND DC X'0' ********MUST FOLLOW NORNNT **************** 76195021 CLBDSP DC X'3008' 76202021 CLTBNM DC C'ILBO TB0' VIRTUAL= CLASS TEST TBL 76209021 CLCNF1 DC X'0104' 76216021 * CONSTANTS FOR ALPHAN IF AND MOVE 76223021 IMADCN DC A(IMGEN+2) 76230021 IMCONS DS 0F 76237021 IMOTS DC CL4'VLXX' 14 BYTES OVERLAID FOR IF AND MOV 76244021 IMIRTN DC A(0) 76251021 DC A(0) 76258021 IMVRBC EQU IMOTS+1 76265021 IMBDSP DC X'E000' 76272021 MVCONS DS 0F 76279021 DC C'VMO0' VL MOVE VIRTUAL NAME 76286021 DC A(MVC) 76293021 DC A(MVI) 76300021 DC X'E01E' 76307021 * 76314021 IFCONS DS 0F 76321021 DC C'VCO0' VL COMPARE VIRTUAL NAME 76328021 DC A(CLC) 76335021 DC A(CLI) 76342021 DC X'E024' 76349021 * 76356021 IMAREA DS 0F USED 76363021 IMLCH DS F BY 76370021 IMICH1 DS F ALPHA 76377021 IMICH2 DS F IF 76384021 IMLFC DS F AND 76391021 IMIFC1 DS F MOVE 76398021 IMIFC2 DS F COMMON 76405021 IMIFSW DS C ROUTINE 76412021 * 76419021 IMPTR1 DS F USED 76426021 IMPTR2 DS F BY 76433021 IMPTR3 DS F ALPHA 76440021 IMRTRN DS 2F IF 76447021 IMSAVE DS 2F AND 76454021 IMWORK DS 25C MOVE 76461021 IMLSAV DS 2F COMMON 76468021 PLUSST DS F ROUTINE 76475021 H4 DC H'4' HALF WORD = 4 76482021 H256 DC H'256' HALF WORD = 256 76489021 IMCHAR DS C TELLS IF VERB IS MOVE OR IF 76496021 * CONSTANTS FOR EXAMINE 76503021 EXDSP1 DC H'0' 76510021 EXDSP2 DC H'0' 76517021 EXDSP3 DC H'0' 76524021 EXDSP4 DC H'0' 76531021 EXDSPX DC H'0' 76538021 EX3012 DC X'3012' 76545021 EXCOND DC X'00' 76552021 EXCND2 DC X'00' 76559021 IMGSAV DS F SAVE AREA FOR EXHIBIT 76566021 * CONSTANTS FOR GO 76573021 DS 0H 76580021 DS C 76587021 GOCON DC X'480520' BALR 2,0 BALR 2,0 76594021 GOCON1 DC X'484720702000' BC HI,DISP(2) 76601021 DC X'488B10700001' SLA 1,1 76608021 GOCON2 DC X'4847C0702000' BC 12,DISP(2) 76615021 DC X'484811702018' LH 1,24(1,2) 76622021 DC X'488910700002' SLL 1,2 76629021 DC X'485811703000' L 1,0(1,3) 76636021 DC X'4807F1' BCR 15,1 76643021 * CONSTANTS FOR PERFORM 76650021 PFMCON DC X'485800640C0000' L 0,PFMCTL 76657021 DC X'480600' BCTR 0,0 76664021 PFMCN1 DC X'485000640C0000' ST 0,PFMCTL 76671021 DC X'481200' LTR 0,0 76678021 * CONSTANTS FOR USE, ENDUSE 76685021 * 76692021 USCON3 DC X'4434' INIT MACRO-LOAD PERM REGS 76699021 * 76706021 * 76713021 SPACE 2 76720021 *DEL 5189 76727021 *DEL 5189 76734021 *DEL 5189 76741021 *DEL 5189 76748021 *DEL 5189 76755021 *DEL 5189 76762021 *DEL 5189 76769021 *DEL 5189 76776021 *DEL 5189 76783021 *DEL 5189 76790021 *DEL 5189 76797021 *DEL 5189 76804021 *DEL 5189 76811021 *DEL 5189 76818021 *DEL 5189 76825021 *DEL 5189 76832021 *DEL 5189 76839021 DS 0F 76846021 *DEL 5189 76853021 *DEL 5189 76860021 XIDBY DS 1H OUTPUT OF XIDSZ ROUTINE (SIZES). 76867021 XBDBY DS 1H - - - - . 76874021 XIDDN DS 1H - - - - . 76881021 XOPVLC DS 1H VARIABLE LENGHT CELL NUMBER. 76888021 XOPLGH DS 1F FIXED LENGH VALUE. 76895021 *DEL 5189 76902021 *DEL 5189 76909021 *DEL 5189 76916021 *DEL 5189 76923021 *DEL 5189 76930021 *DEL 5189 76937021 *DEL 5189 76944021 *DEL 5189 76951021 *DEL 5189 76958021 *DEL 5189 76965021 *DEL 5189 76972021 *DEL 5189 76979021 *DEL 5189 76986021 *DEL 5189 76993021 *DEL 5189 77000021 *DEL 5189 77007021 *DEL 5189 77014021 *DEL 5189 77021021 *DEL 5189 77028021 *DEL 5189 77035021 *DEL 5189 77042021 *DEL 5189 77049021 *DEL 5189 77056021 *DEL 5189 77063021 *DEL 5189 77070021 *DEL 5189 77077021 *DEL 5189 77084021 *DEL 5189 77091021 *DEL 5189 77098021 *DEL 5189 77105021 *DEL 5189 77112021 *DEL 5189 77119021 *DEL 5189 77126021 *DEL 5189 77133021 *DEL 5189 77140021 * 77147021 * ERROR MESSAGES BUFFER. 77154021 XMSGDF DC X'000600' CODE FOR ERROR MSG 77161021 DC X'0000' MESSAGE NUMBER. 77168021 DC X'0000' CARD NUMBER. 77175021 DC X'05' SEVERITY,PHASE NUMBER. 77182021 XSTORE DS 2F 77189021 ************************** 77196021 * 77203021 INCODE EQU X'5C' 77210021 TS4DATA EQU X'38' 77217021 TS2CODE EQU X'30' 77224021 *DEL 5189 77231021 *DEL 5189 77238021 *DEL 5189 77245021 *DEL 5189 77252021 *DEL 5189 77259021 *DEL 5189 77266021 *DEL 5189 77273021 *DEL 5189 77280021 *DEL 5189 77287021 *DEL 5189 77294021 *DEL 5189 77301021 X1VAL DC F'0' 51894 77308021 *DEL 5189 77315021 *DEL 5189 77322021 *DEL 5189 77329021 *DEL 5189 77336021 *DEL 5189 77343021 *DEL 5189 77350021 *DEL 5189 77357021 *DEL 5189 77364021 *DEL 5189 77371021 *DEL 5189 77378021 *DEL 5189 77385021 *DEL 5189 77392021 *DEL 5189 77399021 *DEL 5189 77406021 *DEL 5189 77413021 *DEL 5189 77420021 *DEL 5189 77427021 *DEL 5189 77434021 *DEL 5189 77441021 *DEL 5189 77448021 *DEL 5189 77455021 *DEL 5189 77462021 *DEL 5189 77469021 *DEL 5189 77476021 *DEL 5189 77483021 *DEL 5189 77490021 *DEL 5189 77497021 *DEL 5189 77504021 *DEL 5189 77511021 *DEL 5189 77518021 ***************************************************************** 42646 77525021 * * 42646 77532021 * SAVE AREAS USED BY I-O SUBROUTINES * 42646 77539021 * * 42646 77546021 ***************************************************************** 42646 77553021 SPACE 3 42646 77560021 IOSAVE01 DS F USED BY SORTXSA 42646 77567021 IOSAVE02 DS F USED BY SORTXSA 42646 77574021 IOSAVE03 DS F USED BY SORTXSA 42646 77581021 EJECT 42646 77588021 ***************************************************************** 42646 77595021 * * 42646 77602021 * ADCONS USED BY I-O SUBROUTINES * 42646 77609021 * * 42646 77616021 ***************************************************************** 42646 77623021 SPACE 3 42646 77630021 IOADCN01 DC A(SORTXSA) IOADCN01 42646 77637021 EJECT 42646 77644021 *=1 DATA AREA FOR NON ARITHMETIC (BILL). 77651021 DS 0F 77658021 ONBCON DC XL4'0' B FACTOR 77665021 ONCCON DC XL4'0' C FACTOR 77672021 LENGTH DC 1F'00000004' *** DUMMY *** DUMMY *** DUMMY *** 77679021 DISPNN DS 1F TOTAL OPERAND COUNTER 77686021 EXHIBP DS 1F BIT PATTERN BUILD CELL 77693021 GNSTRE DS 1H SAVE GN IN QUPDAT 77700021 QRETGN DS 1H SAVE GN IN QUPDAT 77707021 GNRETU DS 1H SAVE GN FOR DEF IN QRETUV 77714021 QRETSW DC X'00' BIT 1 ON IF IN QUPDAT 77721021 GNLMSV DS 1H SAVE GN FOR LM GENERATION 9030 77728021 LSTDBG DS 1F HOLDS PFMCTR NUMBER FOR LAST *DE 77735021 DS 0H FORCE HALF WORD BOUNDARY 77742021 DITYSV DC XL2'0000' SAVES DN-INFO TYPE FOR DISPLAY 77749021 EXPARC DC 1H'0000' PARAM COUNT FOR LOCAL EXHIBIT 77756021 DISGND DS 1H GN2 77763021 ONCOUL DC XL2'0' ON-CTR-NO, LOW LVL COUNTER 77770021 ONCOUH DC XL2'0' ON-CTR-NO, HI LVL COUNTER 77777021 SPACE 2 42646 77784021 * 42646 77791021 * DATA AREA FOR SORT PROCESSING 42646 77798021 * 42646 77805021 SORGN3 DS 1H SORT'S GN3 77812021 SORGN4 DS 1H SORT'S GN4 77819021 SDISPL DS H DISPL INTO SORT WORK BUFFER 77826021 SPARAM DC H'1' PARAM CELL NUMB (SORT) 77833021 SORSSS EQU * 77840021 SORLG1 DC XL5'0' MAX (OR ONLY)RECORD LENGTH-SORT 77847021 SORTSW DC XL2'00' OPTION AND STATUS SWITCH FOR SORT 77854021 NX1 EQU 1 42646 77861021 SORTSW1 EQU SORTSW+NX1 42646 77868021 SORTTT EQU * 77875021 SLENGT EQU SORTTT-SORSSS 77882021 * MASKS FOR SORTSW 77889021 SINPT EQU X'01' INPUT PROCEDURE 77896021 SOTPT EQU X'02' OUTPUT PROCEDURE 77903021 SUSING EQU X'04' USING (COMPILER GEN INPUT PROC) 77910021 SGVING EQU X'08' GIVING (COMPILER GEN OUTPUT PROC) 77917021 SORTVL EQU X'10' VAR. LENGTH OR SPANNED RECS 77924021 SNDONE EQU X'20' 77931021 SASCEN EQU X'40' ASCENDING KEY 77938021 SFIRST EQU X'80' FIRST TIME LOGIC 77945021 * MASKS FOR SORTSW1: 42646 77952021 CELLALOC EQU X'01' XSACELLS HAVE BEEN ALLOCATED 42646 77959021 SORTRTRN EQU X'02' WITHIN A RETURN VERB 42646 77966021 SORTRLSE EQU X'04' WITHIN A RELEASE VERB 42646 77973021 SORTVERB EQU X'08' ALERTS OTHER ANALYZERS A SORT IS ACTIVE 42646 77980021 SORTSRA EQU X'80' SAME RECORD AREA SPECIFIED FOR SD 42646 77987021 STOMSG DC X'34' 77994021 STLNG DC AL1(SORTDD-SORTCC) TOTAL LITERAL COUNT 78001021 SORTCC EQU * 78008021 DC AL2(SORTBB-SORTAA+4) 78015021 DC X'8000' MCS FLAG 78022021 SORTAA EQU * 78029021 DC C'IKF888I UNSUCCESSFUL SORT FOR ' 78036021 SRTNME DC 32C' ' 78043021 SORTBB EQU * 78050021 MSGCDE DC X'04004020' SEE NOTE 78057021 SORTDD EQU * 78064021 MSGCDERP DC X'40004020' 78071021 * NOTE - 4000 - DESCRIPTOR CODE - IMMEDIATE ACTION REQUIRED 78078021 * NOTE - 0400 - DESCRIPTOR CODE - JOB STATUS 78085021 * -4020-ROUTING CODE-MASTER CONSOLE + SYSOUT 78092021 * 78099021 * CELLS CONTAINING NUMBERS OF XSACELLS ASSIGNED TO SORT: 42646 78106021 XSASORT DC H'00' USED FOR SORT VERB 42646 78113021 XSARTRN DC H'00' USED FOR RETURN VERB 42646 78120021 XSARLSE DC H'00' USED FOR RELEASE VERB 42646 78127021 * SAVE AREAS FOR GN NUMBERS - RELEASE VERB 42646 78134021 RLSEGN1 DS 2C USED FOR INLINE 42646 78141021 RLSEGN2 DS 2C F OR V LENGTH TEST 42646 78148021 EXHIT1 DC H'0' 78155021 IOPARM DS 1H 78162021 DISPL DS H 78169021 MCLOSLCK EQU 1 78176021 DIFPNN DC XL2'0000' 78183021 DIPARE DC 1H'0000' 78190021 * NON-ALIGNED WORK CELLS 78197021 DS 0F 78204021 SORSFN DS 5C SAVES FRON OF SFN - KEEP WD BOUN 78211021 DNMINR DC XL1'00' CALCLG SAVES MINOR OF DN'S HERE 78218021 SORDN1 DC XL6'00' SORT RECORD DN THRU BL NUMBER 78225021 IOCODE DC XL1'FF' 78232021 ASRLAS DC XL1'87' LAST HEADER 78239021 PR35M DS 1H 78246021 * SWITCHES 78253021 * KEEP ALL FOLLOWING SW'S STARTING 'ON....' TOGETHER FOR COMMON CLE 78260021 DS 0H 78267021 ONSWIT EQU * 78274021 ONSWNU DS 1H 78281021 ONTYSW DS 2C 78288021 ONESW DS 1C 78295021 CALLXN EQU ONSWIT TEMP HOLDER FOR XN'S, OVERLAYS ON SWITCHES 78302021 ONBSW DS 1C 78309021 ONI2SW DS 1C 78316021 ONI3SW DS 1C 78323021 ONGFSW DS 1C 78330021 ONSWSW DS 1C 78337021 * END OF ON SWITCHES 78344021 CALLSW DC XL1'0' CALL OR LINK SW 78351021 CDNOSW DC XL1'0' CARD NUMBER PRECEEDS STRING SW. 78358021 EXHBSN DC XL1'00' EXHIBIT NAMED SWITCH 78365021 EXHBSC DC XL1'00' EXHIBIT CHANGED SWITCH 78372021 DISPS1 DC XL1'00' DISPLAY 78379021 PERF1S DC XL1'00' PERFORM 78386021 FLAGSW DC XL1'00' 78393021 READSW DC X'00' FIRST/SECOND TIME SW FOR READ 78400021 ADESW1 DC XL1'00' ADETER SW 78407021 ADESW2 DC XL1'00' ADETER SW 78414021 ENTSW DC X'00' USED IN ENTRY 78421021 * 78428021 * MASKS FOR ENTSW: 78435021 FRSTON EQU X'80' FIRST TIME THROUGH ENTRY 78442021 FRSTOFF EQU X'7D' TURN FIRST TIME, GN SWITCH OFF 78449021 ENTRSPAC DS 2F WORK AREA FOR ENTRY-POINT NAME 1155 78456021 SPACE 1 1155 78463021 ENTRYGN EQU X'02' INDIC A GN IS TO BE GEN'ED 78470021 WRSW01 DS 1C 78477021 IOMVSW DC 1X'00' MOVE FOR 'INTO', 'FROM' CONTROL 78484021 OPENSW DC X'00' 78491021 DIFPSW DC XL1'00' 78498021 REWRSW DC XL1'00' 78505021 WRITSW DC XL1'00' 78512021 RECMODE DS XL1 78519021 CLOSSW DC XL1'00' CLOSE SWITCH 78526021 LOOKAH DC XL1'00' LOOK AHEAD SW 78533021 STOPSW DC XL1'00' STOP SPECIAL CASE FOR ACCEPT 78540021 IODOSW DS 1C 78547021 MADCSW DC X'00' DSPLTP SW 78554021 CLSSW DC X'0' CLASS TEST SWITCH 78561021 QRTNSW DC XL1'00' Q-ROUTINES IN EFFECT WHEN SW SWT 78568021 DIWOSW DC XL1'00' ALTERNATE MESSAGE FOR WTOR SW 78575021 QREFSW DC XL1'00' SW FOR O-O-L REF OF I-L ODO OBJ 78582021 CPFLAG DC X'00' 78589021 USESW DC X'00' SWITCH FOR USE...STD ERROR 78596021 HALFWD DS H 78603021 TITLE 'IKFCBL51: VARIABLE A-TEXT V A R I A B L E' 78610021 * 78617021 * 78624021 * DIRECT A-TEXT WRITE OUT STRINGS REQUIRING CHANGES. THOSE STRINGS 78631021 * NOT REQUIRING CHANGES ARE IN THE CONSTANT AREA 78638021 * 78645021 * TO ADD NEW DIRECT A-TEXT STRINGS, USE THE NEXT HIGHEST NUMBER, 78652021 * BEYOND THE HIGHEST PREVIOUS NUMBER USED, =MM. 78659021 * A) SET UP TEXT IN THE... CONSTANT AREA IF NO BYTE IS CHAN 78666021 * ... DATA AREA IF ONE OR MORE BYTES C 78673021 * FORMAT... 78680021 * ATXTNN EQU * 78687021 * DC XL'... ONE DC PER INSTRUCTION... 78694021 * ZTXTNN EQU * 78701021 * (IF ANY BYTE IS CHANGABLE, LABEL IT ANNCH1, 78708021 * B) THE CALLING SEQUENCE IS... 78715021 * BAL RETRG,GATXTC (OR, GAT 78722021 * DC AL2(ATXTNN-ATXTBC) (OR, GAT 78729021 * DC AL2(ZTXTNN-ATXTNN) 78736021 *...... THE FOLLOWING ARE POINTERS TO AREAS OF CHANGES... 78743021 * CONSTANT A-TEXT STARTING POINT 78750021 * VARIABLE A-TEXT FOLLOWS... 78757021 * 78764021 ATXTBV EQU * 78771021 IOTXTA DC X'48583064140000' L 3,DECBADR 78778021 IOTXTB EQU * 78785021 DC X'485820703008' L 2,8(3) 78792021 IOTXTC DC X'489200703005' MVI 5(3),CODE 78799021 IOTXTD EQU * 78806021 IOTXTE DC X'48581064000000' L 1,DCBADR 78813021 DC X'481821' * LR 2,1 78820021 IOTXTF EQU * 78827021 DC X'48D20270202150' * MVC 33(3,2),GN-EODATA 78834021 DC X'000080000001' 78841021 IOTXTG DC X'4858F0701030' L 15,48(1) 78848021 DC X'4805EF' BALR 14,15 78855021 IOTXTH EQU * 78862021 IOTXTI DC X'481813' LR 1,3 78869021 IOTXIA EQU * 78876021 DC X'4858F0702030' L 15 ,48(2) 78883021 DC X'4805EF' BALR 14,15 78890021 DC X'481813' LR 1,3 78897021 IOTXIB EQU * 78904021 DC X'4858F0702034' L 15,52(2) 78911021 DC X'4805EF' BALR 14,15 78918021 DC XL4'4430A00E' DESTROY 14 78925021 DC XL4'4430A00F' DESTROY 15 78932021 IOTXTJ EQU * 78939021 DC X'48585070300C' L 5,12(3) 78946021 DC X'48D2' * MVC SYM-KEY(6),BUFFER 78953021 IOTXTJ1 DC X'0078' LENGTH 78960021 IOTXTJ2 DC X'000000FFFFFF705000' IDK FOR ACT.KEY+4 78967021 IOTXTL DC X'48585070300C' L 5,12(3) 78974021 DC X'484110701004' * LA 1,4(1) 78981021 DC X'484010705004' * STH 1,4(5) 78988021 IOTXTL1 EQU * 78995021 DC X'484110701004' * LA 1,4(1) 79002021 IOTXTL2 EQU * 79009021 DC X'484010705000' * STH 1,0(5) 79016021 IOTXTM EQU * 79023021 IOTXTO EQU * 79030021 DC X'48D203641C00015C' * MVC PARAM#1,BL 79037021 IOTXTOA1 DC X'00' BL TYPE 79044021 IOTXTOA DC X'00' BL NUMBER 79051021 DC X'4892' DCB NO. * MVI PARAM#1,OPTNCODE 79058021 IOTXTOC DC X'00641C0001' 79065021 DC X'48D203641C0003640000' * MVC PARAM#3,DCBADR 79072021 IOTXTOB DC X'00' DCB NO. 79079021 IOTXTOD DC X'485010641C00' * ST 1,PARAM#4 79086021 IOTXTOE DC X'00' 79093021 IOTXTOF EQU * 79100021 DC X'48411070' * LA 1,INTEGER 79107021 IOTXTOG DC X'0000' 79114021 IOTXTOH EQU * 79121021 DC X'4892' *MVI PARAM#2+3 ,MNEUMONIC- 79128021 IOTXTOI DC X'00' 79135021 DC X'641C000280000003' 79142021 IOTXTOJ EQU * 79149021 IOTXTP EQU * 79156021 DC X'485840702024' * L 4,36(2) 79163021 IOTXTP2 EQU * 49518 79170021 DC X'48D20270401950' * MVC 25(3,4),GN-INVKEY+1 79177021 IOTXTP1 DC X'0000' 79184021 DC X'80000001' 79191021 IOTXTQ EQU * 79198021 DC X'4891FD703018' * TM 24(3),X'FD' 1139 79205021 DC XL4'4428A00E' * RESERVE 14 1139 79212021 DC X'4858E050' * L 14, 1139 79219021 IOTXTQA DC X'0000' * GN(BAD BL'S) 1139 79226021 DC X'48077E' * BCR 7,14 1139 79233021 DC XL4'442CA00E' * FREE 14 1139 79240021 IOTXTR EQU * 79247021 DC X'48960170401B' * OI 27(4),1 79254021 IOTXTRPR EQU * 79261021 DC X'48585050' * L 5,GN-NEXT-SENTENCE 79268021 IOTXTR1 DC X'0000' 79275021 DC X'4807F5' * BCR 15,5 79282021 IOTXTS EQU * 79289021 DC X'485840701024' *L 4,36(1) 79296021 IOTXTS1 EQU * 79303021 DC X'489480704004' NI 4(4),X'80' 79310021 DC X'48D200704008701078' MVC 8(1,4),120(1) 79317021 IOTXTT EQU * 79324021 DC X'4858F0701054' * L 15,84(1) 79331021 DC X'4805EF' * BALR 14,15 79338021 DC X'4430A00E' DESTROY 14 79345021 DC X'4430A00F' DESTROY 15 79352021 DC X'484100700080' * LA 0,128 79359021 DC X'4428A00F' RESERVE 15 79366021 DC X'4805F0' BALR 15,0 79373021 DC X'489110702010' TM 36(2),X'10' 79380021 DC X'48471070F00E' BO 14(15) 79387021 DC X'484110700008' LA 1,8(0,0) 79394021 DC X'481601' OR 0,1 79401021 DC X'442CA00F' FREE 15 79408021 DC X'488900700018' * SLL 0,24 79415021 DC X'485600702100' * O 0,256(2) 79422021 DC X'481812' LR 1,2 79429021 DC X'4858F070104C' * L 15,76(1) 79436021 DC X'4805EF' * BALR 14,15 79443021 IOTXTU EQU * 79450021 DC X'4892' * MVI 50(1),CODE 79457021 DC X'00' CODE 79464021 DC X'701032' 79471021 DC X'4892' * MVI 51(1),CODE 79478021 DC X'00' CODE 79485021 DC X'701033' 79492021 DC X'485810640000' * L 1,DCBADR 79499021 IOTXTWC1 DC X'00' DCB NUMBER 79506021 DC X'4858205C' * L 2,BL 79513021 IOTXTWC2 DC X'0000' BL TYPE 79520021 IOTXTWC3 DC X'00' BL NUMBER 79527021 DC X'48412070' * LA 2, DISP(2) 79534021 IOTXTWC4 DC X'2000' 79541021 DC X'48D2017020007010E0' * MVC 0(2,2),224(1) 79548021 DC X'48D2017020027010CE' * MVC 2(2,2),206(1) 79555021 DC X'48D203702004701098' * MVC 4(4,2),152(1) 79562021 IOTXTAA EQU * 79569021 DC X'485810640000' * L 1,DCBADR 79576021 IOTXTAA1 DC X'00' DCB NUMBER 79583021 IOTXTAB EQU * 79590021 DC X'481821' * LR 2,1 79597021 IOTXTBB EQU * 79604021 DC X'48415078' * LA 5,ACT.KEY 79611021 IOTXTBB1 DC X'000000' KEY IDK 79618021 DC X'FFFFFF' NO DICT POINTER 79625021 IOTXTCC EQU * 79632021 DC X'48411078' * LA 1,ACT-KEY+4 79639021 IOTXTCC1 DC X'000000FFFFFF' 79646021 DC X'485010703014' * ST 1,20(3) 79653021 DC X'48D20370301C78' * MVC 28(4,3),ACT-KEY 79660021 IOTXTCC2 DC X'000000FFFFFF' 79667021 * 79674021 IOTXTDD EQU * 79681021 DC X'489108703005' * TM 5(3),X'08' 79688021 DC X'48585050' * L 5,GN 79695021 IOTXTDD3 DC X'0000' GN NUMBER 79702021 DC X'4807E5' * BCR NOTONE,5 79709021 DC X'485810703024' * L 1,36(3) 79716021 IOTXTDD1 DC X'489200703005' * MVI 5(3),UPDATE-CODE 79723021 IOTXTDD2 DC X'48D50070100078000000FFFFFF' * CLC 0(KL+4,1),AC 79730021 DC X'48585050' * L 5,GN2 79737021 IOTXTDD4 DC X'0000' GN2 NUMBER 79744021 DC X'480785' * BCR EQ,5 79751021 IOTXTEE EQU * 79758021 DC X'485850703024' * L 5,36(3) 79765021 DC X'48D2' * MVC 0(KL+4,5),ACT-KEY 79772021 IOTXTEE1 DC X'0070500078' KL+4 79779021 IOTXTEE2 DC X'000000FFFFFF' IDK FOR ACT-KEY 79786021 IOTXTFF EQU * 79793021 DC X'0402' 79800021 DC AL1(IOTXTFF0-IOTXTFF1) LITERAL LNGTH 79807021 IOTXTFF1 EQU * 79814021 DC AL2(IOTXTFF7-IOTXTFF1) TOTL LNGTH OF CNT+MSG 79821021 DC X'8000' 79828021 IOTXTFF3 EQU * 79835021 DC C'IKF999I UNSUCCESSFUL OPEN FOR ' 79842021 IOTXTFF2 EQU * 79849021 DC 8X'0' 79856021 IOTXTFF7 DS CL4 MCSCODE GO HERE 79863021 IOTXTFF0 EQU * 79870021 DC X'48582050' * L I,GN 79877021 IOTXTFF5 DC X'0000' 79884021 DC X'489110701030' * TM 48(1),X'10' 79891021 DC X'480712' * BCR 1,2 79898021 DC X'48D2' * MVC TS2#1(MSGLNGTH),LIT 79905021 DC AL1(IOTXTFF0-IOTXTFF1-1) 79912021 DC X'6430000168' 79919021 IOTXTFF6 DC X'0000' LITERAL ID 79926021 DC X'48D2076430' * MVC TS2#MSGLNGTH,DDNAME 79933021 DC AL2(IOTXTFF2-IOTXTFF1+1) 79940021 DC X'701028' 79947021 DC X'48411064300001' 79954021 DC X'480A23' * SVC 35 79961021 DC X'34' 79968021 IOTXTFF4 DC X'0000' GN NUMBER 79975021 IOTXTGG EQU * 79982021 DC X'4841107000' * LA 1,CODE 79989021 IOTXTGG1 DC X'00' CODE 79996021 DC X'488910700018' * SLL 1,24 80003021 DC X'485610640000' * O 1,DCBADR 80010021 IOTXTGG2 DC X'00' DCB NUMBER 80017021 IOTXTHH EQU * 80024021 IOTXTII1 EQU * 80031021 DC X'4858F050' * L 15, 80038021 DC X'0000' * GN-BYPASS 80045021 DC X'4807FF' * BCR 15,15 80052021 IOTXTII2 EQU * 80059021 EJECT 37374 80066021 * 37374 80073021 * 37374 80080021 * ATXT02 THRU ZTXT02 IS GENERATED DURING CLOSE PROCESSING OF 37374 80087021 * BISAM FILES FOR WHICH THE OPTIONS 'TRACK-AREA IS INTEGER' 37374 80094021 * OR 'APPLY CORE-INDEX' HAVE BEEN SPECIFIED. THE CODE RESULTS37374 80101021 * IN FREEMAINS OF STORAGE REQUESTED WHEN THE FILE WAS OPENED 37374 80108021 * 37374 80115021 SPACE 2 37374 80122021 ATXT02 EQU * 37374 80129021 DC X'4858107020' L 1, (2) 41095 80136021 A02CH2 DC X'48' 72.OR.64 41095 80143021 DC X'484110701000' LA 1,0(1) 41095 80150021 DC XL3'481211' LTR 1,1 41095 80157021 DC XL4'4428A00F' RESERVE 15 41095 80164021 ATXT02A EQU * 41095 80171021 DC XL3'48078F' BCR 8,15 41095 80178021 DC XL4'442CA00F' FREE 15 41095 80185021 DC X'481B00' SR 0,0 41095 80192021 DC X'4843007020' IC 0, (2) 41095 80199021 A02CH1 DC XL1'44' 68.OR.70 37374 80206021 DC X'488900700008' SLL 0,8 41095 80213021 DC X'4843007020' IC 0, (2) 41095 80220021 A02CH3 DC X'45' 69.OR.71 41095 80227021 DC XL3'480A0A' SVC 10 37374 80234021 DC X'48D7037020' XC (3,2), 41095 80241021 A02CH4 DC X'48' 72.OR.64 41095 80248021 DC X'7020' (2) 41095 80255021 A02CH5 DC X'48' 72.OR.64 41095 80262021 ZTXT02 EQU * 41095 80269021 SPACE 2 41095 80276021 ATXT03 EQU * 80283021 SPACE 1 80290021 * 80297021 * THIS TEXT IS GENERATED DURING OPEN PROCESSING FOR A BISAM 80304021 * FILE FOR WHICH THE OPTION 'TRACK-AREA IS INTEGER' HAS 80311021 * BEEN SPECIFIED, AND CONSISTS OF A CONDITIONAL GETMAIN 80318021 * FOR THE STORAGE REQUESTES BY INTEGER. 80325021 * 80332021 SPACE 1 80339021 DC XL6'485830640000' L 3,DCBADR 80346021 A03CH1 DC XL1'00' NUMBER 80353021 DC XL11'48D70B641C0001641C0001' XC PARMS(12),PARMS 80360021 DC XL7'489220641C0003' MVI PARM3,X'20' 80367021 DC XL3'48D201' MVC (2), 80374021 DC XL8'641C000180000002' PARM1+2 80381021 DC XL3'703046' 70(3) 80388021 DC X'484100641C0002' LA 0,PARM2 80395021 DC X'485000641C0002' ST 0,PARM2 80402021 DC XL7'484110641C0001' LA 1,PARM1 80409021 DC XL4'4428A00F' RESERVE 15 80416021 DC XL3'480A04' SVC 4 80423021 DC XL4'4430A00E' DESTROY 14 80430021 ATXT03A EQU * 80437021 DC XL3'4812FF' LTR 15,15 80444021 DC XL3'48077E' BCR 7,14 80451021 DC XL4'4430A00E' DESTROY 14 80458021 DC XL4'442CA00F' FREE 15 80465021 DC XL3'48D203' MVC (4, 80472021 DC XL3'703040' 64 3), 80479021 DC XL4'641C0002' PARM2 80486021 ZTXT03 EQU * 80493021 SPACE 2 80500021 * 43113 80507021 * ATXT04 THRU ZTXT04 IS GENERATED FOR THE EXIT PROGRAM AND 43113 80514021 * GOBACK VERBS WHEN THE VERB APPEARS WITHIN A LABEL OR ERROR 43113 80521021 * DECLARATIVE. 43113 80528021 * 43113 80535021 SPACE 1 43113 80542021 ATXT04A EQU * 43113 80549021 DC X'4805F0' BALR 15,0 43113 80556021 ATXT04 EQU * 43113 80563021 DC X'48910170104B' TM 75(1),X'01' 43113 80570021 DC X'48471070F0' BO (15) 43113 80577021 A04CH1 DC X'1E' 30.OR.14 43113 80584021 DC X'485810701048' L 1,72(1) 43113 80591021 DC X'4847F070F0' B (15) 43113 80598021 A04CH2 DC X'0E' 14.OR.00 43113 80605021 DC X'48D24370D004701004' MVC 4(68,13),4(1) 43113 80612021 ZTXT04 EQU * 43113 80619021 SPACE 2 43113 80626021 ATXT22 DC X'4848307030' LH 3,110 80633021 A22CH1 DC XL1'00' OR... 3,254(3) 80640021 DC XL6'484140701008' LA 4,8(1) 80647021 DC XL6'484020701004' STH 2,4(1) 80654021 DC XL6'484030701006' STH 3,6(1) 80661021 DC XL3'480550' BALR 5,0 80668021 DC XL6'485040701000' ST 4,0(1) 80675021 DC XL3'481814' LR 1,4 80682021 DC XL3'481A43' AR 4,3 80689021 DC XL3'480625' BCTR 2,5 80696021 DC XL6'485020701000' ST 2,0(1) 80703021 ZTXT22 EQU * 80710021 ATXT05 EQU * 42646 80717021 SPACE 1 42646 80724021 * 42646 80731021 * THIS TEXT IS GENERATED FOR THE RELEASE VERB WHEN THE VERB IS 42646 80738021 * ACTUALLY PART OF A DUMMY (GENERATED) OUTPUT PROCEDURE 42646 80745021 * 42646 80752021 SPACE 1 42646 80759021 DC X'4891806418' TM ,X'80' 42646 80766021 A05CH1 DC X'0000' XSARLSE 42646 80773021 DC X'48071E' BCR ONES,14 42646 80780021 DC X'4858206418' L 2, 42646 80787021 A05CH2 DC X'0000' XSARLSE 42646 80794021 DC X'481B33' SR 3,3 42646 80801021 DC X'484330702000' IC 3,0(2) 42646 80808021 DC X'488930700008' SLL 3,8 42646 80815021 DC X'484330702001' IC 3,1(2) 42646 80822021 ZTXT05 EQU * 42646 80829021 SPACE 2 42646 80836021 ATXT06 EQU * 42646 80843021 SPACE 1 42646 80850021 * 42646 80857021 * THIS TEXT IS GENERATED FOR A READ WHEN THE VERB IS ACTUALLY 42646 80864021 * PART OF A DUMMY (GENERATED) INPUT PROCEDURE 42646 80871021 * 42646 80878021 SPACE 1 42646 80885021 DC X'4850106418' ST 1, 42646 80892021 A06CH1 DC X'0000' XSARLSE 42646 80899021 DC X'48' * 80906021 A06CH4 DC X'00' OI.OR.NI 80913021 A06CH2 DC X'00' FLAG, 42646 80920021 DC X'6418' XSA 42646 80927021 A06CH3 DC X'000' RLSE 42646 80934021 ZTXT06 EQU * 42646 80941021 SPACE 2 42646 80948021 ATXT07 EQU * 48401 80955021 SPACE 1 48401 80962021 * 48401 80969021 * THIS CODING IS GENERATED FOLLOWING A QSAM WRITE AND TESTS48401 80976021 * FOR AN I-O ERROR ON THAT WRITE BEFORE DOING A BL-UPDATE. 48401 80983021 * 48401 80990021 DC X'485820640000' L 2, 48401 80997021 A07CH1 DC X'00' DCBADR 48401 81004021 DC X'489140702079' TM 121(2),X'40' 48401 81011021 DC X'48585050' L 5, 48426 81018021 A07CH2 DC X'0000' GN(IOERROR) 48401 81025021 DC X'489200702079' MVI 121(2),X'00' 48401 81032021 DC X'480715' BCR 1,5 48426 81039021 ZTXT07 EQU * 48401 81046021 SPACE 2 48401 81053021 ATXT08 EQU * 58971 81060021 DC X'485810640000' * L 1, 58971 81067021 A08CH1 DC X'00' DCBADDR 58971 81074021 DC X'485840701024' * L 4,36(1) 58971 81081021 DC X'48960170401B' * OI 27(4),X'01' 58971 81088021 ZTXT08 EQU * 58971 81095021 ATXT35 EQU * 81102021 DC X'48583070102C' * L 3,44(1) 81109021 DC X'48910F70300C' * TM 12(3),X'0F' 81116021 DC XL3'480550' * BALR 5,0 81123021 DC XL5'4847E07050' 81130021 A35CH1 DC XL1'00' * BC 14,A35CH1(5) = 16, 18 81137021 ZTXT35 EQU * 81144021 ATXT25 EQU * 81151021 DC X'48411064400001' * LA 1,SA3 81158021 DC XL2'480A' 81165021 A25CH1 DC XL1'00' * SVC 19 OR 20 81172021 ZTXT25 EQU * 81179021 ATX35A EQU * 81186021 DC X'48583070102C' * L 3,44(1) 81193021 DC X'48910F70300C' * TM 12(3),X'0F' 81200021 A35LGN DC X'485850500000' * L 5,GN 81207021 DC X'4807E5' * BCR 14,5 81214021 ZTX35A EQU * 81221021 ATXT48 EQU * 81228021 DC XL1'44' FREE, RESERVE, DESTROY 81235021 A48CH2 DC XL1'00' 81242021 DC XL1'A0' REGISTER REF 81249021 A48CH1 DC XL1'00' FREE, RESERVE OR DESTROY MACRO, ANY R 81256021 ZTXT48 EQU * 81263021 ATXT51 EQU * 81270021 DC X'489101600401' * TM SWITCH+1,X'01' 81277021 ATXT51A EQU * 9030 81284021 DC X'4858F050' 81291021 A51CH2 DC X'0000' * L 15,GN=A48CH2 GN NU 81298021 DC X'48071F' * BCR ONES,15 81305021 ZTXT51 EQU * 81312021 ATXT52A EQU * 4774 81319021 DC X'48D203641C00015C00' * MVC PARAM1(4), 4774 81326021 A52CH2 DC X'00' BL 4774 81333021 ATXT52 EQU * 81340021 DC X'484100641C' * LA R0,PARAM 4774 81347021 A52CH6 DC X'0001' 1.OR.2 4774 81354021 DC X'481810' LR 1,0 81361021 DC X'4841107010' LA 1,XXX(1) END SORT LIT 81368021 A52CH1 DC X'00' (XXX=LENGTH SORT LIT) 81375021 DC X'48412070100F' LA R2,15(R1) BEG REC LIT 81382021 ATXT52B EQU * 4774 81389021 DC X'481111' * LNR 1,1 4774 81396021 ATXT52C EQU * 4774 81403021 DC X'4841307020' LA 3,YYY(2) END REC LIT 81410021 A52CH3 DC X'00' (YYY=LENGTH REC LIT) 81417021 DC X'48584050' L 4, 81424021 A52CH4 DC X'0000' GN=INPUT PROC 81431021 DC X'48585050' L 5, 81438021 A52CH5 DC X'0000' GN=OUTPUT PROC 81445021 ZTXT52 EQU * 81452021 * REG SAVERS 81459021 ATXT56 EQU * 81466021 DC X'48411070' 81473021 A56CH1 DC X'0000' * LA 1,LENGTH-1 * 81480021 DC X'481B22' * SR 2,2 81487021 DC X'442CA003' * FREE 3 81494021 DC X'480530' * BALR 3,0 81501021 ZTXT56 EQU * 81508021 ATXT59 EQU * 81515021 DC X'481B33' * SR XRD,XRD 81522021 DC X'4843306428' * IC XRD,XSASW * 81529021 A59CH1 DC X'0000' * OI XSASW,MSWON* 81536021 DC X'4896016428' (XRD=3) 81543021 A59CH2 DC X'0000' 81550021 ZTXT59 EQU * 81557021 ATXT62 EQU * 81564021 DC X'484110701001' * LA XRA,1(XRA) 81571021 DC X'4850106408' * ST XRA,ONCT=HI* 81578021 A62CH1 DC X'0000' (XRA = 1) 81585021 ZTXT62 EQU * 81592021 ATXT63 EQU * 81599021 DC X'4430A00F' * DESTROY 15 81606021 DC X'4858F050' * L 15,GN= 81613021 A63CH2 DC X'0000' 81620021 DC X'48078F' * BCR 8,15 81627021 DC X'4858106408' 81634021 A63CH1 DC X'0000' * L XRA,ONCTR=LO 81641021 ZTXT63 EQU * 81648021 ATXT66 EQU * 81655021 DC X'48078F' * BCR 8,15 81662021 DC X'484110701001' * LA XRA,1(XRA) 81669021 DC X'4850106408' 81676021 A66CH1 DC X'0000' * ST XRA,ONCTR=LO 81683021 DC X'4807F2' * BCR UNCOND,XRB 81690021 DC X'34' 81697021 A66CH3 DC X'0000' GN DEF 81704021 DC X'481B11' * SR XRA,XRA 81711021 DC X'4850106408' 81718021 A66CH2 DC X'0000' * ST XRA,ONCTR=L/ 81725021 ZTXT66 EQU * 81732021 * NOTE... XRA IS ASSUMED = 1, XRB = 2. 81739021 ATXT65 EQU * 81746021 DC X'4858F050' L 15,GN CH2* 81753021 A65CH2 DC X'0000' 81760021 DC X'4850F0600800' ST 15,SORTSAVE 81767021 DC X'4430A00F' DESTROY 15 81774021 DC X'4858E06418' L 14,XSA 81781021 A65CH1 DC X'0000' CH1* 81788021 DC X'4428A00E' RESERVE 14 81795021 DC X'48052E' BALR 2,14 81802021 DC X'4858F0600800' L 15,SORTSAVE 81809021 DC X'4430A00F' DESTROY 15 81816021 DC X'4807FF' BCR 15,15 81823021 DC X'4850E06418' ST 14,XSA CH3* 81830021 A65CH3 DC X'0000' 81837021 DC X'442CA00E' FREE 14 81844021 ZTXT65 EQU * 81851021 ATXT67 EQU * 81858021 DC X'484110641C0001' * LA 1,PARAM=1 81865021 DC X'48D70F701000701000' * XC 0(16,1),0(1) 81872021 DC X'485010701008' * ST 1,8(1) 81879021 DC X'484110701001' * LA 1,1(1) 81886021 DC X'485020701003' * ST 2,3(1) 81893021 DC X'484110701003' * LA 1,3(1) 81900021 DC X'4892' 81907021 A67CH2 DC X'00' * MVI 0(1),1 .OR. ,LENG 81914021 DC X'701000' 81921021 DC X'4892' 81928021 A67CH3 DC X'00' 81935021 DC X'701009' * MVI 9(1),28 OR ALT. L 81942021 DC X'48928070100A' * MVI 10(1),X'80' 81949021 DC X'480A23' * SVC 35 81956021 DC X'484110641C0001' * LA 1,PARAM=1 81963021 DC X'484100700001' * LA 0,1 81970021 DC X'480A01' * SVC 1 81977021 ZTXT67 EQU * 81984021 * 81991021 ATXT68 EQU * 7882 81998021 DC X'4850106418' * ST 1,XSA-CELL 7882 82005021 A68CH1 DC X'0000' * NUMBER 7882 82012021 ZTXT68 EQU * 7882 82019021 ATXT69 EQU * 82026021 DC X'48D2007030057020FC' * MVC 5(1,3),252(2) 82033021 ZTXT69 EQU * 82040021 * 82047021 ATXT70 DC X'489200703005' * MVI 5(3),CODE 82054021 ZTXT70 EQU * 82061021 ATXT71 EQU * 7882 82068021 DC X'4858406418' L 4,XSA-CELL 43150 82075021 A71CH1 DC X'0000' * NUMBER 7882 82082021 ZTXT71 EQU * 7882 82089021 ATXT75 EQU * 7882 82096021 DC X'481B33' SR 3,3 43150 82103021 DC X'484330704000' IC 3,0(0,4) 43150 82110021 DC X'488930700008' SLL 3,8 43150 82117021 DC X'484330704001' IC 3,1(0,4) 43150 82124021 ZTXT75 EQU * 7882 82131021 ATXT100 EQU * 82138021 DC X'4428A00F' RESERVE 15 82145021 DC X'4858F070D1B0' L 15,1B0(13) ADDR INIT1 9652 82152021 DC XL6'48900E70F038' STM 0,14,SAVEP2 9652 82159021 DC X'485810643C0001' L 1,SAVE-2 43113 82166021 DC XL3'4805F0' BALR 15,0 82173021 DC XL6'489110600400' TM SWITCH,X'10' 82180021 DC XL6'4847E070F00E' BC OFF,14(15) 9652 82187021 DC XL4'4858F058' * L 15,=V(ILBOSTP1) 82194021 A100CH1 DC XL2'0000' 82201021 DC XL3'4807FF' BCR 15,15 82208021 ZTXT100 EQU * 82215021 ATXT101 EQU * 82222021 DC XL6'4848F070D05C' * LH 15,92(13) 82229021 *DEL 4311 82236021 DC XL6'4858D070D004' L 13,4(13) 82243021 DC XL6'48980C70D014' * LM 0,12,20(13) 82250021 DC X'4858E070D00C' * L 14,12(13) 82257021 *DEL 4311 82264021 DC XL3'4807FE' BCR 15,14 82271021 DC X'4430A00E' DESTROY 14 43113 82278021 DC X'442CA00F' FREE 15 43113 82285021 ZTXT101 EQU * 82292021 ATXT102 EQU * 82299021 DC X'4428A00F' RESERVE 15 82306021 DC X'485810643C0001' L 1,SAVE-2 43113 82313021 DC XL3'4805F0' BALR 15,0 82320021 DC XL6'489110600400' TM SWITCH,X'10' 82327021 DC X'48471070F0' BC ON, (15) 43113 82334021 A102CH1 DC X'22' 30.OR.58 60604 82341021 DC X'4858F070D1B0' L 15,1B0(13) 82348021 DC X'48900E70F038' STM 0,14,SAVEP2 82355021 ZTXT102 EQU * 82362021 ATXT103 EQU * 82369021 DC XL4'4858F058' * L 15,=V(ILBOSTP1) 82376021 A103CH1 DC XL2'0000' 82383021 DC XL3'4807FF' BCR 15,15 82390021 ZTXT103 EQU * 82397021 ATXT99 DC X'480008' * CNOP 2,4 GET DC ON FULL-WD 82404021 DC X'480530' * BALR 3,0 82411021 DC X'484780703018' * BC 8,24(3) BR 6 BYTES PAST OR 82418021 DC X'4847F070300C' * BC 15,12(3) 82425021 DC X'44246C04' * DC OF .... 82432021 A99CH1 DC X'00000000' LITERAL-Q 82439021 DC X'485800703008' * L 0,8(3) PICK UP LIT-Q 82446021 DC X'481610' * OR 1,0 82453021 ZTXT99 EQU * 82460021 ATXT106 EQU * 82467021 A106CH1 DC X'48581064500000' L 1,CKPTSV#X PICK UP COUNTER 82474021 DC X'48585050' 82481021 A106CH2 DC X'0000' GN NUMBER 82488021 DC X'480615' 82495021 A106CH3 DC X'48581064000000' L 1,DCBADR#N COUNTER=ZERO 82502021 ZTXT106 EQU * 82509021 ATXT110 EQU * 82516021 DC X'4858004C' * L 0, 82523021 A110CH1 DC X'000000' PN 82530021 *DEL 82537021 DC X'4428A00E' RESERVE 14 82544021 DC X'4858E0640C' * L 14, 82551021 A110CH2 DC X'0000' PFMCTL 82558021 DC X'4806E0' * BCTR 14,0 82565021 DC X'4850E0640C' * ST 14, 82572021 A110CH3 DC X'0000' PFMCTL 82579021 DC X'4812EE' * LTR 14,14 82586021 DC X'442CA00E' FREE 14 82593021 ZTXT110 EQU * 82600021 ATXT115 EQU * 82607021 DC X'481B00' * SR 0,0 82614021 DC X'48490070D05E' * CH 0,SORT-RETURN 82621021 DC X'48581050' * L 1, 82628021 A115CH1 DC X'0000' * GN 82635021 DC X'480781' * BCR EQUAL,1 82642021 ZTXT115 EQU * 82649021 IOTXTZ9 EQU * 82656021 DC X'484350704014' * IC 5,20(4) 82663021 DC X'489200704014' MVI 20(4),X'00' 82670021 DC X'480A1F' * SVC 31 82677021 DC X'484250704014' * STC 5,20(4) 82684021 IOTXTZ99 EQU * 82691021 IOTXTZA1 EQU * 82698021 DC X'48412064200009' LA 2,WS+8 (THIRD WORD) 82705021 DC X'48502064200001' ST 2,WS (FIRST WORD) 82712021 DC X'485820640000' L 2,DCBADD 82719021 IOTXTZA2 EQU * 82726021 DC X'00' DCB # 82733021 DC X'484110702068' LA 1,104(2) 82740021 DC X'4841F064200001' LA 15,WS 82747021 DC X'480A06' SVC 6 82754021 IOTXTZA3 EQU * 82761021 IOTXTZZ1 EQU * 1139 82768021 DC X'4891C0702051' * TM 81(2),X'C0' 1139 82775021 DC XL4'4428A00E' * RESERVE 14 1139 82782021 DC X'4858E050' * L 14, 1139 82789021 IOTXTZZ2 DC X'0000' * GNADR 1139 82796021 DC X'48077E' * BCR 7,14 1139 82803021 DC XL4'442CA00E' * FREE 14 1139 82810021 IOTXTZZ3 EQU * 1139 82817021 TITLE 'MORE CONSTANTS' 82824021 IOTXTOP1 EQU * 82831021 DC X'4858407010' L 4,100 OR 92(1) 82838021 IOTXTOP2 EQU * 82845021 DC X'00' 82852021 DC X'48D203704004701068' MVC 4(4,4),104(1) 82859021 DC X'481854' * LR R5,R4 82866021 DC X'48415070500C' * LA R5,12(R5) 82873021 DC X'485050704000' * ST R5,0(R4) 82880021 DC X'48D707704008704008' * XC 8(8,R4),8(R4) 82887021 IOTXTOP3 EQU * 82894021 IOTXTZB1 DC X'485840701070' * L R4,112(R1) R4=A(RCD) 82901021 DC X'4892' * MVI 0(R4),X'00' OR X'40' 82908021 ZB1CHNG DC X'00' 82915021 DC X'704000' 82922021 IOTXTZB2 EQU * 82929021 *** 82936021 *** PATCH AREA FOR VARIABLE ATEXT 82943021 *** MUST BE KEPT AT END OF TEXT AREA 82950021 *** 82957021 VTXTPTCH DC CL50' ' PATCH AREA 82964021 SPACE 2 82971021 MODCON DC CL8'IGG019B0' BUFFER AND RECORD CONTROL INITIALIZE 82978021 PR35SV DC 1F'00000000' 82985021 REMLGH DS 1F 82992021 MYSAVE DS 1F TSTRPD RTN SAVES R14 HERE 82999021 DS 0F 83006021 ELEMTB DS 620C DOPS 1 THRU 5 HERE 83013021 TITLE 'E Q U A T E S' 83020021 RW0 EQU 0 83027021 R0 EQU 0 'ACCUMULATOR' 83034021 RW1 EQU 1 INDEX AND WORK REGISTERS 83041021 RW2 EQU 2 * 83048021 RW3 EQU 3 * 83055021 RW4 EQU 4 * 83062021 RW5 EQU 5 * 83069021 RW6 EQU 6 * 83076021 RB1 EQU 8 83083021 STNGR EQU 9 83090021 MCARD EQU X'81' CARD NUMBER CODE 83097021 OPSIZ EQU 124 MAX SIZE NEEDED FOR ENTRIES IN ELEMTB 83104021 ANALNO EQU HEADER+1 ANALYZER NUMBER 83111021 ELEMCT EQU HEADER+2 ELEMENT COUNT 83118021 * EQUATES FOR EXAMINE ANALYZER AND A TEXT GENERATOR 83125021 OPD1 EQU 4 83132021 OPD2 EQU 5 83139021 OPD3 EQU 6 83146021 GR1 EQU 0 83153021 GR15 EQU 15 83160021 GRX EQU 0 83167021 GRX1 EQU 1 83174021 GRY EQU 2 83181021 GRY1 EQU 3 83188021 GXRA EQU 9 83195021 HFWORD EQU X'80' 1 IF HALFWORD WANTED 83202021 TWOADR EQU X'40' 1 IF SS TYPE INSTRUCTION 83209021 GAD1DN EQU 1 1 IF ADR 1 DONE 83216021 DECBIN EQU X'20' 1 IF WANT DEC TO BIN CONVERSION 83223021 DBLFPT EQU X'10' 1 IF DOUBLE FLOATING POINT 83230021 DECOP EQU X'04' 1 IF DECIMAL OP 83237021 SPREG EQU X'FF' 'I' FLD IN SPEC REG IDK 83244021 RETRG EQU 14 83251021 XRA EQU 1 83258021 XRB EQU 2 83265021 XRC EQU 1 83272021 GBRG1 EQU 11 BASE REGISTER FOR EXAMINE AND A TEXT 83279021 GR14 EQU 3 83286021 QR EQU 1 Q ROUTINE REGISTER ASSIGNMENTS 83293021 QR2 EQU 2 83300021 QR3 EQU 3 83307021 EJECT 83314021 * STANDARD EQUATES FOR BC INSTRUCTIONS 83321021 UNCOND EQU 15 83328021 HI EQU 2 83335021 LO EQU 4 83342021 EQ EQU 8 83349021 NOTHI EQU 13 83356021 NOTLO EQU 11 83363021 NOTEQ EQU 7 83370021 NEG EQU 4 83377021 ZERO EQU 8 83384021 NOTNEG EQU 11 83391021 NOTZER EQU 7 83398021 ONE EQU 1 83405021 ONES EQU 1 83412021 MIXED EQU 4 83419021 NOTONE EQU 14 83426021 NOTMXD EQU 11 83433021 NOP EQU 0 83440021 GMCTYP EQU IMM 83447021 DOP1 EQU ELEMTB 83454021 DOP2 EQU ELEMTB+OPSIZ*1 83461021 DOP3 EQU ELEMTB+OPSIZ*2 83468021 DOP4 EQU ELEMTB+OPSIZ*3 83475021 DOP5 EQU ELEMTB+OPSIZ*4 83482021 SBEGIN EQU ELEMTB+OPSIZ*3 BEG OF SORT WORK BUFFER 83489021 RPPAT EQU DOP3+2 83496021 RPPATM EQU DOP3+1 83503021 FIVEGN EQU GNCTR 83510021 GCNLGN EQU COUNT-XL1+1 LENGTH FOR CLEARING WORK AREA 83517021 DON EQU PH5CTL 83524021 SIGNED EQU 1 83531021 POSI EQU X'0F' 83538021 HIBITS EQU X'0F' TURN OFF HIGH ORDER 4 BITS 83545021 EJECT 83552021 *=1 EQU'S FOR ARITHMETIC. 83559021 * TAMER DEFINITION OF TIB - 83566021 * 83573021 XSEGM EQU TIB15-COS 83580021 XINTR EQU TIB1-COS INTERMEDIATE RESULT TABLE 83587021 XAVAL EQU TIB2-COS TEMP. STORAGE AVAL. TABLE 83594021 XSSNT EQU TIB4-COS SUBSCRIPT-INDEX ID TABLE 83601021 PNUTBL EQU TIB6-COS PN USE TABLE 83608021 RUNTBL EQU TIB35-COS 83615021 GNCALTBL EQU TIB16-COS GN CALL TABLE 7330 83622021 USETBL EQU TIB26-COS DECLARATIVE PN/ATTRIBUTE TABLE 43521 83629021 * 83636021 * TAMER ADCONS 83643021 XPRIM EQU APRIME 83650021 XINST EQU AINSRT 83657021 XTABL EQU RELADD 83664021 ****************************** 83671021 * 83678021 * 83685021 * ERROR MESSAGES NUMBER. 83692021 * 83699021 ERRN01 EQU 1 83706021 * ERROR NO 1.LOGIC ERROR IN XRDBIR ROUTINE. 83713021 ERRN02 EQU 2 83720021 * ERROR NO 2.LOGIC ERROR IN SSCRPT ROUTINE. 83727021 ERRN03 EQU 3 83734021 * ERROR NO 3.LEVEL 1 - DIVISOR IS 0. 83741021 ERRN04 EQU 4 83748021 * ERROR NO. 4. TRUNCATION OF AN. SENDING FIELD 83755021 ERRN05 EQU 5 83762021 * ERROR NO 5.LOGIC ERROR IN MOVE PROCESSOR. 83769021 ERRN06 EQU 6 83776021 * ERROR NO 6.LOGIC ERROR IN MOVE OR STORE PROCESSOR. 83783021 ERRN07 EQU 7 83790021 * ERROR NO 7.LOGIC ERROR IN XSETVL ROUTINE. 83797021 ERRN08 EQU 8 83804021 * ERROR NO 8.LOGIC ERROR IN FPCVBH ROUTINE. 83811021 ERRN09 EQU 9 83818021 * ERROR NO 9.LOGIC ERROR IN XSUDB3 ROUTINE. 83825021 ERRN10 EQU 10 83832021 * ERROR NO 10.LEVEL 1.TRUNCATION OF A LIT INT. RES. 83839021 ERRN11 EQU 11 83846021 * ERROR NO 11.LEVEL 0. POSSIBLE TRUNCATION OF AN IN. 83853021 * 83860021 ERRN12 EQU 12 83867021 * ERROR NO 12.LOGIC ERROR.LOST IR IN XINTR TABLE(XINS 83874021 ERRN13 EQU 13 83881021 * ERROR NUMB.13 COMPARISON OF TWO LITERALS LEVEL 1 83888021 ERRN14 EQU 14 83895021 * ERROR NO 14. KEY IN SEARCH ALL AT INVALID OFFSET 83902021 ERRN15 EQU 15 83909021 * ERROR NO 15. INVALID USE OF SPECIAL REGISTER 83916021 ERRN16 EQU 16 83923021 * ERROR NO. 16. MORE THAN 255 SUBSCRIPT CELLS USED. 83930021 ERRN17 EQU 17 83937021 * ERROR NO. 17. EXHIBIT CHANGED OPERAND GR 83944021 * THAN 256 BYTES. ASSUME 256. 83951021 ERRN18 EQU 18 83958021 * NAME OF IDENTIFIER IN EXHIBIT EXCEEDS MAXIMUM. 83965021 * TRUNCATED TO 120. 83972021 SPACE 2 83979021 * REG.DEFINITION- 83986021 * WORK REGISTERS- 83993021 XR0 EQU 0 84000021 XR1 EQU 1 84007021 XR2 EQU 2 84014021 XR3 EQU 3 84021021 XR4 EQU 4 84028021 XR5 EQU 5 84035021 XR6 EQU 6 84042021 * 84049021 R13 EQU 13 84056021 FRW0 EQU 0 84063021 XR15 EQU 15 84070021 SPACE 2 84077021 * BASE REGISTERS- 84084021 XRBAS1 EQU 7 BASE REG FOR ARITH. 84091021 XRBAS2 EQU 10 - - - - . 84098021 XRDATA EQU 13 84105021 XRCONS EQU 12 - - - CONSTANTS. 84112021 XRVAR EQU 15 VARIABLE BASE REG. 84119021 XRVERB EQU STNGR VERBE REGISTER. 84126021 XRSUB EQU 14 LINKAGE REGISTER. 84133021 R14 EQU 14 84140021 R15 EQU 15 84147021 WORKAB EQU 96 84154021 SPACE 2 84161021 ************************* 84168021 * TRANSFER CODES 84175021 SPACE 2 84182021 UNCON EQU 15 84189021 NOTHR EQU X'E' 84196021 XZERO EQU 8 84203021 XONE EQU 4 84210021 XTWO EQU 2 84217021 XTHRE EQU 1 84224021 XNOEQ EQU 7 84231021 XNOGT EQU X'D' 84238021 XLOEQ EQU X'C' 84245021 XGTEQ EQU X'A' 84252021 *DEL 5189 84259021 *DEL 5189 84266021 *DEL 5189 84273021 *DEL 5189 84280021 *DEL 5189 84287021 *DEL 5189 84294021 *DEL 5189 84301021 *DEL 5189 84308021 *DEL 5189 84315021 *DEL 5189 84322021 *DEL 5189 84329021 *DEL 5189 84336021 *DEL 5189 84343021 *DEL 5189 84350021 *DEL 5189 84357021 *DEL 5189 84364021 *DEL 5189 84371021 *DEL 5189 84378021 *DEL 5189 84385021 *DEL 5189 84392021 *DEL 5189 84399021 *DEL 5189 84406021 *DEL 5189 84413021 *DEL 5189 84420021 *DEL 5189 84427021 *DEL 5189 84434021 *DEL 5189 84441021 *DEL 5189 84448021 *DEL 5189 84455021 *DEL 5189 84462021 *DEL 5189 84469021 *DEL 5189 84476021 *DEL 5189 84483021 *DEL 5189 84490021 *DEL 5189 84497021 *DEL 5189 84504021 *DEL 5189 84511021 *DEL 5189 84518021 *DEL 5189 84525021 *DEL 5189 84532021 *DEL 5189 84539021 *DEL 5189 84546021 *DEL 5189 84553021 *DEL 5189 84560021 *DEL 5189 84567021 *DEL 5189 84574021 *DEL 5189 84581021 *DEL 5189 84588021 *DEL 5189 84595021 *DEL 5189 84602021 *DEL 5189 84609021 *DEL 5189 84616021 *DEL 5189 84623021 *DEL 5189 84630021 *DEL 5189 84637021 SPACE 2 84644021 SPACE 2 84651021 * TYPES 84658021 * 84665021 XGGPFL EQU 1 FIXED LENGHT GROUP. 84672021 XGALB EQU 2 ALPHABETIC. 84679021 XGALN EQU 3 ALPHANUMERIC. 84686021 XGGPVL EQU 4 VARIABLE LENGHT GROUP. 84693021 XGRPT EQU 5 REPORT ITEM. 84700021 XGEXDC EQU 8 EXTERNAL DECIMAL. 84707021 XGEXFP EQU 9 - FLOATING POINT. 84714021 XGINFP EQU X'0A' INTERNAL - - . 84721021 XGBINR EQU X'0B' BINARY. 84728021 XGINDC EQU X'0C' INTERNAL DECIMAL. 84735021 XGANE EQU X'0E' 84742021 SPACE 2 84749021 * INPUT CODES DEFINITION. 84756021 * 84763021 XGIRI EQU X'BA' 84770021 TEMRES EQU X'BC' P2 TEXT FOR TEMPORARY RESULT 84777021 XGDTN EQU X'30' DATA NAME. 84784021 XGFPL EQU X'33' FLOATIND-POINT LITERAL. 84791021 INDXNM EQU X'36' P-2 TEXT FOR INDEX-NAME 84798021 XGFCT EQU X'75' FIGURATIVE CONSTANT. 84805021 PLFCON EQU X'39' P2 TXT PLURAL FIGCON 84812021 XSTDTN EQU X'79' STANDART DATA-NAME. 84819021 XGALC EQU X'34' ALPHA NUMERIC CONSTANT. 84826021 XGNLT EQU X'32' NUMERIC LITERAL. 84833021 PNDEF EQU X'C7' P-2 TEXT CODE FOR PN DEF 84840021 GNDEF EQU X'88' - - - - GN - 84847021 VNDEF EQU X'C9' - - - - VN - 84854021 PNREF EQU X'D0' P-2 TEXT CODE FOR PN REFEREN 84861021 DUMMYPN EQU X'D4' P2 TEXT CODE FOR DUMMY PN REF 2962 84868021 VNREF EQU X'DB' P-2TEXT CODE FOR VN REFERENCE 84875021 GNREF EQU X'AA' 84882021 PFMSAV EQU X'FA' 84889021 PAPNDEF EQU X'30' PROC-A TEXT CODE FOR PN DEF 84896021 PAGNDEF EQU X'34' - - - - - GN - 84903021 PAVNDEF EQU X'38' - - - - - VN - 84910021 PAPNREF EQU X'4C' PROC-A TEXT CODE FOR PN REFE 84917021 PAVNREF EQU X'54' PROC-A TEXT CODE FOR VN REF. 84924021 SPACE 2 84931021 * VALUE OF DISPLACEMENTS IN INPUT STRING 84938021 * 84945021 XGIRNU EQU 1 DISPLACT. TO GET IR NUMBER. 84952021 XGMINC EQU 3 - - MINOR CODE. 84959021 XDIDK EQU 4 DISPLACT.OF ADDRESSING PARAMETERS . 84966021 XGSCIN EQU 7 - - SCALE INDICATOR. 84973021 XGSCAL EQU 8 - - SCALE VALUE . 84980021 XGDGLG EQU 9 - - DIGIT LENGHT . 84987021 *DEL 5189 84994021 *DEL 5189 85001021 *DEL 5189 85008021 *DEL 5189 85015021 *DEL 5189 85022021 *DEL 5189 85029021 *DEL 5189 85036021 *DEL 5189 85043021 *DEL 5189 85050021 *DEL 5189 85057021 *DEL 5189 85064021 *DEL 5189 85071021 *DEL 5189 85078021 *DEL 5189 85085021 *DEL 5189 85092021 *DEL 5189 85099021 *DEL 5189 85106021 *DEL 5189 85113021 *DEL 5189 85120021 *DEL 5189 85127021 *DEL 5189 85134021 *DEL 5189 85141021 *DEL 5189 85148021 *DEL 5189 85155021 *DEL 5189 85162021 *DEL 5189 85169021 SPACE 3 85176021 ****************************** 85183021 * A-TEXT ENTRY POINTS. 85190021 * 85197021 A EQU ADD 85204021 AP EQU ADD 85211021 AR EQU ADD 85218021 AL EQU ADDLBI 85225021 BALR EQU BRNLNK 85232021 BCTR EQU BRNCNT 85239021 SR EQU SUB 85246021 M EQU MULT 85253021 MR EQU MULT 85260021 MH EQU MULT 85267021 MP EQU MULT 85274021 D EQU DIV 85281021 DP EQU DIV 85288021 L EQU LOAD 85295021 LR EQU LOAD 85302021 LH EQU LOAD 85309021 LCR EQU LCRBI 85316021 ZAP EQU LOAD 85323021 MVO EQU LNRBI 85330021 CVB EQU CVBBI 85337021 CVD EQU CVDBI 85344021 ST EQU STORE 85351021 STH EQU STORE 85358021 BC EQU BRANCH 85365021 CLC EQU COMPLG 85372021 LTR EQU LTRBI 85379021 PACK EQU LTRBI 85386021 XJOP1 EQU OP1 85393021 XJOP2 EQU OP2 85400021 XIMM EQU IMM 85407021 XPLUS1 EQU PLUS1 85414021 XPLUS2 EQU PLUS2 85421021 * 85428021 SEGSAV EQU 28 85435021 GONE EQU XC001 85442021 BAL EQU BRNLNK 85449021 GVERB EQU XRVERB 85456021 HCOMSR EQU XRVAR 85463021 FREF EQU X'B8' PROC-A FILE REF CODE 85470021 MSWON EQU 1 85477021 MSWOFF EQU 254 85484021 SSWON EQU X'02' SECONDARY BIT SWITCH MASTER - SETTING 85491021 SSWOFF EQU X'FD' SECONDARY BIT SWITCH MASTER - RESETTI 85498021 MDN EQU X'30' 85505021 MNLIT EQU X'32' 85512021 MFPLIT EQU X'33' 85519021 MANLIT EQU X'34' 85526021 MFIGC EQU X'75' 85533021 MSFN EQU X'21' 85540021 LDOP EQU OPSIZ SIZE OF THE DOP AREAS 85547021 HTERM EQU CBEND 85554021 G1 EQU GONE 85561021 G2 EQU GTWO 85568021 GMACDC EQU XCON1 85575021 GMADCN EQU RELAD1 85582021 MADCON EQU X'18' 85589021 MDC EQU X'24' 85596021 MENTRY EQU X'04' 85603021 MBLCHG EQU X'08' BLCHNG MACRO TYPE 85610021 MFLIT EQU X'33' 85617021 MALIT EQU X'34' 85624021 MFGCON EQU X'75' 85631021 MDNNM EQU X'35' DN NAME FOR EXHIBIT NAMED 85638021 MRGN EQU X'AA' RIGHT HAND GN REF 85645021 SWCOUN EQU XSWCTR 85652021 SPACE 5 85659021 EJECT 85666021 GCNLN2 EQU XREG1-XWC1 LENGTH FOR CHANGING ADR TWOS TO ADR ON 85673021 ONCTRN EQU ONCTR COMMON CELL 85680021 MSDN EQU MDN 85687021 MFN EQU X'21' 85694021 SORTVI EQU SORTC1 85701021 DIMINR EQU DNMINR 85708021 ADCALL EQU ADCN2D CALL 85715021 SORCC1 EQU ELEMTB+450 SORT CONTROL CARD ELEMTB+620-12*14-2 85722021 SORCC2 EQU SORCC1+1 IMAGE BUILD-UP AREA 85729021 MBDAM EQU X'80' 85736021 MBSAM EQU X'40' 85743021 MBISAM EQU X'20' 85750021 MQISAM EQU X'10' 85757021 MNOQQI EQU X'E0' 85764021 MSYSOU EQU 1 DEVICE CODE FOR SYSOUT 85771021 MCNSLE EQU 2 DEVICE CODE FOR CONSOLE 85778021 MSYSPH EQU 3 DEVICE CODE FOR SYSPCH 85785021 MSYSIN EQU 4 DEVICE CODE FOR SYSIN 85792021 FPLENS EQU 14 SHORT FP LEN AFTER CONV IN PARAM 85799021 FPLENL EQU 23 LONG FP LEN AFTER CONV IN PARAM 85806021 MWORKA EQU 120 DISPLACEMENT OF OTSR WORK AREA 85813021 MCLREL EQU X'80' CLOSE REEL (INFO BYTE) 85820021 MCLCLR EQU MSWON+SSWON 85827021 MAWO EQU X'02' APPLY WRITE ONLY BIT IN DOP(FN)+ 85834021 MPARMA EQU X'FA' PARAM HEADER FROM IC TEXT 85841021 MDESTR EQU X'30' MACRO CODE... DESTROY REGISTE 85848021 MRESRV EQU X'28' MACRO CODE... RESERVE REGISTER 85855021 MFREE EQU X'2C' MACRO CODE... FREE RESERVED REGS 85862021 ADRPLX EQU PLUS1-XWC1 85869021 ADRPLY EQU XREG1-XVN1 85876021 RUNSAV EQU SVWJHE CHECKPOINT SAVE AREA 85883021 END EQU * 85890021 LX11 EQU 11 85897021 LX14 EQU 14 85904021 LX90 EQU 90 85911021 LX25 EQU 25 85918021 LX18 EQU 18 85925021 LX120 EQU 120 85932021 LX31 EQU 31 85939021 LX23 EQU 23 85946021 XX52 EQU 82 85953021 XX54 EQU X'54' 85960021 R7 EQU 7 85967021 R8 EQU 8 85974021 R12 EQU 12 85981021 DX0 EQU 0 85988021 LX0 EQU 0 85995021 DX1 EQU 1 86002021 LX1 EQU 1 86009021 DX2 EQU 2 86016021 NX2 EQU 2 86023021 LX2 EQU 2 86030021 DX3 EQU 3 86037021 NX3 EQU 3 86044021 LX3 EQU 3 86051021 DX4 EQU 4 86058021 NX4 EQU 4 86065021 LX4 EQU 4 86072021 DX5 EQU 5 86079021 NX5 EQU 5 86086021 LX5 EQU 5 86093021 DX6 EQU 6 86100021 NX6 EQU 6 86107021 LX6 EQU 6 86114021 DX7 EQU 7 86121021 NX7 EQU 7 86128021 LX7 EQU 7 86135021 DX8 EQU 8 86142021 NX8 EQU 8 86149021 LX8 EQU 8 86156021 DX9 EQU 9 86163021 NX9 EQU 9 86170021 LX9 EQU 9 86177021 DX10 EQU 10 86184021 NX10 EQU 10 86191021 LX10 EQU 10 86198021 DX11 EQU 11 86205021 NX11 EQU 11 86212021 DX12 EQU 12 86219021 NX12 EQU 12 86226021 LX12 EQU 12 86233021 DX13 EQU 13 86240021 NX13 EQU 13 86247021 DX14 EQU 14 86254021 NX14 EQU 14 86261021 DX15 EQU 15 86268021 NX15 EQU 15 86275021 LX15 EQU 15 86282021 DX16 EQU 16 86289021 NX16 EQU 16 86296021 LX16 EQU 16 86303021 DX18 EQU 18 86310021 LX19 EQU 19 86317021 DX20 EQU 20 86324021 DX21 EQU 21 86331021 DX22 EQU 22 86338021 DX23 EQU 23 86345021 DX24 EQU 24 86352021 DX26 EQU 26 86359021 LX26 EQU 26 86366021 DX28 EQU 28 86373021 DX29 EQU 29 86380021 DX30 EQU 30 86387021 LX30 EQU 30 86394021 NX30 EQU 30 86401021 DX32 EQU 32 86408021 LX32 EQU 32 86415021 DX33 EQU 33 86422021 DX35 EQU 35 86429021 DX39 EQU 39 86436021 DX42 EQU 42 86443021 LX50 EQU 50 86450021 NX56 EQU 56 86457021 NX120 EQU 120 86464021 NX121 EQU 121 86471021 NX122 EQU 122 86478021 NX123 EQU 123 86485021 LX124 EQU 124 86492021 DX256 EQU 256 86499021 XX00 EQU X'00' 86506021 XX84 EQU X'84' 86513021 XX70 EQU X'70' 86520021 XX03 EQU X'03' 86527021 XX44 EQU X'44' 86534021 XX45 EQU X'45' 41095 86541021 XX46 EQU X'46' 37374 86548021 XX47 EQU X'47' 41095 86555021 XX4C EQU X'4C' 86562021 XXC0 EQU X'C0' 86569021 XXFF EQU X'FF' 86576021 XX81 EQU X'81' 86583021 XX42 EQU X'42' 86590021 XX07 EQU X'07' 86597021 XX08 EQU X'08' 86604021 XX0A EQU X'0A' 86611021 XX40 EQU X'40' 86618021 XX0D EQU X'0D' 86625021 XX01 EQU X'01' 86632021 XX2C EQU X'2C' 86639021 XX48 EQU X'48' 86646021 XX14 EQU X'14' 86653021 XX7F EQU X'7F' 86660021 XX0C EQU X'0C' 86667021 XX0F EQU X'0F' 86674021 XX02 EQU X'02' 86681021 XX04 EQU X'04' 86688021 XX0B EQU X'0B' 86695021 XX09 EQU X'09' 86702021 XX11 EQU X'11' 86709021 XX10 EQU X'10' 86716021 XXFE EQU X'FE' 86723021 XX05 EQU X'05' 86730021 XX20 EQU X'20' 86737021 XX80 EQU X'80' 86744021 XXEF EQU X'EF' 86751021 XXFD EQU X'FD' 86758021 XX2F EQU X'2F' 86765021 XX1D EQU X'1D' 86772021 XX6D EQU X'6D' 86779021 XX64 EQU X'64' 86786021 XX1E EQU X'1E' 86793021 XXD0 EQU X'D0' 86800021 XX60 EQU X'60' 86807021 XX61 EQU X'61' 7898 86814021 XXD2 EQU X'D2' 86821021 XX0E EQU X'0E' 86828021 XX18 EQU X'18' 86835021 XX21 EQU X'21' 86842021 XX22 EQU X'22' 86849021 XX4E EQU X'4E' 86856021 XXFC EQU X'FC' 86863021 XX30 EQU X'30' 86870021 XX1C EQU X'1C' 86877021 XX23 EQU X'23' 86884021 XXA0 EQU X'A0' 86891021 XX1B EQU X'1B' 86898021 XX36 EQU X'36' 86905021 XX34 EQU X'34' 86912021 XX32 EQU X'32' 86919021 XX33 EQU X'33' 86926021 XX75 EQU X'75' 86933021 XXFA EQU X'FA' 86940021 XXF9 EQU X'F9' 86947021 XX15 EQU X'15' 86954021 XX12 EQU X'12' 86961021 XX50 EQU X'50' 86968021 XX78 EQU X'78' 86975021 XXA4 EQU X'A4' 86982021 XXF0 EQU X'F0' 86989021 XXF1 EQU X'F1' 86996021 XX6C EQU X'6C' 87003021 XX38 EQU X'38' 87010021 XX58 EQU X'58' 87017021 XX5C EQU X'5C' 87024021 XX7C EQU X'7C' 87031021 XXB0 EQU X'B0' 87038021 XXB4 EQU X'B4' 87045021 XX24 EQU X'24' 87052021 XX41 EQU X'41' 87059021 XXC1 EQU X'C1' 87066021 XXB8 EQU X'B8' 87073021 XX06 EQU X'06' 87080021 XXE0 EQU X'E0' 87087021 XX88 EQU X'88' 87094021 XX68 EQU X'68' 87101021 XXC8 EQU X'C8' 87108021 XX90 EQU X'90' 87115021 XX1A EQU X'1A' 87122021 XX1F EQU X'1F' 87129021 XX19 EQU X'19' 87136021 XX13 EQU X'13' 87143021 XX4F EQU X'4F' 87150021 XX16 EQU X'16' 87157021 XX17 EQU X'17' 87164021 XX92 EQU X'92' 87171021 XX95 EQU X'95' 87178021 XX96 EQU X'96' 87185021 XX97 EQU X'97' 87192021 XX94 EQU X'94' 87199021 XX91 EQU X'91' 87206021 XX43 EQU X'43' 87213021 XX8E EQU X'8E' 87220021 XX98 EQU X'98' 87227021 XX9C EQU X'9C' 7898 87234021 XX28 EQU X'28' 87241021 XX3A EQU X'3A' 87248021 XX2A EQU X'2A' 87255021 XX3B EQU X'3B' 87262021 XX2B EQU X'2B' 87269021 XX3F EQU X'3F' 87276021 XX39 EQU X'39' 87283021 XX29 EQU X'29' 87290021 XX3C EQU X'3C' 87297021 XX3D EQU X'3D' 87304021 XX2D EQU X'2D' 87311021 XX31 EQU X'31' 87318021 XXDF EQU X'DF' 87325021 XXF6 EQU X'F6' 87332021 XXF5 EQU X'F5' 87339021 XXF3 EQU X'F3' 87346021 XX74 EQU X'74' 87353021 XX8F EQU X'8F' 87360021 XXC5 EQU X'C5' 87367021 XX35 EQU X'35' 87374021 XXBF EQU X'BF' 87381021 XX25 EQU X'25' 87388021 XX6B EQU X'6B' 87395021 XXCE EQU X'CE' 87402021 XX82 EQU X'82' 87409021 XX6E EQU X'6E' 87416021 XX51 EQU X'51' 87423021 XX55 EQU X'55' 87430021 XXBB EQU X'BB' 87437021 XX7A EQU X'7A' 87444021 XX4B EQU X'4B' 87451021 XX6F EQU X'6F' 87458021 XX73 EQU X'73' 87465021 XX27 EQU X'27' 87472021 XX72 EQU X'72' 87479021 XXAA EQU X'AA' 87486021 XC0 EQU C'0' 87493021 XC9 EQU C'9' 87500021 XCZ EQU C'Z' 87507021 XCM EQU C'M' 87514021 XCE EQU C'E' 87521021 XCW EQU C'W' 87528021 XCI EQU C'I' 87535021 XCU EQU C'U' 87542021 XCF EQU C'F' 87549021 XCV EQU C'V' 87556021 XCA EQU C'A' 87563021 XCD EQU C'D' 87570021 END PHASE51 87577021 LX12 EQU 12 87584021 LX14 EQU 14 87591021 LX17 EQU 17 87598021 LX18 EQU 18 87605021 LX20 EQU 20 87612021 LX23 EQU 23 87619021 LX25 EQU 25 87626021 LX31 EQU 31 87633021 LX70 EQU 70 87640021 LX90 EQU 90 87647021 LX120 EQU 120 87654021 XX52 EQU X'52' 87661021 END PHASE5 87668021 ./ ADD SSI=01011183,NAME=IKFCBL6A,SOURCE=0 *$MODULE PHASE6A 00100020 IKF6A01 CSECT 00200020 * 00300020 * PHASE IDENTIFICATION 00400020 * 00500020 PH6A TITLE 'IKFCBL6A' 00600020 * INPUT DN/PN REFS ON SYSUT3 00700020 * DN DEFS ON SYSUT1 00800020 * PN DEFS ON SYSUT1 (FOLLOWING DN DEFS) 00900020 EJECT 01000020 * EQUATES 01100020 R0 EQU 0 PARAMETER REGISTERS 01200020 R1 EQU 1 01300020 R2 EQU 2 01400020 R3 EQU 3 01500020 RW1 EQU 4 WORK REGS 01600020 RW2 EQU 5 01700020 RW3 EQU 6 01800020 RET2 EQU 7 01900020 RW5 EQU 8 02000020 INPUTR EQU 9 POINTS TO INPUT ELEMENT 02100020 COSREG EQU 10 POINTS TO COMMON 02200020 R11 EQU 11 02300020 BASE EQU 12 BASE REG 02400020 R13 EQU 13 SAVE AREA ADDR 02500020 R14 EQU 14 RETURN REG 02600020 R15 EQU 15 02700020 LOW EQU 4 FOUR 02800020 NOTEQUAL EQU 7 SEVEN 02900020 EQUAL EQU 8 EIGHT 03000020 REFLN EQU 5 LENGTH OF REF ELEMENT 03100020 DNLN EQU 5 LENGTH OF TDNREF TBL ENTRY 03200020 PNLN EQU 4 LENGTH OF TPNREF TBL ENTRY 03300020 EJECT 03400020 IKFCBL6A DS 0H 03500020 STM R14,R12,DX12(R13) SAVE REGISTERS 03600020 LR R2,R13 GET HIGHER SAVE AREA ADDR 03700020 BALR BASE,R0 ESTABLISH ADDRESABILITY 03800020 USING *,BASE 03900020 USING COS,COSREG 04000020 USING INREC,INPUTR 04100020 B PH6A BRANCH AROUND ID 04200020 DC C'IKFCBL6A' PHASE NAME 04300020 DC C'B' BUILD 04400020 DC X'20' NUMBER IN HEX 04500020 PH6A LA R13,SAVE6A GET LOWER SA ADDRESS 04600020 ST R2,DX4(R13) PROVIDE BACK CHAINING(REQUIRED) 04700020 ST R13,DX8(R2) PROVIDE FORWARD CHAINING 04800020 L COSREG,DX0(R1) GET COMMON TABLE ADDR 04900020 * 05000020 * PRINT HEADER LINE 05100020 * 05200020 BALR R0,COSREG EJECT 05300020 DC X'D6' EJECT A PAGE 05400020 MVI OUTBUF,XX40 BLANK OUTPUT LINE 05500020 MVC OUTBUF+NX1(L119),OUTBUF OF PRINT FIELD 05600020 MVC OUTBUF+NX45(L'HDG),HDG GENERATE HEADER LINE 05700020 BAL RW2,PRINTLN BLANK LINE 05800020 BAL RW2,PRINTLN BLANK LINE 05900020 BAL RW2,PRINTLN BLANK LINE 06000020 MVC OUTBUF(L'NAMEMSG),NAMEMSG 06100020 MVC OUTDEF(L'DEFMSG),DEFMSG 06200020 MVC OUTREF(D9),HDG+NX6 MOVE HEADER LINELD 06300020 * SAVE 4000 BYTES FOR THE SYSTEM 06400020 L R15,AGETALL GET ADDR OF SUBRTN TO GET CORE 06500020 BALR R14,R15 BRANCH 06600020 * UPON RETURN R0 CONTAINS STARTING ADDR, R1 LENGTH 06700020 ST R0,TBLADDR INITIALIZE POINTERS 06800020 ST R0,TBLENTRY CURRENT ENTRY ADDRESS 06900020 AR R0,R1 END OF TABLE 07000020 ST R0,TBLEND SAVE 07100020 * 07200020 * 07300020 * READ DATA/FILE NAME REFERENCE ELEMENTS 07400020 * FORMAT //DDDDDD CCCC// 07500020 * WHERE DDDDDD V DICT PTR OR PN NUMBER (IF BIT 0 IN CCCC IS ONE) 07600020 * CCCC = CARD NUMBER 07700020 READREF BALR R0,COSREG CALL PH00 07800020 DC X'03' READ FROM SYSUT3 07900020 BC EQUAL,EOFDN BTANCH - EOF 08000020 LR INPUTR,R0 GET ADDRESS OF AN ELEMENT 08100020 CLI DX0(INPUTR),XX77 IS XREF TO BE PRODUCED 08200020 BE EOFDN NO,BR THEN EXIT 08300020 NEXTREF CLI DX0(INPUTR),XXFF HAS END OF BLOCK BEEN REACHED ? 08400020 BC EQUAL,READREF YES, READ NEXT BLOCK 08500020 L R2,TBLENTRY GET CURRENT ENTRY ADDR 08600020 C R2,TBLEND TABLE OVERFOW 08700020 BC NOTLOW,OVFLOW YES,BR 08800020 MVC DX0(REFLN,R2),DX0(INPUTR) MAKE AN ENTRY IN REFTBL 08900020 LA R2,REFLN(R2) POINT TO NEXT ENTRY 09000020 ST R2,TBLENTRY SAVE 09100020 LA INPUTR,REFLN(INPUTR) POINT TO NEXT ELEMENT 09200020 CLI DX0(INPUTR),XX77 IS XREF TO BE PRODUCED 09300020 BE EOFDN NO,BR THEN EXIT 09400020 B NEXTREF PROCESS NEXT ENTRY 09500020 EJECT 09600020 EOFDN DS 0H 09700020 MVC ZERDSPL(DICTSZ,R2),ZEROS MOVE ZEROS IN AT END OF TBL 09800020 BAL R14,SORT SORT REFTBL 09900020 TM SWITCHX,TBLOVFL HAS TABLE OVERFLOWN 10000020 BC ONES,EOF1 YES,BR 10100020 * 10200020 * PRINT XREF DICTIONARY FOR DATA/FILE NAMES 10300020 * 10400020 L R1,TBLADDR GET REFTBL ADDRESS 10500020 LR RW1,R1 YES,SEARCH USING DICT PTR AS SAR 10600020 L RW3,TBLENTRY GET CURRENT ENTRY ADDRESS 10700020 CR RW1,RW3 ANY ENTRIES IN REFTBL 10800020 BC EQUAL,EXIT EXIT,NAMES ARE NOT REFERENCED 10900020 XREFDN1 EQU * 11000020 BALR R0,COSREG READ DN DEFS 11100020 INFILE DC X'01' 11200020 BC EQUAL,EXIT EOF BR 11300020 LR INPUTR,R0 11400020 XREFDN2 CLI DX0(INPUTR),XXFF END OF BLOCK 11500020 BC EQUAL,XREFDN1 YES,READ NEXT BLOCK 11600020 CLI DX0(INPUTR),XX2C IS THIS A CARD NUMB. 11700020 BC EQUAL,XREFDN8 YES,BR 11800020 CLI INDNID,XX4C IS THIS PN DEF 11900020 BC EQUAL,XREFPN YES,BR 12000020 CLI DX0(INPUTR),XX48 IS THIS A DN DEF 12100020 BC NOTEQUAL,ERROR NO,ERROR BRANCH 12200020 TM SWITCHX,FSTDN IS THIS 1ST DN DEF ELMNT 12300020 BC ONES,XREFDN20 NO,BR 12400020 OI SWITCHX,FSTDN INDICATE-DN DEFS ARE PRESENT 12500020 BAL RW2,PRINTLN PRINT SUB-TITLE FOR DATA NAMES 12600020 BAL RW2,PRINTLN SPACE 12700020 XREFDN20 DS 0H 12800020 NI SWITCHX,XXFF-PNDEF SET DN DEF INDICATOR 12900020 TM SWITCHX,TBLOVFL HAS TABLE OVERFLOWN 13000020 BC EQUAL,XREFDN3 NO,BR 13100020 SR R3,R3 YES,WRITE DN DEF ELMNT 13200020 IC R3,INDNLN GET LNGTH OF DN DEF ELMNT 13300020 LA R3,DX7(R3) 13400020 LR R2,INPUTR SPECIFY ADDR OF DN DEF ELMNT 13500020 BAL R14,OUTPUT WRITE ON OUTFILE 13600020 XREFDN3 DS 0H 13700020 MVC HOLD(LX3),INDNDICT GET SEARCH ARG 13800020 MVC SARG(LX3),HOLD SAVE SEARCH ARG 13900020 BAL R14,SEARCH FIND REFS 14000020 B XREFDN4 BR,FOUND 14100020 XREFDN4 DS 0H 14200020 TM SWITCHX,TBLOVFL HAS TABLE OVERFLOWN 14300020 BC EQUAL,XREFDN40 NO,BR 14400020 XREFDN35 DS 0H 14500020 C RW1,TBLENTRY ARE ALL REFS PROCESSED ? 14600020 BC NOTLOW,XREFDN7 EX,BR 14700020 CLC INDNDICT(D3),DX0(RW1) ARE ALL REFS PROCD 14800020 BC NOTEQUAL,XREFDN7 YES,BR 14900020 TM DX3(RW1),XX80 IS CURRENT REF ENTRY A PN R 15000020 BC EQUAL,XREFDN39 NO,DN REF-PROCESS IT 15100020 XREFDN38 LA RW1,REFLN(RW1) IGNORE PN REFS,POINT TO NEXT ENT 15200020 B XREFDN35 PROCESS NEXT ENTRY 15300020 XREFDN39 DS 0H 15400020 MVC REFOUT+NX1(D2),DX3(RW1) EXTR REF CARD NO. 15500020 LA R3,DX3 SPECIFY LNGTH OF CARD NMBR ELMNT 15600020 LA R2,REFOUT 15700020 BAL R14,OUTPUT WRITE CARD NMBR ON OUTFILE 15800020 B XREFDN38 NEXT ENTRY 15900020 XREFDN40 DS 0H 16000020 SR RW2,RW2 16100020 IC RW2,INDNLN GET LENGTH OF SOURCE NAME 16200020 BCTR RW2,R0 LN-1 16300020 EX RW2,MOVEDN MVC OUTBUF(1),INDNM 16400020 MVC HOLD(LX2),INDNCRD GET CARD NO. FROM DN DEF 16500020 BAL R14,PRINT PRINT 16600020 XREFDN7 DS 0H 16700020 SR RW2,RW2 16800020 IC RW2,INDNLN GET LN OF NAME 16900020 LA INPUTR,DX7(RW2,INPUTR) POINT TO NEXT DN DEF 17000020 B XREFDN2 NEXT DN DEF 17100020 XREFDN8 LR R2,INPUTR SPECIFY ADDR OF CARD NMBR ELMNT 17200020 LA R3,DX3 SPECIFY LENGTH 17300020 BAL R14,OUTPUT WRITE CARD NMBR ELMNT 17400020 LA INPUTR,DX3(INPUTR) POINT TO NEXT ELMNT ON INFILE 17500020 B XREFDN2 PROCESS NEXT 17600020 * 17700020 * 17800020 * PRINT XREF DICTIONARY FOR PROCEDURE NAMES 17900020 * 18000020 XREFPN DS 0H 18100020 OI SWITCHX,PNDEF SET PN DEF INDICATOR 18200020 TM SWITCHX,TBLOVFL HAS TABLE OVERFLOWN 18300020 BC ONES,XREFPN90 YES,BR 18400020 TM SWITCHX,FSTPN IS CURRENT PN 1ST PN 18500020 BC ONES,XREFPN12 NO,BR 18600020 OI SWITCHX,FSTPN INDICATE-1ST PN DEF PROCESSED 18700020 TM SWITCHX,FSTDN WERE DN DEFS PRESENT 18800020 BC EQUAL,XREFPN10 YES,BR 18900020 BAL R14,GENPROC GENERATE SUB-TITLE 19000020 B XREFPN12 BRANCH 19100020 XREFPN10 BAL R14,GENPROC1 GENERATE SUB-TITLE 19200020 XREFPN12 DS 0H 19300020 TM SWITCHX,TBLOVFL HAS TABLE OVERFLOWN 19400020 BC EQUAL,XREFPN2 NO,BR 19500020 SR R3,R3 YES,GET LNGTH OF PN DEF ELMNT 19600020 IC R3,INPNLN 19700020 LA R3,DX6(R3) 19800020 LR R2,INPUTR SPECIFY ADDR OF ELMNT 19900020 BAL R14,OUTPUT WRITE PN DEF ON OUTFILE 20000020 XREFPN2 DS 0H 20100020 MVI HOLD,XX00 20200020 MVC HOLD+NX1(D2),INPNNO GET SEARCH ARGUMENT 20300020 MVC SARG(LX3),HOLD SAVE SEARCH ARG 20400020 BAL R14,SEARCH SEARCH RTN 20500020 B XREFPN5 FOUND,BR 20600020 XREFPN5 DS 0H 20700020 TM SWITCHX,TBLOVFL HAS TABLE OVERFLOWN 20800020 BC R8,XREFPN53 NO,BR 20900020 XREFPN51 C RW1,TBLENTRY ARE ALL REFS PROCESSED 21000020 BC NOTLOW,XREFPN9 YES,BR 21100020 CLC INPNNO(D2),DX1(RW1) ARE ALL REFS PROCD 21200020 BC NOTEQUAL,XREFPN9 YES,BR 21300020 TM DX3(RW1),XX80 IS THIS PN REF 21400020 BC ONES,XREFPN52 YES,BR 21500020 XREFXYZ LA RW1,REFLN(RW1) IGNORE DN REFS,POINT TO NEXT TBL 21600020 B XREFPN51 NEXT TBL 21700020 XREFPN52 MVC REFOUT+NX1(D2),DX3(RW1) EXTR REFS FROM TABLE 21800020 LA R3,DX3 LNGTH 21900020 LA R2,REFOUT ADDR 22000020 BAL R14,OUTPUT WRITE REF CRD NMBR 22100020 B XREFXYZ POINT TO NEXT TBL ENTRY 22200020 XREFPN53 DS 0H 22300020 SR RW2,RW2 22400020 IC RW2,INPNLN GET LENGTH OF SOURCE NAME 22500020 BCTR RW2,R0 LN-1 22600020 EX RW2,MOVEPN MVC OUTBUF(1),INPNM 22700020 MVC HOLD(LX2),INPNCRD GET CARD NO. 22800020 BAL R14,PRINT GENERATE A REFERENCE 22900020 XREFPN9 SR RW2,RW2 23000020 IC RW2,INPNLN GET LENGTH OF NAME 23100020 LA INPUTR,DX6(RW2,INPUTR) POINT TO NEXT PN DEF 23200020 B XREFDN2 NEXT DN DEF 23300020 XREFPN90 TM SWITCHX,FSTDN WERE DN'S PRESENT 23400020 BC EQUAL,XREFPN10 NO,BR 23500020 B XREFPN12 YES,BR 23600020 ******************************************************************* 23700020 * OUTPUT RTN 23800020 ******************************************************************* 23900020 OUTPUT BALR R0,COSREG CALL PH00 24000020 OUTFILE DC X'00' 24100020 BR R14 RETURN 24200020 ******************************************************************* 24300020 EXIT DS 0H 24400020 TM SWITCHX,TBLOVFL HAS TABLE OVERFLOWN 24500020 BC EQUAL,EXIT2 NO,BRANCH EOJ 24600020 L INPUTR,SAVEIN RESTORE REFS ADDR 24700020 MVC TBLENTRY(LX4),TBLADDR RESTORE CURRENT ENTRY ADDR 24800020 B NEXTREF NEXT REF 24900020 ERROR MVC OUTBUF(L'ERRMSG),ERRMSG PH6A 25000020 BAL RW2,PRINTLN PRINT ERROR MSG PH6A 25100020 EXIT2 DS 0H 25200020 TM SWITCH+NX1,DOPH7 IS NEXT PHASE TO BE EXECUTED 25300020 BC EQUAL,EXIT3 NO,EOJ-RETURN 25400020 BALR R0,COSREG LINK TO NEXT PHASE 25500020 DC X'A0' LOAD NEXT PHASE 25600020 EXIT3 BALR R0,COSREG EOJ 25700020 DC X'B0' EOJ 25800020 ******************************************************************* 25900020 EJECT 26000020 * 26100020 * TABLE OVERFLOW ROUTINE 26200020 *