./ ADD LEVEL=40,SOURCE=0,NAME=EQUREGS 00002000 MACRO 00004000 &LABEL EQUREGS &L=R,&DO=(0,15,1),&SYM= 00006000 .*--> MACRO: EQUREGS GENERATE SYMBOLIC REGISTER EQUATES . . . . . . 00008000 .* JOHN R. MASHEY/JULY'69/PSU 360/67 * 00010000 .* MACRO FOR SETTING UP SETS OF REGISTER EQUATES. * 00012000 .* *** ARGUMENTS *** * 00014000 .* L= SYMBOL USED TO BEGIN EQUATES, SUCH AS R, REG,ETC. * 00016000 .* DO= (INITIAL,LIMIT,INCREMENT) WILL SET UP REGISTERS * 00018000 .* EQUATED TO THE VALUE AS CONTROLLED BY THE DO PARAMATER.* 00020000 .* BEHAVES LIKE FORTRAN DO, INCLUDING ABILITY TO LEAVE OUT* 00022000 .* INCREMENT. * 00024000 .* SYM= LIST OF SYMBOLS TO BE CONCATENATED TO L PARM. * 00026000 .* LIST WILL SET UP EQUATES INCLUDING SYM VALUES, FOR * 00028000 .* FIRST SET OF EQUATES IN LIST, AND WILL THEN SET UP * 00030000 .* NUMERIC EQUATES IF DO VALUES EXCEED NUMBER OF ELEMENTS * 00032000 .* IN SYM OPERAND. MAY BE OMITTED ENTIRELY. * 00034000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00036000 LCLA &I,&J,&K COUNTER,INCREMENT,SYM COUNTER 00038000 AIF (N'&DO LT 2).XERROR NOT ENOUGH ARGUMENTS-ERR 00040000 &K SETA 1 INIT 00042000 &I SETA &DO(1) SET TO INITIAL VALUE 00044000 &J SETA 1 SET TO DEFAULT VALUE 00046000 AIF (N'&DO LT 3).XLOOP DEFAULT VALUE IS OK 00048000 &J SETA &DO(3) USE VALUE PROVIDED 00050000 .XLOOP AIF ('&SYM(&K)' EQ '').XLOOP1 USE NUMBER IF NO SYM VAL 00052000 &L&SYM(&K) EQU &I 00054000 &K SETA &K+1 INCREMENT TO GET NEXT SYM OPERAND 00056000 AGO .XLOOP2 SKIP OVER NORMAL GENRATION 00058000 .XLOOP1 ANOP 00060000 &L&I EQU &I 00062000 .XLOOP2 ANOP 00064000 &I SETA &I+&J ADD INCREMENT TO COUNTER 00066000 AIF (&I LE &DO(2)).XLOOP CONTINUE UNTIL DONE 00068000 MEXIT 00070000 .XERROR MNOTE 0,'** ERROR - EQUREGS REQUIRES AT LEAST 2 VALUES IN DO' 00072000 MEND 00074000 ./ ADD LEVEL=40,SOURCE=0,NAME=XCHAR 00076000 MACRO 00078000 XCHAR &STRING,&NUM 00080000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00082000 .*--> MACRO: XCHAR RETURN SAFE RIGHT-END SUBSTRING OF A STRING. * 00084000 .* JOHN R. MASHEY-JULY 1969-360/67* 00086000 .* THIS MACRO RETURNS IN &XXCHAR THE &NUM CHARACTERS TAKEN FROM * 00088000 .* THE RIGHT END OF THE CHARACTER STRING &STRING, WITHOUT * 00090000 .* BLOWING UP IF THERE ARE LESS THAN &NUM CHARS IN &STRING. * 00092000 .* THIS MACRO IS USED BY XSAVE,XRETURN, AND XSRNR * 00094000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00096000 GBLC &XXCHAR RETURN RESULT IN THIS 00098000 AIF (&NUM GT K'&STRING).XGA SKIP IF HE WANTS MORE 00100000 &XXCHAR SETC '&STRING'(K'&STRING+1-&NUM,&NUM) SCOOP RIGHT AMT 00102000 MEXIT 00104000 .XGA ANOP 00106000 &XXCHAR SETC '&STRING' STRING SMALLER-USE WHOLE THING 00108000 MEND 00110000 ./ ADD LEVEL=40,SOURCE=0,NAME=XDECI 00112000 MACRO 00114000 &LABEL XDECI ®,&ADDRESS 00116000 .*--> MACRO: XDECI EXTENDED DECIMAL INPUT CONVERSION * * * * * * * 00118000 .* EXTENDED DECIMAL INPUT MACRO - ENABLES PROGRAMS * 00120000 .* WRITTEN FOR ASSIST TO BE RUN UNDER OS/360 DIRECTLY. * 00122000 .* USES MODULE XXXXDECI TO SCAN DECIMAL STRING BEGINNING AT * 00124000 .* &ADDRESS, CONVERT ITS VALUE INTO REGISTER ®, AND SET * 00126000 .* REGISTER R1 AS A SCAN POINTER TO THE DELIMITER FOLLOWING THE * 00128000 .* STRING OF DECIMAL DIGITS. THE CONDITION CODE IS SET BY THE * 00130000 .* VALUE IN ®, UNLESS AN ERROR OCCURRS, IN WHICH CASE CC=3. * 00132000 .* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00134000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00136000 LCLC &XLABL FOR CREATION OF LABEL 00138000 &XLABL SETC 'XX&SYSNDX.E' CREATE UNIQUE LABEL 00140000 CNOP 2,4 . LINE UP ON BOUNDARY 00142000 &LABEL STM 14,1,&XLABL . SAVE LINKAGE REGS 00144000 LA 0,&ADDRESS . BEGINNING @ FOR SCANNING 00146000 L 15,&XLABL-4 . GET ADCON FOR CONVERSION 00148000 BALR 14,15 . CALL ROUTINE, PT WITH R14 00150000 DC V(XXXXDECI) . ADCON FOR CONVERSION ROUTINE 00152000 &XLABL DS 5F . REGS 14,15,0,1, VALUE FOR ® 00154000 LM 14,1,4(14) . RELOAD REGS 00156000 BO *+8 . BRANCH IF ® SHOULDN'T CHANGE 00158000 L ®,&XLABL+16 . GET VALUE FOR ® 00160000 AIF (T'® EQ 'N' AND '®' NE '1').XXEXIT SKIP IF SAFE 00162000 L 1,&XLABL+12 . USER MAY HAVE REG=1, LOAD FOR SAFE 00164000 .XXEXIT MEND 00166000 ./ ADD LEVEL=40,SOURCE=0,NAME=XDECO 00168000 MACRO 00170000 &LABEL XDECO ®,&ADDRESS 00172000 .*--> MACRO: XDECO EXTENDED DECIMAL OUTPUT CONVERSION* * * * * * * 00174000 .* USES MODULE XXXXDECO TO CONVERT VALUE IN REGISTER ® TO * 00176000 .* AN EDITED 12-BYTE FIELD, WITH SIGN, AT LOCATION &ADDRESS. * 00178000 .* EXTENDED DECIMAL OUTPUT MACRO - ENABLES PROGRAMS * 00180000 .* WRITTEN FOR ASSIST TO BE RUN UNDER OS/360 DIRECTLY. * 00182000 .* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00184000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00186000 LCLC &XLABL FOR CREATION OF UNIQUE LABEL 00188000 &XLABL SETC 'XX&SYSNDX.D' CREATE UNIQUE LABEL 00190000 CNOP 2,4 . LINE UP ON RIGHT BOUNDARY 00192000 &LABEL STM 14,0,&XLABL . STORE LINKAGE REGS 00194000 ST ®,&XLABL+12 . SAVE VALUE TO BE CONVERTED 00196000 LA 0,&ADDRESS . OBTAIN @ OPERAND FILED 00198000 L 15,&XLABL-4 . GET ADCON FOR CONVERSION PROG 00200000 BALR 14,15 . CALL XXXXDECO, PT R14 00202000 DC V(XXXXDECO) . ADCON FOR CONVERSION PROG 00204000 &XLABL DS 4F . REGS 14,15,0, REG TO BE CONVERTED 00206000 LM 14,0,4(14) . RELOAD LINKAGE REGISTERS 00208000 MEND 00210000 ./ ADD LEVEL=40,SOURCE=0,NAME=XDUMP 00212000 MACRO 00214000 &LABEL XDUMP &AREA,&LENGTH 00216000 .*--> MACRO: XDUMP ASSIST COMPATIBILITY DUMP MACRO . . . . . . . . 00218000 .* MACRO FOR STORAGE AND REGISTER DUMPING. ENABLES * 00220000 .* PROGRAMS WRITTEN FOR ASSIST TO BE RUN DIRECTLY UNDER OS/360. * 00222000 .* SEE ASSIST USER MANUAL FOR USAGE * 00224000 .* *NOTE* USES XSNAP, SO REQUIRES XSNAPOUT DD SYOUT=A CARD. * 00226000 .*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00228000 AIF (T'&AREA EQ 'O').XREGS SKIP TO REGS IF NO OPS 00230000 AIF (T'&LENGTH EQ 'O').XSTDF DEFAULT LENGTH IF NONE 00232000 .* DUMP STORAGE, USING SUPPLIED LENGTH &LENGTH. 00234000 &LABEL XSNAP T=NO,LABEL='USER STORAGE', #00236000 STORAGE=(*&AREA,*&LENGTH+&AREA) 00238000 MEXIT 00240000 .* DUMP STORAGE, USING DEFAULT LENGTH OF 4. 00242000 .XSTDF ANOP 00244000 &LABEL XSNAP T=NO,LABEL='USER STORAGE', #00246000 STORAGE=(*&AREA,*4+&AREA) 00248000 MEXIT 00250000 .* &AREA,&LENGTH OMITTED --> DUMP REGISTERS. 00252000 .XREGS ANOP 00254000 &LABEL XSNAP LABEL='USER REGISTERS' 00256000 MEND 00258000 ./ ADD LEVEL=40,SOURCE=0,NAME=XGET 00260000 MACRO 00262000 &XLABEL XGET &XAREA,&XNUM 00264000 .*--> MACRO: XGET GET RECORD OFF OF &DDNAME FILE . . . . . . . . . * 00266000 .* RICHARD FOWLER AUG, 1972 V.5.0 * 00268000 .* MACRO FOR EASY READING OFF OF ANY DD FILE, READS &XNUM * 00270000 .* CHARACTERS. CONDITION CODE SET TO 0 NORMALLY, OR TO 1 ON * 00272000 .* END OF FILE. GENERATION CONTROLLED BY &XGETST. * 00274000 .* EXECUTION ASSUMES REG 1 POINTS TO DD NAME * 00276000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 00278000 GBLB &XGETST GENERATION STATUS- 0=YES, 1=NO 00280000 AIF (&XGETST).XNOGEN IF SHOULDN'T GENERATE-SKIP CALL 00282000 &XLABEL XIONR XXXXGET,&XNUM,&XAREA,80 00284000 MEXIT 00286000 .XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 00288000 &XLABEL DS 0H . LABEL FOR CANCELLED XGET 00290000 .XXEXIT MEND 00292000 ./ ADD LEVEL=40,SOURCE=0,NAME=XGPGEN 00294000 MACRO 00296000 &LABEL XGPGEN &DIREC=G,&FETCH=NOT,&DDNUM=20 00298000 .** --> MACRO: XGPGEN GENERATE GENERAL I/O MODULES . . . . . . . . . . 00300000 .* RICHARD FOWLER NOV, 1972 V.5.0 . 00302000 .* . 00304000 .* ARGUMENTS: . 00306000 .* &DIREC = P --> OUTPUT . 00308000 .* ^= P --> INPUT . 00310000 .* &FETCH =NOT --> NO FETCH PROTECTION . 00312000 .* ^=NOT --> FETCH PROTECTION . 00314000 .* &DDNUM = MAXIMUM NUMBER OF DD NAMES ALLOWED AT ONCE . 00316000 .* (**EACH DD FILE REQUIRES 3F TABLE ENTRY PLUS DCB AND BUFFER**) . 00318000 .*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00320000 TITLE ' &LABEL - MODULE CREATED BY XGPGEN' 00322000 DCBD DSORG=QS 00324000 * * * * * XIOBLOCK - CONTROL BLOCK SET UP BY XREAD/XPRNT/XPNCH * * * * 00326000 XIOBLOCK DSECT 00328000 DS V . @ I/O ROUTINE 00330000 DS 3F AREA FOR REGS 15-0 TO BE SAVED 00332000 XIOLENG DS AL2 . LENGTH OF RECORD, (CODES-FUTURE USEQ 00334000 XIORETRN LM 14,0,4(14) RETURN CODE FOR RESTORING REGISTERS 00336000 &LABEL CSECT 00338000 *--> CSECT: EXTENDED I/O MODULE FOR GENERAL I/O . . . . . . . . . . . . 00340000 * THIS MODULE IS CALLED TO DO GENERAL I/O WORK ON A FILE . 00342000 * SIMILAR IN OPERATION TO THE XIO ROUTINES, BUT CAN HANDLE 00344000 * MANY FILES AT ONCE. . 00346000 * ENTRY CONDITIONS: . 00348000 * R14 = @ OF CONTROL BLOCK . 00350000 * R15 = ENTRY POINT ADDRESS . 00352000 * R0 = ADDRESS OF AREA TO MOVE DATA INTO . 00354000 * R1 = ADDRESS OF DD NAME TO BE USED . 00356000 * CONTROL BLOCK: . 00358000 * OFFSET LENGTH WHAT . 00360000 * 0 1F ENTRY POINT ADDRESS . 00362000 * 4 3F SAVE AREA . 00364000 * 16 2 LENGTH OF AREA . 00366000 * . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00368000 USING *,15 . NOTE TEMPORARY ADDRESSABILITY 00370000 USING XIOBLOCK,R14 00372000 STM R13,R7,X&DIREC.SAV1 SAVE REGISTERS TO BE USED A 00374000 CNOP 0,4 . GET ON FULLWORD 00376000 BAL R13,*+76 SET UP FAKE AREA PNTR - BASE 00378000 USING *,R13 . NOTE NEW USING/SAVE AREA POINTER 00380000 DS 18F . FAKE SAVE AREA 00382000 DROP R15 . KILL OLD ADDRESSING 00384000 SPACE 2 00386000 USING IHADCB,R1 . SET UP ADDRESSIBILITY TO DCB S 00388000 MVC X&DIREC.CURENT(8),0(R1) . GET CURRENT DD NAME 00390000 * CHECK FOR CLOSE 00392000 SR R1,R1 GET ZERO LENGTH INDICATOR 00394000 CH R1,XIOLENG ARE THEY EQUAL? 00396000 BE X&DIREC.EOF . YES-GO CLOSE AND FORGET FILE 00398000 XXGPSRCH &DIREC 00400000 * THE FOLLOWING CODE, IF EXECUTED, GENERATES A DCB AND TRIES AN OPEN 00402000 * 00404000 X&DIREC.MAKE C R1,=A(X&DIREC.FULL) CHECK FOR TABLE OVERFLOW 00406000 BNL X&DIREC.CC3 NO SPACE, DON'T TRY OPEN-RETURN J 00408000 ST R1,X&DIREC.ELEM . SAVE NEW ADDRESS, R1 ALREADY POINTIN 00414000 MVC 0(8,R1),X&DIREC.CURENT SAVE DD NAME FOR FUTURE CALLS 00416000 L 0,X&DIREC.LONG 00418000 GETMAIN R,LV=(0) . LOAD R1 WITH ADDR OF NEW DCB 00420000 L R2,X&DIREC.ELEM . GET ADDRESS OF POINTER 00422000 ST R1,8(R2) . SAVE @ OF DCB 00424000 * 00426000 ST R1,X&DIREC.FULL KLUDGE TO GET AROUND ADDRESSIBILITY 00428000 MVC X&DIREC.OPEN+1(3),X&DIREC.FULL+1 COPY OVER DCB @ INTO J 00430000 * 00432000 MVC 0(X&DIREC.ELEM-X&DIREC.DCB,R1),X&DIREC.DCB BUILD DCB 00434000 MVC DCBDDNAM,X&DIREC.CURENT MOVE DD NAME INTO DCB 00436000 OPEN MF=(E,X&DIREC.DCBPTR) DO REMOTE OPEN 00438000 L R1,X&DIREC.FULL . FIX R1, DESTROYED IN OPEN 00440000 TM DCBOFLGS,X'10' . DID OPEN GO? 00442000 BO X&DIREC.CONT4 YES, DO I/O 00444000 * OPEN DIDN'T GO - CLEAN UP SO DOESN'T BOMB LATER J 00445000 L R0,X&DIREC.LONG GET LENGTH OF DCB FOR FREEMAIN J 00446000 FREEMAIN R,LV=(0),A=(1) GIVE THE SPACE BACK TO OS J 00447000 XC 0(12,R2),0(R2) CLEAR OUT SO WON'T THINK IT'S OPEN J 00448000 X&DIREC.CC3 TM *+1,X'FF' SET CC=3 ==> OPEN IMPOSSIBLE J 00449000 B X&DIREC.RET RETURN TO USER 00450000 SPACE 2 00452000 X&DIREC.CONT L R1,8(R1) . GET DCB ADDRESS 00454000 X&DIREC.CONT4 LH R5,XIOLENG GET LENGTH OF AREA 00456000 AIF ('&FETCH' EQ 'PROTECT').SKPFTCH 00458000 L R2,X&DIREC.SAV1+12 GET @ I/O AREA 00460000 * THE FOLLOWING CODE IS USED FOR ADDRESS ILLEGAL ****************** 00462000 ***** THIS CODE WILL NOT WORK IF MACHINE HAS FETCH PROTECT *********** 00464000 SPACE 2 00466000 L R4,16 . GET CVT PNTR FROM LOC 16 00468000 LA R0,0(R2,R5) . GET ENDING ADDRESS OF I/O AREA 00470000 C R0,164(R4) . COMPARE TO CVTMZ00 - HIGHEST ADDRESS 00472000 BNL X&DIREC.ABD3 . GO ABEND IF HIGHER 00474000 .SKPFTCH ANOP 00476000 AIF ('&DIREC' EQ 'P').XOUT SKIP IF OUTPUT 00478000 LH R7,DCBLRECL GET LRECL FROM DCB J 00479000 GET IHADCB . GET # BUFFER 00480000 CLR R5,R7 COMPARE REQUEST LENGTH TO LRECL J 00481000 BNH *+6 SKIP AROUND IF OK J 00482000 LR R5,R7 TOO BIG, USE LRECL INSTEAD J 00483000 LR R4,R5 . SET UP FOR SHIFT 00484000 SRDL R4,8 . PUT RIGHTMOST BYTE IN R5 00486000 SRL R5,24 . RIGTH JUSTIFY FOR MOVE 00488000 LTR R4,R4 . ANYTHING LEFT IN R4? 00490000 BE *+22 . NO - DO NORMAL MOVE 00492000 MVC 0(256,R2),0(R1) . GIVE USER 256 BYTES OF DATA 00494000 LA R2,256(R2) . GO TO NEXT BLOCK 00496000 LA R1,256(R1) . GO TO NEXT BLOCK 00498000 BCT R4,*-14 . IF ANYTHING LEFT IN R4, DO ANOTHER 00500000 * NORMAL MOVE FOLLOWS 00502000 LTR R5,R5 . IS ANYTHING IN R5? 00504000 BE *+10 . NO - DONT MOVE LEFTOVER BYTES 00506000 BCTR R5,0 . DECREMENT LENGTH BY 1 00508000 EX R5,X&DIREC.MOV . MOVE INTO RIGHT PLACE 00510000 .XCLOSE ANOP 00512000 SR R0,R0 . SET COND CODE TO 0, USER OK 00514000 B X&DIREC.RET . GO TO RETURNX&DIREC.EOF CLOSE IHADCB 00516000 X&DIREC.EOF EQU * 00518000 XXGPSRCH &DIREC,2 00520000 X&DIREC.MAKE2 B X&DIREC.RET . GO RETURN 00522000 X&DIREC.CONT2 LR R4,R1 . SAVE THE ADDRESS 00524000 MVC X&DIREC.PTR+1(3),9(R1) 00526000 LA R1,X&DIREC.PTR 00528000 CLOSE MF=(E,(1)) DO REMOTE CLOSE 00530000 L R1,8(R4) . POINT TO DCB TO FREE 00532000 FREEPOOL (1) FREE THE BUFFERS 00534000 L R1,8(R4) RESET R1 IN CASE DESTROYED 00536000 L R0,X&DIREC.LONG GET AMOUNT TO FREE 00538000 FREEMAIN R,LV=(0),A=(1) 00540000 * 00542000 * DCB NO LONGER EXISTS, REMOVE CORRESPONDING ELEMENT FROM LIST 00544000 * 00546000 LA R3,X&DIREC.FULL . GET UPPER ADDRESS OF TABLE 00548000 SR R3,R4 . FIND LENGTH OF REST OF TABLE 00550000 EX R3,X&DIREC.WIPOUT WIPEOUT 12 BYTES OF MEMORY 00552000 * 00554000 * IF NO POINTERS REMAIN, SET POINTER TO LAST TO ZERO 00556000 * 00558000 LA R3,12 00560000 L R2,X&DIREC.ELEM 00562000 SR R2,R3 00564000 LA R1,X&DIREC.PNTSRT 00566000 CR R1,R2 00568000 BNH *+8 00570000 LA R2,0 . SET POINTER TO ZERO 00572000 ST R2,X&DIREC.ELEM SAVE POINTER 00574000 AIF ('&DIREC' EQ 'P').XRET 00576000 OI *+1,1 . SET COND CODE FOR END OF FILE 00578000 .* SHOULD REMOVE DCB FROM LIST NOW 00580000 AGO .XRET . HAVE RETURN CODE GENERATED 00582000 .* 00584000 .XOUT ANOP 00586000 LH R7,82(R1) . GET LRECL 00588000 PUT IHADCB . PRINT THE STUFF 00590000 CLR R5,R7 COMPARE REQUEST LENGTH TO LRECL J 00591000 BNH *+6 SKIP AROUND IF OK LENGTH J 00592000 LR R5,R7 TOO BIG- USE LRECL INSTEAD J 00593000 LR R4,R5 . SET UP FOR SHIFT 00594000 LR R6,R5 SAVE FOR LATER 00596000 SRDL R4,8 . PUT RIGHTMOST BYTE IN R5 00598000 SRL R5,24 . RIGTH JUSTIFY FOR MOVE 00600000 LTR R4,R4 . ANYTHING LEFT IN R4? 00602000 BE *+22 . NO - DO NORMAL MOVE 00604000 MVC 0(256,R1),0(R2) . PUT STUFF INTO BUFFER 00606000 LA R2,256(R2) . GO TO NEXT BLOCK 00608000 LA R1,256(R1) . GO TO NEXT BLOCK 00610000 BCT R4,*-14 . IF ANYTHING LEFT IN R4, DO ANOTHER 00612000 * NORMAL MOVE FOLLOWS 00614000 LTR R5,R5 . IS ANYTHING IN R5? 00616000 BE *+12 00618000 BCTR R5,0 . DECREMENT LENGTH BY 1 00620000 EX R5,X&DIREC.MOV . MOVE INTO RIGHT PLACE 00622000 AR R1,R5 GET BEGINNING @ TO BLANK 00624000 SR R7,R6 GET DIFFERENCE BETWEEN USER AND DCB 00626000 BZ *+12 NO DIFFERENCE, DO NOTHING A 00628000 MVI 1(R1),C' ' 00630000 EX R7,X&DIREC.MOV2 CLEAR REST 00632000 * ****NOTE THAT THIS ONLY WORKS FOR DIFFERENCES < 256 00634000 AGO .XCLOSE 00636000 .* 00638000 .XRET ANOP 00640000 SPACE 2 00642000 X&DIREC.RET LM R13,R7,X&DIREC.SAV1 RESTORE REGS A 00644000 B XIORETRN RETURN 00646000 DROP R14 00648000 X&DIREC.ABD3 CLI *,0 SET CC=2, SHOW EXECUTE ERROR J 00650000 B X&DIREC.RET GO RETURN, SHOWING ERROR J 00652000 .* 00656000 SPACE 2 00658000 X&DIREC.PTR CLOSE (X&DIREC.CONT),MF=L GENERAL PURPOSE CLOSE 00660000 X&DIREC.WIPOUT MVC 0(1,R4),12(R4) 00662000 X&DIREC.CURENT DS CL8 . AREA TO HOLD CURRENT DD NAME 00664000 X&DIREC.SAV1 DS 11F SAVE AREA FOR REGS USED A 00666000 X&DIREC.PNTSRT DS (&DDNUM*3)F . AREA FOR DDNUM DD NAMES & POINTERS 00668000 X&DIREC.FULL DS F 00670000 X&DIREC.OPEN DS 0F EXTRA LABEL 00672000 AIF ('&DIREC' EQ 'P').XDEFSR SKIP IF OUTPUT 00674000 X&DIREC.DCBPTR OPEN (X&DIREC.CONT,(INPUT)),MF=L OPEN CONTROL WORD J 00676000 X&DIREC.DCB DCB DSORG=PS,MACRF=GL,EODAD=X&DIREC.EOF 00678000 X&DIREC.ELEM DC F'0' . INITIAL # OF ELEMENTS 00680000 XX&DIREC.LONG EQU X&DIREC.ELEM-X&DIREC.DCB GET DCB LENGTH 00682000 X&DIREC.LONG DC A(XX&DIREC.LONG) SAVE LENGTH OF DCB 00684000 X&DIREC.MOV MVC 0(1,R2),0(R1) . GIVES USER THE DATA 00686000 LTORG 00688000 DROP R13 00690000 MEXIT DONE 00692000 .XDEFSR ANOP 00694000 X&DIREC.DCBPTR OPEN (X&DIREC.CONT,(OUTPUT)),MF=L OPEN CONTROL WORD J 00696000 X&DIREC.DCB DCB DSORG=PS,MACRF=PL 00698000 X&DIREC.ELEM DC F'0' . INITIAL # OF ELEMENTS 00700000 XX&DIREC.LONG EQU X&DIREC.ELEM-X&DIREC.DCB GET DCB LENGTH 00702000 X&DIREC.LONG DC A(XX&DIREC.LONG) SAVE LENGTH OF DCB 00704000 X&DIREC.MOV MVC 0(1,R1),0(R2) . MOVE INTO LINE 00706000 X&DIREC.MOV2 MVC 2(1,R1),1(R1) CLEAR OUT REST OF BUFFER 00708000 LTORG 00710000 DROP R13 00712000 MEND 00714000 ./ ADD LEVEL=41,SOURCE=0,NAME=XHEXI 00716000 MACRO 00718000 &NAME XHEXI ®,&ADDR 00720000 .* * 00722000 .*-->MACRO: XHEXI HEXADECIMAL INPUT CONVERSION MACRO. * 00724000 .* WRITTEN BY ALAN ARTZ 4/17/72 * 00726000 .* THIS MACRO TAKES THE VALUE STARTING AT THE ADDRESS GIVEN BY * 00728000 .* &ADDR AND CONVERTS IT AND PUTS THE HEXADECIMAL VALUE IN ®. * 00730000 .* IF THERE ARE MORE THAN 8 DIGITS, R1 POINTS TO THE 9TH AND THE * 00732000 .* FIRST 8 ARE CONVERTED. IF THERE IS A NON-BLANK, NON-HEX DIGIT * 00734000 .* FOUND, R1 POINTS TO THAT CHARACTER AND THE CC=3, OTHERWISE CC SET * 00736000 .* BY VALUE IN REG. * 00738000 .* * 00740000 .* CALLS MODULE XXXXHEXI TO DO THE ACTUAL CONVERSIONS * 00742000 .* * 00744000 .********************************************************************** 00746000 LCLC &LABEL 00748000 &LABEL SETC 'XX&SYSNDX.H' UNIQUE LABEL 00750000 &NAME STM 14,0,&LABEL . SAVE REGISTERS 00752000 ST ®,&LABEL+12 . REGISTER STORE INCASE OF OVERFLOW CND 00754000 LA 0,&ADDR . GET STRING TO BE CONVERTED 00756000 CNOP 2,4 . GET PROPER ALIGNMENT 00758000 L 15,&LABEL-4 . ADDRESS OF XXXXHEXI 00760000 BALR 14,15 . GO TO APPROPRIATE PLACE 00762000 DC V(XXXXHEXI) . VCON OF ROUTINE 00764000 &LABEL DS 4F . STORAGE FOR REGISTERS 00766000 LM 14,0,4(14) . RESTORE REGISTERS 00768000 L ®,&LABEL+12 . GET CONVERTED NUMBER 00770000 MEND 00772000 ./ ADD LEVEL=41,SOURCE=0,NAME=XHEXO 00774000 MACRO 00776000 &NAME XHEXO ®,&ADDR 00778000 LCLC &LABEL 00780000 .* * 00782000 .*-->MARCO: XHEXO HEXADECIMAL OUTPUT CONVERSION MACRO * 00784000 .* WRITTEN BY ALAN ARTZ 4/17/72 * 00786000 .* THIS MACRO TAKES THE VALUE IN & REG AND CONVERTS IT TO * 00788000 .* PRINTABLE FORM. * 00790000 .* IT PUTS THE CONVERTED VALUE IN AN EIGHT BYTE AREA STARTING AT* 00792000 .* THE ADDRESS GIVEN IN &ADDR. * 00794000 .* THE CONDITION CODE IS NOT CHANGED AND NETHER ARE THE REGISTERS* 00796000 .* * 00798000 .* CALLS MODULE XXXXHEXO TO DO THE ACTUAL CONVERSIONS. * 00800000 .* * 00802000 .********************************************************************** 00804000 &LABEL SETC 'XX&SYSNDX.H' UNIQUE LABEL 00806000 &NAME DS 0H 00808000 STM 14,0,&LABEL . SAVE REGIST5RS 00810000 ST ®,&LABEL+12 . SAVE REGISTER 00812000 LA 0,&ADDR . PASS REGISTER TO XXXXHEXO 00814000 CNOP 2,4 . GDT PROPER ALIGNMENT 00816000 L 15,&LABEL-4 . ADDRESS OF XXXXHEXO 00818000 BALR 14,15 . CALL HEXO 00820000 DC V(XXXXHEXO) 00822000 &LABEL DS 4F . STORAGE FOR REGISTERS 00824000 LM 14,0,&LABEL . RESTORE REGISTERS 00826000 MEND 00828000 ./ ADD LEVEL=40,SOURCE=0,NAME=XIDENT 00830000 MACRO 00832000 XIDENT &ID,&LABEL,&XCSECT,&PRIVATE 00834000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00836000 .*--> MACRO: XIDENT IDENTIFY ENTRY POINT FOR XSAVE,$SAVE. * 00838000 .* MACRO USED BY XSAVE TO PRODUCE ID AT AN ENTRY POINT. WILL * 00840000 .* USE THE FIRST NON-NULL OPERAND PASSED TO IT AS THE ID. * 00842000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00844000 LCLA &I,&J LOCAL COUNTERS 00846000 &I SETA 1 INITIALIZE 00848000 AIF ('&ID' NE '*').XIDINC SKIP IF EXPLICIT ID FIELD 00850000 .XILOOP ANOP 00852000 &I SETA &I+1 INCREMENT TO NEXT ONE 00854000 AIF ('&SYSLIST(&I)' EQ '').XILOOP SKIP BACK IF THIS IS NULL 00856000 .XIDINC ANOP 00858000 &J SETA 6+((K'&SYSLIST(&I)+1)/2)*2 GET BRANCH LENGTH 00860000 B &J.(,15) . BRANCH AROUND ID 00862000 &J SETA &J-5 GET ACTUAL LENGTH OF ID 00864000 DC AL1(&J),CL&J'&SYSLIST(&I)' 00866000 MEND 00868000 ./ ADD LEVEL=40,SOURCE=0,NAME=XIOGN 00870000 MACRO 00872000 &XLABEL XIOGN &LRECL=80,&BLKSIZE=80,&XOP=OUTPUT,&RECFM=,&DDNAME=, #00874000 &BUFNO=1 00876000 .*--> MACRO: XIOGN I/O SUPPORT MODULE GENERATION . . . . . . . . . 00878000 .* JOHN R. MASHEY - FEB 1970 - V.5.0 * 00880000 .* MACRO USED TO GENERATE THE I/O CSECTS USED BY THE XIOPAK * 00882000 .* MACROS XREAD,XPRNT,XPNCH. THE CSECTS ARE CALLED EACH TIME * 00884000 .* ONE OF THE MACROS IS CALLED, AND DOES REQUIRED OPN'S, GET'S, * 00886000 .* PUT'S, ETC . * 00888000 .* **ARGUMENTS** * 00890000 .* BLKSIZE,BUFNO,LRECL,RECFM= ARGUMENTS FOR CREATED DCB. * 00892000 .* DEFAULTS: BLKSIZE=80,BUFNO=1,LRECL=80. * 00894000 .* IF MODULE DESIRED FOR USE WITH VARIABLE JCL VALUES, * 00896000 .* CODE BLKSIZE=0,BUFNO=0,LRECL=0. * 00898000 .* XOP= EITHER INPUT OR OUTPUT, DENOTING DIRECTION OF I/O. * 00900000 .* DEFAULT: OUTPUT. * 00902000 .* DDNAME= LIST OF DDNAMES WHICH MODULE CAN USE FOR I/O. * 00904000 .* WILL ATTEMPT OPEN OF EACH ONE, IN ORDER GIVEN, UNTIL * 00906000 .* ONE SUCCEEDS OR LIST IS EXHAUSTED. * 00908000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00910000 GBLB &XIOGNST =0 ==> HAVEN'T GEND XIOBLOCK 00912000 LCLA &XDD COUNTER FOR # DDNAMES 00914000 LCLB &XIO OUTPUT=1,INPUT=0 00916000 LCLC &X PREFIX OF ALL LABELS 00918000 &XDD SETA N'&DDNAME GET # OF DDNAMES TO BE TRIED 00920000 &XIO SETB ('&XOP' EQ 'OUTPUT') SET FOR INPUT OR OUTPUT 00922000 &X SETC '&XLABEL'(3,4) GET LABEL START 00924000 TITLE ' *** &XLABEL *** I/O ROUTINE' 00926000 &XLABEL CSECT 00928000 ENTRY &X.DCB 00930000 USING XIOBLOCK,R14 . NOTE POINTER TO CONTROL BLOCK 00932000 USING *,R15 . NOTE TEMPORARY ADDRESSIBILITY 00934000 STM R13,R5,&X.SAV1 . SAVE REGS WHICH WILL BE USED 00936000 CNOP 0,4 . MAKE SURE ALIGNED ON FULLWORD 00938000 BAL R13,*+76 . SET UP FAKE SAVE AREA PTR,BASE 00940000 USING *,R13 . NOTE NEW USING/SAVE AREA POINTER 00942000 DS 18F . FAKE SAVE AREA,FOR GET/PUT ETC 00944000 DROP R15 . KILL OLD ADDRESSING 00946000 SPACE 2 00948000 .XASA1 AIF (&XIO).XOUT SKIP IF OUTPUT 00950000 &X.EOFT NOP &X.ABD2 . *** WILL BECOME A B AFTER EOF EXIT 00952000 .XOUT ANOP 00954000 &X.TES1 NOP &X.GO . *** WILL BE A BRANCH AFTER OPEN GOES 00956000 LR R5,R14 SAVE R14 AROUND CALL TO XXXXOPEN 00958000 LA 1,&X.OPBK . GET ADDRESS OF CONTROL TABLE 00960000 L 15,&X.OPAD . GET BRANCH ADDRESS 00962000 BALR 14,15 . CALL XXXXOPEN ROUTINE 00964000 LR R14,R5 RESTORE R14 00966000 &X.OPOK MVI &X.TES1+1,X'F0' . CHANGE NOP TO B-DONT OPEN AGAIN 00968000 &X.GO LH R4,&X.DCB+82 . GET DCB LRECL FOR COMPARISON 00970000 LH R5,XIOLENG . GET LENGTH FROM CONTROL BLOCK 00972000 BCTR R5,0 . DECREMENT TO LENGTH-1 00974000 CLR R4,R5 . COMPARE WITH LIMIT 00976000 BH *+8 . SKIP IF WITHIN RANGE 00978000 LR R5,R4 . MOVE DEFAULT VALUE OVER 00980000 BCTR R5,0 . DECREMENT DEFAULT TO LENGTH-1 00982000 .XASB SPACE 2 00984000 L R2,&X.SAV1+12 . GET ADDRESS OF I/O AREA (FROM R0) 00986000 .* 00988000 * THE FOLLOWING CODE IS USED TO CHECK FOR ADDRESS ILLEGAL * 00990000 * THIS CODE WILL NOT WORK IF MACHINE HAS FETCH PROTECT********** 00992000 L R1,16 . GET CVT POINTER FROM LOC 16 00994000 LA R0,1(R2,R5) . GET ENDING ADDRESS OF I/O AREA 00996000 C R0,164(R1) . COMPARE TO CVTMZ00-HGIHEST ADDRESS 00998000 BNL &X.ABD3 . GO ABEND IF HIGHER 01000000 .* 01002000 AIF (&XIO).XOUT1 SKIP IF OUTPUT MODE 01004000 GET &X.DCB OBTAIN @ BUFFER 01006000 EX R5,&X.MOV . MOVE REQUESTED NUMBER OF BYTES 01008000 SR R0,R0 . SET CONDITION CODE=0, SHOW USER OK 01010000 B &X.RET . GO TO RETURN TO CALLER 01012000 &X.ABD2 WTO ' &XLABEL ABEND 300 - ATTEMPT TO READ PAST END-OF-FILE',X01014000 ROUTCDE=11 01016000 B &X.ABD1 . GO ABEND 01018000 &X.EOF CLOSE &X.DCB 01020000 LA 1,&X.DCB POINT 1 TO DCB TO FREE BUFFER 01022000 FREEPOOL (1) FREE THE BUFFERS 01024000 OI *+1,1 . SET CONDITON CODE TO 1 01026000 MVI &X.EOFT+1,X'F0' . CHANGE NOP TO B-NO MORE READS 01028000 AGO .XRET HAVE RETURN CODE GENRATED 01030000 .* 01032000 .XOUT1 EX R5,&X.MOV . MOVE NUMBER OF BYTES TO OUTPUT LINE 01034000 PUT &X.DCB,&X.BUF 01036000 EX R5,&X.MOV1 . REBLANK OUTPUT LINE 01038000 .* 01040000 .XRET ANOP 01042000 SPACE 2 01044000 &X.RET LM R13,R5,&X.SAV1 . RESTORE THE REGS WE CHANGED 01046000 AIF (NOT &XIO).XOUT2 SKIP SPM IF THIS WAS AN INPUT 01048000 SPM R14 . RESTORE THE CONDITION CODE 01050000 .XOUT2 B XIORETRN . RETURN TO CALLING XIOBLOCK 01052000 &X.ABD3 WTO ' &XLABEL ABEND 300-ILLEGAL ADDRESS-SEE REG 2', X01054000 ROUTCDE=11 01056000 &X.ABD1 ABEND 300,DUMP 01058000 .* 01060000 SPACE 2 01062000 &X.SAV1 DS 9F . AREA TO PRESERVE REGS IN 01064000 &X.OPAD DC V(XXXXOPEN) . ADDRESS OF SUPEROPEN ROUTINE 01066000 &X.OPBK XOPENBLK &X.DCB,&XLABEL,&DDNAME,RECFM=&RECFM,LRECL=&LRECL, #01068000 BLKSIZE=&BLKSIZE,BUFNO=&BUFNO,XOP=&XOP 01070000 .XNODD AIF (&XIO).XOUT3 SKIP IF OUTPUT 01072000 .* 01074000 &X.MOV MVC 0(0,R2),0(R1) . R1==> BUFFER, EXECUTE SUPPLIES LENGT 01076000 &X.DCB DCB DSORG=PS,MACRF=GL,EODAD=&X.EOF 01078000 AGO .XEXIT 01080000 .* 01082000 .XOUT3 ANOP 01084000 &X.BUF DC CL(&LRECL)' ' . OUTPUT I/O BUFFER AREA 01086000 &X.BLNK DC CL(&LRECL)' ' . FOR REBLANKING OUTPUT BUFFER 01088000 &X.MOV MVC &X.BUF(0),0(R2) . MOVE RIGHT NUMBER OF CHARS TO BUFFER 01090000 &X.MOV1 MVC &X.BUF(0),&X.BLNK EXECUTED MOVE TO REBLANK BUFFER 01092000 &X.DCB DCB DSORG=PS,MACRF=PM 01094000 .XEXIT DROP R13,R14 . KILL LEFTOVER ADDRESSING 01096000 .* 01098000 AIF (&XIOGNST).XXEXIT SKIP IF ALREADY GEND XIOBLOCK 01100000 &XIOGNST SETB (1) SHOW WE'VE GENERATE XIOBLOCK 01102000 EJECT 01104000 * * * * * XIOBLOCK - CONTROL BLOCK SET UP BY XREAD/XPRNT/XPNCH * * * * 01106000 XIOBLOCK DSECT 01108000 DS V . @ I/O ROUTINE 01110000 DS 3F AREA FOR REGS 15-0 TO BE SAVED 01112000 XIOLENG DS AL2 . LENGTH OF RECORD, (CODES-FUTURE USEQ 01114000 XIORETRN LM 14,0,4(14) RETURN CODE FOR RESTORING REGISTERS 01116000 .XXEXIT MEND 01118000 ./ ADD LEVEL=40,SOURCE=0,NAME=XIONR 01120000 MACRO 01122000 &XLABEL XIONR &XNAME,&XNUM,&XAREA,&XDEFT 01124000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01126000 .*--> MACRO: XIONR INNER MACRO-$READ,$PNCH,$PRNT,$SORC * 01128000 .* JOHN R. MASHEY - FEB 1970 - V.5.0 * 01130000 .* XIONR IS USED BY XIOPAK MACROS XREAD,XPRNT,XPNCH TO SET UP * 01132000 .* THE REQUIRED CODE FOR CALLING THEIR RESPECTIVE SUBROUTINES. * 01134000 .* *** ARGUMENTS *** * 01136000 .* XNAME THE NAME OF THE I/O ROUTINE TO BE CALLED. * 01138000 .* XNUM THE LENGTH OF XAREA TO BE PRINTED,PUNCHED,ETC. * 01140000 .* XAREA THE AREA ON WHICH I/O OPERATION TO BE PERFORMED. * 01142000 .* MAY BE SPECIFIED BY (0) OR (R0). * 01144000 .* XDEFT DEFAULT VALUE OF XNUM TO BE USED, IF IT IS OMITTED * 01146000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 01148000 .* * 01150000 .* AS OF AUG 1972, XGET AND XPUT ALSO USE THIS MACRO. * 01152000 .* RICHARD FOWLER * 01154000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01156000 AIF (T'&XAREA EQ 'O').XERR1 PRODUCE MNOTE 01158000 &XLABEL STM 14,0,XX&SYSNDX.R+4 . SAVE REGS WHICH WILL BE CHANGED 01160000 AIF (T'&XNUM EQ 'O').XN1 SKIP NEXT CHECK IF OMITTED 01162000 AIF ('&XNUM'(1,1) NE '(' OR '&XNUM'(K'&XNUM,1) NE ')').XN1 01164000 STH &XNUM,XX&SYSNDX.R+16 . STORE LENGTH 01166000 .XN1 AIF ('&XAREA' EQ '(0)' OR '&XAREA' EQ '(R0)').XNOLA 01168000 .XN2 LA 0,&XAREA 01170000 .XNOLA L 15,XX&SYSNDX.R . GET BRANCH ADDRESS 01172000 CNOP 2,4 . ADJUST FOR RIGHT ALIGNEMNT 01174000 BALR 14,15 . CALL ROUTINE, R14==> CONTROL BLOCK 01176000 XX&SYSNDX.R DC V(&XNAME) . ROUTINE ADDRESS 01178000 DS 3F . SAVE SPACE FOR REGS 14-0 01180000 AIF ('&XNUM' EQ '').XDFT SKIP IF DEFAULT SHOULD BE 01182000 DC AL2(&XNUM) . LENGTH OF AREA 01184000 AGO .XDS SKIP 01186000 .XDFT DC AL2(&XDEFT) . DEFAULT LENGTH USED 01188000 .XDS LM 14,0,4(14) . RESTORE REGS. CON CODE ALREADY DONE 01190000 MEXIT 01192000 .XERR1 MNOTE 0,'**XIONR- AREA ADDRESS OMITTED-GENERATION CANCELLED' 01194000 MEND 01196000 ./ ADD LEVEL=40,SOURCE=0,NAME=XLIMD 01198000 MACRO 01200000 &XLABEL XLIMD &ADDR,&LENGTH 01202000 .*--> MACRO: XLIMD LIMIT DUMP-ASSIST COMPATIBILITY MACRO . . . . . 01204000 .*. MACRO PROVIDED ONLY FOR RUNNING ASSIST DECKS UNDER OS/360. . 01206000 .*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 01208000 &XLABEL DS 0H . XLIMD EXPANSION- NOTHING 01210000 MEND 01212000 ./ ADD LEVEL=40,SOURCE=0,NAME=XLOOK 01214000 MACRO 01216000 XLOOK &ARG1,&ARGL 01218000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01220000 .*--> MACRO: XLOOK FIND POSITION OF ELEMENT IN LIST. * 01222000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01224000 .* MACRO TO FIND AND RETURN POSTION OF ARGUMENT IN A SUBLIST. * 01226000 .* &ARG1 ARGUMENT TO BE SEARCHED FOR * 01228000 .* &ARGL LIST OF ARGUMENTS FOR &ARG1 TO BE CHECKED FOR IN * 01230000 .* &XXLOOK THE FIRST POSITION IN &ARGL IN WHICH &ARG1 IS * 01232000 .* FOUND, IF ANY. IF &ARG1 IS NOT IN &ARGL, &XXLOOK = 0. * 01234000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01236000 GBLA &XXLOOK FOR RETURN OF INDEX VALUE 01238000 &XXLOOK SETA 1 INITIALIZE THE COUNTER 01240000 .XLA AIF (&XXLOOK GT N'&ARGL).XLB IF GT,QUIT,NOT FOUND 01242000 AIF ('&ARG1' EQ '&ARGL(&XXLOOK)').XXEXIT IF FOUND,RETURN 01244000 &XXLOOK SETA &XXLOOK+1 INCREMENT COUNTER 01246000 AGO .XLA GO BACK FOR NEXT CHECK 01248000 .XLB ANOP 01250000 &XXLOOK SETA 0 NOT FOUND, SET TO 0 TO SHOW THIS 01252000 .XXEXIT MEND 01254000 ./ ADD LEVEL=40,SOURCE=0,NAME=XMUSE 01256000 MACRO 01258000 XMUSE &BR,&AD 01260000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262000 .*--> MACRO: XMUSE BASE REGISTER SETUP MACRO FOR XSAVE * 01264000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01266000 .* THIS MACRO IS CALLED BY XSAVE TO HANDLE BR AND AD OPERANDS, * 01268000 .* AND PRODUCE APPROPRIATE USINGS. &BR AND &AD ARE FROM XSAVE. * 01270000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01272000 LCLA &I,&N LOCAL COUNTERS 01274000 LCLC &B(4),&V BASE REGS, USING NAME 01276000 &N SETA N'&BR GET NUMBER WHERE HANDY 01278000 &V SETC '*' NORMAL USE 01280000 AIF (&N LE 4).XNOKA MAKE SURE NOT TOO MANY BASES 01282000 &N SETA 4 IDIOT USER HAD >4 BASES, IGNORE EXTR 01284000 MNOTE 4,'**XMUSE- MORE THAN 4 BASE REGS-EXTRAS IGNORED' 01286000 .XNOKA AIF ('&AD' EQ '').X1LOOP SKIP IF NORMAL SITUATION 01288000 .* USED IF AD PARAMATER WAS SPECIFIED IN XSAVE MACRO. * 01290000 CNOP 0,4 01292000 B *+8 . SKIP AROUND ADDRESS CONSTANT 01294000 DC A(&AD) . ADDRESS CONSTANT FOR AD=PARAMETER 01296000 L &BR(1),*-4 . LOAD ADCON INTO RIGHT REGISTER 01298000 &V SETC '&AD' CHANGE NAME FOR USING 1ST OPERND 01300000 .* NORMAL SECTION OF CODE FOR GENERATING USING. * 01302000 .X1LOOP ANOP 01304000 &I SETA &I+1 INCREMENT COUNTER TO BASE REG 01306000 &B(&I) SETC ',&BR(&I)' GET I'TH BASE REGISTER 01308000 AIF (&I LT &N).X1LOOP CONTINUE UNTIL ALL BASWE REGS DONE 01310000 DROP 15 . CLEAN UP USING SITUATION 01312000 USING &V&B(1)&B(2)&B(3)&B(4) 01314000 MEND 01316000 ./ ADD LEVEL=40,SOURCE=0,NAME=XOPENBLK 01318000 MACRO 01320000 &LABEL XOPENBLK &DCB,&XNAME,&DDNAME,&RECFM=F,&LRECL=,&BLKSIZE=, #01322000 &BUFNO=1,&XOP=OUTPUT,&ABEND=YES,&WARN=NO 01324000 .*--> MACRO: XOPENBLK GENERATES 1 CONTROL BLOCK FOR XXXXOPEN . . . . 01326000 .* SEE THE XOPENBLK DSECT. . 01328000 .* *** ARGUMENTS *** . 01330000 .* &DCB NAME OF DCB TO BE OPENED . 01332000 .* &XNAME NAME OF CALLING ROUTINE . 01334000 .* &DDNAME LIST OF 1 OR MORE DDNAMES, IN ORDER. 01336000 .* DESIRED TO BE TRIED. . 01338000 .* NEXT 4 ARGS GIVE DEFAULT VALUES USED TO FILL DCB . 01340000 .* IF NEEDED DURING DCB EXIT PROCESSING. . 01342000 .* &RECFM=, &LRECL=, &BLKSIZE=, &BUFNO= SAME NAMES AS DCB . 01344000 .* &XOP= DIRECTION TO OPEN: OUTPUT OR INPUT. 01346000 .* &ABEND= ABEND IF CAN'T OPEN: YES OR NO . 01348000 .* &WARN= WARNING IF CAN'T OPEN FIRST CHOICE . 01350000 .* YES OR NO . 01352000 .*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 01354000 LCLA &I COUNTER VARIABEL 01356000 LCLB &B0,&B3,&B5 FOR RECFM BITS, XOPFLAG1 BITS 01358000 &LABEL OPEN (&DCB,&XOP),MF=L . LIST TO GEN CONTROL ELEMENT 01360000 DC AL2(&LRECL,&BLKSIZE,&BUFNO) LRECL,BLKSIZE,BUFNO 01362000 .* 01364000 &B0 SETB ('&RECFM'(1,1) EQ 'F') SHOULD BE SET 01366000 &B3 SETB ('&RECFM.X'(2,1) EQ 'B') BLOCKED OR NOT 01368000 &B5 SETB ('&RECFM'(K'&RECFM,1) EQ 'A') ASA CARRIAGE CONTROLS 01370000 DC B'&B0.00&B3.0&B5.00' . RECFM BYTE 01372000 .* 01374000 &B0 SETB ('&ABEND' EQ 'YES') DOES HE WANT TO ABEND IF NO OPEN 01376000 &B3 SETB ('&WARN' EQ 'YES') DOES HE WANT WARN IF NOT FIRST DDNA 01378000 DC B'&B3&B0',CL8'&XNAME ' . XOP-FLAG1,XNAME 01380000 .* 01382000 &I SETA 8*(N'&DDNAME-1) 3 DDNAMES, CONVERT TO BXLE LMT 01384000 DC H'&I' . BXLE OFFSET FOR DD SEARCH 01386000 &I SETA 1 RE INIT FOR LOOP TO GEN 01388000 .XOPA DC CL8'&DDNAME(&I)' 01390000 &I SETA &I+1 INCREMENT TO NEXT ONE 01392000 AIF (&I LE N'&DDNAME).XOPA LOOP UNTIL ALL DDNAMES GEND 01394000 MEND 01396000 ./ ADD LEVEL=40,SOURCE=0,NAME=XPNCH 01398000 MACRO 01400000 &XLABEL XPNCH &XAREA,&XNUM 01402000 .*--> MACRO: XPNCH PUNCH CARD MACRO . . . . . . . . . . . . . . . 01404000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01406000 .* MACRO FOR EASY PUNCHING OF UP TO 80 BYTES OF XAREA. MACRO * 01408000 .* GENERATION IS CONTROLLED BY &XPNCHST. * 01410000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01412000 GBLB &XPNCHST STATUS VARIABLE- 0=ON, 1=OFF 01414000 AIF (&XPNCHST).XNOGEN SKIP GENRATION IF NOT WANTED 01416000 &XLABEL XIONR XXXXPNCH,&XNUM,&XAREA,80 01418000 MEXIT 01420000 .XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01422000 &XLABEL DS 0H . LABEL FOR A CANCELLED XPNCH 01424000 .XXEXIT MEND 01426000 ./ ADD LEVEL=40,SOURCE=0,NAME=XPRNT 01428000 MACRO 01430000 &XLABEL XPRNT &XAREA,&XNUM 01432000 .*--> MACRO: XPRNT PRINT LINE MACRO . . . . . . . . . . . . . . . 01434000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01436000 .* MACRO FOR EASY PRINTING OF UP TO 133 CHARACTERS OF XAREA, * 01438000 .* AS SPECIFIED BY XNUM. FIRST CHARACTER IS USED AS CARRIAGE * 01440000 .* CONTROL CHARACTER. GENERATION IS CONTROLLED BY &XPRNTST. * 01442000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01444000 GBLB &XPRNTST GENERATION STATUS 0=YES, 1=NO 01446000 AIF (&XPRNTST).XNOGEN SKIP GENERATION IF STATUS=OFF 01448000 &XLABEL XIONR XXXXPRNT,&XNUM,&XAREA,133 01450000 MEXIT 01452000 .XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01454000 &XLABEL DS 0H . LABEL FOR CANCELLED XPRNT 01456000 .XXEXIT MEND 01458000 ./ ADD LEVEL=40,SOURCE=0,NAME=XPUT 01460000 MACRO 01462000 &XLABEL XPUT &XAREA,&XNUM 01464000 .*--> MACRO: XPUT PUT A RECORD ONTO FILE &DDNAME . . . . . * 01466000 .* RICHARD FOWLER AUG 1972 V.5.0 * 01468000 .* MACRO FOR EASY PRINTING ONTO ANY DD FILE RECORD LENGTH=&XNUM * 01470000 .* IF PRINT FILE, THE FIRST CHARACTER IS USED AS CARRIAGE CONTROL 01472000 .* GENERATION CONTROLLED BY &XPUST * 01474000 .* EXECUTION ASSUMES REG 1 POINTS TO DD NAME * 01476000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 01478000 GBLB &XPUTST GENERATION STATUS- 0=YES, 1=NO 01480000 AIF (&XPUTST).XNOGEN IF SHOULDN'T GENERATE, SKIP CALL 01482000 &XLABEL XIONR XXXXPUT,&XNUM,&XAREA,133 01484000 MEXIT 01486000 .XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01488000 &XLABEL DS 0H . LABEL FOR CANCELLED XPUT 01490000 .XXEXIT MEND 01492000 ./ ADD LEVEL=40,SOURCE=0,NAME=XREAD 01494000 MACRO 01496000 &XLABEL XREAD &XAREA,&XNUM 01498000 .*--> MACRO: XREAD READ CARD MACRO . . . . . . . . . . . . . . . . 01500000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01502000 .* MACRO FOR EASY CARD READING-READS UP TO 80 CHARACTERS INTO * 01504000 .* XAREA OPERAND. CONDITION CODE SET TO 0 NORMALLY, OR TO 1 ON * 01506000 .* END OF FILE. GENERATION CONTROLLED BY &XREADST. * 01508000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01510000 GBLB &XREADST GENERATION STATUS- 0=YES, 1=NO 01512000 AIF (&XREADST).XNOGEN IF SHOULDN'T GENRATE-SKIP CALL 01514000 &XLABEL XIONR XXXXREAD,&XNUM,&XAREA,80 01516000 MEXIT 01518000 .XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01520000 &XLABEL DS 0H . LABEL FOR CANCELLED XREAD 01522000 .XXEXIT MEND 01524000 ./ ADD LEVEL=40,SOURCE=0,NAME=XRETURN 01526000 MACRO 01528000 &LABEL XRETURN &RGS=(14-12),&SA=,&RC=,&RP=,&T=,&TR=*,&REEN= 01530000 .** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01532000 .*--> MACRO: XRETURN GENERAL RETURN MACRO, OS LINKAGE * 01534000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01536000 .* EXTENDED RETURN MACRO - SEE PSU CC WRITEUP - XSAVE/XRETURN * 01538000 .* FOR EXPLANATION AND USE OF OPERANDS. * 01540000 .* USES MACROS: FREEMAIN,XCHAR,XSRNR * 01542000 .** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01544000 GBLB &XRETUST =0 TRACE GENERATION OK, =1 NO TRACE 01546000 GBLC &XSAVE,&XXCHAR STD SAVE AREA NAME, XCHAR VARIABLE 01548000 LCLA &I LOCAL COUNTER 01550000 LCLB &RCA,&RCB FOR CONTROL OF RETURN CODE GENER 01552000 .* * 01554000 .* GENERATE LABEL IF THERE IS ONE, GENERATE TRACE CODE IF IT * 01556000 .* IF DESIRED, AND SET UP LCLB VARIABLES TO DESCRIBE RETURN * 01558000 .* CODE CONDITIONS. GENERATE LR IF NEEDED FOR RC OPTION. * 01560000 .* * 01562000 SPACE 1 01564000 AIF (T'&LABEL EQ 'O').XNOLB SKIP IF NO LABEL USED 01566000 &LABEL DS 0H . DEFINE LABEL 01568000 .XNOLB AIF ('&TR' EQ 'NO' OR &XRETUST).XNORT SKIP IF NO TRACE 01570000 XSRTR &TR,&LABEL,EXITED GET TRACE GENERATED 01572000 .XNORT ANOP 01574000 &RCA SETB (T'&RC EQ 'O') TRUE IF WHOLE THING OMITTED 01576000 &RCB SETB (1) SET THIS WAY FOR NEXT TEST 01578000 AIF (&RCA).XNRCB SKIP IMMEDIATELY IF OMITTED 01580000 &RCB SETB ('&RC'(1,1) NE '(' OR '&RC'(K'&RC,1) NE ')') NOT RG TYP 01582000 AIF (&RCB).XNRCB SKIP IF NOT REGISTER TYPE 01584000 XCHAR &RC,3 GET LAST 3 CHARS 01586000 AIF ('&XXCHAR' EQ '15)').XNRCB SKIP IF ALREADY IN 15 01588000 LR 15,&RC . LOAD RETURN CODE FROM DESIRED REG 01590000 .XNRCB AIF (T'&REEN EQ 'O').XNORM SKIP IF NOT REENTRANT 01592000 .* * 01594000 .* REENTRANT RETURN CODE GENERATION - OBTAIN ADDRESS AND LENGTH * 01596000 .* OF AREA FROM WHERE XSAVE PUT THEM,DO FREEMAIN,FIXUP REGS. * 01598000 .* * 01600000 AIF ('&TR' EQ 'NO' OR &XRETUST).XGOK MAKE SURE REENT 01602000 MNOTE 0,'**XRETURN- TR OPTION IMPLIES NON-REENTRANT CODE' 01604000 .XGOK L 13,4(13) . GET OLD SA POINTER BACK 01606000 STM 15,1,16(13) . SAVE REGS FROM FREEMAIN CRUNCHING 01608000 L 1,8(13) . GET ADDRESS OF AREA BACK 01610000 * FREEMAIN R,LV=8*((&REEN+79)/8),A=(1) FREE STORAGE 01612000 FREEMAIN R,LV=8*((&REEN+79)/8),A=(1) FREE STORAGE 01614000 LM 15,1,16(13) . RESTORE THE REGS 01616000 AGO .XNORM1 GO TO PROCESS REGISTER RESTORATION 01618000 .XNORM AIF ('&SA' EQ 'NO').XNORM1 SKIP RESTORATION IF UNUSED 01620000 .* * 01622000 .* REGISTER RESTORATION CODE - RESTORE REGS FROM CALLER'S * 01624000 .* SAVE AREA,DEPENDING ON RETURN CODE AND FUNCTION OPTIONS. * 01626000 .* * 01628000 L 13,4(13) . RESTORE PREVIOUS SAVE AREA POINT 01630000 .XNORM1 AIF ('&RGS' EQ 'NO').XNORM2A SKIP IF NO REGS NEEDED 01632000 AIF ('&RGS' NE '(14-12)' OR NOT &RCB).XNORM2 01634000 LM 14,12,12(13) . STANDARD REGISTER RESTORATION 01636000 AGO .XNORM2A CONTINUE 01638000 .XNORM2 ANOP 01640000 &I SETA &I+1 INCREMENT COUNTER 01642000 XSRNR L,&RGS(&I),&RCB HAVE RESTORE CODE GENRATED 01644000 AIF (&I LT N'&RGS).XNORM2 LOOP UNTIL DONE 01646000 .* * 01648000 .* RETURN CODE(15) AND RETURN PAST(14) CODE GENERATION. * 01650000 .* * 01652000 .XNORM2A AIF (&RCA OR NOT &RCB).XNORM3 SKIP IF NOT LA TYPE RC= 01654000 LA 15,&RC . PUT RETURN CODE IN 15 01656000 .XNORM3 AIF ('&T' NE '*').XNORM4 SEE IF MVI WANTED 01658000 MVI 12(13),X'FF' . SHOW WE HAVE RETURNED 01660000 .XNORM4 AIF (T'&RP EQ 'O').XNORP SKIP IF RP NOT USED 01662000 B &RP.(14) . RETURN GIVEN NUMBER PAST 14 01664000 AGO .XNORM5 01666000 .XNORP BR 14 . RETURN NORMALLY TO CALLER 01668000 .* * 01670000 .* SAVE AREA GENERATION - IF A SAVE AREA SHOULD BE CREATED, * 01672000 .* USE EITHER ONE SPECIFIED BY MACRO,OR ELSE STANDARD ONE. * 01674000 .* * 01676000 .XNORM5 AIF (T'&SA EQ 'O' OR '&SA' EQ 'NO').XEXIT SKIP IF NO SAV5 01678000 AIF ('&SA' EQ '*').XSASTD IF *,USE STANDARD SAVE 01680000 &SA DC 18F'0' . SAVE AREA,NAMED BY MACRO 01682000 AGO .XEXIT 01684000 .XSASTD ANOP 01686000 &XSAVE DC 18F'0' . SAVE AREA,USING GENERATED NAME 01688000 .XEXIT SPACE 1 01690000 MEND 01692000 ./ ADD LEVEL=40,SOURCE=0,NAME=XSAVE 01694000 MACRO 01696000 &LABEL XSAVE &RGS=(14-12),&BR=12,&SA=*,&ID=*,&TR=*,&REEN=,&OPT=,&AD= 01698000 .** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01700000 .*--> MACRO: XSAVE EXTENDED SAVE MACRO - OS LINKAGE. * 01702000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01704000 .* EXTENDED SAVE MACRO - SEE PSU CC WRITEUP - XSAVE/XRETURN * 01706000 .* FOR DESCRIPTION OF ARGUMENTS FOR THIS MACRO * 01708000 .* USES MACROS: GETMAIN,XCHAR,XIDENT,XLOOK,XMUSE,XSRNT,XSRTR * 01710000 .** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01712000 GBLA &XXLOOK RETURN VARIABLE FROM XLOOK MACRO 01714000 GBLB &XSAVEST =0 TRACE GEN OK, =1 NO TRACE DONE 01716000 GBLC &XSAVE,&XCSECT,&XXCHAR STD NAME,CSECT NAME,XCHAR VAR 01718000 LCLA &I LOCAL COUNTER 01720000 LCLB &XNSECT FLAG FOR NEW CSECT 01722000 LCLC &B1,&BT 1ST BASE,LAST 2 CHARS OF 1ST BASE 01724000 &B1 SETC '&BR(1)' GET FIRST OR ONLY BASE IN EASIER NAM 01726000 XCHAR &B1,2 GET LAST 2 CHARS OF BASE REG 01728000 &BT SETC '&XXCHAR' GET LAST 2 CHARACTERS 01730000 &XNSECT SETB ('&SYSECT' NE '&XCSECT') NOTE IF NEW CSECT NEEDED 01732000 &XCSECT SETC '&SYSECT' SET TO SYSECT, FOR NORMAL USE 01734000 .* * 01736000 .* CHECK OPT FIELD - GENERATE TITLE AND/OR ENTRY OR CSECT * 01738000 .* STATEMENTS, DEPENDING ON CONTENTS OF OPT FIELD, IF USED. * 01740000 .* * 01742000 AIF (T'&OPT EQ 'O').XNOPS SKIP IF OPT UNUSED 01744000 XLOOK TITLE,&OPT WAS TITLE OPTION USED 01746000 AIF (&XXLOOK EQ 0).XNTITL SKIP IF TITLE NOT USED 01748000 AIF (N'&OPT EQ 1).XNOPS SKIP IF TITLE ONLY 01750000 TITLE '*** &LABEL ***' 01752000 .XNTITL XLOOK ENTRY,&OPT WAS ENTRY USED 01754000 AIF (&XXLOOK EQ 0).XTRCS SKIP IF NOT USED 01756000 AIF ('&LABEL' EQ '').XENTE SKIP TO ERR IF NO LABEL 01758000 ENTRY &LABEL . NOTE XSAVE ENTRY OPTION 01760000 AGO .XNOPS 01762000 .XENTE MNOTE 4,'**XSAVE- OPT=ENTRY USED WITHOUT LABEL-OPTION IGNORED' 01764000 AGO .XNOPS 01766000 .XTRCS XLOOK CSECT,&OPT CHECK FOR CSECT OPTION 01768000 AIF (&XXLOOK EQ 0).XTRCS1 SKIP IF OPTION NOT THERE 01770000 &LABEL CSECT 01772000 &XCSECT SETC '&LABEL' SET THIS TO SHOW NEW CSECT 01774000 &XNSECT SETB (1) NOTE THAT NEW CSECT IS NEEDED 01776000 AGO .XENT1 SKIP OVER &LABEL DEFN 01778000 .XTRCS1 MNOTE 0,'**XSAVE- UNKNOWN OPT=&OPT- IGNORED' 01780000 .* * 01782000 .* CREATE STATMENT LABEL IF ANY. IF IDENTIFIER REQUESTED,USE * 01784000 .* SPECIFIED IDENTIFIER,STATEMENT LABEL,OR CSECT NAME IN XIDENT * 01786000 .* TO GENERATE CORRECT IDENTIFIER WITH BRANCH AROUND IT. * 01788000 .* * 01790000 .XNOPS SPACE 2 01792000 &LABEL DS 0H . DEFINE LABEL,MAKE SUREE ALIGNED 01794000 .XENT1 USING *,15 . FOR TEMPORARY ADDRESSIBILITY 01796000 AIF ('&SA' EQ '*' OR '&SA' EQ 'NO').XCHKS1 SKIP IF NO CHANGE 01798000 &XSAVE SETC '&SA' EXPLICIT NEW SAVE AREA NAME 01800000 AGO .XSAOK 01802000 .XCHKS1 AIF ('&XSAVE' NE '').XCHKS2 SKIP IF NOT NULL 01804000 &XSAVE SETC '$PR#&SYSNDX' SET UP DEFAULT SAVE AREA NAME 01806000 AGO .XSAOK 01808000 .XCHKS2 AIF (NOT &XNSECT).XSAOK SKIP IF NEW SAVE NOT NEEDED 01810000 &XSAVE SETC '&XCSECT'(1,3).'#&SYSNDX' DEFAULT SAVE AREA NAME 01812000 .* * 01814000 .XSAOK AIF ('&ID' EQ 'NO').XID3 SKIP IF NO ID WANTED 01816000 XIDENT &ID,&LABEL,&XCSECT,$PRIVATE CALL TO SET UP IDENT 01818000 .* * 01820000 .* IF TR OPTION IN EFFECT, CALL XSRTR TO GENERATE RIGHT CODE, * 01822000 .* THEN HAVE XSRNR GENERATE CODE TO SAVE RANGES OF REGISTERS * 01824000 .* * 01826000 .XID3 AIF (&XSAVEST OR '&TR' EQ 'NO').XNOTR SKIP IF NO TRACE 01828000 XSRTR &TR,&LABEL,ENTERED GET TRACE GENERATED 01830000 .XNOTR AIF ('&RGS' NE '(14-12)').XSRCAL SKIP IF NOT STANDARD 01832000 STM 14,12,12(13) . SAVE STANDARD REGISTER SET 01834000 AGO .XCHK13 01836000 .XSRCAL AIF ('&RGS' EQ 'NO').XCHK13 SKIP IF NO REGS SAVED 01838000 &I SETA 1 INITIALIZE COUNTER 01840000 .XSETUP XSRNR ST,&RGS(&I) CALL XSRNR WITH EACH REG SET 01842000 &I SETA &I+1 INCREMENT TO NEXT REGS SET 01844000 AIF (&I LE N'&RGS).XSETUP CONTINUE PROCESSING RGS 01846000 .XCHK13 AIF ('&BT' NE '13').XNORM1 NOT REG 13,DO NORMALLY 01848000 .* * 01850000 .* REGISTER 13 DOUBLE USAGE - THIS SECTION GENERATES CODE TO * 01852000 .* USE REGISTER 13 BOTH AS A BASE AND AS THE SAVE AREA POINTER. * 01854000 .* * 01856000 AIF (T'&AD EQ 'O').XU2 SKIP TO NORMAL IF &AD OMITTED 01858000 LR 14,13 . SAVE @ OLD SAVE AREA BEFORE SETTING 01860000 XMUSE &BR,&AD HAVE ADCON SET UP 01862000 ST 13,8(14) . SAVE NEW POINTER INTO OLD SAVEAREA 01864000 ST 14,4(13) . SAVE OLD POINTER INTO NEW AREA 01866000 AGO .XEND1 GO FINISH UP 01868000 .XU2 CNOP 0,4 01870000 ST 13,&XSAVE+4 . SAVE OLD SA POINTER INTO NEW AREA 01872000 BAL 13,&XSAVE+72 . SET UP 13, BRANCH AROUND SA 01874000 XMUSE &BR SET UP WHATEVER USING REQUIRED 01876000 &XSAVE DC 18F'0' . SAVE A›EA 01878000 .XU3 L 15,&XSAVE+4 . GET OLD SA POINTER BACK TO SET LINKS 01880000 ST 13,8(15) . STORE NEW POINTER IN OLD AREA 01882000 AGO .XEND1 CHECK NUMBER OF BR'S,GET LA'S SET UP 01884000 .* * 01886000 .XNORM1 AIF (T'&REEN EQ 'O').XNORM2 SKIP OVER REENTRANT 01888000 .* * 01890000 .* REENTRANT ENTRY CODE GENERATION - THIS GENERATES CODE TO * 01892000 .* ACQUIRE SPACE FOR SAVEAREA(72 BYTES) + AS MUCH MORE SPACE * 01894000 .* AS IS SPECIFIED IN REEN PARAMATER, IF USED. * 01896000 .* * 01898000 AIF ('&TR' EQ 'NO' OR &XSAVEST).XGOK MAKE SURE REENT 01900000 MNOTE 0,'**XSAVE- USE OF TR OPTION IMPLIES NON-REENTRANT CODE' 01902000 .XGOK ANOP 01904000 * GETMAIN R,LV=8*((&REEN+79)/8) GET SPACE ROUNDED TO D 01906000 GETMAIN R,LV=8*((&REEN+79)/8) .GET CORE ROUNDED TO DBLWRD 01908000 ST 13,4(1) . STORE OLD POINTER IN NEW AREA 01910000 ST 1,8(13) . STORE (EW POINTER IN OLD AREA 01912000 LR &B1,1 . SAVE VALUE OF NEW SAVE POINTER 01914000 LM 0,1,20(13) . RESTORE PREVIOUS VALUES OF REGS 01916000 LR 13,&B1 . POINT 13 TO NEW SAVE AREA 01918000 AGO .XNEWBS GO GENERATE NEW BALR,USING 01920000 .* * 01922000 .* NORMAL,NON-REENTRANT ENTRY CODE SECTION. * 01924000 .* * 01926000 .XNORM2 AIF ('&SA' EQ 'NO').XNEWBS SKIP IF NO SAVE AREA 01928000 ST 13,&XSAVE+4 . SAVE OLD POINTER IN NEW AREA 01930000 AIF ('&BT' NE '15').XSN15 SKIP IF NOT 15 01932000 LA 13,&XSAVE . GET ADDRESS OF NEW SAVE AREA 01934000 L &B1,&XSAVE+4 . GET OLD SAVE POINTER BACK 01936000 AGO .XSOLD GO SAVE NEW POINTER 01938000 .XSN15 LR &B1,13 . MOVE OLD POINTER OVER 01940000 LA 13,&XSAVE . ADDRES> OF NEW SAVE AREA 01942000 .XSOLD ST 13,8(&B1) . SAVE NEW POINTER IN OLD AREA 01944000 .* SET UP BALR, LA'S IF REQUIRED, AND USING STATEMENT. * 01946000 .XNEWBS AIF ('&BT' NE '15' OR N'&BR GT 1).XSET2 SKIP IF 15 01948000 AIF ('&REEN' EQ '' AND '&SA' EQ 'NO' AND '&AD' EQ '').XEND2 01950000 .XSET2 AIF (T'&AD NE 'O').XSET3 SKIP BALR IF ADCON USED 01952000 BALR &B1,0 . SET UP NEW BASE REGISTER 01954000 .XSET3 XMUSE &BR,&AD SET UP USINGS, ADCON IF NEEDED 01956000 .XEND1 AIF (N'&BR EQ 1).XEND2 IF ONLY 1 BASE,DON'T CALL XMUSE 01958000 &I SETA 2 INITIALIZE 01960000 .XA2A LA &BR(&I),4095 . LOAD IN ADDRESS 01962000 LA &BR(&I),1(&BR(&I),&BR(&I-1)) . SET USING VALUES 01964000 &I SETA &I+1 INCREMENT TO NEXT BASE 01966000 AIF (&I LE N'&BR AND &I LE 4).XA2A LOOP FOR # BASES 01968000 .XEND2 SPACE 1 01970000 MEND 01972000 ./ ADD LEVEL=40,SOURCE=0,NAME=XSET 01974000 MACRO 01976000 &XLABEL XSET &XSNAP=,&XSTOP=,&XREAD=,&XPRNT=,&XPNCH=,&XTIME=, X01978000 &XSAVE=,&XRETURN= 01980000 .*--> MACRO: XSET CONTROL XMACRO GENERATION . . . . . . . . . . . 01982000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01984000 .* XSET IS USED TO CONTROL GENERATION OF X-MACROS OF THE NAMES * 01986000 .* USED AS OPERANDS. NAME=OFF CANCELLS THE GIVEN MACRO UNTIL * 01988000 .* NAME=ON IS CODED. ALL NAMES ARE ON UNLESS CANCELLED. ALL * 01990000 .* CODE MAY BE ELIMINATED FOR ANY MACROS EXCEPT XSAVE/XRETURN, * 01992000 .* WHOSE TRACE CODE ONLY IS ELIMINATED. * 01994000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01996000 GBLB &XSNAPST,&XSTOPST,&XSAVEST,&XRETUST STATUS VARS 01998000 GBLB &XREADST,&XPRNTST,&XPNCHST,&XTIMEST 02000000 AIF (T'&XLABEL EQ 'O').XNOLB GEN LABEL ONLY IF NEEDED 02002000 &XLABEL DS 0H . LABEL APPEARED ON AN XSET 02004000 .XNOLB ANOP 02006000 &XSNAPST SETB (('&XSNAP' EQ 'OFF') OR ((T'&XSNAP EQ 'O') AND &XSNAPST)) 02008000 &XSTOPST SETB (('&XSTOP' EQ 'OFF') OR ((T'&XSTOP EQ 'O') AND &XSTOPST)) 02010000 &XREADST SETB (('&XREAD' EQ 'OFF') OR ((T'&XREAD EQ 'O') AND &XREADST)) 02012000 &XPRNTST SETB (('&XPRNT' EQ 'OFF') OR ((T'&XPRNT EQ 'O') AND &XPRNTST)) 02014000 &XPNCHST SETB (('&XPNCH' EQ 'OFF') OR ((T'&XPNCH EQ 'O') AND &XPNCHST)) 02016000 &XTIMEST SETB (('&XTIME' EQ 'OFF') OR ((T'&XTIME EQ 'O') AND &XTIMEST)) 02018000 &XSAVEST SETB (('&XSAVE' EQ 'OFF') OR ((T'&XSAVE EQ 'O') AND &XSAVEST)) 02020000 &XRETUST SETB (('&XRETURN' EQ 'OFF') OR ((T'&XRETURN EQ 'O') AND X02022000 &XRETUST)) 02024000 MEND 02026000 ./ ADD LEVEL=40,SOURCE=0,NAME=XSNAP 02028000 MACRO 02030000 &XLABEL XSNAP &T=PR,&LABEL=,&STORAGE=,&IF= 02032000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02034000 .*--> MACRO: XSNAP EXTENDED SNAP MACRO-DEBUGGING-DUMPING. * 02036000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 02038000 .* XSNAP IS USED FOR STORING,PRINTING OF REGISTERS AND ANY * 02040000 .* OTHER ADDRESSIBLE AREAS. XSNAP HARMS NO REGISTERS,CAN BE USED* 02042000 .* IN ANY NUMBER OF CSECTS IN 1 ASSEMBLY,AND PRINTS REGISTERS * 02044000 .* EXACTLY AS THEY ARE WHEN THE XSNAP IS CALLED. XSNAP * 02046000 .* ACTION MAY BE MADE CONDITIONAL EITHER AT ASSEMBLY TIME OR * 02048000 .* DURING EXECUTE TIME. SEE WRITEUP FOR OPERAND DESCRIPTION. * 02050000 .* USES MACROS: XLOOK * 02052000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02054000 GBLA &XXLOOK XLOOK RETURN VALUE 02056000 GBLB &XSNAPST GENERATION STATUS,ON=0,OFF=1 02058000 LCLA &I,&K,&L,&N LOCAL COUNTERS 02060000 LCLB &XP,&XF PRINT REGS AND PRINT FLOATING REGS 02062000 LCLC &NAM,&INST,&A(5) 02064000 .* * 02066000 .* CHECK FOR XSNAPS BEING CANCELLED. CREATE LABEL IF NEEDED. * 02068000 .* * 02070000 AIF (NOT &XSNAPST).XGOGEN GENERATE IF STATUS=ON 02072000 AIF (T'&XLABEL EQ 'O').XXEXIT SKIP IF NOTHING TO GEN 02074000 &XLABEL DS 0H . LABEL USED ON NULLIFIED XSNAP 02076000 MEXIT 02078000 .XGOGEN SPACE 1 02080000 &NAM SETC 'XX&SYSNDX' SET UP MOST OF NAME FOR LABELS 02082000 &N SETA (N'&STORAGE/2)*2 GET ROUNDED NUMBER OF OPERANDS 02084000 &XLABEL STM 0,15,&NAM.B . SAVE ALL REGISTERS 02086000 .* * 02088000 .* IF OPTION - IF IF OPTION IS USED AND HAS CORRECT ARGUMENTS, * 02090000 .* GENERATE A CLI, C, OR CR INSTRUCTION TO PERFORM APPROPRIATE * 02092000 .* TEST,DEPENDING ON THE KIND OF IF ARGUMENTS . NEGATE THE * 02094000 .* CONDITION AND CREATE THE RIGHT EXTENDED MNEMONIC BRANCH * 02096000 .* SO THAT THE XSNAP WILL BE SKIPPED IF THE STATED CONDTION IS * 02098000 .* NOT MET. GENERATE USER'S OWN OPCODE IF HE SUPPLIED ONE. * 02100000 .* * 02102000 AIF (T'&IF EQ 'O').XNOIF SKIP IF IF NOT REQUESTED 02104000 AIF (N'&IF GE 3).XOKIF SKIP IF ENOUGH ARGUMENTS 02106000 MNOTE 0,'**XSNAP- IF=&IF:IGNORED, LACKS REQUIRED 3-4 OPERANDS' 02108000 AGO .XNOIF CANCEL IF OPTION 02110000 .XOKIF XLOOK &IF(2),(H,L,E,O,P,M,Z,NH,NL,NE,NO,NP,NM,NZ) 02112000 AIF (&XXLOOK GT 0).XOKIF1 SKIP IF OK RELATION 02114000 MNOTE 0,'**XSNAP- IF=&IF(2) UNKNOWN-CANCELLED' 02116000 AGO .XNOIF SKIP GENERATION OF THIS OPTION 02118000 .XOKIF1 ANOP 02120000 &INST SETC '&IF(4)' GET INSTRUCTION 02122000 AIF (N'&IF EQ 4).X IF OPCODE SUPPLIED,SKIP CHECKING 02124000 &INST SETC 'CLI' MAKE TENTATIVE INSTRUCTION SETUP 02126000 AIF ('&IF(1)'(1,1) NE '(' OR '&IF(1)'(K'&IF(1),1) NE ')').X 02128000 &INST SETC 'C' PROBABLY WANTS RX TYPE 02130000 AIF ('&IF(3)'(1,1) NE '(' OR '&IF(3)'(K'&IF(3),1) NE ')').X 02132000 &INST SETC 'CR' 2 REGS-USER WANTS RR TYPE 02134000 .X ANOP 02136000 &INST &IF(1),&IF(3) . TEST 02138000 &INST SETC 'BN&IF(2)' NEGATE COND, HOPE FOR 1 OF 1ST SET 02140000 AIF (&XXLOOK LE 7).XOKIF2 SKIP IF NOW SET UP RIGHT 02142000 &INST SETC 'B'.'&IF(2)'(2,2) REMOVE N FROM COND 02144000 .XOKIF2 &INST &NAM.C 02146000 .* * 02148000 .* CREATE BRANCH AROUND THE SAVE AREA, FLAGS, ETC. * 02150000 .* * 02152000 .XNOIF XLOOK &T(1),(PR,PRINT,FL,FLOAT,NO,NOREGS,ST,STORE) 02154000 &I SETA 72+4*&N LENGTH FOR T=PRINT,NOREGS 02156000 AIF (&XXLOOK LE 6).XBRNCH SKIP IF ILLEGAL, OR PR,NO 02158000 &I SETA 68 LENGTH FOR T=STORE 02160000 .XBRNCH B &NAM.B+&I . BRANCH AROUND CONSTANTS 02162000 .* * 02164000 .* CREATE FRONT BRACKET CHARACTER STRING FOR REGISTER AREA * 02166000 .* * 02168000 DS 0F . ALIGN LABEL ON FULLWORD 02170000 &L SETA 8 SET &L FOR NO LABEL= LENGTH 02172000 AIF (T'&LABEL EQ 'O').XNOLAB IF NO LABEL,SKIP GENERATIO 02174000 &L SETA ((K'&LABEL+1)/4)*4 ROUND LENGTH UP TO FULLWORD 02176000 AIF (&L LE 92).XLAB1 SKIP IF LABEL SMALL ENOUGH 02178000 MNOTE 0,'**XSNAP- LABEL= OPERAND TRUNCATED TO 92 CHARACTERS' 02180000 &L SETA 92 TRUNCATE 02182000 .XLAB1 DC CL&L&LABEL 02184000 AGO .XCHK1 SKIP GENRATION OF 1ST DELIMETER 02186000 .XNOLAB DC CL8'&NAM.B' . FRONT BRACKET FOR REGISTER AREA 02188000 .* * 02190000 .* CREATE REGISTER AREA, BRACKETS, FLAG VALUES, AS NEEDED * 02192000 .XCHK1 AIF (&XXLOOK LT 7).XPRINT SKIP IF PRINTED OUTPUT 02194000 &NAM.B DC 16F'-1',4C'X' . REGISTER SAVE AREA, BRACKET X'S 02196000 AGO .XIFLB SKIP TO CHECK FOR IF LABEL 02198000 .XPRINT AIF (&XXLOOK GT 0).XPRINT1 SKIP IF LEGAL T= 02200000 MNOTE 0,'**XSNAP- UNKNOWN T=&T: T=PR ASSUMED' 02202000 .XPRINT1 ANOP 02204000 &XP SETB (&XXLOOK LT 5) SET TO 1 IF GP REGS NEEDED 02206000 &XF SETB (&XXLOOK GT 2 AND &XP) SET TO 1 IF T=FL OR T=FLOAT 02208000 &XF SETB (&XF OR '&T(2)' EQ 'FL' OR '&T(2)' EQ 'FLOAT') 02210000 &NAM.B DC 16F'-1',B'&T(3)00&XF&XP',AL1(0,&L,&N/2),V(XXXXSNAP) 02212000 .* * 02214000 .* GENERATE ADDRESS LIST FOR STORAGE=, WITH EITHER WORDS FOR * 02216000 .* STORING ADDRESSES OR A-TYPE ADDRESS CONSTANTS. * 02218000 .* * 02220000 AIF (T'&STORAGE EQ 'O').OKN SKIP IF STORAGE= NOT USED 02222000 &I SETA 1 INITIALIZE AS COUNTER 02224000 AIF (&N EQ N'&STORAGE).LOOP1 SKIP IF LEGAL 02226000 MNOTE 0,'**XSNAP- ODD OPERAND IGNORED: STORAGE=&STORAGE(&N)' 02228000 AIF (&N EQ 0).OKN 02230000 .LOOP1 AIF ('&STORAGE(&I)'(1,1) NE '*').LOOP1E 02232000 &K SETA 1 INITIALIZE COUNTER 02234000 .* PROCESS ADDRESS REQUIRING LA - ST COMBINATION * 02236000 .LOOP1A AIF (&I+&K GT &N).LOOP1C SKIP IF WE'RE AT END 02238000 AIF ('&STORAGE(&I+&K)'(1,1) NE '*').LOOP1C SKIP IF NOT * 02240000 &K SETA &K+1 INCREM # CONSECUTIVE *FORMS 02242000 AGO .LOOP1A GO CHECK NEXT 02244000 .LOOP1C DS &K.A . WORDS WHERE ADDRESSES WILL BE STORED 02246000 &I SETA &I+&K INCREMENT 02248000 AGO .LOOP1G GO FOR NEXT CHECK 02250000 .* PROCESS ADDRESS CONSTANT TYPE OF OPERAND * 02252000 .LOOP1E DC A(&STORAGE(&I)) 02254000 &I SETA &I+1 INCREMENT # OPERANDS DONE 02256000 .LOOP1G AIF (&I LE &N).LOOP1 CONTINUE IF ANY MORE 02258000 .* * 02260000 .* CREATE LOAD ADDRESS - STORE PAIRS FOR EXPRESSION ADDRESSES * 02262000 .* * 02264000 &I SETA 1 02266000 .LOOP2 AIF ('&STORAGE(&I)'(1,1) NE '*').LOOP2E SKIP IF NOT * 02268000 &L SETA K'&STORAGE(&I)-1 GET # CHARAS IN EXPRESSION 02270000 &K SETA 1 INIT COUNTER 02272000 AIF (&L LE 40).LOOP2A SKIP IF SMALL ENOUGH 02274000 MNOTE 8,'**XSNAP- STORAGE(&I) LONGER THAN 40 CHARACTERS' 02276000 &L SETA 40 TRUNCATE AND HOPE IT GOES 02278000 .* BREAK EXPRESSION INTO 8 CHARACTER SECTIONS. * 02280000 .LOOP2A ANOP 02282000 &A(&K) SETC '&STORAGE(&I)'(8*&K-6,8) GET UP TO 8 NEXT CHARS 02284000 &K SETA &K+1 INCRMENT COUNTER 02286000 AIF (8*&K-8 LT &L).LOOP2A LOOP UNTIL HAVE WHOLE OPR 02288000 LA 0,&A(1)&A(2)&A(3)&A(4)&A(5) 02290000 ST 0,&NAM.B+4*&I+68 STORE ADDRESS IN LIST 02292000 .LOOP2C ANOP 02294000 &K SETA &K-1 DECRMENT SECTION TO NULL 02296000 &A(&K) SETC '' NULL FOR NEXT USE 02298000 AIF (&K GT 2).LOOP2C CONTINUE UNTIL ALL BUT &A(1) NULL 02300000 .LOOP2E ANOP 02302000 &I SETA &I+1 INCREMENT POSITION IN LIST 02304000 AIF (&I LE &N).LOOP2 CONTINUE WITH LIST 02306000 .* * 02308000 .* CREATE CODE TO SET UP REGISTERS FOR XXXXSNAP,CALL IT,AND * 02310000 .* RESTORE REGS ON RETURN. XXXXSNAP RESTORES THE CONDTION CODE.* 02312000 .* * 02314000 .OKN LA 10,&NAM.B . GET ADDRESS OF REGISTER BLOCK 02316000 L 15,68(10) . GET V(XXXXSNAP) FOR BRANCH 02318000 BALR 14,15 . CALL XXXXSNAP,POINT 14 AT NEXT INST 02320000 LM 0,15,0(10) . RELOAD THE REGISTERS 02322000 .* CREATE LABEL FOR IF OPTION, IF IT WAS USED. * 02324000 .XIFLB AIF ('&INST' EQ '').XEXIT SKIP GEN OF IF LABEL 02326000 &NAM.C EQU * . DEFINE LABEL FOR IF= BRANCH 02328000 .XEXIT SPACE 2 02330000 .XXEXIT MEND 02332000 ./ ADD LEVEL=40,SOURCE=0,NAME=XSRNR 02334000 MACRO 02336000 XSRNR &OP,&RG,&NO15 02338000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02340000 .*--> MACRO: XSRNR SAVE/RESTORE REGISTERS FOR XSAVE/XRETURN * 02342000 .* JOHN R. MASHEY- FEB 1970 - V.4.0 * 02344000 .* THIS MACRO IS USED BY XSAVE AND XRETURN TO SET UP * 02346000 .* REGISTER SAVING AND RESTORATION. * 02348000 .* &OP IS THE OPCODE TO BE USED. I.E. EITHER L OR ST. * 02350000 .* &RG IS 1 OPERAND FROM THE &RGS OPERAND USED BY XSAVE AND * 02352000 .* XRETURN. IT IS EITHER 1 REGISTER, OR A PAIR OF REGS * 02354000 .* SEPARATED BY A DASH. * 02356000 .* &NO15 =0 STATES THAT A RETURN CODE IS CURRENTLY IN REG 15 * 02358000 .* AND SHOULD NOT BE DISTURBED, REGARDLESS OF HOW THE REGS* 02360000 .* ARE SPECIFIED. * 02362000 .* USES MACROS: XCHAR * 02364000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02366000 GBLC &XXCHAR FOR COMMUNICATION WITH XCHAR 02368000 LCLA &I 02370000 LCLC &R1,&R2 1ST REG, 2ND REG, TEMPORARY 02372000 AIF ('&RG' EQ 'NO').XXEXIT DON'T GEN ANYTHING 02374000 .* SCAN FOR DASH-MEANING 2 REGISTERS. * 02376000 .XSL1 ANOP 02378000 &I SETA &I+1 INCREMENT FOR NEXT CHARACTER 02380000 AIF ('&RG'(&I,1) EQ '-').XDASH JUMP IF DASH FOUND 02382000 AIF (&I LT K'&RG).XSL1 CONTINUE TO END OF OPERAND 02384000 &R1 SETC '&RG' &RG IS 1 REGISTER BY ITSELF 02386000 AGO .XSAA GO TO NEXT DECISION POINT 02388000 .* FOUND DASH-NOW SEPARATE THE REGISTERS. * 02390000 .XDASH ANOP 02392000 &R1 SETC '&RG'(1,&I-1) GET FIRST REGISTER 02394000 AIF (&I EQ K'&RG).XSAA DUMB USER - 1 REG FOLLOWED BY - 02396000 &R2 SETC '&RG'(&I+1,K'&RG-&I) GET 2ND REGISTER 02398000 .XSAA XCHAR &R1,2 GET UP TO LAST 2 CHARS OF 1ST REG 02400000 AIF ('&XXCHAR' NE '14' AND '&XXCHAR' NE '15').XNO1415 02402000 &I SETA 4*&XXCHAR-44 OFFSET FOR 14 OR 15 02404000 AIF ('&R2' NE '').XS2RG SKIP IF 2 REGISTERS SPECIFIED 02406000 AIF ('&XXCHAR' EQ '15' AND '&NO15' EQ '0').XXEXIT 02408000 &OP &R1,&I.(13) . SAVE/RESTORE 1 REG 02410000 MEXIT 02412000 .XS2RG AIF ('&NO15' EQ '0').XSN15 SKIP IF 15 SHOULDN'T BE 02414000 &OP.M &R1,&R2,&I.(13) . SAVE/RESTORE RANGE OF REGS 02416000 MEXIT 02418000 .XSN15 AIF ('&XXCHAR' EQ '15').XSN15A SKIP IF 15 SPECIFIED 02420000 L &R1,12(13) . RELOAD REG 14 02422000 XCHAR &R2,2 GET 2ND REG 02424000 AIF ('&XXCHAR' EQ '15').XXEXIT SKIP IF 15 SPECIFIED 02426000 .XSN15A LM 0,&R2,20(13) . RELOAD REST OF REGS 02428000 MEXIT 02430000 .* RESTORE 1 REG OR RANGE (NOT STARTING WITH 14 OR 15). * 02432000 .XNO1415 AIF ('&R2' NE '').XLMSTM JUMP IF MULTIPLE REGS 02434000 &OP &R1,&R1*4+20(13) 02436000 MEXIT 02438000 .XLMSTM &OP.M &R1,&R2,&R1*4+20(13) 02440000 .XXEXIT MEND 02442000 ./ ADD LEVEL=40,SOURCE=0,NAME=XSRTR 02444000 MACRO 02446000 XSRTR &TR,&LABEL,&MSG 02448000 .*--> MACRO: XSRTR GENERATE TRACE CODE FOR XSAVE/XRETURN . . . . . 02450000 .* JOHN R. MASHEY- FEB 1970 - V.4.0 * 02452000 .* THIS MACRO IS USED BY XSAVE AND XRETURN TO GENERATE THE * 02454000 .* TRACE CODE CALLS TO XSNAP OR XPRNT, OR TIMING CALLS TO XTIME.* 02456000 .* MACROS CALLED BY THIS MACRO - XLLOK, XPRNT,XSNAP,XTIME * 02458000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02460000 GBLA &XXLOOK FOR COMMUNICATION 0WITH XLOOK 02462000 GBLB &XSNAPST,&XPRNTST GLOBALS FOR OUTPUT MACROS 02464000 LCLA &I FOR USE AS LENGTH SPECIIFICATION 02466000 LCLB &XSTSAV FOR SAVING STAUS VARIABLES 02468000 LCLC &NAME FOR EITHER LABEL OR CSECT 02470000 XLOOK &TR(1),(*,SNAP,TIME) CHECK TYPE 02472000 AIF (&XXLOOK LT 3).XPS SKIP IF NOT TIME 02474000 * XTIME ,&TR(2) 02476000 XTIME ,&TR(2) 02478000 MEXIT 02480000 .XPS AIF (&XXLOOK EQ 0 AND N'&TR GT 1 AND '&TR(2)' NE 'SNAP').XE 02482000 &NAME SETC '&LABEL' ASSUME NAME IS LABEL 02484000 AIF (T'&LABEL NE 'O').XNOK1 SKIP IF LABEL EXISTS 02486000 &NAME SETC '&SYSECT' USE CSECT NAME INSTEAD 02488000 AIF ('&SYSECT' NE '').XNOK1 SKIP IF CSECT NOT PC 02490000 &NAME SETC '$PRIVATE' USE NAME FOR PRIVATE CODE (PC) 02492000 .XNOK1 AIF (&XXLOOK EQ 2 OR '&TR(2)' EQ 'SNAP').XNSNAP 02494000 &XSTSAV SETB (&XPRNTST) SAVE STATUS VARIABLE 02496000 &XPRNTST SETB (0) MAKE SURE XPRNT WILL GENERATE 02498000 AIF (&XXLOOK EQ 1).XDFTA SKIP- TR=* - DEFAULT 02500000 &I SETA 2*((K'&TR)/2) GET RIGHT TOTAL LENGTH FOR DC 02502000 B *+4+&I . BRANCH AROUND MESSAGE 02504000 XX&SYSNDX.T DC C'0',CL(&I-1)&TR 02506000 AGO .XPRB SKIP OVER ALTERNATE 02508000 .XDFTA B *+28 . BRANCH AROUND MESSAGE 02510000 XX&SYSNDX.T DC CL24'0*** &NAME &MSG ***' 02512000 &I SETA 24 SET UP FOR XPRNT 02514000 .XPRB ANOP 02516000 * XPRNT XX&SYSNDX.T,&I PRINT MESSAGE WITH GIVEN LENGTH 02518000 XPRNT XX&SYSNDX.T,&I 02520000 &XPRNTST SETB (&XSTSAV) RESTORE PREVIOUS VALUE 02522000 MEXIT 02524000 .XE MNOTE 0,'**XSRTR- TR=&TR: UNKNOWN, IGNORED' 02526000 MEXIT 02528000 .XNSNAP ANOP 02530000 &XSTSAV SETB (&XSNAPST) SAVE XSNAP STATUS, IN CASE OFF 02532000 &XSNAPST SETB (0) MAKE SURE XSNAP WILL GENERATE 02534000 * XSNAP LABEL=' MESSAGE ' 02536000 AIF (&XXLOOK EQ 2).XDFTB SKIP IF TR=SNAP 02538000 XSNAP LABEL=&TR(1) 02540000 AGO .XSNB SKIP OVER ALTERNATE 02542000 .XDFTB XSNAP LABEL='*** &NAME &MSG ***' 02544000 .XSNB ANOP 02546000 &XSNAPST SETB (&XSTSAV) RESTORE STATUS,IN CASE IT WAS OFF 02548000 MEND 02550000 ./ ADD LEVEL=40,SOURCE=0,NAME=XSTOP 02552000 MACRO 02554000 &LABEL XSTOP &N=2,&ABEND=200,&GOTO= 02556000 .*--> MACRO: XSTOP CONTROL PROGRAM LOOPS . . . . . . . . . . . . . 02558000 .* JOHN R. MASHEY - FEB 1970 - V.4.0 * 02560000 .* XSTOP IS USED TO STOP INFINITE LOOPS IN ASSEMBLER * 02562000 .* N=NUMBER WILL CAUSE THE PROGRAM TO ABEND THE NUMBER'TH * 02564000 .* TIME THROUGH THE XSTOP. DEFAULT IS N=2, * 02566000 .* WHICH MEANS THE XSTOP CAN ONLY BE ENCOUNTERED ONCE * 02568000 .* BEFORE IT ABENDS. * 02570000 .* ABEND=K K WILL BE THE COMPLETION CODE ISSUED BY THE * 02572000 .* EMBEDDED ABEND MACRO. DEFAULT IS 200. * 02574000 .* GOTO=LABEL BRANCH TO LABEL INSTEAD OF ABENDING * 02576000 .* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02578000 GBLB &XSTOPST XSTOP GENERATION STATUS,ON=0,OFF=1 02580000 LCLC &XNAM NAME FOR CONSTANTS 02582000 AIF (&XSTOPST).XXNOG SKIP IF NOGEN 02584000 &XNAM SETC 'XX&SYSNDX.V' GET UNIQUE LABEL 02586000 &LABEL ST 0,&XNAM . SAVE WORK REGISTER 02588000 L 0,&XNAM+4 . LOAD CURRENT COUNTER VALUE 02590000 BCT 0,&XNAM+8 . BRANCH IF STILL OK,DECREMENT REG 02592000 L 0,&XNAM . RESTORE WORK REGISTER 02594000 AIF ('&GOTO' EQ '').XXAB SKIP IF NO GOTO USED 02596000 B &GOTO . TAKE DESIRED BRANCH 02598000 AGO .XXDC SKIP TO GENERATE DC'S 02600000 .XXAB ABEND &ABEND,DUMP 02602000 .XXDC ANOP 02604000 &XNAM DC A(0,&N) . REGISTER SAVE AREA, COUNTER 02606000 ST 0,&XNAM+4 . SAVE DECREMENTED COUNTER VALUE 02608000 L 0,&XNAM . RESTORE WORK REGISTER 02610000 SPACE 2 02612000 MEXIT 02614000 .XXNOG AIF (T'&LABEL EQ 'O').XXEXIT SKIP IF NO LABEL 02616000 &LABEL DS 0H 02618000 .XXEXIT MEND 02620000 ./ ADD LEVEL=40,SOURCE=0,NAME=XXGPSRCH 02622000 MACRO 02624000 XXGPSRCH &DIREC,&TIME 02626000 .**-->MACRO: XXGPSRCH INNER MACRO FOR XGPGEN . . . . . . . . . . . . . 02628000 .* ARGUMENTS: 02630000 .* &DIREC= G--> INPUT 02632000 .* P--> OUTPUT 02634000 .* &TIME=1 --> FIRST CALL, SETS UP EXTRA CODE AND ACTS AS &SYSNDX 02636000 .* 2--> SECOND CALL 02638000 .*. . . . . . . . . . . . .. . . . . . . . . . . . . . . . . . . . . . 02640000 L R3,X&DIREC.ELEM . GET # LAST POINTER TO OPEN FILES 02642000 LA R1,X&DIREC.PNTSRT . GET @ OF FIRST POINTER 02644000 LTR R3,R3 . ARE THERE ANY ELEMENTS? 02646000 BE X&DIREC.MAKE&TIME NO - GO CREATE ONE 02648000 LA R2,12 . SET UP INCREMENT SIZE 02650000 X&DIREC.LOOP&TIME CLC 0(8,R1),X&DIREC.CURENT COMPARE DD NAMES 02652000 BE X&DIREC.CONT&TIME IF EQUAL, GO TO I/O 02654000 BXLE R1,R2,X&DIREC.LOOP&TIME ^EQUAL, SEARCH TILL END OF TABLE 02656000 SPACE 2 02658000 MEND 02660000