./ ADD LEVEL=40,SOURCE=0,NAME=XXXXDECI 00002000 TITLE 'XXXXDECI - EXTENDED DECIMAL INPUT CONVERSION MODULE' 00004000 **--> CSECT: XXXXDECI EXTENDED DECIMAL INPUT CONVERSION MODULE. . . . 00006000 *. XXXXDECI IS CALLED BY MACRO XDECI TO PERFORM SCANNING AND . 00008000 *. CONVERSION OF DECIMAL STRINGS. . 00010000 *. ENTRY CONDITIONS . 00012000 *. R14= ADDRESS OF XDECIB DSECT CREATED BY CALLING XDECI. . 00014000 *. R15= ENTRY POINT ADDRESS (=V(XXXXDECI) . 00016000 *. EXIT CONDITIONS . 00018000 *. XDECIR1,XDECIRV VALUES ARE FILLED IN FOR REGS. . 00020000 *. CC IS SET ACCORDING TO SIGN OF RESULT, OR = 3 IF ERROR. . 00022000 *. USES DSECTS: XDECIB . 00024000 *. NAMES: XXDI---- . 00026000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00028000 XXXXDECI CSECT 00030000 USING *,R15 NOTE ENTRY PT USING FOR BASE REG 00032000 USING XDECIB,R14 NOTE @ CONTROL BLOCK FROM XDECI 00034000 STM R2,R3,XXDISAVE SAVE WORK REGISTERS 00036000 LA R1,1 USEFUL CONSTANT, IN ODD REGISTER 00038000 LR R2,R0 MOVE BEGINNING @ OVER WHERE USABLE 00040000 * SCAN LOOP TO SKIP OVER LEADING BLANKS. 00042000 CLI 0(R2),C' ' IS NEXT CHARACTER A BLANK 00044000 BNE *+8 SKIP OUT OF LOOP IF NOT 00046000 BXH R2,R1,*-8 LOOP, INCREMENTING SCAN POINTE 00048000 SPACE 1 00050000 MVI XXDIS,X'10' MAKE INST A LPR FOR NOW, + 00052000 CLI 0(R2),C'+' IS THERE A LEADING + 00054000 BE XXDII YES, BRANCH TO BUMP POINTER 00056000 CLI 0(R2),C'-' IS THERE A LEADING - 00058000 BNE XXDII2 NO,DON'T BUMP SCAN POINTER 00060000 MVI XXDIS,X'11' - SIGN,SO MAKE INST AN LNR 00062000 XXDII AR R2,R1 BUMP SCAN PTR BY 1, LEADING SIGN 00064000 XXDII2 LR R3,R2 MOVE INIT SCAN PTR AND SAVE IT 00066000 SPACE 1 00068000 * SCAN TO END OF DECIMAL DIGITS. 00070000 CLI 0(R2),C'0' IS NEXT CHARACTER A DIGIT 00072000 BL *+16 BRANCH OUT OF LOOP IF NOT DIGIT 00074000 CLI 0(R2),C'9' WAS IT TOO HIGH (MULTIPUNCH) 00076000 BH *+8 YES, BRANCH OUT. IDIOT OVERPUNCHRS 00078000 BXH R2,R1,*-16 LOOP BACK, BUMPING SCAN POINTER 00080000 SPACE 1 00082000 ST R2,XDECIR1 STORE VALUE FOR RETURN AS SCAN PTR 00084000 SR R2,R3 OBTAIN LENGTH OF STRING 00086000 BZ XXDION IF ZERO LENGTH, ERROR, BRANCH 00088000 LA R0,9 LIMIT FOR COMPARISON 00090000 CR R2,R0 COMPARE WITH LIMIT VALUE 00092000 BNH *+12 SKIP IF SMALL ENOUGH TO BE OK 00094000 XXDION TM *+1,1 SET COND CODE = 3,BAD VALUE 00096000 B XXDIST GO TO RETURN TO CALLER 00098000 SR R2,R1 NORMAL CODE, DECREMENT LENGTH 00100000 EX R2,XXDIPK PACK THE VALUE 00102000 CVB R0,XXDIDWOR CONVERT VALUE 00104000 XXDIS LPR $+R0,R0 MAKE SIGN, SET CC RIGHT**MODIFIED*** 00106000 ST R0,XDECIRV SAVE AS VALUE FOR REG 00108000 XXDIST LM R2,R3,XXDISAVE RESTORE EXTRA WORK REGS 00110000 B XDECIRET RETURN TO CALLING XDECI MACRO 00112000 SPACE 1 00114000 XXDIPK PACK XXDIDWOR,0($,R3) PACK TO BE EXECUTED 00116000 XXDIDWOR DS D DOUBLEWORD WORKAREA 00118000 XXDISAVE DS 2F WORK REGS SAVE AREA 00120000 DROP R14,R15 KILL USINGS 00122000 SPACE 1 00124000 **--> DSECT: XDECIB CONTROL BLOCK CREATED BY XDECI MACRO. . . . . . 00126000 *. AN XDECIB IS CREATED BY EACH CALL TO THE XDECI MACRO, AND . 00128000 *. CONTAINS THE @ XXXXDECI, SAVEWORDS FOR REGS R14,R15,R0, AND . 00130000 *. WORDS FOR RETURN VALUES FOR REGISTER R1, AND THE ARGUMENT REG. 00132000 *. THIS DSECT IS USED ONLY IN MODULE XXXXDECI. . 00134000 *. GENERATION: XDECI . 00136000 *. NAMES: XDECI--- . 00138000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00140000 XDECIB DSECT 00142000 DS V(XXXXDECI) ADCON TO GET HERE 00144000 DS 3F REGS 14,15,0 SAVED HERE 00146000 XDECIR1 DS A RETURN VALUE FOR REG 1 SCAN POINTER 00148000 XDECIRV DS F VALUE CONVERTED AND RETURNED HERE 00150000 XDECIRET LM 14,1,4(14) RETURN POINT @ 00152000 EQUREGS 00154000 $ EQU 0 FOR ANY FIELD MODIFIED DURING EXEC 00156000 END 00158000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXDECO 00160000 TITLE 'XXXXDECO - EXTENDED DECIMAL OUTPUT CONVERSION PROGRAM' 00162000 **--> CSECT: XXXXDECO EXTENDED DECIMAL OUTPUT CONVERSION MODULE . . . 00164000 *. XXXXDECO IS CALLED BY MACRO XDECO TO CONVERT A REGISTER . 00166000 *. VALUE TO EDITED DECIMAL, IN A 12-BYTE AREA, WITH SIGN. . 00168000 *. ENTRY CONDITIONS . 00170000 *. R14= ADDRESS OF XDECOB DSECT CREATED BY XDECO . 00172000 *. R15= ENTRY POINT ADDRESS (=V(XXXDECO) . 00174000 *. EXIT CONDITIONS . 00176000 *. EDITED 12-BYTE RESULT OF REGISTER ARGUMENT STORED AT ADDRESS ARG. . 00178000 *. USES DSECTS: XDECOB . 00180000 *. NAMES: XXDO---- . 00182000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00184000 XXXXDECO CSECT 00186000 USING *,R15 NOTE ENTRY PT USING FOR BASE 00188000 USING XDECOB,R14 NOTE XDECO CONTROL BLOCK 00190000 STM R1,R2,XXDOSAVE SAVE WORK REGISTERS 00192000 LR R2,R0 MOVE @ AREA WHERE CAN BE USED 00194000 L R0,XDECOV GET VALUE TO BE CONVERTED 00196000 CVD R0,XXDODWOR CONVERT THE VALUE 00198000 MVC 0(12,R2),XXDODECP MOVE EDIT PATTERN IN 00200000 LA R1,11(R2) SET UP FOR NEG NUMBER FOR EDMK 00202000 EDMK 0(12,R2),XXDODWOR+2 EDIT THE VALUE OVER 00204000 BNM XXDORETN SKIP INSERTION OF - IF >=0 00206000 BCTR R1,0 MOVE @ POINTER BACK 1 00208000 MVI 0(R1),C'-' INSERT - IN FRONT OF 1ST DIGIT 00210000 XXDORETN LM R1,R2,XXDOSAVE RESTORE WORKING REGS 00212000 SPM R14 RESTORE ORIGINAL COND CODE 00214000 B XDECORET RETURN TO CALLING XDECO 00216000 SPACE 1 00218000 XXDODECP DC X'402020202020202020202120' EDIT PATTERN 00220000 XXDODWOR DS D WORKAREA 00222000 XXDOSAVE DS 2F SAVE AREA FOR REGS 1-2 00224000 DROP R14,R15 KILL USINGS 00226000 SPACE 1 00228000 **--> DSECT: XDECOB CONTROL BLOCK CREATED BY XDECO. . . . . . . . . 00230000 *. AN XDECOB IS CREATED FOR EACH XDECO CALL, AND CONTAINS THE . 00232000 *. @ XXXXDECO MODULE, SAVE WORDS FOR REGS R14,R15,R0, AND A . 00234000 *. WORD FOR THE VALUE TO BE CONVERTED TO DECIMAL. . 00236000 *. XDECOB IS USED ONLY IN CSECT XXXXDECO. . 00238000 *. GENERATION: XDECO . 00240000 *. NAMES: XDECO--- . 00242000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00244000 XDECOB DSECT 00246000 DS V(XXXXDECO) ADCON TO GET HERE 00248000 DS 3F SAVE AREA FOR REGS 14,15,0 00250000 XDECOV DS F VALUE FOR CONVERSION 00252000 XDECORET LM 14,0,4(14) RETURN POINT @ 00254000 EQUREGS 00256000 END 00258000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXGET 00260000 XXXXGET XGPGEN 00262000 EQUREGS 00264000 END 00266000 ./ ADD LEVEL=41,SOURCE=0,NAME=XXXXHEXI 00268000 TITLE 'XXXXHEXI-MODULE CALLED BY XHEXI' 00270000 **-->CSECT: XXXXHEXI EXTENDED HEXADECIMAL INPUT CONVERSION MODULE . . . 00272000 *. XXXXHEXI IS CALLED BY MACRO XHEXI TO SCAN THE INPUT STRING . 00274000 *. AND CONVERT IT TO HEXADECIMAL INPUT. . 00276000 *. ENTRY CONDITIONS . 00278000 *. R14= ADDRESS OF A STORAGE AREA WITH R14-R1 STORED . 00280000 *. R15= ENTRY POINT ADDRESS (V(XXXXHEXI)) . 00282000 *. R0= ADDRESS OF STRING TO BE SCANNED. . 00284000 *. EXIT CONDITIONS: . 00286000 *. VALUE OF CONVERTED STRING IN STORAGE AREA POINTED TO BY R14, . 00288000 *. STORED IN 16 PASSED R14 OR IN XHEXINUM. . 00290000 *. R1= ENDING ADDRESS OF STRING, I.E. FIRST NON-HEXADECIMAL DIGIT. . 00292000 *. CC SET=3 IF ERROR . 00294000 *. USES DSECT XHEXIB. . 00296000 *. NAMES: XXHI____ . 00298000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00300000 SPACE 1 00302000 XXXXHEXI CSECT 00304000 PRINT NOGEN 00306000 USING *,15 SET UP BASE REGISTER 00308000 USING XHEXIB,R14 DSECT OVERLAP 00310000 STM R14,R6,XXHEXISA STORE APPROPRIATE REGISTERS 00312000 LR R1,R0 START SCAN OF STRING 00314000 LA R3,1 ODD VALUE USED IN BXH INSTR 00316000 XXHILP CLI 0(R1),C' ' SEARCH FOR FIRST NON-BLANK 00318000 BNE XXHIBGN BRANCH WHEN FOUND TO START TRT 00320000 BXH R1,R3,XXHILP KEEP GOING UNTIL FIND NON-BLANK 00322000 XXHIBGN LR R3,R1 FIRST BYTE OF STRING IN R3 AND R4 00324000 LR R4,R3 00326000 LR R6,R1 BEGINNING OF STRING 00328000 LA R1,8(R1) R1 NOW HAS MAXIMUM ADDRESS IN IT 00330000 * IF TRT DOESN'T STOP BEFORE 8TH TIME, R1 WON'T CHANGE=> NEED END 00332000 TRT 0(8,R6),XXHITAB2 FIND LAST BYTE-8 MAXIMUM 00334000 LR R6,R1 SAVE ENDING ADDRESS 00336000 SR R1,R3 FIND NO OF CHARACTERS 00338000 BZ XXHIERR IF LENGTH ZERO SET CC TO 3 00340000 LR R3,R1 00342000 MVC XXHIDOUB(8),=12C'0' MOVE ZEROS IN AREA TO BE CONVERTED 00344000 LA R5,8 00346000 SR R5,R3 # OF PADDED BLANKS 00348000 LA R5,XXHIDOUB(R5) R5 NOW ADDRESS OF AREA CONVERTED STRI 00350000 BCTR R3,0 00352000 EX R3,XXHIMOVE EX USED TO MOVE CONVERTED SRTING IN 00354000 TR XXHIDOUB(8),XXHITAB3 CONVERT C1-C6 TO FA-FF 00356000 PACK XXHIOUT(5),XXHIDOUB(9) DO FUNNY PACK TO MAKE RIGHT LETS 00358000 L R0,XXHIOUT CONVERTED NUMBER IN R0 00360000 ST R0,XHEXINUM STOREE CONVERTED NUMBER 00362000 B XXHIARND BRANCH AROUND CONSTANTS 00364000 LTORG 00366000 XXHIMOVE MVC 0(0,R5),0(R4) MOVE FOR STRING TO BE CONVRTED 00368000 XXHIDOUB DS D,C STORAGE AREA 00370000 XXHIOUT DS F,C STORAGE AREA 00372000 SPACE 1 00374000 ** TAB2 STOPS ON ANYTHING BUT VALID HEX DIGITS 00376000 XXHITAB2 DC 256X'01' 00378000 ORG XXHITAB2+C'A' STOPS ON ANYTHING BUT A-F 00380000 DC 6X'00' 00382000 ORG XXHITAB2+C'0' STOP NOT ON 0-9 00384000 DC 10X'00' 00386000 ORG 00388000 SPACE 1 00390000 * TAB3 USED IN TR CONVERTS FA-FF FROM CU-C6 00392000 XXHITAB3 EQU *-C'A' CONVERT FA-FF FROM C1-C6 00394000 DC X'FAFBFCFDFEFF' 00396000 ORG XXHITAB3+C'0' 00398000 DC X'F0F1F2F3F4F5F6F7F8F9' 00400000 ORG 00402000 XXHIERR TM *+1,1 SET CONDITION CODE 00404000 XXHIARND LM 14,15,XXHEXISA RESTORE REGISTERS 00406000 LR R1,R6 ENDING ADRESS IN SRTING 00408000 LM R2,R6,XXHEXISA+16 00410000 B XHEXIRET RETURN TO CALLING PROG 00412000 XXHEXISA DS 9F SAVE AREA FOR REGISTERS 00414000 DROP R14,R15 CLEAN UP USINGS 00416000 SPACE 5 00418000 *.--> DSECT: XHEXIB CONTROL BLOCK CREATE BY XHEXI . . . . . . . . . . 00420000 *. AN XHEXIB IS CREATED FOR XHEXI CALL, AND CONTAINS THE . 00422000 *.@ XXXXHEXI MODULE, SAVE WORDS R14,R15, R0, AND A WORD VALUE THAT HAS. 00424000 *. BEEN CONVERTED . 00426000 *. XHEXI IS USED ONLY IN CSECT XXXXHEXI . 00428000 *. GENERATION XHEXI . 00430000 *. NAMES XHEXI___ . 00432000 *. . .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00434000 XHEXIB DSECT 00436000 DS V(XXXXHEXI) STORAGE OF VCON 00438000 DS 3F STORAGE FOR REGISTERS 00440000 XHEXINUM DS F STORAGE FOR CONVERTED NUMBER 00442000 XHEXIRET LM R14,0,4(R14) RESTORE REGISTERS 00444000 EQUREGS 00446000 END 00448000 ./ ADD LEVEL=41,SOURCE=0,NAME=XXXXHEXO 00450000 TITLE 'XXXXHEXO-MODULE CALLED BY XHEXO' 00452000 *.-->CSECT: XXXXHEXO EXTENDED HEXADECIMAL OUTPUT CONVERSION MODULE . .. 00454000 *. XXXXHEXO IS CALLED BY MACRO XHEXO TO CONVERT A REGISTER VALUE. 00456000 *. TO EDITED HEXADECIMAL IN AN 8-BYTE AREA. . 00458000 *. ENTRY CONDITIONS: . 00460000 *. R14= ADDRESS OF SAVEAREA FOR CALLING MACRO . 00462000 *. R15= ENTRY POINT ADDRESS. . 00464000 *. R0 ADDRESS OF AREA WHERE CONVERTE STRING GOES . 00466000 *. REGISTER VALUE IN XHEXOREG . 00468000 *. EXIT CONDITIONS: . 00470000 *. 8-BYTE CONVERTED NUMBER OF REGISTER ARGUMENT STORED AT ADDRESS . 00472000 *. ARGUMENT . 00474000 *. USES DSECT XHEXOB. . 00476000 *. NAMES:XXHO---- . 00478000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00480000 SPACE 1 00482000 XXXXHEXO CSECT 00484000 USING *,15 BASE REGISTET 00486000 USING XHEXOB,R14 DSECT OVERLAP 00488000 STM R14,R1,XXHEXOSA STORE REGISTERS 00490000 L R1,XHEXOREG REGISTER TO BE CONVERTED 00492000 ST R1,XXHOAREA STORE NUMBER TO BE CONVERTED 00494000 LR R1,R0 VALUE IN 1 OF ADDRESS TO BE MOVED TO 00496000 L R14,=A(XXHOTAB3-C'0') FOR CONVERSION OF 0-9 TO F0-F9 00498000 UNPK XXHODOUB(9),XXHOAREA(5) CONVERT NUMBER 00500000 TR XXHODOUB,0(R14) MAKE PRINTABLE 00502000 MVC 0(8,R1),XXHODOUB MOVE NUMBER INTO RIGHT AREA 00504000 XXHOBACK LM R14,R1,XXHEXOSA RESTORE REGISTERS 00506000 B XHEXORET RETURN TO CALLING PROG 00508000 XXHOTAB3 DC C'0123456789ABCDEF' 00510000 XXHOAREA DS F,C STORAGE AREA 00512000 XXHODOUB DS D,C STORAGE 00514000 XXHEXOSA DS 4F 00516000 LTORG 00518000 DROP R14,R15 CLEAN UP USINGS 00520000 SPACE 5 00522000 *.--> DSECT: XHEXOB CONTROL BLOCK CREATED BY XHEXO. . . . . . . . . . 00524000 *. AN XHEXOB IS CREATED FOR XHEXO CALL, AND CONTAINS THE @ . 00526000 *. XXXXHEXO MODULE, SAVE WORDS FOR R14-R2 AND THE PLACE TO RETURN . 00528000 *. XHEXOB IS USED ONLY IN CSECT XXXXHEXO. . 00530000 *. GENERATION: XXXXHEXO . 00532000 *. NAMES: XHEXO---- . 00534000 *. . .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00536000 XHEXOB DSECT 00538000 DS V(XXXXHEXO) STORAGE OF VCON 00540000 DS 3F 00542000 XHEXOREG DS F WHERE REGISTER STORED 00544000 XHEXORET LM R14,R2,4(R14) RESTORE REGISTERS 00546000 EQUREGS 00548000 END 00550000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXOPEN 00552000 TITLE 'XOPENBLK DSECT, EQUS FOR XXXXOPEN ROUTINE' 00554000 EQUREGS 00556000 **--> DSECT: XOPENBLK USED TO CONTROL XXXXOPEN MODULE . . . . . . . . 00558000 *. CALLING XIO MODULE PASSES @ IN R1 TO XXXXOPEN TO DO THE. 00560000 *. GENERALIZED OPEN ROUTINE WITH MULTIPLE DDNAMES, ETC. . 00562000 *. GENERATION: 1 CALL TO XOPENBLK MACRO INSTRUCTION. . 00564000 *. NAMES: XOP----- . 00566000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00568000 XOPENBLK DSECT 00570000 XOPABEND EQU B'00000001' (XOPFLAG1) - ABEND IF CAN'T OPEN 00572000 XOPWARN EQU B'00000010' (XOPFLAG1) - WARN IF 1ST DD NO GO 00574000 SPACE 1 00576000 XOPDCBAD DS X,AL3 OPEN/CLOSE ELEMENT (BYTE,ADDR DCB) 00578000 * NEXT FOUR ITEMS ARE USED BY DCB EXIT TO FILL DCB, IF 00580000 * IT HAS NOT ALREADY BEEN DONE DURING OPEN PROCESS. 00582000 XOPLRECL DS H LRECL DEFAULT 00584000 XOPBLKSI DS H BLKSIZE DEFAULT 00586000 XOPBUFNO DS H BUFNO DEFAULT 00588000 XOPRECFM DS B RECFM DEFAULT (F,FA,FB,FBA ALLOWED) 00590000 SPACE 1 00592000 XOPFLAG1 DS B FLAGS FOR CONTROL 00594000 XOPXNAME DS CL8 NAME OF ROUTINE CALLING, FOR MSGS 00596000 XOPDDLIM DS H 8 * (# DDNAMES - 1) :: BXLE LIMIT 00598000 XOPDDNAM DS CL8 BEGINNING OF DDNAME LIST ALLOWED 00600000 SPACE 2 00602000 * ADDITIONAL LOCAL REGISTER EQUATES. 00604000 RXOP EQU R5 @ XOPENBLK - OPEN CONTROL BLOCK 00606000 RDCB EQU R6 @ DCB TO BE OPENED (FROM XOPENBLK) 00608000 RDD1 EQU R7 @ 1ST DDNAME ENTRY IN TIOT 00610000 RBASE EQU R8 BASE REGISTER 00612000 TITLE 'XXXXOPEN - SPECIAL OPEN ROUTINE FOR XXXX IO SUPPORT' 00614000 **--> CSECT: XXXXOPEN CALLED TO DO SPECIAL OPEN BY XIO MODULES . . . 00616000 *. THIS IS CALLED BY ROUTINES LIKE XXXXPRNT, XXXXSNAP, ETC. 00618000 *. TO PERFROM THEIR OPEN'S FOR THEM. ALL INPUT INFOMRATION IS . 00620000 *. CONTAINED IN THE XOPENBLK AREA WHICH IS PASSED TO XXXXOPEN. . 00622000 *. THE ROUTINE PERFORMS THE FOLLOWING ACTIONS: . 00624000 *. 1. ATTEMPTS AN OPEN FOR EACH DDNAME (IN XOPENBLK) WHICH IT . 00626000 *. CAN FIND IN THE TIOT, UNTIL A SUCCESSFUL OPEN IS DONE. IT . 00628000 *. NEVER USES A DDNAME UNLESS IT IS IN THE TIOT. . 00630000 *. 2. DURING A SUCCESSFUL OPEN, THE DCB EXIT IS TAKEN, AND SOME . 00632000 *. PARTS OF THE DCB CAN BE FILLED IN THEN (LRECL, BLKSIZE, . 00634000 *. RECFM, BUFNO). THIS ALLOWS VALUES TO BE FILLED IN FROM JCL. . 00636000 *. 3. IF NO OPEN COULD BE DONE, IT ISSUES A MESSAGE AND ALSO . 00638000 *. MAY ABEND IF DESIRED. . 00640000 *. 4. IF DESIRED, A WARNING MAY BE ISSUED IF THE FIRST CHOICE . 00642000 *. DDNAME COULD NOT BE USED. . 00644000 *. ENTRY CONDITIONS . 00646000 *. R13,R14,R15 : NORMAL OS/360 CONVENTIONS. . 00648000 *. R1 = ADDRESS OF XOPENBLK, WITH ALL VALUES FILLED IN. . 00650000 *. EXIT CONDITIONS . 00652000 *. NO REGISTERS ARE CHANGED, OPEN HAS BEEN PERFORMED IF POSSIBLE. 00654000 *. NAMES: XXOP---- . 00656000 *. USES DSECTS: IHADCB,XOPENBLK . 00658000 *. USES MACROS: ABEND,DCBD,EQUREGS,OPEN,WTO . 00660000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00662000 XXXXOPEN CSECT 00664000 USING *,R15 NOTE ENTRY POINT USING 00666000 STM R14,RBASE,XXOPSAVE SAVE ALL REGS USED 00668000 BALR RBASE,0 SET UP OWN VASE REG, 15 NOT SAFE 00670000 USING *,RBASE NOTE THE USING 00672000 * 1-TIME HOUSEKEEPING INITIALIZATION CODE. 00674000 LR RXOP,R1 MOVE XOPENBLK PTR WHERE SAFE 00676000 USING XOPENBLK,RXOP NOTE THE PTR 00678000 L RDCB,XOPDCBAD GET @ DCB ITSELF 00680000 USING IHADCB,RDCB NOTE THE POINTER THERE 00682000 SPACE 1 00684000 * SAVE ORIGINAL VALUES FROM DCB. 00686000 MVC XXOPLREC,DCBLRECL LOGICAL RECORD LENGTH 00688000 MVC XXOPBLKS,DCBBLKSI BLOCK SIZE 00690000 MVC XXOPBUFN,DCBBUFNO BUFFER NUMBER 00692000 MVC XXOPRECF,DCBRECFM RECORD FORMAT 00694000 SPACE 1 00696000 MVC DCBEXLST+1,=AL3(XXODEXLS) @ OF OUR EXIT LIST TO USE 00698000 SPACE 1 00700000 * CHASE POINTERS TO @ OF 1ST DDNAME IN TIOT. 00702000 L R1,16 @ CVT 00704000 L R1,0(,R1) @ TCB PTR 00706000 L R1,0(,R1) @ TCB 00708000 L R1,12(,R1) @ TIOT 00710000 LA RDD1,24(,R1) 8 1ST DD ENTRY IN THE TIOT 00712000 SPACE 1 00714000 * INIT FOR LOOP TO SEARCH TIOT FOR EACH DDNAME ALLOWED, 00716000 * THEN ATTEMPT OPEN ON EACH FOUND UNTIL OPEN WORKS. 00718000 LA R2,8 BXLE INCREMENT = LENGTH OF DDNAME 00720000 LA R3,XOPDDNAM @ 1ST DDNAME IN XOPENBLK LIST 00722000 LR R4,R3 MOVE OVER, R4 WILL BE INDEX REG 00724000 AH R3,XOPDDLIM ADD OFFSET = LIMIT FOR COMING BXLE 00726000 SPACE 1 00728000 * OUTER LOOP: CHECK EACH DDNAME IN XOPENBLK IN ORDER. 00730000 XXOPZERO SR R0,R0 CLEAR FOR INSERTIONS 00732000 LR R1,RDD1 INIT TO @ OF 1ST ONE IN TABLE 00734000 SPACE 1 00736000 * INNER LOOP: LOOK FOR DDNAME IN TIOT, THEN TRY OPEN. 00738000 XXOPDDSR IC R0,0(,R1) GET LENGTH/CODE BYTE 00740000 LTR R0,R0 WAS LENGTH = 0 (NO MORE DD ENTRIES) 00742000 BZ XXOPBXLE YES, SO GO FOR NEXT DD IN XOPENBLK 00744000 CLC 4(8,R1),0(R4) WAS DDNAME IN TIOT = ONE IN XOPENBLK 00746000 BE *+8 YES, SKIP OUT OF TIOT SEARCH 00748000 BXH R1,R0,XXOPDDSR NO, INCREMENT TIOT PTR, BRNCH ALWAYS 00750000 SPACE 1 00752000 * DDNAME FOUND IN TIOT - MAKE SURE VALUES IN DCB ARE 00754000 * CORRECT, ATTEMPT OPEN, FILL IN VALUES NEEDED. 00756000 MVC DCBDDNAM,0(R4) MOVE IN DDNAME WE'VE FOUND 00758000 MVC DCBLRECL,XXOPLREC MAKE SURE LRECL OK 00760000 MVC DCBBLKSI,XXOPBLKS MAKE SURE BLKSIZE OK 00762000 MVC DCBBUFNO,XXOPBUFN MAKE SURE BUFNO OK 00764000 MVC DCBRECFM,XXOPRECF MAKE SURE RECFM OK 00766000 SPACE 1 00768000 OPEN MF=(E,XOPDCBAD) DO REMOTE OPEN 00770000 TM DCBOFLGS,X'10' DID OPEN GO 00772000 BO XXOPNOKA YES, WE'RE DONE - QUIT 00774000 XXOPBXLE BXLE R4,R2,XXOPZERO DIDN'T GO TRY AGAIN 00776000 SPACE 1 00778000 * NO GOOD DDNAME WAS FOUND AND OPENED - MESSAGE, ABEND. 00780000 MVC XXOP300B(8),XOPXNAME MOVE IN NAME OF CALLING RT 00782000 WTO MF=(E,XXOP300A) DO WRITE TO PROGRAMMER 00784000 SPACE 1 00786000 TM XOPFLAG1,XOPABEND DOES HE REALLY WANT ABEND 00788000 BZ XXOPRETN NO, DONT DO IT 00790000 ABEND 300,DUMP YES, QUIT NOW 00792000 SPACE 2 00794000 XXOPNOKA DS 0H COME HERE IF OPEN WORKED 00796000 TM XOPFLAG1,XOPWARN DID HE WANT WARNING IF NOT 1ST COIC 00798000 BZ XXOPRETN NO, SO DON'T BOTHER CHECKING 00800000 CLC XOPDDNAM,0(R4) WAS THE FIRST DDNAME USED 00802000 BE XXOPRETN YES, QUIT 00804000 SPACE 1 00806000 * CALLER DESIRED WARNING IF 1ST DDNAME NOT USED - GIVE IT. 00808000 MVC XXOP400B(8),XOPXNAME MOVE IN ROUTINE NAME 00810000 MVC XXOP400C(8),0(R4) MOVE IN ACTUAL DDNAME USED 00812000 MVC XXOP400D(8),XOPDDNAM MOVE IN FIRST CHOICE DDNAME 00814000 WTO MF=(E,XXOP400A) WRITE TO PROGRAMMER 00816000 SPACE 1 00818000 XXOPRETN EQU * EXIT TO CALLER 00820000 LM R14,RBASE,XXOPSAVE RESTORE ALL REGS 00822000 BR R14 RETURN 00824000 SPACE 2 00826000 **--> EXIT : DCB EXIT - WHEN EXIT IS CALLED BY SUPERVISOR, THIS CODE* 00828000 * FILLS IN ANY FIELDS WHICH HAVE NOT BEEN FILLED IN ALREADY, * 00830000 * I.E., FROM ORIGINAL DCB, DD CARD, OR DATASET LABEL. * 00832000 * NOTE: THIS CODE DEPENDS ON REGS 2-12 BEING UNCHANGED * 00834000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00836000 XXOPEXIT EQU * EXIT ENTRY POINT 00838000 DROP RDCB 00840000 USING IHADCB,R1 00842000 USING *,R15 NOTE LOCAL USING 00844000 SR R2,R2 USE FOR COMPARISON 00846000 CH R2,DCBLRECL LRECL FOUND YET 00848000 BNE *+10 YES, SKIP 00850000 MVC DCBLRECL,XOPLRECL NO, MOVE DEFAULT ONE IN 00852000 SPACE 1 00854000 CH R2,DCBBLKSI BLKSIZE FILLED IN YET 00856000 BNE *+10 YES, SKIP 00858000 MVC DCBBLKSI,XOPBLKSI NO, MOVE DEFAULT IN 00860000 SPACE 1 00862000 CH R2,DCBBUFNO BUFNO FILLED IN YET 00864000 BNE *+10 YES, SKIP 00866000 MVC DCBBUFNO,XOPBUFNO NO, MOVE DEFAULT IN 00868000 SPACE 1 00870000 CLI DCBRECFM,B'00000000' RECFM SPECIFIED YET 00872000 BNE *+10 YES, SKIP 00874000 MVC DCBRECFM,XOPRECFM NO, MOVE DEFAULT VALUE IN 00876000 BR R14 RETURN TO SUPERVISOR 00878000 DROP R15 ZAP TEMPORARY USING 00880000 SPACE 2 00882000 * CONSTANTS AND WORKAREAS 00884000 XXODEXLS DC 0F'0',X'85',AL3(XXOPEXIT) EXIT LIST FOR DCB EXIT 00886000 SPACE 1 00888000 XXOP300A WTO ' XXXXXXXX ABEND 300 - COULD NOT OPEN FOR ANY DDNAME: #00890000 DD CARD MISSING OR MISSPELLED',MF=L,ROUTCDE=11 (WTP) 00892000 XXOP300B EQU XXOP300A+5 OFFSET TO XXXXXXXX (XMODULE NAME) 00894000 SPACE 1 00896000 XXOP400A WTO ' XXXXXXXX WARNING 400 - DDNAME: YYYYYYYY USED, RATHER #00898000 THAN PREFERRED: ZZZZZZZZ',MF=L,ROUTCDE=11 00900000 XXOP400B EQU XXOP400A+5 OFFSET TO XXXXXXXX (XMODULE NAME) 00902000 XXOP400C EQU XXOP400A+36 OFFSET TO YYYYYYYY (DDNAME USED) 00904000 XXOP400D EQU XXOP400A+75 OFFSET TO ZZZZZZZZ (DDNAME PREFERED) 00906000 XXOPSAVE DS (RBASE+3)F RESERVE SPACE FOR R14,R15,R0,R1-RBASE 00908000 SPACE 1 00910000 * NEXT 4 AREAS USED TO SAVE ORIGINAL VALUES IN DCB SO 00912000 * THAT EVERY OPEN BEGINS WITH SAME ONES, IF ANY FAIL. 00914000 XXOPLREC DS H LRECL 00916000 XXOPBLKS DS H BLKSIZE 00918000 XXOPBUFN DS H BUFNO 00920000 XXOPRECF DS B RECFM 00922000 LTORG 00924000 DROP RXOP,RBASE ZAP ALL USINGS 00926000 EJECT 00928000 DCBD DSORG=QS GENERATE DSECT IHADCB 00930000 END 00932000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXPNCH 00934000 XXXXPNCH XIOGN DDNAME=(XPNCH,FT07F001),RECFM=F 00936000 EQUREGS 00938000 END 00940000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXPRNT 00942000 XXXXPRNT XIOGN LRECL=133,BLKSIZE=133,RECFM=FA,DDNAME=(XPRNT,FT06F001) 00944000 EQUREGS 00946000 END 00948000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXPUT 00950000 XXXXPUT XGPGEN DIREC=P 00952000 EQUREGS 00954000 END 00956000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXREAD 00958000 XXXXREAD XIOGN DDNAME=(XREAD,INPUT,FT05F001),XOP=INPUT,RECFM=F 00960000 EQUREGS 00962000 END 00964000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXXXSNAP 00966000 TITLE 'XXXXSNAP - I/O CSECT USED BY XSNAP - VERSION 5.0' 00968000 XXSNAPC DSECT 00970000 XXSGPRG EQU B'00000001' (XXSFLAGS)=> PRINT GP REGS 00972000 XXSFLRG EQU B'00000010' (XXSFLAGS)=> PRINT FL REGS 00974000 XXSRGSAV DS 16F REGISTER AREA, REGS SAVED BY XSNAP 00976000 XXSFLAGS DS B OPTION BYTE FLAG 00978000 DS AL1 **** UNUSED AS OF VERSION 4.0*** 00980000 XXSLABLN DS AL1 LENGTH OF THE LABEL FIELD 00982000 XXSNMSTR DS AL1 NUMBER OF @ PAIRS IN STORAGE= LIST 00984000 DS V(XXXXSNAP) ADCON FOR CALL TO XXXXSNAP ROUTINE 00986000 XXSADSTR DS 0A STORAGE = ADDRESS LIST(OPTIONAL) 00988000 SPACE 2 00990000 SPACE 2 00992000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00994000 * JOHN R. MASHEY - MAY 1969 * 00996000 * VERSION 4.0 - FEBRUARY 1970 * 00998000 * * 01000000 * VERSION 5.0 - NOVEMBER 1972 CALLS * 01002000 * XXXXOPEN CSECT. RICHARD FOWLER * 01004000 * * 01006000 * IBM 360/67 ASSEMBLER 'G' * 01008000 * PENNSYLVANIA STATE UNIVERSITY * 01010000 * ABSOLUTE REGISTER EQUATES AND USAGE * 01012000 R0 EQU 0 WORK REGISTER * 01014000 R1 EQU 1 USED AS WORK REGISTER * 01016000 R2 EQU 2 USED TO HOLD 1ST ADDRESS OF PAIR * 01018000 R3 EQU 3 USED TO HOLD SECOND ADDRESS OF PAIR* 01020000 R4 EQU 4 USED AS INCREMENT FOR BXLE'S * 01022000 R5 EQU 5 LIMIT ADDRESS IN VARIOUS BXLE'S * 01024000 R6 EQU 6 WILL CONTAIN CVTMZ00(HIGHEST ADDR) * 01026000 R7 EQU 7 OLD ADDRESS IN SAME LINE CHECK * 01028000 R8 EQU 8 INTERNAL LINKAGE REGISTER * 01030000 R9 EQU 9 ADDRESS OF CURRENT ADDRESS PAIR * 01032000 R10 EQU 10 POINTS TO XSNAP LABEL,REGISTER AREA* 01034000 R11 EQU 11 UNUSED * 01036000 R12 EQU 12 # STORAGE= ADDRESS PAIRS TO DO * 01038000 R13 EQU 13 BASE REGISTER/@ DUMMY SAVE AREA * 01040000 R14 EQU 14 RETURN ADDR,POINTER TO LABEL LENGTH* 01042000 R15 EQU 15 ENTRY POINT REGISTER * 01044000 EQUREGS L=F,DO=(0,6,2) SET UP FLOATING EQUS 01046000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01048000 SPACE 2 01050000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01052000 * XSNAP CONTROL BLOCK AND POINTERS ON ENTRY TO XXXXSNAP. * 01054000 * FIELD LENGTH(BYTES) DESCRIPTION/PURPOSE * 01056000 * LABEL LABLN LABEL=, PADDED TO FULLWORD WITH ' '* 01058000 * R10===>RGSAV 64 16 FULLWORDS, WHERE REGS WERE SAVED* 01060000 * FLAGS 1 BYTE FOR OPTION BITS * 01062000 * BIT 6 = 1 ==> PRINT FP REGISTERS. IF =0, DO NOT * 01064000 * BIT 7 = 1 ==> PRINT GP REGISTERS. IF =0, DO NOT * 01066000 * UNUSED 1 FOR FUTURE USE, NOT USED IN V.4.0 * 01068000 * LABLN 1 LENGTH OF THE LABEL FIELD * 01070000 * NMSTR 1 # 8-BYTE @ PAIRS IN STORAGE= LIST * 01072000 * ADCON 4 V(XXXXSNAP) FOR CALL * 01074000 * ADSTR NMSTR*8 STORAGE= @ LIST, IF PRESENT * 01076000 * INSTRUCTS 10 3 INSTRUCTIONS - LA, L, BALR * 01078000 * R14===>LM 0,15,0(10) RETURN POINT, RELOADS REGISTERS * 01080000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01082000 EJECT 01084000 XXXXSNAP CSECT 01086000 $CHN EQU 0 FOR ANY FIELD CHANGED DURING EXEC 01088000 ENTRY XXSNDCB SO PEOPLE CAN CHANGE,IF THEY WISH 01090000 USING XXXXSNAP,R15 NOTE TEMPORARY ENTRY USING 01092000 USING XXSNAPC,R10 NOTE POINTER TO BLOCK 01094000 CNOP 0,4 MAKE SURE ALIGNED ON FULLWORD 01096000 BAL R13,*+76 SET UP BASE AND SAVE AREA @ 01098000 USING *,R13 NOTE USING FOR BASE/SAVE AREA 01100000 XXSSAVE DS 18F FAKE SAVE AREA FOR OS TO SAVE INTO 01102000 ORG XXSSAVE ORG BACK 01104000 XXDWORK DS 4D OVERLAP FLT WORK AREAS INTO FAKE SAV 01106000 ORG 01108000 DROP R15 CLEAR TEMPORARY USING 01110000 ST R14,XXSAVE14 SAVE RETURN ADDRESS,CC PROG MAKS 01112000 SPACE 2 01114000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01116000 * CALL CSECT XXXXOPEN TO OPEN THE DCB THE FIRST TIME CALLED,CHNG 01118000 * NOP TO A BRANCH SO THAT IT WILL ONLY BE OPENED ONCE,AND MAKE CHECK* 01120000 * TO ASSURE DCB WAS OPENED SUCCESSFULLY,ABENDING IF NOT. * 01122000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01124000 BC $CHN,XXOPENOK **CHANGED TO BRANCH BY NEXT INST**** 01126000 MVI *-3,X'F0' **INSTRUCTION. THUS DO ONLY 1 OPEN * 01128000 LA 1,XXSNOPBK GET ADDRESS OF CONTROL BLOCK 01130000 L 15,XXSNOPAD GET ADDRESS OF SUPER OPEN CSECT 01132000 BALR 14,15 GO THERE, ONLY RETURNS IF FILE OPEND 01134000 SPACE 2 01136000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01138000 * GET ADDRESS OF LABEL FROM FIRST POSITION IN ADDRESS LIST, * 01140000 * AND USING REGISTER 10(THE ADDRESS OF THE REGISTER SAVE AREA) * 01142000 * FIND THE LENGTH OF THE LABEL AND PRINT THE LABEL& HEADER LINE. * 01144000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01146000 SPACE 2 01148000 XXOPENOK SR R2,R2 CLEAR FOR INSERTION 01150000 IC R2,XXSLABLN GET LENGTH OF LABEL FIELD 01152000 LR R1,R10 GET DUPLICATE OF XXSNAPC PTR 01154000 SR R1,R2 SUBTRACT TO GET START @ FOR LABEL 01156000 BCTR R2,0 DECREMENT TO LENGTH-1 FOR MVC 01158000 STC R2,*+5 STORE INTO MVC 01160000 MVC XXLABEL+38($CHN),0(R1) MOVE LABEL TO PRINT AREA 01162000 ST R1,XXWORK1 SAVE THIS @ FOR CONVERSION 01164000 MVC XXWORK1(1),XXSAVE14 MOVE CCMASK OVER FOR CONVERSION 01166000 MVC XXLABEL+1(XXSN1B),XXSNP1ST MOVE HEADER,PATTERN,MSG 01168000 ED XXLABEL+L'XXSNP1ST+1(6),XXCOUNT EDIT CALL NUMBER 01170000 UNPK XXLABEL+1+XXSN1B(9),XXWORK1(5) CONVRT CCPM,LOCN 01172000 TR XXLABEL+1+XXSN1B(8),XXTAB1 FINISH HEX CONVERSION 01174000 AP XXCOUNT,=PL1'1' INCREMENT NUMBER OF CALLS 01176000 LA R0,XXLABEL SET UP ADDR FOR PRINT ROUTINE 01178000 BAL R8,XXPRINT GET THE TITLE LINE PRINTED OUT 01180000 MVC XXLABEL+1(L'XXLABEL-1),XXBLANKS 01182000 SPACE 2 01184000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01186000 * CHECK TO SEE IF THE REGISTERS SHOULD BE PRINTED. * 01188000 * PRINT THE HEADING FOR THE REGISTER DUMP. CONVERT AND PRINT * 01190000 * THE REGISTERS IN 2 LINES. CHECK TO SEE IF ONLY THE REGISTERS * 01192000 * WERE DESIRED. FINISH UP AND RETURN TO CALLING XSNAP IF SO. * 01194000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01196000 SPACE 2 01198000 TM XXSFLAGS,XXSGPRG DOES HE WANT GP REGS PRINTED 01200000 BZ XXCHKFP NO, SO DONT PRINT THEM 01202000 LR R2,R10 DUPLICATE @ RGSAV OVER 01204000 XXGOREG LA R0,XXREGLAB ADDRESS OF REGISTER LABEL 01206000 BAL R8,XXPRINT PRINT THE REGISTER LABEL 01208000 MVC XXREGOUT(12),=CL12'0 REGS 0-7' LABEL-1ST REGS 01210000 BAL R8,XXREGS1 CONVERT 1>T REGS BLOCK,PRINT LINE 01212000 BAL R8,XXPRINT HAVE LINE PRINTED 01214000 MVC XXREGOUT(12),=CL12' REGS 8-15' 2ND LINE LABEL 01216000 BAL R8,XXREGS2 GET 2ND GROUP CONVERTED,PRINTED 01218000 BAL R8,XXPRINT HAVE LINE PRINTED 01220000 XXCHKFP TM XXSFLAGS,XXSFLRG DOES HE WANT FLOATING PT REGS PRINTE 01222000 BZ XXCHKST NO,SO GO CHECK FOR STORAGE= 01224000 SPACE 1 01226000 * FOLLOWING SECTION PRINTS FLOATING POINT REGISTERS * 01228000 MVC XXREGOUT(12),=CL12'0 FLTR 0-6' MOVE LABEL IN 01230000 STD F0,XXDWORK SAVE REG F0 01232000 STD F2,XXDWORK+8 SAVE F2 01234000 STD F4,XXDWORK+16 SAVE F4 01236000 STD F6,XXDWORK+24 SAVE F6 01238000 LA R2,XXDWORK SET UP @ WORKAREA FOR XXREGS1 01240000 BAL R8,XXREGS1 CALL GP REG CONVERTER 01242000 MVC XXREGOUT+24(12),XXREGOUT+28 PUT F0 TOGETHRE 01244000 MVC XXREGOUT+48(12),XXREGOUT+52 PUT F2 TOGETHER 01246000 MVC XXREGOUT+72(12),XXREGOUT+76 PUT F4 TOGETHER 01248000 MVC XXREGOUT+96(12),XXREGOUT+100 PUT F6 TOGETHER 01250000 BAL R8,XXPRINT PRINT THE ASSEMBLED LINE 01252000 MVC XXREGOUT,XXBLANKS REBLANK LINE LIKE ITS SUPPOSED TO BE 01254000 SPACE 1 01256000 XXCHKST SR R12,R12 CLEAR FOR INSERT 01258000 IC R12,XXSNMSTR GET # OF ADDRESS PAIRS 01260000 LTR R12,R12 ARE THERE ANY @ PAIRS 01262000 BZ XXEXIT1 NO STORAGE=, SO QUIT 01264000 LA R9,XXSADSTR INIT R9 TO @ FIRST ADDRESS PAIR 01266000 LA R4,4 SET UP BXLE INDEX FOR REST OF PROG 01268000 * THE FOLLOWING 2 LINES HELP US PREVENT 0C5'S * 01270000 L R6,16 GET CVT POINTER 01272000 L R6,164(R6) GET CVTMZ00-HIGHEST MACHINE @ 01274000 SH R6,=H'32' REDUCE SO WILL NOT 0C5 01276000 SPACE 2 01278000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01280000 * SECTIONS XXMEMA - XXMEME SERVE TO PROCESS 1 ADDRESS PAIR * 01282000 * FROM THE LIST OF ADDRESS PAIRS SPECIFYING STORAGE TO BE DUMPED. * 01284000 * AT XXMEMF,THE 2ND ADDRESS IS TESTED TO SEE IF IT IS THE LAST ONE * 01286000 * AND THE DUMP COMPLETED IF SO. OTHERWISE,A BRANCH IS TAKEN BACK * 01288000 * TO XXMEMA TO PROCESS THE NEXT ADDRESS PAIR. * 01290000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01292000 SPACE 2 01294000 XXMEMA LM R2,R3,0(R9) OBTAIN NEXT ADDRESS PAIR 01296000 UNPK XXCOREL,1(4,R9) 1ST STEP TO CONVERT LOWER ADDR 01298000 UNPK XXCOREH,5(4,R9) UST STEP TO CONVERT HIGHER ADDRESS 01300000 TR XXCOREL(17),XXTAB1 TRANSLATE TO COMPLETE HEX CONVERT 01302000 MVC XXCOREL+6(4),=C' TO ' BLANK EXTRA BYTE&ADD TO 01304000 MVI XXCOREH+6,C' ' BLANK OUT EXTRA BYTE 01306000 LA R0,XXCORETL SET UP ADDRESS OF CORE TITLE 01308000 BAL R8,XXPRINT GET CORE HEAD PRINTED 01310000 CR R3,R6 MAKE SURE HIGH ADDR ISN'T TOO HIGN 01312000 BNH *+6 SKIP OVER IF NOT TOO HIGH 01314000 LR R3,R6 @ WOULD 0C5-USE HIGHEST INSTEAD 01316000 LA R3,31(R3) PREPARE TO ROUND 2ND ADDR UPWARD 01318000 SRDL R2,5 ROUND BOTH ADDRESSES 01320000 SLL R2,5 NOW HAVE 1ST ADDR IN R2,ROUNDED DOWN 01322000 SLL R3,5 NOW HAVE HIGH ADDR IN R3,ROUNDED UP 01324000 CR R2,R3 WAS USER IN ERROR& LOW ADDR>HIGH ADD 01326000 BH XXMEMF ADDR ERROR-PRINT NOTHING,GO TO NEXT 01328000 CR R2,R6 MAKE SURE IF 1ST=2ND>MEMORY SIZE 01330000 BH XXMEMF PRINT NOTHING IF SO 01332000 SPACE 2 01334000 XXMEMB EQU * 01336000 ST R2,XXWORK1 STORE BEGINNING ADDR FOR CONVERT 01338000 LR R7,R2 SAVE BEGINNING ADDRESS FOR SAME CHK 01340000 UNPK XXCORADD+1(7),XXWORK1+1(4) GET BEGINNING ADDRESS 01342000 MVC XXCORE3,0(R2) MOVE 32 BYTES OVER FOR ALPHMERIC TR 01344000 TR XXCORE3,XXTAB2 PERFORM ALPHAMERIC CONVERSION 01346000 LA R1,XXCORE1 ADDRESS FOR 1ST BLOCK CONVERSION 01348000 BAL R8,XXMEMP1 GET 1ST BLOCK OF 4 WORDS CONVERTED 01350000 LA R1,XXCORE2 ADDRESS FOR 2ND BLOCK CONVERSION 01352000 BAL R8,XXMEMP1 GET 2ND BLOCK CONVERTED 01354000 TR XXCORADD+1(84),XXTAB1 FINISH HEX CONVERSION 01356000 LA R0,XXCORADD ADDRESS OF CORE OUTPUT LINE 01358000 BAL R8,XXPRINT GET 1 CORE LINE PRINTED 01360000 SPACE 2 01362000 * XXMEMC-XXMEME CHECK FOR DUPLICATE LINES. HAVING FOUND 1 OR * 01364000 * MORE DUPLICATE LINES,CORE IS SCANNED UNTIL A DIFFERENT LINE IS * 01366000 * FOUND,OR THE BLOCK FINISHED,AND THEN PRINTS SAME LINES MESSAGE. * 01368000 SPACE 2 01370000 XXMEMC CR R2,R3 R2 HAS BEEN INCREMENTED-ARE WE DONE 01372000 BNL XXMEMF YES WE'RE DONE WITH THIS SECTION 01374000 CLC 0(32,R7),0(R2) COMPARE PREVIOUS SECTION WITH NEXT 01376000 BNE XXMEMB NOT THE SAME-WILL HAVE TO PRINT LINE 01378000 LA R7,32(R7) INCREMENT SO WILL HAVE RIGHT 3 01380000 ST R7,XXWORK1 SAVE 1ST LINE ADDRESS OF SAME AREAS 01382000 UNPK XXSAML,XXWORK1+1 1ST STEP TO CONVERT 01384000 XXMEMD LA R2,32(R2) INCREMENT TO LOOK AT NEXT SECTION 01386000 CR R2,R3 ARE WE DONE 01388000 BNL XXMEME YES,WE'RE DONE-SAME LINES MESSAGE 01390000 CLC 0(32,R7),0(R2) CHECK NEXT SECTION WITH 1ST OF SAMES 01392000 BE XXMEMD SAME-KEEP LOOPING UNTIL DIFFERENT 01394000 XXMEME LR R1,R2 SAVE END ADDR WHERE CAN DESTROY 01396000 SH R1,=H'32' DECRMENT SO LINE ADDR RIGHT 01398000 ST R1,XXWORK1 SAVE FOR HEX CONVERSION 01400000 UNPK XXSAMH,XXWORK1+1 CONVERT-FIRST STEP 01402000 TR XXSAML(13),XXTAB1 FINISH HEX CONVERSION OF SAME LINES 01404000 MVI XXSAML+6,C'-' PLACE DASH BETWEEN ADDRESSES 01406000 LA R0,XXSAME ADDRESS OF MESSAGE FOR OUTPUT 01408000 BAL R8,XXPRINT PRINT THE SAME LINE MESSAGE 01410000 CR R2,R3 HAVE WE MEANWHILE FINISHED BLOCK 01412000 BL XXMEMB NO-KEEP GOING UNTIL BLOCK DONE 01414000 XXMEMF LA R9,8(R9) INCREM R9 TO @ NEXT @ PAIR 01416000 BCT R12,XXMEMA GO BACK FOR NEXT BLOCK 01418000 B XXEXIT2 ALL STORAGE= DONE, GO RETURN 01420000 SPACE 2 01422000 * XXEXIT - PRINT ENDING LINE,THEN RETURN TO CALLING XSNAP. * 01424000 SPACE 2 01426000 XXEXIT1 TM XXSFLAGS,XXSGPRG+XXSFLRG WERE EITHER REGS PRINTED 01428000 BZ XXEXIT3 NO OPTIONS, JUST LEAVE SINGLE LINE 01430000 XXEXIT2 LA R0,XXLABEL SET UP FOR BLANK LINE 01432000 BAL R8,XXPRINT CALL PRINTER SECTION 01434000 XXEXIT3 L R14,XXSAVE14 RELOAD RETURN @, CC 01436000 SPM R14 RESTORE CONDITION CODE 01438000 BR R14 RETURN TO CALLING XSNAP 01440000 SPACE 2 01442000 * *** INTERNAL SUBROUTINE AREA *** * 01444000 SPACE 2 01446000 * XXREGS1 CONVERTS AND PRINTS 1 LINE OF 8 REGISTERS * 01448000 SPACE 1 01450000 XXREGS1 LA R4,12 INCREMENT FOR BXLE 01452000 LA R5,XXREGOUT+16+7*12 LIMIT ADDRESS FOR BXLE 01454000 XXREGS2 LA R3,XXREGOUT+16 START POINT,INDEX FOR COMING BXLE 01456000 XXREGS3 UNPK 0(9,R3),0(5,R2) CONVERT 1 REGISTER VALUE 01458000 MVI 8(R3),C' ' BLANK OUT EXTRA BYTE USED IN CONVERT 01460000 LA R2,4(R2) INCRMENT POINTER TO REGISTER 01462000 BXLE R3,R4,XXREGS3 LOOP-DO 1 LINE OF 8 REGISTER VALUES 01464000 TR XXREGOUT+16(92),XXTAB1 FOR REST OF HEX CONVERT 01466000 LA R0,XXREGOUT ADDRESS OF OUTPUT LINE 01468000 BR R8 RETURN TO CALLER 01470000 SPACE 2 01472000 * XXMEMP1 CONVERTS 1 BLOCK OF 16 BYTES TO HEX. * 01474000 SPACE 1 01476000 XXMEMP1 LA R5,12(R2) SET UP LIMIT FOR BXLE 01478000 XXMEMP2 UNPK 0(9,R1),0(5,R2) UNPACK 1 WORD OF MEMORY 01480000 MVI 8(R1),C' ' BLANK OUT EXTRA BYTE UNPACKED 01482000 LA R1,9(R1) INCREMENT POINTER TO OUTPUT AREA 01484000 BXLE R2,R4,XXMEMP2 CONTINUE,CONVERTING 16 BYTES 01486000 BR R8 RETURN TO CALLER 01488000 SPACE 2 01490000 * XXPRINT PRINTS 130 CHARACTERS FROM THE ADDRESS IN R0 * 01492000 SPACE 1 01494000 XXPRINT PUT XXSNDCB,(0) PRINT SPECIFIED LINE 01496000 BR R8 RETURN TO CALLER 01498000 SPACE 4 01500000 * *** OUTPUT LINE,CONSTANT, AND TRANSLATE TABLE AREA *** * 01502000 SPACE 2 01504000 XXSAVE14 DS A SAVE WORD FOR RETURN @, CC,MASK 01506000 XXWORK1 DC F'0',X'04' FIELD + REVERSED BLANK FOR HEX CONVT 01508000 XXCOUNT DC PL3'1' COUNTER FOR NUMBER OF CALLS 01510000 XXSNDCB DCB DSORG=PS,MACRF=PM,RECFM=FA,LRECL=130,BLKSIZE=130, #01512000 DDNAME=XSNAPOUT,BUFNO=1 01514000 XXSNP1ST DC C'BEGIN XSNAP - CALL' HEADER TITLE 01516000 DC X'402020202021' EDIT PATTERN FOR CALL NUMBER 01518000 DC C' AT ' FOR XSNAP LOCATION MESSAGE 01520000 XXSN1B EQU *-XXSNP1ST LENGTH OF HEADER,NUMBER,LOCATION 01522000 XXSAME DC CL12' LINES' BEGINNING OF SAME LINE MESSAGE 01524000 XXSAML DC CL7' ' LOWEST ADDRESS AREA 01526000 XXSAMH DC CL7' ',CL104' SAME AS ABOVE' REST OF MESSG 01528000 XXLABEL DC CL130'0' PRIME LABEL PRINTING AREA 01530000 XXREGLAB DC C'0GP REGISTERS 0/8 1/9 2/10 #01532000 3/11 4/12 5/13 6/14 7/15' 01534000 XXBLANKS DC CL130' ' BLANK FIELD,ALSO BLANKS FOR XXREGLAB 01536000 XXREGOUT DC CL130' ' REGISTER PRINTING AREA 01538000 XXTAB DC C'0123456789ABCDEF' TR TABLE FOR HEX CONVERT 01540000 XXTAB1 EQU XXTAB-240 TO MAKE CONSTANT TR'S EASIER FOR HEX 01542000 XXTAB2 DC 64C'.',C' ',128C'.',C'ABCDEFGHI',7C'.',C'JKLMNOPQR' 01544000 DC 8C'.',C'STUVWXYZ',6C'.',C'0123456789',6C'.' ALPH TR TAB 01546000 XXCORADD DC CL7' ',CL3' ' 10 BYTES - LINE ADDRESS 01548000 XXCORE1 DC 4CL9' ',CL3' ' 39 BYTES - SPACE FOR 4 WORDS 01550000 XXCORE2 DC 4CL9' ',CL3' *' 39 BYTES - SPACE FOR 2ND BLOCK 01552000 XXCORE3 DC CL32' ',CL10'*' 32 BYTES -ALPHAMERIC + PAD TO 130 CH 01554000 XXCORETL DC CL30'-',CL30'CORE ADDRESSES SPECIFIED-' 01556000 XXCOREL DS CL7,CL3 SPACE FOR LOW ADDR, 'TO ' 01558000 XXCOREH DC CL7' ',CL53' ' SPACE FOR 2ND ADDRESS 01560000 XXSNOPAD DC V(XXXXOPEN) 01562000 XXSNOPBK XOPENBLK XXSNDCB,XXXXSNAP,(XSNAPOUT,XPRNT,SYSPRINT,FT06F001), #01564000 LRECL=130,BLKSIZE=130,WARN=YES,RECFM=FA 01566000 LTORG 01568000 END 01570000