AIF (&$REPL EQ 0).RENREPL SKIP IF NO REPLACE AT ALL 30000000 TITLE 'RECORBLK DSECT - REPLACE CORRESPONDENCE TABLE' 30002000 **--> DSECT: RECORBLK REPLACE MODULE-DESCRIBES 1 REAL-REPLACE PAIR. . 30004000 *. THIS DSECT DESCRIBES 1 ENTRY IN THE TABLE RECORRAD. . 30006000 *. WHEN AN ENTRY POINT IS REPLACED, A RECORBLK IS CREATED FOR . 30008000 *. IT AND FILLED WITH VALUES FROM THE ENTRY POINT'S RFSYMBLK. . 30010000 *. THE ENTRY ADDRESS OF THE NEW ENTRY IS FOUND FROM THE SYMBOL . 30012000 *. TABLE (WHICH STILL EXISTS), AND IS SAVED INTO THE RECFPSW . 30014000 *. FIELD (OR A -1 PLACED HERE TO SHOW THE ENTRY COULD NOT BE . 30016000 *. FOUND IN THE USER PROGRAM). USING THE RECAXAD FIELD, WHICH . 30018000 *. POINTS TO THE ADCON IN AVWXTABL OF THE REAL ROUTINE, THE REAL. 30020000 *. ADCON IS SAVED IN RECADRE, AND IT IS REPLACED BY THE ADDRESS . 30022000 *. OF REFAKE. A CODE IS PLACED INTO THE HI-ORDER BYTE OF THE . 30024000 *. WORD IN AVWXTABL, WHICH IS USED BY REFAKE TO IDENTIFY WHICH . 30026000 *. ENTRY IS CALLED. . 30028000 *. AT THE END OF A REPLACE RUN, THE REAL ADCONS ARE MOVED . 30030000 *. BACK TO THEIR PROPER PLACES IN AVWXTABL, USING THE RECAXAD . 30032000 *. FIELD OF EACH RECORBLK ELEMENT IN THE RECORRAD TABLE. . 30034000 *. **NOTE** FIRST SECTION OF DSECT SAME AS DSECT RFSYMBLK. . 30036000 *. LOCATION: CSECT REMONI, TABLE RECORRAD. . 30038000 *. NAMES: REC----- . 30040000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30042000 SPACE 1 30044000 RECORBLK DSECT 30046000 * DATA TRANSFERRED FROM RFSYMS CSECT TABLES. 30048000 RECSYMB DS CL6 ENTRY POINT NAME 30050000 RECAXAD DS H OFFSET IN AVWXTABL=AX#-AX$BASE 30052000 RECRGAD DS H OFFSET FOR CHECK CODE=RG#-RGENTS 30054000 SPACE 1 30056000 RECADRE DS V SPACE TO SAVE REAL ADDRESS CONSTNAT 30058000 RECFPSW DS 0F BEGINNING PSW FOR ONE ENTRY POINT 30060000 RECFPCC DS C ILC-CC-PM, ALSO USED AS FLAG 30062000 RECFPAD DS AL3 BEGINNING @ FOR ENTRY POINT IN FAKE 30064000 SPACE 1 30066000 * RUN STATISTICS VARIABLES 30068000 RECINSTS DS F CUMULATIVE # INSTRUCTIONS DONE 30070000 RECCALLS DS H CUMULATIVE # TIMES ENTRY CALLED 30072000 RECWRONG DS H CUMULATIVE # TIMES PROG WRONG VALUES 30074000 RECZ$L EQU *-RECINSTS LENGTH TO BE ZEROED-COUNTERS 30076000 REC$LEN EQU ((*-RECORBLK+3)/4)*4 LENGTH, RNDED TO FULLWRD 30078000 TITLE 'RFSYMBLK DSECT - REPLACE ENTRY INFORMATION TABLE' 30080000 **--> DSECT: RFSYMBLK REPLACE MODULE: 1 ENTRY IN TABLE CSECT RFSYMS . 30082000 *. EACH SECTION OF RFSYMS GIVES EITHER A REPLACABLE . 30084000 *. CSECT NAME OR ONE OF ITS ENTRY POINT NAMES. THE ENTRY . 30086000 *. POINT ELEMENTS CONTAIN VARIOUS POINTERS WHICH ARE USED TO . 30088000 *. GIVE OFFSET ADDRESSES FOR REAL ENTRY ADDRESS CONSTANTS OR . 30090000 *. FOR VARIOUS CHECKING CODE IN THE REPLACE MONITOR. . 30092000 *. **NOTE** THIS DSECT IS SAME AS FIRST PART OF RECORBLK DSECT. . 30094000 *. GENERATION: 1 CALL TO RFSGN MACRO CREATS 1 CSECT ELEMENT . 30096000 *. AND 1 TO REC$MAX ENTRY ELEMENTS. . 30098000 *. LOCATION: CSECT RFSYMS. . 30100000 *. NAMES: RFS----- . 30102000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30104000 SPACE 1 30106000 RFSYMBLK DSECT 30108000 RFSYMB DS CL6 CSECT/ENTRY NAME, ALPHAMERIC 30110000 RFSENTN DS AL1 CSECT: NUMBER OF ENTRY POINTS 30112000 RFSENTL DS AL1 CSECT: LENGTH OF CSECT+ENTRY BLKS 30114000 RFSRIAD DS H OFFSET TO RI&CSECT-PTRS TO CALLABLES 30116000 SPACE 1 30118000 ORG RFSENTN ORG BACK . DEFINE ENTRY FIELDS 30120000 RFSAXAD DS H OFFSET TO ENTRY ADCON IN AVWXTABL 30122000 * = AXENTRY - AX$BASE 30124000 RFSRGAD DS H OFFSET TO REG CHECKING CODE FOR 30126000 * RETURN VALUES. = RGENTRY-RGENTS 30128000 ORG RFSRGAD BACK OVER, REALLY FOR RFSYMS PART 2 30130000 RFSRHAD DS H OFFSET TO CODE TO CHECK REGS FOR 30132000 * CALLING OTHER PROGS.=RHENTRY-RHENTS 30134000 RFS$LEN EQU ((*-RFSYMBLK+1)/2)*2 LENGTH OF BLOCK,RD FULLWORD 30136000 TITLE 'REMONI - REPLACE MONITOR CONTROL PROGRAM' 30138000 PRINT NOGEN 30140000 REMONI CSECT 30142000 **--> CSECT: REMONI REPLACE MONITOR CONTROL PROGRAM . . . . . . . . 30144000 *. REMONI HANDLES MOST OF THE DETIALS REQUIRED FOR A STUDENT TO . 30146000 *. WRITE AN ASSIST CSECT, HAVE IT ASSEMBLED BY ASSIST, AND THEN RUN . 30148000 *. A TEST PROGRAM. THE ENTRYPOINTS OF HIS PROGRAM ARE CALLED ALONG . 30150000 *. WITH THE ORIGINALS, AND HIS RESULTS CHECKED FOR ACCURACY. WHILE . 30152000 *. ADDRESS CONSTANT MODIFCATION IS PERFORMED, THE ENTIRE PROCESS IS . 30154000 *. STILL A SERIALLY RESUABLE PROGRAM. SEE THE ASSIST REPLACE USER'S . 30156000 *. GUIDE FOR DETAILS ON USING THE REPLACE MONITOR. . 30158000 *. NAMES: RE------ MAIN CODE BODY AND INSUBS. . 30160000 *. NAMES: RG------ CHECKING CODE FOR RETURN VALUES. . 30162000 *. NAMES: RH------ EXTERNAL CALL CHECKING (&$REPL=2) . 30164000 *. CALLS SYFIND . 30166000 *. USES DSECTS: AJOBCON,AVWXTABL,ECONTROL,RECORBLK,RFSYMBLK . 30168000 *. USES MACROS: $CALL,$PRNT,$RETURN,$SAVE,REPRNT,XDECO,XSNAP . 30170000 *. . 30172000 *. OVERALL REGISTER CONVENTIONS AND USAGE. . 30174000 *. R0,R1,R2,R3,R4,R15 WORK REGISTERS . 30176000 *. R5 = @ RECORBLK ELEMENT FOR CURRENT ENTRY BEING PROCESSED. . 30178000 *. R6 = BASE REGISTER FOR MAIN CODE OF EACH REMONI ENTRY POINT. . 30180000 *. R7,R8 USUAL PARAMETER REGS FOR INTERNAL SUBROUTINES. . 30182000 *. R9 = LINK REGISTER FOR INSUBS WHICH MUST CALL OTHERS WITH R14. . 30184000 *. R10= @ ECONTROL (EXECUTION CONTROL BLOCK, USER PSEUDO REGISTERS. . 30186000 *. R11= @ AJOBCON DSECT (MAIN JOB CONTROL TABLE) . 30188000 *. R12(RAT)= @ VWXTABL CSECT (AVWXTABL DSECT). . 30190000 *. R13= SAVE AREA ADDRESS, BASE REGISTER FOR DATA, INTERNAL SUBRS. . 30192000 *. R14= INTERNAL LINK REGISTER. LOCAL WORK REGISTER. . 30194000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30196000 SPACE 1 30198000 $DBG ,NO NO DEBUG 30200000 ENTRY REINTA,REENDA,REFAKE ENTRIES ALWAYS PRESENT 30202000 SPACE 1 30204000 * REMONI FLAG EQUATES 30206000 READMOD EQU B'00000001' (REFLAGS)=>ADCONS IN AX ARE MODIFID 30208000 REFPRT EQU B'00000010' (REFLAGS)=> REFAKE PRTED >=1 MSG,SKP 30210000 SPACE 1 30212000 REC$MAX EQU 5 MAXIMUM # ENTRIES TO BE REPLACED 30214000 EJECT 30216000 **--> ENTRY: REINTA INITIALZE BEFORE ASSEMBLER CALLED . . . . . . . 30218000 *. THIS ENTRY IS CALLED 1 TIME BEFORE ASSIST ASSEMBLER IS CALLED. 30220000 *. IT CHECKS FOR PRESENCE OF REAL ADDRESS CONSTANTS IN VWXTABL, AND . 30222000 *. REPLACES THEM IF THEY HAVE BEEN MODIFIED IN PREVIOUS REPLACE RUN. . 30224000 *. IT ALSO MAY SET FLAGS IN AVWXTABL IF THE SYSTEM IS IN . 30226000 *. REPLACE PHASE A (ASSEMBLE REPLACEMENT PROGRAM AND LINK IT). . 30228000 *. ENTRY CONDITIONS . 30230000 *. R11= @ AJOBCON (MAIN JOB CONTROL BLOCK). . 30232000 *. R12(RAT)= @ VWXTABL CSECT (AVWXTABL DSECT). . 30234000 *. . 30236000 *. AVWXTABL: HAS BEEN COMPLETELY INITIALIZED BY MAIN PROGRAM ASSIST. . 30238000 *. THIS PERMITS REINTA TO MODIFY ASSEMBLER CONTROL FLAGS IF . 30240000 *. NEEDED TO MAKE ASSEMBLER PERFORM REQUIRED ACTIONS. . 30242000 *. USES DSECTS: AJOBCON,AVWXTABL . 30244000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30246000 REINTA $SAVE RGS=(R14-R12),BR=R6,SA=RESAVE 30248000 USING RESAVE,R13 NOTE AVAIL AS BASE 30250000 USING AVWXTABL,RAT NOTE ASSEMBLER TABLE USING 30252000 USING AJOBCON,R11 NOTE MAIN JOB CONTROL TABLE 30254000 TM AJOMODE,AJOREPLF+AJOREPHB TEST REPLACE STATUS 30256000 BZ REINREAL NOT REPLACE AT ALL, RESTORE ADCONS 30258000 BM REINPHSA AJOREPLF ONLY==> REPLACE PHASE A-BR 30260000 SPACE 2 30262000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30264000 * PRE-ASSEMBLY -- REPLACEMENT PHASE B * 30266000 * THIS ACTION OCCURS JUST BEFORE THE ASSEMBLER IS CALLED WITH * 30268000 * MODIFIED ADCON TABLE FOR THE TEST RUN OF USER-WRITTEN CSECT. * 30270000 * DON'T MODIFY ADCONS AGAIN, BUT FIX AVWXTABL FLAGS SO RUN * 30272000 * WILL BE NORMAL. * 30274000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30276000 OI AJOSTEP,AJOSEXEC SHOW MAY BE IN INTERP FROM NOW ON 30278000 NI AVTAGS1,255-AJORELOC SHOW NO RELOCATION 30280000 B REINRETA BRANCH TO EXIT CODE 30282000 SPACE 2 30284000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30286000 * PRE-ASSEMBLY -- REPLACEMENT PHASE A * 30288000 * THIS SECTION IS ENTERED JUST BEFORE A USER-WRITTEN REPLACE * 30290000 * CSECT IS ASSEMBLED. MAKE SURE THAT THE REAL ADCONS ARE IN * 30292000 * AVWXTABL (MAY HAVE BEEN CHANGED BY PREVIOUS REPLACE RUN), * 30294000 * AND SET FLAGS REQUIRED FOR REPLACEMENT. THIS INCLUDES * 30296000 * MAKING THE ASSEMBLER RELOACTE THE OBJECT CODE TO ITS * 30298000 * ACTUAL LOCATION IN MEMORY, SIMPLIFYING DUMP PRINTING AND * 30300000 * DATA TRANSFERS. * 30302000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30304000 REINPHSA EQU * ENTRY LABEL: REPLACE PHASE A 30306000 OI AVTAGS1,AJORELOC WE WANT USER PROGR AT REAL ADDRESS 30308000 * FALL THRU, HAVE ANY MODIFIED ADCONS RESTORED IF NEEDED. 30310000 SPACE 1 30312000 REINREAL BAL R14,REREAL HAVE REAL ADCONS REPLACED, IF NEED 30314000 REINRETA EQU * EXIT LABEL 30316000 REINRET $RETURN RGS=(R14-R12) 30318000 DROP R6,R11,RAT,R13 REMV USINGS 30320000 AIF (&$REPL LT 2).RESY1 SKIP IF NO CALLING ALLOWED 30322000 EJECT 30324000 **--> ENTRY: RESYMB ENTER CODE IN SYMBOL TABLE OF CALLABLE ENTRY. . 30326000 *. RESYMB IS CALLED FROM CVCON2 IF A SYMBOL FLAGGED EXTRN IS . 30328000 *. USED IN A VCON. IT PLACES A CODE INTO THE SYVALUE ENTRY OF THE . 30330000 *. SYMBOLS SYMSECT. THIS CODE (THE OFFSET TO A CALLABLE ENTRY . 30332000 *. ELEMENT IN THE SECOND SECTION OF RFSYMS), IS USED FOR CHECKING . 30334000 *. WHEN THE USER PROGRAM ACTUALLY CALLS THE ROUTINE. . 30336000 *. ENTRY CONDITIONS . 30338000 *. RA = @ SYMSECT FOR THE EXTRN SYMBOL. . 30340000 *. ALL OTHER REGS: SAME AS ASSEMBLER REGISTER CONVENTIONS. . 30342000 *. EXIT CONDITIONS . 30344000 *. RA = @ SAME SYMSECT, BUT CODE HAS BEEN ENTERED IN SYVALUE. . 30346000 *. RB = 0 IF SYMBOL WAS LEGITAMATE. . 30348000 *. = 4 IF SYMBOL WAS NOT LEGITAMETE ENTRY TO BE CALLED. . 30350000 *. NAMES: RES----- . 30352000 *. USES DSECTS: RFSYMBLK,SYMSECT . 30354000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30356000 SPACE 1 30358000 ENTRY RESYMB DECLARE HERE, SINCE MAY NOT EXIST 30360000 RESYMB $SAVE RGS=(R14-R6),SA=RESAVE,BR=R6 30362000 USING RESAVE,R13 NOTE FOR SAFETY 30364000 USING SYMSECT,RA NOTE SYMBOL TABLE PTR 30366000 L R3,RERFSYMS =V(RFSYMS) 30368000 USING RFSYMS,R3 NOTE PTR TO TABLE CSECT 30370000 LA R0,RFS$LEN INCREMENT FOR BXLE SEARCH 30372000 LA R1,RFSCALLZ-RFS$LEN LIMIT @ FOR BXLE 30374000 LA R2,RFSCALLA INDEX FOR BXLE 30376000 USING RFSYMBLK,R2 NOTE BLOCK PTR 30378000 SPACE 1 30380000 * SEARCH CALLABLE ENTRY TABLE FOR THE GIVEN ENTRY. 30382000 CLC RFSYMB,SYMBOL IS IT? (IGNORE 7-8 CHAR SYMBOLS) 30384000 BE RESFOUND YES, SKIP OUT 30386000 BXLE R2,R0,*-10 LOOP THROUTHE TABLE 30388000 SPACE 1 30390000 LA RB,4 COULDNT FIND IT, FLAG SO ANDRETRN 30392000 RESRETA EQU * EXIT LABEL 30394000 $RETURN RGS=(R14-R6) RTURN, RESTORE ALL BUT PARM REGS 30396000 SPACE 1 30398000 * SYMBOL FOUND - PUT OFFSET TO TABLE ELEMENT IN SYMTAB. 30400000 RESFOUND SR R2,R3 GET OFFSET FROM RFSYMS TO ELEMENT 30402000 ST R2,SYVALUE SAVE THIS AS SYMBOL VALUE 30404000 SR RB,RB CLEAR TO SHOW OK 30406000 B RESRETA GO RETURN 30408000 DROP R2,R3,R6,RA,R13 RFSYMBLK,RFSYMS,BASE1,SYMSECT,BASE2 30410000 .RESY1 ANOP 30412000 EJECT 30414000 **--> ENTRY: REENDA REPLACE MODULE: POST-ASSEMBLY PROCESSING . . . 30416000 *. REENDA IS CALLED JUST AFTER AN ASSEMBLY IS COMPLETED. . 30418000 *. IF THE RUN IS NOT A REPLACE RUN, NOTHING IS DONE. . 30420000 *. IF IT IS REPLACE PHASE A, THE ASSEMBLED PROGRAM WAS A REPLACE. 30422000 *. VERSION OF AN ASSIST MODULE, SO CHECK AND MODIFY ASSEMBLER ADCONS.. 30424000 *. IF THE RUN IS IN PHASE B, THE ASSEMBLY JUST FINISHED WAS . 30426000 *. A TEST PROGRAM, SO PRINT PERFORMANCE STATISTICS FOR THE MODULE. . 30428000 *. ENTRY CONDITIONS . 30430000 *. R11= @ AJOBCON (MAIN JOB CONTROL BLOCK). . 30432000 *. R12(RAT)= @ VWXTABL CSECT (AVWXTABL DSECT). . 30434000 *. CALLS SYFIND . 30436000 *. USES DSECTS: AJOBCON,AVWXTABL,RECORBLK,RFSYMBLK,SYMSECT . 30438000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30440000 REENDA $SAVE RGS=(R14-R12),BR=R6,SA=RESAVE 30442000 USING RESAVE,R13 NOTE 2ND BASE REGISTER 30444000 USING AVWXTABL,RAT NOTE MAIN ASSEMBLER TABLE USING 30446000 USING AJOBCON,R11 NOTE POINTER THERE 30448000 SPACE 1 30450000 * DETERMINE REPLACE PHASE (IF ANY). IF PHASE A, LINK 30452000 * REPLACEMENT PROGRAM. IF PHASE B, PRINT STATISTICS. 30454000 TM AJOMODE,AJOREPLF+AJOREPHB REPLACE STATUS 30456000 BZ REENRET NO REPLACE, DON'T DO ANYTHING 30458000 BO REEPHSB BOTH FLAGS==> PHASE B-BRANCH 30460000 SPACE 1 30462000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30464000 * POST-ASSEMBLY -- REPLACEMENT PHASE A * 30466000 * FIND CSECT NAME IN RFSYMS TABLE. CREATE A RECORBLK BLOCK * 30468000 * FOR EACH ENTRY POINT, FILLING IN VALUES. MODIFY THE ADCONS * 30470000 * IN AVWXTABL WHICH BELONG TO ENTRYPOINTS OF THE CSECT. * 30472000 * PRINT ERROR MESSAGES FOR ANY MISSING NAMES. * 30474000 * ***** PHASE A REGISTER USAGE ***** * 30476000 * R1 = @ RFSYMBLK OF CSECT, THEN ENTRY POINT BEING PROCESSED * 30478000 * R2 = INCREMENT FROM EACH CSECT ELEMENT TO THE NEXT DURING SEARCH. * 30480000 * R3 = OFFSET VALUE OF RECORBLK FROM BEGINNING OF RECORRAD * 30482000 * = NUMBER OF ENTRY ELEMENTS LEFT TO PROCESS FOR GIVEN CSECT * 30484000 * R4 = @ SYFIND. MUST BE SAVED HERE BECUASE IT IS LEGAL TO REPLACE * 30486000 * SYFIND, THUS LEADING TO INTERCEPTED CALL WHEN SYFIND IS * 30488000 * CALLED TO LOOKUP SYEND2, WITH ADCON ALREADY MODIFIED. * 30490000 * R5 = @ RECORBLK ELEMENT IN RECORRAD OF ENTRY BEING PROCESSED * 30492000 * R7(RA)= @ ENTRYPOINT SYMSECT, THEN ADDRESS OF THAT ENTRY * 30494000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30496000 SPACE 1 30498000 * INITIALIZE FOR SEARCH FOR AJOREPL IN RFSYMS LIST. 30500000 L R1,RERFSYMS GET ADCON FOR RFSYMS 30502000 SR R2,R2 CLEAR FOR INSERTIONS 30504000 LA R3,RFSYMS$L-RFS$LEN(R1) ADEQUATE LIMIT FOR BXLE 30506000 USING RFSYMBLK,R1 OVERLAY DSECT ON 1ST SECTION RFSYMS 30508000 L R4,AXSYFIND =V(SYFIND), GET IT NOW, SO SAFE 30510000 EJECT 30512000 * SEARCH FOR CSECT NAME TO BE REPLACED. 30514000 * LOOK AT EACH CSECT NAME IN RFSYMS, UNTIL ONE IS FOUND 30516000 * WHICH IS IN THE SYMBOL TABLE AND DECLARED CSECT. 30518000 REESEARC LA RA,RFSYMB SHOW @ OF CSECT NAME 30520000 LA RB,L'RFSYMB SHOW LENGTH OF IT (ALWAYS 6) 30522000 LR REP,R4 REP= =V(SYFIND). MOVE OVER FOR CALL 30524000 BALR RET,REP CALL SYFIND TO LOOKUP THE SYMBOL 30526000 L R11,AVAJOBPT RESTORE THE PTR IN CASE NEEDED 30528000 SPACE 1 30530000 LTR RB,RB WAS THE SYMBOL IN THE SYMBOL TABLE 30532000 BNZ REESEARE NO, SO SKIP TO LOOK AT NEXT ONE 30534000 USING SYMSECT,RA NOTE SYMBOL TABLE PTR, IT WAS IN 30536000 TM SYFLAGS,$SYCSE WAS IT FLAGGED A CSECT (A MUST) 30538000 BO REEFOUND YES, THIS IS ONE WE'RE LOOKING FOR 30540000 DROP RA REMOVE SYMSECT USING 30542000 SPACE 1 30544000 REESEARE IC R2,RFSENTL GET LENGTH OF CSECT+ENTRY ENTIRES 30546000 BXLE R1,R2,REESEARC ADD INCREM TO NEXT CSECT, LOOP OK 30548000 SPACE 1 30550000 * FALLS THRU==> CSECT NAME TO BE REPLACED NOT FOUND. 30552000 * FLAG PROGRAM UNEXECUTABLE, NEVER ENTER PHASE B. 30554000 OI AVTAGS1,AJNLOAD SHOW THE REPLACE PROG NOGOOD,NO EXEC 30556000 REPRNT REZAR100,L'REZAR100 MISSING NAME MESSAGE 30558000 B REENRET RETURN, NO ADCONS CHANGED 30560000 SPACE 1 30562000 * CSECT NAME FOUND, NOW LINK ITS ENTRY POINTS IN VWXTABL. 30564000 REEFOUND MVC REZCSECT,RFSYMB MOVE REPLACED CSECT NAME OVER 30566000 REPRNT REZAR000,REZ000L PRINT MESSAGE WITH CSECT NAME 30568000 SPACE 1 30570000 IC R2,RFSENTN GET # ENTRIES BELONGING TO CSECT 30572000 STH R2,RECORNUM STORE COUNT INTO CORRESPONDENCE # 30574000 MVC REFRIAD,RFSRIAD SAVE @ OFFSET TO CALL LIST CHK VALS 30576000 LA R1,RFS$LEN(R1) SET RFSYMBLK TO 1ST ENTRY-TYPE ENTRY 30578000 LA R5,RECORRAD INIT TO BEGINNING @ OF CORRES TABLE 30580000 USING RECORBLK,R5 NOTE DSECT PTR 30582000 SR R3,R3 CLEAR, WILL BE INDEX TO RECORRAD 30584000 SPACE 1 30586000 * LOOP THRU ENTRY LIST. LOOK EACH ONE UP IN SYMBOL 30588000 * TABLE. OBTAIN EACH ENTRY POINT @ AND CREATE A RECORBLK 30590000 * ELEMENT FOR IT. MODIFY ADCON IN AVWXTABL. 30592000 REESYCAL LA RA,RFSYMB @ SYMBOLIC ENTRYPT NAME 30594000 LA RB,L'RFSYMB LENGTH OF NAME(ALWAYS 6) 30596000 * SYFIND MAY ERASE REGISTERS RA-RE (R7-R11). 30598000 LR REP,R4 REP= =V(SYFIND). MOVE OVER FOR CALL 30600000 BALR RET,REP CALL SYFIND TO LOOKUP THE SYMBOL 30602000 L R11,AVAJOBPT RESTORE R11 IN CASE WE NEED IT 30604000 LTR RB,RB WAS IT THERE 30606000 BNZ REENOENT NO, UNDEFINED, NOT IN TABLE AT ALL 30608000 USING SYMSECT,RA NOTE SYMBOL TABLE POINTER 30610000 TM SYFLAGS,$SYDEF WAS SYMBOL DEFINED 30612000 BZ REENOENT NO,FLAG IT 30614000 TM SYFLAGS,$SYENT+$SYCSE WAS IT EITHER CSECT OR ENTRY 30616000 BZ REENOENT NO, SO FLAG IT 30618000 L R7,SYVALUE GET VALUE OF SYMBOL, FOR ENTRY 30620000 DROP RA NO MORE SYMBOL DSECT 30622000 B REENLINK BRANCH TO LINKAGE SEGMENT 30624000 EJECT 30626000 * ENTRY NOT FOUND OR UNDEFINED - PRINT MESSAGE, FLAG. 30628000 REENOENT MVC REZEN002,RFSYMB MOVE THE ENTRY NAME OVER 30630000 REPRNT REZAR002,REZ002L MESSAGE SHOWING ENTRY NOT FOUND 30632000 L R7,AWFM1 TO GO INTO RECFPSW, SHOW NOGOOD 30634000 SPACE 1 30636000 * LINK NEEDED POINTERS AND CORRESPONDENCE TABLE RECORRAD. 30638000 REENLINK MVC RECSYMB(RFS$LEN),RFSYMB MOVE RFSYMBLK OVER 30640000 ST R7,RECFPSW SAVE ENTRYPT IN USER PROGRAM 30642000 LH R14,RECAXAD GET OFFSET INTO AVWXTABL FOR ADCON 30644000 LA R14,AX$BASE(R14) GET ACTUAL @ OF THE ADCON 30646000 MVC RECADRE,0(R14) SAVE THE REAL ADCON 30648000 MVC RECINSTS(RECZ$L),AWZEROS ZERO STATS COUNTERS 30650000 * FILL IN AVWXTABL WORD- @ REFAKE, OFFSET ID OF ENTRYPT 30652000 MVC 0(4,R14),REREFAKE PUT IN @ FAKE/CHECK ROUTINE 30654000 STC R3,0(,R14) STORE RECORBLK OFFSET INTO ADCON BYT 30656000 SPACE 1 30658000 * CHECK IF ENTRY OK, PRINT MESSAGE IF SO. 30660000 LTR R7,R7 WAS ENTRY @ < 0 (I.E. NOT FOUND) 30662000 BM REENOENS NO, MESSAGE ALREADY PRINTED 30664000 LA R8,REZLOCAT SHOW @ FOR HEX CONVERSION 30666000 BAL R14,REXCON3 CONVERT TO HEX 30668000 MVC REZEN001,RFSYMB MOVE SYMBOL IN FOR ENTRY NAME 30670000 REPRNT REZAR001,REZ001L MESSAGE DESCRIBNG OK ENTRY 30672000 SPACE 1 30674000 REENOENS LA R1,RFS$LEN(R1) BUMP PTR TO NEXT RFSYMBLK ENTRY 30676000 LA R3,REC$LEN(R3) INCREMENT OFFSET VALUE IN RECORRAD 30678000 LA R5,REC$LEN(R5) BUMP PTR TO NEXT RECORBLK ELEMENT 30680000 BCT R2,REESYCAL GO BACK FOR NEXT ENTRY. LOOP ON # 30682000 DROP R1,R5 REMV RFSYMBLK,RECORBLK 30684000 SPACE 1 30686000 OI REFLAGS,READMOD SHOW WE'VE MODIFIED ADCONS 30688000 B REENRET RETURN TO CALLING PROGRAM 30690000 EJECT 30692000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30694000 * POST-ASSEMBLY -- REPLACEMENT PHASE B * 30696000 * PRINT STATISTICS OF USER-PROGRAM PERFORMANCE. * 30698000 * ***** PHASE B REGISTER USAGE ***** * 30700000 * R0,R1,R2,R8,R9 WORK REGISTERS * 30702000 * R4 = NUMBER OF RECORBLK ENTRIES LEFT TO PROCESS * 30704000 * R5 = @ RECORBLK OF ENTRY WHOSE STATISTICS ARE BEING CALCULATED. * 30706000 * R7 = @ 12-BYTE FIELD WHERE NEXT OUTPUT NUMBER TO BE PLACED * 30708000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30710000 REEPHSB REPRNT REZAR003,REZ003L PRINT HEADER LINE 30712000 LH R4,RECORNUM # ENTRY POINTS FOR LOOP COINTER 30714000 LA R5,RECORRAD INIT @ TO BEGINNING OF TABLE 30716000 USING RECORBLK,R5 NOTE POINTER 30718000 SPACE 1 30720000 REESTATS MVC REZ004EN,RECSYMB MOVE ENTRYPOINT NAME OVER 30722000 LA R7,REZ004NS @ 1ST OUTPUT NUMBER, INCRD BY DECO 30724000 SPACE 1 30726000 L R8,RECINSTS # INSTRUCTIONS DONE 30728000 BAL R14,REEXDECO PRINT IT, ADVANCE R7 PTR 30730000 SPACE 1 30732000 LR R1,R8 SAVE # INSTRUCTIONS DONE FOR LATER 30734000 LH R8,RECCALLS # CALLS TO ROUTINE 30736000 BAL R14,REEXDECO CONVERT # CALLS, ADVANCE R7 30738000 SPACE 1 30740000 LR R2,R8 SAVE # CALLS FOR LATER DIVIDESX 30742000 LH R8,RECWRONG GET # WRONG RETURN TIMES 30744000 BAL R14,REEXDECO CONVERT # WRONG, ADVANCE R7 30746000 SPACE 1 30748000 LR R9,R8 SAVE # WRONG 30750000 LTR R2,R2 WAS # CALLS ZERO 30752000 BNZ *+8 NO, SO LEAVE AS IS 30754000 LA R2,1 YES, =0, SO MAKE =1 FOR SAFE DIVIDES 30756000 SR R0,R0 CLEAR FOR DIVIDE SETUP 30758000 DR R0,R2 AVG # INSTRS/CALL 30760000 LR R8,R1 MOVE QUOTIENT OVER FOR CONVERT 30762000 BAL R14,REEXDECO CALL CONVERT ROUTINE, ADVANCE R7 30764000 SPACE 1 30766000 LA R8,100 VALUE FOR PERCENT CONVERT 30768000 MR R8,R8 # WRONG * 100, RESULT IN R9 30770000 DR R8,R2 #WRONG*100/#CALLS = PERCENT 30772000 LR R8,R9 MOVE QUOTIENT FOR CONVERT 30774000 BAL R14,REEXDECO CONVERT, ADVANCE R7 30776000 SPACE 1 30778000 REPRNT REZAR004,REZ004L PRINT MESSAGE FOR THIS ENTRY 30780000 LA R5,REC$LEN(R5) INCREMENT THE RECORBLK PTR 30782000 BCT R4,REESTATS LOOP BACK FOR NEXT RECORBLK VALS 30784000 DROP R5 DON'T NEED RECORBLK ANYMORE 30786000 SPACE 1 30788000 REENRET $RETURN RGS=(R14-R12) 30790000 DROP R6,R11,RAT,R13 DROP TABLE USINGS, BASE REGS 30792000 EJECT 30794000 **--> ENTRY: REFAKE INTERCEPT REPLACED CALLS, CHECK REAL/USER . . . 30796000 *. ENTRY CONDITIONS . 30798000 *. R15(BITS 0-7)= OFFSET CODE # FOR SPECIFIC ENTRY BEING CALLED. . 30800000 *. R0-R14 ARE AS DESCRIBED IN ASSEMBLER CALLING CONVENTIONS. . 30802000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30804000 SPACE 1 30806000 * * * * * REFAKE ENTRY REGISTER USAGE * * * * * * * * * * * * * * * * * 30808000 * R0,R1,R2,R3,R4,R15 WORK REGISTERS * 30810000 * R5 = @ RECORBLK ELEMENT FOR THE ENTRY POINT BEING CALLED. * 30812000 * R6 = FIRST BASE REGISTER, USED FOR MAIN CODE. * 30814000 * R9 = LINK REGISTER FOR INSUBS WHICH MUST CALL OTHERS WITH R14. * 30816000 * R10= @ ECONTROL (EXECUTION CONTROL BLOCK, USER PSEUDO REGISTERS. * 30818000 * R13= SAVE AREA @, ALSO SECOND BASE REGISTER, FOR INSUBS. * 30820000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30822000 SPACE 1 30824000 REFAKE $SAVE RGS=(R14-R6),BR=R6,SA=RESAVE SAVE ALL BUT PARM RGS 30826000 USING AVWXTABL,RAT NOTE MAIN ASM TABLE USING 30828000 USING RESAVE,R13 NOTE SECONDARY BASE REG USING 30830000 SPACE 1 30832000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30834000 * REFAKE IS ENTERED VIA A MODIFIED ADCON IN AVWXTABL, WHICH * 30836000 * ALSO CONTAINS THE OFFSET IN RECORRAD OF THE RECORBLK FOR THE * 30838000 * REPLACED ENTRY BEING CALLED. SET R5 TO THE @ THIS RECORBLK, TO BE* 30840000 * USED THROUGHOUT THIS CODE. CALL THE CORRESPONDING REAL ASSIST * 30842000 * ROUTINE. SAVE INITIAL PARM REGISTER VALUES AND THOSE RETURNED * 30844000 * BY REAL ROUTINE FOR TESTING, OR PRINTING. ALSO PRINT VARIOUS * 30846000 * REGISTER SETS OR THE CURRENT STATEMENT, IF REQUIRED BY SETTING * 30848000 * OF VARIOUS BITS IN ECRFLAG OF THE ECONTROL BLOCK. * 30850000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30852000 SPACE 1 30854000 STM RA,RE,REGSAVA SAVE ORIGINAL PARM REG VALUES 30856000 SRL R15,24 GET HI-ORDER BYTE BY ITSELF 30858000 LA R5,RECORRAD(R15) ADD OFFSET TO TABLE @==>@RECORBLK 30860000 USING RECORBLK,R5 NOTE @ TABLE ELEMENT 30862000 * INCREMENT TOTAL NUMBER OF TIMES CALLED. 30864000 LH R15,RECCALLS CURRENT TOTAL NUMBER OF CALLS 30866000 LA R15,1(R15) +1 FOR THIS TIME 30868000 STH R15,RECCALLS = NEW CURRENT TOTAL # CALLS 30870000 SPACE 1 30872000 * CALL THE REAL ASSIST ROUTINE FIRST. SAVE THE VALUES 30874000 * IT RETURNS IN REGISTERS RA-RE FOR LATER USE. 30876000 SPACE 1 30878000 L R15,RECADRE GET REAL ENTRY POINT @ 30880000 BALR RET,REP CALL THE REAL ROUTINE 30882000 STM RA,RE,REGSAVB SAVE THE RETURNED PARAMETERS 30884000 SPACE 2 30886000 * ENTRY ACCEPTED, SET UP FOR INTERPRETATION 30888000 L R11,AVAJOBPT GET PTR TO ,AIN CONTROL BLOCK 30890000 USING AJOBCON,R11 NOTE PTR 30892000 L R10,AJOECOPT GET PTR TO PARTIALLY-FILLED ECONTROL 30894000 USING ECONTROL,R10 NOTE PTR 30896000 EJECT 30898000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30900000 * DEPENDING ON ECRFLAG (WHICH CAN BE CHANGED BY THE USER PROG * 30902000 * DURING EXECUTION), PRINT THE CURRENT CARDIMAGE (IF ANY), THE 5 * 30904000 * PARAMETER REGISTERS ON ENTRY, AND/OR THE PARAMETER REGISTERS * 30906000 * RETURNED BY THE REAL ASSIST ROUTINE. * 30908000 * THEN FLIP THESE BIT FLAGS, SO THAT IF AN ERROR OCCURS, WE * 30910000 * CAN PRINT ANYTHING WE DIDN'T ALREADY PRINT . * 30912000 * INIT REFPRT BIT IN REFLAGS OFF. USE OF REXPRINT INSUB * 30914000 * SETS THIS BIT ON. IF IT IS ON WHEN REFAKE EXITS, 2 LINES ARE* 30916000 * SKIPPED TO SEPARATE OUR MESSAGES FROM FOLLOWING LISTING. THE * 30918000 * LISTING IS VERY HARD TO FOLLOW IF THIS IS NOT DONE. * 30920000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30922000 NI REFLAGS,255-REFPRT INIT FLAG TO SHOW NO MSGS PRT YT 30924000 MVC REFRFLAG,ECRFLAG SAVE THE BYTES FOR LATER 30926000 BAL R9,REFRFC CALL INSUB FOR 3 CHECKS/PRINTS 30928000 XI REFRFLG1,ECR$REGB+ECR$REGA+ECR$CARD FLIP BITS 30930000 SPACE 2 30932000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30934000 * FINISH CONSTRUCTION OF ECONTROL FOR INTERPRETIVE CALL TO * 30936000 * USER-WRITTEN REPLACEMENT PROGRAM. CALL THE INTERPRETER, WITH THE * 30938000 * USER PROGRAM AS ARGUMENT. INCREMENT STATISTICS, AND BRANCH TO * 30940000 * PROCESS POSSIBLE ERROR IF ANY BUT NORMAL RETURN INDICATED. * 30942000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30944000 SPACE 1 30946000 * TEST USER ENTRYPT TO MAKE SURE HAS BEEN FOUND. 30948000 CLI RECFPCC,0 WAS BYTE 0, I.E. LEGAL @ 30950000 BNE REFNOCAL NO, SO QUIT NOW, CAN'T EXECUT 30952000 SPACE 1 30954000 MVC ECFENTER,RECFPSW INIT ENTRY POINT TO RIGHT @ 30956000 MVI ECFLAG0,$ECSPIEB+$ECEOF SET FLAG PROPERLY 30958000 SPACE 1 30960000 * INITIALIZE REGISTER CONTENTS FOR USER PROGRAM. 30962000 MVC ECREGS(7*4),REFILLRG PUT IN REGISTER FILLER 30964000 MVC ECREGRA(5*4),REGSAVA MOVE ORIG PARM REGS TO FAKE 30966000 MVC ECFPREGS(32),ECREGS PUT 4'S OVER HERE ALSO 30968000 ST RAT,ECREG12 SAVE AVWXTABL PTR HERE 30970000 MVC ECREG13,ECSAVE1 MOVE @ DUMMY SAVEAREA INTO FAKE 13 30972000 MVC ECREG14,RERFSYMS PUT DISTINCT, EASY-TO-CHECK RET @ 30974000 MVC ECREG15,ECFENTER PUT ENTRY PT @ IN FAKE R15 30976000 SPACE 1 30978000 REEXECUT EQU * ENTER HERE AFTER USER CALLED AN 30980000 * ASSIST MODULE AND IT REURNED OK 30982000 L REP,AJOEXECU =V(EXECUT) PUT IN ADCON 30984000 BALR RET,REP CALL THE INTERPRETER 30986000 SPACE 1 30988000 * UPDATE TOTAL NUMBER OF INSTRUCTIONS PERFORMED. 30990000 LM R14,R15,ECILIMT GET ECILIMT-ECILIMP 30992000 SR R15,R14 # INSTRUCTIONS EXECUTED THIS TIME 30994000 A R15,RECINSTS + CUMULATIVE TOTAL FROM BEFORE 30996000 ST R15,RECINSTS = NEW CUMULATIVE TOTAL INSTRUCTIONS 30998000 SPACE 1 31000000 MVI RERGEFLG,0 ZERO OUT RETURN CODE FLAG 31002000 MVC REZ059MS(REZ059ML),AWBLANK BLANK OUT MESSAGE AREA 31004000 SPACE 1 31006000 CLI ECFLAG1,$ECBRN14 WAS A PROPER RETURN DONE 31008000 BNE REFNORET NO GOOD RETURN-BRANCH 31010000 EJECT 31012000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31014000 * CHECKING SECTION FOR USER-RETURNED REGISTERS * 31016000 * 1. CALL INSUB RGENTS TO CHECK REGS RA-RE FOR INDIVIDUAL CASES* 31018000 * 2. MAKE COMMON CHECK FOR MODIFIED REGS - R0-R6, R12, R13. * 31020000 * 3. SET ECRFLAG IF NEEDED AND PRINT MESSAGE AR059 AND OTHER * 31022000 * MESSAGES, IF THERE WERE ONE OR MORE ERRORS. * 31024000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31026000 LH R15,RECRGAD GET OFFSET FOR SPECIFIC ERROR 31028000 BAL R14,RGENTS CALL CHECKING ROUTINE.INITS RERGEFLG 31030000 SPACE 1 31032000 NI ECRFLAG+1,255-ECR$ERRC INIT TO SHOW NO ERRORS 31034000 SPACE 1 31036000 CLC ECREGS(7*4),REFILLRG MAKE SURE DIDN'T MESS UP 31038000 BE *+14 OK, SKIP ERROR 31040000 OI RERGEFLG,RGE06 FLAG THIS ERROR 31042000 MVC REZ059R0,=C'R0-R6' MOVE MESSAGE IN 31044000 SPACE 1 31046000 BAL R14,REGC1213 CALL R1K R13 CHECKER 31048000 SPACE 1 31050000 TM RERGEFLG,X'FF' WERE THERE ANY ERRORS AT ALL 31052000 BZ REFNOERR NO, SO SKIP PRINTING 31054000 SPACE 1 31056000 OI ECRFLAG+1,ECR$ERRC SET ERROR FLAG FOR THE USER 31058000 BAL R9,REFRFC PRINT OUT ANYTHING NOT ALREADY DONE 31060000 B REF059PR SKIP TEST, GO PRINT AR058-AR059 31062000 SPACE 1 31064000 * TEST FOR PRINTING REGS RETURNED BY USER PROGRAM. 31066000 REFNOERR TM ECRFLAG+1,ECR$REGC DID HE WANT TO SEE RETURN REGS 31068000 BZ REFRFZ08 NO, SKIP 31070000 SPACE 1 31072000 REF059PR MVI REZ05XN,C'8' SHOW AR058 MESSAGE 31074000 BAL R14,REREGSRA CALL REREGS, PRINT ECREGSRA- 31076000 REFRFZ08 EQU * BRANCH LABEL IF PREVIOUS CODE SKIPPE 31078000 SPACE 1 31080000 TM RERGEFLG,X'FF' WERE THERE ANY ERRORS 31082000 BZ REFNOERS NO ERRORS, BRANCH OUT AGAIN 31084000 SPACE 1 31086000 * AR058 MESSAGE JUST PRINTED. ADD AR059 WITH ERROR FLAGS. 31088000 BAL R9,REGCRARE CALL TO CHK BITS, FLAG, PRINT AR059 31090000 SPACE 1 31092000 LH R1,RECWRONG GET CURRENT # WRONG 31094000 LA R1,1(R1) +1 FOR THIS TIME 31096000 STH R1,RECWRONG = NEW TOTAL # WRONG 31098000 B REFARETA GO RESTORE PARM REGS, RETURN 31100000 EJECT 31102000 * EXIT TAKEN IF UNFOUND ENTRY POINT CALLED DURING EXEC. 31104000 REFNOCAL EQU * CALLED ENTRY NOT FOUND EXIT 31106000 MVC REZEN101,RECSYMB MOVE NAME OF ENTRY OVER-ERROR 31108000 REPRNT REZAR101,REZ101L PRINT UNFOUND ENTRY CALLED DURING EX 31110000 LM R14,R15,ECRDLIML ECRDLIML-H - DUMP LIMITS 31112000 XSNAP T=(PR,FL,1),STORAGE=(*0(R14),*0(R15)), #31114000 LABEL='REPLACE MONITOR AR101 DUMP' 31116000 B REFAREAL GO RESTORE ADCONS 31118000 SPACE 2 31120000 REFNORET EQU * BRANCH HERE IF NOT RIGHT RETURN 31122000 AIF (&$REPL LT 2).REFNOBR SKIP IF CAN'T CALL OTEHRS 31124000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31126000 * CHECK USER FOR CALLING ASSIST ROUTINE PROPERLY * 31128000 * CHECK USER ROUTINE FOR BRANCHING OUT IF ITSELF, USING A LEGAL* 31130000 * OFFSET CODE GIVEN TO IT BY RESYMB. * 31132000 * REGISTER USAGE IN CALL CHECKING SECTION * 31134000 * R4 = @ RFSYMBLK OF CALLED ROUTINE (SECTION 2 OR RFYSMS). * 31136000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31138000 SPACE 1 31140000 CLI ECFLAG1,$ECBROUT WAS ERROR BRANCH OUT OF RANGE 31142000 BNE REFABEND NO, SO MUST BE ACTUAL ERROR 31144000 SPACE 1 31146000 LH R15,REFRIAD GET OFFSET TO RI&CSECT IF ANY 31148000 LTR R15,R15 IS THIS CSECT ALLOWED TO CALL 31150000 BZ REFABEND =0 ==> CAN'T CALL-BRANCH -ERROR 31152000 SPACE 1 31154000 L R1,RERFSYMS =V(RFYSMS), @ CONTROL TABLE 31156000 LH R0,0(R15,R1) GET # ENTRY PTS CALLABLE FROM CSECT 31158000 L R4,ECREG15 GET USER REGISTER 15 31160000 LA R4,0(R4) REMOVE ANY GARBAGE FROM FRONT 31162000 SPACE 1 31164000 * SEE IF USER BRANCHED TO LEGAL OFFSET GIVEN HIM BY RESYMB 31166000 REHSEARC LA R15,2(R15) INCREMENT COUNTER TO NEXT HALF 31168000 LH R2,0(R15,R1) GET NEXT VALUE, EXPAND 31170000 CR R4,R2 WAS VALUE THE SAME 31172000 BE *+12 YES, ITS OK, SO JUMP OUT OF LOOP 31174000 BCT R0,REHSEARC LOOP BACK FOR LIST OF CALLABLES 31176000 B REFABEND VALUE WASN'T ONE OF OURS-QUIT 31178000 SPACE 1 31180000 * OFFSET INTO SECTION 2 OF RFSYMS CHECKED AND OK. 31182000 AR R4,R1 ADD =V(RFYSMS), GET @ ELEMENT 31184000 DROP R5 TEMPORARILY REMOVE USING FOR USER 31186000 USING RFSYMBLK,R4 NOTE PTR TO CALLED ASSIST PROG 31188000 LH R15,RFSRHAD GET OFFSET OF CHECKING CODE 31190000 BAL R14,RHENTS CALL CHECKER, NOTE RERGEFLG =0 ALRED 31192000 SPACE 1 31194000 BAL R14,REGC1213 GET R12 CHECKED, R13 PARTIALLY 31196000 TM RERGEFLG,RGE13 WAS R13 FLAGGED 31198000 BZ REHN13 NO, SO IT WAS OLD SA PTR, OK 31200000 SPACE 1 31202000 TM ECREG13+3,3 AS IT ON F BOUNDARY 31204000 BNZ REHN13 NO, ERROR, LEAVE IT FLAGGED 31206000 L R15,ECREG13 GET USER R13 31208000 LA R15,0(R15) REMOVE LEADING BYTE 31210000 C R15,ECFADL LOWER THAN LOWEST USER @ 31212000 BL REHN13 OUT OF AREA, ALREADY MARKED,BR 31214000 C R15,ECFADHC COMPARE TO HIGH LIMIT FOR USER 31216000 BH REHN13 OUTSIDE, NOGOOD, LAREADY FLAGGED 31218000 NI RERGEFLG,255-RGE13 IN USER AREA, OS OK, REMOVE FLAG 31220000 MVC REZ05913,AWBLANK REMOVE R13 MESSAGE TOO 31222000 EJECT 31224000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31226000 * IF USER WANTS TO SEE THEM, OR IF THERE IS AN ERROR, * 31228000 * PRINT PARAMETER REGISTERS PASSED BY USER PROGRAM. IF IN * 31230000 * ERROR, PRINT ERROR MESSAGE AND ABEND THE USER. IF CORRECT, * 31232000 * CALL THE ASSIST ROUTINE, AND PASS ITS ANSWERS BACK TO THE * 31234000 * USER PROGRAM. THE INTERPRETR CONTINUES FROM WHERE IT LEFT * 31236000 * OFF, WITHOUT REINITIALIZING INSTRUCTION STACK. * 31238000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31240000 SPACE 1 31242000 REHN13 TM ECRFLAG+1,ECR$REGD DID USER WANT REGS PRINTED ON CALL 31244000 BO REF050PR YES, OS GO PRINT 31246000 SPACE 1 31248000 TM RERGEFLG,X'FF' WAS NAYTHING WRONG WITH HIS REGS 31250000 BZ REHNOERS NO, SO LEGIT CALL, GO DO IT 31252000 SPACE 1 31254000 REF050PR MVI REZ05XN,C'0' SHOW AR050 MESSAGE 31256000 MVC REZ05XMS,=CL9'CALL TO' MOVE IN MESSAGE 31258000 MVC REZ05XEN,RFSYMB MOVE IN SYMBOL OF ENTRY CALLED 31260000 BAL R14,REREGSRA GO PRINT USER REGS OUT 31262000 SPACE 1 31264000 TM RERGEFLG,X'FF' WERE THER ANY ERRORS 31266000 BZ REHNOERS NO, USER JUST WANTED TO SEE, SKIP 31268000 SPACE 1 31270000 BAL R9,REGCRARE HAVE REGS RA-RE FLAGGED IF NEED,PRT 31272000 B REFABEND USER MADE HIS MISTAKE-ABEND 31274000 SPACE 1 31276000 REHNOERS LH R15,RFSAXAD OFFSET IN AVWXTABL OF V(REAL ROUT) 31278000 DROP R4 DON'T NEED CALLED RFSYMBLK ANYMORE 31280000 USING RFSYMBLK,R5 RESTORE NOREMAL USING FOR ELSEWHERE 31282000 L R15,AX$BASE(R15) GET ACTUAL @ CALLED ROUTINE 31284000 SPACE 1 31286000 LR R1,R10 SAVE @ ECONTROL 31288000 LM RA,R13,ECREGRA GET USER REGS RA-RE,R12,R13 31290000 USING ECONTROL,R1 TEMPORARY USING 31292000 DROP R10 REMOVE USING SO WE CAN USE R1 TEMPRL 31294000 DROP R13 WIPED OUT REG, SO ERASE USING 31296000 BALR R14,R15 CALL REAL ASSIST ROUTINE 31298000 SPACE 1 31300000 STM RA,RE,ECREGRA SAVE THE PARM REGS 31302000 LR R10,R1 GET @ ECONTROL BACK IN USUAL REG 31304000 DROP R1 REMOVE TGEMP USING 31306000 USING ECONTROL,R10 RESTORE NORMAL USING 31308000 L R11,AVAJOBPT GET @ AJOBCON BACK 31310000 LA R13,RESAVE GET @ OF OUR SAVE AREA BACK 31312000 USING RESAVE,R13 RESOTRE NORMAL USING HERE 31314000 SPACE 1 31316000 MVC ECPSWIAD,ECREG14+1 MOVE TO PSW @ SO STARTS THERE 31318000 B REEXECUT GO TO START INTEPRETER UP AGAIN 31320000 EJECT 31322000 .REFNOBR ANOP 31324000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31326000 * REFAKE EXIT CODE SECTIONS * 31328000 * IF USER ABENDED FOR ANY REASON, GIVE HIM A DUMP AND * 31330000 * HAVE ALL ADCONS REPLACED, THUS TERMINATING REPLACEMENT. * 31332000 * IN ANY CASE, PLACE THE CORRECT RETURN VALUES IN PARAMETER * 31334000 * REGISTERS RA-RE. THEN RETURN TO THE ASSIST ASSEMBLER * 31336000 * ROUTINE WHICH UNWITTINGLY CALLED REFAKE. * 31338000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31340000 SPACE 1 31342000 REFABEND EQU * USER PROGRAM ABEND EXIT 31344000 REPRNT REZAR102,REZ102L ABEND MESSAGE 31346000 BAL R9,REFRFC PRINT ANYTHING NOT ALREADY PRINTED 31348000 REFADUMP EQU * ENTER HERE TO DUMP USER AND RESTORE 31350000 LM R14,R15,ECRDLIML GET DUMP LIMITS 31352000 XSNAP T=(PR,FL,10),STORAGE=(*0(R14),*0(R15)) GIVE DUMP 31354000 REFAREAL EQU * ENTER HERE IF CANNOT USE DUMP ABOVE 31356000 BAL R14,REREAL CANCEL REPLACEMENT 31358000 SPACE 1 31360000 REFNOERS EQU * BRANCH HERE IF NO ERRORS IN REG CHEC 31362000 REFARETA EQU * EXIT LABEL FOR ENTIRE REFAKE 31364000 TM REFLAGS,REFPRT HAVE WE PRINTED ANY MESSAGE 31366000 BZ REFARETE NO, SO DON'T DO ANYTHING 31368000 REPRNT REZAR000,1 =C'0'. SKIP 2 LINES FOR READABLE 31370000 REFARETE EQU * BRANCH HERE IF DON'T HAVE TO SKIP 31372000 LM RA,RE,REGSAVB RELOAD REAL SUBR'S RIGHT PARM RGS 31374000 REFARET $RETURN RGS=(R14-R6) RESTORE ALL BUT PARM REGS 31376000 DROP R5,R6,R10,R11,RAT,R13 ERASE ALL USINGS 31378000 TITLE 'REPLACE MONITOR - INTERNAL DATA AREAS - BASE R13' 31380000 RESAVE DS 18F SAVE AREA, SECONDARY BASE REG 31382000 SPACE 1 31384000 REREFAKE DC A(REFAKE) ADCON TO PLACE INTO AVWXTABL 31386000 RERFSYMS DC V(RFSYMS) SYMBOLIC ENTRY TABLE CSECT 31388000 REFILLRG DC (7*4)AL1($PRGFILR) FILL CHARS FOR REGISTERS 31390000 REGSAVA DS 5F REGS RA-RE BEFORE REAL PROG CALLED 31392000 REGSAVB DS 5F REGS RA-RE AFTER CALL TO REAL SUBR 31394000 RECORRAD DS 0F,(REC$MAX)CL(REC$LEN) ADCON CORRESPONDENCE TABLE 31396000 REXFWORK DC F'0',X'04' WORKAREA, WITH REVERSED ' ' FOR HEX 31398000 REFLAGS DC B'0' FLAG BYTE 31400000 RECORNUM DC H'0' CURRENT # ENTRIES IN RECORRAD 31402000 REFRFLAG DS H SAVE AREA FOR ECRFLAG OVER CALL 31404000 REFRFLG1 EQU *-1 @ 2ND BYTE REFRFLAG, WHERE BITS ARE 31406000 REFRIAD DS H OFFSET @ FROM RFSYMS TO COUNT, THEN 31408000 * LIST OF OFFSETS TO RFSYMBLK ELEMENTS FOR CALLABLE SUBS 31410000 * FOR REPLACED CSECT. ONLY USED IF &$REPL=2. 31412000 RERGEFLG DS B FLAG FOR ERROR CONDTIONS IN USER RGS 31414000 SPACE 2 31416000 * INFORMATION, WARNING MESSAGES - AR00# MESSAGES. * 31418000 * ///AR000 - LIST NAME OF CSECT BEING REPLACED. * 31420000 * ///AR001 - LIST NAME AND LOCATION OF EACH ENTRY BEING REPPD. * 31422000 * ///AR002 - LIST NAME OF ENTRY REQUIRED BUT NOT FOUND. * 31424000 * ///AR003 - OUTPUT HEADER FOR PERFORMANCE STATISTICS * 31426000 * ///AR004 - LIST PERFORMANCE STATISTICS FOR SINGLE ENTRY. * 31428000 SPACE 1 31430000 REZAR000 DC C'0///AR000 REPLACE CSECT: ' 31432000 REZCSECT DC CL6' ',C' ///' 31434000 REZ000L EQU *-REZAR000 LENGTH OF MESSAGE 31436000 SPACE 1 31438000 REZAR001 DC C'0///AR001 REPLACE ENTRY: ' 31440000 REZEN001 DC CL6' ',C' AT LOCATION: ' 31442000 REZLOCAT DC XL6'0',C' ///' 31444000 REZ001L EQU *-REZAR001 LENGTH OF MESSAGE 31446000 SPACE 1 31448000 REZAR002 DC C'0///AR002 REPLACE ENTRY: ' 31450000 REZEN002 DC CL6' ',C' NOT FOUND AS CSECT OR ENTRY ///' 31452000 REZ002L EQU *-REZAR002 LENGTH OF MESSAGE 31454000 SPACE 1 31456000 REZAR003 DC C'0///AR003 STATISTICS : # INSTRUCTIONS # CALLS ' 31458000 DC C'# WRONG INSTRS/CALL % WRONG' 31460000 REZ003L EQU *-REZAR003 LENGTH OF MESSAGE 31462000 SPACE 1 31464000 REZAR004 DC C' ///AR004 ' 31466000 REZ004EN DC CL6' ',C' : ' SPACE OFR ENTRY NAME 31468000 REZ004NS DS 5ZL12 5 SLOTS FOR OUTPUT NUMBERS 31470000 DC C' %' 31472000 REZ004L EQU *-REZAR004 LENGTH OF MESSAGE 31474000 EJECT 31476000 * DEBUG SERVICE MESSAGES - AR05# MESSAGES AND ITEMS. 31478000 * ///AR050 - PARM REGISTERS ON CALL TO ANOTHER ROUTINE. * 31480000 * ///AR051 - CARDIMAGE BEFORE ENTRY TO ROUTINE. * 31482000 * ///AR052 - PARM REGISTERS BEFORE ENTRY TO ROUTINE. * 31484000 * ///AR054 - PARM REGISTERS RETURNED BY REAL ROUTINE. * 31486000 * ///AR058 - PARM REGISTERS RETURNED BY USER ROUTINE. * 31488000 * ///AR059 - REGISTER ERROR MESSAGE, SHOWING ONES IN ERROR * 31490000 SPACE 1 31492000 REZAR051 DC C'0///AR051 ON ENTRY TO ' 31494000 REZ051EN DC CL6' ',C' STMT ADDR: ' ENTRY NAME 31496000 REZ051AD DC XL6'0',C' ->' @ CARDIMAGE, PTR TO IT 31498000 REZ051CD DS CL71 SPACE FOR MOST OF CARD 31500000 REZ051L EQU *-REZAR051 LENGTH OF MESSAGE 31502000 SPACE 2 31504000 REZ05ENT DC C'ENTRY TO ' ... THESE TWO CONSTANTS MUST 31506000 REZ05EXT DC C'EXIT FROM' ... BE OF THE SAME LENGTH. 31508000 SPACE 1 31510000 REZAR05X DC C'0///AR05' HEADER BEGINNING 31512000 REZ05XN DC X'0',C' ON ' LAST DIGIT OF MESSAGE NUMBER 31514000 REZ05XMS DC CL(L'REZ05ENT)' ',C' ' 'ENTRY TO' OR 'EXIT FROM' 31516000 REZ05XEN DC CL6' ',C' REGISTERS RA-RE: ' ENTRY NAME 31518000 DC C'RA/7/: ' 31520000 REZ05XRG DC XL8'0',C' RB/8/: ',XL8'0',C' RC/9/: ',XL8'0',C' RD/A/: ' 31522000 DC XL8'0',C' RE/B/: ',XL8'0',C' ' 31524000 REZ05XL EQU *-REZAR05X LENGTH OF MESSAGE AREA 31526000 SPACE 1 31528000 REZAR059 DC C' ///AR059 WARNING: ERROR IN USER REGS: ' 31530000 REZ059MS EQU * BEGINNING OF AREA TO BE BLANKED 31532000 REZ059R0 DS C'R0-R6',C' ' ERR IN ANY OF THESE 31534000 REZ05912 DS C'R12',C' ' ASM TABLE REG-CAN'T CHANGE 31536000 REZ05913 DS C'R13',C' ' SAVE AREA PTR 31538000 ORG REZAR059+(REZ05XRG-REZAR05X) ORG TO SIMILAR OFFSET 31540000 REZ059RG EQU * BEGINNING OF MESSAGES FOR REGS 31542000 ORG REZAR059+REZ05XL LEAVE SAME AMOUNT OF SPACE 31544000 REZ059ML EQU *-REZ059MS LENGTH TO BLANK OUT 31546000 REZ059L EQU *-REZAR059 LENGTH OF MESSAGE 31548000 SPACE 2 31550000 * SEVERE ERROR MESSAGES - AR10# MESSAGES. * 31552000 * THESE ERRORS TERMINATE REPLACEMENT IMMEDIATELY. * 31554000 * ///AR100 - REPL= NAME COULD NOT BE FOUND. * 31556000 * ///AR101 - UNFINDABLE ENTRY NAME CALLED DURING EXECUTION. * 31558000 * ///AR102 - USER PROGRAM ABENDED. * 31560000 SPACE 1 31562000 REZAR100 DC C'0///AR100 REPLACE CSECT NOT FOUND - REPLACE ABORT ///' 31564000 SPACE 1 31566000 REZAR101 DC C'0///AR101 INVALID ENTRYPOINT NAME: ' 31568000 REZEN101 DC CL6' ',C' CALLED. REPLACE ACTION ABORTED ///' 31570000 REZ101L EQU *-REZAR101 LENGTH OF MESSAGE 31572000 SPACE 1 31574000 REZAR102 DC C'0///AR102 USER PROGRAM ABENDED DURING REPLACEMENT ///' 31576000 REZ102L EQU *-REZAR102 31578000 TITLE 'REPLACE MONITOR INTERNAL SUBROUTINES - BASE R13' 31580000 SPACE 1 31582000 * ***NOTE*** THE FOLLOWING USINGS ARE ASSUMED WHEN 31584000 * NECESSARY BY ANY OF THE INSUBS WHICH NEED THEM. 31586000 USING RECORBLK,R5 INDIVIDUAL ENTRY INFORMATION 31588000 USING ECONTROL,R10 EXECUTION CONTROL TABLE 31590000 USING AJOBCON,R11 JOB CONTROL TABLE PTR 31592000 USING AVWXTABL,RAT NOTE FOR REST OF CODE 31594000 USING RESAVE,R13 NOTE SECONDARY BASE REGISTER 31596000 SPACE 2 31598000 * ***** LIST OF INSUBS ***** * 31600000 * REEXDECO - CONVERT NUMBER FROM BINARY TO EDITED DECIMAL * 31602000 * REFRFC - PRINT REGISTER SETS DETERMINED BY USER * 31604000 * REGC1213 - CHECK USER REGS 12 AND 13, SET FLAGS * 31606000 * REGCRARE - TEST FLAGS FOR REGS RA-RE. FORMAT AND PRINT MSG * 31608000 * REREAL - RESTORE NORMAL ADDRESS CONSTANTS IN AVWXTABL * 31610000 * REREGS - FORMAT,PRINT PARM REGS. REREGSRA PRINTS ECREGRA- * 31612000 * REXCON3 - CONVERT REGISTER VALUE TO 3 BYTES OF HEXADECIMAL * 31614000 * REXPRINT - PRINT A LINE (CALLED BY REPRNT MACRO) * 31616000 * * 31618000 * RGENTS - RETURN VALUE CHECKING SECTION * 31620000 * RGRAADDR - (RGENTS INTERNAL) - CHECK RA FOR LEGAL SCAN PTR * 31622000 * RGRCADDR - (RGENTS INTERNAL) - CHECK RC FOR @ IN USER PROGR * 31624000 * * 31626000 * RHENTS - CHECK PARM REGS USER PASSED TO ASSIST SUBR. * 31628000 * RHRAADDR - (RHENTS INTERNAL) CHECK RA FOR LEGALITY * 31630000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31632000 SPACE 4 31634000 **--> INSUB: REEXDECO CONVERT NUMBER TO DECIMAL + + + + + + + + + + 31636000 *+ CALLED FROM REENDA, PHASE B, CONVERT NUMBER, ADVANCE PTR. + 31638000 *+ ENTRY CONDITIONS + 31640000 *+ R7 = @ 12-BYTE FIELD WHERE NUMBER SHOULD BE PLACED. + 31642000 *+ R8 = NUMBER TO BE CONVERTED TO DECIMAL AND PLACED AT 0(R7). + 31644000 *+ R14= RETURN @ TO CALLING CODE IN REENDA. + 31646000 *+ EXIT CONDITIONS + 31648000 *+ R7 = INPUT VALUE OF R7 + 12, I.E., ADVANCED 1 POSITION. + 31650000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31652000 SPACE 1 31654000 REEXDECO XDECO R8,0(R7) CONVERT NUMBER 31656000 LA R7,12(R7) INCREMENT FIELD POINTER 31658000 BR R14 RETURN 31660000 EJECT 31662000 **--> INSUB: REFRFC TEST ECRFLAG AND PRINT NEEDED INFOR + + + + + + 31664000 *+ ENTERED BEFORE USER PROGRAM EXECUTION (AND POSSIBLY AFTER, + 31666000 *+ IF IT ABENDED), TO PRINT STATEMENT/AND/OR REGISTERS. + 31668000 *+ ENTRY CONDITIONS + 31670000 *+ R9 = RETURN @ TO CALLING CODE. + 31672000 *+ R10= @ ECONTROL + 31674000 *+ EXIT CONDITIONS + 31676000 *+ R7,R8,R14,R15 MAY BE CHANGED. + 31678000 *+ MESSAGES AR051, AR052, AND/OR AR054 MAY BE PRINTED. + 31680000 *+ MAY CALL INSUBS REREGS,REXCON3,REXPRINT. + 31682000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31684000 SPACE 1 31686000 * TEST FOR CARDIMAGE PRINTING AND DO IT IF NEEDED. 31688000 * **NOTE** REQUIRES AVRSBPT=0 IF NO CARD YET PROCESSED. 31690000 REFRFC TM REFRFLG1,ECR$CARD DOES HE WANT CARDIMAGE 31692000 BZ REFRFZ01 NO, SO SKIP ENTIRELY 31694000 L R8,AVRSBPT GET @ RSBLOCK, IF ANY 31696000 LTR R8,R8 =0 IF THERE ISN'T ANY CARD YET 31698000 BZ REFRFZ01 NO CARDIMAGE, CAN'T PRINT-BRANCH 31700000 USING RSBLOCK,R8 NOTE POINTER TO RSBLOCK 31702000 SPACE 1 31704000 MVC REZ051EN,RECSYMB MOVE ENTRY NAME INTO MESSAGE 31706000 SR R7,R7 CLEAR FOR INSERTION 31708000 IC R7,RSBLENG GET LENGTH-1 OF ENTRIE BLOCK 31710000 SH R7,=AL2(RSB$L) - LENGTH BEFORE CARDIMAGE STARTS 31712000 LA R15,RSOL1-1 LENGTH-1 OF SINGLE CARD (MAX ALLWD) 31714000 CR R7,R15 WAS ACTUAL L-1 > MAX 31716000 BNH *+6 NO, SKIP, USE ACTUAL L-1 31718000 LR R7,R15 YES, USE JUST 1 CARD OF SEVERAL 31720000 SPACE 1 31722000 MVC REZ051CD,AWBLANK BLANK PUT THE CARDIMAGE 31724000 STC R7,*+5 STORE LENGTH-1 INTO NEXT MVC 31726000 MVC REZ051CD($),RSBSOURC MOVE VARIABLE SIZE CARD OVR 31728000 REFRFX01 LA R7,RSBSOURC PUT @ IN REG FOR CONVERSION 31730000 DROP R8 DON'T NEED RSBLOCK USING ANY MORE 31732000 LA R8,REZ051AD SHOW @ WHERE CONVERTED VALUE GOES 31734000 BAL R14,REXCON3 CALL CONVERT ROUTINE 31736000 REPRNT REZAR051,REZ051L PRINT CARDIMAGE, MESSAGE 31738000 REFRFZ01 EQU * BRANCH LABEL, PREVIOUS CODE SKIPPED 31740000 EJECT 31742000 * TEST FOR INITIAL REGISTER VALUE PRINTING. 31744000 MVC REZ05XEN,RECSYMB MOVE ENTRY NAME NOW. CAN USE # TIMES 31746000 TM REFRFLG1,ECR$REGA DOES HE WANT INPUT REGISTERS 31748000 BZ REFRFZ02 NO, SO DON'T DO IT, BRANCH 31750000 SPACE 1 31752000 MVC REZ05XMS,REZ05ENT MV ENTRY TO MESSAGE IN 31754000 MVI REZ05XN,C'2' MAKE MESSAGE ***AR052 31756000 LA R7,REGSAVA SHOW @ BLOCK OF 5 ORIGINAL REGS 31758000 BAL R14,REREGS CALL REGISTER CONVERT AND PRINT CODE 31760000 REFRFZ02 EQU * BRANCH LABEL FOR SKIP PREVIOUS CODE 31762000 SPACE 1 31764000 * TEST FOR PRINTING OF REGS RETURNED BY REAL PROGRAM. 31766000 MVC REZ05XMS,REZ05EXT PUT 'EXIT FROM' IN NOW 31768000 TM REFRFLG1,ECR$REGB DOES HE WANT RETURNED VALUES 31770000 BCR Z,R9 NO RETURN TO CALLER 31772000 SPACE 1 31774000 MVI REZ05XN,C'4' MESSAGE IS ***AR054 31776000 LA R7,REGSAVB SHOW @ 5 REGISTERS 31778000 BAL R14,REREGS CALL REG CONVERT AND PRINT 31780000 BR R9 RETURN TO CALLER 31782000 EJECT 31784000 **--> INSUB: REGCRARE USING RERGEFLG, FLAG AND PRINT REG MSG + + + + 31786000 *+ **NOTE** SEE SECTION RGENTS FOR RGE-- FLAGS, AS FOLLOWING + 31788000 *+ CODE MAY NOT BE OBVIOUS WITHOUT THEM. + 31790000 *+ ENTRY CONDITIONS + 31792000 *+ R9 = RETURN @ TO CALLING CODE + 31794000 *+ RERGEFLG IS NONZERO, I.E. AT LEAST 1 ERROR EXISTS. + 31796000 *+ EXIT CONDITIONS + 31798000 *+ REZAR059 MESSAGE IS COMPLETED AND PRINTED. + 31800000 REGCRARE IC R0,RERGEFLG GET THE FLAG, WITHS BITS POSS IN 3-7 31802000 SLL R0,32-5 SHIFT SO 5 BITS AT LEFT END OF REG 31804000 LA R1,REZ059RG @ 1ST SLOT FOR FLAGGING 31806000 SPACE 1 31808000 REFRAREF ALR R0,R0 SET CC BY 1ST BIT, REST OF REG 31810000 BC Z+M,*+10 SKIP IF 1ST BIT=0, NOT ERROR 31812000 MVC 0(8,R1),=8C'$' FLAG THIS REG 31814000 LA R1,8+8(R1) INCREMENT POINTER TO NEXT AREA 31816000 BC M+O,REFRAREF LOOP BACK IF ANY MORE TO DO 31818000 SPACE 1 31820000 REPRNT REZAR059,REZ059L PRINT ERROR FLAG LINE 31822000 BR R9 RETURN TO CALLER 31824000 SPACE 4 31826000 **--> INSUB: REGC1213 CHECK USER REGS 12-13,FLAG RERGEFLG + + + + + + 31828000 *+ ENTRY CONDITIONS + 31830000 *+ R14= RETURN @ TO CALLING CODE + 31832000 *+ REZAR059MS IS ASSUMED TO BE BLANKED OUT + 31834000 *+ EXIT CONDITIONS + 31836000 *+ RERGEFLG MAY BE FLAGGED WITH RGE12 OR RGE13 OR BOTH + 31838000 *+ REZ059MS MAY CONTAIN REGISTER FLAGS R12 OR R13 + 31840000 *++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31842000 SPACE 1 31844000 REGC1213 C RAT,ECREG12 DID HE LEAVE R12 ALONE 31846000 BE *+14 YES, SKIP 31848000 OI RERGEFLG,RGE12 SHOW R12 IN ERROR 31850000 MVC REZ05912,=C'R12' SHOW ERROR MESSAGE 31852000 SPACE 1 31854000 CLC ECREG13,ECSAVE1 DID HE SAVE SA PTR OK 31856000 BCR E,R14 YES, OK, RETURN 31858000 OI RERGEFLG,RGE13 NO, MODIFIED R13 ERROR 31860000 MVC REZ05913,=C'R13' SHOW ERROR MESSAGE 31862000 BR R14 RETURN TO CALLER 31864000 EJECT 31866000 *+--> INSUB: REREAL REPLACE REAL ADCONS IN VWXTABL IF NOT THERE. + 31868000 *+ ENTRY CONDITIONS + 31870000 *+ R11= @ AJOBCON JOB CONTROL TABLE. + 31872000 *+ R12(RAT)= ADDRESS OF VWXTABL CSECT (FOR DSECT AVWXTABL) + 31874000 *+ R14= RETURN ADDRESS TO CALLING CODE IN REMONI + 31876000 *+ EXIT CONDITIONS + 31878000 *+ ALL ADCONS IN VWXTABL ARE CORRECT, REFLAGS IS MARKED UNMODIFIED. + 31880000 *+ AJOSTEP IS FLAGGED TO SHOW NOT IN EXECUTION PHASE FOR SURE. + 31882000 *+ USES REGS: R0,R1,R2,R15 + 31884000 *+ USES DSECTS: AVWXTABL,RECORBLK + 31886000 *++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31888000 REREAL EQU * ENTRY FOR RESTORATION 31890000 NI AJOSTEP,255-AJOSEXEC REMOVE INTERP FLAG FOR SURE 31892000 TM REFLAGS,READMOD HAVE ADCONS BEEN MODIFIED 31894000 BCR Z,R14 NO,JUST RETURN TO CALLER 31896000 * INITIALIZE FOR LOOP TO RESTORE ADCONS. 31898000 LH R0,RECORNUM GET # ENTRIES IN RECORRAD 31900000 LA R1,RECORRAD GET @ 1ST ENTRY IN RECORRAD 31902000 USING RECORBLK,R1 NOTE DSECT POINTER 31904000 DROP R5 ZAP NORMAL USING SO WE CAN USE R1 31906000 SPACE 1 31908000 * LOOP, RESTORING ADCONS FROM RECORRAD BACK TO VWXTABL. 31910000 REREALA LH R2,RECAXAD GET ADCON OFFSET VALUE 31912000 L R15,RECADRE GET ADCON FROM TABLE 31914000 ST R15,AX$BASE(R2) STORE ADCON BACK IN ORIGINAL LOCAT 31916000 LA R1,REC$LEN(R1) BUMP DSECT POINTER TO NEXT ONE 31918000 BCT R0,REREALA LOOP ON # ENTRIES IN RECORRAD TABLE 31920000 SPACE 1 31922000 NI REFLAGS,255-READMOD SHOW VWXTABL NOW IN UNMODIFIED STATE 31924000 BR R14 RETURN TO CALLING SECTION 31926000 DROP R1 KILL USING 31928000 USING RECORBLK,R5 RESORE NORMAL USING FOR REST OF INSU 31930000 EJECT 31932000 **--> INSUB: REREGS FORMAT PARAMETER REGS AND PRINT THEM + + + + + 31934000 *+ CONVERTS BLOCK OF 5 REGISTERS TO HEXADECIMAL, PLACES THEM + 31936000 *+ IN LOCATIONS IN MESSAGE AREA REZAR05X, AND PRINTS MESSAGE. + 31938000 *+ ENTRY CONDITIONS + 31940000 *+ R7 = @ 5-WORD BLOCK OF REGISTERS TO BE PRINTED + 31942000 *+ R14= RETURN @ TO CALLING CODE + 31944000 *+ EXIT CONDITIONS + 31946000 *+ R7 = @ REZAR05X MESSAGE, WITH REGS FILLED IN, USED TO PRINT IT. + 31948000 *+ R8 = LENGTH OF REZAR05X MESSAGE AREA, FOR PRINTING ALSO. + 31950000 *+ R15 IS USED AS WORK REGISTER AND MODIFIED + 31952000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31954000 SPACE 1 31956000 REREGSRA LA R7,ECREGRA @ 5 REGS IN ECONTROL BLOCK 31958000 SPACE 1 31960000 REREGS LA R15,5 LOOP COUNTER = # REGS TO BE DONE 31962000 LA R8,REZ05XRG INIT TO @ FIRST SLOT FOR HEX REG 31964000 SPACE 1 31966000 REREGSA UNPK 0(9,R8),0(5,R7) UNPK 1 REGISTER VALUE, EXTRA BYTE 31968000 TR 0(8,R8),AWTHEX3 TRANSLATE PROPERLY 31970000 MVI 8(R8),C' ' ADD BLANK AFTERWARD 31972000 LA R7,4(R7) ADVANCE REG PTR TO NEXT REGISTER 31974000 LA R8,8+8(R8) ADVANCE HEX PTR TO NEXT SLOT 31976000 BCT R15,REREGSA LOOP FOR 5 REGS TO BE DONE 31978000 SPACE 1 31980000 LA R7,REZAR05X SHOW @ MESSAGE AREA 31982000 LA R8,REZ05XL SHOW LENGTH 31984000 B REXPRINT BRANCH TO PRINT ROUTINE 31986000 EJECT 31988000 **--> INSUB: REXCON3 CONVERT 3 BYTES OF REGISTER R7 TO HEX. + + + + 31990000 *+ ENTRY CONDITIONS + 31992000 *+ R7 = VALUE TO BE CONVERTED ( IN 3 LOW-ORDER BYTES ) + 31994000 *+ R8 = ADDRESS OF 7 BYTE AREA FOR FIELD TO BE PLACED (WITH TRL ' ') + 31996000 *+ RAT(R12)= ADDRESS OV VWXTABL CSECT, NEEDED FOR TRANSLATE TABL + 31998000 *+ R14= RETURN @ TO CALLING SECTION IN REMONI + 32000000 *+ USES DSECTS: AVWXTABL + 32002000 *++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32004000 SPACE 1 32006000 REXCON3 ST R7,REXFWORK SAVE THE WORD FOR UNPK 32008000 UNPK 0(7,R8),REXFWORK+1(4) UNPK WITH TRAILING ' ' 32010000 TR 0(6,R8),AWTHEX3 TRANSLATE TO PRINTABLE HEX 32012000 BR R14 RETURN TO CALLER 32014000 SPACE 4 32016000 **--> INSUB: REXPRINT PRINT MESSAGE + + + + + + + + + + + + + + + + + 32018000 *+ PRINT MESSAGE AND FLAG REFLAGS WITH REFPRT TO SHOW PRINTED. + 32020000 *+ ENTRY CONDITIONS + 32022000 *+ R7 = ADDRESS OF MESSAGE TO BE PRINTED + 32024000 *+ R8 = LENGTH OF MESSAGE TO BE PRINTED + 32026000 *+ R14= RETURN ADDRESS TO CALLING SECTION OF REMONI + 32028000 *++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32030000 SPACE 1 32032000 REXPRINT $PRNT 0(R7),(R8) PRINT MESSAGE 32034000 OI REFLAGS,REFPRT SHOW SOMETHING PRTED DURING REFAKE 32036000 BR R14 RETURN TO CALLING CODE 32038000 TITLE 'REMONI: INSUB RGENTS: PARAMETER REGISTER CHECKING' 32040000 **--> INSUB: RGENTS CHECK USER VALUES IN PARAMETER REGISTERS+ + + + 32042000 *+ THIS CODE CHECKS THE VALUES RETUNRED IN USER REGISTERS RA-RE + 32044000 *+ AGAINST THE VALUES RETURNED BY THE REAL ASSIST ROUTINE. THE + 32046000 *+ BYTE FLAG RERGEFLG IS SET ACCORDINGLY, FOR ANY OF THE REGISTERS + 32048000 *+ WHICH MAY HAVE INCORRECT VALUES. NOTE THAT THE REGISTERS CAN'T + 32050000 *+ JUST BE COMPARED DIRECTLY, SINCE SOME REGISTERS MAY BE IGNORED, + 32052000 *+ DEPENDING ON THE CONTENTS OF OTHERS (FOR INSTANCE, IF RB HAS AN + 32054000 *+ ERROR CODE, RA AND RC ARE INDETERMINATE FOR MANY ENTRIES.) + 32056000 *+ ENTRY CONDITIONS + 32058000 *+ R5 = @ RECORBLK ELEMENT FOR THE ENTRYPOINT CALLED. + 32060000 *+ R6,R13 = FIRST AND SECOND BASE REGISTERS FOR REMONI(REFAKE). + 32062000 *+ R10= @ ECONTROL BLOCK (WHICH CONTAINS USER RETURN REGS) + 32064000 *+ R12(RAT) = @ AVWXTABL CONTROL BLOCK + 32066000 *+ R14= RETURN @ TO CALLING SECTION OF REMONI. + 32068000 *+ R15= OFFSET FROM RG$BASE TO CODE FOR CHECKING ENTRYPOINT CALLED. + 32070000 *+ = 0 IF NO CHECKS ARE REQUIRED. + 32072000 *+ EXIT CONDITIONS + 32074000 *+ R5,R6,R10,R11,R12,R13,R14,R15 ARE PRESERVED ACROSS THIS CODE. + 32076000 *+ RERGEFLG CONTAINS BITS SHOWING ERROR FLAGS, REGS RA-RE. + 32078000 *+ NAMES: RG------ + 32080000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32082000 SPACE 2 32084000 * * * * * * * * RGENTS REGISTER ALLOCATION * * * * * * * * * * * * * * 32086000 * R0 = WORK REGISTER * 32088000 * R1 = LINK REGISTER FOR INTERNAL SUBROUTINES (INTERNAL TO RGENTS) * 32090000 * R2,R3,R4 (RGRA,RGRB,RGRC) HAVE REAL ROUTINES RETURN VALUES. * 32092000 * R7,R8,R9 (RA,RB,RC) HAVE USER RETURN VALUES OF THESE REGS. * 32094000 * (NOTE MOST PROGS RETURN VALUES IN NOR MORE THAN THESE. * 32096000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32098000 SPACE 1 32100000 * LOCAL REGISTER EQUATES FOR RGENTS. THESE ARE USED FOR 32102000 * EASE OF PROGRAMMING, AND MAY BE READ AS: RGRA: 32104000 * REGISTER(GOOD) VALUE OF RA. 32106000 RGRA EQU R2 GOOD VALUE OF RETURNED RA 32108000 RGRB EQU R3 GOOD VALUE OF RETURNED RB 32110000 RGRC EQU R4 GOOD VALUE OF RETURNED RC 32112000 SPACE 1 32114000 * ERROR EQUS USED IN USER-RETURN REGISTER CHECKING. 32116000 RGERE EQU B'00000001' (RERGEFLG)- RE FOUND IN ERROR 32118000 RGERD EQU B'00000010' (RERGEFLG)- RD FOUND IN ERROR 32120000 RGERC EQU B'00000100' (RERGEFLG)- RC FOUND IN ERROR 32122000 RGERB EQU B'00001000' (RERGEFLG)- RB FOUND IN ERROR 32124000 RGERA EQU B'00010000' (RERGEFLG)- RA FOUND IN ERROR 32126000 RGE13 EQU B'00100000' (RERGEFLG)- R13 MODFIED 32128000 RGE12 EQU B'01000000' (RERGEFLG)- R12 MODIFIED 32130000 RGE06 EQU B'10000000' (RERGEFLG)- >=1 OF R0-R6 MODIFIED 32132000 SPACE 1 32134000 RGENTS EQU * ENTRY FOR CHECKING CODE 32136000 LM RGRA,RGRC,REGSAVB GET THE CORRECT VALUES RETURNED 32138000 LM RA,RC,ECREGRA GET THE USER'S REGS 32140000 B RG$BASE(R15) BRANCH TO CORRECT CODE 32142000 EJECT 32144000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32146000 * INDIVIDUAL ROUTINE REGISTER CHECKING CODE * 32148000 * THE OFFSET VALUES STORED IN RFSYMS WERE CALCULATED RELATIVE * 32150000 * TO LABEL RG$BASE, WITH AN OFFSET OF 0 MEANING THAT NO * 32152000 * REGISTER CHECKING IS REQUIRED. THE ENTRY LABELS IN THIS * 32154000 * SECTION ARE ALL OF THE FORM 'RG' FOLLOWED BY THE NAME OF * 32156000 * THE DESIRED ENTRY POINT. NOTE THAT MANY OF THEM ARE EQU'D * 32158000 * TOGETHER AND USE EXACTLY THE SAME CODE FOR CHECKING. * 32160000 * THE ENTRY LABELS ARE IN ORDER FIRST BY WHETHER THEY * 32162000 * MAY CALL OTHER MODULES OR NOT, AND THEN ALPHABETICALLY. * 32164000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32166000 SPACE 1 32168000 RG$BASE EQU * BASE LABEL FOR OFFSETS 32170000 BR R14 RETURN, NO CHECKING 32172000 SPACE 2 32174000 RGBRUSIN EQU RG$BASE NO CHECKING 32176000 SPACE 1 32178000 RGBRINIT EQU RG$BASE NO CHECKING 32180000 SPACE 1 32182000 RGBRDROP EQU * RB AND GRB BOTH =0 OR ^=0 32184000 LTR RGRB,RGRB WAS REAL RETURN CODE 0 32186000 BNZ RGBR10 NO, BRANCH 32188000 LTR RB,RB WAS USER RETURN CODE ALSO ZERO 32190000 BCR Z,R14 YES, NO MORE, QUIT 32192000 B RGRBERR RGRB=0, RB^=08 ERROR 32194000 SPACE 1 32196000 RGBRDISP EQU * GRB=0==>RB=0 AND RA=GRA. 32198000 * GRB^=0 ==> RB^=0 32200000 LTR RGRB,RGRB WAS REAL RB =0 32202000 BNZ RGBR10 ^=0, GO CHECK USER RB 32204000 LTR RB,RB RB MUST =0 ALSO 32206000 BNZ RGRBERR IT DOESN'T, SO WORNG 32208000 CR RA,RGRA RB=GRB=0, SO CHECK RA TOO 32210000 BCR E,R14 SAME, OK, RETURN 32212000 B RGRAERR NO, ERRO, GO FLAG IT 32214000 RGBR10 LTR RB,RB WAS USER RB ALSO NOT ZERO 32216000 BCR NZ,R14 YES, OK, QUIT 32218000 B RGRBERR NO, RGRB^=0, RB=0, ERROR 32220000 SPACE 2 32222000 RGCBCON1 EQU * GRB=$ERINVCN==> RB=$ERINVCN, RA OK 32224000 * GRB=0 ==> RA=GRA, RC=GRC 32226000 CR RB,RGRB ARE THEY SAME 32228000 BNE RGRBERR NO, GO FLAG, DON'T DO MORE 32230000 LTR RGRB,RGRB WAS CONSTNAT GOOD 32232000 BZ RGCB10 YES, GO CONTINUE CHECK 32234000 BAL R1,RGRAADDR BAD CONSTANT, BUT CHECK SCAN PTR 32236000 BR R14 IF RETURNED HERE, OK 32238000 RGCB10 CR RC,RGRC SAME VALUE OF RC 32240000 BE RGCB20 YES, SKIP, OK 32242000 OI RERGEFLG,RGERC NO, ERROR, FLAG IT 32244000 RGCB20 CR RA,RGRA WAS RA SAME 32246000 BNE RGRAERR NO, ERROR, GO FLAG IT 32248000 BR R14 RETURN, OK 32250000 EJECT 32252000 RGCBCON2 EQU * RA=GRA. CODE AT @RC = CODE @GRC. 32254000 * LENGTH-1 FOR CLC FROM ORIG. RB 32256000 CR RA,RGRA MAKE SURE SAME SCAN PTR 32258000 BE *+8 SKIP IF OK 32260000 OI RERGEFLG,RGERA FLAG SCAN PTR ERR 7 32262000 BAL R1,RGRCADDR MAKE SURE RC HAS OK @, SO DON'T 0C5 32264000 L RB,REGSAVA+4 GET ORIGINAL INPUT VALUE OF RB 32266000 EX RB,RGCBCLC SUPPY LENGTH-1 TO THE CLC 32268000 BCR E,R14 SAME, SO OK, RETURN 32270000 B RGRCERR BAD, GO FLAG IT 32272000 RGCBCLC CLC 0($,RC),0(RGRC) COMPARE VALUE, EX SUPPLIES LENGTH 32274000 SPACE 2 32276000 RGCCCON1 EQU RGCBCON1 SAME CODE AS ABOVE 32278000 SPACE 1 32280000 RGCCCON2 EQU RGCBCON2 SAME CODE AS ABOVE 32282000 SPACE 2 32284000 RGCDECN1 EQU * RB=GRB. GRB=0==> RA=GRA. 32286000 LR RC,RGRC DUPLICATE VALUE SO CHECK OK 32288000 B RGCBCON1 BRANCH BACK TO USE SAME CODE 32290000 SPACE 1 32292000 RGCDECN2 EQU * RB=GRB. OTHERWISE, SAME AS CBCON2 32294000 CR RB,RGRB WAS IT SAME 32296000 BE RGCBCON2 YES SO GO CONTIUE CHECK 32298000 B RGRBERR NO, GO FLAG AS ERROR 32300000 SPACE 2 32302000 RGCFHCN1 EQU RGCDECN1 SAME AS DE CONSTANTS 32304000 SPACE 1 32306000 RGCFHCN2 EQU RGCDECN2 SAME AS DE CONSTANTS 32308000 SPACE 2 32310000 RGCPCON1 EQU RGCBCON1 SAME AS ABOVE 32312000 SPACE 1 32314000 RGCPCON2 EQU RGCBCON2 SAME AS ABOVE 32316000 SPACE 2 32318000 RGCXCON1 EQU RGCBCON1 SAME CODE AS ABOVE 32320000 SPACE 1 32322000 RGCXCON2 EQU RGCBCON2 SAME CODE AS ABOVE 32324000 SPACE 2 32326000 RGCZCON1 EQU RGCBCON1 SAME CODE AS ABOVE 32328000 SPACE 1 32330000 RGCZCON2 EQU RGCBCON2 SAME CODE AS ABOVE 32332000 EJECT 32334000 RGOPINIT EQU RG$BASE NO CHECKING REQUIRED 32336000 SPACE 1 32338000 RGOPFIND EQU * RA=GRA. RG=GRB. RGRB=0 ==> RC OK 32340000 CR RA,RGRA IS IT OK 32342000 BE *+8 YES, SKIP 32344000 OI RERGEFLG,RGERA NO, FLAG RA ERROR 32346000 CR RB,RGRB WAS RETURN CODE OK 32348000 BNE RGRBERR NO, GO FLAG IT AND QUIT 32350000 LTR RGRB,RGRB WSS RETURN CODE ZERO 32354000 BCR NZ,R14 NO, QUIT NOW, OK 32356000 BAL R1,RGRCADDR MAKE SURE OPCODTB PTR IN LEGAL AREA 32357000 S RA,REGSAVA GET LENGTH OF OPCODE 32358000 BCTR RA,0 GET LENGTH-1 32360000 USING OPCODTB,RC NOTE PTR THERE 32362000 EX RA,RGOPCLC IS SYMBOL THE SAME 32364000 BCR E,R14 YES, OK RETURN 32366000 B RGRCERR NO, GO FLAG ERROR 32368000 RGOPCLC CLC OPCMNEM($),OPCMNEM-OPCODTB(RGRC) COMPARE OPCODES 32370000 DROP RC REMOVE OPCODTB USING 32372000 BR R14 RETURN , OK 32374000 SPACE 2 32376000 RGSDBCDX EQU * RB=GRB. GRB=0 OR -4 ==> RA=GRA,RC= 32378000 CR RB,RGRB SAME 32380000 BNE RGRBERR NO, QUIT NOW, ERROR 32382000 LTR RGRB,RGRB WAS RETURN CODE 0 OR -4 32384000 BNP RGCB10 YES, SO GO TO COMMON CHECKING CODE 32386000 BAL R1,RGRAADDR CHECK SCAN PTR FOR LEGALITY 32388000 BR R14 RETURN, OK 32390000 SPACE 1 32392000 RGSDBTRM EQU RGSDBCDX SAME CODE 32394000 SPACE 1 32396000 RGSDCTRM EQU RGSDBCDX SAME CODE AS ABOVE 32398000 SPACE 1 32400000 RGSDDTRM EQU RGSDBCDX SAME CODE AS ABOVE 32402000 SPACE 1 32404000 RGSDXTRM EQU RGSDBCDX SAME CODE AS ABOVE 32406000 EJECT 32408000 RGSYINT1 EQU RG$BASE NO CHECKING 32410000 SPACE 1 32412000 RGSYENT1 EQU * RB=GRB. (RA==> SYMBOL)=(GRA=>SYM) 32414000 CR RB,RGRB SAME OR NOT 32416000 BE RGSY10 YES, OK 32418000 OI RERGEFLG,RGERB NO, ERROR 32420000 B RGSY10 GO CONTINUE CHECKING 32422000 SPACE 1 32424000 RGSYFIND EQU * RG=GRB. GRB=0 ==> SYMBOLS SAME 32426000 CR RB,RGRB RETURN CODE SAME 32428000 BNE RGRBERR NO, ERROR RIGHT OFF 32430000 LTR RGRB,RGRB WAS SYMBOL IN TABLE(RGRB=4) 32432000 BCR NZ,R14 NO, SO DON'T LOOK, RETURN 32434000 RGSY10 C RA,ECFADL BEGIN CHECK FOR WITHIN USER PROG 32436000 BL RGRAERR RA TOO LOW-ERROR 32438000 C RA,ECFADHC COMPARE WITH HIGH CHECK LIMIT 32440000 BH RGRAERR TOO HIGH-BRANCH-ERROR 32442000 L RB,REGSAVA+4 GET ORIGINAL LENGTH OF SYMBOL 1-8. 32444000 BCTR RB,0 OBTAIN LENGTH-1 FOR EXECUTE MVC 32445000 USING SYMSECT,RA NOTE SYMBOL TABLE DSECT 32446000 EX RB,RGSYCLC COMPARE THE SYMBOLS 32448000 BNE RGRAERR NOT SAME SYMBOL, ERROR 32450000 BR R14 OK, RETURN 32452000 RGSYCLC CLC SYMBOL($),SYMBOL-SYMSECT(RGRA) COMPARE SYMBOLS 32454000 DROP RA REMOVE SYMSECT USING 32456000 SPACE 1 32458000 RGSYEND2 EQU RG$BASE NO CHECKING 32460000 SPACE 2 32462000 AIF (&$REPL LT 2).RGNERE2 SKIP IF REPL ENTRIES MAY NOT CALL 32464000 * ASSIST SUBROUTINES 32464007 EJECT 32466000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32468000 * CHECKING CODE - ENTRIES WHICH MAY CALL OTHERS. * 32470000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32472000 SPACE 2 32474000 RGEVALUT EQU * GRB^=0 ==> RB^=0. GRB=0 ==> RA=GRA. 32476000 * GRB=0 ==> RC=GRC, RD=GRD, RE=GRE. 32478000 LTR RGRB,RGRB WAS REAL RETURN CODE ZERO 32480000 BZ RGEV10 YES, SKIP 32482000 LTR RB,RB WAS USER CODE NO TZERO 32484000 BZ RGRBERR DIDN'T MATCH, ERROR BRANCH 32486000 BAL R1,RGRAADDR ERROR IN EXP-GO CHECK FOR OK SCAN PT 32488000 BR R14 RETURN, SCAN PTR OK 32490000 RGEV10 LTR RB,RB WAS FAKE USER RB ZERO ALSO 32492000 BNZ RGRBERR NO, ERROR, QUIT 32494000 LM R0,R1,ECREGRA+12 GET USER REGS RD-RE 32496000 C R0,REGSAVB+12 COMPARE WITH REAL RD 32498000 BE *+8 SKIP IF OK 32500000 OI RERGEFLG,RGERD FLAG RD WRONG 32502000 C R1,REGSAVB+16 COMPARE WITH REAL RE RETURNED 32504000 BE RGCB10 OK, GO CONTINUE CHK FOR RC,RA 32506000 OI RERGEFLG,RGERE FLAG RE IN ERROR 32508000 B RGCB10 GO TO CHECK RC,RA 32510000 .RGNERE2 ANOP 32512000 EJECT 32514000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32516000 * MISC. CHECKING AND EXIT CODE SECTIONS. * 32518000 * THESE SECTIONS OF CODE CAN BE CALLED OR BRANCHED TO BY ANY * 32520000 * OF THE INDIVIDUAL SECTIONS ABOVE. * 32522000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32524000 SPACE 2 32526000 **--> INSUB: RGRAADDR CHECK LEGITAMACY OF SCAN PTR RA + + + + + + + + 32528000 *+ ENTRY CONDITIONS + 32530000 *+ R1 = RETURN @ OF CALLING PROGRAM CODE. + 32532000 *+ RA = VALUE OF SCAN POINTER TO BE CHECKED. + 32534000 *+ R14= RETURN @ TO BE TAKEN IF RA IS IN ERROR. + 32536000 *+ EXIT CONDITIONS + 32538000 *+ RB,RC ARE DESTROYED. MUST BE RELOADED IF CALLER NEEDS THEM. + 32540000 *+ RERGEFLG IS MARKED WITH RGERA IF RA IS INCORRECT. + 32542000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32544000 RGRAADDR C RA,REGSAVA COMPARE TO ORIGINAL SCAN PTR 32546000 BL RGRAERR ROUTINE BACKED UP SCAN PTR-ERROR 32548000 LA R0,200 MAXIMUM POSSIBLE DIF IN SCAN PTRS 32550000 A R0,REGSAVA ADD ORIG RA TO MAX DIFFERENCE 32552000 CR RA,R0 CHECK GAINST THIS LIMIT 32554000 BCR L,R1 YES, OK, NO ERROR 32556000 SPACE 1 32558000 * EXIT POINT - FLAG RA IN ERROR, QUIT CHECKING. 32560000 RGRAERR OI RERGEFLG,RGERA SHOW RA WRONG 32562000 BR R14 RETURN, QUIT CHECKING 32564000 SPACE 2 32566000 * EXIT POINT - FLAG RB IN ERROR, QUIT CHECKING. 32568000 RGRBERR OI RERGEFLG,RGERB FLAG RB IN ERROR 32570000 BR R14 RETURN, NO MORE CHECKING 32572000 SPACE 2 32574000 **--> INSUB: RGRCADDR CHECK RC FOR @ INSIDE USER PROG.+ + + + + + + + 32576000 *+ ENTRY CONDITIONS + 32578000 *+ R1 = RETURN @ TO CALLING CODE IN RGENTS + 32580000 *+ RC = VALUE TO BE CHECKED + 32582000 *+ R14= RETURN @ TO BE TAKEN IF RC HAS INCORRECT VALUE. + 32584000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32586000 RGRCADDR C RC,ECFADL MUST BE >= LOWER FAKE LIMIT 32588000 BL RGRCERR IT WASNT, SO ERROR-BRANCH 32590000 C RC,ECFADHC MUST BE <= HIGH LIMIT FOR CHECKING 32592000 BCR NH,R1 NOT HIGH, SO OK, RETURN TO CALLER 32594000 SPACE 1 32596000 * EXIT POINT - FLAG RC IN ERROR, QUIT CHECKING 32598000 RGRCERR OI RERGEFLG,RGRC FLAG ERROR IN RC 32600000 BR R14 RETURN TO REGULAR PROG. QUIT CHECK 32602000 AIF (&$REPL LT 2).RHNREP SKIP IF NO REPL CALLS 32604000 TITLE 'REMONI - RHENTS SECTION - CHECK CALLING VALUES' 32606000 **--> INSUB: RHENTS CHECK PARM REGS PASSED TO CALLED PROGRAM+ + + + 32608000 *+ RHENTS IS CALLED ONLY WHEN A CALL TO A REAL ASSIST MODULE + 32610000 *+ IS MADE BY A REPLACABLE MODULE PERMITTED TO CALL OTHERS. ITS + 32612000 *+ PURPOSE IS TO PROTECT ASSIST FROM ABENDS CAUSED BY IMPROPER VALUES+ 32614000 *+ BEING PASSED TO REAL ASSIST ROUTINES, WHICH EXECUTE DIRECTLY. + 32616000 *+ ENTRY CONDITIONS + 32618000 *+ R14= RETURN @ TO CALLLING CODE IN MAIN SECTION OF REFAKE. + 32620000 *+ R15= OFFSET @ FROM RH$BASE TO INDIVIDUAL CODE CHECKING SECTION. + 32622000 *+ RERGEFLG BITS FOR RGERA-RGERE ARE ZEROED. + 32624000 *+ EXIT CONDITIONS + 32626000 *+ R0,R1,RA,RB,RC MAY BE MODIFED. + 32628000 *+ R4-R6,R10-R15 ARE PRESERVED ACROSS CALLS TO RHENTS. + 32630000 *+ RERGEFLG BITS ARE SET AS NEEDED. + 32632000 *+ NAMES: RH------ + 32634000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32636000 SPACE 1 32638000 * * * * * * * * RHENTS REGISTER ALLOCATION * * * * * * * * * * * * * * 32640000 * R0 = WORK REGISTER * 32642000 * R1 = INTERNAL LINK REGISTER FOR CHECKING ROUTINES. * 32644000 * R2,R3 UNUSED AT PRESENT, MAY BE USED IF REQUIRED IN FUTURE. * 32646000 * RA,RB,RC HOLD VALUES OF CORRESPONDING USER REGISTERS. * 32648000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32650000 SPACE 1 32652000 RHENTS EQU * 32654000 LM RA,RC,ECREGRA GET PARM REGS, MOST USUAL ONES 32656000 B RH$BASE(R15) BRANCH TO RIGHT SECTION OF CODE 32658000 SPACE 1 32660000 RH$BASE EQU * BASE LABEL FOR CALL CHECKING SECTS 32662000 BR R14 IF COMES HERE, NO CHECKING 32664000 SPACE 2 32666000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32668000 * INDIVIDUAL ROUTINE REGISTER CHECKING CODE SECTIONS * 32670000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32672000 SPACE 2 32674000 RHSDBCDX EQU * RA IN MACHINE REASONABLY 32676000 BAL R1,RHRAADDR CALL CHECKING ROUTINE 32678000 BR R14 RETURN 32680000 SPACE 1 32682000 RHSDBTRM EQU RHSDBCDX SAME CODE 32684000 RHSDCTRM EQU RHSDBCDX SAME CODE 32686000 RHSDDTRM EQU RHSDBCDX SAME CODE 32688000 RHSDXTRM EQU RHSDBCDX SAME CODE 32690000 SPACE 2 32692000 RHSYFIND EQU * RA REASONBALE, 1<= RB <= 7 32694000 BAL R1,RHRAADDR CHECK RA FOR REAONABLENESS 32696000 C RB,AWF1 TEST 32698000 LTR RB,RB WAS RB<=0 32700000 BNP RHRBERR YES, ILLEGAL-BRANCH 32702000 C RB,AWF7 WAS IT TOO BIG 32704000 BCR NH,R14 NO,OK,RETURN 32706000 RHRBERR OI RERGEFLG,RGERB RB IN ERROR 32708000 BR R14 RETURN 32710000 EJECT 32712000 * RHENTS INTERNAL SUBROUTINES * 32714000 SPACE 2 32716000 **--> INSUB: RHRAADDR CHECK RA FOR REASONABLE @ + + + + + + + + + + + 32718000 *+ ENTRY CONDITIONS + 32720000 *+ R1 = RETURN @ TO CALLING CODE + 32722000 *+ RA = VALUE TO BE CHECKED FOR LEGALITY. + 32724000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32726000 SPACE 1 32728000 RHRAADDR EQU * 32730000 * CHECK FOR @ IN USER PROGRAM. 32732000 C RA,ECFADL LOWER LIMIT OF USER 32734000 BL RHRA2 NO, NOT IN USER PROG 32736000 C RA,ECFADHC HIGH CHECKING LIMIT 32738000 BCR NH,R1 INSIDE USER, OK, RETURN 32740000 SPACE 1 32742000 * CHECK FOR IN AVWXTABL 32744000 RHRA2 EQU * 32746000 CR RA,RAT LOWER TAHN PTR 32748000 BL RHRA3 YES, NOT THERE EIEHRE 32750000 LA R0,AVWXEND-8 HIGHEST @ IN TABLE 32752000 CR RA,R0 COMPARE TO UPPER LIMIT POSSIBLE 32754000 BCR NH,R1 IN THERE, OK RETURN 32756000 SPACE 1 32758000 * CHECK FOR @ IN DYNAMIC AREA. 32760000 RHRA3 EQU * 32762000 C RA,AJOTADL LOWER THAN LOWEST 32764000 BL RHRA4 YES 32766000 C RA,AJOTADH HIGHER THAN HIGHEST 32768000 BCR NH,R1 NO, SO OK, RETURN 32770000 SPACE 1 32772000 RHRA4 EQU * 32774000 RHRAERR OI RERGEFLG,RGERA FLAG RA WORNG 32776000 BR R1 RETURN TO CALLER 32778000 .RHNREP ANOP 32780000 LTORG 32782000 DROP R5,R10,R11,RAT,R13 REMOVE ALL USINGS 32784000 TITLE 'RFSYMS - REPLACE TABLE CSECT - CSECT,ENTRY NAMES' 32786000 PRINT GEN 32788000 **--> CSECT: RFSYSMS TABLE OF CSECT-ENTRY NAMES-REPLACE . . . . . . 32790000 *. RFYSMS (SECT.1) HAS AN ELEMENT FOR EACH CSECT WHICH CAN. 32792000 *. BE DYNAMMICALLY REPLACED BY A USER-WRITTEN ROUTINE. EACH . 32794000 *. ELEMENT CONTAINS THE NAME OF THE CSECT, THE NUMBER OF . 32796000 *. ENTRY POINTS IN IT, AND A LIST OF ENTRY POINT NAMES AND . 32798000 *. OFFSETS TO THEIR ADCONS IN AVWXTABL, SO THEY CAN BE CHANGED. . 32800000 *. THE 2ND SECTION IS PRESENT IF &$REPL=2. IT LISTS ALL . 32802000 *. ENTRYPOINTS WHICH CAN BE CALLED FROMA USER PROGRAM, WITH . 32804000 *. OFFSET @ PTRS TO THEIR ADCONS IN AVWXTABL, AND TO CODE IN . 32806000 *. SECTION RHENTS OF REMONI. THIS CODE IS USED TO CHECK THE . 32808000 *. REGISTERS PASSED BY THE USER TO THE CALLED PROGRAM. . 32810000 *. THE 3RD SECTION IS ALSO PRESENT ONLY IF &$REPL=2. IT . 32812000 *. HAS LABELS OF THE FORM RI&CSECT, WITH &CSECT BEING ONE WHICH . 32814000 *. NOT ONLY CAN BE REPLACED, BUT CAN ALSO CALL OTHER ROUTINES. . 32816000 *. EACH ELEMNT CONTAINS A HALFWORD WITH THE NUMBER OF DIFFERENT . 32818000 *. SUBROUTINE ENTRIES WHICH THIS CSECT IS PERMITTED TO CALL, . 32820000 *. FOLOWED BY THAT # OFFSET VALUES TO THE ELEMENTS IN THE 2ND . 32822000 *. SECTION OF THOSE ENTRIES IT CAN CALL. REMONI OBTAINS AN . 32824000 *. OFFSET FROM RFSYMS TO RI&CSECT FROM THE RFSYMBLK BELONGING . 32826000 *. TO THAT CSECT. NOTE, IF A CSECT CAN CALL NO OTHER, THE . 32828000 *. VALUE SAVED IS = 0. . 32830000 *. NAMES: RF------ . 32832000 *. NAMES: RI------ (IN SECTION 3, IF &$REPL=2) 32834000 *. DSECT RFSYMBLK IS USED TO DESCRIBE EACH ENTRY IN SECTS.1&2. . 32836000 *. USES MACROS: $AL2,RFSGN . 32838000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 32840000 SPACE 1 32842000 RFSYMS CSECT 32844000 * **NOTE** COMMENTED ENTRIES ARE NOT CURRENTLY AVAILABLE. 32846000 RFSGN BROPS2,(BRINIT,BRUSIN,BRDROP,BRDISP) 32848000 * RFSGN CACONS,(CACON1,CACON2),TYPE=1 32850000 RFSGN CBCONS,(CBCON1,CBCON2) 32852000 RFSGN CCCONS,(CCCON1,CCCON2) 32854000 RFSGN CDECNS,(CDECN1,CDECN2) 32856000 RFSGN CFHCNS,(CFHCN1,CFHCN2) 32858000 * RFSGN CODTL1,CODTL1,TYPE=1 32860000 RFSGN CPCONS,(CPCON1,CPCON2) 32862000 * RFSGN CVCONS,(CVCON1,CVCON2),TYPE=1 32864000 RFSGN CXCONS,(CXCON1,CXCON2) 32866000 RFSGN CZCONS,(CZCON1,CZCON2) 32868000 RFSGN EVALUT,EVALUT,TYPE=1 32870000 RFSGN OPCOD1,(OPINIT,OPFIND) 32872000 * RFSGN SCANRS,(SCANBL,SCANCO,SCANEQ),TYPE=1 32874000 RFSGN SDTERM,(SDBCDX,SDBTRM,SDCTRM,SDDTRM,SDXTRM) 32876000 RFSGN SYMOPS,(SYINT1,SYENT1,SYFIND,SYEND2) 32878000 RFSYMS$L EQU *-RFSYMS LENGTH OF SEARCH IN RFSYMS CSECT 32880000 SPACE 1 32882000 AIF (&$REPL LT 2).RENREPA SKIP IF NO SECTS 2 & 3 32884000 SPACE 2 32886000 * SECTION 2 - CALLABLE ENTRY POINT INFORMATION. 32888000 RFSCALLA DS 0H BEGINNING OF LIST 32890000 RFSGN SDBCDX,TYPE=2 32892000 RFSGN SDBTRM,TYPE=2 32894000 RFSGN SDCTRM,TYPE=2 32896000 RFSGN SDDTRM,TYPE=2 32898000 RFSGN SDXTRM,TYPE=2 32900000 RFSGN SYFIND,TYPE=2 32902000 RFSCALLZ EQU *-RFS$LEN END @ - LENGTH FOR BXLE LIMIT 32904000 SPACE 2 32906000 * SECTION 3 - OFFSETS TO CALLABLES FROM EACH REPLACABLE. 32908000 * ALTHOUGH EVALUT IS ONLY ONE NOW, OTHERS COULD BE ADDED. 32910000 SPACE 1 32912000 RIEVALUT DC H'6' EVALUT CAN CALL 6 ENTRIES IF IT WANT 32914000 $AL2 RFSYMS,(RFSDBCDX,RFSDBTRM,RFSDCTRM,RFSDDTRM,RFSDXTRM,RFS#32916000 YFIND) OFFSETS TO SECTION 2 BLOCKS ABOVE 32918000 SPACE 2 32920000 PRINT NOGEN TURN OFF GENERATION IN REST CPP 32921000 .RENREPA ANOP 32922000 .RENREPL ANOP 32924000