TITLE '*** ASSIST - MAIN CONTROL - OVERALL ***' 03750000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03750500 *--> CSECT: ASSIST MONITOR CONTROL PROGRAM FOR THE ASSIST SYSTEM * 03751000 * ENTRY CONDITIONS * 03751200 * R1= @ POINTER TO OS LENGTH/PARM FIELD AREA. * 03751400 * CALLS AOBJIN,AODECK,APARMS,EXECUT,MPCON0,REENDA,REINTA * 03751590 * CALLS XXXXFINI,XXXXINIT * 03751600 * USES DSECTS: AJOBCON,AVWXTABL,ECONTROL * 03751800 * USES MACROS: $DBG,$PRNT,$RETURN,$SAVE,$SORC,$TIRC * 03751900 * USES MACROS: ASPAGE,ASPRNT,ASRECL,ASTIME,ASTIMR * 03751910 * USES MACROS: FREEMAIN,GETMAIN,STIMER,TTIMER,XCALL,XSNAP,WTL * 03751920 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03751990 ASSIST CSECT 03752000 * * * * * * * * REGISTER USAGE IN ASSIST MAIN PROGRAM * * * * * * * * * 03752100 * R0,R1,R15 USUALLY LOCAL WORK REGISTERS. PARAMETER REGS FOR SOME. * 03752200 * R9 = INTERNAL LINK REGISTER FOR TIME/RECORDS/PAGES CONTROL . * 03752300 * R10= ADDRESS OF EXECUTION CONTROL BLOCK ECONTROL (PART OF TIME). * 03752400 * R11= ADDRESS OF JOB CONTROL TABLE AJOBCON(ALWAYS). * 03752500 * R12= ADDRESS OF ASSEMBLER CONTROL TABLE AVWXTABL(PART OF TIME). * 03752600 * R13= SAVE AREA PTR AND BASE REGISTER ALSO. * 03752700 * R14= EXTERNAL LINK REGISTER. INTERNAL LINK REGISTER FOR LOWEST * 03752800 * LEVEL INTERNAL SUBROUTINES. * 03752900 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03753000 $DBG ,NO NO DEBUG,SINCE NO AVWXTABL 03754000 AIF (&$ASMLVL).ASXSAVE SKIP FOR OS $SAVE 03754100 BALR R15,0 SET UP TEMPORARY ADDRESSABILITY(DOS) 03754200 USING *,R15 INFORM ASSEMBLER OF R15 USING 03754300 CNOP 0,4 FULLWORD ALIGNMENT FOR FUTURE SAVE 03754400 BAL R13,ASSAVE+72 BR AROUND SAVE,SET R13 = @ SAVEAREA 03754500 USING *,R13 SHOW R13 AS ASSIST BASE REGISTER 03754600 DROP R15 KILL USING 03754700 ASSAVE DC 18F'0' SAVEAREA FOR CSECT ASSIST 03754800 .ASXSAVE AIF (NOT &$ASMLVL).ASNXSAV SKIP IF UNDER DOS GENERATION 03754900 $SAVE RGS=(R14-R12),BR=R13,SA=ASSAVE 03756000 .ASNXSAV ANOP 03756100 MVC ASPARMSV,0(R1) MOVE @ LENGTH/PARM FIELD OVER 03758000 ASTIMR 00,2 INITIALIZE TIMER IF &$TIMER=2 03763000 XCALL XXXXSPIN INITIALIZE PROGRAM INTERRUPT CODE 03763300 LA R11,ASJOBCON GET @ FOR AJOBCON 03764000 USING AJOBCON,R11 NOTE MAIN TABLE USING 03766000 EJECT 03834000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03836000 * INITIALIZE AJOBCON. CALL XXXXINIT TO INITIALIZE * 03838000 * INPUT/OUTPUT PROCESSORS. (I.E. DO OPENS, SET FLAGS. ) * 03840000 * MAKE SURE BOTH LINE PRINTER (PR) AND SOURCE CARD READER (SO) * 03842000 * OPENED SUCCESSFULLY. QUIT IMMEDIATELY IF THEY DIDN'T. * 03844000 * CALL APARMS TO ANALYZE PARM FIELD IF ANY,SET FLAGS IN AJOBCON* 03846000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03848000 SPACE 1 03850000 ASJINIT EQU * SECTION TO INIT AJOBCON 03852000 XC AJOZER1(AJOZER$L),AJOZER1 ZERO OUT WHOLE SECTION 03854000 SPACE 1 03854100 ASJOBINT EQU * ENTRY FOR BEGINNING OF NEW $JOB 03854180 * CALL PARM FIELD ANALYSIS ROUTINE TO SET FLAGS. * 03854200 ASJPARMS EQU * 03854300 ASRECL 02 BORROW 10 LINES FOR HEADER/ CPP 03854310 ASPAGE 02 --AND PARM FIELD MESSAGES CPP 03854315 SPACE 03854320 * ***** LIMIT PARMS & RESETABLE DEFAULTS ***** 03854400 LA R9,ASPARLIM SHOW @ PARM FIELD 03854410 LA R10,ASPARL$L SHOW LENGTH OF PARM FIELD 03854420 MVI AJOAPMOD,AJOAPRSE SHOW THIS IS RESET CALL 03854430 MVI AJOAPSET,APCSETLD SHOW LIMIT/DEFAULT CALL TYPE 03854435 XCALL APARMS CALL PARM FIELD SCANNER 03854440 AIF (NOT &$ASMLVL).ASPARMC NO // EXEC PARM FIELD 03854445 SPACE 1 03854450 * ***** REAL PARM FIELD ANALYSIS ***** 03854490 L R9,ASPARMSV GET PTR TO LENGTH-PARM FOR APARMS 03854500 LH R10,0(R9) GET LENGTH OF THE REAL PARM 03854520 LA R9,2(R9) GET @ ACTUAL PARM FIELD 03854540 MVI AJOAPMOD,AJOAPMOV SHOW PARM SHOULD BE MOVED OVER 03854560 MVI AJOAPSET,APCSETP SHOW THIS IS THE REAL PARM FIELD NOW 03854580 XCALL APARMS CALL SCANNER PROGRAM 03854600 .ASPARMC ANOP 03854620 SPACE 1 03854700 TM AJOSTEP,AJOMSINT HAVE GONE THRU 1-TIME INIT ALREADY 03854710 BO ASNOT1T YES, SO DON'T DO IT AGAIN. 03854720 SPACE 1 03854730 * ***** ONE-TIME-PER-BATCH INITIALIZATION ***** 03854740 BAL R14,ASMSINIT MAIN STORAGE INITIALIZATION 03854750 TM AJOMODE,AJNSYSIN WAS NOSYSIN SPECIFIED 03854800 BO ASZERR2 NOSYSIN, SO QUIT NOW. NO SOURCE CRDS 03854900 SPACE 1 03855000 * HAVE DCB'S OPEND FOR PRINTER, SOURCE RDR. CHECK FOR OK. 03855800 XCALL XXXXINIT CALL I/O INITIALIZER 03856000 TM AJIOPR,AJIOPEN DID PRINTER OPEN RIGHT 03858000 BZ ASZERR1 NO,GO DO MESSAGE AND QUIT 03860000 TM AJIOSO,AJIOPEN DID SOURCE CARD RDR OPEN RIGHT 03862000 BZ ASZERR2 NO, BRANCH AND QUIT IMMEDIATELY 03864000 ASNOT1T EQU * ENTER FOR EVERY-TIME PROCESSING 03866000 TM AJOMODE,AJOBATCH WAS THIS BATCH RUN 03866050 BZ ASPARFIN NO, SKIP TO PUT IN FINAL DEFAULTS 03866100 AIF (NOT &$DATARD).ASNRDX SKIP IF NO DATA RDR EXISTS 03866150 OI AJIORE,AJIODFLT SINCE BATCH, MAKE SURE NO DATA RDR 03866200 .ASNRDX ANOP 03866250 SPACE 1 03866300 * ***** BATCH MODE - GET $JOB CARD AND ITS PARMS ***** 03866350 AIF (NOT &$MACSLB).ASSNOMC 03866360 XCALL XXXXLBED MAKE SURE THAT XXXXSORC GETS CARD RIGHT 03866370 .ASSNOMC ANOP 03866380 MVI AJOBTRQ,AJO$J SHOW THAT $JOB CARD IS DESIRED J 03866400 BAL R14,ASFLUSH GO GET IT; RETURN ONLY IF FOUND J 03866500 * ***** $JOB CARD OR EQUIV FOUND. PROCESS PARM. 03866550 MVI AJOAPMOD,AJOAPMOV SHOW PARM SHOULD BE MOVED OVER 03866600 MVI AJOAPSET,APCSETU SHOW USER SETTING THIS TIME 03866650 LA R9,AJOJCLPM SHOW @ PARM FIELD ON $JOB CARD 03866700 LA R10,80-(AJOJCLPM-AJOJCLCD) LENGTH OF PARM FIELD(MAX) 03866750 XCALL APARMS CALL PARM ANALYSIS ROUTINE 03866800 MVC AJOPARM(80),AJOJCLCD MOVE WHOLE JCL CARD IN INST 03866850 SPACE 1 03866900 * ***** DEFAULT PARM FIELDS - DON'T OVERRRIDE SET ***** 03866950 ASPARFIN EQU * SKIP HERE IF NOBATCH 03867000 MVI AJOAPMOD,AJOAPDEF+AJOAPFIN DEFAULT CALL, ALSO LAST 1 03867050 MVI AJOAPSET,APCSETLD SHOW LIMIT/DEFAULT TYPE SETTING 03867100 LA R9,ASPARDF SHOW DEFAULT PARMS 03867150 LA R10,ASPARD$L SHOW LENGTH OF DEFAULT PARM LIST 03867200 XCALL APARMS MAKE FINAL CALL TO PARM ROUTINE 03867250 EJECT 03880000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03882000 * TIME,RECORDS,PAGES INITIALIZATION FOR ASSEMBLY. * 03884000 * PRINT ASSIST HEADER + 1 PARM FIELD. * 03885000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03886000 SPACE 1 03888000 ASRECL 04 CALL RECORD INIT CODE 03910000 ASPAGE 04 CALL PAGE HANDLING, IF EXISTS 03912000 ASTIMR 04,1 SET UP TIME/INST COUNT LIMITS 03914000 SPACE 1 03938000 * PRINT HEADER. PRINT REAL PARM OR $JOB PARM AREA 03940000 ASPRHEAD EQU * ENTRY FOR MULTIPLE ASSEMBLYS/EXEC 03941000 ASPRNT ASH1HD,ASH1H$L PRINT BEGINNING HEADER 03942000 CLC AJOPARM(AJOP$L),AJOBLANK CHECK IF PARM TO PRNT CPP 03944000 BE ASPRHD1 SKIP IF NO PARMS TO PRINT CPP 03946000 ASPRNT AJOPARMA,AJOP$L+1 PRINT THE PARM FIELD 03948000 ASPRHD1 DS 0H CPP 03950000 AIF (&$DEBUG).ASDA SKIP IF PRODUCTION 03952000 XSNAP LABEL='AFTER TIME/RECORDS SET',IF=(AJODEBUG,O,8,TM), X03954000 STORAGE=(*AJOPARMA,*AJOBCON+AJOB$L) 03956000 .ASDA ANOP 03958000 EJECT 03960000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03962000 * SET UP ADDRESSES FOR CALL TO THE ASSIST ASSEMBLER. * 03964000 * ALSO SET UP TIME,SO CAN DO TIMING FOR THE ASSEMBLER * 03966000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03968000 SPACE 1 03970000 ASASMCL EQU * SECTION TO CALL ASSEMBLER 03972000 MVC AJOTADL(8),AJOPADL REINITIALIZE TEMP TO PERMANENTS 03974000 SPACE 1 03976200 ASASMCLR EQU * ENTRY LABEL FOR REPLACE PHAS B 03976400 L RAT,AJOVWXPT INIT ADCON FOR ASSEMBLER TABLE 03976500 USING AVWXTABL,RAT NOTR POINTER IN R12 03977000 ST R11,AVAJOBPT INIT POINTER TO AJOBCON. 03977500 MVC AVADDLOW(8),AJOTADL MOVE CURRENT CORE LIMITS OVER 03977600 MVC AVNERR(AJOAVL),AJONERR GIVE FLAGS TO ASSEMBLER 03977700 AIF (NOT &$OBJIN).ASNOBJ1 SKIP IF NO OBJECT DECK IN 03977705 SPACE 1 03977710 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03977715 * OBJECT DECK INPUT CODE * 03977720 * IF PARM=OBJIN, CALL AOBJIN TO LOAD DECK, SKIPPING EXECUTION * 03977725 * IF THERE IS NOT ENOUGH ROOM FOR IT. AOBJIN SETS UP VALUES * 03977730 * IN AVWXTABL JUST AS THOUGH THERE HAD BEEN AN ASSEMBLY. * 03977735 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03977740 TM AJODECKF,AJOOBJIN WAS THERE OBJECT DECK,INSTD OF SOURC 03977745 BZ ASOBJINN NO, NO OBJECT DECK-SKIP TO ASSEMBLE 03977750 AIF (&$REPL EQ 0).ASNRPX SKIP IF NO REPLACEMENT 03977755 TM AJOMODE,AJOREPLF REPLACE RUN 03977760 BO ASOBJINN YES, SO DON'T LET HIM READ DECK IN 03977765 .ASNRPX ANOP 03977770 XCALL AOBJIN CALL OBJECT INPUT ROUTINE 03977775 TM AVTAGS1,AJNLOAD NOLOAD SET IF SOMETHING WRONG 03977780 BO ASNOEXEC BAD DECK - SKIP EXECUTION 03977785 B ASOBJINX OK, SKIP OVER ASSEMBLY AND CONTINUE 03977790 ASOBJINN EQU * SKIP HERE IF NO OBJECT INPUT 03977795 .ASNOBJ1 ANOP 03977800 AIF (&$REPL EQ 0).ASNREP1 SKIP IF NO REPLACEMENT 03977810 * IF REPLACEMENT POSSIBLE, CALL REINTA TO SET FLAGS,ADCONS 03977820 XCALL REINTA CALL REPLACE PRE-ASSEMBLY INIT 03977830 .ASNREP1 SPACE 1 03977840 SPACE 1 03977850 * FLAG ASSEMBLY, CALL ASSEMBLER, UNFLAG ASSEMBLY. 03977900 OI AJOSTEP,AJOSASM SHOW WE'RE IN ASSEMBLER NOW 03978000 XCALL MPCON0 CALL THE ASSEMBLER 03980000 NI AJOSTEP,255-AJOSASM SHOW WE FINISHED ASSEMBLER 03982000 SPACE 1 03986000 ASTIMR 12,1 CALL FOR ASSEMBLY TIME,RATE PRINTING 03988000 SPACE 1 03990000 AIF (&$REPL EQ 0).ASNREP2 SKIP IF NO REPLACEMENT 03990100 * IF REPLACEMENT POSSIBLE, CALL REENDA TO CHANGE ADCONS 03990200 XCALL REENDA POST-ASSEMBLY PROCESSOR 03990300 .ASNREP2 SPACE 1 03990400 TM AVTAGS1,AJNLOAD WAS NO LOAD FLAG SET 03992000 BO ASNOEXEC EITHER USER DIDN'T WANT, OR ERRS 03994000 ASOBJINX EQU * EXIT HERE IF OBJECT INPUT 03994005 AIF (NOT &$DECK).ASNDECK SKIP IF NO DECKS PUNCHED 03994010 SPACE 1 03994015 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994020 * OBJECT DECK PUNCH CODE * 03994025 * IF PARM=DECK, PUNCH THE CURRENT USER PROGRAM OUT, AS LONG * 03994030 * AS IT WASN'T ONE JUST READ IN FOR PARM=OBJIN. * 03994035 * ALSO, DON'T PUNCH IF IN REPLACE RUN. * 03994040 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994045 TM AJOASMF2,AJODECK DID USER WANT AN OBJECT DECK 03994050 BZ ASDECKN NO, SKIP 03994055 TM AJODECKF,AJOOBJIN DID HE JUST READ IT IN 03994060 BO ASDECKN YES, IDIOT USER-DON'T PUNCH IT 03994065 AIF (&$REPL EQ 0).ASNREDK SKIP IF NO REPLACEMENT 03994070 TM AJOMODE,AJOREPLF ARE WE IN REPLACE RUN 03994075 BO ASDECKN YES, DON'T ALLOW DECK PUNCHED 03994080 .ASNREDK ANOP 03994085 XCALL AODECK CALL TO PUNCH OBJECT DECK 03994090 ASDECKN EQU * SKIP LABEL OVER OBJECT DECK PUNCH 03994095 .ASNDECK ANOP 03994100 SPACE 2 03994105 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994200 * PRE-EXECUTION CONTROL CARD CHECKING * 03994300 * IF IN BATCH MODE, FLUSH CARDS UNTIL A $ENTRY CARD FOUND, * 03994400 * AND POSSIBLY ALLOW EXECUTION, OR A $JOB CARD FOUND, IN * 03994500 * WHICH CASE GO BACK FOR NEXT JOB. $STOP CARD FOUND WILL NOT * 03994600 * RETURN HERE ANYWAY. NOTE THAT EXECUTION IN BATCH MODE * 03994700 * CURRENTLY REQUIRES A $ENTRY CARD. * 03994800 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994900 SPACE 1 03995000 TM AJOMODE,AJOBATCH ARE WE IN MIDDLE OF BATCH RUN 03995100 BZ ASEXNBAT NO, NO BATCH, DON'T READ ANY CARDS 03995200 SPACE 1 03995300 AIF ('&$BTCC(3)' EQ '').ASBTCC1 SKIP IF NO $ENTRY NEEDED J 03995400 MVI AJOBTRQ,AJO$E SHOW THAT $ENTRY IS WHAT WE WANT J 03995500 BAL R14,ASFLUSH GO GET; IF RETURN, IT EXISTS J 03995600 CLI AJOBTYP,AJO$E WAS IT ACTUALLY $ENTRY J 03995620 BE ASEXNBAT YES, CONTINUE J 03995640 OI AJIOSO,AJIOSORR $JOB- SET FOR REREAD, FINISH JOB J 03995660 B ASNOEXEC GO TO END THIS JOB, PICK UP $JOB J 03995680 .ASBTCC1 ANOP 03995700 ASEXNBAT EQU * 03995800 EJECT 04008000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04010000 * PREPARE ADDRESSES AND ECONTROL BLOCK FOR EXECUTION * 04012000 * OF USER PROGRAM BY EXECUT. SET UP ECONTROL APPROPRIATELY. * 04014000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04016000 SPACE 1 04018000 ASEXECAL EQU * 04019000 LM R0,R5,AVRADL GET THE 6 @ WORDS FROM AVWXTABL 04020000 LA R10,AVECONTR OVERLAP ECONTROL&UNNEEDED AV SECT 04021000 DROP RAT REMOVE USING FOR TIME BEING 04022000 AIF (&$REPL EQ 0).ASNRP1E SKIP IF NO REPLACE 04022050 SPACE 1 04022100 * IF IN REPLACE MODE A, THE ECONTROL BLOCK CANNOT BE 04022150 * LOCATED IN MIDDLE OF AVWXTABL, SO ALLOCATE SPACE FOR 04022200 * IT AT HIGH END OF DYNAMIC AREA INSTEAD. 04022250 TM AJOMODE,AJOREPLF+AJOREPHB ARE WE IN REPL, OR PHASE B 04022300 BNM ASREPLBM BRANCH-NOT PHASE A IN ANY CASE 04022350 SPACE 1 04022400 L R10,AJOTADH GET CURRENT HIGH POINTER 04022450 SH R10,=AL2(EC$LEN) SPACE FOR ECONTROL 04022500 ST R10,AJOTADH SAVE BACK, ALSO LEAVE IN R10 04022550 ASREPLBM EQU * BRANCH HERE IF NOT REPL PHASE A 04022600 .ASNRP1E SPACE 1 04022650 USING ECONTROL,R10 NOTE EXECUTION TIME USING 04028000 XC ECZER1(ECZER$L),ECZER1 ZERO OUT AREA IN ECONTROL 04030000 AIF (NOT &$VIRT).VIASM1 V 04031000 TM AJOEXEF,AJOVIRT TEST IF IN VIRT MODE V 04031100 BO VIASM10 IF YES, FIGURE ADDRESS DIFF. V 04031200 .VIASM1 ANOP V 04031300 * AV R0=RADL R1=RADH R2=RELOC R3=FENTER R4=LOCLOW R5=LOCHIH 04032000 * EC R0=RADL R1=RADH R2=RELOC R3=FENTER F4=FADL R5=FADH 04033000 LR R7,R0 GET RELOCATION VALUE IN USABLE REG. 04034000 SR R7,R4 DE-RELOCATE IF RELOC OR START CPP 04034500 LA R6,0(R7,R5) GET @ OF PGM END (=SAVE AREA @) 04035000 LA R5,72(R5) HIGHEST ADDRESSABLE FAKE LOC. 04036000 LR R8,R5 COPY TO ALIGN PGM LENGTH FOR DUMP 04037000 LA R0,31 ALIGN TO 32 BYTE BOUNDARY 04038000 $ALIGR R8,R0 ALIGN SO DUMP ENDS ON 1 LINE 04039000 LA R1,256(R7,R8) R1=EN D OF PGM+SA+256 BYTE PAD 04040000 C R1,AJOTADH COMPARE IF LARGER THAN SPACE 04041000 BH ASEXOVSP IF YES, THEN ABORT EXECUTION 04042000 AR R7,R4 RELOCATE IF RELOC OR START CPP 04042500 LR R0,R7 RESTORE R0 AS REAL LOW @ 04043000 LA R8,72(R6) R8=REAL END OF SAVE AREA (DUMP END) 04044000 STM R0,R5,ECRADL SAVE ECONTROL ADDRESS BLOCK 04045000 STM R7,R8,ECRDLIML SAVE INITIAL DUMP LIMITS 04046000 ST R1,AJOTADL SAVE TEMP. LOW DYNAMIC AREA ADDR. 04047000 SPACE 2 04048000 * FILL SAVE AREA + 256 BYTE PAD WITH FILL CHARACTER 04049000 MVI 0(R6),$PRGFILC BEGIN PROPEGATE MOVE 04050000 MVC 1(256,R6),0(R6) FILL SAVE AREA PLUS PART OF 256 PAD 04051000 XC 4(4,R6),4(R6) ZERO BACK PTR. IN SAVE AREA 04052000 ST R6,ECSAVE1 @ OF SAVE AREA (USED IN EXECUT) 04053000 LA R7,256(R6) INCREASE POINTER 04054000 SR R1,R7 CALCULATE HOW MUCH MORE TO DO 04055000 BCTR R1,0 -1 FOR MOVE TO N-1 NEW BYTES 04056000 BCTR R1,0 -1 FOR MACHINE FORM OF SS LEN. 04057000 STC R1,*+5 CHANGE LENGTH FOR FINISH MOVE 04058000 MVC 1($,R7),0(R7) **CHANGED** FILL REST OF PAD AREA 04059000 LA R1,2(R1,R7) RESTORE R1 TO ORIGINAL CONDITION 04060000 SPACE 2 04061000 * SET UP USER REGS. FOR ENTRY 04062000 SR R6,R2 FAKE @ OF SAVE AREA 04063000 L R7,=F'-100000' SET UP STRANGE RETURN ADDRESS 04064000 LR R8,R3 GET ENTRY POINT 04065000 STM R6,R8,ECREG13 STORE FAKE R13-14-15 IN SAVE AREA 04065140 MVI ASRGFIL2+1,50 SET UP TO FILL R0-R12 WITH X'F7' 04065150 AIF (NOT &$VIRT).VIASM2 SKIP OTHER ADR CALC. IF NOT VIRT 04065160 B ASRGFIL1 CONTINUE NORMAL PROCESSING 04065170 SPACE 3 04065180 * SET UP STORAGE AND PROTECTION KEYS * 04065190 VIASM10 LTR R4,R4 CHECK IF PROGRAM STARTS AT 0 04065200 BNZ VIASERR1 NO, THEN ABORT RUN 04065210 LA R1,2047(R5) BUMP TO NEXT HIGHER 2K MULT. 04065220 SRA R1,11 WILL ROUND TO 2K MULT. 04065230 BZ VIASERR2 WAS USER PROGRAM OF LENGTH 0? 04065240 LR R6,R1 SAVE NUMBER OF 2K BLOCKS 04065250 SLA R1,11 NOW HAVE CORRECT 2K MULTIPLE 04065260 AR R1,R0 RELOCATE HIGH "MACHINE" ADDRESS 04065270 LR R7,R1 SAVE THAT VALUE 04065280 AR R7,R6 ADD ON SPACE FOR PROT. KEYS (1/BLK) 04065290 C R7,AJOTADH DOES THAT REQUEST MORE THAN EXISTS? 04065300 BH ASEXOVSP YES, THEN SPACE OVERFLOW 04065310 ST R7,AJOTADL SAVE START ADDR OF DYNAMIC AREA 04065320 LR R7,R1 MOVE OVER ADDR OF START OF KEYS 04065330 MVI 0(R7),$VISKEY FILL KEYS WITH 0,FETCH PROT. 04065340 BAL RET,VIASFILL CALL SUBR. TO FILL KEY FIELDS 04065350 SPACE 2 04065360 * FILL REMAINDER OF LAST STORAGE BLOCK WITH FILL VALUE * 04065370 LR R7,R5 GET FAKE HIGH PGM .ADDR. 04065380 AR R7,R0 RELOCATE TO REAL FOR FILLING 04065390 LR R6,R1 GET END @ OF LAST 2K BLOCK 04065400 SR R6,R7 SUBTRACT PGM END==LEN. TO FILL 04065410 BZ VIASRGS IF EXACT 2K MULT. THEN NO FILL 04065420 MVI 0(R7),$PRGFILC PUT IN FIRST CORE FILL BYTE 04065430 BAL RET,VIASFILL CALL RTN. TO FILL LAST 2K BLOCK 04065440 SPACE 2 04065450 * SET UP ENTRY REGS. FOR EXECUT (VIRT) * 04065460 VIASRGS LR R5,R1 MAKE R5 POINT TO NEW HIGHEST/ 04065470 SR R5,R0 --LOCATION COUNTER VALUE 04065480 STM R0,R5,ECRADL STORE REAL AND FAKE PGM LIMITS 04065490 STM R0,R1,ECRDLIML STORE INIT. DUMP LIMITS (WHOLE PGM) 04065500 MVI ASRGFIL2+1,62 WILL FILL ALL REGS WITH SAME VALUE 04065510 B ASRGFIL1 BRANCH OVER NON-VIRT ADDR. CALCS. 04065520 SPACE 2 04065530 ***--> INSUB: VIASFILL FILL AN AREA WITH A GIVEN VALUE * * * * * * ** 04065540 * R6=LEN TO FILL, R7=@ OF FIRST BYTE TO PROPEGATE * 04065550 * R8 IS DESTROYED; R6,R7 MODIFIED * 04065560 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04065570 VIASFILL LA R8,256 USEFUL CONSTANT 04065580 SH R6,=H'2' SUB. 1 FOR EX OF SS + 1 FOR MVI DONE 04065590 BM VIASST3 IF NEG, THEN ONLY HAD 1 TO DO; DONE 04065600 VIASST1 CR R6,R8 CHECK IF <256 TO DO 04065610 BL VIASST2 IF YES, THEN DO PARTIAL MVC 04065620 MVC 1(256,R7),0(R7) AT LEAST 256 TO DO, SO BIG MVC 04065630 AR R7,R8 UPDATE BY HOW MUCH FILLED 04065640 SR R6,R8 REDUCE AMOUNT YET TO MOVE 04065650 B VIASST1 LOOP TO FILL MORE 04065660 VIASST2 STC R6,*+5 MODIFY FOLLOWING MVC FOR SHORT MOVE 04065670 MVC 1($,R7),0(R7) MOVE <= 256 BYTES OF FILL 04065680 VIASST3 BR RET RETURN TO POINT OF CALL 04065690 SPACE 2 04065700 .VIASM2 ANOP 04065710 ASRGFIL1 MVI ECREGS,$PRGFILR FILL REGS WITH OBVIOUS CHAR. 04078000 ASRGFIL2 MVC ECREGS+1($),ECREGS **CHANGED** FILL PSEUDO-REGS. 04080000 MVC ECFPREGS(32),ECREGS PUT 4'S IN FP REGS ALSO 04082000 MVC ECILIMP,AJOINSL MOVE INSTRUCTION LIMIT OVER 04084000 MVC ECAJ(ECAJL),AJOEC MOVE EXECUTION FLAGS OVER 04086000 MVI ECSYSMSK,X'FF' SET CHANNEL MASKS TO INTERRUPT CEH 04087000 MVI ECKYAMWP,X'C5' SET KEY=C, AMWP=0101 CEH 04088000 SPACE 1 04088200 OI ECFLAG0,$ECSPIEB NOTE WE WANT SPIE REMOVED AT END 04088400 * IF 'RELOC' OPTION USED, ALLOW STORE-ONLY PROTECT 04088600 AIF (NOT &$RELOC).ASNRELC SKIP IF NO RELOC MODE AVAIL 04088800 TM AJOASMF,AJORELOC DID USER ASK FOR RELOC MODE 04089000 BO *+8 YES, SKIP, DON'T SET FETCH PROTECT 04089200 .ASNRELC ANOP 04089400 OI ECFLAG0,$ECPROT SHOW BOTH FETCH/STORE PROTECT 04089600 SPACE 1 04090000 XCALL XXXXSNIN HAVE XXXXSNAP INIT CALL # 04092000 ST R10,AJOECOPT SAVE @ ECONTROL, IN CASE TIMER 04094000 AIF (&$DEBUG).ASXS1 SKIP XSNAP IF NOT DEBUG MODE 04096000 XSNAP LABEL='ECONTROL BEFORE EXECUT',IF=(AJODEBUG,O,2,TM), #04104000 STORAGE=(*ECONTROL,*ECONTROL+EC$LEN) 04106000 LM R14,R15,ECRADL GET STORAGE LIMITS 04108000 XSNAP T=(NO,,1),LABEL='USER STORAGE BEFORE EXEC(FAKE ADDR)', #04110000 STORAGE=(*0(R14),*0(R15)),IF=(AJODEBUG,O,4,TM) 04112000 .ASXS1 ANOP 04118000 EJECT 04120000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04122000 * EXECUTION CONTROL BLOCK PREPARATION COMPLETED. MAKE SURE * 04122500 * THAT TIME OR RECORDS LIMITS HAVE NOT BEEN OVERRUN ALREADY. * 04123000 * IF NOT, THEN PRINT HEADER, SET TIMER, AND EXECUTE PROGRAM. * 04124000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04124500 SPACE 1 04126000 TM AJOMODE,AJOSOVRT+AJOSRECX HAS ANY OVERRUN OCCURRED 04128000 BNZ ASNOEXEC SKIP IF OVERRUN ALREADY. DON'T EXEC 04130000 AIF (&$REPL EQ 0).ASNREP3 SKIP IF NO REPLACEMENT 04130005 TM AJOMODE,AJOREPLF+AJOREPHB TEST REPLACE STATUS 04130010 BNM ASREPLBZ BR-EITHER NO REPLACE(Z) OR PHS B(O) 04130015 OI AJOMODE,AJOREPHB WAS IN PHASE A, SET NOW TO B 04130020 MVC ECRFLAG,AJORFLAG INITIALIZE THE FLAG VALUE 04130025 ASPAGE 14 GET PAGE CONTROL SET 04130026 ASRECL 14 GET RECORDS SET (LIKE EXEC) 04130028 ASTIMR 14,1 SET TIMER, AS FOR NORMAL EXEC. 04130029 B ASASMCLR RETURN TO RUN A REPLACED CSECT 04130030 ASREPLBZ EQU * EXIT LABEL- NO REPLACE, PHASE B 04130035 .ASNREP3 SPACE 2 04130040 ASPRNT ASHEXGO,L'ASHEXGO PRINT PRE-EXECUTION HEADING 04130400 ASPRNT AJOBLANK,1 PRINT BLANK LINE AFTER EXEC MSG CP 04130500 SPACE 1 04130600 ASPAGE 16 SET PAGE LIMITS FOR EXECUTION 04130800 ASRECL 16 SET UP RECORD LIMITS FOR EXECUTION 04130900 SPACE 1 04131000 * FLAG EXECUTION, CALL EXECUT, UNFLAG EXECUTION. 04131200 OI AJOSTEP,AJOSEXEC FLAG TO SHOW WE'RE IN INTERPRETER 04132000 ASTIMR 16,1 SET TIMER, AFTER SHOWN IN EXEC PHASE 04133000 XCALL EXECUT CALL THE INTERPRETER 04134000 NI AJOSTEP,255-AJOSEXEC SHOW FINISHED EXECUTION 04136000 SPACE 1 J 04136100 * POST-EXECUTION PHASE - USE ALL DUMP LIMITS IN ORDER TO J 04136150 * PREVENT UNNECESSARY LOSS OF MESSAGES. J 04136200 OI AJOSTEP,AJOSDUMP SHOW NOW IN DUMP STEP J 04136250 ASRECL 20 RECORD LIMIT; CLEAR AJOSRECX FLAG J 04136300 ASPAGE 20 PAGE LIMIT, IF USED J 04136400 ASTIMR 18,0 PRINT INSTRUCTION COUNT/RATE 04136500 ASTIMR 20,1 RESET TIMER FOR DUMP PROCESSING J 04136600 * IF 1 OR MORE DATA CARDS WAS NOT READ DURING EXECUTION, J 04136610 * READ IT AND PRINT WITH MESSAGE TO THAT EFFECT. J 04136620 AIF (NOT &$DATARD).ASNDRZZ SKIP IF NO DATA RDR J 04136622 TM AJIORE,AJIOPEN+AJIODFLT WAS RDR OPEN, OR DEFAULT USED J 04136623 BNZ ASCARDRR YES, SAFE TO DO $READ NOW J 04136624 MVC AJOPARM(80+L'ASCARDMS),AJOBLANK BLANK OUT WHOLE AREA J 04136625 MVC AJOPARM+L'ASCARDMS(27),=C'NO CARDS READ:FILE UNOPENED' J 04136626 B ASCARDMM 04136627 .ASNDRZZ ANOP 04136628 ASCARDRR $READ AJOPARM+L'ASCARDMS,80,ASNOMORC READ, SKIP IF EOF J 04136630 ASCARDMM MVC AJOPARM(L'ASCARDMS),ASCARDMS COPY MESSAGE OVER J 04136640 ASPRNT AJOPARMA,81+L'ASCARDMS PRINT THE ASSEMBLED LINE J 04136650 * NOTE: ABOVE MESSAGE MAY OVERLAP INTO AJODWORK. BUT OK.J 04136651 ASNOMORC EQU * COME HERE IF NO CARDS UNREAD J 04136660 SPACE 2 04138000 * DETERMINE WHETHER PROGRAM ENDED WITH A NORMAL RETURN OR* 04158000 * AN ERROR. PRINT NORMAL MESSAGE IF IT WAS FLAGGED AS NORMAL. * 04176000 CLI ECFLAG1,$ECBRN14 WAS RETURN NORMAL 04178000 BNE ASDUMPCL NO, SO CALL DUMP ROUTINE 04180000 ASPRNT ASNORMAL,L'ASNORMAL PRINT NORMAL COMPLETION BY RET 04182000 B ASNOEXEC 04184000 SPACE 1 04186000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04186200 * USER PROGRAM DUMP PHASE * 04186400 * SET UP CORRECT LIMITS FOR DUMP, THEN MAKE SPECIAL XSNAP * 04186600 * CALL WHICH PRODUCES THE FINAL DUMP, USING APPROPRIATE LIMITS.* 04186800 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04187000 ASDUMPCL EQU * 04188000 LM R14,R15,ECRDLIML ECRDLIML-ECRDLIMH - DUMP LIMITS 04190000 XSNAP T=(PR,FL,10),STORAGE=(*0(R14),*0(R15)) FINAL DUMP 04196000 B ASNOEXEC GO TO MAKE BATCH CHECK 04200000 EJECT 04202000 * ASEXOVSP - ENTERED IF STORAGE OVERFLOW. * 04204000 ASEXOVSP ASPRNT ASEMSG,L'ASEMSG PRINT STORAGE OVERFLOW MESSAGE 04206000 B ASNOEXEC TERMINATE RUN V 04206500 AIF (NOT &$VIRT).ASVINO SKIP VIRT ERRORS IF NO VIRT. 04207000 SPACE 1 04207100 * PROGRAM DOES NOT START AT 0 (RELATIVE) V 04207200 VIASERR1 ASPRNT VIASERM1,L'VIASERM1 PRINT ERROR MSG. V 04207300 B ASNOEXEC TERMINATE RUN V 04207400 SPACE 1 V 04207500 * PROGRAM HAS LENGTH 0 (NULL PGM.) V 04207600 VIASERR2 ASPRNT VIASERM2,L'VIASERM2 PRINT ERROR MSG. V 04207700 .ASVINO ANOP ENCLOSE VIRT. ERROR MSGS. V 04207800 SPACE 1 04208000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04208100 * MAIN END-OF-$JOB EXIT - ASNOEXEC * 04208200 * IF TIME AND RECORDS OVERRUN OCCURRED, PRINT MESSAGE. * 04208300 * THEN TEST FOR BATCH RUN, IF SO REUTURN FOR NEXT $JOB CARD. * 04208400 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04208500 SPACE 04208600 * ASNOEXEC-PRINT OVERRUN MSG IF ONE HAS OCCURRED CPP 04208650 ASNOEXEC EQU * CPP 04208700 TM AJOMODE,AJOSOVRT HAS TIME EXPIRED? CPP 04208750 BO ASNXAM5 IF YES, PRINT AM005 MSG. NOW CPP 04208800 TM AJOMODE,AJOSRECX HAVE RECORDS/PAGES EXCEEDED? CPP 04208850 BZ ASTSTBAT NO, GO TEST IF IN BATCH MODE CPP 04208900 SPACE 04208950 * RECORDS OR PAGES OVERRUN--ADD 2 RESERVED LINES CPP 04209000 NI AJOMODE,255-AJOSRECX TURN OFF OVERRUN FLAG CPP 04209050 LA R14,3 USEFUL CONSTANT CPP 04209100 C R14,AJORECNT AT LEAST 3 LINES LEFT? CPP 04209200 BNH *+8 YES, DON'T WORRY CPP 04209250 ST R14,AJORECNT NO, ALLOW FOR AM005 MESSAGE CPP 04209300 AIF (NOT &$PAGE).ASFINNP CPP 04209350 L R0,AJOPREM GET # PAGES LEFT CPP 04209400 LTR R0,R0 CHECK IF ON LAST PAGE CPP 04209450 BP ASNXAM5 NOT LAST PAGE SO ROOM LEFT CPP 04209500 ST R14,AJOLREM LINES RESERVED ON LAST PAGE CPP 04209550 .ASFINNP ANOP CPP 04209600 ASNXAM5 ASPRNT ASRTOVR,L'ASRTOVR PRINT AM005 MESSAGE CPP 04209650 SPACE 1 04210140 * ASTSTBAT - TEST FOR BATCH RUN, CONTINUE IF SO. * 04210150 ASTSTBAT EQU * 04210160 AIF (&$XXIOS).ASFIN SKIP IF NO EXTENDED I/O J 04210170 XCALL XXDDFINI CALL TO CLOSE EVERYTHING UP J 04210175 .ASFIN ANOP 04210180 TM AJOMODE,AJOBATCH WAS RUN A BATCH ONE 04210200 BZ ASFINIS NO, SO WE'RE DONE. QUIT NOW 04210210 SPACE 1 04210215 * FOR BATCH RUN, MAKE SURE MODE/STEP BITS RESET RIGHT. 04210220 NI AJOMODE,255-(AJOREPLF+AJOSRECX+AJOSOVRT+AJOREPHB) 04210225 NI AJOSTEP,255-(AJOSASM+AJOSEXEC+AJOSDUMP) RESET PHASE 04210230 B ASJPARMS GO BACK, SEARCH FOR NEXT $JOB 04210235 EJECT 04210240 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04210242 *--> INSUB: ASFLUSH FLUSH CARD RDR UNTIL NEXT COMMAND CARD * 04210245 * FLUSH UNTIL ASSIST JCL CARD FOUND, PLACING SUCH CARD INTO * 04210300 * AJOJCLCD (XXXXSORC DOES IT AUTOMATICALLY WHEN FOUND). * 04210330 * IF END-FILE FOUND, TERMINATE RUN. NOTE $STOP == EOF. * 04210360 * ENTRY CONDITIONS * 04210380 * R14= RETURN ADDRESS TO CALLING CODE. * 04210400 * EXIT CONDITIONS * 04210500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04210800 ASFLUSH $SORC AJOJCLCD,80,ASFINIS IF END-FILE, ALL DONE-QUIT J 04210850 MVI AJOBTRQ,AJO$D SET TO BE DATA AGAIN J 04210860 BR R14 RETURN TO CALLER J 04210870 EJECT 04222000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04222005 *--> INSUB: ASTIMR## TIMING SERVICES IN ASSIST MAIN PROGRAM. * 04222010 * THIS SECTION CONSISTS OF A NUMBER OF ENTRIES CALLED FROM * 04222020 * POINTS IN THE ASSIST MAIN PROGRAM, USING THE MACRO ASTIMR * 04222030 * AND A TWO-DIGIT CODE AS ONE OPERAND. EACH ENTRY PERFORMS A * 04222040 * SPECIFIC TIMING FUNCTION. AS OF 10/20/70, NO ENTRY IS CALLED * 04222050 * FROM MORE THAN ONE POINT IN ASSIST, SO ACTUALLY, THE CODE FOR* 04222060 * EACH ONE COULD BE INSERTED INLINE, SAVING SOME SPACE. THE * 04222070 * SECTIONS ARE GROUPED THIS WAY FOR EASE OF MODIFICATION, AND * 04222080 * EASE OF GENERATION, SINCE NOT ALL ENTRIES EXIST FOR ALL * 04222090 * GENERATION OPTIONS (CONTROLLED BY &$TIMER). THE ASTIMR MACRO* 04222100 * GENERATES CALLS ONLY TO THE EXISTING SECTIONS. * 04222110 * ENTRY CONDITIONS (FOR ALL ASTIMR## ENTRIES) * 04222120 * R9 = RETURN @ TO CALLING SECTION IN ASSIST. * 04222130 * EXIT CONDITIONS * 04222132 * R0,R1,R14,R15 MAY BE DESTROYED. * 04222134 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04222140 SPACE 1 04222150 AIF (&$TIMER LT 2).AST00A SKIP IF NO $TIRC USABLE 04222160 * ASTIMR00 - &$TIMER=2 - INITIALIZE OVERALL TIMER * 04222170 ASTIMR00 EQU * 04222180 $TIRC TIMREM GET REMAINING TIME, TIMER UNITS 04222190 ST R0,ASTBEGIN SAVE THIS INITIAL TIME 04222200 BR R9 RETURN TO CALLER 04222210 SPACE 1 04222220 .AST00A AIF (&$TIMER GT 0).AST04A SKIP IF ANY TIMER AT ALL 04222230 SPACE 1 04222350 * ASTIMR18 - &$TIMER=0 - PRINT INSTRUCTION COUNT. * 04222360 ASTIMR18 EQU * 04222370 LM R0,R1,ECILIMT GET ECILIMT-ECILIMP FOR COMPUTE 04222380 SR R1,R0 GET DIFFERENCE = # EXECUTED 04222390 CVD R1,AJODWORK CONVERT # EXECUTED 04222400 MVC ASHEXP2,ASPATB MOVE EDIT PATTERN OVER 04222410 ED ASHEXP2,AJODWORK+8-ASPBL/2 EDIT # INSTRS DONE 04222420 SPACE 1 04222430 ASPRNT ASHEX,ASHEXL PRINT EXECUTION MESSAGE 04222440 BR R9 RETURN TO CALLER 04222450 SPACE 1 04222470 AGO .AST24A SKIP OVER REST OF CODE 04222480 .AST04A AIF (&$TIMER GT 1).AST04B SKIP IF NOT =1 04222490 * ASTIMR04 - &$TIMER=1 - FIND TIME FOR STIMER SETTING. * 04222500 ASTIMR04 EQU * 04222510 L R0,AJOTIML LOAD TOTAL TIME LIMIT INTO PARM REG 04222520 BAL R14,ASTIMSET GO SET TIMER TO VALUE IN R0(TU) 04222530 BR R9 RETURN TO CALLER 04222540 SPACE 1 04222650 AGO .AST08A SKIP OVER CODE 04222660 .AST04B ANOP 04222670 * ASTIMR04 - &$TIMER=2 - GET TIME LEFT FOR STIMER * 04222680 ASTIMR04 EQU * 04222690 L R0,AJOTIML TOTAL TIME LIMIT (TIMER UNITS) 04222700 TM AJOAPMOD,AJOAPUST DID USER ACTUALLY SUPPLY T= VALUE 04222710 BO AST04A YES, SO LEAVE IT ALONE-OK 04222720 * USER DID NO SUPPLY T=, USE TIMREM TO GET ACTUAL LEFT. 04222730 $TIRC TIMREM GET ACTUAL TIME REMAINING 04222740 SH R0,=AL2(5000/26) 5 MILLISEC FUDGE FACTOR FOR SAFETY 04222750 AST04A BAL R14,ASTIMSET GO SET TIMER TO DESIRED VALUE 04222760 BR R9 RETURN TO CALLER 04222770 .AST08A SPACE 2 04222930 SPACE 1 04223010 * ASTIMR12 - &$TIMER=1,2 - PRINT ASSEMBLY STATISTICS. * 04223020 * ENTRY CONDITIONS * 04223030 * R12(RAT) = @ AVWXTABL DUMMY SECTION * 04223040 ASTIMR12 EQU * 04223050 USING AVWXTABL,RAT NOTE THE POINTER 04223060 LH R7,AVSTMTNO GET # STATEMENTS FOR ASTIMER 04223070 DROP RAT ERASE THE USING 04223080 ASTIME ASHASM,* CALL TIMER TO PRINT MSG 04223090 BR R9 RETURN TO CALLER 04223095 SPACE 1 04223100 * ASTIMR14 - SET UP FOR REPLACEMENT PHASE B EXEC. * 04223104 ASTIMR14 EQU * (SAME AS -16, I.E., EXECUTION) 04223106 * ASTIMR16 - &$TIMER=1,2 - SET TIMER FOR EXECUTION TIMING* 04223110 ASTIMR16 EQU * 04223120 L R0,AJOTIMR GET CURRETN TIME REMAINING FOR T= 04223122 L R1,AJOTX GET DESIRED TX= LIMIT 04223124 LA R15,AJOTD ADDRESS OF TIME TO BE SAVED FOR DUMP 04223125 BAL R14,ASTRP16 CALL ROUTINE TO CALCULATE TIME 04223126 BAL R14,ASTIMSET CALL STIMER CODE 04223130 BR R9 RETURN TO CALLING SECTION OF CODE 04223139 SPACE 1 04223140 * ASTIMR18 - &$TIMER=1,2 CALC,PRINT EXEC TIME,RATE * 04223150 ASTIMR18 EQU * 04223160 LM R6,R7,ECILIMT GET ECILIMT/ECLIMP FROM ECONTROL 04223170 SR R7,R6 GET # INSTRUCTIONS ACTUALLY DONE 04223180 CVD R7,AJODWORK CONVERT # INSTRS DONE 04223190 MVC ASHEXP2,ASPATB MOVE EDIT PATTERN OVER 04223200 ED ASHEXP2,AJODWORK+8-ASPBL/2 EDIT # INSTRUCTIONS DONE 04223210 ASTIME ASHEX,* GO TO DO TIMING 04223220 BR R9 RETURN TO CALLING SECTION 04223221 SPACE 1 04223222 * ASTIMR20 - &$TIMER=1,2. SET UP FOR DUMP 04223223 ASTIMR20 EQU * 04223224 L R0,AJOTIMR GET CURRENT TIMER SETTING 04223225 A R0,AJOTD ADD IN TIME FOR DUMP 04223226 BAL R14,ASTIMSET CALL STIMER ROUTINE 04223227 BR R9 RETURN TO CALLER 04223228 SPACE 1 04223230 AIF (&$TIMER LT 2).AST24A SKIP IF NO ENDING TIME 04223240 * ASTIMR24 - &$TIMER=2 - COMPUTE,PRINT TOTAL ASSIST TIME * 04223250 ASTIMR24 EQU * 04223260 $TIRC TIMREM GET TIME REMAINING INTO R0 04223270 L R1,ASTBEGIN PLACE BEGINNING TIME FOR ASTIMER 04223280 LA R2,ASHEND SHOW @ OF MESSAGE 04223290 LA R3,ASHENDP SHOW @ NUMBER AREA 04223300 LA R4,ASHENDL SHOW LENGTH OF MESSAGE 04223310 SR R6,R6 SHOW NO RATE (2ND PART OF MESSAGE) 04223320 BAL R14,ASTIMERE ENTER MIDDLE SECTION OF TIME PRINTER 04223330 BR R9 RETURN TO CALLER 04223335 .AST24A ANOP 04223340 EJECT 04223350 AIF (&$TIMER LT 1).AST60A SKIP CODE IF UNNEEDED 04223900 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04223950 *--> INSUB: ASTIMSET SET INTERVAL TIMER ROUTINE * 04224000 * CALLED BY ASTIMR## SECTIONS TO SET TIMER FOR GIVEN INTERVAL. * 04226000 * **NOTE** THIS IS ONLY USE OF IBM STIMER MACRO IN ASSIST. * 04227000 * ALSO, UNDER DOS, ONLY USE OF STXIT MACRO. * 04228000 * ENTRY CONDITIONS * 04228100 * R0 = VALUE OF TIMER INTERVAL TO BE SET (TIMER UNITS = 26.04 MICS) * 04228200 * R14= RETURN ADDRESS TO CALLING SECTION IN ASTIMR## * 04228300 * EXIT CONDITIONS * 04228400 * R0,R1,R15 MAY BE MODIFIED. * 04228500 * AJOMODE IS SET TO SHOW NO TIME OVERRRUNS EXIST AT MOMENT. * 04228600 * USES MACROS: STIMER(OS) ; STXIT,SETIME, GETIME(DOS) * 04228650 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04228700 ASTIMSET EQU * 04228800 ST R0,AJOTIMR STORE VALUE AS CURRENT LAST TIMER 04228900 NI AJOMODE,255-AJOSOVRT MAKE SURE FLAG SET OFF 04229000 AIF (&$ASMLVL).ASTDOST SKIP OVER DOS TIMING OPTIONS 04229005 LR R1,R0 GET VALUE OF TIMER INTERVAL IN R1 04229010 M R0,AJ2604 MULT BY MICROSEC/TU 04229015 D R0,AJ100M CONVERT TO SEC IN R1 04229020 SETIME (R1) SET INTERVAL TIMER 04229025 GETIME TU R1 <= TIME OF DAY IN TIMER UNITS 04229030 A R1,AJOTIML R1 <= TIME OF DAY FOR TIMER INTERRPT 04229035 ST R1,ASTMRMDS SAVE TIME FOR TIMREM OPTION 04229040 STXIT IT,ASTEXIT,ASTSAVAD ALLOW TIMER INTERRUPTION 04229045 .ASTDOST AIF (NOT &$ASMLVL).ASTOSTM SKIP OS STIMER 04229050 STIMER TASK,ASTEXIT,TUINTVL=AJOTIMR 04229100 .ASTOSTM ANOP 04229150 BR R14 RETURN TO CALLER 04229200 EJECT 04229300 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04229350 *--> INSUB: ASTIMER UPDATE TIMER,PRINT ELAPSED TIME,MESSAGE * 04229400 * **NOTE** THIS IS ONLY USE OF IBM TTIMER MACRO IN ASSIST. * 04229500 * ENTRY CONDITIONS * 04229600 * R2 = @ MESSAGE TO BE PRINTED OUT * 04230000 * = 0 ==> UPDATE TIMER ONLY, DO NOT PRINT MESSAGE OUT * 04232000 * R3 = @ AREA WHERE TIME INCREMENT SHOULD BE PLACED * 04234000 * R4 = LENGTH OF MESSAGE TO BE PRINTED * 04236000 * R6 = @ WHERE SECOND PART OF MESSAGE TO GO (INSTS/SEC, ETC) * 04240000 * = 0 ==> THERE IS NO 2ND PART OF MESSAGE * 04242000 * R7 = VALUE TO BE USED IN 2ND PART OF MESSAGE, IF ANY * 04244000 * R14= RETURN @ TO CALLING SECTION OF PROGRAM. * 04245000 * USES MACROS: TTIMER(OS) ; GETIME(DOS) * 04245500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04246000 SPACE 1 04248000 ASTIMER EQU * ENTRY FOR TIMING PRINTING MODULE 04250000 AIF (&$ASMLVL).ASTOSGT SKIP IF OS TTIMER DESIRED 04250050 GETIME TU R1 <= TIME OF DAY IN TIMER UNITS 04250100 L R0,ASTMRMDS GET TIME OF DAY FOR INTERRUPT(TIME) 04250150 SR R0,R1 YIELDS TIME (TU) LEFT IN INTERVAL 04250200 .ASTOSGT AIF (NOT &$ASMLVL).ASTDSGT SKIP IF DOS GETIME IN EFFECT 04250250 TTIMER , GET TIME LEFT IN INTERVAL 04251000 .ASTDSGT ANOP 04251500 L R1,AJOTIMR GET CURRENT TIME REMAINING 04252000 ST R0,AJOTIMR STORE NEW TIME REMINAING 04254000 LTR R2,R2 IS THERE A MESSAGE TO BE PRINTED 04256000 BCR Z,R14 RETURN TO CALLER, JUST RESET TIMER 04258000 SPACE 1 04258500 * ASTIMERE ENTRY ONLY ENTERED FROM SECTION ASTIMR24,IF GEN 04259000 ASTIMERE EQU * ENTRY WITH NO TIMER UPDATE. 04259500 SR R1,R0 GET TIME DIFFERENCE 04260000 M R0,AJ2604 MULT BY 26.04 MICROSEC/TU 04262000 D R0,AJ100000 CONVERT TO MILLISEC IN R1 04264000 CVD R1,AJODWORK CONVERT ELAPSED TIME 04266000 MVC 0(ASPAL,R3),ASPATA MOVE THE EDIT PATTERN IN 04268000 ED 0(ASPAL,R3),AJODWORK+8-ASPAL/2 EDIT VALUE OVER 04270000 LTR R3,R6 TEST CODE AND MOVE OVER 04272000 BZ ASTPRINT SKIP REST IF ZERO,GO PRINT 04274000 SPACE 1 04275000 M R6,AJ1000 MULT # STMTS, GET STMTS/SEC 04276000 LTR R1,R1 MAKE SURE TIME >= 1MILLISEC 04278000 BZ *+6 SKIP DIVIDE IF 0 04280000 DR R6,R1 DIVIDE TO GET STMTS OR INSTS/SEC 04282000 CVD R7,AJODWORK CONVERT RESULT TO DECIMAL 04284000 MVC 0(ASPBL,R3),ASPATB MOVE EDIT PATTERN OVER 04286000 ED 0(ASPBL,R3),AJODWORK+8-ASPBL/2 EDIT VALUE ACCROS 04288000 ASTPRINT LR R0,R2 MOVE @ MESSAGE OVER FOR ASASPRINT 04290000 LR R1,R4 MOVE LENGTH OVER FOR ASASPRNT 04291000 * FALL THRU INTO ASASPRNT 04291500 .AST60A ANOP 04292000 SPACE 1 04292020 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292030 *--> INSUB: ASASPRNT CALLED BY ASPRNT MACRO TO PRINT A LINE. * 04292040 * THIS INSUB IS USED INSTEAD OF MANY $PRNTS TO SAVE SPACE. * 04292060 * *** MUST IMMEDIATELY FOLLOW ASTIMER SECT., IF IT EXISTS. * 04292080 * ENTRY CONDITIONS * 04292100 * R0 = @ LINE TO BE PRINTED * 04292120 * R1 = LENGTH OF LINE TO BE PRINTED. * 04292140 * R14= RETURN @ TO CALLING CODE INSIDE MAIN PROG ASSIST. * 04292160 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292180 SPACE 1 04292200 ASASPRNT $PRNT (R0),(R1) PRINT THE LINE DESIRED 04292220 BR R14 RETURN TO CALLER 04292240 EJECT 04292300 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292320 * MAIN STORAGE MANAGEMENT CODE SECTIONS. * 04292340 * THE FOLLOWING SECTIONS OF CODE CONTAIN THE INTERFACE * 04292360 * BETWEEN ASSIST AND THE OPERATING SYSTEM WITH RESPECT TO * 04292380 * DYNAMIC MEMORY MANAGEMENT. IF ASSIST MUST BE RUN UNDER * 04292400 * A SYSTEM WITHOUT SUCH FACILITIES, THIS CODE CAN BE MODIFIED * 04292420 * TO JUST SUPPLY ADDRESSES OF A FIXED STORAGE AREA. * 04292440 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292460 SPACE 2 04292480 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292490 *--> INSUB: ASMSINIT MAIN STORAGE INITIALIZATION * 04292500 * ASMSINIT IS CALLED TO OBTAIN THE LARGEST POSSIBLE * 04292520 * BLOCK OF MAIN STORAGE >= 8K BYTES, FREE BACK THE AMOUNT * 04292540 * GIVEN BY ASLENOS (OR FREE= PARM, IF USED), AND SET VALUES * 04292560 * DESCRIBING THE STORAGE AREA LEFT, WHICH IS USED AS THE * 04292580 * SINGLE DYNAMIC STORAGE AREA FOR THE ENTIRE RUN. * 04292600 * STORAGE ALLOCATION IS DONE 1 TIME ONLY FOR WHOLE BATCH. * 04292610 * ENTRY CONDITIONS * 04292620 * R14= RETURN @ TO CALLING SECTION OF CODE. * 04292640 * EXIT CONDITIONS * 04292660 * R0,R1,R2,R15 ARE MODIFIED BY THIS SECTION. * 04292680 * AJOPADL,AJOPADH HAVE BEEN SET(LOWER, UPPER LIMITS OF CORE AREA). * 04292700 * AJOSTEP SET WITH FLAG AJOMSINT TO SHOW DONE. * 04292710 * USES MACROS: GETMAIN (ONLY USE OF GETMAIN IN ASSIST). * 04292720 * SEE ALSO XOPC 16 IN EXTENDED INTERPRETER 86538280 04292721 * SEE ALSO MACRO XGPGEN (XGET/XPUT CONTROL) 01262166 04292722 * COMRG-(DOS) * 04292730 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292740 SPACE 1 04292760 ASMSINIT EQU * 04292780 OI AJOSTEP,AJOMSINT SHOW MAIN CORE OBTAINED. HALT FREE= 04292785 LA R2,AJOPADL GET @ WHERE @'S TO BE PUT 04292800 AIF (&$ASMLVL).ASGETMN FOR THE OS GETMAIN 04292802 SPACE 04292804 COMRG GET @ OF OUR COMMUNICATIONS REGION 04292806 LM R0,R1,32(R1) R0 <- HIGHEST PARTITION ADDRESS 04292807 * R1 <- END @ OF LAST PHASE LOADED 04292808 LA R1,3(R1) GET @ OF AT LEAST NEXT FULLWORD 04292809 N R1,=X'FFFFFFFC' INSURE FULLWORD BOUNDARY 04292810 N R0,=X'FFFFFFFC' MAKE SURE ON FULLWORD BOUNDARY 04292811 SR R0,R1 GET LENGTH OF FREE STORAGE LEFT 04292812 ST R1,0(R2) SAVE @ OF FREE BLOCK 04292813 ST R0,4(R2) SAVE LENGTH OF FREE BLOCK 04292814 .ASGETMN AIF (NOT &$ASMLVL).ASNGTMN IN CASE OF STATIC ALLOCATION 04292816 GETMAIN VU,LA=ASSPACE,A=(2),SP=1 GET AT LEAST 8K 04292820 .ASNGTMN ANOP 04292830 * AT THIS PT AJOPADL=@ AREA, AJOPADH=LENGTH OF IT 04292840 SPACE 1 04292860 AIF (&$DEBUG).ASZX1 SKIP IF NOT DEBUG MODE 04292880 * ZERO ENTIRE DYNAMIC MEMORY AREA FOR DEBUGGING. 04292900 LH R0,=H'-256' FOR BXH DECREMENT 04292920 L R15,AJOPADH GET LENGTH OF AREA 04292940 L R1,AJOPADL GET @ AREA 04292960 AR R15,R1 ADD BEGIN TO LENGTH TO GET END@ 04292980 AR R15,R0 ADD -256 TO ENDING @ 04293000 SPACE 1 04293020 XC 0(256,R15),0(R15) ZERO A BLOCK OF MEMORY 04293040 BXH R15,R0,*-6 LOOP BACKWARDS, ZEROING 04293060 XC 0(256,R1),0(R1) ZERO 1ST 256 TO MAKE SURE 04293080 .ASZX1 ANOP 04293100 SPACE 1 04293120 LM R0,R1,AJOPADL AJOPADL,H= AREA @, LENGTH 04293140 LR R15,R1 SAVE THE LENGTH OF THE AREA 04293160 AR R1,R0 GET UPPER @ LIMIT 04293180 ST R1,AJOPADH SAVE AS PERMANENT UPPER LIMIT 04293200 SPACE 1 04293220 * CHECK FREE VALUE, FREE SPACE AS REQUESTED. 04293240 L R0,AJOFREE GET FREE VALUE (INIT TO ASLENOS) 04293260 CR R0,R15 COMPARE FREE LENGTH TO OBTAINED ONE 04293280 BNH *+6 SKIP IF OK, FREE <= GOTTEN J 04293285 LR R0,R15 FREE WHOLE THING (LOOK FOR AS999) J 04293290 AIF (&$FREEMN EQ 0).ASZQQQ SKIP IF NO LOWER LIMIT ON FREE J 04293295 CH R0,=H'&$FREEMN' COMPARE AGAINST MINIMUM ALLOWED J 04293300 BNL *+8 SKIP IF >= MINIMUM ALLOWED J 04293305 LH R0,=H'&$FREEMN' PROBABLY ERROR, USE MINIMUM ALLOWED 04293310 .ASZQQQ ANOP J 04293315 SRL R0,3 SHIFT, REMOVE 3 BITS 04293320 SLA R0,3 SHIFT, ALIGNED ON DOUBLEWORD 04293340 BCR Z,R14 RETURN, FREE=0, SO FREE NONE 04293360 SR R1,R0 SUBTRACT FROM UPPER LIMIT 04293380 ST R1,AJOPADH NEW UPPER LIMIT 04293400 B ASMSFREE GO FREE THE SPACE REQUESTED 04293420 EJECT 04293440 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04293450 *--> INSUB: ASMSFINI FREE CURRENT DYNAMIC STORAGE AREA * 04293460 * CALLED TO FREE SPACE DESCRIBED BY AJOPADL-AJOPADH PTRS. * 04293480 * SINCE DOS USER MUST ALLOCATE OWN DYNAMIC AREA FOR THE USERS * 04293485 * PROGRAMS, THERE IS NO NEED TO FREE THIS BLOCK. * 04293490 * ENTRY CONDITIONS * 04293500 * R14= RETURN @ TO CALLING SECTION OF CODE. * 04293520 * EXIT CONDITIONS * 04293540 * R0,R1,R15 ARE MODIFIED. * 04293560 * STORAGE FROM (AJOPADL) TO (AJOPADH) HAS BEEN FREEMAIN'ED. * 04293580 * USES MACROS: FREEMAIN (ONLY USE OF FREEMAIN IN ASSIST). * 04293600 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04293620 SPACE 1 04293640 ASMSFINI EQU * 04293660 LM R15,R0,AJOPADL GET AJOPADL-AJOPADH 04293680 LR R1,R15 MOVE LOWER @ OVER 04293700 SR R0,R15 LENGTH = (AJOPADH) - (AJOPADL). 04293720 SPACE 1 04293740 ASMSFREE EQU * ENTRY POINT FROM ASMSINIT TO FREE 04293760 AIF (NOT &$ASMLVL).ASNFRMN SKIP IF DOS DYNAMIC STORAGE USE 04293766 AL R0,=XL4'01000000' SHOW SP=1 04293780 FREEMAIN R,LV=(0),A=(1) FREE THE SPACE TO OS 04293800 .ASNFRMN ANOP 04293810 BR R14 RETURN TO CALLER 04293820 EJECT 04294000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04294025 *--> INSUB: ASRECL## RECORD LIMIT CONTROL * 04294050 * VARIOUS ENTRIES IN THIS SECTION ARE CALLED TO MANIPULATE * 04294100 * RECORD CONTROL VARIABLES. EACH SECTION IS NORMALLY CALLED * 04294150 * ONLY ONE PLACE, BUT ARE GROUPED HERE FOR EASE OF CHANGE, AND * 04294200 * SETUP FOR DIFFERING OPTIONS. * 04294250 * ENTRY CONDTIONS * 04294300 * R9 = RETURN ADDRESSS OF CALLING CODE * 04294350 * EXIT CONDITIONS * 04294400 * R0,R1,R14,R15 MAY BE DESTROYED. * 04294450 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04294500 SPACE 04294510 * ASRECL02 - LEND INITIAL 10 RECORDS CPP 04294520 ASRECL02 LA R0,10 USEFUL CONSTANT CPP 04294530 ST R0,AJORECNT LEND 10 RECS. FOR HEADER, PARM CPP 04294540 BR R9 RETURN CPP 04294545 SPACE 1 04294550 * ASRECL04 - INITIALIZE TOTAL RECORD COUNT * 04294600 ASRECL04 EQU * 04294650 AIF (&$RECORD EQ 2).ASR04A SKIP IF $TIRC EXISTS 04294700 L R0,AJORECL GET TOTAL RECORD ALLOTMENT CPP 04294750 .ASR04A AIF (&$RECORD LT 2).ASR04B SKIP IF NO $TIRC 04294850 * CALCULATED RECORD LIMIT: =RECREM (IF USER SUPPLIED NO 04294900 * R= PARM. OR MIN(RECREM, USER R= PARM)). 04294950 $TIRC RECREM GET # LEFT SAID BY SYSTEM 04295000 TM AJOAPMOD,AJOAPUSR DID USER ACTUALLY SPECIFY 04295050 BZ ASR04A NO, SO JUST USE RECREM 04295100 AIF (&$RECOVR).ASRPSU1 SKIP IF R= SHOULD BE USED-PSU BATS 04295125 C R0,AJORECL CHECK AGIANST USER R= 04295150 BNH *+8 SKIP IF MINIMUM THERE ALREADY 04295200 .ASRPSU1 L R0,AJORECL GET USER SPECIFIED R= RECORD LIMIT 04295250 .ASR04B ANOP CPP 04295265 ASR04A A R0,AJORECNT ADD REM. OF INIT. 10 BORROWED CPP 04295270 SH R0,=H'11' SUB. INIT. 10 + 1 FOR AM005 CPP 04295280 * R0=AJORECL-(10-AJORECNT)-1 CPP 04295290 ST R0,AJORECNT STORE NEW MAX LINES (OK IF NEG) CPP 04295300 BR R9 RETURN CPP 04295310 SPACE 1 04295450 * ASRECL14 - SET RECORD COUNT BEFORE REPL PHASE B. 04295500 ASRECL14 EQU * JUST SAME AS FOR EXECUTE TIME 04295550 SPACE 1 04295600 * ASRECL16 - RECORD CONTROL JUST BEFORE USER EXECUTION. 04295650 * AJORECNT = MIN(AJORECNT, RX=) - RD= . 04295700 * THIS METHOD ALLOWS FOR DUMP IF DESIRED. 04295750 ASRECL16 EQU * 04295800 L R0,AJORECNT GET CURRENT LINES LEFT-TOTAL 04295850 L R1,AJORX GET DESIRED TOTAL FOR EXEC+DUMP 04295900 LA R15,AJORD @ RECORDS SAVED FOR DUMP 04295950 BAL R14,ASTRP16 CALL COMPUTING ROUTINE 04296000 ST R0,AJORECNT STORE THE VALUE COMPUTED 04296050 NI AJOMODE,255-AJOSRECX REMOVE POSSIBLE OVERRUN FLAG 04296100 BR R9 RETURN TO CALLER 04296150 SPACE 1 04296200 * ASRECL20 - RESET RECORD CONTROL JUST BEFORE USER DUMP DONE. 04296250 ASRECL20 EQU * 04296300 L R0,AJORECNT GET # LEFT FROM EXECUTION 04296350 A R0,AJORD ADD THOSE SAVED FOR DUMP 04296400 ST R0,AJORECNT STORE CORRECT NEW VALUE 04296450 NI AJOMODE,255-AJOSRECX REMOV OVERRRUN FLAG IF ON 04296500 BR R9 RETURN TO CALLER 04296550 SPACE 2 04296600 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04296625 *--> INSUB: ASTRP16 COMPUTE VALUES FOR BEFORE EXECUTION * 04296650 * USED BY (ASTIMR,ASRECL,ASPAGE)16 TO COMPUTE THE VALUE FOR * 04296700 * CONTROL FOR USER EXECUTION. THE VALUE IS THE MINIMUM OF * 04296750 * REMAINING VALUE AND THE USER EXECUTION VALUE. THEN SUBTRACT * 04296800 * AMOUNT TO BE SAVED FOR A DUMP. * 04296850 * ENTRY CONDITIONS * 04296900 * R0 = CURRENT VALUE OF COUNTER (AJOTIMR,AJORECNT,AJOPREM) * 04296950 * R1 = EXECUTION VALUE (AJOTX, AJORX, AJOPX) * 04297000 * R15= @ DUMP VALUE (AJOTD, AJORD, AJOPD) * 04297050 * EXIT CONDITIONS * 04297100 * R0 = MIN ((R0), (R1)) - 0(R15). IF <0, = 0(R15) & 0(R15) = 0. * 04297150 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04297200 ASTRP16 EQU * 04297250 CR R0,R1 WAS REMAINING LESS THAN EXEC SPECFD 04297300 BL *+6 YES, USE IT SINCE MIN 04297350 LR R0,R1 NO, USE EXECUTION TIME SPECIFIED VAL 04297400 S R0,0(,R15) SUBTRACT VALUE SAVED FOR DUMP 04297450 BCR P,R14 RETURN IF OK 04297500 A R0,0(,R15) ADD THE VALUE BACK TO 0 OR ABOVE 04297550 SR R1,R1 GET A 0 04297600 ST R1,0(,R15) ZERO OUT-SO WE DON'T GIVE HIM MORE 04297650 BR R14 RETURN TO CALLING SECTION 04297700 EJECT 04297750 AIF (NOT &$PAGE).ASPG100 SKIP IF NO PAGE CONTROL 04297800 **--> INSUB: ASPAGE## PAGE CONTROL CODE FOR PAGE MODE LIMITS + + + + 04297850 *+ THESE SECTIONS CALLED TO SET LINE AND PAGE LIMITS. NOTE THAT+ 04297900 *+ THEY DO NOT BOTHER TO CHECK WHETHER PAGE CONTROL MODE IS + 04297950 *+ ON OR NOT. THIS IS SAFE BECAUSE THESE ACTIONS HAVE NO + 04298000 *+ EFFECT WHATSOEVER IF PAGE CONTROL NOT ON, SINCE XXXXIOCO + 04298050 *+ SECTIONS DO NO CHECKING UNLESS IT IS. + 04298100 *+ NOTE THAT SECTIONS OF ASTIMR##, ASRECL##, AND ASPAGE## HAVING+ 04298150 *+ SAME TWO-DIGIT CODE FOR END GENERALLY ARE CALLED TOGETHER. + 04298200 *+ ENTRY CONDITIONS + 04298250 *+ R9 = RETURN ADDRESS TO CALLING SECTION OF CODE. + 04298300 *+ EXIT CONDITIONS + 04298350 *+ R0,R1,R14,R15 MAY BE DESTROYED. + 04298400 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 04298450 SPACE 04298460 * INITIAL PRE-RUN ALLOTMENT OF 10 LINES CPP 04298470 ASPAGE02 LA R0,10 USEFUL CONSTANT CPP 04298480 ST R0,AJOLREM STORE AS LINES REM. ON PAGE CPP 04298490 XC AJOPREM(4),AJOPREM ZERO PAGES LEFT CPP 04298500 NI AJIOPR,255-AJIOSING TURN OFF POSSIBLE SING. SP. FLAG CP 04298510 BR R9 RETURN CPP 04298520 SPACE 04298530 *+ ASPAGE04 - INITIALIZE FOR WHOLE RUN. SET UP FOR + 04298550 *+ DEFINITE NEW PAGE SKIP, SINGLE SPACE IF REQUESTED. + 04298600 ASPAGE04 EQU * 04298650 L R1,AJOP GET ALLOTED # OF PAGES CPP 04298700 LA R0,10 # OF LINES INITIALLY RESERVED CPP 04298725 S R0,AJOLREM GET NUMBER REALLY USED <=10 CPP 04298730 LCR R0,R0 GET NEG. TO SUBTR. FROM THIS PG. CP 04298735 BZ *+10 IF NONE USED, NO CHANGES CPP 04298750 A R0,AJOL SUB # USED FROM MAX LINES/PG CPP 04298760 BCTR R1,0 AND REDUCE # PAGES BY 1 CPP 04298770 STM R0,R1,AJOLREM ST LINES ON CURR. PG & # PAGES CPP 04298800 NI AJIOPR,255-AJIOSING REMOVE POSSIBLE SINGLE SPACE FLAG 04298850 OC AJIOPR,AJIOSS ENTER SINGLE SPACE FLAG IF REQUIRED. 04298900 TM AJIOPR,AJIOPAGE IS CPAGE IN FORCE? CPP 04298910 BCR Z,R9 NO, THEN IGNORE CPP 04298920 OC AJOASMF2,AJIOSS TURN ON SS FLAG IF SET CPP 04298930 BR R9 RETURN 04298950 SPACE 1 04299000 AIF (&$REPL EQ 0).ASPNR SKIP IF NO REPL 04299050 *+ ASPAGE14 - PAGE CONTROL BEFORE REPLACE PHASE B. 04299100 ASPAGE14 EQU * 04299150 SR R0,R0 ZERO REGISTER 04299200 ST R0,AJOLREM SAME AS ASPAGE16, BUT ****NEW PAGE** 04299250 * FALL THRU INTO ASPAGE16. 04299300 .ASPNR ANOP 04299350 SPACE 1 04299400 * ASPAGE16 - PAGE LIMIT SET BEFORE USER PROGRAM EXECUTE. 04299450 ASPAGE16 EQU * 04299500 L R0,AJOPREM GET CURRENT # PAGES LEFT 04299550 L R1,AJOPX GET NUMBER FOR EXEC+DUMP 04299600 LA R15,AJOPD GET VALUE FOR DUMP 04299650 BAL R14,ASTRP16 CALL GENERAL COMPUTE FOR EXEC 04299700 ST R0,AJOPREM STORE COMPUTED VALUE BACK 04299750 NI AJIOPR,255-AJIOSING REMOVE POSSIBLE SINGLESPACE FLAG 04299800 OC AJIOPR,AJIOSSX FLAG SINGLE SPACE IF DESIRED 04299850 BR R9 RETURN TO CALLER 04299900 SPACE 1 04299950 *+ ASPAGE20 - SET UP PAGE LIMIT FOR DUMP. + 04300000 ASPAGE20 EQU * 04300050 LM R15,R0,AJOLREM GET LINES & PAGES REMAINING CPP 04300100 LR R14,R15 SAVE LINES ON CURRENT PAGE CPP 04300110 SPACE 04300112 * FIVE LINES HAVE BEEN SAVED ON THE LAST PAGE FOR CPP 04300114 * POSSIBLE AM005 MSG. ADD THEM BACK NOW UNLESS CPP 04300116 * NO DUMP WILL EXIST (THEY WILL BE ADDED LATER) CPP 04300118 LTR R0,R0 CHECK IF LAST PAGE CPP 04300120 BNZ ASPG20A IF NOT, IGNORE CPP 04300130 LA R14,5(R15) ADD BACK RESERVED 5 LINES CPP 04300140 C R14,AJOL IS THAT > MAX LINES/PAGE? CPP 04300150 BNH ASPG20A NO, THEN NO PROBLEM CPP 04300160 LR R14,R15 YES, THEN TAKE BACK THE 5 CPP 04300170 ASPG20A A R0,AJOPD ADD IN PAGES RESV'D FOR DUMP CPP 04300180 BZ *+6 IF PD=0 SAVE 5 FOR LATER CPP 04300190 LR R15,R14 ELSE USE FIGURE FROM ABOVE CPP 04300200 STM R15,R0,AJOLREM RESTORE NEW LINES/PAGES LIMITS CPP 04300210 NI AJIOPR,255-AJIOSING REMOVE POSSIBLE SINGLE SPACE FLAG 04300220 OC AJIOPR,AJIOSSD PUT IN SSD FLAG IF EXISTS 04300230 BR R9 RETURN 04300250 .ASPG100 ANOP 04300300 EJECT 04300350 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04300400 * DISASTROUS TERMINATIONS. * 04300450 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04300500 SPACE 1 04308000 * ASZERR1 - COULD NOT OPEN PRINTER - ABORT * 04310000 AIF (&$ASMLVL).ASOSWTL SKIP $PRNT IF UNDER OS GENERATN 04310100 ASZERR1 $PRNT =CL50' AM001 - ASSIST COULD NOT OPEN PRINTER - ABORT',50 04310200 .ASOSWTL AIF (NOT &$ASMLVL).ASDSPNT SKIP IF DOS GENERATED $PRNT 04310300 ASZERR1 WTO 'AM001 ASSIST COULD NOT OPEN PRINTER=&$IOUNIT(3)-ABORT',X04312000 ROUTCDE=11 WRITE-TO-PROGRAMMER NOW 04312250 .ASDSPNT ANOP 04312500 TM AJIOSO,AJIOPEN COULD READER BE OPENED FOR SOURCE 04314000 BO ASZERRXI SKIP IF RDR DID OPEN OK 04316000 SPACE 1 04318000 * ASZERR2 - COULDN'T OPEN SOURC RDR - ABORT * 04320000 AIF (&$ASMLVL).ASRDRNO SKIP FOR OS WTL & ABORT 04320100 ASZERR2 $PRNT =CL50' AM002 - ASSIST COULD NOT OPEN READER - ABORT',50 04320200 .ASRDRNO AIF (NOT &$ASMLVL).ASNOWTL SKIP IF NO OS WTL ALLOWED 04320300 ASZERR2 WTO 'AM002 ASSIST COULD NOT OPEN READER=&$IOUNIT(1)-ABORT', X04322000 ROUTCDE=11 WRITE-TO-PROGRAMMER RATHER THAN WTL 04322250 .ASNOWTL ANOP 04322500 SPACE 1 04324000 ASZERRXI LA R2,16 SET RETURN CODE TO DISASTER 04326000 B ASFINISZ TAKE ERROR EXIT 04328000 EJECT 04330000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04332000 * FINISH AND EXIT SECTION * 04334000 * HAVE TOTAL RUN TIME COMPUTED AND PRINTED. * 04336000 * CLOSE ALL DCB'S WHICH ARE CURRENTLY OPEN (XXXXFINI). * 04338000 * FREE ALL THE STORAGE OBTAINED BY GETMAIN AT BEGINNING. * 04340000 * STORE VALUE IN R2 AS RETURN CODE. * 04342000 * RETURN TO CALLING PROGRAM. * 04344000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04346000 SPACE 1 04348000 ASFINIS EQU * NORMAL TERMINATION LABEL 04350000 ASTIMR 24,2 PRINT END MESSAGE IF REQUIRED 04352000 SPACE 1 04354000 XCALL XXXXFINI HAVE ALL DCB'S CLOSED 04356000 SR R2,R2 SET RETURN CODE TO 0 04358000 SPACE 1 04360000 * ASFINISZ ENTERED IF COULDN'T OPEN RDR OR PRINTER * 04362000 * RETURN ALL GETMAIN'ED STORAGE TO THE SYSTEM. * 04363000 ASFINISZ EQU * 04364000 BAL R14,ASMSFINI GO RETURN ALL SPACE USED TO OS 04366000 SPACE 1 04370000 AIF (&$ASMLVL).ASNOEOJ SKIP FOR OS RETURN 04370500 EOJ SVC RETURN TO SUPERVISOR IF DOS 04371000 .ASNOEOJ AIF (NOT &$ASMLVL).ASDSEOJ SKIP IF DOS EOJ IN EFFECT 04371500 L R1,4(R13) GET PREVIOUS SAVE AREA PTR 04372000 ST R2,16(R1) STORE VALUE IN R2 AS RETURN CODE 04374000 $RETURN RGS=(R14-R12) RETURN TO CALLER 04376000 .ASDSEOJ ANOP 04377000 SPACE 1 04378000 AIF (&$TIMER LT 1).AST65A SKIP STIMER EXIT IF NON REQR 04379000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04380000 * TIMER EXIT ROUTINE * 04382000 * THIS SECTION IS CALLED IF A TIMER INTERRUPT OCCURS DURING * 04382100 * AN ASSIST RUN. IT FLAGS AJOSOVRT BIT IN AJOMODE TO NOTE THE * 04382200 * OVERRUN, THEN EXAMINES AJOSTEP TO DETERMINE WHAT STEP ASSIST * 04382300 * IS IN. DEPENDING ON THE STEP, IT TAKES ACTION TO ENSURE * 04382400 * THAT THE PARTICULAR PHASE WILL BE TERMINATED FAIRLY QUICKLY. * 04382500 * PHASES CAN BE ASSEMBLY, EXECUTION, DUMP, OR ASSEMBLY+EXEC * 04382600 * (THE LAST CASE BEING DURING A REPLACE PHASE B, IF ANY). * 04382700 * **NOTE** UNDER DOS USE, ANY MODIFIED REGS MUST BE PLACED IN * 04382800 * THE INTERRUPT SAVE AREA BEFORE EXITING * 04382900 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04402000 SPACE 1 04404000 AIF (&$ASMLVL).ASTEXIN SKIP IF UNDER OS GENERATION 04404100 ASTEXIT BALR R15,0 ESTABLISH ADDRESSABILITY 04404200 USING *,R15 INFORM OF BASE REG R15 USING 04404300 .ASTEXIN AIF (NOT &$ASMLVL).ASTEXDS SKIP IF UNDER DOS GENERATION 04404400 USING ASTEXIT,R15 NOTE TEMPORARY USING 04406000 ASTEXIT STM R14,R12,12(R13) SAVE ALL , FOR SAFETY 04408000 .ASTEXDS ANOP 04409000 LA R11,ASJOBCON GET @ MAIN TABLE BACK 04410000 OI AJOMODE,AJOSOVRT SHOW REAL TIME OVERRUN 04412000 TM AJOSTEP,AJOSEXEC WAS INTERPRETER BEING USED 04414000 BZ ASTEXASM NO, GO TO CHECK ASM FLAG 04416000 L R10,AJOECOPT GET @ ECONTROL BLOCK 04418000 MVI ECFLAG1,$ECTIMEX TELL EXECUT TO QUIT NEXT BRANCH 04420000 SPACE 1 04420100 ASTEXASM EQU * 04420200 * **NOTE** THE MAIN PROGRAMS FOR BOTH PASSES OF THE 04420300 * ASSEMBLER TEST AVTAGS2 1 TIME FOR EACH STATEMENT. 04420400 * **NOTE** IT IS ALWAYS SAFE TO SET THE BIT THIS WAY. 04420500 L RAT,AJOVWXPT GET @ VWXTABL 04420600 USING AVWXTABL,RAT NOTE PTR THERE 04420700 OI AVTAGS2,AJOASTOP SET BIT-ASSEMBLER WILL STOP 04420800 DROP RAT ZAP USING 04420900 * WE MAY BE IN DUMP STEP (AJOSDUMP IN AJOSTEP). IN 04421000 * IN ANY CASE, SET AJOSRECX , WHICH WILL STOP ANY 04421100 * ASSIST MODULE, THE NEXT TIME ANY OUTPUT IS DONE. 04421200 TM AJOSTEP,AJOSDUMP ARE WE IN DUMP STEP J 04421250 BZ *+8 NO, SKIP OVER OVERRUN SET 04421260 OI AJOMODE,AJOSRECX SHOW RECORDS EXCEEDED(PSEUDO) 04421300 ASTEXIZ EQU * 04422000 AIF (&$ASMLVL).ASTEXEX SKIP IF UNDER OS GENERATION 04422200 EXIT IT RETURN TO DOS SUPERVISOR 04422400 ASTSAVAD DC 18F'-1' DOS -IT- INTERRUPT SAVE AREA 04422600 ASTMRMDS DS F TIME OF DAY FOR TIMER INTERRUPT 04422800 .ASTEXEX AIF (NOT &$ASMLVL).ASTEX2 SKIP IF UNDER DOS GENERATION 04423000 LM R14,R12,12(R13) RELOAD REGS 04424000 BR R14 RETURN TO OS/360 04426000 .ASTEX2 ANOP 04427000 DROP R15 KILL THE USING 04428000 .AST65A ANOP 04429000 EJECT 04430000 * PRIMARY SPACE ALLOCATION CONTROL WORDS * 04432000 ASSPACE DC A(8192,524288) GET ALL WE CAN, UP TO 512 K 04434000 ASTBEGIN DS F FOR TIME LEFT AT BEGINNING 04442000 ASFWORK DS F TEMPORARY WORKAREA 04444000 ASPARMSV DS A SAVE WORD FOR @ PARM FILED,ETC 04446000 SPACE 1 04448000 * *** HEADER FOR BEGINNING OF EACH JOB *** 04448100 ASH1HD DC C'1*** ASSIST &$VERSLV-&$GENDAT' CPP 04448200 * DC C' &$MCHNE/&$MODEL:&$SYSTEM' CPP 04448250 * INSTRUCTION SET-DECIMAL,FLOAT,PRIVIL 04448300 DC C' INS=S',(&$DECSA)C'D',(&$FLOTA)C'F',(&$PRIVOP)C'P' 04448400 DC (&$S370A)C'7' SUPPORT DEC. FLOAT, PRIV, 370 CPP 04448450 DC C'/X=',(&$XIOS)C'B',(1-&$XXIOS)C'G',(&$HEXI*&$HEXO)C'H' 04448460 DC (&$EXINT)C'O' SUPPORT BASIC,XGET,HEXS,XOPC CPP 04448470 DC ((1-(&$HEXI+&$HEXO+&$XIOS+&$EXINT+3)/4)*&$XXIOS)C'NONE' 04448480 * TIME,RECORDS,PAGE CHECKING/CONTROL 04448500 DC C', CHECK=' CPP 04448600 T HDRLN &$TIMER,(&$TDF,&$TMX,&$TXDF,&$TXMX) CPP 04448601 R HDRLN &$RECORD,(&$RDF,&$RMX,&$RXDF,&$RXMX) CPP 04448602 DC ((&$COMNT+99)/100)C'C&$COMNT' CPP 04448610 * MAJOR OPTIONALS-CMPRS,COMNT, 04448700 * 026 KEYPUNCH, MACRO, REPLACE MONITOR 04450000 DC C', OPTS=',(&$CMPRS)C'C' COMPRESS OPTION? CPP 04452000 DC ((&$DISKU+1)/2)C'D(&$DISKU/&$FREE)' DISKU ON, FREE DEF? 04452020 DC (&$KP26)C'K',(&$MACROS)C'M(&$MACDF)' CPP 04452050 P HDRLN &$PAGE,(&$PDF,&$PMX,&$PXDF,&$PXMX) CPP 04452051 DC ((&$REPL+1)/2)C'R',(&$VIRT)C'V',(&$XREF)C'X' CPP 04453000 DC C' PENN STATE ***' CPP 04454000 ASH1H$L EQU *-ASH1HD LENGTH OF THIS HEADER 04458000 SPACE 1 04460000 * EDIT PATTERN, OUTPUT HEADINGS * 04462000 AIF (&$TIMER LT 1).AST70A SKIP EDIT PATTERN 04463000 ASPATA DC X'40202021204B202020' EDIT PATTERN FOR TIMING 04464000 ASPAL EQU L'ASPATA LENGTH ATTRIB OF EDIT TIME PATTERN 04464500 .AST70A ANOP 04465000 ASPATB DC X'4020202020202120' EDIT PATTERN FOR # INSTRUCTIONS DONE 04466000 ASPBL EQU L'ASPATB LENGTH ATTRIB OF STMT EDIT PATTERN 04470000 SPACE 1 04472000 AIF (&$TIMER GT 0).AST75A SKIP IF NOT =0 04472100 * EXECUTION STATISTICS MESSAGE FOR &$TIMER=0 ONLY. 04472200 ASHEX DC C'0*** EXECUTION:' 04472300 ASHEXP2 DC ZL(ASPBL)'0',C' INSTRUCTIONS EXECUTED ***' 04472400 ASHEXL EQU *-ASHEX LENGTH OF MESSAGE 04472500 .AST75A AIF (&$TIMER EQ 0).AST80A SKIP MESSAGES IF UNNEEDED 04473000 ASHASM DC C' *** ASSEMBLY TIME =' MESSAGE IDENTIFICATION CPP 04474000 ASHASMP DS CL(ASPAL) 04476000 DC C' SECS, ' 04478000 ASHASMN DC ZL(ASPBL)'0',C' STATEMENTS/SEC ***' 04480000 ASHASML EQU *-ASHASM DEFINE LENGTH OF MESSAGE 04482000 SPACE 1 04484000 ASHEX DC C'0*** EXECUTION TIME =' 04486000 ASHEXP DS CL(ASPAL) 04488000 DC C' SECS. ' 04490000 ASHEXP2 DC ZL(ASPBL)'0',C' INSTRUCTIONS EXECUTED - ' 04492000 ASHEXN DC ZL(ASPBL)'0',C' INSTRUCTIONS/SEC ***' 04494000 ASHEXL EQU *-ASHEX DEFINE TOTAL LENGTH OF MESSAGE 04496000 .AST80A ANOP 04497000 ASCARDMS DC C'*** FIRST CARD NOT READ: ' CARD MESSAGE J 04497100 SPACE 1 04498000 ASEMSG DC C' *** AM003 - STORAGE OVERFLOW BEFORE EXECUTION; EXECUT#04500000 TION DELETED ***' 04502000 SPACE 1 04504000 ASNORMAL DC C' *** AM004 - NORMAL USER TERMINATION BY RETURN ***' 04506000 SPACE 1 04508000 ASRTOVR DC C' *** AM005 - TIME OR RECORDS HAVE BEEN EXCEEDED ***' 04510000 SPACE 1 04512000 AIF (NOT &$VIRT).ASVINO2 SKIP ERR MSG. TEXT IF NOT NEEDED 04512100 VIASERM1 DC C'0*** AMV06 - VIRTUAL PROGRAM DOES NOT START AT LOCATIO#04512200 N 0 - EXECUTION DELETED ***' V 04512300 SPACE 1 04512400 VIASERM2 DC C'0*** AMV07 - NO PROGRAM RECEIVED IN VIRTUAL MODE - EXE#04512500 CUTION DELETED ***' V 04512600 SPACE 1 04512700 .ASVINO2 ANOP 04512800 AIF (&$TIMER LT 2).AST90A SKIP END MESSAGE IF ^NEED 04513000 ASHEND DC C' *** TOTAL RUN TIME UNDER ASSIST' 04514000 DC (&$VIRT)C'-V',C' = ' 04514100 ASHENDP DC ZL(ASPAL)'0',C' SECS ***' 04516000 ASHENDL EQU *-ASHEND LENGTH OF MESSAGE 04518000 SPACE 1 04519000 .AST90A ANOP 04519500 ASHEXGO DC C' *** PROGRAM EXECUTION BEGINNING - ANY OUTPUT BEFORE E#04520000 XECUTION TIME MESSAGE IS PRODUCED BY USER PROGRAM ***' 04522000 SPACE 2 04522100 * ***** PARM FIELD OPTION LISTS ***** 04522200 SPACE 1 04522300 * ASPARLIM - SUPPLIES LIMIT VALUES FOR NUMERICAL PARMS, 04522400 * PLUS DEFAULT VALUES FOR ANY OVERRIDABLE VALUES. 04522500 * **NOTE** MOST OF OVERRIDABLE ONES COULD BE SUPPLIED 04522600 * IN DEFAULT PARM FIELD BELOW ALSO. 04522700 ASPARLIM DS 0D ALIGN 04522800 * UPPER LIMIT VALUES-CANNOT BE INCREASED BEYOND THESE. 04522900 DC C'I=&$IMX' MAXIMUM INSTRUCTION COUNT 04523000 AIF (NOT &$PAGE).ASPL10 SKIP IF NO PAGE CONTROL 04523100 DC C',L=&$LMX,P=&$PMX,PD=&$PDMX,PX=&$PXMX' PAGE LIMITS 04523200 .ASPL10 ANOP 04523300 DC C',R=&$RMX,RD=&$RDMX,RX=&$RXMX' RECORD LIMITS 04523400 AIF (&$TIMER EQ 0).ASPL20 SKIP IF NO TIMING 04523500 DC C',T=&$TMX,TD=&$TDMX,TX=&$TXMX' TIME LIMITS 04523600 .ASPL20 ANOP 04523700 SPACE 1 04523800 * OVERRIDABLE DEFAULT VALUES FOR RESETTABLE PARM OPTIONS. 04523900 DC C',&$BATCH,NOCMPRS,NOCOMNT,DUMP=0,FREE=&$FREE' 04524000 DC C',LIST,LOAD,NOMONIT,NERR=0' (LARGE NO LONGER EXISTS) J 04524100 AIF (NOT &$DATARD).ASPL25 SKIP IF NO DATA RDR 04524200 DC C',DATA,SYSIN' DEFAULT - THEY BOTH EXIST 04524300 .ASPL25 ANOP 04524400 AIF (&$DEBUG).ASPL30 SKIP IF NO DEBUG 04524500 DC C',DEBUG=0' NO VALUE FOR DEBUG 04524600 .ASPL30 ANOP 04524700 *********AIF (NOT &$EXINT).ASPL35 **********NEW INTERPRETER****** 04524710 DC C',IECF=0' DEFAULT: NO STATISTICS 04524720 .ASPL35 ANOP 04524730 AIF (NOT &$KP26).ASPL40 SKIP IF NO ALTERNATE KEYPINCH 04524800 DC C',KP=29' DEFAULT IS 029 04524900 .ASPL40 ANOP 04525000 AIF (NOT &$PAGE).ASPL50 SKIP IF NO PAGE CONTROL 04525100 * CHANGE BELOW TO ---CPAGE TO PAGE CONTROL DEFAULT. 04525200 DC C',NOSS,NOSSX,NOSSD,CPAGE' MAKE CPAGE DEFAULT IF GEN J 04525300 .ASPL50 ANOP 04525400 AIF (&$DISKU NE 1).ASPL60 SKIP 04525500 DC C',NODISKU' NORMAL - DO INCORE 04525600 .ASPL60 ANOP 04525700 AIF (NOT &$PUNCH).ASPL70 SKIP IF NOPUNCH 04525800 DC C',PUNCH' REAL PUNCH EXISTS 04525900 .ASPL70 ANOP 04526000 AIF (&$REPL EQ 0).ASPL90 SKIP IF NO REPLACE 04526100 DC C',NOREPL,RFLAG=0' 04526200 .ASPL90 ANOP 04526300 AIF (NOT &$PRIVOP).ASPL100 SKIP IF NO PRIVILEGED OPS 04526400 DC C',NOSUPER' 04526500 DC (&$VIRT)C',VIRT' VIRT. SIMULATION MODE ON? V 04526520 .ASPL100 ANOP 04526600 AIF (NOT (&$DECK OR &$OBJIN)).ASPL110 SKIP IF NO DECKS 04526610 DC C',NODECK,NOOBJIN' 04526620 .ASPL110 ANOP 04526630 AIF (NOT &$RELOC).ASPL120 SKIP IF NO RELOC MODE 04526640 DC C',NORELOC' MAKE NON RELOCATED NORMAL MODE 04526650 .ASPL120 ANOP 04526660 AIF (&$S370 NE 2).ASPL130 SKIP IF NOT SIMULATING S/370 04526666 DC C',ALGN' MAKE DEFAULT ALGN (ALIGNMENT NEEDED) 04526668 .ASPL130 ANOP 04526670 AIF (NOT &$MACROS).ASPL140 SKIP IF NO MACROS 04526672 DC C',MACRO=&$MACDF,MACTR=&$MMACTR,MNEST=&$MMNEST' CPP 04526674 DC C',MSTMG=&$MMSTMG' MACRO-RELATED DEFAULTS CPP 04526675 AIF (NOT &$MACSLB).ASPL135 SKIP IF NO LIBRARY MACS 04526676 DC C',NOLIBMC' DEFAULT = NO CALL LIBR MCS 04526678 .ASPL135 ANOP 04526680 .ASPL140 ANOP 04526682 AIF (NOT &$XREF).NOXREF6 SKIP IF NO XREF A 04526683 DC C',XREF=(&$XREFDF(1),&$XREFDF(2),&$XREFDF(3))' DEFAULTA 04526685 .NOXREF6 ANOP A 04526690 DC C' ' PUT IN BLANK AT END*****MUST HAVE*** 04526700 ASPARL$L EQU *-ASPARLIM LENGTH OF ENTIRE FIELD 04526800 SPACE 2 04526900 * DEFAULT VALUES FOR LIMIT VALUES AND NONRESETTABLE PARMS. 04527000 ASPARDF DS 0D ALIGN 04527100 AIF (NOT &$PAGE).ASPD10 SKIP IF NO PAGE CONTROL 04527200 DC C'L=&$LDF,P=&$PDF,PD=&$PDDF,PX=&$PXDF,' 04527300 .ASPD10 ANOP 04527400 DC C'R=&$RDF,RD=&$RDDF,RX=&$RXDF' RECORD DEFAULTS 04527500 AIF (&$TIMER EQ 0).ASPD20 SKIP IF NO TIMER 04527600 DC C',T=&$TDF,TD=&$TDDF,TX=&$TXDF' 04527700 .ASPD20 ANOP 04527800 DC C' ' PUT IN BLANK AT END*****MUST HAVE*** 04527900 ASPARD$L EQU *-ASPARDF LENGTH OF THIS PARM FIELD 04528000 SPACE 1 04528100 LTORG 04528200 SPACE 1 04528300 * FOLLOWING SECTION CORRESPONDS TO AJOBCON DSECT. * 04530000 ASJOBCON DS 0D 04532000 DC 16F'0' FOR ZEROING 04534000 DC F'1000' FOR CONVERSION, AJ1000 04535000 AIF (&$ASMLVL).ASJOSTU SKIP TO SET OS TIMER UNIT=26.04 04535200 DC F'333334' DOS TIMER UNITS(USEC) * 100 04535400 .ASJOSTU AIF (NOT &$ASMLVL).ASJDSTU SKIP IF DOS TU OF 1/300 SEC 04535600 DC F'2604' FOR TIME CONVERSIONS 04536000 .ASJDSTU ANOP 04537000 DC F'100000' FOR TIME CONVERSIONS 04538000 DC F'100000000' 100 MILLION, TIME CONVERSIONS 04540000 DC V(VWXTABL) @ MAIN ASSEMBLER TABLE 04541000 DC V(EXECUT) ADCON FOR INTERPRETER CODE 04541500 DS 0D 04542000 AIF (NOT &$KP26).ASNKP26 SKIP IF NO 026 KEYPUNCH ALL 04542050 SPACE 1 04542100 * TRANSLATE TABLE - 026-->029 KEYPUNCH. ALLOWS KP=26. 04542150 * 0 1 2 3 4 5 6 7 8 9 A B C D E F SAME EXCEPT )+(=' 04542200 DC X'000102030405060708090A0B0C0D0E0F' 0X 04542250 DC X'101112131415161718191A1B1C1D1E1F' 1X 04542300 DC X'202122232425262728292A2B2C2D2E2F' 2X 04542350 DC X'303132333435363738393A3B3C3D3E3F' 3? 04542400 DC X'404142434445464748494A4B5D4D4E4F' 4X ) 4C 04542450 DC X'4E5152535455565758595A5B5C5D5E5F' 5X + 50 04542500 DC X'606162636465666768696A6B4D6D6E6F' 6X ( 6C 04542550 DC X'707172737475767778797A7E7D7D7E7F' 7X = 7B ' 7C 04542600 DC X'808182838485868788898A8B8C8D8E8F' 8X 04542650 DC X'909192939495969798999A9B9C9D9E9F' 9X 04542700 DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' AX 04542750 DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' BX 04542800 DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' CX 04542850 DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' DX 04542900 DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' EX 04542950 DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' FX 04543000 SPACE 1 04543050 .ASNKP26 ANOP 04543100 DC CL136' ' FOR BLANKING 04544000 DC C' ' FOR CARRIAGE CONTROL 04546000 ORG ASJOBCON+AJOB$L GET REMAINING LENGTH FOR SECTION 04548000 DS 0D SEE WHAT LENGTH IS 04550000 DROP R10,R11,R13 KILL LEFTOVER USINGS 04552000 TITLE '*** APCBLK DSECT - APARMS PARM CODE BLOCK ***' 04552100 **--> DSECT: APCBLK APARMS PARM CODE BLOCK. . . . . . . . . . . . . 04552200 *. THIS BLOCK DESCRIBES A PARM OPTION TABLE, GIVING THE NAME OF . 04552300 *. THE PARM, A FLAG BYTE, AND AN OFFSET ADDRESS TO A PROCESSING . 04552400 *. SECTION OF CODE IN CSECT APARMS. IT IS USED ONLY IN APARMS. . 04552500 *. LOCATION: INSIDE TABLE APBPARMA IN CSECT APARMS. . 04552600 *. GENERATION: EACH APCBLK IS CREATED BY 1 CALL TO APCGN MACRO. . 04552700 *. NAMES: APC----- . 04552800 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 04552900 SPACE 1 04554000 APCBLK DSECT 04556000 * EQU FLAG LIST FOR APCFLAG) - GIVE HANDLING TYPES. 04556050 APCYESNO EQU B'00000001' (APCFLAG)- YES/NO PARM;ELSE =PARM 04556100 APCYES1B EQU B'00000010' (APCFLAG)- FOR YES/NO TYPE PARMS 04556150 * ON=> 1BIT=>YES;OFF=> 1BIT=> NO 04556200 APCNINCR EQU B'00000010' (APCFLAG)- IF =PARM DECIMAL VALUE 04556250 * IF VALUE SET, DO NOT INCREMENT 04556300 APCD EQU B'00000100' (APCFLAG)- PARM=DECIMAL # VALUE 04556350 APCNRSET EQU B'00001000' (APCFLAG)- ONCE SET, DO NOT RESET 04556400 APCCALL EQU B'00010000' (APCFLAG)- CALL ROUTINE -APCADDR @ 04556450 APCSETU EQU B'00100000' (APCFLAG)-VALUE SET BY USER-$JOB CRD 04556500 APCSETP EQU B'01000000' (APCFLAG)-VALUE SET FROM REAL PARM 04556550 APCSETLD EQU B'10000000' (APCFLAG)- VALUE WAS SET BY LIMIT 04556600 * OR DEFAULT VALUE. 04556650 APCSET EQU APCSETLD+APCSETU+APCSETP VALUE SET BY ANYBODY 04556700 APCP$L EQU AJOCP$L LENGTH OF MAXIMUM # CHARS IN PARM 04556750 SPACE 1 04556800 * VARIABLES IN APCBLK - GIVE PARM NAME AND FLAGS 04556850 APCPARM DS CL(APCP$L) EBCDIC FORM OF PARM, R-PADDED BLANKS 04556900 APCFLAG DS B FLAGS- DESCRIBE TYPE OF HANDLING 04556950 APCAJOFS DS AL1 OFFSET OF VARIABLE FROM AJO$PARM 04557000 APCLKSET DS B FLAG SHOWING WHICH CALL SET/IF SET 04557050 APCBITS DS B FLAG USED TO SET FOR YES OPT OF Y/N 04557100 ORG APCBITS BACK UP TO OVERLAY FOR =PARM 04557150 APCADDR DS AL1 OFFSET FROM APAJUMP TO ROUTINE 04557200 APC$L EQU *-APCBLK LENGTH OF 1 APCBLK 04576000 TITLE '*** APARMS - USER PARM FIELD PROCESSING CSECT ***' 04577000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04577025 *--> CSECT: APARMS USER PARM FIELD PROCESSING CSECT * 04577050 * SCANS USER PARM FIELD, SETS VALUES IN AJOBCON DSECT. * 04577100 * ENTRY CONDITIONS * 04577150 * R9 = @ OF ACTUAL PARM FIELD CHARACTER STRING. * 04577200 * R10= LENGTH OF PARM FIELD AT 0(R9). * 04577220 * R11= ADDRESS OF AJOBCON DUMMY SECTION AREA. * 04577250 * EXIT CONDITIONS * 04577300 * AJOPARM IN AJOBCON NOW HAS USER PARM FIELD, RIGHT-PADDED WITH ' '.* 04577350 * VARIOUS FLAGS IN AJOBCON ARE NOW SET(SEE CODE STARTING AT APAJUMP)* 04577400 * USES DSECTS: AJOBCON,APCBLK * 04577420 * USES MACROS: $DBG,$RETURN,$SAVE,$TIRC,APCGN,XDECI * 04577440 * *NOTE* AS OF 8/12/70, THIS PROGRAM IS MORE GENERAL THAN * 04577450 * CURRENTLY NEEDED, TO ALLOW FOR FUTURE NEW PARM OPTIONS. * 04577500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04577550 SPACE 1 04577600 APARMS CSECT 04578000 $DBG ,NO SHOW NO DEBUG CODE FROM $SAVE/RETURN 04580000 SPACE 1 04582000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04583000 * REGISTER USAGE AND CONVENTIONS IN APARMS CSECT * 04584000 * R0,R1,R2 = TEMPORARY WORK REGISTERS * 04586000 * R3 ADDRESS OF CURRENT APCBLK WHEN LOOKING DOWN PARM LIST * 04588000 * R4 = APCP$L = LENGTH OF 1 APCBLK. USED AS INCREMENT IN BXLE'S. * 04590000 * R5 = @ LAST APCBLK IN TABLE OR PART OF TABLE SEARCHED, BXLE LIMIT.* 04592000 * R6 = SCAN POINTER TO NEXT CHARACTER TO BE PROCESSED IN PARM FIELD * 04594000 * R7 = 1 CONSTANT FOR USE IN BXH'S AND INCREMENTING,DECREMENTING* 04596000 * R8 = BASE REGISTER * 04598000 * R9 = @ PARM FIELD ON INPUT. USED AS BYTE REGISTER THEREAFTER. * 04600000 * R10= LENGTH OF PARM FIELD ON INPUT. @ LAST BYTE OF PARM AS LIMIT @* 04602000 * R11= @ AJOBCON BLOCK, ON INPUT AND UNCHANGED * 04604000 * R12 (UNUSED) * 04606000 * R13= @ CALLING PROGRAM'S SAVE AREA, UNCHANGED * 04608000 * R14= INTERNAL LINK REGISTER, WORK REGISTER * 04610000 * R15= TEMPORARY WORK REGISTER * 04612000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04614000 SPACE 1 04616000 USING AJOBCON,R11 NOTE POINTER TO JOB TABLE 04618000 $SAVE RGS=(R14-R12),SA=NO,BR=R8 04620000 EJECT 04622000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04624000 * INITIALIZATION SECTION * 04626000 * INITIALIZE FLAGS IN LEADING NIBBLES OF APCFLAG BYTES. * 04628000 * CHECK TO SEE IF A PARM FIELD WAS USED. IF SO, MOVE IT OVER * 04630000 * TO INTERNAL AREA, WITH BLANKS FOLLOWING, TO MAKE SCANNING * 04632000 * EASIER AND USE LESS REGISTERS. SET UP FOR DOING ANALYSIS. * 04634000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04636000 SPACE 1 04638000 LA R4,APC$L FOR INCREMENT ON MANY BXLE'S 04642000 USING APCBLK,R3 NOTE USING, WILL USE R3 ALWAYS 04646000 SPACE 1 04648000 * ***** TEST FOR FLAG RESET REQUIRED. DO SO IF NEEDED **** 04648500 TM AJOAPMOD,AJOAPRSE WAS THIS CALL A RESET CALL 04649000 BZ APNOTRSE NO, SO SKIP RESET THIS TIME 04649500 LA R3,APBPARMA @ BEGINNING OF TABLE 04650000 LA R5,APBPARMB-APC$L @ LAST ELEMENT IN TABLE 04650250 SPACE 1 04650500 NI APCLKSET,255-APCSET REMOVE ALL SET FLAGS 04652000 BXLE R3,R4,*-4 LOOP THRU TABLE 04654000 SPACE 1 04656000 APNOTRSE EQU * EXIT HERE IF NOT A RESET CALL 04657000 LA R7,1 USEFUL CONSTANT 04658000 LR R6,R10 MOVE LENGTH OF PARM OVER 04658200 * IF AJOAPMOV SET, LEAVE PARM WHERE IT IS (MUST BE LIMIT 04658400 * OR DEFAULT, WHICH HAVE BLANK AFTER PARM.) 04658600 TM AJOAPMOD,AJOAPMOV SHOULD IT BE MOVED 04658800 BO *+12 YES, GO TO MOVE AND PAD CODE 04659000 LR R6,R9 MOVE BEGINNING ADDRESS OVER TO INIT 04659200 AR R10,R9 ADD BEGIN TO LENGTH GIVING END IN 10 04659400 B APMINIT SKIP OVER TO INIT CODE 04659600 MVC AJOPARM,AJOBLANK+1 BLANK OUT ENTIRE PARM AREA 04659800 SR R6,R7 DECREMENT FOR MVC,CHECK FOR SIGN 04666000 BM APFINE THERE WAS NO PARM FIELD,BRANCH 04668000 LA R0,AJOP$L-1 LENGTH-1 OF MAXIMUM PARM FIELD 04670000 CR R6,R0 IS LENGTH SMALL ENOUGH 04672000 BNH *+6 SKIP IF LEGAL 04674000 LR R6,R0 TOO BIG,USE MAXIMUM 04676000 STC R6,*+5 STORE THIS LENGTH INTO MVC 04678000 MVC AJOPARM($),0(R9) MOVE PARM FIELD OVER, R-PAD WITH BL 04679000 AIF (NOT &$KP26).APNKP2T SKIP IF NO 026 KEYPUNCH 04679100 STC R6,*+5 PUT LENGTH INTO TR 04679200 TR AJOPARM($),AJTRTB26 TRANSLATE SO WILL PRINT RIGHT 04679300 .APNKP2T ANOP 04679400 LA R10,AJOPARM(R6) SET LIMIT @ FOR SCANNING 04681000 LA R6,AJOPARM INIT SCAN POINTER TO BEGINNING 04682000 APMINIT EQU * ENTRY TO BEGIN INIT FOR SCANNING 04682200 SR R9,R9 CLEAR FOR USE AS BYTE REG AFTER NOW 04682400 MVC APFLOCKT+1(1),AJOAPSET MOVE INTO TM INSTR TO TEST LOCK 04683000 EJECT 04684000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04686000 * PARAMETER FIELD SCAN SECTION * 04688000 * CHECK FOR PARM BEGINNING WITH 'NO', AND SET FLAGS IF * 04690000 * FOUND. SCAN FOR , = OR BLANK TERMINATING PARM, SAVING UP TO * 04692000 * FIVE CHARS OF PARM, RIGHT-PADDED WITH BLANKS, FOR LOOKUP. * 04694000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04696000 SPACE 1 04698000 APMSCAN EQU * BEGINNING OF SCAN FOR 1 PARM OPTION 04700000 CLI 0(R6),C' ' SEARCH FOR NONBLANK 04702000 BNE *+8 FOUND NONBLANK, EXIT LOOP 04704000 APMSCANX BXH R6,R7,APFINC BUMP SCAN PTR, GO TO CHECK FOR END 04706000 SPACE 1 04707000 SR R2,R2 SHOW EXPECTED POSTIVE PARM 04708000 AIF (&$DEBUG).APND1 SKIP IF PRODUCTION 04710000 XSNAP STORAGE=(*AJOPARMA,*AJIOFLAG),LABEL='APMSCAN', X04712000 IF=(AJODEBUG,O,1,TM) SNAP IF DEBUG ON 04714000 .APND1 ANOP 04716000 CLC 0(2,R6),=C'NO' IS PARM PRECEDED BY NO 04718000 BNE APMSCA NO,SO SKIP,LEAVING R2 SET 04720000 LA R2,2 SET TO SHOW NO VALUE 04722000 AR R6,R2 ADD 2 TO SCAN PTR, BEYOND 'NO' 04724000 SPACE 1 04726000 * SEARCH FOR A POSSIBLE DELIMITER CHARACTRER (^ALPHABETIC) 04726100 APMSCA EQU * 04726200 LR R15,R6 SAVE @ OF BEGINNING OF PARM 04726300 CLI 0(R6),C'A' IS IT A DELIMITER 04726400 BL *+8 PROBABLY-BRANCH OUT 04726500 BXH R6,R7,*-8 LOOP UNTIL FIND (NOT BLANKS END PRM) 04726600 SPACE 1 04726700 LR R1,R6 @ DELIMITER 04726800 SR R1,R15 R1 = LENGTH OF PARM 04726900 BNP APMSCANX EXTRA DELIMITER-GO TO IGNORE IT 04727000 SR R1,R7 R1= LENGTH(PARM OPTION) - 1 04727100 LA R0,APCP$L-1 MAXIMUM POSSIBLE LENGTH-1 OF PARM 04727200 CR R1,R0 WAS PARM TOO LONG TO BE LEGAL ONE 04727300 BH APMSCANX YES, SO IGNORE IT 04727400 * **NOTE** COULD CHANGE ABOVE TO ALLOW TRUNC OF LONG PARMS 04727500 STC R1,APMSCMVC+1 STORE LENGTH-1 INTO MVC 04727600 MVC AJOCOMP,AJOBLANK FILL PARM WITH BLANKS 04727700 APMSCMVC MVC AJOCOMP($),0(R15) MOVE OPTION IN, PAD WITH BLANKS 04727800 AR R6,R7 POSITION SCAN PTR BEYOND DELIMITER 04727900 EJECT 04758000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04760000 * PARAMETER LOOKUP AND FLAGGING * 04762000 * USING 1ST LETTER OF OPTION AS TABLE INDEX, SEARCH SECTION * 04762100 * OF LOOKUP TABLE FOR IT. IF NOT FOUND, IGNORE IT. IF FOUND, * 04762200 * USE BITS OF ITS APCFLAG TO DETERMINE HANDLING. IF THIS CALL * 04762300 * ACTUALLY SETS A VARIABLE, OR INTO ITS APCFLAG BIT(S) SHOWING * 04762400 * WHAT TYPE CALL PRODUCED THIS VALUE, FOR LATER CHECKING. * 04762500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04776000 SPACE 1 04776100 CLI AJOCOMP,C'Z' MAKE SURE CHARACTER OK (NOT DIGIT) 04776200 BH APFINC BAD OPTION NAME-IGNORE IT 04776300 IC R9,AJOCOMP GET FIRST LETTER OF OPTION 04776400 LA R5,B'00111100' MASK FOR MIDDLE 4 BITS OF OPTION 04776500 NR R9,R5 MASK OUT ALL BUT MIDDLE BITS 04776600 SRL R9,1 SHIFT FOR HALFWORD INDEX VALUES 04776700 LA R3,APBPARMA BEGINNING OF TABLE @ 04776800 AH R3,APLNDX(R9) = @ BEGINNING OF TABLE SECTION 04776900 LA R5,APBPARMA-APC$L @ BEGINNING - 1 ELEMENT LENGTH 04777000 AH R5,APLNDX+2(R9) = @ LAST POSSIBLE ELEMENT IN SECTION 04777100 * AT THIS PT, R3 IS INDEX, AND R5 LIMIT FOR ENSUING BXLE 04777200 SPACE 2 04777300 APLOOK CLC AJOCOMP,APCPARM COMPARE NEW PARM WITH TABLE ENTRY 04780000 BE APFOUND SKIP OUT IF FOUND 04782000 BXLE R3,R4,APLOOK LOOP THRU TABLE 04784000 B APFINC FELL THRU, NOT IN TABLE, IGNORE IT 04786000 SPACE 1 04788000 APFOUND EQU * EXIT HERE WHEN PARM IDENTIFIED 04790000 AIF (&$DEBUG).APND2 SKIP IF PRODUCTION 04796000 XSNAP LABEL='APFOUND',STORAGE=(*APCBLK,*APCBLK+8), #04798000 IF=(AJODEBUG,O,1,TM) SNAP FOUND BLOCK,IF DEBUG 04800000 .APND2 ANOP 04802000 APFLOCKT TM APCFLAG,$ CAN THIS PARM BE SET BY CURRENT CALL 04802020 BNO APFNOSET NO,SO IGNORE HIM 04802040 IC R9,APCAJOFS GET OFFSET IN AJOBCON TO VARIABLE 04802060 * IF PARM=DECIMAL #, CONVERT THE VALUE INTO R0. 04802080 TM APCFLAG,APCD WAS THIS DECIMAL CONVERT 04802100 BZ *+8 NO, SKIP CONVERT 04802120 BAL R14,APDECON CALL ROUTINE TO SCAN, PUT VALU IN R0 04802140 * IF VALUE NOT SET PREVIOUSLY, SKIP TO TEST FOR TYPE 04802160 TM APCLKSET,APCSET HAS IT BEEN SET ALREADY BY ANYBODY 04802180 BZ APFTYPE NO, SO SAFE TO DO IT THIS TIME 04802200 * HAS ALREADY BEEN SET-CHECK IF CAN DO IT AGAIN. 04802220 TM APCFLAG,APCNRSET IS IT ALLOWED TO BE RESET 04802240 BO APFNOSET NOT ALLOWED TO RESET-SKIP OUT 04802260 TM APCLKSET,APCSETU+APCSETP WAS IT SET BY $JOB 04802280 BZ APFDFSK NO, SKIP CHECK FOR DEFAULT-OK TO SET 04802300 TM AJOAPMOD,AJOAPDEF IS THIS DEFAULT TYPE CALL 04802320 BO APFNOSET YES, JUMP OUT-DON'T OVERRIDE VALUE 04802340 APFDFSK EQU * 04802360 * IF PARM IS YES/NO TYPE, GO TO RESET ITS VALUE 04802380 TM APCFLAG,APCYESNO WAS IT YES/NO TYPE 04802400 BO APFYESNO YES, SO GO PROCESS IT 04802420 SPACE 1 04802440 * ***** PARM=VALUE PROCESSING ***** 04802460 TM APCFLAG,APCNINCR SEE IF DECIMAL# AND CAN'T INCR 04802480 BZ APFCALL ALLOWABLE TO CHANGE-GO SEE IF CALL 04802500 * VARIABLE ALREADY SET AND NEW VALUE SUPPLIED. VALUE 04802520 * CAN BE RESET IF IT IS LESS THAN OR EQUAL OLD ONE. 04802540 C R0,AJO$APC(R9) COMPARE (ASSUMES FULLWORD VALUE) 04802560 BH APFNOSET TOO HIGH-IGNORE HIM 04802580 * IF FLAGGED, CALL INDIVIDUAL PROCESSING ROUTINE. 04802600 * THIS TAKES CARE OF SPECIAL CASES. 04802620 APFCALL TM APCFLAG,APCCALL DOES PARM REQUIRE CALL 04802640 BZ APFSTORE NO, SO JUST STORE VALUE(ASSUMED F) 04802660 IC R2,APCADDR GET OFFSET @ OF ROUTINE 04802680 LA R14,APFSET RETURN @ TO SHOW VALUE SET 04802700 B APAJUMP(R2) GO TO THE ROUTINE INDICATED 04802720 * **NOTE- ROUTINE WILL EXIT TO R14(SET) OR APFNOSET. 04802740 APFSTORE ST R0,AJO$APC(R9) STORE THE COMPUTED VALUE 04802760 B APFSET GO TO FLAG THAT VALUE HAS BEEN SET 04802780 * TYPE TEST - DEFINITELY LEGAL TO SET NEW VALUE. 04802800 APFTYPE TM APCFLAG,APCYESNO WAS IT YES/NO TYPE PARM 04802820 BZ APFCALL NO WAS = PARM OR SPECIAL-GO DO IT 04802840 * ***** YES/NO PARM PROCESSING ***** 04802860 * AT THIS POINT R2=0 => YES VALUE, R2=2 => NO VALUE. 04802880 * R9 = OFFSET FROM AJO$APC TO BYTE TO BE FLAGGED. 04802900 * DETERMINE POLARITY OF FLAG BYTE AND SET ACCORDINGLY. 04802920 APFYESNO TM APCFLAG,APCYES1B DOES A YES VALUE => A BIT ON 04802940 BO *+6 YES, SO LEAVE R2 AS IS/SKIP 04802960 AR R2,R7 NO. YES VALUE=> BIT OFF-INCREM R2 04802980 LA R14,AJO$APC(R9) GET ACTUAL @ BYTE TO BE SET 04803000 OC 0(1,R14),APCBITS SET BIT(S) DEFINITELY ON 04803020 IC R2,APFYNTAB(R2) GET THE BYTE FROM CONTROL TABLE 04803040 LTR R2,R2 MUST WE NOW RESET GIVEN BIT TO 0 04803060 BNZ *+10 NO, SKIP SINCE BIT SET TO 1 OK 04803080 XC 0(1,R14),APCBITS YES, MUST TURN BIT OFF TO BE RIGHT 04803100 SPACE 1 04803120 * ***** COMMON PARM VALUE SETTING EXITS ***** 04803140 APFSET EQU * VALUE WAS ACTUALLY SET THIS TIME 04803160 OC APCLKSET,AJOAPSET OR IN TO SHOW WHO ACTUALLY SET VALUE 04803180 APFNOSET EQU * EXIT HERE IF NOT SET THIS TIME 04803200 APFINC CR R6,R10 HAVE WE REACHED END YET(R10=LIMIT @) 04826000 BL APMSCAN NO,RETURN FOR NEXT PARM 04828000 EJECT 04830000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04832000 * COMPLETION SECTION * 04834000 * IF AJOAPMOD WAS FLAGGED WITH AJOAPFIN, THE CURRENT CALL TO * 04836000 * APARMS IS THE LAST BEFORE ASSEMBLY BEGINS. ANY OPTION NEEDING* 04837000 * IT MAY THEN TEST THE SET BITS IN ITS APCFLAG TO DETERMINE * 04838000 * WHERE THE PARM CAME FROM WHICH ACTUALLY SET ITS VALUE. * 04840000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04842000 SPACE 1 04844000 APFINE EQU * EXIT HERE AT END OF 1 COMPLETE SCAN 04844050 TM AJOAPMOD,AJOAPFIN WAS THIS LAST CALL 04844100 BZ APNOTLST NO, SO DON'T MAKE CHECKS 04844150 AIF (&$TIMER LT 2).APFNNT SKIP IF NOT SPECIAL TIMER 04844200 SPACE 1 04844250 * FLAG AJOAPMOD IF USER ACTUALLY SUPPLIED T=. IF HE DID 04844300 * NOT, ASSIST WE USE TIMREM VALUE INSTEAD OF DEFAULT, 04844350 * THUS ALLOWING MORE PRECISE CONTROL OVER TIME. 04844400 TM APBT+(APCLKSET-APCBLK),APCSETU+APCSETP VALUE FROM $J,PAR 04844450 BZ *+8 NO,DON'T SET THE FLAG 04844500 OI AJOAPMOD,AJOAPUST YES, USER ACTUALLY GAVE VALUE-NOTE 04844550 SPACE 1 04844600 .APFNNT AIF (&$RECORD LT 2).APFNNR SKIP IF NO SPECIAL RECORDS 04844650 SPACE 1 04844700 * FLAG AJOAPMOD IF USER ACTUALLY SUPPLIED R=. IF HE DID 04844750 * NOT, WILL USE $TIRC RECREM FOR PRECISE RECORD COUNT. 04844800 TM APBR+(APCLKSET-APCBLK),APCSETU+APCSETP DID HE SET VALUE 04844850 BZ *+8 NO, SKIP OVER 04844900 OI AJOAPMOD,AJOAPUSR SHOW USER SET R= HIMSELF 04844950 .APFNNR ANOP 04845000 SPACE 2 04845050 AIF (NOT &$ACCT).APNCOM1 SKIP IF NO ACCOUNT DISCRIM 04858050 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04858100 * ACCOUNT NUMBER CHECKING * 04858150 * THE FOLLOWING CODE CAN BE USED TO SET DIFFERENT OPTIONS * 04858200 * DEPENDING ON THE ACCOUNT NUMBER OF THE JOB. AS OF 03/01/71, * 04858250 * THE ONLY DISCRIMINATION PRESENT IS TO REQUIRE COMMENT CHECKING * 04858300 * CERTAIN ACCOUNTS, I.E., INTRODUCTORY COURSES. * 04858350 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04858400 SPACE 1 04858450 $TIRC (NAME,AJOACCT) GET ACCOUNTING INFO 04858500 LA R0,L'AJOACCT INCREMENT FOR BXLE 04858550 LA R1,APXCOMLB @ LAST ENTRY IN TABLE FOR LIMIT BXLE 04858600 LA R2,APXCOMLA START OF ACCT# TABLE FOR INDEX BXLE 04858650 SPACE 1 04858700 * SEARCH TABLE FOR ACCOUNT NUMBER. 04858750 CLC AJOACCT,0(R2) IS THIS THE ONE 04858800 BE APXCOMFN YES, JUMP OUT OF LOOP 04858850 BXLE R2,R0,*-10 LOOP UNTIL END OF TABLE 04858900 B APXCOMXT NOT FOUND - IGNORE IT 04858950 APXCOMFN OI AJOASMF2,AJOCOMNT COMMENT CHECKING NOW IN EFFECT 04859000 SPACE 1 04859050 APXCOMXT EQU * EXIT POINT FROM ACCT# CHECKING 04859100 * CHECK FOR CERTAIN NAME TO ALLOW SPECIAL DEBUGGING. 04859150 AIF (NOT &$JRM).APNCOM1 SKIP IF NOT ANY SPECIAL JRM CODE 04859200 CLC =C'MASHEY J ',AJOPRGNM CHECK FOR NAME, SPECIAL OPT 04859220 BNE APNOTJRM NO, NOT NAME, SO SKIP 04859230 CLC AJOACCT,APACCJRM IS ACCOUNT CURRENT ONE 04859235 BNE APNOTJRM NO, IT ISN'T, SKIP 04859240 OI AJODMPF,$EC$JRM SET FLAG TO MAKE EXECUT DO EXTRA 04859250 APNOTJRM EQU * SKIP HERE IF NOT SPECIAL DEBUG 04859260 .APNCOM1 AIF (NOT &$VIRT).APNNNV SKIP IF NOT VIRT MODE POSSIBLE 04859300 SPACE 2 04859310 * REPL SUPERCEDES VIRT, BUT VIRT IMPLIES NO RELOC POSSIBLE. 04859315 TM AJOEXEF,AJOVIRT IS VIRTUAL MACHINE SIMULATION ON? 04859320 BNO APNOTLST NO, STOP WORRYING 04859330 TM AJOMODE,AJOREPLF TEST IF ALSO REPL. V 04859340 BNO APNORLOC IF NO, MUST THEN INHIBIT RELOC. 04859350 NI AJOMODE,255-AJOVIRT ELSE, REPL WIPES OUT VIRT 04859360 B APNOTLST HAVE JUST CANCELLED VIRT, SO DON 04859370 APNORLOC NI AJOMODE,255-AJORELOC VIRT ON, SO INHIBIT RELOC 04859380 OI AJOEXEF,AJOSUPER VIRT ALSO IMPLIES PRIVILEGED OPS OK 04859390 .APNNNV ANOP END OF VIRT ONLY CODE 04859395 APNOTLST EQU * EXIT HERE UNLESS LAST CALL TO AP 04859700 APRET $RETURN RGS=(R14-R12),SA=NO 04860000 EJECT 04862000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04863000 *--> INSUB: APDECON CONVERT DECIMAL PARM VALUE * 04864000 * ENTRY CONDITIONS * 04866000 * R6 = SCAN PTR TO 1ST CHARACTER OF DECIMAL # * 04868000 * R14= RETURN @ TO CALLING SECTION OF APARMS * 04870000 * EXIT CONDITIONS * 04872000 * R0 = CONVERTED RESULT OF DECIMAL #, =0 IF THERE WERE NO NUMBERS * 04874000 * R6 = SCAN POINTER TO 1ST NON-DECIMAL DIGIT FOUND * 04876000 * THIS ROUTINE MODIFIES REGS R0,R1,R6 * 04878000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04880000 SPACE 1 04882000 APDECON LR R1,R6 SAVE INIT SCAN POINTER 04884000 SR R0,R0 SET DEFAULT AMOUNT 04886000 XDECI R0,0(R6) SCAN AND CONVERT VALUE 04888000 LR R6,R1 MOVE SCAN PTR @ OVER INTO PTR REG 04890000 BR R14 RETURN TO CALLING SECTION OF CODE 04892000 EJECT 04922000 * * * * * INDIVIDUAL PARAMETER FIELD ANALYSIS SECTIONS. * 04924000 * ALL LABELS ARE OF FORM APA$$$$$ WHERE $$$$$ IS PARAMETER NAME* 04926000 APAJUMP EQU * BASE @ FOR PARM ROUTINES 04928000 SPACE 3 04930000 * PARM=VALUE TYPE PARAMETERS * 04992000 SPACE 1 04994000 AIF (NOT &$ACCT).APNACCT SKIP IF NO ACCT DISCRIMINAT 04995000 APAACCT BR R14 ACCT NUMBER OPTION *****FUTURE USE** 04996000 .APNACCT ANOP 04997000 SPACE 1 04998000 APADUMP MVI AJODMPF,$ECREGS+$ECDINST+$ECSTORG DEFAULT DUMP FLAGS 05000000 LTR R0,R0 WAS VALUE 0 (LEAVE DEFAULT OK) 05000500 BCR Z,R14 YES, SO LEAVE FLAG THERE 05001000 NI AJODMPF,255-$ECSTORG JUST SMALL DUMP,REMV FLAG 05001500 BR R14 RETURN 05002000 SPACE 1 05004000 AIF (&$DEBUG).APNDEBG SKIP IF DEBUG NOT MODE 05006000 APADEBUG STC R0,AJODEBUG STORE VALUE IN DEBUG FLAG 05008000 BR R14 RETURN 05010000 SPACE 1 05012000 .APNDEBG ANOP 05014000 SPACE 2 05026000 AIF (NOT &$MACROS).APNMAC SKIP IF NO MACRO STUFF 05026100 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05026150 * *** SCANNING CODE FOR MACRO= PARM. * 05026200 * POSSIBLE OPTIONS ARE AS FOLLOWS: * 05026300 * MACRO=N NO MACROS (ASSUMED IF IN ERROR) * 05026400 * MACRO=F F-LEVEL MACRO (BASIC REQUEST) * 05026500 * MACRO=G ADD G-LEVEL FEATURES * 05026600 * MACRO=H ADD H-LEVEL FEATURES * 05026700 * **NOTE** THE BASIC FACILITY IS THE F-LEVEL COMPATIBLE ONE. * 05026800 * SOME OF THESE OPTIONS MAY NOT BE SUPPORTED, AND IN ANY CASE, * 05026900 * CODE FOR THEM IS ALL CONDITIONAL. * 05027000 * SEE SET VARIABLES BEGINNING &$MACRO- . * 05027100 * ** SETS BITS IN AJOASMFM, SEE FLAGS AT BEGINNING OF AJOBCON. * 05027200 SPACE 1 05027300 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05027350 APAMACRO EQU * CODE FOR MACRO= 05027400 * FOLLOWING STMT MAKES ASSUMPTION OF MACRO=N. 05027500 NI AJOASMFM,(255-AJOMACRO-AJOMACRG-AJOMACRH) SET MACRO=N 05027600 SR R2,R2 CLEAR, WILL BE INDEX TO TABLE 05027700 CLI 0(R6),C'F' WAS IT MACRO=F 05027800 BE APAMACR1 YES, SKIP, LEAVE R2=0 05027900 AR R2,R7 SET R2=1 05028000 CLI 0(R6),C'G' WAS IT G 05028100 BE APAMACR1 YES, BRANCH, LEAVE R2=1 05028200 AR R2,R7 SET R2=2 05028300 CLI 0(R6),C'H' WAS IT MACRO = H 05028400 BNE APAMACRZ NO, MUST BE MACRO=N, OR ERROR-SKIP 05028500 APAMACR1 LA R2,APAMACRT(R2) GET @ FLAG BYTE FOR ACTUAL LEVEL 05028600 OC AJOASMFM(1),0(R2) OR APPRORPIATE BITS INTO FLAG 05028700 APAMACRZ BXH R6,R7,APFSET BUMPSCAN PTR, GO TO SHOW SET 05028800 * AJOASMFM FLAG BYTES FOR MACRO= F, G, H . 05028900 APAMACRT DC AL1(AJOMACRO,AJOMACRO+AJOMACRG,AJOMACRO+AJOMACRH,0) 05029000 DS 0H MUST BE HALF ALIGNED (NOTE 0 ABOVE) 05029100 .APNMAC ANOP 05029200 SPACE 1 05052000 AIF (NOT &$KP26).APKP29X SKIP IF NO 026 KEYPUNCH 05052020 APAKP EQU * KP=26 OR KP=29. 29 DEFAULT 05052040 * ANYTHING BUT KP=26 TREATED AS KP=29. 05052060 NI AJIOSO,255-AJIOKP26 RESET TO DEFAULT KP=029 05052080 LA R1,26 VALUE FOR COMPARE 05052100 CR R0,R1 WAS KP=26 SPECIFIED 05052120 BCR NE,R14 NO, VALUE SET RIGHT, RETURN 05052140 OI AJIOSO,AJIOKP26 SHOW 026 KEYPUNCH 05052160 BR R14 RETURN, GO TO APFSET 05052180 .APKP29X ANOP 05052200 SPACE 1 05052220 AIF (&$TIMER EQ 0).APNOT SKIP IF NO TIMING 05052240 * ***** SCANNING/CONVERSION FOR T=, TD=, TX= ***** * 05052260 * THE FOLLOWING CODE ALLOWS THESE PARMS TO SPECIFY * 05052280 * FRACTIONAL PARTS OF A SECOND. IT SCANS THE FRACTIONAL PART * 05052300 * IF ANY AND CONVERTS THE VALUE INTO TIMER UNITS (26.04 MICSEC * 05052320 * AND STORES IT IN APPROPRIATE LOCATION. IT ACCEPTS UP TO 3 * 05052340 * FRACTIONAL DIGITS (I.E., MILLISECONDS). * 05052360 SPACE 1 05052380 APAT EQU * 05052400 APATD EQU * 05052420 APATX EQU * 05052440 LR R1,R0 MOVE # SECONDS ON PARM OVER 05052460 M R0,AJ1000 *1000 = # MILLISECONDS 05052480 CLI 0(R6),C'.' DID HE SPECIFY FRACTION 05052500 BNE APTINT NO,JUST INTERGER-SKIP 05052520 LR R2,R1 MOVE MILLISEC # OVER FOR SAFETY 05052540 AR R6,R7 BUMP SCAN PTR BEYOND . 05052560 LR R5,R6 SAVE @ 1ST FRAFTION DIGIT 05052580 BAL R14,APDECON CALL CONVERTER FOR SCANNING 05052600 SR R5,R6 GET # DIGITS 05052620 AH R5,=H'4' ADD LIMIT+1 TO GET 3-1 OF MULTS 05052640 BNP APTIGNOR IF MORE THAN 3 DIGITS-IGNORE IT 05052660 SPACE 1 05052680 LR R1,R0 MOVE VALUE OF FRACTION 05052700 LA R15,10 VALUE FOR MULTIPLY 05052720 BAL R14,*+6 SET REG,SKIP OVER MULT & INTO LOOP 05052740 MR R0,R15 CONVERT*10 05052760 BCTR R5,R14 LOOP. END WITH # MILLISEC IN R1 05052780 AR R2,R1 ADD TO PREVIOUSLY SAVED # MILLISEC 05052800 APTIGNOR LR R1,R2 MOVE VALUE BACK TO R1 05052820 SPACE 1 05052840 * AT THIS PT, R1=# MILLISECONDS SPECIFIED 05052860 APTINT EQU * 05052880 M R0,AJ100000 GET 100*# MICROSECONDS 05052900 D R0,AJ2604 / BY 100# MICRO SEC IN A TIMER UNIT 05052920 * AT THIS PT R1 = # TIMER UNITS IN INTERVAL 05052940 LR R0,R1 MOVE OVER FOR LATER STORE 05052960 TM APCLKSET,APCSET HAS IT BEEN SET BY ANYONE 05052980 BZ APFSTORE NO, DEFINITELY SAFE TO STORE-GO 05053000 TM APCLKSET,APCSETU+APCSETP SET BY USER 05053020 BZ *+12 NO, SKIP DEFAUL TEST 05053040 TM AJOAPMOD,AJOAPDEF IS IT DEFAUL T CALL 05053060 BO APFNOSET YES, ALREADY SET-DON'T OVERRRIDE 05053080 SPACE 1 05053100 C R0,AJO$APC(R9) COMPARE TO PREVIOUS VALUE 05053120 BH APFNOSET TOO-HIGH-IGNORE HIM 05053140 B APFSTORE OK-GOTO STORE VALUE 05053160 .APNOT ANOP 05053180 AIF (NOT &$XREF).NOXREF5 A 05053300 SPACE 3 05053305 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053310 * THIS ROUTINE IS THE CROSS REFERENCE OPTION SCANNING ROUTINE * 05053315 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053320 APAXREF EQU * 05053325 IC R0,AJOXREF GET FLAG IN A 05053330 LR R2,R0 MOVE FLAG TO R0,R1,R2 A 05053335 LR R1,R2 05053340 N R0,APXRB3 GET RIGHT BITS SET A 05053345 N R1,APXRB2 05053350 N R2,APXRB1 A 05053355 LR R12,R6 GET POINTER TO PARM FIELD A 05053360 CLI 0(R12),C'(' SEE IF LIST OF VALUES A 05053365 BNE APXRXRO PROCESS FIRST ONLY A 05053370 AR R12,R7 BUMP PAST "(" A 05053375 CNOP 0,4 MAKE SURE OF PROPER ALIGNMENT A 05053380 BAL R14,APXRCHK CHECK FOR PROPER DELIMETER A 05053385 DC A(APXRSD) WHERE TO GO IF OMITTED A 05053390 BAL R14,APXRSET SET VALUE INTO PROPER REGISTER A 05053395 SLL R15,4 MOVE TO RIGHT POSITION A 05053400 LR R0,R15 MOVE TO CORRECT REGISTER 05053405 AR R12,R7 BUMP TO NEXT CHARACTER A 05053410 APXRSD EQU * CHECK FOR VALUES IN SD= 05053415 AR R12,R7 BUMP PAST VALUE A 05053420 CNOP 0,4 MAKE SURE OF ALIGNMENT A 05053425 BAL R14,APXRCHK CHECK PROPER DELIMITER A 05053430 DC A(APXRSR) ADDRESS TO GO TO IF USING DEFAULTS 05053435 BAL R14,APXRSET SET CORRECT VALUE A 05053440 SLL R15,2 MOVE TO CORRECT POSITION A 05053445 LR R1,R15 MOVE TO RIGHT REG A 05053450 AR R12,R7 BUMP TO NEXT CHARACTER A 05053455 APXRSR EQU * DO SR= DEFAULT A 05053460 AR R12,R7 BUMP POINTER A 05053465 CLI 0(R12),C')' WAS IT OMITTED A 05053470 BE APXRADD YES, DO ADD A 05053475 CLI 1(R12),C')' PROPER DELIMITER A 05053480 BNE APXRFIN NO, BAG IT A 05053485 BAL R14,APXRSET GET NUMBER IN REG A 05053490 LR R2,R15 MOVE TO RIGHT REG A 05053495 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053500 * THIS SECTION ADDS THE REGISTERS R0,R1,R2. THESE REGISTERS HAVE THE * 05053505 * CORRECT VALUES IN THEM EITHER BY THE DEFAULT VALUES OR BY SETTING * 05053510 * A FLAG WITH THE XREF= OPTION. * 05053515 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053520 APXRADD EQU * A 05053525 AR R1,R0 COLLECT XREF AND SD VALUES A 05053530 AR R2,R1 COLLECT ALL A 05053535 STC R2,AJOXREF SET ACTUAL FLAG A 05053540 APXRRET EQU * A 05053545 LA R6,1(R12) SET PROPER DELIMITER A 05053550 B APFSET SHOW VALUE SET A 05053555 APXRXRO BAL R14,APXRSET GET NUMBER A 05053560 SLL R15,4 MOVE TO RIGHT POSITION A 05053565 LR R0,R15 MOVE TO RIGHT REGS A 05053570 B APXRADD SET ACTUAL XREF FLAG A 05053575 SPACE 2 05053576 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053577 *-->INSUB: APXRSET CONVERT NUMBER TO INTERNAL FORM * 05053580 * CONVERTS XREF PARM NUMBERS AND CHECKS TO SEE IF THEY'RE IN THE * 05053582 * RANGE 0-3. * 05053584 * ENTRY CONDITIONS * 05053585 * R12= POINTER TO NUMBER TO BE CONVERTED * 05053587 * EXIT CONDITIONS * 05053589 * R15= CONVERTED NUMBER * 05053590 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053595 APXRSET EQU * INSUB TO SET VALUE IN REGISTER 15 A 05053600 MVC APXRWORK+7(1),0(R12) MOVE NUMBER TO WORK AREA A 05053605 PACK APXRWORK(8),APXRWORK A 05053610 CVB R15,APXRWORK CONVERT NUMBER TO INTERNAL FORM A 05053615 C R15,=X'00000003' SEE IF TOO BIG A 05053620 BH APXRFIN DENOTE ERROR A 05053625 BR R14 RETURN A 05053630 SPACE 2 05053632 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053634 *-->INSUB: APXRCHK CKECK FOR VALID DELIMITER * 05053635 * CHECKS FOR ',' IN XREF=(A,B,C) PARM FIELD. SPECIAL RETURN * 05053637 * FOR XREF=(A). * 05053639 * ENTRY CONDITIONS * 05053640 * R12= POINTER OF NEXT CHARACTER * 05053642 * EXIT CONDITIONS * 05053645 * R14= @ OF ROUTINE TO BRANCH TO * 05053647 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053650 APXRCHK EQU * A 05053655 CLI 0(R12),C',' WAS NEXT OPERAND OMITTED? A 05053660 BE APXRNXT YES: DO NEXT SECTION 05053665 CLI 1(R12),C',' PROPER DELIMITER? A 05053670 BNE APXRFIN NO: GO TO ERROR A 05053675 B 4(R14) GO BAVK A 05053680 APXRNXT L R14,0(R14) GET ADDRESS 05053685 BR R14 GO TO ROUTINE 05053690 APXRFIN EQU * 05053695 LR R6,R12 GET @ BACK IN R6 05053700 B APFNOSET ERROR FOUND: SHOW NOT SET A 05053705 APXRB1 DC A(3) MASK OUT ALL BUT LOWER BITS A 05053710 APXRB2 DC A(12) MIDDLE BITS A 05053715 APXRB3 DC A(48) TOP BITS A 05053720 APXRWORK DC D'0' WORK AREA A 05053725 .NOXREF5 ANOP 05053730 * TABLE OF APCBLKS FOR PARM FIELD ANALYSIS * 05054000 APBPARMA DS 0D DEFINE BEGINNING SYMBOL, ALIGN 05056000 APLAC EQU * PARMS A-C 05056020 APCGN ACCT,AJOACCT,0,C=1,G=&$ACCT 05056040 AIF (&$S370 NE 2).APNALGN SKIP IF NO S/370 SIMULATION 05056045 APCGN ALGN,AJOEXEF,AJONALGN,Y=1 05056050 .APNALGN ANOP 05056055 APCGN BATCH,AJOMODE,AJOBATCH,I1=1,Y=1,LK=110 05056060 APCGN CMPRS,AJOASMF2,AJOCMPRS,I1=1,Y=1,G=&$CMPRS 05056080 APCGN COMNT,AJOASMF2,AJOCOMNT,I1=1,Y=1,G=&$COMNT,LK=110 05056100 APCGN CPAGE,AJIOPR,AJIOPAGE,I1=1,Y=1,G=&$PAGE,LK=110 05056120 APLDG EQU * PARMS D-G 05056140 APCGN DATA,AJIORE,AJIODFLT,Y=1,G=&$DATARD,LK=110 05056160 APCGN DEBUG,AJODEBUG,C=1,D=1,G=&$DEBUG,GC=1 05056180 APCGN DECK,AJOASMF2,AJODECK,Y=1,I1=1,G=&$DECK 05056190 APCGN DISKU,AJOASMF,AJODISKU,G=&$DISKU,Y=1,I1=1 05056195 APCGN DUMP,AJODMPF,C=1,D=1 05056200 APCGN FREE,AJOFREE,0,D=1,LK=110 05056220 APLHI EQU * PARMS H-I 05056240 APCGN I,AJOINSL,0,D=1,I1=1 05056260 APCGN IECF,AJOIECF,0,D=1,G=&$EXINT IECF OF EXT'D INTPRTR 05056265 APLJL EQU * PARMS J-L, GAP 05056280 APCGN KP,AJIOSO,C=1,D=1,G=&$KP26 05056300 APCGN L,AJOL,0,D=1,I1=1,G=&$PAGE 05056320 APCGN LIBMC,AJOASMFM,AJOLIBMC,I1=1,Y=1,G=&$MACROS PRT LIB MCS 05056350 APCGN LIST,AJOASMF,AJNLIST,Y=1 05056360 APCGN LOAD,AJOASMF,AJNLOAD,Y=1 05056380 APLMP EQU * PARMS M-P 05056400 APCGN MACRO,AJOASMFM,C=1,G=&$MACROS MACRO LEVEL 05056420 APCGN MACTR,AJOMACTR,0,D=1,G=&$MACROS MACRO ACTR 05056423 APCGN MNEST,AJOMNEST,0,D=1,G=&$MACROS MACRO NEST LIMIT 05056426 APCGN MSTMG,AJOMSTMG,0,D=1,G=&$MACROS MACRO STMT LIMIT 05056430 APCGN MONIT,AJOMODE,AJOMONIT,I1=1,Y=1,LK=110 05056440 APCGN NERR,AJONERRF,0,D=1 05056460 APCGN OBJIN,AJODECKF,AJOOBJIN,Y=1,I1=1,G=&$OBJIN 05056470 APCGN P,AJOP,0,D=1,I1=1,G=&$PAGE 05056480 APBPD APCGN PD,AJOPD,0,D=1,I1=1,G=&$PAGE 05056500 APCGN PUNCH,AJIOPN,AJIODFLT,Y=1,G=&$PUNCH,LK=110 05056520 APBPX APCGN PX,AJOPX,0,D=1,I1=1,G=&$PAGE 05056540 APLQR EQU * PARMS Q-R, GAP 05056560 APBR APCGN R,AJORECL,0,D=1,I1=1 05056580 APBRD APCGN RD,AJORD,0,D=1,I1=1 05056600 APCGN RELOC,AJOASMF,AJORELOC,I1=1,Y=1,G=&$RELOC 05056620 APCGN REPL,AJOMODE,AJOREPLF,I1=1,Y=1,G=&$REPL 05056640 APCGN RFLAG,AJORFLAF,0,D=1,G=&$REPL 05056660 APBRX APCGN RX,AJORX,0,D=1,I1=1 05056680 APLST EQU * PARMS S-T 05056700 APCGN SS,AJIOSS,AJIOSING,I1=1,Y=1,G=&$PAGE 05056720 APCGN SSD,AJIOSSD,AJIOSING,I1=1,Y=1,G=&$PAGE 05056740 APCGN SSX,AJIOSSX,AJIOSING,I1=1,Y=1,G=&$PAGE 05056760 APCGN SUPER,AJOEXEF,AJOSUPER,I1=1,Y=1,G=&$PRIVOP 05056780 APCGN SYSIN,AJOMODE,AJNSYSIN,Y=1,G=&$DATARD,LK=110 05056800 APBT APCGN T,AJOTIML,D=1,I1=1,G=&$TIMER,C=1 05056820 APCGN TD,AJOTD,D=1,I1=1,G=&$TIMER,C=1 05056840 APBTX APCGN TX,AJOTX,D=1,I1=1,G=&$TIMER,C=1 05056860 APLUX EQU * PARMS U-X 05056880 APCGN VIRT,AJOEXEF,AJOVIRT,I1=1,Y=1,G=&$VIRT 05056885 APCGN XREF,AJOXREF,C=1,G=&$XREF A 05056890 APLYZ EQU * PARMS Y-Z 05056900 APBPARMB EQU * LIMIT OF APCGN'D TABLE 05056920 SPACE 2 05056940 * PARM TABLE LOOKUP INDEX - APLNDX 05056960 * GIVES OFFSETS TO BEGINNING OF EACH SECTION OF TABLE, 05056980 * DETERMINED BY INITIAL LETTER 05057000 * DETERMINED BY MIDDLE 4 BITS OF 1ST BYTE OF OPTION NAME. 05057020 APLNDX $AL2 APBPARMA,(APLAC,APLDG,APLHI,APLJL,APLJL,APLMP,APLQR, #05057040 APLST,APLST,APLUX,APLYZ,APBPARMB) 05057060 AIF (NOT &$ACCT).APNCOM2 SKIP IF NO ACCT# CHECKING 05094100 SPACE 1 05094200 * TABLE OF ACCOUNT NUMBERS RECEIVING SPECIAL TREATMENT. 05094300 APXCOMLA EQU * BEGINNING OF TABLE 05094400 DC 5CL5'ACCT#' DUMMIES, TO BE FIXED IN OBJ DECK 05094500 APACCJRM DC C'C3338' CURRENT ACCT# FOR TESTING PURPOSES 05094600 APXCOMLB EQU *-L'AJOACCT @ LAST 1 IN TABLE 05094700 SPACE 1 05094800 .APNCOM2 ANOP 05094900 SPACE 1 05095000 * TABLE TO DETERMINE WHETHER YES/NO PARM SHOULD HAVE ITS 05095020 * VARIABLE BYTE BITS SET TO 1'S OR 0'S. 05095040 APFYNTAB DS 0BL4 YES/NO BIT SETTING CONTROL TABLE 05095060 DC B'1' YES PARM,YES1B ==> BIT = 1 05095080 DC B'0' YES PARM, ^YES1B ==> BIT = 0 05095100 DC B'0' NO PARM, YES1B ==> BIT = 0 05095120 DC B'1' NO PARM, ^YES1B ==> BIT = 1 05095140 LTORG 05096000 DROP R3,R8,R11 KILL ALL USINGS 05098000 AIF (NOT (&$DECK OR &$OBJIN)).AOBNONE SKIP IF NO DECKS 05098010 TITLE 'AOBJCARD DSECT : OBJECT DECK CARDIMAGE' 05098020 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098025 *--> DSECT: AOBJCARD IMAGE OF OBJECT DECK CARD * 05098030 * THIS DSECT DESCRIBES 1 CARD OF AN ASSIST OBJECT DECK. THE * 05098040 * DECK FORMAT IS COMPATIBLE WITH NORMAL S/360 OBJECT DECKS, SO THAT * 05098050 * THEY CAN BE USED UNDER SOME CIRCUMSTANCES. THEY ARE HOWEVER * 05098060 * SIMPLER, IN ORDER TO ALLOW FOR PRODUCTION OF THEM FROM STUDENT- * 05098070 * COMPILERS, I.E. XPL. LATER VERSIONS OF THE LOADER MAY PERMIT * 05098080 * MORE COMPLEX OBJECT DECKS, BUT AS OF 9/01/71, THE ONLY TYPES OF * 05098090 * OBJECT DECK CARDS RECOGNIZED ARE TXT AND END CARDS. * 05098100 * NAMES: AO------ * 05098110 * REFERENCE: ASSEMBLER(F) PROGRAMMER'S GUIDE - GC26-3756-4 * 05098120 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098130 SPACE 1 05098140 AOBJCARD DSECT 05098150 SPACE 1 05098160 * ***** COMMON BASE BEGINNING ***** 05098170 DS X'02' 1 (S/360) - ASSIST IGNORES 05098180 AOBJTYPE DS CL3 2-4 TYPE OF CARD 05098190 SPACE 1 05098200 * ***** ESD CARD LAYOUT ***** 05098210 ******************** NOT CURRENTLY IMPLEMENTED ******************* 05098220 SPACE 1 05098230 * ***** TXT CARD LAYOUT ***** 05098240 ORG AOBJTYPE BACK UP TO SHOW LAYOUT 05098250 DS CL3'TXT' 2-4 TEXT CARD IDENTIFIACTION 05098260 AOTADDR DS 0A,C' ' 5 ASSIST IGNORES 1ST BYTE 05098270 AOTADDRT DS AL3 6-8 @ WHERE OBJECT CODE GOES 05098280 DS CL2' ' 9-10 ASSIST IGNORES THESE COLS 05098290 AOTLENG DS 0H,C 11-12 LENGTH OF CODE ON CARD 05098300 AOTLENG2 DS AL1 12 LENGTH USED BY ASSIST 0-56 05098310 DS CL4' ' 13-16 IGNORED *****FUTURE USE ****** 05098320 AOTCODE DS CL56 17-72 OBJECT CODE 0-56 BYTES OF IT 05098330 AOTSEQN DS CL8 73-78 SEQUENCE NUMBER, IGNORED 05098340 SPACE 1 05098350 * ***** RLD CARD LAYOUT ***** 05098360 ******************** NOT CURRENTLY IMPLEMENTED ******************* 05098370 SPACE 1 05098380 * ***** END CARD LAYOUT ***** 05098390 ORG AOBJTYPE BACK TO SHOW TYPE 05098400 DS CL3'END' 2-4 END CARD FLAG 05098410 AOEBLNK EQU * BEGINNING OF BLANK AREA 05098420 AOENTRY DS 0A,C' ' 5 ASSIST IGNORES LEADING BLANK 05098430 AOENTRY2 DS AL3 6-8 GIVES ENTRY @, UNLESS BLANK 05098440 AOEBLNKL EQU 72-(*-AOBJCARD) LENGTH TO BE BLANKED 05098450 TITLE 'AOBJDK CSECT - OBJECT DECK PUNCH/LOAD' 05098460 AOBJDK CSECT 05098470 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098475 *--> CSECT: AOBJDK OBJECT DECK HANDLING MODULE * 05098480 * JOHN R. MASHEY - 09/01/71 * 05098490 * THE TWO ENTRIES OF AOBJDK ARE USED TO LOAD OR PUNCH OBJECT * 05098500 * DECKS WHICH ARE SUBSETS OF NORMAL S/360 DECKS. THE TWO ENTRIES * 05098510 * MAY OR MAY NOT EXIST, DEPENDING ON FLAGS &$DECK AND &$OBJIN. * 05098520 * USES DSECTS: AOBJCARD,AVWXTABL * 05098530 * USES MACROS: $RETURN,$SAVE * 05098540 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098550 $DBG ,NO NO DEBUG IN $SAVE,$RETURN 05098560 EJECT 05098570 AIF (NOT &$OBJIN).AOBJN1 SKIP IF NO OBJECT INPUT 05098580 ENTRY AOBJIN 05098590 AOBJIN $SAVE RGS=(R14-R12),SA=NO,BR=R6 05098600 USING AVWXTABL,RAT NOTE ASSEMBLER CONTROL TABLE 05098610 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098615 *--> ENTRY: AOBJIN LOAD OBJECT DECK * 05098620 * ENTRY CONDITIONS * 05098630 * R12(RAT) = @ ASSEMBLER CONTROL TABLE (AVWXTABL). * 05098640 * EXIT CONDITIONS * 05098650 * AVRADL,AVRADH,AVRELOC,AVFENTER,AVLOCLOW,AVLOCHIH ARE SET UP * 05098660 * AS THEY WOULD HAVE BEEN HAD THE PROGRAM BEEN ASSEMBLED. * 05098670 * AVTAGS1 IS FLAGGED WITH AJNLOAD IF SOME ERROR OCCURRED. * 05098680 * NAMES: AOB----- * 05098690 * USES MACROS: $PRNT,$RETURN,$SAVE,$SORC,XSNAP * 05098700 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098710 SPACE 1 05098720 * * * * * * * * REGISTER USAGE FOR AOBJIN * * * * * * * * * * * * * * * 05098730 * R0,R1 WORK REGISTERS. R1 USED FOR ADDRESS CALCULATIONS. * 05098740 * R2 = LOWEST REAL @ LOADED CODE. INIT=AVADDLOW. INTO AVRADL. * 05098750 * R3 = @+1 OF HIGHEST LOADED CODE. INIT=AVADDLOW. INTO AVRADH. * 05098760 * R4 = LOAD RELOCATION FACTOR. = AVADDLOW - (1ST TXT @ FOUND). * 05098770 * R5 = USER ENTRYPOINT @ (FAKE). TO BE STORED INTO AVFENTER. * 05098780 * R6 = BASE REGISTER * 05098790 * R7 = ADDRESS OF OBJECT CARD IMAGE (AOBJCARD DSECT). * 05098800 * R8 = BYTE REGISTER (USED FOR INSERT OF LENGTH FROM AOTLENG2) * 05098810 * R9 = @+1 OF HIGHEST USABLE BYTE FOR PROGRAM. = AVADDHIH. * 05098820 * R10,R11 UNUSED * 05098830 * R12(RAT)= @ AVWXTABL CONTROL BLOCK * 05098840 * R13= @ CALLING PROGRAM'S SAVE AREA. * 05098850 * R14= INTERNAL LINK REGISTER, WORK REGISTER. * 05098860 * R15= WORK REGISTER * 05098870 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098880 EJECT 05098890 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098900 * OBJECT LOAD INITIALIZATION. * 05098910 * 1. FILL OBJECT AREA (AVADDLOW-AVADDHIH) WITH FILL CHARS. * 05098920 * 2. SET UP INITIAL VALUES FOR @'S IN REGISTERS. * 05098930 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098940 LM R8,R9,AVADDLOW AVADDLOW-AVADDHIH - CORE LIMITS 05098950 LA R7,31(,R8) * ALIGN ACTUAL BEGINNING @ 05098960 SRL R7,5 * TO MULTIPLE OF 32. 05098970 SLL R7,5 * THIS IS REQUIRED BY XXXXSNAP 05098980 ST R7,AVADDLOW * STORE ALIGNED VALUE BACK 05098990 LA R8,32 # BYTES TO BE FILLED WITH 1 STM 05099000 SR R9,R8 SUBTRACT 32 FOR BXLE USE 05099010 SR R9,R8 -32 MORE FOR COMPLETE SAFETY 05099020 BXH R7,R8,AOBINTA MAKE SURE AT LEAST 32 BYTES 05099030 SPACE 1 05099040 SR R7,R8 BACK UP TO BEGINNING FOR SAFETY 05099050 MVI 0(R7),$PRGFILC PUT IN FILL CHARACTER 05099060 MVC 1(31,R7),0(R7) PROPAGATE FILL CHARACTER 05099070 LM R14,R5,0(R7) GET 8 REGS WORTH OF FILL CHARACTER 05099080 SPACE 1 05099090 STM R14,R5,0(R7) STORE 32 BYTES OF FILL CHARACTER 05099100 BXLE R7,R8,*-4 LOOP TO FILL WHOLE AREA 05099110 SPACE 1 05099120 AOBINTA LM R8,R9,AVADDLOW AVADDLOW-AVADDHIH - LIMIT @'S 05099130 LR R2,R8 R2= INIT VALUE LOWEST REAL(AVRADL) 05099140 LR R3,R2 R3= INIT VALUE HIGHEST LIMIT(RADH) 05099150 SR R5,R5 INIT ENTRY @ TO 0 (BEGINNING OF CD) 05099160 NI AVTAGS1,255-AVOENTR-AVO1TXT SHOW NO TXT, ENTRY @ FOUND 05099170 LA R7,AVCONCAT USE THIS AS WORKAREA FOR AOBJCARD 05099180 USING AOBJCARD,R7 NOTE DSECT 05099190 SR R8,R8 CLEAR R8 AS BYTE REGISTER FOR INSERT 05099200 SPACE 1 05099210 * PRINT HEADER MESSAGE AL000. 05099220 BAL R14,AOBHEXCO CONVERT VALUES TO HEX FOR PRINT 05099230 DC H'2' # ITEMS IN FOLLOWING LIST 05099240 DC AL2(AVADDLOW-AVWXTABL,AOB000A-AOB) REAL @ START 05099250 DC AL2(AVADDHIH-AVWXTABL,AOB000B-AOB) REAL LIMIT 05099260 BAL R14,AOBPRINT GO PRINT COMPLETED MESSAGE 05099270 DC AL2(AOB000-AOB,AOB000L) @ OFFSET, LENGTH 05099280 EJECT 05099290 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05099300 * READ OBJECT DECK AND LOAD LOOP HEAD * 05099310 * READ 1 CARD OF OBJECT DECK, UNTIL EOF FOUND. DETERMINE TYPE * 05099320 * OF CARD, BRANCH TO PROCESSING SECTION, RETURN FOR NEXT CARD. * 05099330 * **NOTE** AS OF 9/01/71, WILL PROCESS ONLY TXT AND END CARDS, THUS * 05099340 * SECTIONS OF CODE COMMENTED OUT ARE TO INDICATE POSSIBLE EXTENSIONS* 05099350 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05099360 AOBREAD EQU * ENTRY LABEL FOR 1 CARD PROCESS 05099370 $SORC AOBJCARD,80,AOBJEOF READ UNTIL END-FILE 05099380 CLC AOBJTYPE,=C'TXT' WAS IT TEXT CARD (MOST LIKELY) 05099390 BE AOBTXT YES (NOTE WE IGNORE COL 1 OF CARD) 05099400 CLC AOBJTYPE,=C'END' WAS IT END CARD 05099410 BE AOBEND YES, GO THERE TO PROCESS IT 05099420 ***** CLC AOBJTYPE,=C'RLD' WAS IT RLD 05099430 ***** BE AOBRLD YES, GO THERE 05099440 ***** CLC AOBJTYPE,=C'ESD' WAS IT ESD CARD 05099450 ***** BE AOBESD YES, GO THERE 05099460 ***** IF DESIRED, INSERT COUNTER HERE FOR UNKNOWN TYPES OF CARDS. 05099470 B AOBREAD UNKNOWN TYPE OF CARD-IGNORE IT 05099480 SPACE 1 05099490 * ***** PROCESSING CODE FOR INDIVIDUAL TYPES OF CARDS ***** 05099500 SPACE 2 05099510 * ***** END CARD(S) ***** 05099520 * SETS R5 = ENTRY @, IF: 1) A PREVIOUS END CARD HAS * 05099530 * NOT ALREADY SPECIFIED ONE, AND 2) ONE IS GIVEN ON THIS * 05099540 * END CARD. * 05099550 AOBEND EQU * 05099560 TM AVTAGS1,AVOENTR HAS ONE BEEN SPECIFIED ALREADY 05099570 BO AOBREAD YES, SO DON'T DO IT AGAIN 05099580 CLC AOENTRY2,AWBLANK+1 WAS ENTRY POINT BLANK 05099590 BE AOBREAD YES, SO IGNORE IT 05099600 L R5,AOENTRY GET FULLWORD CONTAINING ENTRY @ 05099610 LA R5,0(,R5) REMOVE LEADING BYTE 05099620 OI AVTAGS1,AVOENTR SHOW ENTRY @ FOUND, SO WONT DO AGAN 05099630 B AOBREAD GO BACK FOR MORE (IF ANY) 05099640 SPACE 2 05099650 * ***** ESD CARD(S) ***** * 05099660 *AOBESD EQU * EXTERNAL SYMBOL DICTIONARY 05099670 SPACE 2 05099680 * ***** RLD CARD(S) ***** * 05099690 *AOBRLD EQU * RELOCATION DICTIONARY 05099700 EJECT 05099710 * ***** TXT CARD(S) ***** * 05099720 * MOVE TEXT CODE FROM CARDIMAGE INTO MEMORY. * 05099730 * COMPUTE RELOCATION FACTOR FROM FIRST TEXT CARD FOUND. * 05099740 * MAINTAIN HIGH LIMIT FOR ACTUAL OBJECT CODE, AND MAKE * 05099750 * SURE CODE DOES NOT EXCEED HIGH LIMIT, OR GO BELOW * 05099760 * THE LOW LIMIT (AFTER FIRST TEXT CARD). * 05099770 AOBTXT EQU * ENTRY LABEL FOR TEXT CARD 05099780 L R1,AOTADDR GET @ CODE (USER PROG RELATIVE) 05099790 LA R1,0(,R1) REMOVE HI-ORDER BYTE 05099800 TM AVTAGS1,AVO1TXT HAVE WE GOTTEN AT LEAST 1 TXT CARD 05099810 BO AOBTXT1 YES, SO SKIP 05099820 * FIRST TEXT CARD - COMPUTE RELOCATION FACTOR 05099830 LR R4,R2 MOVE REAL BEGINNING @ OVER 05099840 SR R4,R1 SUBTRACT USER LOW @ FROM REAL= RELOC 05099850 OI AVTAGS1,AVO1TXT FLAG SO WE DON'T COMPUTE IT AGAIN 05099860 BZ AOBTXT1 NO, LEAVE ENTRY PT REG AS IS 05099870 TM AVTAGS1,AVOENTR HAS ENTRY PT BEEN RECEIVED ALREADY 05099880 BO AOBTXT1 YES, SO DON'T CHANGE R5 05099890 LR R5,R1 MAKE DEFAULT ENTRY PT THE FIRST BYTE 05099900 AOBTXT1 AR R1,R4 RELOC USER @ TO REAL ONE 05099910 CR R1,R2 WAS IT LOWER THAN REAL LIMIT 05099920 BL AOBTXTIL YES, GO TO FLAG OR PRINT MESSAGE 05099930 IC R8,AOTLENG2 GET LENGTH FROM CARD OF CODE 05099940 LA R0,0(R8,R1) GET REAL @+1 OF LAST BYTE OF CODE 05099950 CR R0,R9 WAS IT HIGHER THAN ACTUAL SPACE 05099960 BH AOBTXTIH YES, TOO MUCH CODE-EXIT 05099970 CR R0,R3 WAS IT HIGHER THAN PREVIOUS HIGH 05099980 BNH *+6 NO, SKIP 05099990 LR R3,R0 YES, SET NEW HIGH LIMIT 05100000 SPACE 1 05100010 LTR R8,R8 WAS LENGTH=0 (POSSIBLE FOR DS'S) 05100020 BZ AOBREAD YES, SO DON'T DO ANYTHING 05100030 BCTR R8,0 DECREMENT LENGTH TO LENGTH-1 FOR MVC 05100040 EX R8,AOBTXTMV MOVE TEXT CODE OVER 05100050 B AOBREAD RETURN FOR NEXT CARD 05100060 AOBTXTMV MVC 0($,R1),AOTCODE MOVE CODE TO MEMORY **MODIFIED** 05100070 EJECT 05100080 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100090 * EXIT CODE - CHECK AND STORE FINAL ADDRESSES * 05100100 * MAKE SURE WE RECIEVED AT LEAST 1 TEXT CARD, ASSURE *8 * 05100110 * LENGTH MULTIPLE, AND STORE BLOCK OF 6 ADDRESSES APPROPRIATELY. * 05100120 * NOTE THAT ALTERATIONS MUST BE MADE IF THE USER CODED RELOC, IN * 05100130 * WHICH CASE HIS PROGRAM MUST EITHER BE LOADED FROM WHERE IT WAS * 05100140 * ASSEMBLED ORIGINALLY, OR MUST CONTAIN NO ADDRESS CONSTANTS AT ALL.* 05100150 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100160 AOBJEOF EQU * 05100170 TM AVTAGS1,AVO1TXT DID WE GET AT LEAST 1 TXT CARD 05100180 BZ AOBNOTXT NO, QUIT NOW WITH ERROR 05100190 LA R3,7(,R3) ROUND UPPER REAL @ UP 05100200 SRL R3,3 SHIFT TO REMOVE 3 BITS 05100210 SLL R3,3 SHIFT BACK, NOW ALIGNED 05100220 TM AVTAGS1,AJORELOC WAS THIS TO BE RELOACTED MODE 05100230 BZ AOBJNORM NO, NORMAL-SKIP 05100240 AR R5,R4 RELOCATE USER LOCATION TO REAL 05100250 SR R4,R4 MAKE EXECUTION RELOC FACTOR = 0 05100260 AOBJNORM EQU * FINAL STORE OF @'S 05100270 STM R2,R5,AVRADL AV(RADL-RADH-RELOC-FENTER) 05100280 SR R2,R4 RADL-RELOC = FAKE LOW @ FOR USER 05100290 SR R3,R4 RADH-RELOC = FAKE HIGH LIMIT @ 05100300 STM R2,R3,AVLOCLOW AV(LOCLOW-LOCHIH) -USER RELATIVE LIM 05100310 SPACE 1 05100320 * SUCCESFFUL COMPLETION MESSAGE AL100. 05100330 BAL R14,AOBHEXCO GO CONVERT VALUES TO HEX 05100340 DC H'4' # ITEMS IN LIST 05100350 DC AL2(AVLOCLOW-AVWXTABL,AOB100A-AOB) LOWEST USER @ 05100360 DC AL2(AVLOCHIH-AVWXTABL,AOB100B-AOB) HIGH USER @ 05100370 DC AL2(AVFENTER-AVWXTABL,AOB100C-AOB) FAKE ENTRY @ 05100380 DC AL2(AVRELOC-AVWXTABL,AOB100D-AOB) RUN TIME RELOC 05100390 BAL R14,AOBPRINT PRINT COMPLETED MESSAGE 05100400 DC AL2(AOB100-AOB,AOB100L) MESSG OFFSET, LENGTH 05100410 SPACE 1 05100420 AOBJEXIT $RETURN RGS=(R14-R12),SA=NO RETURN TO CALLER 05100430 SPACE 1 05100440 * ***** ERROR EXITS ***** 05100450 AOBNOTXT BAL R14,AOBPRINT PRINT AL996 - NO TEXT CARDS FOUND 05100460 DC AL2(AOB996-AOB,AOB996L) OFFSET, LENGTH 05100470 B AOBJBAD GO TO SHOW ABORT 05100480 AOBTXTIL BAL R14,AOBPRINT AL997 - TXT @ TOO LOW 05100490 DC AL2(AOB997-AOB,AOB997L) OFFSET,LENGTH 05100500 B AOBTXTID GO TO DUMP STMT FOR USER 05100510 AOBTXTIH BAL R14,AOBPRINT AOB998 - OVERFLOW OF AREA 05100520 DC AL2(AOB998-AOB,AOB998L) OFFSET, LENGTH 05100530 AOBTXTID BAL R14,AOBDUMP DUMP USER CARDIMAGE, FALL TO AOBJBAD 05100540 AOBJBAD BAL R14,AOBPRINT GO PRINT AL999 - LOAD ABORT 05100550 DC AL2(AOB999-AOB,AOB999L) OFFSET, LENGTH 05100560 OI AVTAGS1,AJNLOAD FLAG NOLOAD 05100570 B AOBJEXIT RETURN SHOWING ERROR 05100580 EJECT 05100590 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100595 *--> INSUB: AOBDUMP DUMP CURRENT USER CARDIMAGE * 05100600 * ENTRY CONDITIONS * 05100610 * R14= RETURN ADDRESS TO CALLING CODE * 05100620 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100630 AOBDUMP EQU * 05100640 XSNAP T=(NO,,0),LABEL='IMAGE OF INCORRECT OBJECT CARD', X05100650 STORAGE=(*AOBJCARD,*AOBJCARD+80) 05100660 BR R14 05100670 SPACE 2 05100680 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100685 *--> INSUB: AOBHEXCO CONVERT VALUES TO EDITED HEXADECIMAL * 05100690 * ENTRY CONDITIONS * 05100700 * R14= @ PARAMETER LIST. LIST CONSISTS OF THE FOLLOWING: * 05100710 * 1) HALFWORD GIVING # ITEMS IN LIST TO BE CONVERTED. * 05100720 * 2) 1 OR MORE PAIRS OF OFFSET VALUES GIVING DISPLACEMENT * 05100730 * FROM AVWXTABL TO FULLWORD VARIABLE TO BE CONVERTED, AND * 05100740 * OFFSET FROM LABEL AOB TO 6-BYTE FIELD WHERE EDITED HEX * 05100750 * SHOULD BE PLACED. REQUIRES FREE BYTE AFTER THIS FIELD. * 05100760 * EXIT CONDITIONS * 05100770 * R0,R1,R14,R15 ARE ALL MODIFIED. * 05100780 * CONTROL RETURNED TO LOCATION AFTER PARAMETER LIST. * 05100790 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100800 AOBHEXCO LH R0,0(,R14) GET # ENTRIES IN FOLLOWING LIST 05100810 AOBHEX2 LH R1,2(,R14) GET OFFSET OF FULLWORD TO CONVERT 05100820 LA R1,AVWXTABL(R1) GET ACTUAL @ OF VARIABLE 05100830 LH R15,4(,R14) GET OFFSET TO OUTPUT FIELD 05100840 LA R15,AOB(R15) GET ACTUAL @ OUTPUT FIELD 05100850 UNPK 0(7,R15),1(4,R1) UNPACK 3 BYTES, WITH EXTRA FOR EASE 05100860 TR 0(6,R15),AWTHEX3 TRANSLATE TO PRINTABLE 05100870 MVI 6(R15),C' ' PUT IN BLANK AFTER TO WIPE EXTRA OUT 05100880 LA R14,4(,R14) BUMP PTR TO NEXT PAIR 05100890 BCT R0,AOBHEX2 LOOP THORUGH LIST 05100900 B 2(,R14) RETURN TO CALLER 05100910 SPACE 2 05100920 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100929 *--> INSUB: AOBPRINT PRINT 1 LINE OF OUTPUT MESSAGE * 05100930 * ENTRY CONDITIONS * 05100940 * R14= @ PARAMETER LIST, WHICH HAS OFFSET @ OF MESSAGE FROM AOB, * 05100950 * FOLLOWED BY LENGTH OF MESSAGE, BOTH IN HALFWORDS. * 05100960 * EXIT CONDITIONS * 05100970 * R0,R1 ARE MODIFIED. * 05100980 * CONTROL RETURNED TO LOCATION AFTER PARAMETER LIST. * 05100990 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101000 AOBPRINT LA R0,AOB BASE @ FOR MESSAGE 05101010 AH R0,0(,R14) ADD IN OFFSET @ 05101020 LH R15,2(,R14) LENGTH OF MESSAGE 05101030 $PRNT (R0),(R15) PRINT THE MESSAGE 05101040 B 4(,R14) RETURN TO CALLER 05101050 EJECT 05101060 * AOBJIN LOADER MESSAGES - AL### * 05101070 * AL000 - BEGINNIG HEADER LABEL. * 05101080 * AL100 - SUCCESSFUL COMPLETION. * 05101090 * AL996 - NO TEXT CARDS RECEIVED. * 05101100 * AL997 - TXT CARD @ TOO LOW * 05101110 * AL998 - TXT CARD @ TOO HIGH - OVERFLOW OF AREA * 05101120 * AL999 - LOAD ABORTED MESSAGE * 05101130 AOB EQU * BASE FOR OFFSET @'S IN PARM LISTS 05101140 SPACE 1 05101150 AOB000 DC C'0*** AL000 - ASSIST LOADER BEGINS LOAD AT ' 05101160 AOB000A DC XL6'0' LOWEST @ = AVADDLOW 05101170 DC C' ,USABLE CORE ENDS AT ' 05101180 AOB000B DC XL6'0',C' ***' HIGH LIMIT = AVADDHIH 05101190 AOB000L EQU *-AOB000 LENGTH OF THIS MESSAGE 05101200 SPACE 1 05101210 AOB100 DC C'0*** AL100 - LOAD COMPLETED, USER ADDRESSES: LOW ' 05101220 AOB100A DC XL6'0',C' ,HIGH ' AVLOCLOW - LOW USER LIMT 05101230 AOB100B DC XL6'0',C' ,ENTRY ' HIGH LIMIT AVLOCHIH 05101240 AOB100C DC XL6'0',C' . RUN-TIME RELOCATION ' USER ENTRY @ 05101250 AOB100D DC XL6'0',C' ***' AVRELOC - RUN-TIME RELOCATION 05101260 AOB100L EQU *-AOB100 LENGTH OF THIS MESSAGE 05101270 SPACE 1 05101280 AOB996 DC C'0*** AL996 - NO TXT CARD RECEIVED ***' 05101290 AOB996L EQU *-AOB996 LENGTH OF MESSAGE 05101300 SPACE 1 05101310 AOB997 DC C'0*** AL997 - TXT CARD ADDRESS BELOW 1ST TXT CARD ***' 05101320 AOB997L EQU *-AOB997 LENGTH OF MESSAGE 05101330 SPACE 1 05101340 AOB998 DC C'0*** AL998 - TXT CARD ADDRESS EXCEEDED STORAGE ***' 05101350 AOB998L EQU *-AOB998 LENGTH OF MESSAGE 05101360 SPACE 1 05101370 AOB999 DC C' *** AL999 - LOAD ABORTED ***' 05101380 AOB999L EQU *-AOB999 LENGTH OF MESSAGE 05101390 DROP R6,R7,RAT REMV USINGS: BASE,AOBJCARD,AVWXTABL 05101400 .AOBJN1 AIF (NOT &$DECK).AOBNONE SKIP IF NO DECK 05101410 EJECT 05101420 ENTRY AODECK 05101430 AODECK $SAVE RGS=(R14-R12),SA=NO,BR=R6 05101440 USING AVWXTABL,RAT NOTE ASSEMBLER CONTROL TABLE 05101450 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101455 *--> ENTRY: AODECK PUNCH OBJECT DECK FOLLOWING ASSEMBLY * 05101460 * IF THE DECK OPTION IS SPECIFIED, AODECK IS CALLED FOLLOWING * 05101480 * A SUCCESSFULL ASSEMBLY TO PUNCH THE USER PROGRAM OUT IN OBJECT * 05101490 * DECK FORM. THE DECK PUNCHED CONTAINS 1 OR MORE TXT CARDS AND * 05101500 * 1 END CARD, AND FOLLOWS S/360 DECK FORMAT FAIRLY CLOSELY. * 05101510 * **NOTE** THIS FACILITY IS VERY PRIMITIVE, AND THE DECKS * 05101520 * PRODUCED CANNOT REALLY BE USED FOR ANYTHING BUT INPUT TO ASSIST, * 05101530 * SINCE THERE IS NEITHER EXTERNAL SYMBOL DICTIONARY NOR RELOCATION * 05101540 * DICTIONARY PRODUCED. ALSO, SINCE THE ENTIRE USER PROGRAM IS * 05101550 * PUNCHED, OBJECT CARDS ARE PRODUCED FOR SPACE CONTAINING ONLY DS * 05101560 * LOCATIONS. IN SOME CASES, THIS COULD CAUSE HUGE DECKS TO BE * 05101570 * PUNCHED. IF A BETTER SETUP IS DESIRED, ASSEMBLER MODULE UTOPRS * 05101580 * COULD BE CHANGED TO PRODUCE SMALLER DECKS, ALTHOUGH RLD ENTRIES * 05101590 * WOULD STILL BE DIFFICULT TO PRODUCE. * 05101600 * **NOTE** THE MOST LIKELY USE FOR THIS OPTION IS TO PRODUCE * 05101610 * OBJECT DECKS TO BE USED AS UTILITY PROGRAMS FROM RJE TERMINALS. * 05101620 * ENTRY CONDITIONS * 05101630 * R12(RAT) = @ ASSEMBLER CONTROL TABLE (AVWXTABL). * 05101640 * USES MACROS: $PNCH,$RETURN,$SAVE * 05101645 * NAMES: AOD----- * 05101650 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101660 SPACE 1 05101670 * * * * * * * * REGISTER USAGE FOR AODECK * * * * * * * * * * * * * * * 05101680 * R4 = @ CURRENT BLOCK OF CODE TO BE PUNCHED (INIT = AVRADL). * 05101690 * R5 = CURRENT LENGTH OF CODE REMAINING (INIT =AVRADH-AVRADL) * 05101700 * R6 = BASE REGISTER * 05101710 * R7 = @ AOBJCARD : OBJECT CARD OUTPUT IMAGE * 05101720 * R8 = CURRENT @ OF CODE TO PUNCHED (USER PROGRAM RELATIVE). * 05101730 * R9 = L'AOTCODE = LENGTH OF NORMAL(ALL BUT LAST) CODE ON CARD * 05101740 * R12(RAT)= @ ASSEMBLER CONTROL TABLE (AVWXTABL). * 05101750 * R13= @ CALLING PROGRAM'S SAVE AREA, UNCHANGED * 05101760 * R14= INTERNAL LINK REGISTER * 05101770 * ALL OTHERS ARE UNUSED * 05101780 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101790 SPACE 1 05101800 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101810 * INITIALIZATION FOR OBJECT PUNCH * 05101820 * INITIALIZE REGISTERS, SEQUENCE #, AND TXT CARDIMAGE. * 05101830 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101840 LM R4,R5,AVRADL AV(RADL-RADH) LOWER/UPPER REAL @'S 05101850 SR R5,R4 SIZE OF CODE = UPPER-LOWER LIMIT 05101860 BNP AODEXIT NO MORE, QUIT 05101870 LA R7,AVCONCAT WE WILL USE THIS AS WORKAREA 05101880 USING AOBJCARD,R7 NOTE PTR THERE 05101890 L R8,AVLOCLOW GET LOWEST USER PROGRAM @ 05101900 MVC AOBJCARD(72),AWBLANK BLANK OUT CARD, EXCEPT SEQUENCE 05101910 MVC AOBJTYPE,=C'TXT' FLAG AS TXT CARD 05101920 ***** MVI AOBJCARD,X'02' NORMAL S/360 FLAG 05101930 LA R9,L'AOTCODE LENGTH OF NORMAL OBJECT CODE 05101940 STH R9,AOTLENG STORE FOR NORMAL LENGTH 05101950 ZAP AVDWORK1(5),AWP0 ZERO WORKAREA FOR SEQUENCE# 05101960 UNPK AOTSEQN(8),AVDWORK1(5) MOVE SEQUENCE # OVER 05101970 OI AOTSEQN+7,X'F0' MAKE PRINTABLE 05101980 MVI AODTXTMV+1,L'AOTCODE-1 NORMAL LENGTH-1 OF OBJCODE 05101990 SPACE 1 05102000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102010 * LOOP FOR PUNCHING OBJECT DECK * 05102020 * PUNCH FULL OBJECT CARD FOR (ALL BUT POSSIBLY LAST BLOCK) * 05102030 * OF CODE IN USER PROGRAM. * 05102040 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102050 AODTXT EQU * 05102060 ST R8,AOTADDR STORE USER CODE FAKE @ INTO CARD 05102070 ***** MVI AOTADDR,C' ' BLANK OUT FOR S/360 NORMAL 05102080 CR R5,R9 HOW MUCH IS LEFT TO BE PUNCHED 05102090 BNL AODTNORM STILL ENOUGH FOR FULL CARD-BRANCH 05102100 SPACE 1 05102110 BCTR R5,0 LENGTH-1 FOR MVC 05102120 STC R5,AODTXTMV+1 STORE INTO MVC FOR LAST PUNCH 05102130 MVC AOTCODE,AWBLANK BLANK OUT WHOLE CARD, SINCE PART NOT 05102140 AODTNORM EQU * 05102150 AODTXTMV MVC AOTCODE($),0(R4) MOVE CODE FROM MEMORY 05102160 BAL R14,AODPUNCH GO PUNCH THE CARD 05102170 AP AVDWORK1(5),AWP1 INCREMENT THE CARD COUNTER 05102180 UNPK AOTSEQN(8),AVDWORK1(5) UNPACK FOR NEXT CARD 05102190 OI AOTSEQN+7,X'F0' MAKE SURE PRINTABLE 05102200 AR R8,R9 INCREMENT USER CODE @ 05102210 AR R4,R9 INCREMENT REAL @ IN MEMORY PTR 05102220 SR R5,R9 DECREMENT LENGTH PUNCHED LAST TIME 05102230 BP AODTXT IF MORE TO DO, RETURN FOR NEXT CARD 05102240 SPACE 1 05102250 * ***** COMPLETION - PUNCH END CARD 05102260 MVC AOBJTYPE,=C'END' MAKE CARD AN END CARD 05102270 MVC AOEBLNK(AOEBLNKL),AWBLANK BLANK OUT CARD(CEPT SEQN#) 05102280 MVC AOENTRY2,AVFENTER+1 MOVE ENTRY @ IN 05102290 BAL R14,AODPUNCH PUNCH THE ASSEMBLED END CARD 05102300 AODEXIT $RETURN RGS=(R14-R12),SA=NO 05102310 SPACE 1 05102320 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102325 *--> INSUB: AODPUNCH PUNCH 1 OBJECT CARD FOR AODECK * 05102330 * ENTRY CONDITIONS * 05102340 * R14= RETURN @ TO CALLING SECTION OF CODE * 05102350 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102360 AODPUNCH EQU * 05102370 $PNCH AOBJCARD,80,AODEXIT PUNCH, QUIT IF OVERRUN 05102380 BR R14 RETURN TO CALLING SECTION 05102390 LTORG 05102400 DROP R6,R7,RAT REMV USINGS: BASE,AOBJCARD,AVWXTABL 05102410 .AOBNONE ANOP 05102420 AIF (&$EXINT).EXYZ SKIP IF USING EXTENDED INTERPRETER 05102425 TITLE '*** EXECUT - ASSIST INTERPRETER SECTION ***' 05102430 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102435 *--> CSECT: EXECUT INTERPRETER SECTION * 05102440 * EXECUT PERFORMS ALL 360 INSTRUCTION SIMULATION DURING * 05102450 * INTERPRETIVE EXECUTION OF THE USER PROGRAM. ALL CONTROL * 05102460 * VALUES FOR THIS MODULE ARE CONTAINED IN DSECT ECONTROL, WHICH* 05102470 * IS PASSED TO EXECUT BY THE CALLING PROGRAM. THE INSTRUCTION.* 05102480 * SET SIMULATED INCLUDES THE FOLLOWING: * 05102490 * 1. STANDARD INSTRUCTION SET (INCL. 370'S IF ALLOWED) * 05102500 * 2. DECIMAL INSTRUCTION SET (IF PRESENT ON MACHINE). * 05102510 * 3. FLOATING POINT INSTRUCTIONS (OPTIONAL). * 05102520 * 4. X-MACRO PSEUDO INSTRUCTIONS - XDUMP, XLIMD, * 05102530 * XPNCH, XPRNT, XREAD. * 05102540 * THE PRIVILEGED OPERATIONS MAY BE DECODED TO THE POINT OF * 05102550 * BRANCHING TO INDIVIDUAL INSTRUCTION HANDLERS, BUT THEY ARE * 05102600 * ARE FLAGGED WITH AN 0C2 INTERRUPT AT PRESENT, AND ARE NOT * 05102650 * INTERPRETED FURTHER. THE CODE PRESENT IS FOR FUTURE USE. * 05102700 * THE SVC INSTRUCTION IS CURRENTLY FLAGGED WITH AN 0C2 IF* 05102750 * USED, BUT CODE EXISTS TO HANDLE ALL SVC CALLS IN A TABLE- * 05102800 * DRIVEN WAY, USING THE @ OF AN SVC CONTROL TABLE PASSED IN THE* 05102850 * WORD ECSVCADS IN ECONTROL. AS OF 8/2/70, THERE ARE NOT SVC * 05102900 * ROUTINES, BUT THE CODE EXISTS FOR FUTURE USE. * 05102950 * GENERAL CODE IS ALSO PROVIDED FOR ANY ADDITIONAL NEW * 05103000 * INSTRUCTIONS OR I/O SIMULATORS BY THE SECTION EXCALL, WHICH * 05103050 * ALLOWS CALLS TO EXTERNAL ROUTINES (WHICH WOULD BE USED BY * 05103100 * ANY SVC CALLS, IF THERE ARE ANY). * 05103150 * ENTRY CONDITIONS * 05104000 * R10= @ ECONTROL - EXECUTION CONTROL BLOCK. * 05106000 * ECONTROL CONTAINS ALL INITIAL VALUES FOR REGS,LIMITS,ETC. * 05106050 * EXIT CONDITIONS * 05106100 * ECINTCOD CONTAINS INTERRRUPT CODE, IF PROGRAM INTERRUPT. * 05106150 * ECFLAG1 CONTAINS SPECIAL COMPLETION CODE, IF ANY. * 05106200 * ECERRAD = ADDRESS OF AN ERCOMPCD ERROR COMPLETION CODE BLOCK * 05106250 * ECONTROL CONTAINS ALL OTHER VALUES NEEDED FOR A COMPLETION DUMP.* 05106300 * USES DSECTS: ECONTROL,ECSTACKD * 05106350 * USES MACROS: $AL2,$ERCGN,$PNCH,$PRNT,$READ,$RETURN,$SAVE * 05106400 * USES MACROS: $SPIE, XDECI, XDECO, XSNAP * 05106450 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05108000 EXECUT CSECT 05110000 $DBG ,NO KILL TRACE CODE HERE 05114000 SPACE 1 05115000 EXPRFETC EQU B'10000000' (EXIPROT) - INST ACCESSES STORAGE 05116000 EXPRSTOR EQU B'01000000' (EXIPROT) - INST MODIFIES STORAGE 05118000 EXPRFET2 EQU B'00100000' (EXIPROT) - SS INST ACCESSES CORE 05120000 EXPRSTO2 EQU B'00010000' (EXIPROT) - SS INST MODS CORE(2ND @) 05122000 SPACE 1 05124000 * *** SYMBOLIC REGISTER EQUATES *** * 05126000 RSTK EQU R3 ADDR OF CURRENT INST. STACK ENTRY 05128000 RIA EQU R4 INSTRUCTION ADDRESS REGISTER 05130000 RCC EQU R5 CONDITION CODE REGISTER 05132000 REC EQU R6 POINTER TO ECONTROL BLOCK 05134000 RWK EQU R7 WORK REGISTER 05136000 RR1 EQU R8 DECODING REGISTER FOR R1 FIELD 05138000 RR2 EQU R9 REGISTER 2 (WHEN USED IN RR'S) 05140000 RX2 EQU RR2 INDEX REGISTER(FOR RX'S) 05142000 RR3 EQU RR2 RO OPERAND(FOR RS INST) 05144000 RB1 EQU R10 1ST BASE-DISPLACEMENT-(B1-D1) 05146000 RB2 EQU R11 2ND BASE-DISPLACEMENT-(B2-D2) 05148000 RMEM EQU R12 CONTAINS RELOCATION VALUE 05150000 RLINK EQU R14 INTERNAL LINAKGE REGISTER-RETURN ADD 05152000 ROP EQU R15 USED TO HOLD OPCODE BYTE 05154000 * **NOTE** DURING MAIN EXECUTION REGS R2,ROP ARE BYTE REGS. * 05156000 SPACE 1 05158000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05160000 * * 05162000 * ORGANIZATION OF THE ASSIST INTERPRETER * 05164000 * * 05166000 * 1. INITIALIZATION CODE * 05168000 * 2. INTERRUPT-HANDLING AND EXIT CODE * 05170000 * 3. OCCASIONAL INTERNAL SUBROUTINE CODE * 05172000 * 4. PRIMARY INSTRUCTION FETCH AND COMMON DECODING * 05174000 * 5. 1ST-LEVEL DECODING, IN GROUPS : RR, RX, SI-RS, AND SS * 05176000 * 6. 2ND-LEVEL SECTIONS-PERFORM INDIVIDUAL INSTRUCTIONS, * 05178000 * IN GROUPS: RR, RR-RX OVERLAP, RX, SI, RS, SS,SPECIAL * 05180000 * 7. 3RD-LEVEL INTERNAL SUBROUTINES (DECODERS,RANGE CHECK) * 05182000 * 8. DATA AREAS, OPCODE BRANCH AND PROTECTION TABLES * 05184000 * * 05186000 * **WARNING** ADDRESSIBILITY IS NOW TIGHT IN EXECUT. * 05187000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05188000 EJECT 05190000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05192000 * INITIALIZATION PHASE - OBTAIN PARAMATER ADDRESSES FROM CALLER* 05194000 * PERFORM CALCULATIONS TO GET THEM INTO NEEDED FORM. ZERO OUT THE * 05196000 * INSTRUCTION STACK FINSTACK,AND INITIALIZE ANY REQUIRED REGISTER * 05198000 * VALUES FOR THE EXECUTION. ALSO SAVE INSTRUCTION LIMIT VALUE. * 05200000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05202000 SPACE 1 05204000 $SAVE RGS=(R14-R12),BR=R8,SA=EXECSAVE 05206000 LR REC,R10 MOVE ECONTROL BLOCK POINTER OVER 05210000 USING ECONTROL,REC NOTE USAGE 05212000 TM ECFLAG0,$ECCONT IS THIS A CONTINUE OR A NEW 05214000 BO EXCONTIN INIT ALREADY DONE-KEEP GOING 05216000 OI ECFLAG0,$ECCONT NOTE THAT ANY OTHERS WILL BE CONTINU 05218000 SPACE 1 05220000 * INSTRUCTION STACK ZEROING AND CHAINING. * 05222000 SR R1,R1 CLEAR FOR ZEROING USE 05224000 SR R2,R2 CLEAR FOR ZEROING 05226000 SR R3,R3 CLEAR FOR ZEROING 05228000 LA R4,L'ECSTENT VALUE OF SINGLE ENTRY 05230000 LA R5,ECINSTAC+L'ECINSTAC*(EC$STACK-1) GET ENDING LIMIT 05232000 LA R7,ECINSTAC GET BEGINNING ADDRESS OF STACK AREA 05234000 USING ECSTACKD,R7 SET UP TEMPORARY USING 05236000 LA R0,ECINSTAC+L'ECINSTAC GET @ 2ND ELEMENT 05238000 SPACE 1 05240000 EXINITST STM R0,R3,ECSTENT ZERO 1 TABLE ENTRY 05242000 LR R7,R0 UPDATE POINTER TO STACK ENTRY 05244000 BXLE R0,R4,EXINITST CONTINUE LOOPING 05246000 SPACE 1 05248000 LA R0,ECINSTAC ADDRESS FOR WRAPAROUND 05250000 STM R0,R3,ECSTENT STORE IN LAST ENTRY 05252000 ST R7,ECRSTK SAVE WHERE CAN BE PICKED UP 05254000 DROP R7 DROP TEMPORARY REG TO KEEP USING STRAIGHT 05256000 MVC ECILIMT,ECILIMP MOVE PERMANENT TO TEMPORARY 05258000 MVC ECILCMSK(4),ECFENTER MAKE ENTRY POINT THE PSW 05260000 MVC ECR14SAV,ECREG14 SAVE FOR ORIGINAL RETURN @ 05261000 SPACE 1 05262000 EXCONTIN BAL RLINK,EXADCALC GO TO RECALCULATE ADDRESSES IF NEED 05264000 SPACE 1 05266000 EXSPIEGO EQU * 05268000 TM ECFLAG0,$ECSPIEA IS OUR SPIE ALREADY IN EFFECT 05270000 BO EXSPIEA YES,WE DON'T HAVE TO RE-SPIE 05272000 $SPIE EXSPIERT,((1,15)),CE=EXSPIEXT,ACTION=CR CATCH ALL INTRP 05274000 ST R1,ECPICA SAVE PREVIOUS PICA, IF ANY 05276000 OI ECFLAG0,$ECSPIEA SHOW OUR SPIE IS IN CONTROL 05278000 EXSPIEA L RSTK,ECRSTK GET POINTER TO NEXT SLOT FOR STACK 05280000 USING ECSTACKD,RSTK SET UP STACK USING FROM NOW ON 05282000 L RMEM,ECRELOC GET RELOCATION VALUE IN REGISTER 05284000 SR R2,R2 CLEAR REG FOR CONSTANT INSERTS 05286000 STH R2,ECINTCOD SET THE INTERRUPT CODE TO 0 05288000 SR ROP,ROP CLEAR OPCODE REG FOR CONSTANT IC'S 05292000 L RB2,ECILCMSK LOAD INST ADDR WHERE EXFINB EXPECTS 05294000 LR RCC,RB2 PLACE CC AND MASK OVER 05296000 SPM RCC INITIALIZE REAL CC TO FAKE ONE 05298000 AIF (NOT &$FLOTE).EXNOFL1 SKIP IF NOT GOING TO DO FP 05300000 LD F0,ECFPREGS GET FP REG 05302000 LD F2,ECFPREGS+8 GET 2ND FP REG 05304000 LD F4,ECFPREGS+16 LOAD 3RD FP REG 05306000 LD F6,ECFPREGS+24 GET 4TH FP REG 05308000 .EXNOFL1 ANOP 05310000 B EXFINB SKIP TO START RUN 05312000 EXECSAVE DC 18F'0' SAVE AREA, ALSO BASE REGISTER HERE 05314000 DROP R8 KILL TEMPORARY USING 05316000 USING EXECSAVE,R13 USE R13 AS BASE/SAVEAREA POINTER 05318000 EXJUMP DS 0H BASE FOR 2ND LEVEL INDEX JUMPS 05320000 SPACE 1 05322000 * * * * * 0CX INTERRUPT EXITS * * * * * * * * * * * * * * * * * * * * 05324000 * THE LABELS ARE HERE SO THAT OTHERS MAY BE EQU'D TO THEM* 05326000 EX0C1 LA R0,1 SHOW OPERATION INTERRUPT 05328000 AIF (&$DEBUG).EX0C1A SKIP DEBUG CODE IF PRODUCTION 05330000 CLI ECOP,X'83' IS CODE THE PSEUDO DIAGNOSE 05332000 BE EXDIAG YES,GO THERE FOR OUR PSEUDO DIAGNOSE 05334000 .EX0C1A ANOP 05336000 B EXEXITI EXIT POINT FOR INTERRUPTS 05338000 EX0C2C EQU * CHECK FOR PRIVILEGED OPERATION 05340000 TM ECKYAMWP,$ECPRBST ARE WE IN PROBLEM STATE 05342000 BCR Z,RLINK NO,SUPERVISOR STATE,SO OK-RETURN 05344000 EX0C2 LA R0,2 PRIVILEGED OPERATION 05346000 B EXEXITI EXIT POINT FOR INTERRUPTS 05348000 EX0C3 LA R0,3 EXECUTE INTERRUPT 05350000 B EXEXITI EXIT POINT FOR INTERRUPTS 05352000 EX0C4 LA R0,4 PROTECTION INTERRUPT 05354000 B EXEXITI EXIT POINT FOR INTERRUPTS 05356000 *EX0C5 LA R0,5 ADDRESSING INTERRUPT 05358000 * B EXEXITI QUIT 05360000 EX0C6 LA R0,6 SPECIFICATION INTERRUPT 05362000 B EXEXITI EXIT POINT FOR INTERRUPTS 05364000 *EX0C7 LA R0,7 DATA EXCEPTION 05366000 * B EXITI QUIT 05368000 EX0CA LA R0,10 DECIMAL OVERFLOW 05369000 B EXEXITI QUIT 05369500 SPACE 2 05370000 * ENTERED WHEN PROGRAM BRANCHES OUT OF RANGE * 05372000 EXIAOUT MVI ECFLAG1,$ECBRN14 HOPE FOR NORMAL RETURN 05372500 L R14,ECR14SAV GET RETURN @, ORIGINAL 05373000 LA R14,0(R14) REMOVE LEADING BYTE 05373500 CR RIA,R14 WAS BRANCH TO THIS @ 05374000 BE EXITA RETURN 05374500 MVI ECFLAG1,$ECBROUT WAS ACTUAL BRANCH OUT OF PROG,RET 05375000 LA R1,EXCCBROU SHOW @ BRANCH OUT 05376000 B EXITIA GO HAVE @ STORED, QUIT 05378000 EJECT 05380000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05382000 * INTERRUPT HANDLER - THIS SECTION IS ENTERED FOR ANY * 05384000 * REAL INTERRUPT, SUCH AS 0C7,0C6,ETC. THE REAL INTERRUPT * 05386000 * IS SAVED AS THE PSEUDO INTERRUPT, SINCE THEY MUST BE THE * 05388000 * SAME. THE ADDRESS IN THE PSW PART OF THE PIE IS MODIFIED SO * 05390000 * THAT OS WILL RETURN CONTROL TO EXSPIERT INSTEAD OF TO THE * 05392000 * INTERRUPTED CODE, AND THEN CONTROL IS GIVEN TO OS. WHEN THE * 05394000 * INTERPRETER REGAINS CONTROL, IT EXITS, SHOWING AN INTERRUPT. * 05396000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05400000 SPACE 1 05402000 USING *,R15 05404000 EXSPIEXT LH RB1,2(R1) GET INTERRUPT CODE FROM PIE 05406000 AIF (&$DEBUG).EXXNSP SKIP IF PRODUCTION 05410000 XSNAP LABEL='SPIE',STORAGE=(*0(R1),*32(R1)), X05412000 IF=(ECFLAG2,O,X'20',TM) XSNAP PIE 05414000 .EXXNSP ANOP 05416000 BR R14 RETURN TO OS CONTROL 05420000 DROP R15 DROP USING TO KEEP STRAIGHT 05424000 SPACE 1 05426000 EXSPIERT LR R0,RB1 MOVE INTERRUPT CODE OVER WHERE NEED 05430000 EJECT 05432000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05434000 * EXIT AND RETURN CODE - SAVE EVERYTHING REQUIRED, * 05436000 * REMOVE $SPIE IF NECESSARY, AND RETURN TO CALLER. * 05438000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05440000 SPACE 1 05442000 EXEXITI STH R0,ECINTCOD SAVE INTO INTERRUPT CODE 05444000 MVI ECFLAG1,0 RESET, NEEDED BY REPLACE MONITOR 05444500 * FOLLOWING FINDS MESSAGE FOR 0CX COMPLETION CODES. * 05446000 ALR R0,R0 SLL R0,1,DOUBLE CODE FOR INDEX 05448000 LR R1,R0 MOVE WHERE WE CAN USE FOR INDEX 05450000 LH R1,EXCOFFS(R1) GET OFFSET TO MESSAGE BLOCK 05452000 LA R1,EXCC0(R1) GET @ MESSAGE BLOCK 05454000 EXITIA ST R1,ECERRAD STORE THIS @ IN ECONTROL 05456000 SPACE 1 05458000 EXITA ST RSTK,ECRSTK SAVE THE STACK POINTER 05460000 N RCC,=XL4'3F000000' REMOVE @, ILC(WHICH IS WRONG) 05462000 ALR RCC,RIA PUT THE ADDRESS AND CONCODE TOGETHER 05464000 ST RCC,ECILCMSK SAVE INTO THE PSW 05466000 OI ECILCMSK,X'40' SET ILC TO =1 05468000 CLI ECOP,X'40' WAS LAST INSTRUCTION RR 05470000 BL EXITAILC YES, SO ILC IS SET RIGHT,BRANCH 05472000 XI ECILCMSK,X'C0' SET ILC TO 2 FOR RX-SI-RS 05474000 CLI ECOP,X'C0' WAS INST AN SS 05476000 BL EXITAILC NO, IT WAS SI-RX-RS, BRANCH, ILC=2 05478000 OI ECILCMSK,X'40' SET ILC=3 FOR SS INSTS 05480000 EXITAILC EQU * 05482000 AIF (NOT &$FLOTE).EXNOFL3 SKIP IF NOT FLOATINGS 05484000 STD F0,ECFPREGS STORE FIRST FP REG 05486000 STD F2,ECFPREGS+8 STORE 2ND FP REG 05488000 STD F4,ECFPREGS+16 SAVE THE THIRD FP REG 05490000 STD F6,ECFPREGS+24 SAVE 4TH FP REG 05492000 .EXNOFL3 ANOP 05494000 TM ECFLAG0,$ECSPIEB DO WE NEED TO UNDO SPIE 05496000 BZ EXECRET NO WE DON'T,SO DON'T SPIE 05498000 L R1,ECPICA GET PICA ADDRESS BACK 05500000 $SPIE ACTION=(RS,(1)) RESTORE PREVIOUS XSPIEBLK 05506000 NI ECFLAG0,255-$ECSPIEA WE WILL HAVE TO RESPIES 05508000 EXECRET $RETURN RGS=(R14-R12) 05510000 EJECT 05532000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05534000 * SPECIAL ROUTINES - THE FOLLOWING ROUTINES ARE USED AT MOST * 05536000 * OCCASIONALLY, AND ARE NOT DIRECTLY PARTS OF THE INTERPRETER. * 05538000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05540000 SPACE 1 05542000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05544000 * EXTERNAL CALL ROUTINE - THIS SECTION PREPARES ALL OF * 05546000 * THE DUMMY MACHINE AREAS, AND CALLS THE ROUTINE WHOSE ADDRESS * 05548000 * IS IN RWK. IT CHECKS FOR AN INTERRUPT CONDITION,RESTORES * 05550000 * ALL THE REGISTERS, AND RETURNS CONTROL TO NORMAL EXECUTION. * 05552000 * ***NOTE*** THIS ROUTINE IS MAINLY FOR FUTURE USE, I.E. FOR * 05554000 * IMPLEMENTATION OF CERTAIN SVC'S, MACHINE LEVEL I/O, OR * 05556000 * ANY ADDITIONAL PSEUDO MACHINE OPCODES WHICH ARE REQUIRED. * 05558000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05560000 SPACE 1 05562000 EXCALL STM R0,R15,ECTSAVE SAVE THE REGS TO BE SAFE 05564000 ST RSTK,ECRSTK SAVE POINTER IN CONTROL BLOCK 05566000 N RCC,=XL4'3F000000' REMOVE EXTRA BITS IN CC REG 05567000 ALR RCC,RIA PUT THE ADDRESS AND CONCODE TOGETHER 05568000 ST RCC,ECILCMSK SAVE INTO THE PSW 05570000 LR R15,RWK PLACE ADDRESS IN R15 FOR CALL 05572000 BALR RLINK,R15 CALL THE ROUTINE 05574000 LM R0,R15,ECTSAVE RESTORE THE REGS 05576000 SR R0,R0 CLEAR THIS OUT 05578000 CH R0,ECINTCOD SEE IF INTERRUPT CODE 05580000 BNE EXITA IF THERE WAS CODE-RETURN 05582000 CLI ECFLAG1,0 WAS SPECIAL CODE STILL 0 05584000 BNE EXITA NO,SO EXIT WITH ERROR FLAG 05586000 BAL RLINK,EXADCALC HAVE ADDRESS RECALCULATED IF NEEDED 05588000 L RB2,ECILCMSK GET PSW BACK 05590000 LR RCC,RB2 GET CC AND MASK BACK 05592000 B EXFINB BRANCH THERE, IN CASE PSW CHANGED 05594000 SPACE 1 05596000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05598000 * ADDRESS CALCULATION SECTION - IF THE ADDRESS VALUES * 05600000 * MAY HAVE BEEN CHANGED, OR ARE NOT ALREADY COMPUTED,THIS * 05602000 * SECTION FINDS THE USER HIGH ADDRESS AND RELOCATION FACTOR * 05604000 * GIVEN REAL LOW AND HIGH ADDRESSES, AND USER LOW ADDRESS. * 05606000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05608000 SPACE 1 05610000 EXADCALC TM ECFLAG0,$ECADSOK SEE IF THE ADDR'S NEED FIXING 05612000 BCR O,RLINK RETURN IF CALCULATIONS UNNEEDED 05614000 OI ECFLAG0,$ECADSOK FLAG ADDRS OK, WHICH THEY WILL BE 05616000 L R0,ECRADH GET REAL HIGH ADDRESS LIMIT 05618000 S R0,ECRADL GET LENGTH OF PROGRAM 05620000 A R0,ECFADL ADD TO FAKE LOW ADDRESS 05622000 ST R0,ECFADH STORE THIS IN FAKE HIGHEST 05624000 SH R0,=H'256' FOR @ CHECKING DIFFERENCE 05626000 ST R0,ECFADHC SAVE FOR @ CHECKING EXRANGE 05628000 L R0,ECRADL GET REAL LOWEST ADDRESS 05630000 S R0,ECFADL SUBTRACT TO GET RELOCATION EXEC 05632000 ST R0,ECRELOC SAVE THIS FOR EXECUTION TIME RELOCAT 05634000 BR RLINK RETURN TO CALLING SECTION 05636000 EJECT 05638000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05640000 * MAIN INTERPRETER LOOP HEAD. ALL SUCCESSFUL BRANCHES PASS * 05642000 * THROUGH EFINB, WHICH CHECKS FOR ILLEGAL BRANCHES. CONTROL THEN * 05644000 * PASSES THROUGH EFIN,WHICH CHECKS FOR LOOPING BEYOND INSTRUCTION * 05646000 * COUNT LIMIT. ALL OTHER INSTRUCTIONS SKIP EFINB AND RETURN * 05648000 * DIRECTLY TO EFIN. THE NEXT INSTRUCTION IS THEN ACCESSED,DECODED * 05650000 * PARTIALLY FOR 4-WAY BRANCH (RR,RX,SI&RS,SS),AND VARIOUS * 05652000 * BOOKKEEPING DETAILS DONE (UPDATING INSTRUCTION ADDRESS,MOVING * 05654000 * INSTRUCTION INTO NEXT STACK LOCATION,ETC. ) * 05656000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05658000 SPACE 1 05660000 EXFINB LA RIA,0(RB2) MOVE BRANCH ADDRESS OVER,REM 1ST BYT 05662000 C RIA,ECFADL COMPARE FOR BELOW LOWEST FAKE 05664000 BL EXIAOUT BRANCHED OUT OF RANGE 05666000 C RIA,ECFADH COMPARE TO NEXT ADDRESS BEYOND AREA 05668000 BNL EXIAOUT ADDRESS OUT OF RANGE-ERROR 05670000 AIF (NOT &$ALIGN).EXFT1 SKIP IF MACHINE REQUIRES ALIGN 05671000 ST RB2,ECTSAVE SAVE ADDR: MUST DO CHECK SLOW WAY 05671100 TM ECTSAVE+3,X'01' WAS ADDR ODD 05671200 BO EX0C6 YES-BAD PROGRAMMER-JUMP 05671300 .EXFT1 AIF (&$ALIGN).EXFT2 SKIP IF ALIGN NOT NEEDED 05671400 LH R0,0(RB2,RMEM) QUICK ALIGNEMNT CHECK 05672000 .EXFT2 ANOP 05672050 * IF TIMER RUNOUT OCCURS, ASSIST SETS ECFLAG1=$ECTIMEX. 05672100 * EXECUT DISCOVERS THIS NEXT TIME BRANCH IS SUCCESSFUL. 05672200 AIF (&$TIMER EQ 0).EXNOTOA SKIP IF NO TIMER AT ALL 05672250 CLI ECFLAG1,$ECTIMEX HAS FLAG BEEN SET BY TIMER EXIT 05672300 BE EXOVRTIM YES, SO GO THERE, TIME RAN OUT 05672400 .EXNOTOA ANOP 05672450 SPACE 2 05672500 * CHECK FOR EXCEEDING TOTAL INSTRUCTION COUNT * 05676000 * ALL INSTRUCTIONS BUT SUCCESSFUL BRANCHES ENTER HERE * 05678000 EXFIN L R0,ECILIMT GET THE COUNTER 05680000 EXTIMDEC BCT R0,EXGO DECREMENT COUNTER, BRANCH IF OK 05682000 ST R0,ECILIMT RESTORE INST COUNT FOR STATS(0) 05684000 MVI ECFLAG1,$ECTIMEX SHOW TIME EXCEEDED(INSTR LIMIT) 05686000 LA R1,EXCCTIME SHOW @ TIME MESSAGE 05688000 B EXITIA GO TO FINISH AND EXIT 05692000 AIF (&$TIMER EQ 0).EXNOTOB SKIP IF NO TIMER AT ALL 05693000 EXOVRTIM LA R1,EXCCTIMB SHOW TIMER OVER. ECFLAG1 ALREADY SET 05694000 B EXITIA SKIP TO EXIT SECTION 05696000 .EXNOTOB ANOP 05697000 EXGO ST R0,ECILIMT STORE THIS BACK IN LIMIT 05698000 SPACE 1 05700000 * INSTRUCTION FETCH AND PRIMARY DECODING SECTION. * 05702000 SPACE 1 05704000 LA RWK,0(RIA,RMEM) OBTAIN PHYSICAL REAL ADDRESS 05706000 EXFEXENT L RSTK,ECSTLINK OBTAIN ADDRESS OF NEXT STACK SLOT 05708000 STM RIA,RCC,ECSTIADD SAVE INSTRUCTION ADDRESS,CC,MASK 05710000 MVC ECSTINST,0(RWK) MOVE 6 BYTES INTO NEXT SLOT 05712000 IC ROP,ECOP GET OPCODE INTO REGISTER 05714000 IC R2,EXOPTAB1(ROP) GET SECONDARY CODE FOR OPCODES 05716000 LR R1,ROP GET OPCODE WHERE CAN BE CHANGED 05718000 SRL R1,6 REMOVE ALL BUT 1ST 2 BITS 05720000 SLL R1,2 SHIFT BACK = MULT*4 FOR INDEX 05722000 AIF (&$DEBUG).EXSNAP1 SKIP XSNAPS GENERATION IF NOT DEBUG 05724000 XSNAP LABEL='PRIMARY FETCH',IF=(ECFLAG2,O,X'80',TM), #05726000 STORAGE=(*ECSTENT,*ECB2D2+2,*ECFPREGS,*ECILIMP) 05728000 LM RB1,RB2,ECRADL GET LOW AND HIGH @ POINTERS 05730000 XSNAP T=NO,LABEL='USER AREA',STORAGE=(*0(RB1),*0(RB2)),IF=(ECF#05732000 LAG2,O,X'40',TM) 05734000 .EXSNAP1 ANOP 05736000 SPACE 1 05738000 * UPDATE INSTRUCTION COUNTER RIA TO NEXT INSTRUCTION, * 05740000 * TAKE 4-WAY BRANCH TO PRIMARY TYPE DECODING SECTIONS. * 05742000 EXEXLEN A $CHN+RIA,EXILENG(R1) UPDATE RIA**CHANGED BY EXEX***** 05744000 EXPRIME B *+4(R1) TAKE BRANCH FOR PRIMARY PROCESSING 05746000 B EXTRR R1=0 ==> RR INSTRUCTION 05748000 B EXTRX R1=4 ==> RX INSTRUCTION 05750000 B EXTSIRS R1=8 ==> SI OR RS INSTRUCTION 05752000 B EXTSS R1=12 ==> SS INSTRUCTION 05754000 EJECT 05756000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05758000 * RR PRIMARY DECODING - DECODE R1-R2 FIELDS,THEN MAKE * 05760000 * SECOND LEVEL BRANCH TO INDIVIDUAL INSTRUCTION PROCESSORS. * 05762000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05764000 SPACE 1 05766000 EXTRR BAL RLINK,EXR1R2 GET R1,R2 FIELDS SEPARATED 05768000 LH R1,EXSECRR(R2) GET SECOND LEVEL BRANCH INDEX VALUE 05770000 B EXJUMP(R1) TAKE BRANCH TO INDIVIUDAL ROUTINES 05772000 SPACE 4 05774000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05776000 * RX PRIMARY DECODING - DECODE B2-D2 FIELDS,R1-X2 FIELDS, * 05778000 * YIELDING 2ND OPERAND ADDRESS IN REGISTER RB2. IF INSTRUCTION IS * 05780000 * ONE OF THOSE NOT REQUIRING ADDRESS RELOCATION(I.E. BRANCHES OF * 05782000 * SOME TYPE,LOAD ADDRESS) TAKE SECOND LEVEL BRANCH IMMEDIATELY. * 05784000 * FOR OTHER INSTRUCTIONS,THE 2ND OPERAND ADDRESS IS CHECKED FOR * 05786000 * WITHIN THE PERMITTED RANGE BY EXRANGE, AND THEN THE ADDRESS IS * 05788000 * RELOCATED TO THE ACTUAL CORE ADDRESS. THEN THE SECOND-LEVEL * 05790000 * CHOICE IS MADE FOR THE INDIVIDUAL PROCESSORS. * 05792000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05794000 SPACE 1 05796000 EXTRX BAL RLINK,EXABD PERFORM B2-D2 ADDRESS CALCULATION 05798000 BAL RLINK,EXR1R2 OBTAIN R1,X2 FIELDS 05800000 BZ EXRXNOX IF X2=0,NO INDEXING NEED BE DONE 05802000 AL RB2,ECREGS(RX2) PERFORM INDEXING OPERATION 05804000 LA RB2,0(RB2) ZAP POSSIBLE 1ST BYTE FROM X2 FIELD 05806000 EXRXNOX LH R1,EXSECRX(R2) GET BRANCH INDEX ADDRESS 05808000 CH R2,EXNORNG COMPARE WITH HIGHEST FOR NO RANGECK 05810000 BNH EXJUMP(R1) TAKE BRANCH TO ROUTINES 05812000 BAL RLINK,EXRANGE HAVE THE RANGE CHECKED FOR THE INST 05814000 AR RB2,RMEM RELOCATE FAKE @ TO REAL @ 05816000 AIF (&$S370 NE 2).EXTRX SKIP IF NOT SIMULATING S/370'S 05816100 TM ECFLAG4,AJONALGN MUST WE FAKE ALIGNMENT 05816200 BZ EXJUMP(R1) NO--> BRANCH 05816300 CH R2,EXALIGN DOES INSTRUCTION REQUIRE ALIGNMENT 05816400 BH EXJUMP(R1) NO--> BRANCH 05816500 LTR RB1,RB2 SAVE FOR LATER, SET CC TO ^= 05816600 MVC EXDUBLWD(8),0(RB2) MOVE MAXIMUM OF 8 BYTES OVER 05816700 LA RB2,EXDUBLWD LOAD ADDRESS OF ALIGNED FIELD 05816800 .EXTRX ANOP 05816900 B EXJUMP(R1) TAKE BRANCH TO APPROPRIATE ROUTINE 05818000 SPACE 4 05820000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05822000 * SI-RS PRIMARY DECODING - DECODE B1-D1 FIELD,WITH RESULTING * 05824000 * ADDRESS APPEARING IN REGISTER RB2. THEN MAKE SECOND-LEVEL CHOICE * 05826000 * TO THE VARIOUS INDIVIDUAL PROCESSORS. * 05828000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05830000 SPACE 1 05832000 EXTSIRS BAL RLINK,EXABD ADDRESSING FOR B1-D1 FIELD 05834000 LH R1,EXSECSI(R2) GET SECOND LEVEL JUMP INDEX 05836000 B EXJUMP(R1) TAKE BRANCH TO INDIVIUAL ROUTINE 05838000 EJECT 05840000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05842000 * SS PRIMARY DECODING - DECODE AND CHECK 1ST AND 2ND OPERAND * 05844000 * ADDRESSES FOR WITHIN RANGE,USING DECODED VALUES OF L OR L1 AND L2 * 05846000 * FIELDS AS REQUIRED. AFTER RELOCATING TO ACTUAL MACHINE ADDRESSES, * 05848000 * MAKE SECOND-LEVEL BRANCH TO INDIVIDUAL PROCESSOR SEGMENTS. * 05850000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05852000 SPACE 1 05854000 EXTSS BAL RLINK,EXABD HAVE 1ST @ DECODED 05856000 BAL RLINK,EXRANGE CHECK 1ST @ FOR WITHIN RANGE 05858000 LA RB1,0(RB2,RMEM) RELOCATE THE 1ST @ TO REAL @ 05860000 LH RB2,ECB2D2 GET THE BASE-DISP FOR 2ND @ 05862000 BAL RLINK,EXABD1 HAVE 2ND @ DECODED 05864000 SPACE 1 05866000 * NOTE THAT THE FOLLOWING SEQUENCE IS ESSENTIALLY LIKE * 05868000 * THE SECTION EXRANGE. THIS IS REQUIRED BECAUSE THE 1ST AND * 05870000 * 2ND OPERANDS OF SS INSTRUCTIONS DO NOT NECESSARILY HAVE THE * 05872000 * SAME PROTECTION ATTRIBUTES, I.E. 1ST OPERANDS ARE SOMETIMES * 05874000 * STORE PROTECTION VIOLATION CAUSES, WHILE 2ND OPERANDS USUALLY* 05876000 * CAUSE ONLY FETCH PROTECTION VIOLATIONS, IF ANY. * 05878000 C RB2,ECFADL IS @ LOWER THAN LOWEST ALLOWED 05880000 BL EXSSL TOO LOW,GO SEE IF REALLY ILLEGAL 05882000 C RB2,ECFADHC COMP WITH ACTUAL HI LIM(ECFADH-256) 05884000 BL EXSSL2 @ ACCEPTABLE,GO RELOCATE AND EXECUTE 05886000 SPACE 1 05888000 * ADDRESS OUT OF RANGE-CHECK INST TYPE/PROTECTION MODE. * 05890000 EXSSL LA RWK,EXIPROT-64(ROP) GET @ PROTECTION CONTROL BYTE 05892000 TM 0(RWK),EXPRSTO2+EXPRFET2 ANY CORE ACCESS AT ALL? 05894000 BO EXRANOUT YES,AND @ OUT OF RANGE-GO TO FLAG 05896000 SPACE 1 05898000 BZ EXSSL2 NO IT ISN'T,SO ITS OK ANYWAY 05900000 TM ECFLAG0,$ECPROT OUT OF RANGE,FETCH PROT,IF MODE ON 05902000 BNZ EXRANOUT ABSOLUTE PROTECT MODE-SO PROTECT ERR 05904000 SPACE 1 05906000 EXSSL2 AR RB2,RMEM RELOCATE THE 2ND OP ADDRESS 05908000 MVC EXQSS(2),ECOP MOVE THE OPCODE AND LENGTH(S) OVER 05910000 LH R1,EXSECSS(R2) GET SECOND LEVEL BRANCH INDEX 05912000 B EXJUMP(R1) TAKE BRANCH 05914000 EJECT 05916000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05918000 * SECOND-LEVEL PROCESSOR SECTIONS - THESE SECTIONS PERFORM * 05920000 * ALL REQUIRED COMPUTING AFTER INITIAL DECODING HAS BEEN DONE IN * 05922000 * RESPECTIVE PRIMARY SECTIONS. * 05924000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05926000 SPACE 4 05928000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05930000 * RR SECOND-LEVEL PROCESSOR SECTION. * 05932000 * TO CONDENSE CODE IN RR SECTION, REMOVE THE CODE * 05934000 * SECTIONS BELONGING TO EXLR AND EXFPRR AND EQU THOSE SYMBOLS * 05936000 * TO EXNORMRR INSTEAD * 05938000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05940000 SPACE 1 05942000 * SET PROGRAM MASK * 05944000 EXSPM L RCC,ECREGS(RR1) PLACE SPECIFIED REG INTO CC REGISTER 05946000 SPM RCC SET REAL CC-PM TO FAKE CC-PM 05948000 B EXFIN RETURN FOR NEXT INSTRUCTION 05950000 SPACE 1 05952000 AIF (&$PRIVOP).EXSSK SKIP AND GENERATE RITH CODE-PRIVS OK 05954000 EXSSK EQU EX0C2 PRIVILEGEDS NOT ALLOWED-FLAG 05956000 EXISK EQU EX0C2 PRIVILEGEDS NOT ALLOWED-FLAG 05958000 AGO .EXSVC SKIP OVER GENERATION OF CODE 05960000 .EXSSK ANOP 05962000 EXSSK BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 05964000 EXISK BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 05966000 .EXSVC ANOP 05968000 SPACE 1 05970000 EXSVC L RWK,ECSVCADS GET @ SVC CONTROL TABLE,IF EXISTS 05972000 LTR RWK,RWK ARE SVC'S ALLOWED 05974000 BZ EX0C2 NO SVC'S AT ALL,SO ERROR 05976000 IC RR1,ECI2 GET IMMEDIATE FIELD 05978000 IC RR1,0(RR1,RWK) GET SVC OFFSET BYTE TO @ ROUTINE 05980000 SLA RR1,2 MULT*4 FOR INDEX TO FULLWORDS 05982000 BZ EX0C2 IF =0,MAKE IT PRIVILEGED OPERATION 05984000 L RWK,256(RWK) GET @ SVC ROUTINE @ TABLE 05986000 L RWK,0(RR1,RWK) PICK UP ACTUAL @ SVC ROUTINE 05988000 B EXCALL GO TO CALL ROUTINE 05990000 * **NOTE** AN SVC CONTROL TABLE IS 260 BYTES LONG, CONTAINING * 05992000 * 256 BYTES OF INDIVIUDAL SVC INDICATORS, AND 1 FULLWORD PTR. * 05994000 EJECT 05996000 * REGULAR RR INSTRUCTIONS - 3 ENTRIES TO SEQUENCE - * 05998000 * LR (SEPARATE SINCE CURRENT CC IS NOT CHANGED) * 06000000 * NR,CLR,OR,XR,CR,AR,SR,ALR,SLR - NORMALS * 06002000 * LPR,LNR,LTR,LCR (DO NOT NEED R1 LOADED) * 06004000 EXLR L RWK,ECREGS(RR2) GET SECOND OPERAND 06006000 ST RWK,ECREGS(RR1) PLACE INTO FIRST OPERAND 06008000 B EXFIN RETURN FOR NEXT INSTRUCTION 06010000 SPACE 1 06012000 EXNORMRR L RWK,ECREGS(RR1) OBTAIN 1ST OPERAND 06014000 EXLPNTR L RR2,ECREGS(RR2) OBTAIN 2ND OPERAND 06016000 STC ROP,EXQRR PLACE ACTUAL OPCODE INTO INST 06018000 EXQRR LR $CHN+RWK,RR2 **RIGHT OPCODE IS ENTERED IN ******* 06020000 ST RWK,ECREGS(RR1) SAVE IN FAKE 1ST OPERAND LOCATION 06022000 BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06024000 SPACE 1 06026000 AIF (&$FLOTEX).EXXFPRR GO GENERATE CODE IF XFP OK 06027000 EXXFPRR EQU EX0C1 NOTE XFP NOT ALLOWED 06027500 AIF (&$FLOTE).EXFPRR GO GENERATE IF FLOATINGS OK 06028000 EXFPRR EQU EX0C1 NOTE WE DO NOT ALLOW FLOATINGS 06030000 AGO .EXFPRR2 06032000 .EXXFPRR ANOP 06033000 EXXFPRR EQU * CODE FOR XFP SAME AS REGULAR FP 06033500 .EXFPRR ANOP 06034000 SPACE 2 06036000 * RR FLOATING POINT INSTRUCTIONS. * 06038000 EXFPRR SPM RCC SET THE CONDITION CODE 06040000 EX 0,ECOP EXECUTE THE ACTUAL INSTRUCTION 06042000 BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06044000 .EXFPRR2 ANOP 06046000 SPACE 2 06046010 AIF (&$S370 NE 0).EXLONG1 SKIP IF GENERATING S/370'S 06046020 EXLONG EQU EX0C1 NOTE S/370 RR'S NOT ALLOWED 06046030 AGO .EXLONG3 SKIP OVER CODE GENERATION 06046040 .EXLONG1 ANOP 06046050 * ADDRESS CHECKING CODE FOR CLCL, AND MVCL 06046060 EXLONG EQU * COMMON CODE FOR MVCL, CLCL CHECKING 06046070 TM ECR1R2,X'11' DID HE SPECIFY EVEN REGS? 06046080 BNZ EX0C6 NO--> SPECIFICATION ERROR 06046090 L R0,EXLONGMK LOAD MASK TO ZAP TOP OF REGS 06046100 LA R1,ECREGS(RR1) GET ADDRESS OF FIRST REGISTER PAIR 06046110 LM RB1,RB2,0(R1) LOAD FIRST SET OF REGISTERS 06046120 NR RB1,R0 GET RID OF UPPER BYTE OF ADDRESS 06046130 NR RB2,R0 GET RID OF UPPER BYTE OF LENGTH 06046140 BZ EXLONG2 IF LENGTH = 0, DON'T CHECK ADDRESS 06046150 C RB1,ECFADL IS ADDRESS TOO LOW? 06046160 BL EXLONG1 YES - BRANCH TO CHECK PROTECTION 06046170 LR RWK,RB1 COPY ADDRESS TO WORK REGISTER 06046180 AR RWK,RB2 COMPUTE HIGHEST ADDRESS 06046190 C RWK,ECFADH IS IT ABOVE MAXIMUM FOR USER? 06046200 BL EXLONG2 NO - BRANCH AROUND PROTECTION CHECK 06046210 EXLONG1 CLI ECOP,14 IS THIS A MVCL INSTRUCTION 06046220 BE EX0C4 YES - PROTECTION ERROR 06046230 TM ECFLAG0,$ECPROT IS FETCH PROTECT ON? 06046240 BNZ EX0C4 YES - PROTECTION ERROR 06046250 SPACE 2 06046260 * FIRST ADDRESS OK - CHECK SECOND 06046270 EXLONG2 LA R2,ECREGS(RR2) GET ADDRESS OF SECOND REG. PAIR 06046280 LM RR1,RR2,0(R2) LOAD SECOND SET OF REGISTERS 06046290 NR RR1,R0 GET RID OF UPPER BYTE AF ADDRESS 06046300 NR RR2,R0 GET RID OF UPPER BYTE OF LENGTH 06046310 BZ EXLONG4 IF LENGTH = 0, DON'T CHECK ADDRESS 06046320 C RR1,ECFADL IS ADDRESS TOO LOW? 06046330 BL EXLONG3 YES - BRANCH TO CHECK FOR PROTECTION 06046340 LR RWK,RR1 COPY ADDRESS INTO WORK REGISTER 06046350 AR RWK,RR2 COMPUTE HIGHEST ADDRESS 06046360 C RWK,ECFADH IS IT ABOVE USER MAXIMUM 06046370 BL EXLONG4 NO - BRANCH AROUND ERROR CHECK 06046380 EXLONG3 TM ECFLAG0,$ECPROT IS ABSOLUTE PROTECT ON 06046390 BNZ EX0C4 YES - PROTECTION ERROR 06046400 SPACE 2 06046410 * BOTH ADDRESSES ARE OK - RELOCATE THEM AND PERFORM COMMAND 06046420 EXLONG4 ALR RB1,RMEM RE-LOCATE ADDRESS TO ACTUAL 06046430 ALR RR1,RMEM RE-LOCATE ADDRESS TO ACTUAL 06046440 SPACE 2 06046450 AIF (&$S370 NE 1).EXLONG2 SKIP IF NOT ON REAL 370 06046460 L RB2,4(,R1) RESTORE UPPER BYTES IN LENGTH REGS 06046470 L RR2,4(,R2) RESTORE UPPER BYTES IN LENGTH REGS 06046480 STC ROP,EXQLONG STORE IN OPCODE 06046490 EXQLONG CLCL RB1,RR1 *** OPCODE STORED IN *** 06046500 BALR RCC,0 CAPTURE COND CODE 06046510 AGO .EXLONG4 06046520 .EXLONG2 ANOP 06046530 CLI ECOP,14 IS THIS A MVCL COMMAND? 06046540 BE EXMVCL YES - BRANCH 06046550 SPACE 2 06046560 * CODE FOR CLCL COMMAND 06046570 LTR RR2,RR2 SECOND LENGTH = 0? 06046580 BZ EXCLCL6 YES - BRANCH TO CHECK FIRST LENGTH 06046590 LTR RB2,RB2 FIRST LENGTH = 0? 06046600 BZ EXCLCL2 YES - BRANCH TO USE PAD & OPND 2 06046610 EXCLCL1 CLC 0(1,RB1),0(RR1) COMPARE A CHARACTER FROM EACH FIELD 06046620 BNE EXCLCL5 IF NOT EQUAL, WE ARE DONE - BRANCH 06046630 LA RB1,1(,RB1) INCREMENT POINTERS 06046640 LA RR1,1(,RR1) INCREMENT POINTERS 06046650 BCT RB2,EXCLCL3 DECREMENT FIRST LENGTH, BRANCH ^= 0 06046660 B EXCLCL7 LENGTH = 0 - BRANCH INTO PAD LOOP 06046670 EXCLCL2 CLC 4(1,R2),0(RR1) COMPARE PAD TO OPND 2 06046680 BNE EXCLCL5 IF NOT EQUAL, WE ARE DONE - BRANCH 06046690 LA RR1,1(,RR1) INCREMENT POINTER 06046700 EXCLCL7 BCT RR2,EXCLCL2 DECREMENT SECOND COUNT - BRANCH ^= 0 06046710 B EXCLCL5 IF LENGTH = 0, OPNDS = - WE'RE DONE 06046720 EXCLCL3 BCT RR2,EXCLCL1 DECREMENT SECOND LENGTH, BRANCH ^= 0 06046730 EXCLCL4 CLC 0(1,RB1),4(R2) COMPARE FIRST OPND & PAD 06046740 BNE EXCLCL5 IF NOT EQUAL, WE ARE DONE - BRANCH 06046750 LA RB1,1(,RB1) INCREMENT POINTER 06046760 BCT RB2,EXCLCL4 DECREMENT LENGTH, BRANCH ^= 0 06046770 EXCLCL5 BAL RCC,EXLONG5 CAPTURE CON CODE AND RETURN 06046780 EXCLCL6 LTR RB2,RB2 FIRST LENGTH = 0? 06046790 BNZ EXCLCL4 NO, USE 1ST OPND AND PAD 06046800 BAL RCC,EXLONG5 GET COND CODE (=0) AND RETURN 06046810 SPACE 2 06046820 * CODE FOR MVCL COMMAND 06046830 EXMVCL EQU * CODE FOR MVCL COMMAND 06046840 LR R0,RB2 ASSUME FIRST LENGTH SMALLEST 06046850 CR RB2,RR2 COMPARE THE LENGTHS 06046860 BALR RCC,0 CAPTURE CON CODE 06046870 BL *+6 IF FIRST LOWER, BRANCH 06046880 LR R0,RR2 SECOND LENGTH MUST BE THE SMALLER 06046890 LTR R0,R0 IS SMALLEST LENGTH = 0? 06046900 BZ EXMVCL3 IF SMALLER = 0, BRANCH 06046910 SPACE 2 06046920 * FOLLOWING CODE CHECKS FOR DESTRUCTIVE OVERLAP 06046930 CR RB1,RR1 IS 1ST FIELD AFTER SECOND? 06046940 BNH EXMVCL1 NO - NO OVERLAP - BRANCH 06046950 AR RWK,RMEM RE-LOCATE HIGH OPND 2 ADDRESS 06046960 CR RB1,RWK IS 1ST FIELD AFTER END OF 2ND 06046970 BNL EXMVCL1 YES - NO OVERLAP - BRANCH 06046980 TM *+1,1 SET CON CODE TO OVERFLOW (3) 06046990 BAL RCC,EXLONG5 CAPTURE CON CODE AND RETURN 06047000 SPACE 2 06047010 EXMVCL1 SR RB2,R0 DECREMENT LENGTHS BY THE SMALLER 06047020 SR RR2,R0 DECREMENT LENGTHS BY THE SMALLER 06047030 EXMVCL2 MVC 0(1,RB1),0(RR1) MOVE A BYTE 06047040 LA RB1,1(,RB1) INCREMENT POINTERS 06047050 LA RR1,1(,RR1) INCREMENT POINTERS 06047060 BCT R0,EXMVCL2 DECREMENT LENGTH, IF ^= 0, BRANCH 06047070 EXMVCL3 LTR RB2,RB2 DO WE NEED PADDING? 06047080 BZ EXLONG5 NO - WE ARE DONE - BRANCH 06047090 MVC *+7(1),4(R2) MOVE PAD CHAR INTO MVI INSTRUCTION 06047100 EXMVCL4 MVI 0(RB1),$CHN MOVE PAD TO FIRST OPRND 06047110 LA RB1,1(,RB1) INCREMENT POINTER 06047120 BCT RB2,EXMVCL4 DECREMENT LENGTH - IF ^= 0, BRANCH 06047130 SPACE 2 06047140 * COMMON CLCL, MVCL EXIT CODE 06047150 EXLONG5 XC 5(3,R1),5(R1) ZAP LOWER PART OF LENGTH IN CORE 06047160 XC 5(3,R2),5(R2) ZAP LOWER PART OF LENGTH IN CORE 06047170 O RB2,4(,R1) PUT UPPER BYTE BACK INTO REG 06047180 O RR2,4(,R2) PUT UPPER BYTE BACK INTO REG 06047190 L R0,EXLONGMK GET MASK TO ZAP UPPER BYTE OF REGS 06047200 .EXLONG4 ANOP 06047210 SPACE 2 06047220 * OPERATION COMPLETE - RESTORE REGISTERS AND RETURN 06047230 SLR RB1,RMEM DE-RELOCATE FINAL ADDRESSES 06047240 SLR RR1,RMEM DE-RELOCATE FINAL ADDRESSES 06047250 NR RB1,R0 ZAP UPPER BYTES OF ADDRESS REGS 06047260 NR RR1,R0 ZAP UPPER BYTES OF ADDRESS REGS 06047270 STM RB1,RB2,0(R1) PUT REGISTERS BACK INTO CORE 06047280 STM RR1,RR2,0(R2) PUT REGISTERS BACK INTO CORE 06047290 SR R2,R2 RESTORE R2 AS BYTE REGISTER 06047300 B EXFIN RETURN 06047310 .EXLONG3 ANOP 06047320 EJECT 06048000 * RR-RX OVERLAP SECOND-LEVEL PROCESSOR SECTION. * 06050000 SPACE 1 06052000 * BRANCH AND LINK (BALR,BAL) * 06054000 EXBALR MVI EXILC,X'40' SET ILC RIGHT 06056000 LR RB2,RIA NO BRANCH WILL OCCUR-SET UP FOR REST 06058000 BZ EXBAL1 IF R2=0, NO BRANCH WILL OCCUR 06060000 L RB2,ECREGS(RR2) BRANCH DOES OCCUR-LOAD ADDR IN 06062000 B EXBAL1 SKIP CODE TO SET FILC 06064000 EXBAL MVI EXILC,X'80' SET ILC UP RIGHT 06066000 EXBAL1 N RCC,=XL4'3F000000' LEAVE ONLY CC-PM IN REGISTER RCC 06068000 AL RCC,EXILC ADD ILC INTO PSW BEING BUILT 06070000 ALR RIA,RCC NOW HAVE ILC-CC-PM-IA FILEDS 06072000 ST RIA,ECREGS(RR1) PLACE BUILT PSW INTO FAKE REG 06074000 B EXFINB BRANCH TAKEN-RETURN 06076000 SPACE 1 06078000 * BRANCH ON COUNT (BCTR,BCT) * 06080000 EXBCTR BNZ EXBCTR1 IF R2=0,NO BRANCH WILL OCCUR 06082000 L RWK,ECREGS(RR1) OBTAIN VALUE OF REGISTER 06084000 BCTR RWK,0 DECREMENT THE VALUE 06086000 ST RWK,ECREGS(RR1) RESTORE IT TO FAKE REGISTER 06088000 B EXFIN RETURN FOR NEXT INSTRUCTION 06090000 SPACE 1 06092000 EXBCTR1 L RB2,ECREGS(RR2) GET BRANCH ADDRESS IN SAME AS BCT 06094000 EXBCT L RWK,=F'-1' PUT -1 IN 06096000 A RWK,ECREGS(RR1) ADD VALUE IN (DOING BCT) 06098000 ST RWK,ECREGS(RR1) RESTORE DECREMENTED VALUE TO FAKE RG 06100000 BNZ EXFINB IF NOT=0, BRANCH IS TAKEN 06102000 B EXFIN BRANCH FAILED 06104000 SPACE 1 06106000 * BRANCH ON CONDITION (BCR,BC) * 06108000 EXBCR BZ EXFIN IF R2 IS 0, NO BRANCH OCCURS 06110000 L RB2,ECREGS(RR2) BRANCH ADDRESS TO FIT WITH BC 06112000 EXBC SLL RR1,2 GET MASK BACK IN RIGHT SPOT 06114000 SPM RCC SET REAL CC = FAKE CC 06116000 STC RR1,EXQBC+1 STORE INTO MASK FIELD 06118000 EXQBC BC $CHN,EXFINB **MASK STORED IN** 06120000 B EXFIN BRANCH FIALED 06122000 SPACE 1 06124000 * MULTIPLY AND DIVIDE (MR,DR,M,D) * 06126000 EXMRDR LA RB2,ECREGS(RR2) MAKE ADDRESS COMPATIBLE WITH M-D 06128000 EXMD TM ECR1R2,X'10' MAKE SURE R1 IS EVEN SPECIFICATION 06130000 BO EX0C6 SPECIFICATION ERROR-ODD REGISTER 06132000 LA RR1,ECREGS(RR1) OBTAIN ACTUAL ADDRESS OF FAKE R1 06134000 LM R0,R1,0(RR1) OBTAIN 2 FAKE REGISTER VALUES 06136000 MVN EXQMD(1),ECOP MOVE CODE - SAYS M OR D 06138000 EXQMD M $CHN+R0,0(RB2) **CHANGED TO M OR D DURING EXEC***** 06140000 STM R0,R1,0(RR1) RESTORE THE REGISTERS TO THE FAKES 06142000 B EXFIN RETURN FOR NEXT INSTRUCTION 06144000 EJECT 06146000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06148000 * RX SECOND-LEVEL PROCESSOR SECTION. * 06150000 * TO CONDENSE CODE IN RX SECTION, THE CODE BELONGING * 06152000 * TO THE SECTIONS BEGINNING EXLOADS,EXSTORS,EXLA, AND EXFPRX * 06154000 * SHOULD BE EQU'D TO EXNORMRX, AND THE ACTUAL CODE OF THOSE * 06156000 * SECTIONS REMOVED. * 06158000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06160000 SPACE 1 06162000 * RX NORMAL (IC,CH,AH,SH,MH,N,CL,O,X,C,A,S,AL,SL) * 06164000 EXNORMRX L RWK,ECREGS(RR1) OBTAIN 1ST OPERAND 06166000 STC ROP,EXQNORMR STORE OPCODE IN 06168000 SPM RCC SET REAL CC = FAKE CC 06170000 EXQNORMR IC $CHN+RWK,0(RB2) **WILL BE CHANGED TO RIGHT OPCODE*** 06172000 ST RWK,ECREGS(RR1) PLACE RESULT INTO FAKE REGISTER 06174000 BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06176000 SPACE 1 06178000 * EXECUTE -USES SECTION OF PRIMARY DECODING SECTION * 06180000 EXEX LH RWK,0(RB2) QUICK CHECK FOR ALIGNMENT ERROR 06182000 CLI 0(RB2),X'44' MAKE SURE NOT AN EXECUTE 06184000 BE EX0C3 EXECUTE INTERRUPT 06186000 LR RWK,RB2 PUT ADDRESS WHERE EXPECTED 06188000 MVC EXEXLEN(2),EXEXBRNC REPLACE ADD BY BR RLINK 06190000 BAL RLINK,EXFEXENT GO BACK AND DO COMMON SECTION 06192000 SPACE 1 06194000 * THE FOLLOWING EXECUTED AFTER PRIMARY DECODING DONE * 06196000 SR RB2,RMEM DE-RELOCATE INSTR @ 06196500 ST RB2,ECSTIADD STORE INTO INSTR STACK FOR DUMP 06197000 EXEXOR MVC EXEXLEN(2),EXEXLEN2 FIX UP A TO BE ONE AGAIN 06198000 LTR RR1,RR1 CHECK FOR R1 OPERAND BEING USED 06200000 BZ EXPRIME+4(R1) NOTHING TO OR IN-BRANCH 06202000 LA RB2,ECREGS+3(RR1) ADDRESS OF LAST BYTE OF GIVEN REG 06204000 OC ECR1R2,0(RB2) OR BYTE INTO INSTRUCTION 06206000 B EXPRIME+4(R1) TAKE PRIMARY BRANCH 06208000 EXEXLEN2 A RIA,EXILENG(R1) INST TO REPLACE MODIFIED ONE 06210000 ORG *-2 WE ONLY NEED 1ST 2 BYTES OF LAST INS 06212000 EXEXBRNC BR RLINK WILL BE MOVED IN FOR EXECUTE 06214000 SPACE 1 06216000 * RX LOAD OPERATIONS(NO CC SETTING) (LH,CVB,L) * 06218000 EXLOADS STC ROP,EXQLOAD STORE OPCODE IN 06220000 EXQLOAD L $CHN+RWK,0(RB2) ** OPCODE WILL BE MOVED IN ********* 06222000 ST RWK,ECREGS(RR1) PLACE RESULT INTO FAKE REG 06224000 B EXFIN RETURN FOR NEXT INSTRUCTION 06226000 SPACE 1 06228000 * RX STORE OPERATIONS (NO CC SETTING) (STH,CVD,STC,ST) * 06230000 EXSTORS L RWK,ECREGS(RR1) OBTAIN 1ST OPERAND 06232000 STC ROP,EXQSTORS STORE OPCODE INTO INST 06234000 EXQSTORS ST RWK,0(RB2) ** OPCODE WILL BE CHANGED*********** 06236000 AIF (&$S370 NE 2).EXSTORS SKIP IF NOT SIMULATING S/370 06237000 BZ EXFIN IF CHECKING ALIGNMENT, RETURN 06237100 MVC 0(8,RB1),EXDUBLWD PUT ALTERED CORE BACK IN RIGHT PLACE 06237200 .EXSTORS ANOP 06237300 B EXFIN RETURN FOR NEXT INSTRUCTION 06238000 SPACE 1 06240000 * LOAD ADDRESS LA * 06242000 EXLA ST RB2,ECREGS(RR1) PUT RESULT IN DESIRED FAKE REGISTER 06244000 B EXFIN RETURN FOR NEXT INSTRUCTION 06246000 AIF (&$FLOTEX).EXXFPRX SKIP IF WE HAVE EXTENDED FP 06247000 EXXFPRX EQU EX0C1 NOTE INSTRUCTIONS NOT ALLOWED 06247500 AIF (&$FLOTE).EXFPRX GO GEN IF FLOATINGS ALLOWED 06248000 EXFPRX EQU EX0C1 NOTE FLOATINGS NOT ALLOWED 06250000 EXFPRXST EQU EX0C1 NOTE FLOATINGS NOT ALLOWED 06251000 AGO .EXFPRX2 SKIP OVER GENERATION 06252000 .EXXFPRX ANOP 06253000 EXXFPRX EQU * CODE FOR EXTENDED FLOATINGS 06253500 .EXFPRX ANOP 06254000 SPACE 1 06256000 * FLOATING POINT RX INSTRUCTIONS. * 06258000 EXFPRX EQU * ODD REG CHECK DONE WITH SPIE 06260000 STC ROP,EXQFPRX STORE OPCODE IN 06262000 SLL RR1,2 GET R1 FIELD BACK INTO PLACE 06264000 STC RR1,EXQFPRX+1 STORE R1 FIELD INTO INST ALSO 06266000 SPM RCC SET THE CONDITION CODE 06268000 EXQFPRX STD $,0(,RB2) **OPCODE AND R1 FIELDS STORED IN**** 06270000 BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06272000 AIF (&$S370 EQ 2).EXFPRX1 SKIP IF SIMULATING S/370 06272100 EXFPRXST EQU EXFPRX CODE FOR STORES SAME AS OTHERS 06272200 AGO .EXFPRX2 SKIP AROUND CODE GENERATION 06272300 .EXFPRX1 ANOP 06272400 SPACE 2 06272500 * CODE FOR FLOATING POINT STORES WHEN FAKING ALIGNMENT 06272600 EXFPRXST EQU * CODE FOR FLOATING POINT STORES 06272700 STC ROP,EXQFPRXS STORE OPCODE IN 06272800 SLL RR1,2 GET R1 FIELD BACK INTO PLACE 06272900 STC RR1,EXQFPRXS+1 STORE R1 FIELD INTO INST ALSO 06273000 EXQFPRXS STD $,0(,RB2) **OPCODE AND R1 FIELDS STORED IN**** 06273100 BZ EXFIN IF ALIGNMENT CHECKING, RETURN 06273200 MVC 0(8,RB1),EXDUBLWD PUT ALTERED CORE BACK IN RIGHT PLACE 06273300 B EXFIN RETURN 06273400 .EXFPRX2 ANOP 06274000 SPACE 2 06276000 AIF (NOT &$XIOS).EXCONT SKIP IF NO XMACROS 06277500 * XDECO - EXTENDED DECIMAL OUTPUT INSTRUCTION. * 06278000 * SPECIAL RX INSTRUCTION CONVERTS REGISTER VALUE TO EDITED * 06280000 * 12-BYTE DECIMAL FIELD. (X'52' OPCODE). * 06282000 EXXDECO L R0,ECREGS(RR1) GET VALUE OF THE REGISTER 06284000 XDECO R0,0(RB2) CONVERT THE VALUE 06286000 B EXFIN GO FOR NEXT INSTRUCTION 06288000 SPACE 1 06308000 * XDECI - EXTENDED DECIMAL INPUT INSTRUCTION. * 06310000 * SPECIAL INPUT CONVERTER, SCANS 1-9 DIGIT, SIGNED/UNSIGNED * 06312000 * DECIMAL NUMBERS WITH ANY # PRECEDING BLANKS. SETS CC TO 0,1,2* 06314000 * ACCORDING TO VALUE OF RESULT. CC=3 IF >9 DIGITS, OR 1ST * 06316000 * CHARACTER NOT +, -, DIGIT, OR + OR - WITHOUT DIGIT FOLLOWING.* 06318000 * OPCODE IS HEX '53' (RX FORMAT). * 06320000 EXXDECI XDECI R0,0(RB2) CONVERT AND SCAN VALUE 06320100 BALR RCC,0 SAVE THE CC 06320200 BO *+8 SKIP STORE IF VALUE WAS BAD 06320300 ST R0,ECREGS(RR1) SAVE THE CONVERTED VALUE IF OK 06320400 SR R1,RMEM DE-RELOCATE THE SCAN PTR VALUE 06320500 ST R1,ECREG1 SAVE SCAN PTR IN USER REG 1 06320600 B EXFIN GO BACK FOR NEXT INSTR 06320700 SPACE 1 06322000 AIF (NOT &$HEXI).EXNOHXI SKIP OF NO XHEXI 06350200 * XHEXI-EXTENDED HEXADECIMAL INPUT INSTRUCTION * 06350300 * SPECIAL INPUT MACRO, SCANS 1-8 DIGITS. SKIPS LEADING * 06350400 * BLANKS. SETS CONDITION CODE TO 3 IF ILLEGAL HEX CHARACTER * 06350500 * FOUND. IF GREATER THAN 8 DIGITS FOUND R1 POINTS TO 9TH ELSE * 06350600 * R1 POINTS TO FIRST NON-HEX CHARACTER IN STRING * 06350700 * (X'61' OPCODE) * 06350800 EXXHEXI XHEXI R0,0(RB2) CONVERT AND SCAN VALUE 06350900 BALR RCC,0 SAVE THE CC 06351000 BO *+8 SKIP STORE IF VALUE WAS BAD 06351100 ST R0,ECREGS(RR1) STORE CONVERTED VALUE IF OK 06351200 SR R1,RMEM DE-RELOCATE SCAN POINTER VALUE 06351300 ST R1,ECREG1 SAVE SCAN POINTER IN USER R1 06351400 B EXFIN GO FOR NEXT INSTRUCTION 06351500 AGO .EXCKHXO CHECK IF XHEXO ALLOWED 06351600 .EXNOHXI ANOP 06351700 EXXHEXI EQU EX0C1 INVALID OP-CODE 06351800 .EXCKHXO AIF (NOT &$HEXO).EXNOHXO SKIP IF NOT XHEXO ALLOWED 06351900 * XHEXO-EXTENDED HEXADECIMAL OUTPUT MACRO * 06352000 * SPECIAL RX INSTRUCTION CONVERTS REGISTER VALUE TO OUTPUT * 06352100 * 8 BYTE FORM. (X'62' OPCODE). * 06352200 EXXHEXO L R0,ECREGS(RR1) GET VALUE OF THE REGISYER 06352300 XHEXO R0,0(RB2) CONVERT VALUE 06352400 B EXFIN GET NEXT INSTRUCTION 06352500 AGO .EXCONT 06352600 .EXNOHXO ANOP 06352700 EXXHEXO EQU EX0C1 INVALID OP CODE 06352800 .EXCONT ANOP 06352900 EJECT 06400000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06402000 * SI SECOND-LEVEL PROCESSOR SECTION * 06404000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06406000 SPACE 1 06408000 * ALL NORMAL SI'S - OP D(B),I2 * 06410000 EXSI BAL RLINK,EXRANGE CHECK ADDRESS FOR IN RANGE 06412000 AR RB2,RMEM RELOCATE TO REAL @ 06414000 MVC EXQSI(2),ECOP MOVE OPCODE AND I2 FIELD IN 06416000 SPM RCC SET REAL CON-CODE= FAKE ONE 06418000 EXQSI TM 0(RB2),$CHN ** OP AND I2 WILL BE MOVED IN******* 06420000 BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06422000 SPACE 1 06424000 AIF (&$DEBUG).EXDIAG1 SKIP IF NOT DEBUG MODE 06426000 * DIAG-PSEUDO SI INSTRUCTION USED FOR DEBUGGING PURPOSES * 06428000 EXDIAG MVC ECFLAG2,ECI2 SUPPLY CONTROL FLAG TO BYTE 06430000 B EXFIN GO BACK FOR NEXT INSTRUCTION 06432000 .EXDIAG1 ANOP 06434000 SPACE 1 06436000 AIF (&$P370).EXLCTL SKIP IF PRIVILEGED 370'S ALLOWED 06436100 EXLCTL EQU EX0C2 NO PRIVILEGED 370 OPS ALLOWED 06436200 EXSTCTL EQU EX0C2 NO PRIVILEGED 370 OPS ALLOWED 06436300 EXP370 EQU EX0C2 NO PRIVILEGED 370 OPS ALLOWED 06436400 AGO .EXNP370 SKIP OVER CODE GENERATION 06436500 .EXLCTL ANOP 06436600 EXLCTL BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06436700 EXSTCTL BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06436800 EXP370 BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06436900 .EXNP370 ANOP 06437000 AIF (&$PRIVOP).EXSIO GENERATE CODE,IF PRIVILEGEDS EXIST 06438000 EXSIO EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06440000 EXTIO EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06442000 EXHIO EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06444000 EXSSM EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06446000 EXTCH EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06448000 EXLPSW EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06450000 EXWRD EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06452000 EXRDD EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06454000 AGO .EXNOPRV SKIP OVER CODE GENERATION 06456000 .EXSIO ANOP 06458000 EXSIO BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06460000 EXTIO BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06462000 EXHIO BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06464000 EXTCH BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06466000 EXSSM BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06468000 EXLPSW BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06470000 EXWRD BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06472000 EXRDD BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06474000 .EXNOPRV ANOP 06476000 AIF (&$REPL GT 0).EXNREP0 SKIP IF REPL OPTION ALLOWED 06476090 EXXREPL EQU EX0C1 NO REPLACEMENT: MAKE ILLEGAL OP 06476095 .EXNREP0 AIF (&$REPL EQ 0).EXNREPL SKIP IF NO REPLACEMENT 06476100 SPACE 2 06476150 EXXREPL EQU * CODE FOR XREPL COMMAND -REPLACE 06476200 BAL RLINK,EXRANGE HAVE @ CHECKED FOR RANGE 06476250 AR RB2,RMEM RELOCATE TO REAL @ 06476300 SPACE 1 06476350 CLI ECI2,0 WAS IT SET RFLAG TYPE XREPL 06476400 BH EXXREPL1 NO, SKIP TO NEXT TYPE 06476450 MVC ECRFLAG,0(RB2) SET RFLAG FROM USER LOCATION 06476500 B EXFIN GO FOR NEXT INSTR 06476550 SPACE 1 06476600 EXXREPL1 CLI ECI2,1 WAS IT FETCH RFLAG TYPE 06476650 BH EXXREPL2 NO, SKIP TO NEXT TYPE 06476700 MVC 0(L'ECRFLAG,RB2),ECRFLAG FETCH THE FLAG TO USER AREA 06476750 B EXFIN GO FOR NEXT INSTR 06476800 SPACE 1 06476850 EXXREPL2 CLI ECI2,2 WAS IT INSTRUCTION COUNT 06476900 BH EXXREPL3 NO, GO ON TO NEXT 06476950 MVC 0(4,RB2),ECILIMT MOVE TEMPORARY INSTRUCTION COUNT OVE 06477000 B EXFIN GO FOR NEXT INSR 06477050 EXXREPL3 EQU EXFIN ILLEGAL I2 FIELD, IGNORE. 06477100 .EXNREPL ANOP 06477150 EJECT 06478000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06480000 * RS SECOND-LEVEL PROCESSOR SECTION. * 06482000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06484000 SPACE 1 06486000 * BRANCH ON INDEX (BXH,BXLE) * 06488000 EXRSBX BAL RLINK,EXR1R2 GO DECODE R1-R3 FIELDS 06490000 L R0,ECREGS(RR3) OBTAIN REGISTER SPECIFIED BY R3 FLD 06492000 L R1,ECREGS+4(RR3) GET NEXT REGISTER BEYOND 06494000 TM ECR1R3,X'1' WAS REGISTER ODD 06496000 BZ *+6 IF EVEN REG,SET UP OK,SKIP NEXT INST 06498000 LR R1,R0 R3 WAS ODD-SO USE SAME VALUE 06500000 STC ROP,EXQRSBX STORE OPCODE INTO INSTRUCTION 06502000 L RWK,ECREGS(RR1) OBTAIN R1 FIELD VALUE 06504000 EXQRSBX BXH $CHN+RWK,R0,EXRSBX1 ** CHANGED TO EITHER BXH-BXLE******* 06506000 ST RWK,ECREGS(RR1) BRANCH FAILED-BUT STORE REG BACK 06508000 B EXFIN RETURN FOR NEXT INSTRUCTION 06510000 EXRSBX1 ST RWK,ECREGS(RR1) RESTORE UPDATED REGISTER 06512000 B EXFINB GO TO FINISH-SUCC BRANCH 06514000 SPACE 1 06516000 * LOAD/STORE MULTIPLE (LM,STM) *CODE MAY NOT BE OBVIOUS* * 06518000 EXLMSTM BAL RLINK,EXR1R2 GET R1 AND R3 FIELDS 06520000 AIF (&$S370 NE 2).EXLMSTM SKIP IF NOT SIMULATING S/370 06520100 TM ECFLAG4,AJONALGN SHOULD ALIGNMENT BE CHECKED 06520200 BO *+8 NO - BRANCH AROUND CHECK 06520300 .EXLMSTM ANOP 06520400 L R0,0(RB2,RMEM) QUICK CHECK FOR FULLWORD ALIGNMENT 06522000 LA R1,4(RR3) OBTAIN 1 PART OF LENGTH VALUE 06524000 CR RR1,RR3 IS R1 FIELD <= R3 FIELD 06526000 BNH EXLMSTM1 SKIP OVER IF EASY CASE(R1MOVE TO DO NR 06618660 BZ 6(,RWK) IF 0, WE ARE ALL DONE, RETURN 06618670 EX 0,0(,RWK) PERFORM SUPPLIED OPERATION 06618680 LA RB2,1(,RB2) INCREMENT CORE AREA POINTER 06618690 EXMSKC EQU *+1 POSITION OF MASK CHANGED BY CLM 06618700 BC $+15,EXMSK1 USUALLY BRANCH TO LOOP (BE FOR CLM) 06618710 B 6(,RWK) IF UNEQUAL COMPARE FOR CLM, RETURN 06618720 .EXMASK3 ANOP 06618730 EJECT 06620000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06622000 * SS SECOND-LEVEL PROCESSOR SECTION. * 06624000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06636000 SPACE 1 06638000 * MOVES,TR,PACK - CHANGE NEITHER CC NOR REGISTERS. * 06640000 EXMOVS DS 0H LOCATION FOR MOVES,ETC 06642000 EXQSS MVN 0($CHN,RB1),0(RB2) **OPCODE AND LENGTH MOVED IN ** 06644000 B EXFIN RETURN FOR NEXT INSTRUCTION 06646000 SPACE 1 06648000 * LOGICALS AND DECIMALS - MAY CHANGE CC,BUT NOT REGS * 06650000 EXLOGS SPM RCC SET REAL CC = FAKE ONE 06652000 EXDECS EQU EXLOGS SAME AS LOGS IF DECIMAL FEATURE IN 06654000 EX 0,EXQSS EXECUTE PREPARED INST 06656000 BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06658000 SPACE 1 06660000 * TRT AND EDMK -CHANGE CC,POSSIBLY REGISTERS 1&2 * 06662000 EXTRT LM R1,R2,ECREG1 GET FAKE R1,R2 06664000 EXEDMK EQU EXTRT SAME AS TRT,IF DECIMAL FEATURE USED 06666000 LA R1,0(R1) CLEAR UPPER BYTE FOR SAFETY 06668000 ALR R1,RMEM RELOCATE TO REAL @, IN CASE CHANGED 06670000 EX 0,EXQSS EXECUTE PREPARED INSTRUCTION 06672000 BALR RCC,0 PICK UP CHANGED CONDITION CODE 06674000 SLR R1,RMEM CONVERT BACK TO FAKE @ 06676000 XC ECREG1+1(3),ECREG1+1 CLEAR 3 BYTES OF FAKE R1 06678000 O R1,ECREG1 GET FAKE R1 BACK TOGETHER 06680000 STM R1,R2,ECREG1 REPLACE FAKE REGS R1 AND R2 06682000 SR R2,R2 CLEAR FOR BYTE REGISTER AGAIN 06684000 B EXFIN GO FOR NEXT INSTRUCTION 06686000 AIF (&$S370 NE 0).EXSRP1 SKIP IF WE HAVE S/370'S 06686010 SPACE 2 06686020 EXSRP EQU EX0C1 NOTE SRP NOT ALLOWED 06686030 AGO .EXSRP3 SKIP OVER CODE GENERATION 06686040 .EXSRP1 SPACE 2 06686050 * CODE FOR SRP (SHIFT AND ROUND PACKED) S/370 COMMAND 06686060 EXSRP EQU * CODE FOR SRP 06686070 SR RB2,RMEM REMOVE RE-LOCATION DONE EARLIER 06686080 AIF (&$S370 NE 1).EXSRP2 SKIP IF WE DO NOT HAVE 370 HARDWARE 06686090 B EXDECS REST OF CODE SAME AS ALL DECIMALS 06686100 .EXSRP2 AIF (&$S370 NE 2).EXSRP3 SKIP IF NOT SIMULATING S/370'S 06686110 IC RR1,ECL1I3 GET LENGTH AND IMMEDIATE 06686120 N RR1,EXSRPMK REMOVE IMMEDIATE FIELD 06686130 LR RR2,RR1 COPY (LENGTH OF FIELD) * 4 06686140 SRL RR1,4 GET LENGTH 06686150 OR RR2,RR1 SET UP REG WITH 2 LENGTHS 06686160 SPACE 06686170 MVO EXSRPDA1(1),ECL1I3(1) MOVE IMMEDIATE OVER 06686180 ZAP EXSRPDA1(1),EXSRPDA1(1) CHECK IMMEDIATE 06686190 EX RR1,EXSRPZP1 CHECK USERS NUMBER 06686200 BZ EXSRPLF5 IF NUMBER = 0, WERE DONE 06686210 SPACE 06686220 SLL RB2,26 EXTEND BIT 26 AS IF 06686230 SRA RB2,26 IT IS A SIGN BIT 06686240 BZ EXSRPLF3 IF SHIFT IS ZERO, WERE DONE 06686250 BP EXSRPLF IF SHIFT IS POSITIVE,IT'S LEFT SHIFT 06686260 SPACE 2 06686270 EXSRPRT LPR RB2,RB2 MUST BE RIGHT SHIFT, GET + SHIFT 06686280 B EXSRPRT2 BRANCH INTO LOOP 06686290 EXSRPRT1 MVO EXSRPDA2(16),EXSRPDA2(15) SHIFT ALL BUT LAST NIBBLE 06686300 EXSRPRT2 BCT RB2,EXSRPRT1 DECREMENT COUNT AND BRANCH 06686310 SLL RR1,4 SHIFT LENGTH TO L1 FIELD 06686320 MVN EXSRPDA2+15(1),EXSRPDA1 MAKE SIGN POSITIVE 06686330 AP EXSRPDA2(16),EXSRPDA1(1) ADD IN ROUNDING FACTOR 06686340 EX RR1,EXSRPMV1 MOVE TO USER, DOING LAST SHIFT 06686350 B EXSRPLF3 GO TO SET COND CODE AND RETURN 06686360 SPACE 2 06686370 EXSRPLF LA RWK,0(RR1,RB1) GET @ LAST BYTE OF USER NUMBER 06686380 STC RR2,EXSRPLF2+1 PUT LENGTH INTO MVO INSTR 06686390 OI *+1,0 SET COND CODE TO ZERO 06686400 EXSRPLF1 BNZ EXSRPLF2 HAS OVRFLOW OCCURRED? BRANCH IF SO 06686410 TM 0(RB1),X'F0' CHECK FIRST NIBBLE FOR NON-ZERO 06686420 EXSRPLF2 MVO 0($CHN,RB1),0($CHN,RB1) SHIFT LEFT (LENGTHS STORED IN) 06686430 MVZ 0(1,RWK),=PL1'0' MOVE ZERO TO PROPAGATED SIGN 06686440 BCT RB2,EXSRPLF1 DECREMENT COUNT AND BRANCH 06686450 BNZ EXSRPLF4 OVERFLOW SO BRANCH TO CHECK FOR 0CA 06686460 EXSRPLF3 EX RR2,EXSRPZP2 SET COND CODE FOR +, -, OR 0 06686470 BAL RCC,EXFIN CAPTURE COND CODE AND RETURN 06686480 EXSRPLF4 TM ECSTCCPM,X'04' CHECK MASK BIT 06686490 BO EX0CA OVERFLOW HAS OCCURED--> ERROR 06686500 TM *+1,1 SET COND CODE TO OVRFLOW 06686510 EXSRPLF5 BAL RCC,EXFIN CAPTURE COND CODE AND RETURN 06686520 SPACE 06686530 EXSRPZP1 ZAP EXSRPDA2(16),0($CHN,RB1) CHECK AND MOVE USER NUMBER 06686540 EXSRPZP2 ZAP 0($CHN,RB1),0($CHN,RB1) SET COND CODE TO +, -, OR 0 06686550 EXSRPMV1 MVO 0($CHN,RB1),EXSRPDA2(15) MOVE BACK TO USERS AREA 06686560 .EXSRP3 ANOP 06686570 EJECT 06688000 AIF (&$XIOS).EXXIOS SKIP TO GENERATE CODE IF EXISTS 06690000 EXXIOS EQU EX0C1 THESE INSTRUCTIONS DO NOT EXIST 06692000 AGO .EXNOXIO 06694000 .EXXIOS ANOP 06696000 SPACE 1 06698000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06699000 * PSEUDO RX-SS EXTENDED MNEMONICS-XREAD,XPRNT,XPNCH I/O'S * 06700000 * PSEUDO DUMP ROUTINE - XDUMP * 06702000 * **NOTE** BECAUSE OF NO-STANDARD ADDRESSING DONE BY THESE * 06703000 * INSTRUCTIONS, THEY DO THEIR OWN ADDRESS CHECKING, AND THUS * 06703100 * HAVE A PROTECTION BYTE OF X'00' SO THE INITIAL SS SECTION * 06703200 * DOESN'T STOP THEM. THEY THEN FAKE THE PROTECTION BYTES OF * 06703400 * EITHER STM(X'C0' -XREAD), OR TM(X'80' - XPRNT,XDUMP,XPNCH). * 06703500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06703750 EXXIOS EQU * SECTION FOR X-MACRO I/O INSTRUCTIONS 06704000 N RCC,=XL4'3F000000' REMOVE ALL BUT CC-PM BITS 06706000 ALR RCC,RIA PUT CC-PM-PROG ADDRESS TOGETHER 06708000 ST RCC,ECILCMSK STORE RESULTING PSW 06710000 OI ECILCMSK,X'C0' SET ILC=3, FOR LENGTH OF X-INST 06712000 CLI ECOP,X'E1' SEE IF IT WAS REGS TYPE XDUMP 06714000 BE EXXDUMPR YES,SO GO DUMP REGS ONLY 06716000 SR RB2,RMEM REMOVE SPURIOUS RELOCATION 06718000 EXXLOK BAL RLINK,EXR1R2 GET MASK AND INDEX VALUE 06724000 BZ EXXNOX2 SKIP IF NO INDEX REG USED 06726000 AL RB1,ECREGS(RX2) ADD INDEX VALUE TO ADDRESS 06728000 LA RB1,0(RB1) CHOP OFF 1ST BYTE 06730000 EXXNOX2 EQU * 06732000 LR RR2,RB2 SAVE THE LENGTH TO BE DONE 06734000 LR RB2,RB1 LOAD ADDRESS OVER FOR RANGECHK 06736000 SR RB2,RMEM GET CHECKABLE RANGE 06738000 LA ROP,X'98' FAKE PROTECT LIKE LM INSTRC A 06739000 BAL RLINK,EXRANGE HAVE ADDRESS-LENGTH CHECKED 06740000 SRL RR1,3 GET MASK VALUE IN PLACE FOR INDEX 06742000 ALR RR1,RR1 SHIFT LEFT FOR MULT OF TWO 06743000 LH R1,EXXIOJ(RR1) GET ADDRESS VALUE 06744000 B EXJUMP(R1) GO TO RIGHT SECTION OF CODE 06747000 AIF (NOT &$JRM).EXNOJRM SKIP IF NO JRM SPECIAL CODE 06748050 ORG *-4 ORG BACK OVER B EX0C1 INSTR 06748100 TM ECFLAG3,$EC$JRM WAS SPECIAL JRM DEBUG FLAG SET 06748150 BZ EX0C1 NO, MUST HAVE BEEN REAL ERROR 06748200 SPACE 1 06748250 * SPECIAL DEBUG CODE ENTERED ONLY WHEN JRM SUBMITS JOB 06748300 * WITH CORRECT NAME/ACCT NUMBER, MODIFIES XREAD TO HAVE 06748350 * MASK FIELD TOO LARGE FOR NORMAL CORRECTNESS. 06748400 * IT CAUSES THE USER PROGRAM TO BE CALLED DIRECTLY: 06748450 * R1 = ADDRESS OF SPECIAL ADDRESS LIST: A(ASSIST,ASJOBCON,VWXTABL) 06748500 * R6(REC) = @ ECONTROL BLOCK, MAY NOT BE CHANGED BY USER PROGRAM. 06748550 * R14,R15 NORMAL OS/360 CONVENTIONS 06748600 LR RWK,RB1 MOVE ADDR OVER WHERE HE EXPECTS 06748650 LA R1,=A(ASSIST,ASJOBCON,VWXTABL) USEFUL @'S 06748700 B EXCALL GO TO GENERAL CALL ROUTINE 06748750 .EXNOJRM ANOP 06748800 SPACE 1 06758000 * XREAD PSEUDO-INSTRUCTION - READ A CARD. * 06759000 EXXREAD TM ECFLAG0,$ECEOF HAS THERE BEEN EOF ALREADY 06760000 BO EXXREOF YES, USER TRYING TO GO PAST 06762000 LA ROP,X'90' FOR PROTECT CHECK 06762500 BAL RLINK,EXRANGE HAVE ADDRESS-LENGTH CHECKED 06763000 $READ 0(RB1),(RR2),EXXREOFA 06764000 BAL RCC,EXXIEND GO TO FINISH UP 06766000 EXXREOFA OI ECFLAG0,$ECEOF FLAG END OF FILE 06768000 BAL RCC,EXXIEND GO TO END UP 06770000 SPACE 1 06772000 EXXREOF MVI ECFLAG1,$ECREADR SHOW READ BEYOND END-OF-FILE ERROR 06774000 LA R1,EXCCREAD SHOW END-FILE 06776000 B EXITIA GO TO EXIT ROUTINE 06778000 SPACE 1 06780000 * XPRNT PSEUDO-INSTRUCTION- PRINT A LINE. * 06781000 EXXPRNT $PRNT 0(RB1),(RR2),EXXRECEX 06782000 B EXXIEND 06784000 SPACE 1 06786000 * XPNCH PSEUDO-INSTRUCTION - PUNCH A CARD. * 06787000 EXXPNCH $PNCH 0(RB1),(RR2),EXXRECEX 06788000 B EXXIEND DO COMMON EXIT 06790000 AIF (&$XXIOS).EXXIOS1 SKIP IF NOT ALLOWED XGET-XPUT 06790500 EXXGET EQU * XGET PSEUDO INSTRUCTION - DO INPUT 06790600 LA ROP,X'90' FOR PROTECT CHECK 06790620 BAL RLINK,EXRANGE HAVE ADDRESS-LENGTH CHECKED 06790640 $GET 0(RB1),(RR2) 06790700 BAL RCC,EXXIEND GO TO FINISH UP 06790800 EXXPUT EQU * XPUT PSEUDO INSTRUCTION - DO OUTPUT 06790900 $PUT 0(RB1),(RR2) 06791000 BAL RCC,EXXIEND GO TO FINISH UP 06791100 AGO .EXXIOS2 SKIP LABEL SAVING 06791200 .EXXIOS1 ANOP SAVE LABELS 06791300 EXXGET EQU * 06791400 EXXPUT EQU * 06791500 .EXXIOS2 ANOP 06791600 EXXIEND EQU EXFIN COMMON EXIT-SAME AS EXFIN 06792000 SPACE 1 06792500 EXXRECHK CLI ECFLAG1,$ECRECEX DID XXXXSNAP SET FLAG 06793000 BNE EXFIN NO, SO DON'T BOMB USER OUT 06793500 EXXRECEX MVI ECFLAG1,$ECRECEX RECORDS EXCEEDED 06794000 LA R1,EXCCRECE SHOW RECORDS EXCEEDED MESSAGE 06796000 B EXITIA GO FINISH UP AND RETURN 06798000 SPACE 1 06800000 * XDUMP PSEUDO-INSTRUCTION - DUMP STORAGE OR REGISTERS. * 06801000 EXXDUMP EQU * ENTRY LABEL FOR STORAGE XDUMP 06802000 LR RB2,RB1 MOVE BEGINNING @, SINCE RB1=R10 06811000 LR R10,REC MOVE ECONTROL PTR OVER FOR XXXXSNAP 06812000 XSNAP T=(NO,,1),LABEL='USER STORAGE', X06814000 STORAGE=(*0(RB2),*0(RR2,RB2)) 06816000 B EXXRECHK GO CHECK FOR RECORD OVERFLOW 06818000 SPACE 1 06820000 EXXDUMPR LR R10,REC MOVE ECONTROL PTR OVER FOR XXXXSNAP 06822000 XSNAP T=(PR,,1),LABEL='USER REGISTERS' 06824000 B EXXRECHK GO CHECK FOR RECORD OVERFLOW 06826000 SPACE 1 06826050 * XLIMD PSUEDO INSTRUCTION - LIMIT DUMP AREA. * 06826100 EXXLIMD LA RB2,0(RR2,RB1) GET 2ND LIMIT, REAL @ OF IT 06826150 BCT RR2,*+8 IF RR2=1(OMITTED) USE END OF PROG 06826200 L RB2,ECRADH LENGTH=1, USE HIGHEST @ INSTEAD 06826250 STM RB1,RB2,ECRDLIML ECRDLIML-ECRDLIMH - NEW LIMTS 06826300 B EXFIN GO FOR NEXT INSTRUCTION 06826350 SPACE 1 06826400 EXXIOJ $AL2 EXJUMP,(EXXREAD,EXXPRNT,EXXPNCH,EXXDUMP,EXXLIMD,EXXGET,EX06828000 XXPUT,EX0C1) 06829000 .EXNOXIO ANOP 06832000 EJECT 06834000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06836000 * UTILITY (3RD LEVEL) DECODING,ADDRESS ADDING,AND CHECKING * 06838000 * ROUTINES. THESE ARE CALLED BY THE 1ST AND 2ND LEVEL PROCESSORS * 06840000 * THESE ROUTINE ARE ONLY USED DURING ACTUAL INTERPRETATION. * 06842000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06844000 SPACE 2 06846000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06848000 * *** ADDRESS ADDER *** OBTAINS BASE-DISPLACEMENT,DECODES,AND * 06850000 * RETURNS PROGRAM RELATIVE ADDRESS IN RB2. USES RW. * 06852000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06854000 EXABD LH RB2,ECBD OBTAIN 1ST BASE-DISPLACEMENT 06856000 EXABD1 LR RWK,RB2 DUPLICATE B-D OVER 06858000 N RB2,=XL4'FFF' REMOVE BASE,LEAVING DISPLACEMENT 06860000 N RWK,=XL4'F000' REMOVE DISPLACEMENT,LEAVE BASE 06862000 BCR Z,RLINK IF NO BASE-DONE,RETURN TO CALLER 06864000 SRL RWK,10 SHIFT TO GET BASE*4 FOR INDEX 06866000 AL RB2,ECREGS(RWK) ADD VALUE FROM RIGHT FAKE REGISTER 06868000 LA RB2,0(RB2) CHOP OFF FRONT BYTE 06870000 BR RLINK RETURN TO CALLER 06872000 SPACE 2 06874000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06876000 * *** DOUBLE REGISTER DECODER - PLACES R1 AND (R2-X2-R3) * 06878000 * FIELDS MULTIPLIED BY 4 INTO REGS RR1 AND RR2 RESPECTIVELY. * 06880000 * THE CONDITON CODE IS SET ACCORDING TO PRESENCE OF NON-ZERO * 06882000 * SECOND REGISTER FIELD * 06884000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06886000 SPACE 1 06888000 EXR1R2 IC RR1,ECR1R2 OBTAIN 2ND BYTE OF INST 06890000 LR RR2,RR1 DUPLICATE VALUE TO OTHER REG 06892000 N RR1,=XL4'F0' REMOVE 2ND REG,LEAVING 1ST ONLY 06894000 SRL RR1,2 GET R1 FIELD*4,FOR INDEXING USE 06896000 SLL RR2,2 PREPARE R2-X2-R3 FIELD FOR INDEX 06898000 N RR2,=XL4'3C' REMOVE EXTRA BITS,SET CCODE 06900000 BR RLINK RETURN TO CALLER 06902000 EJECT 06904000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06906000 * *** RANGE CHECKING ROUTINE - CHECKS THE ADDRESS PROVIDED IN * 06908000 * RB2 FOR BEING WITHIN THE ALLOWABLE RANGE. THE METHOD USED * 06910000 * DEPENDS ON THE FACT THAT AN EXTRA 256 BYTES OF CORE WAS * 06912000 * ALLOCATED AT THE END OF THE USER PROGRAM,SO THAT THERE IS * 06914000 * NO NEED TO CHECK USING THE LENGTH OF CODE AFFECTED BY THE * 06916000 * INSTRUCTION. THIS ROUTINE USES REGISTER RWK. * 06918000 * ENTRY CONDITIONS * 06920000 * RB2= PROGRAM ADDRESS TO BE CHECKED FOR RANGE (ECFADL<=@ OPERATION 06976000 EJECT 06978000 SPACE 4 07064000 * * * * * SECONDARY TYPE INDEX BRANCH ADDRESS TABLES * * * * * * * * * 07066000 SPACE 1 07068000 EXSECRR $AL2 EXJUMP,(EX0C1,EXSPM,EXBALR,EXBCTR,EXBCR,EXSSK,EXISK,EXSV#07070000 C,EXLPNTR,EXNORMRR,EXLR,EXMRDR,EXFPRR,EXXFPRR,EXLONG) 07072000 EXSECRX $AL2 EXJUMP,(EX0C1,EXLA,EXBAL,EXBCT,EXBC,EXNORMRX,EXMD,EXLOAD#07074000 S,EXSTORS,EXFPRX,EXFPRXST,EXXFPRX,EXEX,EXXDECI,EXXDECO,E#07075000 XXHEXI,EXXHEXO) 07076000 EXSECSI $AL2 EXJUMP,(EX0C1,EXSSM,EXLPSW,EXWRD,EXRDD,EXRSBX,EXLMSTM,EX#07078000 SHIFS,EXSHIFD,EXSI,EXSIO,EXTIO,EXHIO,EXTCH,EXCLM,EXSTCM,#07079000 EXICM,EXLCTL,EXSTCTL,EXP370,EXXREPL) 07080000 EXSECSS $AL2 EXJUMP,(EX0C1,EXMOVS,EXLOGS,EXTRT,EXEDMK,EXDECS,EXXIOS,E#07082000 XSRP) 07083000 SPACE 1 07084000 * OFFSETS TO COMPLETION CODE MESSAGES * 07086000 EXCOFFS $AL2 EXCC0,(EXCC1,EXCC2,EXCC3,EXCC4,EXCC5,EXCC6,EXCC7,EXCC8,E#07088000 XCC9,EXCCA,EXCCB),-2 STANDARD INTERRRUPT PTRS 07090000 AIF (NOT &$FLOTE).EXFL6 SKIP IF NO FLOATING INERRUPTS 07090500 $AL2 EXCC0,(EXCCC,EXCCD,EXCCE,EXCCF) FLOATING INTERRUPTS 07091000 .EXFL6 ANOP 07091500 EXCC0 EQU * BASE @ FOR COMPLETION MESSAGES 07092000 EXCC1 $ERCGN 0C1,'OPERATION' 07094000 EXCC2 $ERCGN 0C2,'PRIVILEGED OPERATION' 07096000 EXCC3 $ERCGN 0C3,'EXECUTE' 07098000 EXCC4 $ERCGN 0C4,'PROTECTION' 07100000 EXCC5 $ERCGN 0C5,'ADDRESSING' 07102000 EXCC6 $ERCGN 0C6,'SPECIFICATION' 07104000 EXCC7 $ERCGN 0C7,'DATA' 07106000 EXCC8 $ERCGN 0C8,'FIXED-POINT OVERFLOW' 07108000 EXCC9 $ERCGN 0C9,'FIXED-POINT DIVIDE' 07110000 EXCCA $ERCGN 0CA,'DECIMAL OVERFLOW' 07112000 EXCCB $ERCGN 0CB,'DECIMAL DIVIDE' 07114000 AIF (NOT &$FLOTE).EXFL8 SKIP MESSAGES FOR FLOATING POINT 07115000 EXCCC $ERCGN 0CC,'EXPONENT OVERFLOW' 07116000 EXCCD $ERCGN 0CD,'EXPONENT UNDERFLOW' 07118000 EXCCE $ERCGN 0CE,'SIGNIFICANCE' 07120000 EXCCF $ERCGN 0CF,'FLOATING-POINT DIVIDE' 07122000 .EXFL8 ANOP 07122500 SPACE 1 07124000 EXCCREAD $ERCGN 220,'ATTEMPTED READ PAST END-FILE',TYPE=ASSIST 07126000 EXCCTIME $ERCGN 221,'INSTRUCTION LIMIT EXCEEDED',TYPE=ASSIST 07128000 EXCCRECE $ERCGN 222,'RECORD LIMIT EXCEEDED',TYPE=ASSIST 07130000 AIF (&$TIMER EQ 0).EXNOTOC SKIP IF NO TIMER AT ALL 07131000 EXCCTIMB $ERCGN 223,'TIME LIMIT EXCEEDED',TYPE=ASSIST 07132000 .EXNOTOC ANOP 07133000 EXCCBROU $ERCGN 224,'BRANCH OUT OF PROGRAM AREA',TYPE=ASSIST 07134000 SPACE 1 07136000 AIF (&$S370 NE 2).EXDUBLW SKIP IF NOT SIMULATING S/370 07136100 EXDUBLWD DC D'0' DOUBLE-WORD FOR ALIGNING OPERANDS 07136200 EXSRPMK DC XL4'F0' MASK TO REMOVE IMMEDIATE FIELD 07136300 EXALIGN DC H'22' # OF HIGH RX INST NEEDING ALIGNMENT 07136400 EXSRPDA1 DC PL1'0' AREA FOR ROUNDING FACTOR 07136500 EXSRPDA2 DS PL16'0' AREA FOR SHIFTING USER NUMBER 07136600 .EXDUBLW AIF (&$S370 EQ 0).EXLONGK SKIP IF WE DON'T HAVE S/370'S 07136700 EXLONGMK DC 0F'0',XL4'FFFFFF' MASK FOR ZAPPING UPPER BYTES OF REGS 07136800 .EXLONGK ANOP 07136900 EXILENG DC F'2,4,4,6' INSTRUCTION LENGTHS 07138000 EXILC DC F'0' USED BY BAL AND BALR TO HOLD ILC 07140000 EXNORNG DC H'8' # OF HIGH RX INST WITH NO RANGECK 07142000 LTORG 07148000 EJECT 07149000 DS 0D ALIGN FOR DUMP READING EASE 07149010 * * * * * TABLE OF SECONDARY BRANCH INDEX VALUES * 07149020 * TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 07149030 EXOPTAB1 DC X'00000000020406080A0C0E0000001C1C' 0 07149040 DC X'10101010121212121412121216161212' 1 07149050 DC X'18181818181A1A1A1818181818181818' 2 07149060 DC X'18181818181A1A1A1818181818181818' 3 07149070 DC X'1002100A180406080E0A0A0A0A00100E' 4 07149080 DC X'10001C1A0A0A0A0A0E0A0A0A0C0C0A0A' 5 07149090 DC X'141E2000000000161212121212121212' 6 07149100 DC X'14000000000000001212121212121212' 7 07149110 DC X'0200040006080A0A0E0E0E0E10101010' 8 07149120 DC X'0C121212121212120C0000001416181A' 9 07149130 DC X'28000000000000000000000000000000' A 28-XREPL 07149140 DC X'002600000000242200000000001C1E20' B 07149150 DC X'00000000000000000000000000000000' C 07149160 DC X'00020202040404040000000002060A08' D 07149170 DC X'0C0C0000000000000000000000000000' E 07149180 DC X'0E0A0202000000000A0A0A0A0A0A0000' F 07149190 SPACE 1 07149200 * * * * * TABLE USED BY RANGE CHECKING ROUTINE FOR RX,SI,RS, AND SS * 07149210 * BITS OF EACH BYTE HAVE FOLLOWING MEANING * 07149220 * BIT 0 = 1 ==> 1ST ADDRESS IS PROTECTED IF NOT RUNNING REPLACE MODE* 07149230 * BIT 1 = 1 ==> 1ST ADDRESS IS PROTECTED REGARDLESS OF RUNNING MODE * 07149240 * BIT 2 = 1 ==> 2ND ADDRESS IS PROTECTED IF NOT RUNNING REPLACE MODE* 07149250 * BIT 3 = 1 ==> 2ND ADDRESS IS PROTECTED REGARDLESS OF RUNNING MODE * 07149260 * BITS 2-3 ARE ONLY FLAGGED FOR SS AND POSSIBLY SPECIAL INSTS * 07149270 * **NOTE** BIT 1 = 1 ==> BIT 0 = 1, BIT 3 = 1 ==> BIT 2 = 1. * 07149280 * TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 07149290 EXIPROT DC X'C000C080C0000000808080808000C080' 4 07149300 DC X'C000C080808080808080808080808080' 5 07149310 DC X'C080C000000000808080808080808080' 6 07149320 DC X'C0000000000000008080808080808080' 7 07149330 DC X'00000000000000000000000000000000' 8 07149340 DC X'C080C0C0C080C0C08000000000000000' 9 07149350 DC X'C0000000000000000000000000000000' A 28-XREPL 07149360 DC X'0000C0000000C080000000000080C080' B 07149370 DC X'00000000000000000000000000000000' C 07149380 DC X'00E0E0E0E0A0E0E000000000E0A0E0E0' D 07149390 DC X'00000000000000000000000000000000' E A 07149400 DC X'C0E0E0E000000000E0A0E0E0E0E00000' F 07149410 SPACE 4 07149420 DROP R13,REC,RSTK KILL LEFTOVER USINGS 07150000 .EXYZ ANOP 07150005 TITLE 'XXXXDECI - EXTENDED DECIMAL INPUT CONVERSION MODULE' 07150010 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150015 *--> CSECT: XXXXDECI EXTENDED DECIMAL INPUT CONVERSION MODULE * 07150020 * XXXXDECI IS CALLED BY MACRO XDECI TO PERFORM SCANNING AND * 07150030 * CONVERSION OF DECIMAL STRINGS. * 07150040 * ENTRY CONDITIONS * 07150050 * R14= ADDRESS OF XDECIB DSECT CREATED BY CALLING XDECI. * 07150060 * R15= ENTRY POINT ADDRESS (=V(XXXXDECI)) * 07150070 * EXIT CONDITIONS * 07150080 * XDECIR1,XDECIRV VALUES ARE FILLED IN FOR REGS. * 07150090 * CC IS SET ACCORDING TO SIGN OF RESULT, OR = 3 IF ERROR. * 07150100 * USES DSECTS: XDECIB * 07150110 * NAMES: XXDI---- * 07150120 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150130 XXXXDECI CSECT 07150140 USING *,R15 NOTE ENTRY PT USING FOR BASE REG 07150150 USING XDECIB,R14 NOTE @ CONTROL BLOCK FROM XDECI 07150160 STM R2,R3,XXDISAVE SAVE WORK REGISTERS 07150170 LA R1,1 USEFUL CONSTANT, IN ODD REGISTER 07150180 LR R2,R0 MOVE BEGINNING @ OVER WHERE USABLE 07150190 * SCAN LOOP TO SKIP OVER LEADING BLANKS. 07150200 CLI 0(R2),C' ' IS NEXT CHARACTER A BLANK 07150210 BNE *+8 SKIP OUT OF LOOP IF NOT 07150220 BXH R2,R1,*-8 LOOP, INCREMENTING SCAN POINTER 07150230 SPACE 1 07150240 MVI XXDIS,X'10' MAKE INST AN LPR FOR NOW 07150250 CLI 0(R2),C'+' IS THERE A LEADING + 07150260 BE XXDII YES, BRANCH TO BUMP POINTER 07150270 CLI 0(R2),C'-' IS THERE A LEADING - 07150280 BNE XXDII2 NO,DON'T BUMP SCAN POINTER 07150290 MVI XXDIS,X'11' - SIGN,SO MAKE INST AN LNR 07150300 XXDII AR R2,R1 BUMP SCAN PTR BY 1, LEADING SIGN 07150310 XXDII2 LR R3,R2 MOVE INIT SCAN PTR AND SAVE IT 07150320 SPACE 1 07150330 * SCAN TO END OF DECIMAL DIGITS. 07150340 CLI 0(R2),C'0' IS NEXT CHARACTER A DIGIT 07150350 BL *+16 BRANCH OUT OF LOOP IF NOT DIGIT 07150355 CLI 0(R2),C'9' WAS IT TOO HIGH (MULTIPUNCH) 07150360 BH *+8 YES, BRANCH OUT. IDIOT OVERPUNCHERS 07150365 BXH R2,R1,*-16 LOOP BACK, BUMPING SCAN POINTER 07150370 SPACE 1 07150380 ST R2,XDECIR1 STORE VALUE FOR RETURN AS SCAN PTR 07150390 SR R2,R3 OBTAIN LENGTH OF STRING 07150400 BZ XXDION IF ZERO LENGTH, ERROR, BRANCH 07150410 LA R0,9 LIMIT FOR COMPARISON 07150420 CR R2,R0 COMPARE WITH LIMIT VALUE 07150430 BNH *+12 SKIP IF SMALL ENOUGH TO BE OK 07150440 XXDION TM *+1,1 SET COND CODE = 3,BAD VALUE 07150450 B XXDIST GO TO RETURN TO CALLER 07150460 SR R2,R1 NORMAL CODE, DECREMENT LENGTH 07150470 EX R2,XXDIPK PACK THE VALUE 07150480 CVB R0,XXDIDWOR CONVERT VALUE 07150490 XXDIS LPR $+R0,R0 MAKE SIGN, SET CC RIGHT**MODIFIED*** 07150500 ST R0,XDECIRV SAVE AS VALUE FOR REG 07150510 XXDIST LM R2,R3,XXDISAVE RESTORE EXTRA WORK REGS 07150520 B XDECIRET RETURN TO CALLING XDECI MACRO 07150530 SPACE 1 07150540 XXDIPK PACK XXDIDWOR,0($,R3) PACK TO BE EXECUTED 07150550 XXDIDWOR DS D DOUBLEWORD WORKAREA 07150560 XXDISAVE DS 2F WORK REGS SAVE AREA 07150570 DROP R14,R15 KILL USINGS 07150580 SPACE 1 07150590 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150595 *--> DSECT: XDECIB CONTROL BLOCK CREATED BY XDECI MACRO * 07150600 * AN XDECIB IS CREATED BY EACH CALL TO THE XDECI MACRO, AND * 07150610 * CONTAINS THE @ XXXXDECI, SAVEWORDS FOR REGS R14,R15,R0, AND * 07150620 * WORDS FOR RETURN VALUES FOR REGISTER R1, AND THE ARGUMENT REG* 07150630 * THIS DSECT IS USED ONLY IN MODULE XXXXDECI. * 07150640 * GENERATION: XDECI * 07150650 * NAMES: XDECI--- * 07150660 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150670 XDECIB DSECT 07150680 DS V(XXXXDECI) ADCON TO GET HERE 07150690 DS 3F REGS 14,15,0 SAVED HERE 07150700 XDECIR1 DS A RETURN VALUE FOR REG 1 SCAN POINTER 07150710 XDECIRV DS F VALUE CONVERTED AND RETURNED HERE 07150720 XDECIRET LM 14,1,4(14) RETURN POINT @ 07150730 TITLE 'XXXXDECO - EXTENDED DECIMAL OUTPUT CONVERSION PROGRAM' 07150740 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150745 *--> CSECT: XXXXDECO EXTENDED DECIMAL OUTPUT CONVERSION MODULE * 07150750 * XXXXDECO IS CALLED BY MACRO XDECO TO CONVERT A REGISTER * 07150760 * VALUE TO EDITED DECIMAL, IN A 12-BYTE AREA, WITH SIGN. * 07150770 * ENTRY CONDITIONS * 07150780 * R14= ADDRESS OF XDECOB DSECT CREATED BY XDECO * 07150790 * R15= ENTRY POINT ADDRESS (=V(XXXDECO)) * 07150800 * EXIT CONDITIONS * 07150810 * EDITED 12-BYTE RESULT OF REGISTER ARGUMENT STORED AT ADDRESS ARG. * 07150820 * USES DSECTS: XDECOB * 07150830 * NAMES: XXDO---- * 07150840 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150850 XXXXDECO CSECT 07150860 USING *,R15 NOTE ENTRY PT USING FOR BASE 07150870 USING XDECOB,R14 NOTE XDECO CONTROL BLOCK 07150880 STM R1,R2,XXDOSAVE SAVE WORK REGISTERS 07150890 LR R2,R0 MOVE @ AREA WHERE CAN BE USED 07150900 L R0,XDECOV GET VALUE TO BE CONVERTED 07150910 CVD R0,XXDODWOR CONVERT THE VALUE 07150920 MVC 0(12,R2),XXDODECP MOVE EDIT PATTERN IN 07150930 LA R1,11(R2) SET UP FOR NEG NUMBER FOR EDMK 07150940 EDMK 0(12,R2),XXDODWOR+2 EDIT THE VALUE OVER 07150950 BNM XXDORETN SKIP INSERTION OF - IF >=0 07150960 BCTR R1,0 MOVE @ POINTER BACK 1 07150970 MVI 0(R1),C'-' INSERT - IN FRONT OF 1ST DIGIT 07150980 XXDORETN LM R1,R2,XXDOSAVE RESTORE WORKING REGS 07150990 SPM R14 RESTORE ORIGINAL COND CODE 07151000 B XDECORET RETURN TO CALLING XDECO 07151010 SPACE 1 07151020 XXDODECP DC X'402020202020202020202120' EDIT PATTERN 07151030 XXDODWOR DS D WORKAREA 07151040 XXDOSAVE DS 2F SAVE AREA FOR REGS 1-2 07151050 DROP R14,R15 KILL USINGS 07151060 SPACE 1 07151070 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151075 *--> DSECT: XDECOB CONTROL BLOCK CREATED BY XDECO * 07151080 * AN XDECOB IS CREATED FOR EACH XDECO CALL, AND CONTAINS THE * 07151090 * @ XXXXDECO MODULE, SAVE WORDS FOR REGS R14,R15,R0, AND A * 07151100 * WORD FOR THE VALUE TO BE CONVERTED TO DECIMAL. * 07151110 * XDECOB IS USED ONLY IN CSECT XXXXDECO. * 07151120 * GENERATION: XDECO * 07151130 * NAMES: XDECO--- * 07151140 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151150 XDECOB DSECT 07151160 DS V(XXXXDECO) ADCON TO GET HERE 07151170 DS 3F SAVE AREA FOR REGS 14,15,0 07151180 XDECOV DS F VALUE FOR CONVERSION 07151190 XDECORET LM 14,0,4(14) RETURN POINT @ 07151200 AIF (NOT &$HEXI).XXHEXI 07151210 TITLE 'XXXXHEXI-MODULE CALLED BY XHEXI' 07151215 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151217 *-->CSECT: XXXXHEXI EXTENDED HEXADECIMAL INPUT CONVERSION MODULE * 07151220 * XXXXHEXI IS CALLED BY MACRO XHEXI TO SCAN THE INPUT STRING * 07151225 * AND CONVERT IT TO HEXADECIMAL INPUT. * 07151230 * ENTRY CONDITIONS * 07151235 * R14= ADDRESS OF A STORAGE AREA WITH R14-R1 STORED * 07151240 * R15= ENTRY POINT ADDRESS (V(XXXXHEXI)) * 07151245 * R0 = ADDRESS OF STRING TO BE SCANNED. * 07151250 * EXIT CONDITIONS * 07151255 * VALUE OF CONVERTED STRING IN STORAGE AREA POINTED TO BY R14, * 07151260 * STORED IN 16 PASSED R14 OR IN XHEXINUM. * 07151265 * R1= ENDING ADDRESS OF STRING, I.E. FIRST NON-HEXADECIMAL DIGIT. * 07151270 * CC SET=3 IF ERROR * 07151275 * USES DSECT XHEXIB. * 07151280 * NAMES: XXHI---- * 07151285 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151290 SPACE 1 07151295 XXXXHEXI CSECT 07151300 USING *,15 SET UP BASE REGISTER 07151310 USING XHEXIB,R14 DSECT OVERLAP 07151315 STM R14,R6,XXHEXISA STORE APPROPRIATE REGISTERS 07151320 LR R1,R0 START SCAN OF STRING 07151325 LA R3,1 ODD VALUE USED IN BXH INSTR 07151330 XXHILP CLI 0(R1),C' ' SEARCH FOR FIRST NON-BLANK 07151335 BNE XXHIBGN BRANCH WHEN FOUND TO START TRT 07151340 BXH R1,R3,XXHILP KEEP GOING UNTIL FIND NON-BLANK 07151345 XXHIBGN LR R3,R1 FIRST BYTE OF STRING IN R3 AND R4 07151350 LR R4,R3 07151355 LR R6,R1 BEGINNING OF STRING 07151360 LA R1,8(R1) R1 NOW HAS MAXIMUM ADDRESS IN IT 07151365 * IF TRT DOESN'T STOP BEFORE 8TH TIME, R1 WON'T CHANGE=> NEED END 07151370 TRT 0(8,R6),XXHITAB2 FIND LAST BYTE-8 MAXIMUM 07151375 LR R6,R1 SAVE ENDING ADDRESS 07151380 SR R1,R3 FIND NO OF CHARACTERS 07151385 BZ XXHIERR IF LENGTH ZERO SET CC TO 3 07151390 LR R3,R1 07151395 MVC XXHIDOUB(8),=12C'0' MOVE ZEROS IN AREA TO BE CONVERTED 07151400 LA R5,8 07151405 SR R5,R3 # OF PADDED BLANKS 07151410 LA R5,XXHIDOUB(R5) R5 NOW ADDRESS OF CONVERTED STRING 07151415 BCTR R3,0 07151420 EX R3,XXHIMOVE EX USED TO MOVE CONVERTED STRING IN 07151425 TR XXHIDOUB(8),XXHITAB3 CONVERT C1-C6 TO FA-FF 07151430 PACK XXHIOUT(5),XXHIDOUB(9) DO FUNNY PACK TO MAKE RIGHT LETS 07151435 L R0,XXHIOUT CONVERTED NUMBER IN R0 07151440 ST R0,XHEXINUM STORE CONVERTED NUMBER 07151445 B XXHIARND BRANCH AROUND CONSTANTS 07151450 LTORG 07151455 XXHIMOVE MVC 0(0,R5),0(R4) MOVE FOR STRING TO BE CONVRTED 07151460 XXHIDOUB DS D,C STORAGE AREA 07151465 XXHIOUT DS F,C STORAGE AREA 07151470 SPACE 1 07151475 ** TAB2 STOPS ON ANYTHING BUT VALID HEX DIGITS 07151480 XXHITAB2 DC 256X'01' 07151485 ORG XXHITAB2+C'A' STOPS ON ANYTHING BUT A-F 07151490 DC 6X'00' 07151495 ORG XXHITAB2+C'0' STOP ONLY ON 0-9 07151500 DC 10X'00' 07151505 ORG 07151510 SPACE 1 07151515 * TAB3 USED IN TR CONVERTS TO FA-FF FROM C1-C6 07151520 XXHITAB3 EQU *-C'A' CONVERT FA-FF FROM C1-C6 07151525 DC X'FAFBFCFDFEFF' 07151530 ORG XXHITAB3+C'0' 07151535 DC X'F0F1F2F3F4F5F6F7F8F9' 07151540 ORG 07151545 XXHIERR TM *+1,1 SET CONDITION CODE 07151550 XXHIARND LM 14,15,XXHEXISA RESTORE REGISTERS 07151555 LR R1,R6 ENDING ADRESS IN SRTING 07151560 LM R2,R6,XXHEXISA+16 07151565 B XHEXIRET RETURN TO CALLING PROG 07151570 XXHEXISA DS 9F SAVE AREA FOR REGISTERS 07151575 DROP R14,R15 CLEAN UP USINGS 07151580 SPACE 5 07151585 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151587 *--> DSECT: XHEXIB CONTROL BLOCK CREATED BY XHEXI * 07151590 * AN XHEXIB IS CREATED FOR EACH XHEXI CALL, AND CONTAINS THE * 07151595 * @ XXXXHEXI MODULE, SAVE WORDS R14,R15,R0, AND A WORD VALUE THAT HAS* 07151600 * BEEN CONVERTED * 07151605 * XHEXI IS USED ONLY IN CSECT XXXXHEXI * 07151610 * GENERATION XHEXI * 07151615 * NAMES XHEXI--- * 07151620 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151625 XHEXIB DSECT 07151630 DS V(XXXXHEXI) ADCON TO GET HERE 07151635 DS 3F STORAGE FOR REGISTERS 07151640 XHEXINUM DS F STORAGE FOR CONVERTED NUMBER 07151645 XHEXIRET LM R14,0,4(R14) RESTORE REGISTERS 07151650 .XXHEXI AIF (NOT &$HEXO).XXHEXO 07151660 TITLE 'XXXXHEXO - MODULE TO SUPPORT XHEXO PSEUDO-OP' CPP 07151665 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151667 *-->CSECT: XXXXHEXO EXTENDED HEXADECIMAL OUTPUT CONVERSION MODULE * 07151670 * XXXXHEXO IS CALLED BY MACRO XHEXO TO CONVERT A REGISTER VALUE* 07151675 * TO EDITED HEXADECIMAL IN AN 8-BYTE AREA. * 07151680 * ENTRY CONDITIONS: * 07151685 * R14= ADDRESS OF SAVEAREA FOR CALLING MACRO * 07151690 * R15= ENTRY POINT ADDRESS * 07151695 * R0 = ADDRESS OF AREA WHERE CONVERTED STRING GOES * 07151700 * # OF REGISTER CONTAINING VALUE TO BE CONVERTED IN XHEXOREG * 07151705 * EXIT CONDITIONS: * 07151710 * 8-BYTE CONVERTED VALUE FROM REGISTER ARGUMENT STORED AT ADDRESS * 07151715 * POINTED TO BY LOCATION ARGUMENT * 07151720 * USES DSECT XHEXOB. * 07151725 * NAMES:XXHO---- * 07151730 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151735 SPACE 1 07151740 XXXXHEXO CSECT 07151745 USING *,15 BASE REGISTER 07151750 USING XHEXOB,R14 DSECT OVERLAP 07151755 STM R14,R1,XXHEXOSA STORE REGISTERS 07151760 L R1,XHEXOREG REGISTER TO BE CONVERTED 07151765 ST R1,XXHOAREA STORE NUMBER TO BE CONVERTED 07151770 LR R1,R0 VALUE OF ADDRESS TO BE MOVED TO IN R1 07151775 L R14,=A(XXHOTAB3-C'0') FOR CONVERSION 07151780 UNPK XXHODOUB(9),XXHOAREA(5) CONVERT NUMBER 07151785 TR XXHODOUB,0(R14) MAKE PRINTABLE 07151790 MVC 0(8,R1),XXHODOUB MOVE NUMBER INTO RIGHT AREA 07151795 XXHOBACK LM R14,R1,XXHEXOSA RESTORE REGISTERS 07151800 B XHEXORET RETURN TO CALLING PROG 07151805 XXHOTAB3 DC C'0123456789ABCDEF' 07151810 XXHOAREA DS F,C STORAGE AREA 07151815 XXHODOUB DS D,C STORAGE 07151820 XXHEXOSA DS 4F 07151825 LTORG 07151830 DROP R14,R15 CLEAN UP USINGS 07151835 SPACE 5 07151840 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151843 *--> DSECT: XHEXOB CONTROL BLOCK CREATED BY XHEXO * 07151845 * AN XHEXOB IS CREATED FOR XHEXO CALL, AND CONTAINS THE @ * 07151850 * XXXXHEXO MODULE, SAVE WORDS FOR R14-R2 AND THE PLACE TO RETURN * 07151855 * XHEXOB IS USED ONLY IN CSECT XXXXHEXO. * 07151860 * GENERATION: XXXXHEXO * 07151865 * NAMES: XHEXO---- * 07151870 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151875 XHEXOB DSECT 07151880 DS V(XXXXHEXO) STORAGE OF VCON 07151885 DS 3F 07151890 XHEXOREG DS F REGISTER STORAGE 07151895 XHEXORET LM R14,R2,4(R14) RESTORE REGISTERS 07151900 .XXHEXO ANOP 07151905 AIF (&$XXIOS).XGPSKIP SKIP IF XGET/XPUT NOT ALLOWED 07151950 TITLE 'CSECT***XDDTABLE*** CONTROL TABLE FOR XGET-XPUT MONIT' 07151954 XDDTABLE CSECT 07151956 **-->CSECT: XDDTABLE* * * * * * * * * * * * * * * * * * * * * * * * * * 07151958 * CONTAINS INFORMATION ON EACH FILE FOR THE MONITOR * 07151960 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151962 XDDSLOT &$IOUNIT(1),XREAD,POSIN=1 ONLY XREAD PRIMARY INPUT 07151964 XDDSLOT &$IOUNIT(2),XREAD,POSIN=1 ONLY XREAD 2NDARY INPUT 07151966 XDDSLOT &$IOUNIT(3),XPRNT,POSOUT=1 ONLY SPRNT TO PRINTER 07151968 XDDSLOT &$IOUNIT(4),XPNCH,POSOUT=1 ONLY XPNCH TO PUNCH 07151970 XDDSLOT &$IOUNIT(5) USER MAY NOT TOUCH SCRATCH DISK 07151972 XDDSLOT &$IOUNIT(6) USER MAY NOT TOUCH MACRO LIB. 07151974 XDDSLOT , FOR ANY USER DATA SET 07151976 XDDSLOT , FOR ANY USER DATA SET 07151978 XDDSLOT , FOR ANY USER DATA SET 07151980 XDDSLOT , FOR ANY USER DATA SET 07151982 XDDSLOT , FOR ANY USER DATA SET 07151984 XDDSLOT , FOR ANY USER DATA SET 07151986 XDDSLOT , FOR ANY USER DATA SET 07151988 X$DDLONG EQU *-XDDTABLE BYTE LENGTH OF TABLE 07152004 X$DDNUM EQU X$DDLONG/X$SLLONG WILL BE SET TO # OF SLOTS 07152006 TITLE 'CSECT***XDDGET*** XGET-XPUT MONITOR' 07152008 XDDGET CSECT 07152010 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152011 *-->CSECT: XDDGET (ENTRY XDDPUT) * 07152012 * XGET - XPUT MONITOR. USES TABLE XDDTABDE TO CONTROL * 07152014 * I/O THROUGH USER CALLS TO XGET & XPUT. * 07152016 * CALLS $READ,$PRNT,$PNCH,XGET,XPUT MACROS. * 07152018 * E.X. * 07152020 * THE MONITOR WILL NOT PERMIT A USER TO XGET A $READ FILE, * 07152022 * INSTEAD, THE MONITOR WILL CALL $READ AND THE USER WILL * 07152024 * NOT KNOW ABOUT IT. * 07152026 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152027 USING XIOBLOCK,R14 07152028 USING *,R15 07152030 MVI XDDIOBIT,X$SLXGET SET FOR INPUT 07152032 LA R15,XDDPUT RESET ADDRESSING 07152034 USING XDDPUT,R15 07152036 B XDDPUT+4 CONTINUE PROCESSING, KEEP INPUT FLAG 07152038 ENTRY XDDPUT 07152040 XDDPUT MVI XDDIOBIT,X$SLXPUT SET FOR OUTPUT 07152042 * COMMON FROM NOW ON 07152044 STM R14,R12,XDDSAVE SAVE REGS 07152046 USING XDDPUT,12 SET NORMAL ADDRESSING 07152048 LR R12,R15 07152050 DROP R15 KILL R15 07152052 L R3,=V(XDDTABLE) GET THE @ OF THE TABLE 07152054 USING X$SLOT,R3 07152056 LA R4,X$SLLONG GET LENGTH/INCR OF ENTRY 07152058 LA R5,X$SLOT+X$DDLONG-1 07152060 XDDLOOP1 CLC X$SLNAME(8),0(R1) ARE NAMES SAME? 07152062 BE XDDFOUND YES, CHECK OUT REST OF ENTRY 07152064 BXLE R3,R4,XDDLOOP1 07152066 * NOT FOUND 07152068 AIF (&X$DDMOR).XDDSK1 ALLOWED OWN DDNAMES? 07152070 * YES TRY TO FIND SPACE 07152072 L R3,=V(XDDTABLE) GET @ OF DDNAME TABLE BEGIN. 07152074 XDDLOOP TM X$SLFLAG,X$SLPERM ENTRY TEMPORARY? 07152076 BZ XDDMAKE YES 07152078 XDDLPBOT BXLE R3,R4,XDDLOOP 07152080 .XDDSK1 ANOP 07152082 * SIGNAL ERROR 07152084 XDDFBAD EQU * 07152086 TM *+1,X'FF' SET COND CODE 07152088 XDDFGOOD EQU * 07152090 LM R14,R12,XDDSAVE RESTORE REQS 07152092 B XIORETRN RETURN 07152094 AIF (&X$DDMOR).XDDSK2 07152096 * PUT DDNAME IN 07152098 XDDMAKE TM X$SLFLAG,X$SLOPEN FILE OPEN? 07152100 BM XDDLPBOT YES, TRY AGAIN 07152102 MVC X$SLNAME(8),0(R1) 07152104 MVI X$SLFLAG,X$SLPOIN SET FOR POSSIBLE IN OR OUT 07152106 B XDDAAAA 07152108 .XDDSK2 ANOP 07152110 XDDFOUND TM X$SLFLAG,X$SLOPEN IS IT OPEN? 07152112 BZ XDDNOPEN NO, GO FIX UP 07152114 TM X$SLFLAG,$ *****CHANGES- GOING THE RIGHT WAY? 07152116 XDDIOBIT EQU *-3 LABEL FOR IMMEDIATE BYTE 07152118 BO XDDECIDE GOING RIGHT WAY --- BRANCH 07152120 B XDDFBAD TAKE BAD BRANCH 07152122 XDDNOPEN SR R2,R2 EMPTY R2 07152124 IC R2,XDDIOBIT 07152126 SRL R2,4 MOVE BITS OVER 07152128 STC R2,*+5 PUT IN TM INST BELOW 07152130 TM X$SLFLAG,$ ****CHANGES***** USER ALLOWED TO GO THIS WAY 07152132 BZ XDDFBAD NO, GO RETURN 07152134 XDDAAAA OC X$SLFLAG,XDDIOBIT SET TEMP DIRECTION BIT 07152136 XDDECIDE SR R2,R2 CLEAR R2 07152138 IC R2,X$SLWAY 07152140 LH R8,XIOLENG SET UP LENGTH 07152142 B *+4(R2) BRANCH INTO BRANCH TABLE 07152144 B XDD$GPIO DO XGET-XPUT 07152146 B XDD$READ DO NORMAL READ 07152148 B XDD$PRNT DO NORMAL PRINT 07152150 B XDD$PNCH DO NORMAL PUNCH 07152152 XDD$READ EQU * 07152154 $READ (R0),(R8) 07152156 B XDDFGOOD GO RETURN 07152158 XDD$PRNT EQU * 07152160 $PRNT (R0),(R8) 07152162 B XDDFGOOD GO RETURN 07152164 XDD$PNCH EQU * 07152166 $PNCH (R0),(R8) 07152168 B XDDFGOOD GO RETURN 07152170 XDD$GPIO EQU * 07152172 LTR R8,R8 IS LENGTH ZERO? 07152174 BNZ *+8 IF LENGTH > 0 THEN CONTINUE PROC. 07152176 NI X$SLFLAG,X$SLCLOS EMPTY ELEMENT 07152178 CLI XDDIOBIT,X$SLXPUT WAS IT OUTPUT? 07152180 BE XDD$PUT YES, DO OUTPUT 07152182 * NO, DO INPUT 07152184 XGET (R0),(R8) 07152186 B XDDCLEAN 07152188 XDD$PUT EQU * 07152190 XPUT (R0),(R8) 07152192 XDDCLEAN EQU * 07152194 * IF COND CODE IS BAD, WIPE OUT FLAG 07152196 BE XDDFGOOD GO RETURN 07152198 BALR R2,0 SAVE COND CODE FOR AFTER NI 07152200 NI X$SLFLAG,X$SLCLOS WIPE OUT FLAG 07152202 SPM R2 RESTORE COND CODE TO BEFORE NI 07152204 B XDDFGOOD GO RETURN 07152206 XDDSAVE DS 15F SAVE AREA FOR REGISTERS 07152208 LTORG 07152210 DROP R14,R3,R12 CLEAN UP USINGS 07152212 TITLE 'CSECT***XXDDFINI*** CLOSE XGET-XPUT HANDLED FILES' 07152216 XXDDFINI CSECT 07152218 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152219 *-->CSECT: XXDDFINI CLOSES XGET-XPUT FILES * 07152220 * LIKE XXXXFINI, CALLED AT SAME TIME. * 07152222 * BUT CLOSES ONLY THE FILES HANDLED BY XGET-XPUT * 07152224 * * 07152226 * SEARCHS TABLE XDDTABLE FOR FILES THAT ARE OPEN AND ARE HANDLED * 07152228 * BY XGET-XPUT. * 07152230 * WHEN FOUND, CLOSES THEM THROUGH XGET-XPUT. BLANKS OUT FIRST BYTE * 07152232 * OF NAME IN TABLE. IF NOT PERMANENT, AND NOT OPEN, * 07152234 * JUST WIPES OUT FIRST BYTE. * 07152236 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152238 USING XIOBLOCK,R14 ADDRESSABILITY INTO XIOBLOCK 07152240 USING *,R15 TEMPORARY ADDRESSABILITY 07152242 STM R14,R12,XDDFSAVE SAVE REGISTERS 07152244 BALR R12,0 SET R12 07152246 USING *,R12 PERMANENT ADDRESSABILITY 07152248 DROP R15 KILL R15 07152250 L R3,=V(XDDTABLE) GET THE @ OF THE TABLE 07152252 USING X$SLOT,R3 . SET UP FOR TABLE 07152254 LA R4,X$SLLONG GET INCREMENT SIZE 07152256 LA R5,X$SLOT+X$DDLONG-1 GET UPPER BOUNDARY 07152258 XXDDFLOP TM X$SLFLAG,X$SLOPEN IS FILE OPEN 07152260 BZ XXDDFCHK NO, GO SEE IF IT IS PERMANENT 07152262 CLI X$SLWAY,X$SLXGPT IS FILE HANDLED BY XGET-XPUT? 07152264 BNE XXDDFBOT NO, CLOSED BY XXXXFINI 07152266 LR R1,R3 POINT TO DD NAME 07152268 TM X$SLFLAG,X$SLXGET HANDLED BY XGET? 07152270 BO XXDDFGET YES CLOSE BY XGET 07152272 * NO, CLOSE BY XPUT 07152274 XPUT XDDFSAVE,0 CLOSE, USE DUMMY OUTPUT AREA 07152276 B XXDDFCHK 07152278 XXDDFGET EQU * 07152280 XGET XDDFSAVE,0 CLOSE, USE DUMMY INPUT AREA 07152282 XXDDFCHK NI X$SLFLAG,X$SLCLOS REMOVE OPEN BITS 07152284 TM X$SLFLAG,X$SLPERM IS FILE PERMANENT 07152286 BO XXDDFBOT YES, LEAVE ALONE 07152288 MVI X$SLNAME,C' ' NO, BLANK OUT 07152290 XXDDFBOT BXLE R3,R4,XXDDFLOP TRY NEXT ENTRY 07152292 * RAN OUT OF ENTRIES, DONE 07152294 LM R14,R12,XDDFSAVE RESTORE REGISTERS 07152296 BR R14 RETURN 07152298 XDDFSAVE DS 15F SAVE AREA FOR REGISTERS 07152300 LTORG 07152302 DROP R14,R3,R12 KILL USINGS 07152304 PRINT GEN 07152307 XXXXGET XGPGEN 07152308 XXXXPUT XGPGEN DIREC=P 07152310 PRINT NOGEN TURN OFF AFTER XGPGEN'S CPP 07162900 .XGPSKIP ANOP 07162999 TITLE 'CSECT XXXXXIOCO ASSIST I/O PROCESSOR' 07163000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07163500 *--> CSECT: XXXXIOCO ASSIST INPUT/OUTPUT CONTROL PROCESSING * 07164000 * XXXXIOCO CONTAINS ALL ACTUAL INPUT/OUTPUT OPERATIONS. * 07166000 * XXXXINIT AND XXXXFINI ARE USUALLY CALLED ONCE EACH, TO * 07168000 * PERFORM INITIALIZATION AND TERMINATION RESPECTIVELY. * 07170000 * THE ENTRIES XXXXSORC,XXXXREAD,XXXXPNCH,XXXXPRNT ARE CALLED * 07172000 * TO READ SOURCE CARDS,READ DATA CARDS, PUNCH CARDS, OR PRINT * 07174000 * LINES DURING EXECUTION. THE DCB'S FOR READ AND PNCH ARE NOT * 07176000 * OPENED UNLESS THEY ARE USED, AND IF USED WITHOUT WORKABLE * 07178000 * OPEN'S, THEY DEFAULT BACK TO SORC AND PRNT, RESPECTIVELY. * 07180000 * THESE 4 ENTIRES SHARE A COMMON BASE REGISTER (R13,ALSO @ SAVE* 07182000 * AREA), COMMON VALUES OF R11 (@ AJOBCON) AND R12 ( CONSTANT 1)* 07184000 * COMMON EXIT CODE. SORC AND READ SHARE SOME COMMON CODE (GET)* 07186000 * AND PNCH AND PRNT SHARE SOME COMMON CODE (PUT). * 07188000 * THESE ROUTINES ARE DESIGNED TO ACCEPT THE XIOBLOCK SET UP BY * 07190000 * THE XIONR MACRO($READ,$PRNT,$PNCH,$SORC). LOCATE MODE IS * 07192000 * USED TO MINIMIZE MOVEMENT OF CARD AND LINE IMAGES. * 07194000 * *NOTE* REMOTE OPEN/CLOSE PARM LISTS ARE USED TO SAVE SPACE. * 07194100 * UNDER A DOS SYSTEM, NO SUCH LIST EXISTS DUE TO THE NON- * 07194200 * EXISTENCE OF MACRO EXECUTE FORMS FOR THE CLOSING OF DTF'S * 07194300 * USES MACROS: DCB,DCBD(OS) OR DTF(DOS) (OVERALL USE) * 07195000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07196000 SPACE 1 07198000 XXXXIOCO CSECT 07198300 $DBG ,NO SHOW NO DEBUG CODE-$SAVE/$RETURN 07198600 ENTRY XXXXINIT,XXXXFINI,XXXXREAD,XXXXSORC,XXXXPNCH,XXXXPRNT 07199000 AIF (&$DISKU EQ 0).XXNOENT SKIP ENTRY DEFINITION IF NODSK 07199050 AIF (&$ASMLVL).XXBOS1 GEN. CORRECT DISK I/O EQUATES 07199060 XXDECBE EQU 4 . DOS 'DECB' OFFSET 07199062 XXDECBIN EQU 0 . OFFSET INTO FAKE DECB - XXFIXUP 07199064 XXDKOFFL EQU 8 . DOS BUFFER OFFSET, NEEDS 8 BYTES 07199066 XXDKOPEN EQU X'15' DTF OFFSET FOR OPEN TEST 07199068 XXMASK EQU X'04' DOS OPEN TEST MASK 07199070 AGO .XXBOS2 07199072 .XXBOS1 ANOP 07199074 XXDECBE EQU 16 . OS DECB OFFSET 07199076 XXDECBIN EQU 12 . OFFSET INTO OS DECB - XXFIXUP 07199078 XXDKOFFL EQU 0 . OS BUFFER OFFSET, NONE NEEDED 07199080 XXDKOPEN EQU 48 . OS DCB DISP. FOR OPEN TEST 07199082 XXMASK EQU X'10' . OS OPEN TEST MASK. 07199084 .XXBOS2 ANOP 07199086 ENTRY XXXXDKOP,XXXXDKRD,XXXXDKE1,XXXXDKWT 07199100 .XXNOENT ANOP 07199150 AIF (NOT &$MACSLB).XXNOMET SKIP ENTRIES IF NO MACSLB 07199200 ENTRY XXXXLBOP,XXXXLBRD,XXXXFIND,XXXXLBED 07199220 .XXNOMET ANOP 07199240 USING AJOBCON,R11 NOTE GLOBAL USING FOR WHOLE CSECT 07199300 SPACE 1 07199600 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07199950 *--> ENTRY: XXXXINIT INITIAL OPEN FOR READER/PRINTER * 07200000 * OPENS PRINTER,SOURCE CARD RDR. INITIALIZES XXIOCPTR, WHICH * 07200100 * ALWAYS HAS BEGINNING @ OF OPEN/CLOSE PARM LIST (OS GEN. ONLY)* 07200200 * ENTRY CONDITIONS * 07200500 * R11= @ AJOBCON DUMMY SECTION * 07201000 * AJIO-- FLAGS IN AJOBCON ARE ALL ZEROS. * 07201500 * EXIT CONDITIONS * 07202000 * AJIOSO,AJIOPR FLAGGED WITH AJIOPEN IF DCB'S OPENED PROPERLY. * 07202500 * USES MACROS: $RETURN,$SAVE,OPEN * 07203000 * USES DSECT: AJOBCON * 07203500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07203800 SPACE 1 07203900 XXXXINIT $SAVE RGS=(R14-R12),SA=XXIOSAVE,BR=R6 07204000 ST R11,XXIOAJOB SAVE @ OF MAIN TABLE 07206000 AIF (NOT &$MACSLB).XXINNOM SKIP WHEN NO MACSLB ABILITY 07206100 MVI XXLBFLG,X'00' SHOW NO BUFFER(MACSLB) AT THIS POINT 07206200 .XXINNOM ANOP 07206300 AIF (&$ASMLVL).XXOSOPN SKIP FOR OS GENERATION OPEN 07206500 OPEN XXSODCB,XXPRDCB OPEN XXSODCB, XXPRDCB RIGHT NOW 07206550 TM XXSODCB+15,X'20' DID SOURCE READER OPEN? 07206600 BO *+8 SKIP FLAGGING IF IT DIDN'T OPEN 07206650 OI AJIOSO,AJIOPEN SHOW SOURCE READER OPEN 07206700 TM XXPRDCB+15,X'20' DID LINE PRINTER OPEN? 07206750 BO *+8 SKIP FLAGGING IF IT DIDN'T OPEN 07206800 .XXOSOPN AIF (NOT &$ASMLVL).XXDOSOP SKIP IF A DOS OPEN 07206850 LA R1,XXIOCSP INIT VALUE OF OPEN/CLOSE PTR 07207500 ST R1,XXIOCPTR STORE INIT VALUE OF PTR 07208000 OPEN MF=(E,(1)) OPEN XXSODCB,XXPRDCB RIGHT NOW 07208500 TM XXSODCB+48,X'10' DID SOURCE READER OPEN? 07210000 BZ *+8 SKIP FLAGGING IT OPEN IF DIDN'T 07212000 OI AJIOSO,AJIOPEN SHOW SOURCE READER OPEN 07214000 AIF (NOT &$CONCAT).XXOSOP1 IF NOT CONCATENATED, DONE CP 07214500 OI XXSODCB+48,X'08' SHOW CONCATENATION OK IN DCB CP 07215000 .XXOSOP1 ANOP CP 07215500 TM XXPRDCB+48,X'10' DID PRINTER OPEN? 07216000 BZ *+8 SKIP FLAGGING IT OPEN IF DIDN'T 07218000 .XXDOSOP ANOP 07218100 OI AJIOPR,AJIOPEN SHOW PRINTER OPEN 07220000 XXIOOPRT $RETURN RGS=(R14-R12) 07222000 EJECT 07222100 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07222150 *--> ENTRY: XXXXFINI CLOSE ALL DCB'S WHICH ARE OPEN * 07222200 * XXXXFINI USES THE OPEN/CLOSE PARM LIST BUILT DURING EXECUTION* 07222300 * TO CLOSE ALL DCB'S CURRENTLY OPEN. USES 1 EXECUTE TYPE OPEN.* 07222310 * DOS GENERATIONS HAVE NO OPEN/CLOSE LIST, SO A CHECK MUST BE * 07222350 * MADE TO SEE WHICH DCB'S MUST BE CLOSED. * 07222360 * ENTRY CONDITIONS * 07222400 * R11= @ AJOBCON DUMMY SECTION * 07222500 * EXIT CONDITIONS * 07222600 * AJIO-- FLAGS ARE ALL ZEROED OUT. * 07222700 * USES DSECTS: AJOBCON * 07222800 * USES MACROS: $RETURN,$SAVE,CLOSE * 07222900 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07224000 SPACE 1 07226000 XXXXFINI $SAVE RGS=(R14-R12),BR=R6,SA=XXIOSAVE 07228000 AIF (&$ASMLVL).XXOSCLS SKIP FOR OS GENERATION CLOSE 07228200 PUT XXPRDCB OUTPUT LAST DOS RECORD 07228250 CLOSE XXSODCB,XXPRDCB CLOSE SOURCE READER AND PRINTER 07228300 AIF (NOT &$DATARD).XXNORDR SKIP IF NO //DATA.INPUT RDR 07228350 TM AJIORE,AJIOPEN WAS OTHER READER OPENED 07228400 BNO XXFIPNCH IF NOT, THEN DON'T CLOSE IT 07228450 CLOSE XXREDCB CLOSE DATA CARD READER 07228500 .XXNORDR AIF (NOT &$PUNCH).XXNOPNC SKIP IF NO REAL CARD PUNCH 07228550 XXFIPNCH TM AJIOPN,AJIOPEN WAS THE PUNCH OPENED 07228600 BNO XXFIEXIT IF NOT, THEN DON'T CLOSE IT 07228650 PUT XXPNDCB OUTPUT LAST PUNCHED DOS CARD 07228700 CLOSE XXPNDCB CLOSE CARD PUNCH FILE 07228750 .XXNOPNC AIF (&$PUNCH).XXOSCLS SKIP IF CARD PUNCH EXISTS 07228800 XXFIPNCH EQU * EQU TO EXIT, SINCE NO REAL PUNCH 07228850 TM AJIODSK,AJIOPEN IS DISK DTF OPEN 07228855 BO XXFIOUT NO - SO GO RETURN 07228860 CLOSE XXDKUDCB YES - SO CLOSE DTF 07228865 XXFIOUT EQU * 07228870 .XXOSCLS AIF (NOT &$ASMLVL).XXDOSCL SKIP IF DOS CLOSE IN EFFECT 07228900 L R1,XXIOCPTR GET PTR TO BUILT UP OPEN/CLOSE LIST 07229000 CLOSE MF=(E,(1)) REMOTE CLOSE ON ALL OPEN DCB'S 07229500 .XXDOSCL ANOP 07230000 XXFIEXIT XC AJIOFLAG,AJIOFLAG CLEAR ALL FLAGS OUT 07256000 AIF (NOT &$ASMLVL).XXFIF1 SKIP IF NOT OS/360 07256200 * FOLLOWING CODE REQUIRED FOR PROPER REUSABILITY. 07256300 L R2,XXIOCPTR GET @ BEGINNING OF DCB @ LIST 07256400 SPACE 1 07256500 XXFIFREE L R1,0(,R2) GET @ NEXT DCB 07256600 AIF ((&$DISKU EQ 0) AND (NOT &$MACSLB)).XXFINA 07256605 USING IHADCB,R1 NOTE USING ON R1 07256610 TM DCBBUFCB+3,1 DOES DCB OWN A BUFFER POOL OR NOT 07256625 BO XXDCBLST SINCE ODD @, NO BUFFER POOL - BRANCH 07256630 XXFRPOOL FREEPOOL (1) DO THE FREEPOOL TO GET RID OF BUFS 07256635 XXDCBLST TM 0(R2),X'80' WAS THAT THE LAST? 07256640 AGO .XXFINB 07256645 .XXFINA ANOP 07256650 FREEPOOL (1) DO THE FREEPOOL TO GET RID OF BUFS 07256700 TM 0(R2),X'80' WAS THAT ONE THE LAST ONE? 07256800 .XXFINB ANOP 07256850 LA R2,4(R2) INCREMENT TO NEXT DCB @ 07256900 BNO XXFIFREE NOT LAST, GO BACK FOR NEXT ONE 07257000 SPACE 1 07257100 .XXFIF1 ANOP 07257200 $RETURN RGS=(R14-R12),SA=XXIOSAVE 07258000 DROP R6 KILL USING 07260000 EJECT 07262000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07263000 * REGISTER USAGE FOR SECTIONS SORC,READ,PNCH,PRNT * 07264000 * R0 = @ I/O AREA WHERE USER DESIRES DATA MOVED TO/FROM * 07266000 * R1 = @ DCB FOR OPERATION (SET BEFORE ENTRY TO SECTIONS GET, PUT * 07268000 * R2 = @ CONTROL BYTE FOR READER SECTIONS, SET BEFORE ENTRY TO GET * 07270000 * R3,R4 WORK REGISTERS * 07272000 * R5 = DOS IOREG FOR BOTH GET & PUT OPERATIONS * 07272500 * R6,R7,R8,R9,R10 ARE NOT MODIFIED OR USED * 07273000 * R11= @ AJOBCON, MAIN CONTROL DUMMY SECTION * 07274000 * R12= 1, USEFUL CONSTANT * 07276000 * R13= @ SAVE AREA XXIOSAVE, ALSO COMMON BASE REGISTER * 07278000 * R14= @ XIOBLOCK, CONTAINING LENGTH OF I/O REQUEST * 07280000 * R15= LOCAL WORK REGISTER, TEMPORARY SINCE I/O OPRS MODIFY. * 07281000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07282000 SPACE 1 07284000 USING XXIOSAVE,R13 NOTE GLOBAL USING 07286000 USING XIOBLOCK,R14 NOTE PTR TO XIOBLOCK, GLOBAL 07288000 AIF (NOT &$DATARD).XXNDAT0 SKIP IF NO //DATA.INPUT RDR 07288900 SPACE 2 07290000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07290050 *--> ENTRY: XXXXREAD READ 1 CARD AT USER EXECUTION TIME * 07290100 * OPENS CARD READER(DDNAME FT05F001) IF NOT ALREADY OPEN, OR * 07290200 * USES OPEN READER (DDNAME FT00F001) TO GET 1 CARD, USING THE * 07290300 * COMMON CODE SECTION XXIOGET. IF NODATA WAS SPECIFIED IN THE * 07290400 * USER PARM FIELD, NO OPEN WILL BE DONE FOR FT05F001, BUT * 07290500 * SYSIN WILL BE USED INSTEAD. CALLED BY $READ MACRO. * 07290600 * ENTRY CONDITIONS * 07290700 * R0 = @ I/O AREA WHERE DATA TO BE READ/WRITTEN * 07290800 * R14= @ XIOBLOCK CREATED BY THE CALLING XIONR MACRO. * 07290900 * R15= ENTRY POINT ADDRESS * 07291000 * EXIT CONDITIONS * 07291100 * CC= 0 NORMAL RETURN, CARD WAS READ AND TRANSFERRED TO USER * 07291200 * CC= 1 ENDFILE ON READER. IF ASSIST JCL, SAVED IN AJOBCON. * 07291300 * USES MACROS: GET,OPEN * 07291400 * USES DSECTS: AJOBCON,XIOBLOCK * 07291500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07291600 SPACE 1 07292000 USING XXXXREAD,REP NOTE TEMPORARY USING 07294000 XXXXREAD STM R11,R5,XXIOSAVT STORE REGS TO BE CHANGED 07296000 LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07298000 DROP REP KILL TEMPORARY USING 07300000 TM AJIORE,AJIOPEN WAS IT ALREADY OPEN? 07302000 BO XXREC YES,GO DO GET 07304000 TM AJIORE,AJIODFLT ARE WE USING SOURCE RDR INSTEAD? 07306000 BO XXSORE YES, SO USE SORC READER INSTEAD 07308000 * CALL OPTIONAL USING OPEN ROUTINE TO OPEN RDR IF IT CAN. 07308100 LA R2,AJIORE SHOW @ RDR CONTROL BYTE 07308200 AIF (&$ASMLVL).XXNDTF SKIP IF UNDER OS GENERATION 07308220 LA R1,XXREDCB SHOW @ OF DOS DCB 07308240 .XXNDTF AIF (NOT &$ASMLVL).XXNIOCR SKIP IF UNDER DOS GENERATION 07308260 LA R3,XXIOCRE SHOW @ OF OPEN/CLOSE PARM VALUE 07308300 .XXNIOCR ANOP 07308320 BAL R4,XXIOPENO CALL OPEN/FLAGGING SECTION 07308400 BZ XXIOGET IF OK, ALL SET UP-GO READ 07308500 B XXSORE OPEN DIDN'T GO, USE SOURCE RDR 07308600 SPACE 1 07308700 XXREC LA R1,XXREDCB SHOW @ DCB 07332000 LA R2,AJIORE SHOW @ CONTROL BYTE 07334000 B XXIOGET GO TO COMMON GET ROUTINE 07336000 .XXNDAT0 AIF (&$DATARD).XXNDAT2 SKIP IF DATA RDR EXISTS 07336900 XXXXREAD EQU * EQU TO XXXXSORC-DATA RDR ^EXIST 07337000 .XXNDAT2 ANOP 07337100 SPACE 2 07338000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07338050 *--> ENTRY: XXXXSORC READ A CARD DURING ASSEMBLY TIME * 07338100 * CALLED BY MACRO $SORC TO READ CARD FOR ASSEMBLER, USING * 07338200 * ALREADY OPEN DCB (DDNAME SYSIN). * 07338300 * ENTRY CONDITIONS - SAME AS THOSE FOR ENTRY XXXXREAD. * 07338400 * EXIT CONDITIONS - SAME AS THOSE FOR ENTRY XXXXREAD. * 07338500 * USES DSECTS: AJOBCON,XIOBLOCK * 07338600 * USES MACROS: GET * 07338700 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07338800 SPACE 1 07340000 USING XXXXSORC,REP NOTE TEMPORARY USING 07342000 XXXXSORC STM R11,R5,XXIOSAVT STORE REGS TO BE CHANGED 07344000 LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07346000 DROP REP KILL TEMPORARY USING 07348000 AIF (NOT &$MACSLB).XXNOSOC SKIP IF NO MACRO LIBRARY 07349000 XXSWTCH BC $,XXXXLBRD GET A CARD FROM LIBRARY-MAYBE 07349500 .XXNOSOC ANOP 07349550 CLI AJOBTRQ,AJO$D REQUEST FOR DATA? J 07349600 BE XXIOBTAA YES, NO NEED FRO SPECIAL CHECKS J 07349603 * AT THIS POINT, ASSIST IS ASKING FOR A $JOB/$ENTRY CARD J 07349606 NI AJIOSO,255-AJIOPSEO MAKE SURE NO PSEUD-END-FILE ON J 07349610 AIF (NOT &$HASPBT).XXIOBTA SKIP IF NO HASP AUTOBATCH J 07349613 TM AJIOSO,AJIOSOHS DO WE NEED BUFFER FLUSH? J 07349616 BZ XXIOBTAA NO,SKIP OVER IT J 07349620 NI AJIOSO,255-AJIOSOHS REMOVE FLAG SO WON'T DO AGAIN J 07349630 * JUST PREVIOUSLY, TWO OS NULL CARDS HAD BEEN FOUND, AND J 07349640 * ASSIST WANTS TO READ FOR THE NEXT $JOB CARD, IN WHICH J 07349643 * CASE HASP MAY WANT TO PERFORM TERMINATION. IT IS USED J 07349646 * THUSLY. IF USING MULTIPLE BUFFERS, CONSIDER CHANGING J 07349647 * THIS TO CLOSE/OPEN ON XXPRDCB. J 07349648 * IT IS NECESSARY TO PUT A BLANK LINE (SINCE LOCATE MODE)J 07349650 XXSORD PUT XXPRDCB DO PUT LOCATE 07349652 LH R2,XXPRDCB+DCBLRECL-IHADCB GET ACTUAL RECORD LENGTH J 07349660 BCTR R2,0 GET LENGTH-1 FOR MVC J 07349670 STC R2,*+5 PUT LENGTH-1 INTO MVC J 07349680 MVC 0($,R1),AJOBLANK PUT OUT A BLANK LINE TO FLUSH J 07349690 .XXIOBTA ANOP J 07349710 XXIOBTAA EQU * BRANCH IF DATA OR NO BUFFER FLUSH J 07349730 XXSORE LA R1,XXSODCB SHOW @ DCB 07350500 LA R2,AJIOSO SHOW @ CONTROL BYTE 07352000 SPACE 2 07354000 * * * * * XXIOGET - COMMON GET CODE FOR XXXXSORC AND XXXXREAD * 07356000 XXIOGET TM 0(R2),AJIOEOF+AJIOPSEO WAS EITHER EOF FLAG ALREADY ON 07358000 BNZ XXIORETA YES, REFUSE TO READ A CARD NOW 07360000 LM R14,R0,XXIOSAVT+12 RELOAD ORIG VALUES, IN CASE CHANGED 07363000 LH R3,XIOLENG GET THE LENGTH OF OPERATION FROM XIO 07364000 LR R4,R0 MOVE @ AREA OVER FOR SAFEKEEPING 07366000 TM AJIOSO,AJIOSORR WAS REREAD REQUIRED? J 07367000 BZ *+16 NO, BRANCH AND READ NEXT CARD J 07367010 L R1,XXIOLSTC REREAD- GET @ OF LAST BUFFER J 07367020 NI AJIOSO,255-AJIOSORR CLEAR FLAG SO DON'T REREAD AGAIN J 07367030 B XXIOBTBB BRANCH AROUND READ J 07367040 GET (1) DO GET LOCATE ON DCB @ 07368000 AIF (&$ASMLVL).XXNIORG SKIP IF OS & HAVE NO IOREG (PUT) 07368010 * WHEN DOS ISSUES A GET, R5 IS USED AS ITS IOREG (SINCE R1 * 07368020 * IS ILLEGAL) TO POINT TO INPUT BUFFER. MUST LOAD R1 NOW. * 07368030 LR R1,R5 GET @ OF INPUT RECORD 07368040 .XXNIORG ANOP 07368050 ST R1,XXIOLSTC SAVE ADDRESS OF THIS BUFFER J 07368070 XXIOBTBB EQU * BRANCH HERE IF DOING REREAD J 07368080 SPACE 1 07368100 * ***** BATCH CONTROL CARD PROCESSING ***** 07368200 * IF NOT RUNNING BATCH MODE, ANYTHING GOES; ELSE $JOB & 07368300 * $ENTRY CARDS CREATE PSEUDO EOF AND ARE SAVED. $STOP 07368400 * SETS REAL EOF FLAG TO TERMINATE PROCESSING 07368500 TM AJOMODE,AJOBATCH ARE WE IN BATCH MODE 07368600 BNZ XXIOBTCC YES, GO LOOK FOR CONTROL CARDS J 07368700 SPACE 1 07369700 * THRU HERE ==> NORMAL CARD-SIMULATE READ 07369800 XXIONORM EQU * ENTER HERE FOR NORMAL CARD 07369900 SR R3,R12 SUBTRACT 1 FROM LENGTH 07370000 BM XXIORETB 0 LENGTH READ(MUST BE FLUSHING) 07372000 STC R3,*+5 STORE LENGTH - 1 INTO MOVE 07374000 MVC 0($CHN,R4),0(R1) MOVE DESIRED PART OF CARD OVER 07376000 AIF (NOT &$KP26).XXNKP26 SKIP IF NO 026 KEYPUNCH 07376500 SPACE 1 07376600 * IF KP=26 OPTION USED, TRSANSLATE CARD TO EBCDIC. 07376700 TM AJIOSO,AJIOKP26 WAS KP=26 OPTION SPECIFIED 07376800 BZ XXIOKP29 NO, DON'T TRANSLATE, ALREADY -29 07376900 STC R3,*+5 STORE LENGTH-1 INTO TR 07377000 TR 0($,R4),AJTRTB26 TRANSLATE AMOUNT READ BY RDR TO 029 07377100 XXIOKP29 EQU * SKIP HERE IF NO TRANSLATE NEEDED 07377200 .XXNKP26 ANOP 07377300 B XXIORETB RETURN, SHOWING NORMAL RETURN P 07378000 SPACE 1 J 07378200 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *J* 07378210 * BATCH CONTROL CARD SCANNING PROCESS - NEW FOR VERSION 3.0 J* 07378215 * THIS VERSION INCORPORATES MORE FLEXIBILITY, AND ALSO J* 07378220 * SUPPORTS HASP AUTOBATCH CODE AS AN OPTION. MODULE ASSIST J* 07378225 * SETS FLAG AJOBTRQ TO SHOW THE TYPE OF CONTROL CARD THAT IT J* 07378230 * IS REQUESTING (AJOBTRQ=0 OTHERWISE). ACTIONS THEN DEPEND J* 07378235 * ON THE TYPE REQUESTED AND THE INPUT FOUND. NOTE THAT THIS J* 07378240 * CODE NOW PERFORMS THE FLUSH TO CONTROL CARD, RATHER THAN J* 07378245 * HAVING ASSIST LOOP LOOKING FOR ONE. J* 07378250 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *J* 07378255 XXIOBTCC CLI 0(R1),C'&$BTCC(1)' DOES CARD HAVE CONTROL CHARACTER? J 07378270 BNE XXIOBTEE NO, CAN'T BE CONTROL CARD, BRANCH J 07378275 CLC =C'&$BTCC(2)',1(R1) IS IT JOB BEGINNER? J 07378290 LA R15,AJO$J SHOW CODE FOR JOB BEGINNER J 07378295 BE XXIOBTFF YES, GO HANDLE IT J 07378300 AIF ('&$BTCC(3)' EQ '').XXIOBT3 SKIP IF NO $ENTRY WANTED J 07378310 CLC =C'&$BTCC(3)',1(R1) WAS IT $ENTRY OR EQUIVALENT? J 07378315 LA R15,AJO$E SHOW CODE FOR $ENTRY J 07378320 BE XXIOBTFF YES, GO TO PROCESS IT J 07378325 .XXIOBT3 AIF ('&$BTCC(4)' EQ '').XXIOBT4 SKIP IF $STOP NOT ALLOWED J 07378340 CLC =C'&$BTCC(4)',1(R1) IS THIS A $STOP CARD OR EQUIV? J 07378345 BE XXIOEOF YES, TREAT AS REAL EOF J 07378350 .XXIOBT4 ANOP J 07378355 XXIOBTEE SR R15,R15 SET = AJOB$D, NOT A CONTROL CARD J 07378380 XXIOBTFF EQU * COME HERE TO MAKE PROCESS DECISION J 07378400 SPACE 1 J 07378420 AIF (NOT &$HASPBT).XXIOBT6 SKIP IF NOT HASP AUTOBATCH J 07378440 * HASP AUTOBATCH CODE FOLLOWS: SET UP TO READ OVER OS J 07378445 * JOB CARDS, HANDLE TWO NULLS AS REQUIRED, ALLOW READING J 07378450 * OF SINGLE NULL, AND MAKE UP DUMMY $JOB CARD IF OMITTED J 07378455 * FOLLOWING OS JOB CARD. J 07378460 CLC 0(2,R1),=C'//' WAS THIS CARD // CARD? J 07378500 BNE XXIOBTSS NO, GO TO DETERMINE ACTION J 07378505 CLC 2(70,R1),AJOBLANK+2 WAS IT NULL CARD (COLS 3-72)? 07378510 BNE XXIOBTNN NO, NOT A NULL CARD AT ALL-BRANCH J 07378520 * AT THIS POINT, WE HAVE 1 NULL. NOW CHECK FOR 2ND. J 07378530 GET XXSODCB READ CARD, SET R1 => CARD J 07378540 ST R1,XXIOLSTC MAKE SURE @ CARD SAVED FOR LATER J 07378545 CLC 0(2,R1),=C'//' COULD IT BE NULL? J 07378550 BNE XXIOBTHH NO, GO TO HANDLE SINGLE NULL(GAH) J 07378560 CLC 2(70,R1),AJOBLANK+2 WAS IT NULL CARD (COLS 3-72)? 07378570 BNE XXIOBTHH NOT NULL- BRANCH J 07378580 * TWO NULL CARDS FOUND - ACTION DEPENDS ON REQUEST TYPE. J 07378600 CLI AJOBTRQ,AJO$J WAS $JOB CARD ASKED FOR? J 07378620 BE XXSORD YES, GO BUFFER FLUSH AND DO GET J 07378630 OI AJIOSO,AJIOSOHS NEXT TIME-SHOW WILL NEED BUFFER FLSH 07378640 AIF ('&$BTCC(3)' EQ '').XXIOBT5 SKIP IF NO $ENTRY J 07378650 MVI AJOBTYP,AJO$J FAKE TO MAKE $ENTRY REQ QUIT J 07378660 CLI AJOBTRQ,AJO$E WAS IT ACTUALLY $ENTRY? J 07378670 BE XXIORETB RETURN NORMAL, WILL CALL FOR $JOB J 07378680 .XXIOBT5 B XXIOASJC GO SHOW PSEUDO-END-FILE J 07378690 * FOLLOWING CODE FOR SINGLE NULL BY ITSELF IN JOB(?) J 07378800 XXIOBTHH MVC AJOJCLCD,AJOBLANK BLANK OUT WORK AREA J 07378805 MVC AJOJCLCD(2),=C'//' CREATE DUMMY NULL CARD J 07378810 LA R1,AJOJCLCD SHOW @ NULL CARD J 07378812 XXIOBTJJ OI AJIOSO,AJIOSORR REREAD,DON'T LOSE LAST CARD J 07378815 SR R15,R15 SHOW AJO$D => NON-CONTROL CARD J 07378820 B XXIOBTSS GO TO DETERMINE ACTION NEEDED 4 07378830 * FOLLOWING CODE IF // CARD, BUT NOT NULL CARD J 07378840 XXIOBTNN CLI AJOBTRQ,AJO$J SHOULD WE BE SCANNING FOR $JOB J 07378845 BNE XXIOBTSS NO, SO TREAT AS NORMAL DATA CARD J 07378850 * WE ASSUME THAT WE'RE ACTUALLY LOOKING AT OS JOB CARD J 07378900 * NOW: HERE IS PLACE FOR ACCOUNTING IF YOU WANT IT. J 07378905 GET XXSODCB SKIP OVER THE CARD J 07378920 ST R1,XXIOLSTC SAVE @, IN CASE NEEDED LATER J 07378925 CLC =C'&$BTCC(1)&$BTCC(2)',0(R1) WAS IT A $JOB NEXT J 07378930 BE XXIOBTOO YES, THIS IS WHAT WE WANTED J 07378940 * NO $JOB CARD AFTER OS JOB: BE NICE AND FAKE ONE. J 07378950 * FOLLOWING STATEMENT CAN BE USED TO SUPPLY PARMS, SINCE J 07378955 * ASSIST THINKS IT'S A $JOB CARD. CHANGE AS DESIRED. J 07378960 MVC AJOJCLCD,AJOBLANK BLANK OUT CARD WORKAREA J 07378963 MVC AJOJCLCD(15),=CL15'&$BTCC(1)&$BTCC(2) ASSUMED' J 07378965 LA R1,AJOJCLCD SHOW ADDRESS OF ASSEMBLED FAKE CARDJ 07378967 OI AJIOSO,AJIOSORR MARK, SO DON'T LOSE LOOKAHEAD J 07378970 XXIOBTOO LA R15,AJO$J FAKE CODE OF $JOB CARD J 07378975 .XXIOBT6 ANOP 07378990 * FOLLOWING CODE EXPECTS R15=0,1,2 TO INDICATE TYPE OF J 07379000 * CARD FOUND (DATA, $JOB, $ENTRY(MAYBE)). USE TABLE TO J 07379010 * DETERMINE ACTION: FUNCTION OF TYPE REQESTED&THAT FOUND.J 07379020 XXIOBTSS STC R15,AJOBTYP SHOW THE TYPE ACTUALLY FOUND J 07379030 MH R15,=H'3' MULTIPLY TO GET OFFSET OF TABLE ROW 07379040 SR R14,R14 CLEAR FOR INSERT J 07379050 IC R14,AJOBTRQ GET COLUMN SELECTOR: TYPE REQUEST J 07379060 AR R15,R14 GET OFFSET OF CODE BYTE IN TABLE J 07379070 IC R15,XXIOBTAB(R15) GET CODE BYTE TO DETERMINE ACTION J 07379080 * ACTIONS: 0: LOOP (SEARCHING FOR $JOB/$ENTRY CARD); J 07379090 * 4: RETURN NORMAL, COPYING CARD TO REQUESTED AREA; J 07379100 * 8: EXIT WITH END-FILE (CONTROL CARD FOUND IN DATA) J 07379110 B *+4(R15) TAKE INDEXED BRANCH J 07379200 B XXSORE 0: LOOP, HUNTING CONTROL CARD J 07379210 B XXIONORM 4: NORMAL RETURN, COPY CARD J 07379220 * 8: FALL THRU INTO XXIOASJC J 07379230 XXIOASJC OI AJIOSO,AJIOPSEO+AJIOSORR PSEUDO-EOF, REREAD TO SAVE CARD 07379500 B XXIORETA SHOW A PSEUDO END-FILE 07379700 XXIOEOF OI 0(R2),AJIOEOF SHOW END-FILE HAS OCCURRED 07380000 B XXIORETA RETURN SHOWING END-FILE 07382000 * ACTION CONTROL TABLE: USED IN XXIOBTSS CODE. CHANGE J 07382010 * AS NEEDED IF DIFFERENT ACTIONS DESIRED. J 07382020 * AJOBTRQ= DATA,$JOB,$ENTRY (REQUEST). ACTUAL FOUND BELOW J 07382030 XXIOBTAB DC AL1(0004,0000,0000) DATA FOUND- NORMAL, LOOP, LOOP J 07382040 DC AL1(0008,0004,0004) $JOB FOUND- EOF, NORMAL, NORMAL J 07382050 DC AL1(0008,0000,0004) $ENTRY FOUND- EOF,LOOP,NORMAL J 07382060 XXIOLSTC DS A @ LAST CARD READ, FOR REREAD USE J 07382100 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07382150 *--> ENTRY: XXXXPNCH PUNCH A CARD, OPENING IF REQUIRED * 07382200 * CALLED BY $PNCH MACRO TO PUNCH A CARD (DDNAME FT07F001). IF * 07382300 * THE DCB XXPNDCB CANNOT BE OPENED, OR IF NOPUNCH WAS USED IN * 07382400 * THE USER PARM FIELD, THE CARD IS PRINTED (DDNAME FT06F001) * 07382500 * WITH ' CARD-->' PRECEDING IT TO NOTE USAGE. * 07382600 * ENTRY CONDITIONS - SAME AS ENTRY XXXXREAD * 07382700 * EXIT CONDITIONS * 07382800 * CC= 0 NORMAL RETURN, CARD WAS PUNCHED OR PRINTED * 07382900 * CC= 1 RECORD LIMIT HAS BEEN EXCEEDED, CARD PUNCHED ANYWAY * 07383000 * USES DSECTS: AJOBCON,IHADCB,XIOBLOCK * 07383100 * USES MACROS: OPEN,PUT * 07383200 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07384000 SPACE 1 07386000 USING XXXXPNCH,REP NOTE TEMPORARY USING 07388000 XXXXPNCH STM R11,R5,XXIOSAVT SAVE REGS TO BE CHANGED 07390000 LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07392000 DROP REP KILL TEMPORARY USING 07394000 AIF (NOT &$PUNCH).XXNPN0 SKIP IF NO REAL PUNCH 07394500 LA R2,AJIOPN SHOW @ CONTROL BYTE 07395000 TM AJIOPN,AJIOPEN HAS PUNCH BEEN OPENED? 07396000 BO XXPNC YES, SO GO DO IT 07398000 TM AJIOPN,AJIODFLT ARE WE ALREADY USING PRINTER? 07400000 BO XXPNNOPN YES, SO GO FIX UP 07402000 SPACE 1 07404000 * CALL OPTIONAL UNIT OPEN ROUTINE TO OPEN PUNCH IF IT CAN. 07404100 AIF (&$ASMLVL).XXYIOCR SKIP IF UNDER OS GENERATION 07404150 LA R1,XXPNDCB SHOW @ OF DOS PUNCH DCB 07404200 .XXYIOCR AIF (NOT &$ASMLVL).XXYSDTF SKIP IF UNDER DOS GENERATION 07404250 LA R3,XXIOCPN SHOW @ OPEN/CLOSE PARM VALUE 07404300 .XXYSDTF ANOP 07404350 BAL R4,XXIOPENO CALL OPEN/FLAGGING ROUTINE, SETS CC 07404400 BZ XXIOPUT IF OK, ALL SET UP, SO GO PUNCH 07404500 XXPNNOPN EQU * SECTION TO USE PRINTER FOR PUNCH 07416100 .XXNPN0 ANOP 07416150 LR R2,R0 SAVE @ I/O AREA 07416200 MVC AJOPNDFT(8),=C' CARD-->' ENTER CARD FLAG 07416300 MVC AJOPNDFT+8(80),0(R2) MOVE POSSIBLE CARD OVER 07416400 LA R0,AJOPNDFT FAKE I/O @ TO BE THIS AREA 07416500 LH R3,XIOLENG GET LENGTH DESIRED TO PUNCH 07416600 LA R3,8(R3) ADD EXTRA LENGTH OF ' CARD-->' 07416700 LA R1,XXPRDCB SHOW @ OF PRINTER INSTEAD 07416800 LA R2,AJIOPR SHOW @ CONTROL BYTE(IN CASE PAGE) 07416900 B XXPRPN PRINT CARD INSTEAD OF PUNCHING 07418000 AIF (NOT &$PUNCH).XXNPN1 SKIP IF NOPUNCH 07419000 SPACE 1 07420000 XXPNC LA R1,XXPNDCB SHOW @ DCB 07424000 B XXIOPUT GO TO COMMON PUT SECTION 07426000 .XXNPN1 ANOP 07426050 EJECT 07426100 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07426150 *--> ENTRY: XXXXPRNT PRINT ONE LINE OF OUTPUT * 07426200 * CALLED BY $PRNT MACRO TO PRINT 1 LINE, USING DDNAME FT06F001.* 07426300 * ENTRY CONDITIONS - SAME AS ENTRY XXXXREAD * 07426400 * EXIT CONDITIONS - SAME AS XXXXPNCH * 07426500 * USES DSECTS: AJOBCON,IHADCB,XIOBLOCK * 07426600 * USES MACROS: PUT * 07426700 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07428000 SPACE 1 07430000 USING XXXXPRNT,REP NOTE TEMPORARY BASE 07432000 XXXXPRNT STM R11,R5,XXIOSAVT SAVE REGS TO BE CHANGED 07434000 LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07436000 DROP REP KILL TEMPORARY USING 07438000 LA R1,XXPRDCB SHOW @ PRINTER DCB 07440000 LA R2,AJIOPR SHOW @ PRINTER CONTROL BYTE 07441000 SPACE 1 07442000 * * * * * XXIOPUT - COMMON PUT ROUTINE FOR PNCH, PRNT * 07444000 XXIOPUT TM AJOMODE,AJOSRECX ARE RECORDS ALREADY EXCEEDED 07445000 BO XXIORETA YES, IGNORE THIS GUY 07445300 SPACE 1 07445600 LH R3,XIOLENG GET LENGTH OF REQUEST 07446000 * ***** OUTPUT RECORD COUNT AND TESTING ***** 07452040 XXPRPN EQU * ENTRY POINT IF FAKING PUNCH ON PRNTR 07452060 L R15,AJORECNT GET CURRENT RECORDS REMAINING 07452080 SR R15,R12 DECREMENT 07452120 BM XXIOVERP SKIP OUT, NO MORE-DON'T WRITE 07452160 ST R15,AJORECNT STORE UPDATED COUNTER BACK 07452200 SPACE 1 07452240 AIF (NOT &$PAGE).XXNPAG2 SKIP WHOLE SECT IF NO PAGE 07452280 LR R15,R0 MOVE @ USER AREA WHERE CAN USE IT 07452320 MVC AJIOWRKB,0(R15) SAVE 1ST BYTE WHERE WE CAN GET IT 07452360 TM 0(R2),AJIOPAGE ARE WE 1)PRINTING AND 2)IN PAGE CONT 07452400 BZ XXNPAGEC NO, WE AREN'T IN PAGE CONTROL MODE-B 07452440 SPACE 1 07452480 * ***** PAGE CONTROL MODE - PERFORM COINT,CHECK ***** 07452520 MVC XXIOPCLI+1(1),0(R15) MOVE CARRIAGE CONTROL IN FOR CLI 07452560 LA R2,XXIOPGTA BEGINNING @ LEGAL CAR CON BYTE TABLE 07452600 LA R14,4 INCREMENT FOR BXLE SEARCH 07452640 LA R15,XXIOPGTZ @ LAST ELEMNT IN TABLE,BXLE LIMIT 07452680 SPACE 1 07452720 XXIOPCLI CLI 0(R2),$ COMPARE TABLE ELEMENT TO USER CARCON 07452760 BE XXIOPFND FOUND WHAT HE USED-BRANCH 07452800 BXLE R2,R14,XXIOPCLI LOOP UNTIL FIND IT OR RUN OUT 07452840 SPACE 1 07452880 LA R2,XXIOPGTB @ BLANK CARRAGE CONTROL TABLE ELEM. 07452920 XXIOPFND EQU * CHARACTER FOUND 07452960 TM AJIOPR,AJIOSING ARE WE IN CRUNCHED SINGLESPACE MODE? 07453000 BZ XXIONSIN NO, NOT SINGLE SPACE MODE 07453040 * FOLLOWING IMPLEMENTS SINGLE SPACE MODE, WHICH SINGLE 07453080 * SPACES ANY CARRIAGE CONTROL EXCEPT '1', WHICH IS JUST 07453120 * DOUBLE SPACED INSTEAD OF NEW PAGED. THIS MAY BE USEFUL 07453160 * FOR CRAMMING AS MUCH OUTPUT AS POSSIBLE IN GIVEN # 07453200 * OF PAGES, OR OBTAINING AS MUCH OF A DUMP AS POSSIBLE. 07453240 IC R14,1(,R2) GET OFFSET TO WORD FOR REPLACEMENT 07453280 LA R2,XXIOPGTA(R14) GET @ REPLACEMENT CARRIAGE CONTROL 07453320 XXIONSIN EQU * SKIP HERE IF NO SINGLE SPACE 07453360 MVC AJIOWRKB,0(R2) PICK UP CORRECT BYTE FOR CC 07453400 SPACE 1 07453440 LM R14,R15,AJOLREM GET AJOLREM-AJOPREM FOR TESTING 07453480 SH R14,2(R2) LINES REMAINING-LINES FOR GIVEN CCON 07453520 BP XXIOPSTL STILL MORE-JUMP-NO OVERFLOW 07453560 SPACE 1 07453600 * OVERFLOW TO NEXT PAGE- COUNT <= 0 07453640 MVI AJIOWRKB,C'1' SHOW NEW PAGE CARRAGE CONTROL 07453680 L R14,AJOL RESET # LEFT ON PAGE TO LIMIT 07453720 SR R15,R12 # PAGES LEFT = # PAGES LEFT -1 07453760 BM XXIOVERP PAGES EXCEEDED--PRINT MSG & END CPP 07453800 ST R15,AJOPREM STORE NON-NEG NO. PAGES REMAIN. CPP 07453820 BP XXIOPSTL NOT LAST PAGE; PROCEED NORMALLY CPP 07453840 SH R14,=H'4' ON LAST PAGE, HOLD 4 FOR AM005 CPP 07453850 XXIOPSTL ST R14,AJOLREM STORE BACK COMPLETED LINES LEFT 07453880 XXNPAGEC EQU * BRANCH HERE IF NO PAGE CONTROL ON 07453920 .XXNPAG2 ANOP 07453960 SPACE 1 07454000 LR R2,R0 MOVE @ DATA AREA OVER WHERE SAFE 07454040 AIF (&$ASMLVL).XXOSREC SKIP IF UNDER OS GENERATION 07455000 L R4,8(R1) @ OF DTF CCW (CONTAINS LRECL-1) 07455020 LH R4,6(R4) ORIGINAL DTF LRECL FIELD - 1 07455040 LA R4,1(R4) +1 => ORIGINAL DTF LRECL 07455060 PUT (1) DO DOS PUT, WITH IOREG AS SPECIFIED 07455080 * WHEN DOS ISSUES A PUT, R5 IS USED AS THE IOREG (SINCE R1 IS * 07455100 * ILLEGAL) TO POINT TO NEXT OUTPUT BUFFER. GET @ INTO R1. * 07455120 LR R1,R5 @ OF DOS DTF OUTPUT BUFFER 07455140 .XXOSREC AIF (NOT &$ASMLVL).XXDSREC SKIP IF UNDER DOS GENERATION 07455160 USING IHADCB,R1 USING FOR DCB DUMMY SECTION 07455180 LH R4,DCBLRECL GET LRECL FIELD FROM DCB 07455200 DROP R1 KILL USING 07455220 PUT (1) DO PUT LOCATE 07456000 .XXDSREC ANOP 07456100 * NEXT 3 STMTS GUARD AGAINST I/O OF LENGTH > REAL LENGTH. 07457000 CLR R3,R4 IS I/O <= LRECL (CLR RATHER THAN CR) 07457100 BNH *+6 YES, GOOD PERSON, SKIP OVER 07457200 LR R3,R4 NO, BAD PERSON, USE LRECL 07457300 SR R3,R12 DECREMENT LENGTH TO L-1 07458000 BM XXIOPUTA SKIP IF 0 LENGTH 07460000 STC R3,*+5 STORE LENGTH-1 FOR MOVE 07462000 MVC 0($CHN,R1),0(R2) MOVE DATA OVER 07464000 XXIOPUTA SR R4,R12 DECREMENT REG -LRECL FIELD 07466000 AIF (NOT &$PAGE).XXNPAG4 SKIP IF NO PAGE CONTROL 07466900 MVC 0(1,R1),AJIOWRKB PUT IN POSSIBLY-CHANGED CAR CON BYTE 07467000 .XXNPAG4 ANOP 07467100 AR R1,R3 GET @-1 OF 1ST BYTE FOR BLANK PAD 07468000 SR R4,R3 GET # BLANKS REQUIRED FOR PAD 07470000 BZ XXIOPUTC SKIP IF NO BLANK PAD 07472000 SR R4,R12 DECREMENT TO L-1 FOR PAD 07474000 STC R4,*+5 STORE L-1 INTO MOVE 07476000 MVC 1($CHN,R1),AJOBLANK BLANK PAD AT END OF RECORD 07478000 XXIOPUTC EQU * EXIT HERE FOR NORMAL RETURN 07480000 SPACE 1 07492000 * * * * * COMMON EXIT CODE FOR SORC,READ,PNCH,PRNT * 07494000 * THIS SECTION MUST IMMEDIATELY FOLLOW XXIOPUT SECTION. * 07496000 * XXIORETA SETS CONDITION CODE TO 1, SHOWING EITHER END-FILE * 07498000 * ON INPUT DEVICE, OR RECORD OVERFLOW ON OUTPUT DEVICE. * 07500000 * XXIORETB SETS CC = 0 TO SHOW NO SPECIAL CONDITION. * 07502000 XXIORETB SR R0,R0 SET CC TO 0 07508000 XXIORETC LM R11,R5,XXIOSAVT RELOAD CHANGED REGS 07510000 B XIORETRN RETURN APPROPRIATELY 07512000 XXIOVERP OI AJOMODE,AJOSRECX SHOW PAGES/RECORDS EXCEEDED 07512002 XXIORETA OI *+1,1 SET CC TO 1 07512004 B XXIORETC GO TO RELOAD AND RETURN 07512006 AIF (&$DISKU EQ 0).XNODISK SKIP DISK UTILITY WHEN NODISK 07512010 USING AVWXTABL,R7 NOTE MAIN TABLE USING 07512012 USING XIOBLOCK,R14 07512014 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512015 *--> ENTRY: XXXXDKOP INITIALIZES FOR DISK UTILITY RUN * 07512016 * ALL XXXXDK ENTRIES BY RICHARD FORD, PAUL WEISSER. * 07512018 * XXXXDKOP IS CALLED FROM UTINT1 IF THE DISK UTILITY OPTION * 07512020 * IS ENABLED. IT PERFORMS A STANDARD FORM OPEN ON THE DISK * 07512022 * UTILITY DCB, INITIALIZES ANY VARIABLES USED BY THE DISK * 07512024 * UTILITY ROUTINES. XXXXDKOP ALSO COMPLETES THE DECB'S CREATED * 07512026 * FOR BUFFER POOL MANAGEMENT BY FILLING IN THE RESPECTIVE * 07512028 * BUFFER ADDRESS. IN BATCH MODE XXXXDKOP RESETS THE DISK DATA * 07512030 * SET WITH A POINT MACRO INSTRUCTION. * 07512032 * * 07512034 * * 07512036 * REGISTER ASSIGNMENTS * 07512038 * R13-> SAVE AREA POINTER * 07512040 * R14-> XIOBLOCK POINTER REGISTER * 07512042 * R15-> TEMP. BASE REGISTER * 07512044 * R0 -> HOLDS LOW END ROINTER TO BUFFER AREA * 07512046 * R1 -> WORK REGISTER * 07512048 * R3 -> HOLDS NUMBER OF BUFFERS FOR LOOP CONTROL * 07512050 * R7 -> BASE REGISTER FOR AVWXTABL * 07512052 * * 07512054 * USES MACROS: POINT (OS), POINTS (DOS) * 07512056 * USES DSECTS: AVWXTABL, XXIOBLOCK * 07512058 * * 07512060 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512062 USING XXXXDKOP,R15 NOTE TEMPORARY USING 07512064 XXXXDKOP STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512066 LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512068 USING XXIOSAVE,R13 NOTE MAIN USING 07512070 DROP R15 KILL R15 07512072 L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512074 NI AJIODSK,255-AJIOEOF CLEAR EOF FLAG FOR BATCH RUN 07512075 LA R8,4+XXDKOFFL GET OFFSET INTO BUFFER IN R8 07512076 TM XXDKUDCB+XXDKOPEN,XXMASK IS DISK DCB/DTF OPEN 07512078 BO XXOPNPT IF SO, GO ISSUE POINT MACRO 07512080 AIF (NOT &$ASMLVL).XXDR01 SKIP IF DOS GENERATION 07512081 XC XXDKBLKS(2),XXDKBLKS CLEAR BLKSIZE FOR JCL 07512082 .XXDR01 LA R2,AJIODSK GET ADDRESS OF CONTROL BYTE 07512083 AIF (&$ASMLVL).XXDR1 SKIP IF OS GENERATION 07512084 LA R1,XXDKUDCB GET ADDR OF DTF FOR OPEN 07512085 AGO .XXDR2 07512086 .XXDR1 LA R3,XXIODSKU R3 <-- ADDR OF REMOTE CLOSE WORD 07512087 .XXDR2 BAL R4,XXIOPENO OPEN DCB/DTF 07512088 BM XXEXIT DID NOT OPEN---DISASTER 07512090 OI AJIODSK,AJIOPEN SHOW DCB OPEN 07512092 XXOPNPT L R0,AVADDHIH GET CURRENT HIGH CORE POINTER 07512094 S R0,XXDKLN GET SPACE FOR FIRST BUFFER 07512096 SR R0,R8 BUMP PAST LENGTH USED WORD 07512098 AIF (&$BUFNO EQ 1).XXDKOPC SKIP IF ONLY ONE BUFFER 07512100 LA R3,&$BUFNO-1 GET # OF BUFFERS - 1 FOR LOOP 07512102 .XXDKOPC ANOP 07512104 LA R1,XXDECB+4 GET ADDR OF 1ST DECB 07512106 ST R1,AVDECB PUT ADDR OF DECB IN BCB 07512108 LR R1,R0 DUPLICATE BUFFER ADDR 07512110 AR R1,R8 BUMP PAST LENGTH USED WORD 07512112 STM R0,R1,AVBUFF@ INITIALIZE AVBCB 07512114 A R1,XXDKLN COMPUTE ENDING BUFFER @ 07512116 ST R1,AVBUFEND PUT VALUE IN BCB 07512118 AIF (&$BUFNO EQ 1).XXDKOPA SKIP IF ONLY ONE BUFFER 07512120 L R1,XXDECB GET LINK IN R1 07512122 ST R1,AVDECBNX PUT THIS IN BCB 07512124 .XXDKOPA ANOP 07512126 LA R1,XXDECB GET DECB BLOCK ADDRESS 07512128 ST R0,XXDECBE(R1) STORE 1ST BUFF @ IN DECB 1 07512129 AIF (&$BUFNO EQ 1 ).XXDKOPB SKIP IF ONLY 1 BUFFER 07512130 A R8,XXDKLN GET FULL BUFF LENGTH IN R8 07512132 SR R0,R8 GET NEXT BUFF @ 07512134 L R1,0(R1) GET LINK TO NEXT DECB 07512136 ST R0,XXDECBE(R1) STORE NEW BUFF @ AT NEW DECB 07512138 BCT R3,*-10 LOOP FOR ALL DECBS 07512140 .XXDKOPB ANOP 07512142 ST R0,AVADDHIH STORE UPDATED LOW END POINTER 07512144 XDKPT XXDKUDCB,XXXPOINT REPOSITION THE DISK 07512146 SR R2,R2 CLEAR R2 TO INITIALIZE COUNT 07512148 B XXXXDKRT RETURN TO CALLER 07512150 XXEXIT XI AVTAGS1,AJODISKU CANCEL DISK OPTION 07512152 OI *+1,1 SET CC TO MINUS TO FLAG UTINIT1 07512154 B XXXDKRTB RETURN 07512156 SPACE 2 07512158 XXDKEOF EQU * EOF EXIT ( FUTURE USE ) 07512160 XXDKSYND OI AJIODSK,AJIOEOF+AJIOSYND MARK END-FILE, ALSO SYNAD 07512164 B XXXDKRTB RETURN 07512166 SPACE 2 07512168 AIF (NOT &$ASMLVL).XXEX1 SKIP IF OS GENERATION 07512169 * XXDKUDCB DCB EXIT - USE BLKSIZE FROM JCL IF GIVEN, ELSE 07512170 * USE DEFAULT &$BLEN. 07512172 * THIS CODE ONLY USEFUL IN OS/360 SYSTEM. 07512174 USING XXDKEXCD,R15 LOCAL USING 07512176 USING IHADCB,R1 @ DCB, SUPPLIED BY OPEN 07512178 XXDKEXCD LH R0,DCBBLKSI GET BLKSIZE FROM THE DCB 07512180 SRA R0,2 DIVIDE BY 4, TEST FOR ZERO 07512182 SLL R0,2 ALIGN TO FULLWORD MULTIPLE 07512184 BNZ *+8 SKIP IF BLKSIZE FROM JCL 07512186 LH R0,=AL2(&$BLEN) USE DEFAULT BUFFER LENGTH INSTEAD 07512188 STH R0,DCBBLKSI STORE ACTUAL BLKSIZE TO BE USED 07512190 SH R0,=H'4' WANT BLKSIZE-4 FOR LATER USE 07512192 ST R0,XXDKLN SAVE IT WHERE EXPECTED 07512194 BR R14 RETURN TO OPEN EXECUTOR 07512196 DROP R1,R15 REMOVE DCB, LOCAL USINGS 07512198 .XXEX1 ANOP 07512199 TITLE 'DISK UTILITY READ' 07512200 USING XXXXDKRD,REP NOTE TEMPORARY USING 07512202 USING XIOBLOCK,R14 FORMAT FOR CONTROL BLOCK 07512204 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512205 *-->ENTRY XXXXDKRD RETURN A SET OF RECORD BLOCKS TO UTGET2 * 07512206 * XXXXDKRD IS CALLED BY UTGET2 WHEN IT HAS COMPLETED * 07512208 * PROCESSING A SET OF RECORD BLOCKS. XXXXDKRD RETURNS THE * 07512210 * ADDRESS OF THE NEXT BUFFER TO BE PROCESSD VIA THE BUFFER * 07512212 * CONTROL BLOCK AND RE-FILLS THE BUFFER WHICH WAS JUST * 07512214 * PROCESSED. WHEN ALL BLOCKS HAVE BEEN READ, XXXXDKRD CON- * 07512216 * TINUES TO ACCEPT CALLS UNTIL ALL BUFFERS HAVE BEEN * 07512218 * PROCESSED, AT WHICH TIME AN END-OF-FILE INDICATION * 07512220 * (CC=1) IS RETURNED. * 07512222 * * 07512224 * REGISTER ASSIGNMENTS * 07512226 * R13-> BASE REGISTER AND SAVE AREA POINTER * 07512228 * R14-> XIOBLOCK POINTER REGISTER * 07512230 * R15-> TEMP. BASE REGISTER * 07512232 * R2 -> WORK REGISTER FOR COUNTER * 07512234 * R3 -> DECB POINTER * 07512236 * R4 -> BUFFER POINTER * 07512238 * * 07512240 * USES MACROS: READ, CHECK * 07512242 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512244 XXXXDKRD STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512246 LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512248 USING XXIOSAVE,R13 GLOBAL USING 07512250 DROP REP DROP R15 07512252 L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512254 LM R3,R4,AVBCB GET BCB INFO 07512256 TM AJIODSK,AJIOEOF TEST IF LAST BLOCK READ 07512258 AIF (&$BUFNO NE 1).XXDKRDA SKIP IF MORE THAN 1 BUFFER 07512260 BO XXCCSET BRANCH TO SET CONDITION CODE 07512262 .XXDKRDA ANOP 07512264 LH R2,XXBLKCNT SET R2 TO COUNTER VALUE 07512266 BCT R2,XXDKNZ IF COUNT ^=0 TAKE BRANCH 07512268 AIF (&$BUFNO EQ 1).XXDKRDB SKIP IF ONLY ONE BUFFER 07512270 SPACE 2 07512272 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512274 * * 07512276 * LAST REAL READ HAS BEEN PERFORMED---RESET COUNTER TO * 07512278 * EMPTY ALL BUFFERS; SET FLAG TO SHOW END-OF-FILE * 07512280 * * 07512282 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512284 BO XXCCSET IF LAST BLK PASSED, SET CC 07512286 .XXDKRDB ANOP 07512288 OI AJIODSK,AJIOEOF SET END-OF-FILE FLAG 07512290 AIF (&$BUFNO EQ 1).XXDKRDC SKIP IF ONLY ONE BUFFER 07512292 LA R2,&$BUFNO GET COUNT OF BUFFERS 07512294 B XXDKREAD GO AND READ LAST BLOCK 07512296 SPACE 2 07512298 .XXDKRDC ANOP 07512300 XXDKNZ EQU * 07512302 AIF (&$BUFNO EQ 1).XXDKRDE SKIP IF ONLY ONE BUFFER 07512304 BO XXDKNM IF END FLAG SET, SKIP READ 07512306 .XXDKRDE ANOP 07512308 XXDKREAD XDKCHK (R3),XXDKUDCB,DOS CHECK BEFORE GIVING OUT BLOCK 07512309 XDKRD (R3),XXDKUDCB,(R4) READ A BLOCK 07512310 AIF (&$BUFNO EQ 1).XXRDD SKIP IF ONLY 1 BUFFER 07512312 XXDKNM BAL R14,XXFIXUP GO UPDATE POINTERS 07512314 .XXRDD AIF (&$ASMLVL).XXRDD1 SKIP IF OS GEN 07512316 TM AJIODSK,AJIOEOF IF EOF IS SET, 07512317 BZ XXXXDKRT DO NOT CHECK LAST BLOCK 07512318 .XXRDD1 XDKCHK (R3),XXDKUDCB CHECK BEFORE GIVING OUT BLOCK 07512319 SR R0,R0 SET CC TO NOT NEGATIVE 07512320 B XXXXDKRT RETURN TO CALLER 07512322 SPACE 5 07512324 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512326 * * 07512328 * LAST BLOCK HAS ALREADY BEEN PASSED--- SET CC & RETURN * 07512330 * * 07512332 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512334 XXCCSET OI *+1,1 SET CC TO MINUS 07512336 B XXXDKRTB RETURN TO CALLER 07512338 TITLE 'END PASS1 INITIALIZE FOR PASS2' 07512340 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512341 *--> ENTRY: XXXXDKE1 COMPLETE PASS1 PROCESSING, SET UP FOR PASS 2 * 07512342 * XXXXDKE1 IS CALLED FROM UTEND1. XXXXDKE1 WRITES LAST BUFFER * 07512344 * OR IF NO PREVIOUS WRITES WERE PERFORMED, PASSES UTGET2 THE * 07512346 * INITIAL ADDRESS OF THE ONLY BUFFER USED. IF AT LEAST 1 * 07512348 * WRITE TO DISK WAS DONE, XXXXDKE1 POINTS THE DISK TO START * 07512350 * AND READS N-1 BUFFERS FROM THE DISK AND SETS UP FOR * 07512352 * PASS 2 OF THE ASSIST ASSEMBLER. * 07512354 * * 07512356 * REGISTER ASSIGNMENTS * 07512358 * R14-> XIOBLOCK POINTER REGISTER * 07512360 * R15-> TEMP. BASE REGISTER * 07512362 * R2 -> COUNTER WORK REGISTER * 07512364 * R3 -> DECB POINTER * 07512366 * R4 -> BUFFER POINTER * 07512368 * R8 -> WORK REGISTER * 07512370 * * 07512372 * USES DSECTS: XXIOBLOCK, AVWXTABL * 07512374 * USES MACROS: READ, WRITE, POINT, CHECK * 07512376 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512378 USING XXXXDKE1,REP TEMPORARY USING 07512380 XXXXDKE1 STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512382 LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512384 USING XXIOSAVE,R13 NOTE GLOBAL USING 07512386 DROP REP DROP TEMPORARY USING 07512388 L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512390 LH R2,XXBLKCNT GET # OF BLOCKS TO BE READ 07512392 AIF (&$BUFNO EQ 1).XXDKEA SKIP IF JUST 1 BUFFER 07512394 LTR R2,R2 IS IT 0? 07512396 BNP XXONEBLK TAKE BRANCH TO ONE BLK WRITTEN 07512398 L R6,AVDECBLT GET POINTER TO LAST DECB 07512400 XDKCHK (R6),XXDKUDCB ISSUE CHECK 07512402 .XXDKEA ANOP 07512404 XXONEBLK LM R3,R5,AVBCB OBTAIN NEEDED VALUES 07512406 SR R5,R4 GET BUFFER USED LENGTH 07512408 ST R5,XXDKOFFL(,R4) STORE LENGTH IN BUFFER 07512410 XDKWT (R3),XXDKUDCB,(R4) WRITE THE BLOCK 07512412 XDKCHK (R3),XXDKUDCB CHECK COMPLETION OF LAST WRITE 07512414 XDKPT XXDKUDCB,XXXPOINT POINT TO THE FIRST RECORD 07512416 AIF (&$BUFNO NE 1).XXDK1 SKIP IF MORE THAN 1 BUFFER 07512418 ST R4,AVBUFINC RESET LENGTH WORD 07512420 AR R2,R12 INCREMENT COUNTER 07512422 B XXXXDKRT GO RETURN 07512424 .XXDK1 AIF (&$BUFNO EQ 1).XXDEC SKIP IF 1 BUFFER 07512426 AR R2,R12 INCREMENT THE COUNTER 07512428 LA R8,&$BUFNO-1 GET # OF BUFFERS LESS 1 07512430 LR R6,R12 INITIALIZE TO GET ALL INFO 07512432 XXEPRD1 XDKRD (R3),XXDKUDCB,(R4) READ FIRST BLOCK 07512434 AR R6,R12 INCREMENT READ COUNTER 07512436 SR R2,R12 DECREMENT BLOCK COUNTER 07512438 BZ XXFEWER IF ZERO GO TO XXFEWER 07512440 BAL R14,XXFIXUP ELSE MOVE POINTERS TO NEXT BLOCK 07512442 BCT R8,XXEPRD1 LOOP TO CONTINUE READING 07512444 B XXXXDKRT RETURN TO CALLER 07512446 XXFEWER OI AJIODSK,AJIOEOF SET LAST-BLOCK-READ FLAG 07512448 STH R6,XXBLKCNT STORE # OF FULL BUFFERS 07512450 BAL R14,XXFIXUP BRANCH TO UPDATE POINTERS 07512452 BCT R8,XXFIXUP LOOP TO POSITION DECB POINTERS 07512454 B XXXDKRTB RETURN TO CALLER 07512456 .XXDEC ANOP 07512458 TITLE 'DISK UTILITY WRITE' 07512460 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512461 *--> ENTRY: XXXXDKWT WRITE A FULL BUFFER TO DISK * 07512462 * XXXXDKWT IS CALLED FROM UTPUT1 WHEN PASS1 HAS FILLED A * 07512464 * BUFFER. XXXXDKWT WRITES THE BUFFER TO DISK AND UPDATES * 07512466 * THE BUFFER MANAGEMENT TABLE WHICH RETURNS THE ADDRESS OF * 07512468 * THE NEXT AVAILABLE BUFFER TO UTPUT1. * 07512470 * * 07512472 * REGISTER ASSIGNMENTS * 07512474 * R13-> BASE REGISTER AND SAVE AREA POINTER * 07512476 * R14-> XIOBLOCK POINTER REGISTER * 07512478 * R15-> TEMP. BASE REGISTER * 07512480 * R3 -> POINTER TO CURRENT DECB * 07512482 * R4 -> BUFFER POINTER * 07512484 * R5 -> BUFFER LENGTH USED ACCUMULATOR * 07512486 * R6 -> POINTER TO OLD DECB * 07512488 * * 07512490 * USES DSECTS: AVWXTABL, XXIOBLOCK * 07512492 * USES MACROS: WRITE, CHECK * 07512494 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512496 USING XXXXDKWT,REP NOTE TEMP USING 07512498 XXXXDKWT STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512500 LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512502 USING XXIOSAVE,R13 NOTE GLOBAL USING 07512504 DROP REP KILL TEMP USING 07512506 L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512508 LH R2,XXBLKCNT GET CURRENT COUNTER VALUE 07512510 AIF (&$BUFNO EQ 1).XXWTA SKIP IF ONLY 1 BUFFER 07512512 LTR R2,R2 IS THIS FIRST CALL TO THIS ENTRY 07512514 BZ XXXX1ST IF IT IS, SKIP CHECK 07512516 L R6,AVDECBLT GET POINTER TO LAST DECB 07512518 XDKCHK (R6),XXDKUDCB ISSUE CHECK 07512520 .XXWTA ANOP 07512522 XXXX1ST LM R3,R5,AVBCB OBTAIN NEEDED VALUES 07512524 SR R5,R4 SUBTRACT TO GET LENGTH OF INFO 07512526 ST R5,XXDKOFFL(,R4) STORE LENGTH IN BUFFER 07512528 XDKWT (R3),XXDKUDCB,(R4) WRITE THE RECORD(BLOCK) 07512530 AIF (&$BUFNO NE 1).XXWTB SKIP IF > 1 BUFFER 07512532 XDKCHK (R3),XXDKUDCB CHECK LAST WRITE 07512534 .XXWTB ANOP 07512536 AR R2,R12 INCREMENT COUNTER 07512538 AIF (&$BUFNO EQ 1).XXWTC SKIP IF ONLY 1 BUFFER 07512540 BAL R14,XXFIXUP GO TO FIXUP ROUTINE 07512542 .XXWTC AIF (&$BUFNO NE 1).XXWTD SKIP IF BUFNO > 1 07512544 LA R4,4(R4) INCREMENT POINTER PAST LENGTH WORD 07512546 ST R4,AVBUFINC STORE AVBUFINC BACK INTO BCB 07512548 .XXWTD ANOP 07512550 SPACE 2 07512552 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512554 * * 07512556 * COMMON RETURN CODE FOR DISK ROUTINES * 07512558 * * 07512560 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512562 XXXXDKRT STH R2,XXBLKCNT STORE UPDATED COUNTER 07512564 XXXDKRTB LM R11,R8,XXIOSAVT RESTORE REGISTERS 07512566 B XIORETRN RETURN TO CALLER 07512568 AIF (&$BUFNO EQ 1).XXFXA SKIP WHOLE SECTION IF 1 BUFFER 07512570 TITLE 'DISK UTILITY BCB UPDATE ROUTINE' 07512572 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512573 *--> INSUB: XXFIXUP UPDATE BCB POINTERS TO NEXT BUFFER * 07512574 * * 07512576 * XXFIXUP UPDATES THE POINTERS IN THE BCB, MOVING THE NEXT * 07512578 * I/O OPERATION TO THE NEXT BUFFER. * 07512580 * * 07512582 * ENTRY CONDITIONS: R3-> ADDRESS OF CURRENT DECB. * 07512584 * * 07512586 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512588 XXFIXUP ST R3,AVDECBLT STORE ADDR FOR BACKWARD REFERENC 07512590 L R3,AVDECBNX LINK TO NEXT DECB BLOCK 07512592 MVC AVDECBNX(4),0(R3) MOVE LINK TO AVBCB 07512594 LA R3,4(R3) GET DECB @ FOR NEXT BUFFER 07512596 L R4,XXDECBIN(R3) GET BUFFER ADDRESS 07512598 LA R5,4+XXDKOFFL(R4) BUMP PAST LENGTH USED WORD 07512600 STM R3,R5,AVDECB FILL PART OF THE BCB 07512602 A R5,XXDKLN GET BUFFER ENDING ADDRESS 07512604 ST R5,AVBUFEND COMPLETE BCB BLOCK 07512606 BR R14 RETURN TO CALLER 07512608 .XXFXA ANOP 07512610 XXDKLN DC A(&$BLEN-4) BUFFER LENGTH FOR HIGH END POINT 07512612 XXXPOINT DC X'00000100' POINT CONTROL WORD 07512614 XXBLKCNT DS H COUNTER HALF-WORD 07512616 XXDECB XXDKDECB &$BUFNO DEFINE DECB TABLE 07512618 DROP R7 DELETE AVWXTABL USING 07512620 .XNODISK ANOP 07512622 EJECT 07512624 AIF (NOT (&$PUNCH OR &$DATARD OR (&$DISKU NE 0) OR &$MACSLB)#07512626 ).XXNRP4 SKIP IF NO SPECIAL OPEN NEEDED 07512627 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512628 *--> INSUB: XXIOPENO OPEN OPTIONAL DATA SET, FIX FLAGS * 07512629 * XXIOPENO IS CALLED FROM ENTRIES XXXXREAD OR XXXXPNCH TO * 07512630 * OPEN A DCB, FLAG ITS AJIO-- BYTE AJIODFLT IF OPEN FAILS, * 07512632 * OR AJIOPEN IF IT GOES. IF OPEN OK, THE OPEN/CLOSE PARM WORD * 07512634 * ADDED TO THE FRONT OF CURRENT LIST BEING BUILT FOR CLOSING. * 07512636 * UNDER DOS GENERATIONS, NO OPEN/CLOSE PARM WORD IS PRESENT, * 07512638 * SO JUST OPEN AND SET RETURN CODE. * 07512640 * ENTRY CONDITIONS * 07512642 * R1 = @ OF DCB (XXREDCB, XXPNDCB) UNDER DOS GENERATIONS ONLY * 07512644 * R2 = @ AJIO-- CONTROL BYTE (AJIORE, AJIOPN) * 07512646 * R3 = @ OPEN/CLOSE PARM WORD (XXIOCRE, XXIOCPN) * 07512648 * R4 = RETURN @ TO CALLING SECTION OF CODE * 07512650 * EXIT CONDITIONS * 07512652 * R1 = @ OF DCB (XXREDCB, XXPNDCB) * 07512654 * R2 = @ AJIO-- FLAG BYTE (SAME AS ON ENTRY) * 07512656 * R0,R14 ARE PRESERVED FROM EFFECTS OF OPEN * 07512658 * CC = 0 ==> OPEN WENT. AJIO-- FLAG FLAGGED WITH AJIOPEN. * 07512660 * CC = 1 ==> OPEN FAILED. AJIO-- BYTE FLAGGED WITH AJIODFLT. * 07512662 * XXIOCPTR=XXIOCPTR-4 IF OPEN OK, OPEN/CLOSE WORD MOVE ALSO. * 07512664 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512666 SPACE 1 07512668 AIF (&$ASMLVL).XXNIHA SKIP IF UNDER OS GENERATION 07512670 XXIOPENO OPEN (1) OPEN OPTIONAL DATA SET 07512672 LM R14,R0,XXIOSAVT+12 RELOAD MESSED UP REGISTERS 07512674 TM 15(R1),X'20' DID THE OPEN GO 07512676 BZ XXIOPENQ YES, OPEN WENT 07512678 .XXNIHA AIF (NOT &$ASMLVL).XXYIHA SKIP IF UNDER DOS GENERATION 07512680 XXIOPENO LR R1,R3 MOVE PTR TO OPEN/CLOSE WORD OVER 07512682 OPEN MF=(E,(1)) DO REMOTE OPEN 07512684 LM R14,R0,XXIOSAVT+12 RELOAD MESSED-UP REGISTERS 07512686 L R1,0(R3) GET @ DCB FROM OPEN/CLOSE PARM 07512688 USING IHADCB,R1 NOTE DCB DSECT USING 07512690 TM DCBOFLGS,X'10' DID THE OPEN GO? 07512692 BO XXIOPENQ YES, OPEN WENT 07512694 .XXYIHA ANOP 07512698 SPACE 1 07512700 OI 0(R2),AJIODFLT OPEN FAILED, USE DEFAULT DATA SET 07512702 BR R4 RETURN TO CALLER, CC=1 AT MOMENT 07512704 SPACE 1 07512706 * OPEN SUCCEEDED. MARK DATA SET OPEN. ADD ITS OPEN/CLOSE PARM * 07512708 * WORD TO FRONT OF LIST SO IT WILL BE CLOSED LATER (OS ONLY). * 07512710 XXIOPENQ OI 0(R2),AJIOPEN SHOW OPEN OK 07512712 AIF (NOT &$ASMLVL).XXNPRMW NO DOS PARM WORD LIST 07512714 AIF (NOT &$CONCAT).XXNCAT1 SKIP IF NOT CONCAT. OF DATA SETS 07512715 OI DCBOFLGS,X'08' SHOW CONCATENATION ALLOWED CP 07512716 .XXNCAT1 ANOP CP 07512717 L R15,XXIOCPTR GET CURRENT PTR TO OPEN/CLOSE LISTCP 07512718 SH R15,=H'4' SUBTRACT TO GET NEXT POSITION 07512720 ST R15,XXIOCPTR STORE UPDATED VALUE 07512740 MVC 0(4,R15),0(R3) MOVE NEW OPEN/CLOSE PARM IN 07512760 NI 0(R15),X'7F' REMOVE LEADING BIT, SINCE NOT LAST 07512780 .XXNPRMW ANOP 07512790 DROP R1 ADDR. TO DCB NO LONGER NEEDED CP 07512795 SR R15,R15 SET CC=0 TO SHOW SUCCESSFUL 07512800 BR R4 RETURN TO CALLING CODE 07512820 SPACE 1 07512830 .XXNRP4 AIF (NOT &$ASMLVL).XXNPN2 NO LIST FORMS UNDER DOS 07512840 XXIOCPTR DS A @ 1ST VALID OPEN/CLOSE PARM IN LIST 07512860 * OPEN/CLOSE PARM VALUES. ORDER REQUIRED NEXT 2 CARDS. 07512880 DS 2F FOR RE, PN OPEN/CLOSE PARMS 07512900 AIF (&$DISKU LT 1).XXNDKOP 07512905 DS F ROOM FOR DISK UTILITY PARM WORD 07512910 .XXNDKOP AIF (NOT &$MACSLB).XXNMCLB SKIP WORD IF NOT NEEDED 07512915 DS A SPACE FOR ANOTHER PTR WORD 07512916 .XXNMCLB ANOP 07512917 XXIOCSP OPEN (XXSODCB,INPUT,XXPRDCB,OUTPUT),MF=L SET UP VALUES 07512920 SPACE 1 07512940 AIF (NOT &$DATARD).XXNRE2 SKIP IF NO DATA RDR 07512950 XXIOCRE OPEN (XXREDCB,INPUT),MF=L SET UP VALUE HERE 07512960 .XXNRE2 AIF (NOT &$PUNCH).XXNPN2 SKIP IF NO REAL PUNCH 07512970 XXIOCPN OPEN (XXPNDCB,OUTPUT),MF=L SET UP VALUE HERE 07512980 .XXNPN2 ANOP 07512990 AIF (&$DISKU EQ 0).XXNDOPN SKIP IF NO DISK OPTION 07512995 AIF (NOT &$ASMLVL).XXNDOPN SKIP IF OS GENERATION 07512997 XXIODSKU OPEN (XXDKUDCB,(OUTIN)),MF=L 07513000 .XXNDOPN ANOP 07513005 EJECT 07514000 AIF (NOT &$MACSLB).XXNMCOP 07514005 XXLIBCLS OPEN (XXLIBDCB,INPUT),MF=L LIST FORM FOR MACRO LIBRARY OPEN 07514010 EJECT 07514015 SPACE 10 07514020 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514022 *-> ENTRY: XXXXLBOP * 07514025 * XXXXLBOP INITIALIZES FOR A MACRO LIBRARY RUN. XXXXLBOP* 07514030 * IS CALLED BY MOCOMSYS IN MCON1. IT OPENS THE SYSTEM LIBRARY * 07514035 * DCB IF NECESSARY, ALLOCATES BUFFER SPACE IN HIGH CORE, AND * 07514040 * SETS SWITCH IN XXXXSORC SUCH THAT XXXXSORC PROVIDES INCARD * 07514045 * THE ADDRESS OF A CARD IMAGE FROM THE SYSTEM LIBRARY BUFFER * 07514050 * INSTEAD OF FROM THE NORMAL SYSIN DATA SET. ALSO SETS THE * 07514055 * ADDRESS INTO THE GLOBAL TABLE NEEDED BY THE SUPPORTING * 07514060 * ROUTINES. * 07514065 * * 07514070 * REGISTER ASSIGNMENTS: * 07514075 * PSEUDO-STANDARD OS LINKAGE (SAVING ONLY NEEDED REG) * 07514080 * R1=> BASE FOR IHADCB DSECT * 07514085 * R4=> BASE FOR XLBDSECT DSECT * 07514090 * R7=> AVWXTABL BASE REGISTER * 07514095 * R13=> SAVE AREA POINTER AND MAIN BASE REGISTER * 07514100 * R15=> TEMP BASE REGISTER * 07514105 * * 07514110 * USES MACROS: * 07514115 * $ALLOCH * 07514120 * * 07514125 * USES DSECTS: * 07514130 * AVWXTABL, XLBDSECT, IHADCB * 07514135 * * 07514140 * EXIT CONDITIONS: * 07514145 * CC = 1 (MINUS) IF OPEN DID NOT GO * 07514150 * AND ZERO (0) IF OPEN WENT * 07514155 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514160 SPACE 5 07514165 USING AVWXTABL,R7 NOTE MAIN TABLE USING 07514170 USING XXXXLBOP,R15 TEMP BASE REGISTER 07514175 XXXXLBOP STM R11,R8,XXLBSAVT SAVE REGISTERS TO BE CHANGED 07514180 LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07514185 USING XXIOSAVE,R13 NOTE MAIN USING 07514190 DROP R15 CLEAN UP USINGS 07514195 L R7,AJOVWXPT GET MAIN TABLE ADDRESS 07514200 MVC AVLIBBUF,AWZEROS ZERO THE GLOBAL WORD 07514205 TM XXLIBDCB+48,X'10' IS THE LIBRARY DCB ALREADY OPEN 07514210 BO XXLBALOP YES-- GO TO ALREADY OPEN 07514215 LA R2,XXLBFLG R2 <-- ADDRESS OF CONTROL BYTE 07514220 LA R3,XXLIBCLS R3 <-- DDDRESS OF REMOTE CLOSE WORD 07514225 BAL R4,XXIOPENO GO DO OPEN 07514230 BM XXLBOVR OPEN DID NOT GO -- HURT 07514235 SPACE 2 07514240 * OPEN WENT SO COMPLETE LIBRARY RUN SET UP 07514245 SPACE 2 07514250 XXLBALOP LA R1,XXLIBDCB GET ADDRESS OF LIBRARY DCB 07514255 USING IHADCB,R1 SET USING FOR DCB DSECT 07514260 LH R2,DCBBLKSI GET BLOCK SIZE FROM THE DCB 07514265 SPACE 2 07514270 * ROUND UP TO A D-WORD MULTIPLE TO BE SURE 07514275 SPACE 2 07514280 LA R2,7+XLBUFCNT(R2) ADD 7 PLUS LENGTH OF CONTROL AREA 07514285 SRL R2,3 DIVIDE BY 8 07514290 SLL R2,3 MULTIPLY BY 8 07514295 SPACE 2 07514300 * GET THE SPACE FOR THE BUFFER AND CONTROL WORDS IN HIGH CORE 07514305 SPACE 2 07514310 USING XLBDSECT,R4 NOTE LIBRARY DSECT 07514315 $ALLOCH R4,R2,XXLBOVR GET THE SPACE IN HIGH CORE 07514320 MVI XXLBFLG,X'FF' SET FLAG TO SHOW BUFFER ALLOCATED 07514325 SPACE 2 07514330 * INITIALIZE GLOBAL CONTROL WORD 07514335 ST R4,AVLIBBUF STORE BUFFER AND CONTROL BLOCK 07514340 * ADDRESS IN THE GLOBAL TABLE 07514345 SPACE 2 07514350 * INITIALIZE THE BUFFER CONTROL WORDS 07514355 SPACE 2 07514360 ST R2,XLBUFLNG STORE TOTAL LENGTH IN CONTROL WORD 1 07514365 AR R2,R4 GET START PLUS LENGTH IN R2 07514370 ST R2,XLBUFEND STORE IN CONTROL WORD 2 07514375 SR R2,R4 REMOVE STARTING ADDRESS 07514380 LA R2,XLBUFCNT(R4) GET REAL BUFFER START ADDRESS 07514385 LR R3,R2 DUPLICATE FOR MUTIPLE STORE 07514390 STM R2,R3,XLBUFSTR STORE IN CONTROL WORDS 2 & 3 07514395 DROP R4,R1 CLEAN UP USINGS 07514400 SPACE 2 07514405 * SET XXXXSORC SWITCH TO ALWAYS BRANCH 07514410 SPACE 2 07514415 MVI XXSWTCH+1,X'F0' SET SWITCH TO BRANCH 07514420 SPACE 2 07514425 SR R0,R0 MAKE CC NOT MINUS 07514430 XXLBOUTA LM R11,R8,XXLBSAVT RESTORE REGISTERS 07514435 BR R14 RETURN TO CALLER 07514440 SPACE 2 07514445 * STORAGE OVERFLOW EXIT 07514450 SPACE 2 07514455 XXLBOVR OI *+1,1 SET CC TO MINUS 07514460 B XXLBOUTA RETURN 07514465 DROP R7,R13 CLEAN UP USINGS 07514470 SPACE 5 07514475 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514477 *-> ENTRY: XXXXFIND * 07514480 * XXXXFIND DOES A D-TYPE FIND ON EACH MACRO THAT IS * 07514485 * REQUIRED BY THE USER PROGRAM AS DEFINED ON THE SYSLIB CARD. * 07514490 * CALLED FROM MOCOMSYS IN THE MCON1 CSECT. * 07514495 * * 07514500 * REGISTER ASSIGNMENTS: * 07514505 * R12 => AVWXTABL BASE REGISTER * 07514510 * R13 => SAVE AREA POINTER AND MAIN BASE REGISTER * 07514515 * R14 => DCB ADDRESS * 07514520 * * 07514525 * ENTRY CONDITIONS: * 07514530 * MEMBER NAME IS IN AVMSYMBL * 07514535 * * 07514540 * EXIT CONDITIONS: * 07514545 * CC SET TO ZERO IF ALL WENT WELL * 07514550 * CC SET TO MINUS IF NAME COULD NOT BE FOUND * 07514555 * * 07514560 * USES MACROS: * 07514565 * FIND * 07514570 * * 07514575 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514580 SPACE 5 07514585 USING AVWXTABL,R12 NOTE MAIN TABLE USING 07514590 USING XXXXFIND,R15 07514595 XXXXFIND STM R11,R1,XXLBSAVT SAVE REGISTERS THAT MIGHT CHANGE 07514600 L R13,XXIOAJOB+8 GET BASE REGISTER SET UP 07514605 USING XXIOSAVE,R13 NOTE MAIN USING 07514610 DROP R15 CLEAN UP USING SITUATION 07514615 SPACE 2 07514620 MVC XXFNDDW,AVMSYMBL PUT NAME ON A D-WORD BOUNDRY 07514625 SPACE 2 07514630 FIND XXLIBDCB,XXFNDDW,D DO THE FIND 07514635 LTR R15,R15 TEST RETURN CODE FROM FIND ROUTINE 07514640 BNZ XXFNDERR COULDNOT FIND NAME--SET UP BAD RTN 07514645 SPACE 2 07514650 SR R0,R0 MAKE CC NOT MINUS 07514655 XXXXFDOT LM R11,R1,XXLBSAVT RESTORE REGISTERS 07514660 BR R14 RETURN TO CALLER 07514665 SPACE 2 07514670 XXFNDDW DS D D-WORD ALIGNED PLACE FOR MEMBER NAME 07514675 XXFNDERR OI *+1,1 SET CC TO MINUS FOR RETURN 07514680 B XXXXFDOT RETURN 07514685 DROP R12,R13 CLEAN UP USINGS 07514690 SPACE 5 07514695 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514697 *-> ENTRY: XXXXLBRD * 07514700 * * 07514705 * CALLED BY INCARD VIA XXXXSORC TO PROVIDE THE MACRO * 07514710 * PROCESSOR WITH DEBLOCKED RECORDS FROM THE SYSTEM MACRO * 07514715 * LIBRARIES. FUNCTIONS AS AN INSUB TO ENTRY XXXXSORC. * 07514720 * * 07514725 * REGISTER ASSIGNMENTS: * 07514730 * SAME AS XXXXSORC: EXCEPT R12 IS BASE FOR AVWXTABL * 07514735 * * 07514740 * ENTRY CONDITIONS: * 07514745 * SAME AS XXXXSORC * 07514750 * ADDITIONALLY -- INCARDS DATA AREA COMES OVER IN * 07514755 * REGISTER R0 AND MUST BE PROTECTED FROM SYSTEM ACTIONS * 07514760 * * 07514765 * USES DSECTS: * 07514770 * XLBDSECT, IHADCB * 07514775 * * 07514780 * USES MACROS: * 07514785 * READ, CHECK * 07514790 * * 07514795 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514800 SPACE 5 07514805 USING XXIOSAVE,R13 NOTE MAIN USING 07514810 USING IHADCB,XXXLBDCB 07514815 XXXXLBRD STM R6,R7,XXLBSAVT SAVE SOME WORK REGISTERS 07514820 L R12,AJOVWXPT GET AVWXTABL BASE ADDRESS 07514825 USING AVWXTABL,R12 NOTE MAIN TABLE USING 07514830 L R3,AVLIBBUF GET ADDRESS OF BUFFER SPACE 07514835 USING XLBDSECT,R3 NOTE LIBRARY DSECT USING 07514840 LR R4,R0 MOVE DATA AREA ADDRESS OVER 07514845 SPACE 2 07514850 XXXLBDCB EQU R5 HOLDS THE LIBRARY DCB ADDRESS 07514855 XXRECPT EQU R6 HOLDS ADDRESS OF CARD IMAGE 07514860 XXBUFEND EQU R7 POINTER TO THE END OF THE BUFFER 07514865 SPACE 2 07514870 LM XXRECPT,XXBUFEND,XLBUFSTR GET CONTROL INFORMATION 07514875 CR XXRECPT,XXBUFEND IS BUFFER EMPTY 07514880 BNL XXXLIBRD YES--GO READ A NEW BUFFER FULL 07514885 SPACE 2 07514890 XXLBRCPT MVC 0(80,R4),0(XXRECPT) MOVE CARD WHERE INCARD EXPECTS 07514895 LA XXRECPT,80(XXRECPT) INCREMENT TO NEW RECORD 07514900 SPACE 2 07514905 * SET UP FOR RETURN 07514910 SPACE 2 07514915 ST XXRECPT,XLBUFSTR SAVE UPDATED RECORD POINTER 07514920 XXLBRDRT LM R6,R7,XXLBSAVT RESTORE REGISTERS 07514925 B XXIORETB RETURN TO CALLER (INCARD) 07514930 XXXLIBRD LA XXXLBDCB,XXLIBDCB GET DCB ADDRESS IN A REG 07514935 LA XXRECPT,XLIBBUF GET AREA ADDRESS INTO XXRECPT REG 07514940 READ XXLBDECB,SF,(XXXLBDCB),(XXRECPT),'S' READ A BLOCK 07514945 CHECK XXLBDECB CHECK FOR I/O COMPLETION 07514950 SPACE 2 07514955 LH XXBUFEND,DCBBLKSI GET BLOCKSIZE FROM DCB 07514960 L R2,XXLBDECB+16 GET IOB ADDRESS 07514965 SH XXBUFEND,14(R2) GET RELATIVE END OF NEW BLOCK 07514970 LA XXBUFEND,XLBUFCNT(R3,XXBUFEND) GET ABSOULUTE END OF NEW 07514975 * BLOCK 07514980 ST XXBUFEND,XLBUFCED SET CONTROL WORD 4, CURRENT END 07514985 B XXLBRCPT GO TO DEBLOCK 07514990 XXMCEODD MVC 0(80,R4),AWBLANK BLANK OUT AREA FOR CARD 07514995 MVC 10(4,R4),=C'MEND' PUT MEND CARD IMAGE THERE 07515000 B XXLBRDRT RETURN VIA XXXXSORC, INCARD 07515005 SPACE 5 07515010 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07515013 DROP R3,R5,R12,R13 CLEAN UP USINGS 07515015 *-> ENTRY: XXXXLBED * 07515020 * * 07515025 * CALLED 1 TIME BY THE MAIN PROGRAM MCON1 TO INSURE * 07515030 * THAT THE XXXXSORC SWITCH BRANCH IS SET FOR NORMAL PROCESSING.* 07515035 * ALSO CALLED BY MOCOMSYS IN MCON1 TO DEALLOCATE THE BUFFER * 07515040 * AND CONTROL WORD SPACE AND TO RESET THE XXXXSORC SWITCH * 07515045 * BRANCH TO THE NORMAL CONDITION. * 07515050 * * 07515055 * REGISTER ASSIGNMENTS: * 07515060 * R2=> AVWXTABL BASE REGISTER * 07515065 * R13 => SAVE AREA POINTER AND MAIN BASE REGISTER * 07515070 * R15 => TEMP BASE REGISTER * 07515075 * * 07515080 * USES DSECTS: * 07515085 * XLBDSECT * 07515090 * * 07515095 * USES MACROS: * 07515100 * $DALLOCH * 07515105 * * 07515110 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07515115 SPACE 5 07515120 USING AVWXTABL,R2 NOTE TABLE USING 07515125 USING XXXXLBED,R15 TEMP USING 07515130 XXXXLBED STM R11,R2,XXLBSAVT SAVE SOME WORK REGISTERS 07515135 LM R11,R13,XXIOAJOB GET NEEDED VALUES 07515140 L R2,AJOVWXPT GET BASE VALUE FOR MAIN TABLE 07515145 USING XXIOSAVE,R13 NOTE MAIN USING 07515150 DROP R15 CLEAN UP USING SITUATION 07515155 TM XXLBFLG,X'FF' IS THERE A BUFFER AROUND? 07515160 BZ XXEDSET NO -- DO NOT DE-ALLOCATE THE BUFFER 07515165 SPACE 2 07515170 * DEALLOCATE BUFFER SPACE IN HIGH FREEAREA 07515175 SPACE 2 07515180 L R15,AVLIBBUF GET ADDRESS OF BUFFER AREA 07515185 USING XLBDSECT,R15 NOTE LIBRARY DSECT USING 07515190 L R15,XLBUFLNG GET TOTAL LENGTH OF SPACE TO BE 07515195 * FREED 07515200 $DALLOCH R1,(R15) DEALLOCATE THE AREA 07515205 DROP R15 CLEAN UP USING SITUATION 07515210 SPACE 2 07515215 * SET XXXXSORC SWITCH BRANCH TO NORMAL NON-BRANCH 07515220 SPACE 2 07515225 XXEDSET MVI XXLBFLG,X'00' MARK BUFFER AS GONE 07515230 MVI XXSWTCH+1,X'00' SET TO NEVER BRANCH IN XXXXSORC 07515235 LM R11,R2,XXLBSAVT RESTORE REGISTERS 07515240 BR R14 RETURN TO CALLER 07515245 DROP R2 CLEAN UP USING SITUATION 07515250 SPACE 2 07515255 XXLBSAVT DS 14F SPACE FOR TEMP STORAGE OF REGISTERS 07515260 XXLBFLG DS B DUMMY FLAG BYTE FOR REMOTE OPEN 07515265 SPACE 5 07515270 .XXNMCOP ANOP 07515275 XXIOAJOB DS A SPACE FOR @ AJOBCON BLOCK 07516000 DC A(1,XXIOSAVE) FOR REGS R12-R13-FOLLOW XXIOAJOB 07518000 XXIOSAVT DS 14F SAVE AREA FOR I/O ROUTINES 07520000 AIF (NOT &$PAGE).XXNPAG8 SKIP IF NO PAGE CONTROL 07520020 * LEGAL CARRIAGE CONTROL CHARACTERS. ITEMS ARE THE 07520040 * CHARACTER, AN OFFSET TO ITS REPLACEMENT CHARCATER 07520060 * WORD IF IN MODE SINGL, AND DECREMENT FOR LINE COUNTER. 07520080 XXIOPGTA DS 0H ORIGIN OF TABLE, ALIGN 07520100 XXIOPB EQU *-XXIOPGTA OFFSET FROM TABLE TO BLANK'S BLOCK 07520120 XXIOPGTB DC C' ',AL1(XXIOPB),H'1' SINGLE SPACE, SINGLE SPACE 07520140 XXIOPD EQU *-XXIOPGTA OFFSET TO DOUBLE SPACE 07520160 DC C'0',AL1(XXIOPB),H'2' DOUBLE SPACE,SINGLE SPACE 07520180 DC C'1',AL1(XXIOPD),H'32000' NEW PAGE, DOUBLESPACE 07520200 DC C'-',AL1(XXIOPB),H'3' TRIPLE SPACE,SINGLE SPACE 07520220 DC C'+',AL1(*-1-XXIOPGTA),H'0' NO SPACE, NOSPACE 07520240 XXIOPGTZ EQU *-4 @ LAST ELEMENT IN TABLE 07520260 .XXNPAG8 ANOP 07520280 LTORG 07520500 SPACE 1 07522000 * DCB'S FOR THE SOURCE AND DATA CARD READERS. 07524000 AIF (NOT &$ASMLVL).XXNPN4 SKIP IF UNDER DOS GENERATION 07525000 XXSODCB DCB DDNAME=&$IOUNIT(1),DSORG=PS,MACRF=GL,EODAD=XXIOEOF 07526000 AIF (NOT &$DATARD).XXNRE4 SKIP IF NO DATA RDR 07527900 XXREDCB DCB DDNAME=&$IOUNIT(2),DSORG=PS,MACRF=GL,EODAD=XXIOEOF 07528000 .XXNRE4 ANOP 07528200 SPACE 1 07530000 * DCB'S FOR THE LINE PRINTER AND CARD PUNCH. 07532000 XXPRDCB DCB DDNAME=&$IOUNIT(3),DSORG=PS,MACRF=PL, #07534000 RECFM=FA,LRECL=&$PRTSIZ,BLKSIZE=&$PRTSIZ,BUFNO=1 CPP 07535000 AIF (NOT &$PUNCH).XXNPN4 SKIP IF NO REAL PUNCH EXISTS 07535500 XXPNDCB DCB DDNAME=&$IOUNIT(4),DSORG=PS,MACRF=PL, #07536000 RECFM=F,LRECL=80,BLKSIZE=80,BUFNO=1 07537000 .XXNPN4 ANOP 07537500 AIF (&$ASMLVL).XXNPN8 SKIP IF UNDER OS GENERATION 07537520 XXSODCB DTFCD DEVADDR=&$IOUNIT(1),EOFADDR=XXIOEOF,IOREG=(5), X07537540 IOAREA1=XXIOLOCP,IOAREA2=XXIOLOCS,TYPEFLE=INPUT 07537560 XXIOLOCP DC 80C' ' DOS IOAREA1 07537580 XXIOLOCS DC 80C' ' DOS IOAREA2 07537600 AIF (NOT &$DATARD).XXNRE8 SKIP IF NO DATA CARD READER 07537620 XXREDCB DTFCD DEVADDR=&$IOUNIT(2),EOFADDR=XXIOEOF,IOREG=(5), X07537640 IOAREA1=XXIOLOCP,IOAREA2=XXIOLOCS,TYPEFLE=INPUT 07537660 .XXNRE8 ANOP 07537680 SPACE 1 07537700 * DCB'S FOR THE LINE PRINTER AND CARD PUNCH * 07537720 XXPRDCB DTFPR DEVADDR=&$IOUNIT(3),BLKSIZE=133,IOREG=(5),CTLCHR=ASA, X07537740 IOAREA1=XXIOFILP,IOAREA2=XXIOFILS 07537760 XXIOFILP DC 133C' ' PRINTER IOAREA1 07537780 XXIOFILS DC 133C' ' PRINTER IOAREA2 07537800 AIF (NOT &$PUNCH).XXNPN8 SKIP IF NO REAL CARD PUNCH 07537820 XXPNDCB DTFCD DEVADDR=&$IOUNIT(4),CRDERR=RETRY,IOREG=(5),CTLCHR=ASA, X07537840 IOAREA1=XXIOPNCP,IOAREA2=XXIOPNCS,TYPEFLE=OUTPUT 07537860 XXIOPNCP DC 80C' ' PUNCH IOAREA1 07537880 XXIOPNCS DC 80C' ' PUNCH IOAREA2 07537900 .XXNPN8 ANOP 07537920 AIF (&$DISKU EQ 0).XXNDDCB SKIP IF NO DISK OPTION 07537925 AIF (&$ASMLVL).XXDDCB1 SKIP IF OS GENERATION 07537926 XXDKUDC DTFSD DEVADDR=&$IOUNIT(5),EOFADDR=XXDKEOF,TYPEFLE=WORK, X07537927 BLKSIZE=3520,NOTEPNT=YES,DEVICE=&$DSKUDV 07537928 XXDKUDCB EQU XXDKUDC ATTACH 7-CHAR DTFSD LABEL TO EXPECTD 07537929 AGO .XXNDDCB 07537930 .XXDDCB1 ANOP 07537931 XXDKUDCB DCB DDNAME=&$IOUNIT(5),EODAD=XXDKEOF,RECFM=FB,EXLST=XXDKEXLS,#07537935 SYNAD=XXDKSYND,DSORG=PS,NCP=&$BUFNO,MACRF=(RP,W) 07537940 XXDKBLKS EQU XXDKUDCB+X'3E' BLKSIZE FIELD (DCBBLKSI) ADDRESS 07537945 XXDKEXLS DC 0F'0',X'85',AL3(XXDKEXCD) DCB EXIT, FILL IN BLKSIZE 07537950 .XXNDDCB ANOP 07537955 EJECT 07537960 AIF (NOT &$MACSLB).XXNMDCB 07537965 * DCB FOR THE MACRO LIBRARY FETCH OPTION 07537970 XXLIBDCB DCB DSORG=PO,DDNAME=&$IOUNIT(6),MACRF=R,EODAD=XXMCEODD 07537975 .XXNMDCB ANOP 07537980 SPACE 1 07538000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07539000 *--> DSECT: XIOBLOCK CONTROL BLOCK FOR INPUT/OUTPUT MACROS * 07540000 * THIS BLOCK IS CREATED FOR ANY I/O MACRO BY THE INNER MACRO * 07540100 * XIONR, AND CONTAINS THE ADCON FOR THE DESIRED I/O ENTRYPOINT,* 07540200 * SAVE WORDS FOR MODFIED REGS R14,R15,R0, AND THE LENGTH FOR * 07540300 * THE I/O AREA TO BE READ OR WRITTEN. * 07540400 * THIS DSECT IS ONLY USED IN CSECT XXXXIOCO. * 07540500 * GENERATION: BY MACRO XIONR (FOR $READ,$SORC,$PRNT,$PNCH). * 07540600 * NAMES: XIO----- * 07540700 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07540800 SPACE 1 07540900 XIOBLOCK DSECT 07542000 DS V . @ I/O ROUTINE 07544000 DS 3F AREA FOR REGS 15-0 TO BE SAVED 07546000 XIOLENG DS AL2 . LENGTH OF RECORD, (CODES-FUTURE USE) 07548000 XIORETRN LM 14,0,4(14) RETURN CODE FOR RESTORING REGISTERS 07550000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07555025 *-> LIBRARY DSECT -- XLBDSECT * 07555050 * * 07555100 * DESCRIBES LIBRARY BUFFER SPACE AND CONTROL WORDS * 07555150 * * 07555200 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07555250 SPACE 1 07555300 XLBDSECT DSECT 07555350 XLBUFLNG DS F CONTROL WORD 1 => TOTAL LENGTH 07555400 XLBUFEND DS F CONTROL WORD 2 => PERMENENT BUFFER 07555450 * END 07555500 XLBUFSTR DS F CONTROL WORD 3 => START OF BUFFER 07555550 XLBUFCED DS F CONTROL WORD 4 => END OF BLOCK 07555600 XLBUFCNT EQU *-XLBUFLNG LENGTH OF CONTROL SECTION OF BUFFER 07555650 XLIBBUF DS F ACTUAL BUFFER STARTS HERE 07555700 SPACE 5 07555750 DROP R11,R13,R14 AJOBCON,BASE REG, XIOBLOCK 07556000 TITLE '*** XXSNAPC DSECT - XSNAP CONTROL BLOCK ***' 07556100 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07556150 *--> DSECT: XXSNAPC CONTROL BLOCK USED BY THE XSNAP MACRO * 07556200 * THIS BLOCK IS CREATED BY EVERY PRINTING XSNAP MACRO. IT * 07556300 * CONTAINS THE EXACT CONTENTS OF THE GP REGISTERS BEFORE THE * 07556400 * XSNAP WAS CALLED, A FLAG BYTE INDICATING DESIRED OUTPUT AND * 07556500 * SPECIAL OPTIONS, THE NUMBER OF ADDRESS PAIRS USED IN THE * 07556600 * XSNAP STORAGE= OPERAND, THE ADDRESS PAIRS THEMSELVES, AND * 07556700 * THE ADDRESS CONSTANT FOR XXXXSNAP. THE BYTE XXSFLAGS MAY * 07556800 * HAVE SEVERAL BITS TURNED ON REQUESTING SPECIAL ASSIST * 07556900 * SERVICES, SUCH AS USER DEBUGGING OUTPUT AND USER DUMP. THE * 07557000 * BITS ARE SUPPLIED BY XSNAP OPERAND T(3), AND HAVE * 07557100 * MEANING ONLY WHEN USED INSIDE ASSIST WITH THE SPECIAL ASSIST * 07557200 * VERSION OF THE CSECT XXXXSNAP. * 07557300 * GENERATION: XSNAP MACRO, WITH T= ANY TYPE BUT ST OR STORE. * 07557400 * NAMES: XXS----- * 07557500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07557600 SPACE 1 07558000 XXSNAPC DSECT 07560000 XXSGPRG EQU B'00000001' (XXSFLAGS)=> PRINT GP REGS 07562000 XXSFLRG EQU B'00000010' (XXSFLAGS)=> PRINT FL REGS 07564000 XXSAVTR EQU B'00000100' (XXSFLAGS)=> SAVE AREA TRACE(FUTURE) 07566000 XXSASNAP EQU B'00010000' (XXSFLAGS)=> ASSIST EXECUTE SNAP 07568000 XXSASDMP EQU B'00100000' (XXSFLAGS)=> ASSIST FINAL DUMP 07570000 SPACE 1 07571000 XXSRGSAV DS 16F REGISTER AREA, REGS SAVED BY XSNAP 07572000 XXSFLAGS DS B OPTION BYTE FLAG 07574000 DS AL1 **** UNUSED AS OF VERSION 4.0*** 07576000 XXSLABLN DS AL1 LENGTH OF THE LABEL FIELD 07578000 XXSNMSTR DS AL1 NUMBER OF @ PAIRS IN STORAGE= LIST 07580000 DS V(XXXXSNAP) ADCON FOR CALL TO XXXXSNAP ROUTINE 07582000 XXSADSTR DS 0A STORAGE = ADDRESS LIST(OPTIONAL) 07584000 TITLE '*** XXXXSNAP-DEBUGGIN,DUMPING MODULE- V.4.0.AS ***' 07586000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07588000 * JOHN R. MASHEY - MAY 1969 * 07590000 * VERSION 4.0 - FEBRUARY 1970 * 07592000 * VERSION 4.0.AS(SIST) FEB 1970 * 07593000 * IBM 360/67 ASSEMBLER 'G' * 07594000 * PENNSYLVANIA STATE UNIVERSITY * 07596000 * ABSOLUTE REGISTER EQUATES AND USAGE * 07598000 * EQU'S HAVE BEEN CHANGED TO COMMENTS TO PREVENT MULTIPLE* 07600000 * DEFINITION WHEN ASSEMBLING AS PART OF ASSIST. * 07602000 *R0 EQU 0 WORK REGISTER * 07604000 *R1 EQU 1 USED AS WORK REGISTER * 07606000 *R2 EQU 2 USED TO HOLD 1ST ADDRESS OF PAIR * 07608000 *R3 EQU 3 USED TO HOLD SECOND ADDRESS OF PAIR* 07610000 *R4 EQU 4 USED AS INCREMENT FOR BXLE'S * 07612000 *R5 EQU 5 LIMIT ADDRESS IN VARIOUS BXLE'S * 07614000 *R6 EQU 6 WILL CONTAIN CVTMZ00(HIGHEST ADDR) * 07616000 *R7 EQU 7 OLD ADDRESS IN SAME LINE CHECK * 07618000 *R8 EQU 8 INTERNAL LINKAGE REGISTER * 07620000 *R9 EQU 9 ADDRESS OF CURRENT ADDRESS PAIR * 07622000 *R10 EQU 10 POINTS TO XSNAP LABEL,REGISTER AREA* 07624000 *R11 EQU 11 @ ECONTROL BLOCK, RELOCATION VALUE * 07626000 * THIS VALUE IN R11 ONLY IF XXSFLAGS HAS XXASNAP OR XXASDMP ON.* 07626500 *R12 EQU 12 # STORAGE= ADDRESS PAIRS TO DO * 07628000 *R13 EQU 13 BASE REGISTER/@ DUMMY SAVE AREA * 07630000 *R14 EQU 14 RETURN ADDR,POINTER TO LABEL LENGTH* 07632000 *R15 EQU 15 ENTRY POINT REGISTER * 07634000 * EQUREGS L=F,DO=(0,6,2) SET UP FLOATING EQU'S * 07636000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07638000 SPACE 1 07640000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07642000 * XSNAP CONTROL BLOCK AND POINTERS ON ENTRY TO XXXXSNAP. * 07644000 * FIELD LENGTH(BYTES) DESCRIPTION/PURPOSE * 07646000 * LABEL LABLN LABEL=, PADDED TO FULLWORD WITH ' '* 07648000 * R10===>RGSAV 64 16 FULLWORDS, WHERE REGS WERE SAVED* 07650000 * FLAGS 1 BYTE FOR OPTION BITS * 07652000 * BIT 2 = 1 ==> ASSIST COMPLETION FINAL DUMP * 07652500 * BIT 3 = 1 ==> XSNAP USER DEBUGGING DUMP(XDUMP) * 07653000 * BIT 6 = 1 ==> PRINT FP REGISTERS. IF =0, DO NOT * 07654000 * BIT 7 = 1 ==> PRINT GP REGISTERS. IF =0, DO NOT * 07656000 * UNUSED 1 FOR FUTURE USE, NOT USED IN V.4.0 * 07658000 * LABLN 1 LENGTH OF THE LABEL FIELD * 07660000 * NMSTR 1 # 8-BYTE @ PAIRS IN STORAGE= LIST * 07662000 * ADCON 4 V(XXXXSNAP) FOR CALL * 07664000 * ADSTR NMSTR*8 STORAGE= @ LIST, IF PRESENT * 07666000 * INSTRUCTS 10 3 INSTRUCTIONS - LA, L, BALR * 07668000 * R14===>LM 0,15,0(10) RETURN POINT, RELOADS REGISTERS * 07670000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07672000 EJECT 07674000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07674025 *--> CSECT: XXXXSNAP DEBUGGING OUTPUT, COMPLETION DUMP * 07674050 * THIS MODULE PROVIDES ALL REGISTER AND STORAGE DUMPING FOR * 07674100 * DEBUGGING PURPOSES, BOTH FOR INTERNAL ASSIST DEBUGGING, AND * 07674150 * FOR USER PROGRAMS DURING EXECUTION. IT IS CALLED BY THE * 07674200 * MACRO XSNAP (XDUMP PSEUDO-INSTRUCTION FOR USER PROGRAMS), * 07674250 * AND PRODUCES A USER DUMP OR DEBUGGING OUPUT IF THE CALLING * 07674300 * XSNAP SPECIFIED A BINARY VALUE FOR OPERAND T(3). * 07674350 * ENTRY CONDITIONS * 07674400 * SEE XSNAP CONTROL BLOCK AND POINTERS ON ENTRY TO XSNAP COMMENTS. * 07674450 * ALSO, IF SPECIAL ASSIST OUTPUT IS DESIRED I.E. T(3) IS USED, THE * 07674500 * WORD IN XXSRGSAV WHERE REGISTER R10 WAS SAVED MUST CONTAIN THE * 07674550 * ADDRESS OF THE ECONTROL DUMMY SECTION, WHICH SUPPLIES VALUES * 07674600 * EXIT CONDITIONS * 07674650 * ALL REGISTERS AND CONDITION CODE ARE RESTORED TO ORIGINAL VALUES * 07674700 * AFTER EXECUTION OF THE INSTRUCTION AT THE RETURN POINT. * 07674750 * USES DSECTS: ECONTROL,XXSNAPC * 07674800 * USES MACROS: $PRNT(IF &$DEBUG=1), OPEN,PUT(IF&$DEBUG=0) * 07674850 * NAMES: XX------ , ALL NAMES ADDED FOR ASSIST: XXAS---- * 07674900 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07674950 SPACE 1 07675000 XXXXSNAP CSECT 07676000 USING XXXXSNAP,R15 NOTE TEMPORARY ENTRY USING 07678000 USING XXSNAPC,R10 NOTE POINTER TO BLOCK 07680000 CNOP 0,4 MAKE SURE ALIGNED ON FULLWORD 07684000 BAL R13,*+76 SET UP BASE AND SAVE AREA @ 07686000 USING *,R13 NOTE USING FOR BASE/SAVE AREA 07688000 XXSSAVE DS 18F FAKE SAVE AREA FOR OS TO SAVE INTO 07690000 ORG XXSSAVE ORG BACK 07692000 XXDWORK DS 4D OVERLAP FLT WORK AREAS INTO FAKE SAV 07694000 ORG 07696000 DROP R15 CLEAR TEMPORARY USING 07698000 ST R14,XXSAVE14 SAVE RETURN ADDRESS,CC PROG MAKS 07700000 L R11,XXSRGSAV+4*R10 GET PTR (WAS IN R10) 07701000 USING ECONTROL,R11 NOTE POINTER TO ECONTROL BLOCK 07701500 SPACE 2 07702000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07740000 * GET ADDRESS OF LABEL FROM FIRST POSITION IN ADDRESS LIST, * 07742000 * AND USING REGISTER 10(THE ADDRESS OF THE REGISTER SAVE AREA) * 07744000 * FIND THE LENGTH OF THE LABEL AND PRINT THE LABEL & HEADER LINE. * 07746000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07748000 SPACE 2 07750000 XXOPENOK SR R2,R2 CLEAR FOR INSERTION 07752000 BAL R8,XXSNBLNC MAKE SURE XXLABEL BLANK, CC = 0 07753000 TM XXSFLAGS,XXSASDMP ARE WE IN ASSIST FINAL DUMP 07754000 BZ XXASNDMP NO, SO SKIP NEXT SECTION OF CODE *** 07756000 EJECT 07758000 * FOLLOWING SECTION PRINTS HEADER,COMPLETION CODE,PSW, * 07760000 * AND INSTRUCTION TRACE(OPTIONAL) FOR AN ASSIST FINAL DUMP * 07762000 SPACE 1 07764000 MVC XXLABEL(L'XXAS1HD),XXAS1HD MOVE FIRST HDR, 1 CC IN 07766000 BAL R8,XXPRINTP GO TO PRINT AS DESIRED J 07767000 BAL R8,XXSNBLNC REBLANK XXLABEL, MAKE CC = 0 AGAIN 07768000 SPACE 1 07770000 MVC XXAS2HD,=C'*** PSW AT ABEND' 07771000 MVC XXAS2CC,=C'COMPLETION CODE' MOVE HDR IN 07771500 UNPK XXAS2P1,ECPSW(5) FIRST HALF OF PSW 07772000 UNPK XXAS2P2,ECPSWRT(5) 2ND HALF OF PSW 07774000 TR XXAS2P1(2*L'XXAS2P1-1),XXTAB1 FIND CONVERSION 07776000 MVI XXAS2P1+8,C' ' BLANK BETWEEN PARTS OF PSW 07778000 MVI XXAS2P2+8,C' ' BLANK AFTER 2ND PART OF PSW 07780000 SPACE 1 07782000 L R1,ECERRAD GET @ ERROR BLOCK 07784000 USING ERCOMPCD,R1 NOTE THE POINTER 07786000 MVC *+7(1),ERCLENG MOVE LENGTH-1 OVER 07788000 MVC XXAS2MS($CHN),ERCMSSG MOVE MESSAGE OVER 07792000 SPACE 1 07794000 IC R2,ERCTYPE GET TYPE OF COMPLETION 07796000 SLL R2,3 MULT * 8 FOR INDEX TO TABLE 07798000 DROP R1 NOTE NO LONGER USING BLOCK PTR 07800000 LA R1,XXAS2TPM(R2) GET @ COMPLETION TYPE 07802000 MVC XXAS2TP,0(R1) MOVE THE TYPE INTO MESSAGE 07804000 BAL R8,XXPRINTL PRINT ASSEMBLED XXLABEL 07806000 BAL R8,XXSNBLNK REBLANK XXLABEL 07808000 SPACE 1 07812000 TM ECFLAG3,$ECDINST SHOULD THERE BE INSTRUCTION TRACE 07814000 BZ XXASREGS NO,SO DON'T PRINT INSTRUCTIONS 07816000 LA R0,XXAS3HD SHOW @ THIS HEADER 07822000 BAL R8,XXPRINT PRINT 07824000 SPACE 1 07826000 LA R0,XXAS4HD SHOW @ OF THIS LABEL 07828000 BAL R8,XXPRINT PRINT (R0=@ XXLABEL STILL) 07830000 SPACE 1 07834000 L R9,ECRSTK GET @ CURRENT INSTRUCTION STACK 07836000 XXASIN LA R0,XXLABEL SUBSEQUENT PRINTING IS FROM XXLABEL 07837000 LR R12,R9 SAVE @ FOR COMPARISON IN LOOP 07838000 USING ECSTACKD,R9 NOTE DSECT FOR EACH STACK ENTRY 07840000 SPACE 1 07842000 * FIRST LOOP SEARCHES FOR 1ST ACTUAL INSTRUCTION IN THE * 07844000 * INSTRUCTION STACK. CHECK REQUIRED IN CASE OF PROGRAM WHICH * 07846000 * BOMBS ON 1ST INSTRUCTION, SUCH AS BEGINNING WITH DC H'0'. * 07848000 XXASINA L R9,ECSTLINK GET @ NEXT INSTRUCTION ENTRY 07850000 CLI ECOP,0 WAS THIS AN INSTRUCTION 07852000 BNE XXASINB YES,SKIP TO BEGIN PRINTING 07854000 CR R9,R12 CHECK FOR COMPLETE CYCLE 07856000 BNE XXASINA NOT CYCLE,LOOP UNTIL 1ST INST 07858000 AIF (NOT &$EXINT).NOXXIN1 07859000 C R9,ECBSTK IF THIS IS NOT THE BRANCH STACK THEN 07859100 BNE XXASINB PRINT OUT THE ONE INSTRUCTION TRACE 07859200 MVC XXLABEL+1(L'XXAS8HD),XXAS8HD IF THIS IS THE BRANCH STK 07859300 BAL R8,XXPRINT THEN PRINT OUT A MESSAGE THAT THERE 07859400 MVC XXLABEL+1(L'XXLABEL-1),XXBLANKS+1 REBLANK PRINT AREA 07859450 B XXASREGS WERE NO BRANCHES AND DUMP REGISTERS 07859500 .NOXXIN1 ANOP 07859600 SPACE 1 07860000 * HAVING FOUND 1ST ACTUAL INSTRUCTION, OR SINGLE OPCODE * 07862000 * OF 0 IN INSTRUCTION CYCLE, PRINT 1 OR MORE INSTRUCTIONS. * 07864000 XXASINB EQU * BUILD TRACE LINE TO BE PRINTED 07866000 AIF (NOT &$VIRT).VIXXAS1 SKIP DUMP CHGS. IF NOT VIRT 07868050 SPACE 1 07868100 ** IF THIS IS A PSW SWAP, MUST FORMAT DIFFERENTLY 07868150 CLI ECVFLG,0 IF NOT A PSW SWAP,/ 07868200 BE VIXXAS1 --RETURN TO NORMAL PROCESSING 07868250 MVC VIXXAS10,VIXXAS12 MOVE IN STANDARD PART OF SWAP MSG. 07868300 MVC VIXXAS11,ECVTYP+1 COMPLETE TRACE MESSAGE 07868450 B XXASIND MERGE WITH NORMAL PROCESSING 07868550 SPACE 1 07868600 .VIXXAS1 ANOP 07868650 VIXXAS1 MVC XXAS5I2(10),XXBLANKS BLANK HALFWORDS 2-3 07872000 SPACE 1 07874000 UNPK XXAS5I1(5),ECOP(3) CONVERT OPCODE REGS/LENGTH (ALWAYS) 07876000 MVI XXAS5I1+4,C' ' BLANK TRAILING BYTE 07878000 TR XXAS5I1(4),XXTAB1 FINISH HEX CONVERSION 07879000 CLI ECOP,X'40' WAS INSTRUCTION RR 07880000 BL XXASIND YES,SO DO NO MORE ON INSTR 07882000 SPACE 1 07884000 UNPK XXAS5I2(5),ECBD(3) UNPACK FIRST BASE-DISPLACEMENT 07886000 MVI XXAS5I2+4,C' ' BLANK TRAILING BYTE 07890000 TR XXAS5I2(4),XXTAB1 FINISH HEX CONVERSION 07891000 CLI ECOP,X'C0' WAS INST RX,RS,SI 07892000 BL XXASIND YES,SO NO MORE CONVERT NEEDED 07894000 SPACE 1 07896000 UNPK XXAS5I3(5),ECB2D2(3) UNPACK 3RD HALFWORD- 2ND BASE-DISP 07898000 MVI XXAS5I3+4,C' ' BLANK TRAILING BYTE 07900000 TR XXAS5I3(4),XXTAB1 FINISH HEX CONVERSION 07902000 XXASIND UNPK XXAS5CC(3),ECSTIADD(2) CONVERT GOOD ILC/CC/PM 07904000 UNPK XXAS5AD(7),ECSTIADD+1(4) CONVERT INST ADDRESS 07910000 MVI XXAS5AD+6,C' ' BLANK TRAILING BYTE 07912000 TR XXAS5CC(10),XXTAB1 FINISH HEX OF ILC-CC-PM & ADDRESS 07914000 MVC XXAS5CC+2(2),=CL2' ' RESET SPACING BLANKS 07915000 SPACE 1 07918000 AIF (NOT &$EXINT).NOXXIN2 07919000 C R9,ECBSTK IF THIS IS LASST INSTR FOR BRANCH 07919200 BE XXASINP THEN NO ERROR POINTER REQUIRED 07919400 .NOXXIN2 ANOP 07919600 CR R9,R12 WAS THIS LAST ONE 07920000 BNE *+10 BRANCH OVER MVC IF NOT LAST ONE 07922000 MVC XXLABEL+2+XXAS5$L(L'XXAS5P),XXAS5P MOVE ERR PTR 07924000 XXASINP BAL R8,XXPRINT PRINT ASSEMBLED XXLABEL 07926000 CR R9,R12 WAS THIS THE LAST 1(ABENDING INSTR) 07928000 L R9,ECSTLINK GET @ NEXT ENTRY IN TABLE 07930000 BNE XXASINB GOBACK FOR NEXT ENTRY IN TABLE 07932000 SPACE 1 07934000 XXASINE MVC XXLABEL+1(XXAS5$L+2+L'XXAS5P),XXBLANKS REBLANK 07936000 DROP R9 LEFTOVER STACK POINTER NOT NEEDED 07938020 AIF (NOT &$EXINT).NOXXIN3 07938050 L R9,ECBSTK GET BRANCH STACK ADDRESS 07938100 CR R9,R12 IF EQUAL TO R12 THEN WE JUST DID 07938150 BE XXASREGS BRANCH STACK, SO PRINT REGISTERS 07938200 SPACE 2 07938340 LA R0,XXAS7HD GET ADDR 1ST BRANCH TRACE HEADER 07938360 BAL R8,XXPRINT BRANCH, AND PRINT THES HEADER 07938380 SPACE 2 07938400 LA R0,XXAS4HD GET ADDR 2ND BRANCH TREE HEADER 07938420 BAL R8,XXPRINT PRINT THIS HEADER 07938440 MVI XXLABEL,C' ' SINGLE SPACE FOR BRANCH TRACE 07938460 B XXASIN PROCESS BRANCH STACK TRACE 07938500 .NOXXIN3 ANOP 07938520 SPACE 2 07938540 SPACE 1 07940000 * FINAL DUMP==> EITHER PRINT ALL REGS OR NONE * 07942000 XXASREGS MVI XXLABEL,C'0' DOUBLE SPACE REST OF MESSAGES CPP 07944000 TM ECFLAG3,$ECREGS SHOULD WE GIVE REGISTERS 07945000 BO XXASREG1 YES,SO GO DO IT 07946000 B XXCHKST NO REGS AT ALL 07948000 EJECT 07950000 XXASNDMP EQU * ENTRY LABEL FOR NORMAL XSNAP 07952000 IC R2,XXSLABLN GET LENGTH OF LABEL FIELD 07954000 LR R1,R10 GET DUPLICATE OF XXSNAPC PTR 07956000 SR R1,R2 SUBTRACT TO GET START @ FOR LABEL 07958000 BCTR R2,0 DECREMENT TO LENGTH-1 FOR MVC 07960000 STC R2,*+5 STORE INTO MVC 07962000 MVC XXLABEL+38($CHN),0(R1) MOVE LABEL TO PRINT AREA 07964000 ST R1,XXWORK1 SAVE THIS @ FOR CONVERSION 07966000 MVC XXWORK1(1),XXSAVE14 MOVE CCMASK OVER FOR CONVERSION 07968000 SPACE 1 07969000 TM XXSFLAGS,XXSASNAP IS THIS A USER SNAP 07970000 BZ *+10 NO,SO DON'T CHANGE PSW 07972000 MVC XXWORK1(4),ECPSWRT MOVE USER PSW (RIGHT SIDE) OVER 07974000 MVC XXLABEL+1(XXSN1B),XXSNP1ST MOVE HEADER,PATTERN,MSG 07976000 ED XXLABEL+L'XXSNP1ST+1(6),XXCOUNT EDIT CALL NUMBER 07978000 UNPK XXLABEL+1+XXSN1B(9),XXWORK1(5) CONVERT CCPM,LOCN 07980000 TR XXLABEL+1+XXSN1B(8),XXTAB1 FINISH HEX CONVERSION 07982000 AP XXCOUNT,=P'1' INCREMENT # CALLS 07984000 BAL R8,XXPRINTL PRINT ASSEMBLED XXLABEL 07988000 BAL R8,XXSNBLNK REBLANK XXLABEL 07990000 SPACE 2 07992000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07994000 * CHECK TO SEE IF THE REGISTERS SHOULD BE PRINTED. * 07996000 * PRINT THE HEADING FOR THE REGISTER DUMP. CONVERT AND PRINT * 07998000 * THE REGISTERS IN 2 LINES. CHECK TO SEE IF ONLY THE REGISTERS * 08000000 * WERE DESIRED. FINISH UP AND RETURN TO CALLING XSNAP IF SO. * 08002000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08004000 SPACE 2 08006000 TM XXSFLAGS,XXSGPRG DOES HE WANT GP REGS PRINTED 08008000 BZ XXCHKFP NO, SO DONT PRINT THEM 08010000 LR R2,R10 DUPLICATE @ RGSAV OVER 08012000 TM XXSFLAGS,XXSASNAP WAS THIS USER XSNAP 08014000 BZ XXGOREG NO,NORMAL XSNAP,SKIP 08016000 XXASREG1 LA R2,ECREGS SHOW @ FAKE REGS INSTEAD 08018000 XXGOREG EQU * ***WE HAVE DELETED REG HEADER** J 08020000 SPACE 1 08023000 MVC XXREGOUT(12),=CL12'0 REGS 0-7' LABEL-1ST REGS 08024000 BAL R8,XXREGS1 CONVERT 1>T REGS BLOCK,PRINT LINE 08026000 BAL R8,XXPRINT HAVE LINE PRINTED 08028000 SPACE 1 08029000 MVC XXREGOUT(12),=CL12' REGS 8-15' 2ND LINE LABEL 08030000 BAL R8,XXREGS2 GET 2ND GROUP CONVERTED,PRINTED 08032000 BAL R8,XXPRINT HAVE LINE PRINTED 08034000 SPACE 1 08035000 XXCHKFP EQU * 08036000 AIF (NOT &$FLOTM).XXS2 SKIP IF MACHINE DOEN'T HAVE FLOT 08038000 TM XXSFLAGS,XXSFLRG DOES HE WANT FLOATING PT REGS PRINT 08040000 BZ XXCHKST NO,SO GO CHECK FOR STORAGE= 08042000 SPACE 1 08044000 * FOLLOWING SECTION PRINTS FLOATING POINT REGISTERS * 08046000 MVC XXREGOUT(12),=CL12'0 FLTR 0-6' MOVE LABEL IN 08048000 LA R2,ECFPREGS SHOW @ FAKE REGS 08050000 TM XXSFLAGS,XXSASDMP+XXSASNAP WAS THIS ASSIST SNAP/DUMP 08052000 BNZ XXFPCONV GO CONVERT THEM 08054000 STD F0,XXDWORK SAVE REG F0 08056000 STD F2,XXDWORK+8 SAVE F2 08058000 STD F4,XXDWORK+16 SAVE F4 08060000 STD F6,XXDWORK+24 SAVE F6 08062000 LA R2,XXDWORK SET UP @ WORKAREA FOR XXREGS1 08064000 XXFPCONV EQU * 08066000 BAL R8,XXREGS1 CALL GP REG CONVERTER 08068000 MVC XXREGOUT+24(12),XXREGOUT+28 PUT F0 TOGETHER 08070000 MVC XXREGOUT+48(12),XXREGOUT+52 PUT F2 TOGETHER 08072000 MVC XXREGOUT+72(12),XXREGOUT+76 PUT F4 TOGETHER 08074000 MVC XXREGOUT+96(12),XXREGOUT+100 PUT F6 TOGETHER 08076000 BAL R8,XXPRINT PRINT THE ASSEMBLED LINE 08078000 MVC XXREGOUT,XXBLANKS REBLANK LINE LIKE ITS SUPPOSED TO BE 08080000 .XXS2 ANOP 08082000 SPACE 1 08084000 XXCHKST EQU * 08086000 SR R12,R12 CLEAR FOR INSERTION 08088000 IC R12,XXSNMSTR GET # OF ADDRESS PAIRS 08090000 LTR R12,R12 ARE THERE ANY @ PAIRS 08092000 BZ XXEXIT1 NO STORAGE=, SO QUIT 08094000 LA R9,XXSADSTR INIT R9 TO @ FIRST ADDRESS PAIR 08096000 LA R4,4 SET UP BXLE INDEX FOR REST OF PROG 08098000 SPACE 1 08100000 TM XXSFLAGS,XXSASNAP+XXSASDMP ARE SPECIAL @ GAMES NEEDED 08102000 BZ XXASTA SKIP IF NOT (I.E. NORMAL XSNAP) 08104000 TM XXSFLAGS,XXSASDMP WAS THIS A DUMP? 08106000 BZ XXAST SKIP IF JUST SNAP 08108000 TM ECFLAG3,$ECSTORG SHOULD STORAGE BE DUMPED 08110000 BZ XXEXIT3 NO STORAGE,SO QUIT 08112000 MVC XXLABEL(L'XXAS6HD),XXAS6HD MOVE IN STORAGE DUMP HEADER 08114000 BAL R8,XXPRINTP GO PRINT AS DESIRED J 08115000 BAL R8,XXSNBLNC REBLANK XXLABEL, MAKE SURE CC = 0 08116000 SPACE 1 08117000 XXAST L R6,ECRADH GET REAL HIGH LIMIT @ 08118000 TM ECFLAG0,$ECPROT WAS ABSOLUTE PROTECT MODE ON 08119000 L R11,ECRELOC GET EXECUTION TIME RELOCATION FACTOR 08120000 BZ XXASTB NO, SKIP, RESET TO NORMAL LIMIT 08121000 DROP R11 NOTE NO LONGER USING WITH ECONTROL 08122000 LCR R11,R11 MAKE NEGATIVE,SO CAN USE IN LA'S 08124000 B XXASTC SKIP TO BEGIN PROCESSING 08126000 * NOTE ASSIST DUMP REQUIRES USER CORE TO BEGIN ON REAL * 08128000 * ADDRESS DIVISIBLE BY 32,TO GET REASONABLE OUTPUT. * 08130000 SPACE 1 08132000 * THE FOLLOWING 2 LINES HELP US PREVENT 0C5'S * 08134000 XXASTA SR R11,R11 SET RELOCATION TO 0 (NORMAL XSNAP) 08136000 AIF (NOT &$ASMLVL).XXASDOS SKIP IF OTHER THAN OS/360 08137000 XXASTB L R6,16 CVT PTR **********OS/360 ONLY ****** 08138000 L R6,164(R6) GET CVTMZ000 - HIGHEST CORE @ 08138050 .XXASDOS AIF (&$ASMLVL).XXASNOS SKIP IF OS/360, CAN GET SIZ FROM CVT 08138100 XXASTB COMRG R1 <- @ OF COMMUNICATIONS REGION 08138200 L R6,48(R1) GET @ OF END OF MACHINE (DOS) 08138230 LA R6,1(R6) GET @ ON NEXT NON-AVAIL BYTE 08138240 .XXASNOS ANOP 08138300 XXASTC EQU * R6 NOW = HIGHEST LEGAL ADDR. +1 CP 08142000 EJECT 08144000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08146000 * SECTIONS XXMEMA - XXMEME SERVE TO PROCESS 1 ADDRESS PAIR * 08148000 * FROM THE LIST OF ADDRESS PAIRS SPECIFYING STORAGE TO BE DUMPED. * 08150000 * AT XXMEMF,THE 2ND ADDRESS IS TESTED TO SEE IF IT IS THE LAST ONE * 08152000 * AND THE DUMP COMPLETED IF SO. OTHERWISE,A BRANCH IS TAKEN BACK * 08154000 * TO XXMEMA TO PROCESS THE NEXT ADDRESS PAIR. * 08156000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08158000 SPACE 2 08160000 XXMEMA LM R2,R3,0(R9) OBTAIN NEXT ADDRESS PAIR 08162000 LA R0,0(R11,R2) RELOCATE ADDRESS IF NEEDED 08164000 ST R0,XXWORK1 SAVE FOR CONVERSION 08166000 UNPK XXCOREL,XXWORK1+1(4) CONVERT WITH TRAILING BLANK 08168000 LA R0,0(R11,R3) GET HIGH ADDRESS,RELOCATE 08170000 BCTR R0,0 END ADDR. = LAST ADDR. PASSED -1 08170500 ST R0,XXWORK1 SAVE FOR CONVERT 08172000 UNPK XXCOREH,XXWORK1+1(4) CONVERT WITH TRAILING BLANK 08174000 TR XXCOREL(17),XXTAB1 TRANSLATE TO COMPLETE HEX CONVERT 08176000 MVC XXCOREL+7(2),=C'TO' PUT REST OF MSG IN 08178000 MVC XXCORETL,=C'CORE ADDRESSES SPECIFIED-' PUT IN MSG 08180000 BAL R8,XXPRINTL PRINT XXLABEL 08181000 MVC XXCORETL(XXCORE$L),XXBLANKS+30 REBLANK THE AREA 08182000 SPACE 1 08183000 CR R3,R6 MAKE SURE HIGH ADDR ISN'T TOO HIGH 08184000 BNH *+6 SKIP OVER IF NOT TOO HIGH 08186000 LR R3,R6 @ WOULD 0C5-USE HIGHEST INSTEAD 08188000 LA R3,31(R3) PREPARE TO ROUND 2ND ADDR UPWARD 08190000 SRDL R2,5 ROUND BOTH ADDRESSES 08192000 SLL R2,5 NOW HAVE 1ST ADDR IN R2,ROUNDED DOWN 08194000 SLL R3,5 NOW HAVE HIGH ADDR IN R3,ROUNDED UP 08196000 CR R2,R3 WAS USER IN ERROR: LOW ADDR>HIGH ADD 08198000 BH XXMEMF ADDR ERROR-PRINT NOTHING,GO TO NEXT 08200000 CR R2,R6 MAKE SURE IF 1ST=2ND>MEMORY SIZE 08202000 BH XXMEMF PRINT NOTHING IF SO 08204000 SPACE 2 08206000 XXMEMB EQU * 08208000 AR R2,R11 RELOCATE IF NEEDED 08210000 ST R2,XXWORK1 STORE BEGINNING ADDR FOR CONVERT 08212000 SR R2,R11 CONVERT BACK TO REAL @ 08214000 LR R7,R2 SAVE BEGINNING ADDRESS FOR SAME CHK 08216000 UNPK XXCORADD+1(7),XXWORK1+1(4) GET BEGINNING ADDRESS 08218000 MVC XXCORE3,0(R2) MOVE 32 BYTES OVER FOR ALPHMERIC TR 08220000 TR XXCORE3,XXTAB2 PERFORM ALPHAMERIC CONVERSION 08222000 SPACE 1 08223000 LA R1,XXCORE1 ADDRESS FOR 1ST BLOCK CONVERSION 08224000 BAL R8,XXMEMP1 GET 1ST BLOCK OF 4 WORDS CONVERTED 08226000 LA R1,XXCORE2 ADDRESS FOR 2ND BLOCK CONVERSION 08228000 BAL R8,XXMEMP1 GET 2ND BLOCK CONVERTED 08230000 SPACE 1 08231000 TR XXCORADD+1(84),XXTAB1 FINISH HEX CONVERSION 08232000 LA R0,XXCORADD ADDRESS OF CORE OUTPUT LINE 08234000 BAL R8,XXPRINT GET 1 CORE LINE PRINTED 08236000 EJECT 08238000 * XXMEMC-XXMEME CHECK FOR DUPLICATE LINES. HAVING FOUND 1 OR * 08240000 * MORE DUPLICATE LINES,CORE IS SCANNED UNTIL A DIFFERENT LINE IS * 08242000 * FOUND,OR THE BLOCK FINISHED,AND THEN PRINTS SAME LINES MESSAGE. * 08244000 SPACE 2 08246000 XXMEMC CR R2,R3 R2 HAS BEEN INCREMENTED-ARE WE DONE 08248000 BNL XXMEMF YES WE'RE DONE WITH THIS SECTION 08250000 CLC 0(32,R7),0(R2) COMPARE PREVIOUS SECTION WITH NEXT 08252000 BNE XXMEMB NOT THE SAME-WILL HAVE TO PRINT LINE 08254000 LA R7,32(R11,R7) INCREMENT TO MAKE RIGHT @,RELOCATE 08256000 ST R7,XXWORK1 SAVE 1ST LINE ADDRESS OF SAME AREAS 08258000 SR R7,R11 CONVERT BACK TO REAL @ 08260000 UNPK XXSAML,XXWORK1+1 1ST STEP TO CONVERT 08262000 SPACE 1 08263000 XXMEMD LA R2,32(R2) INCREMENT TO LOOK AT NEXT SECTION 08264000 CR R2,R3 ARE WE DONE 08266000 BNL XXMEME YES,WE'RE DONE-SAME LINES MESSAGE 08268000 CLC 0(32,R7),0(R2) CHECK NEXT SECTION WITH 1ST OF SAMES 08270000 BE XXMEMD SAME-KEEP LOOPING UNTIL DIFFERENT 08272000 SPACE 1 08273000 XXMEME LA R1,0(R11,R2) GET END @,RELOCATE,WHERE CAN DESTROY 08274000 SH R1,=H'32' DECRMENT SO LINE ADDR RIGHT 08276000 ST R1,XXWORK1 SAVE FOR HEX CONVERSION 08278000 UNPK XXSAMH,XXWORK1+1 CONVERT-FIRST STEP 08280000 TR XXSAML(13),XXTAB1 FINISH HEX CONVERSION OF SAME LINES 08282000 MVI XXSAML+6,C'-' PLACE DASH BETWEEN ADDRESSES 08284000 MVC XXLABEL+1+3(XXSAM$L),XXSAME MOVE SAME LINES MSG OVER 08286000 LA R0,XXLABEL+1 SHOW @ 1 BEYOND CARRIAGE CONTROL 08287000 BAL R8,XXPRINT PRINT THE SAME LINE MESSAGE 08288000 CR R2,R3 HAVE WE MEANWHILE FINISHED BLOCK 08290000 BL XXMEMB NO-KEEP GOING UNTIL BLOCK DONE 08292000 SPACE 1 08293000 XXMEMF LA R9,8(R9) INCREM R9 TO @ NEXT @ PAIR 08294000 MVC XXLABEL+1+3(XXSAM$L),XXBLANKS+1+3 REBLANK AREA 08295000 BCT R12,XXMEMA GO BACK FOR NEXT BLOCK 08296000 B XXEXIT2 ALL STORAGE= DONE, GO RETURN 08298000 EJECT 08300000 * XXEXIT - PRINT ENDING LINE,THEN RETURN TO CALLING XSNAP. * 08302000 SPACE 2 08304000 XXEXIT1 TM XXSFLAGS,XXSGPRG+XXSFLRG WERE EITHER REGS PRINTED 08306000 BZ XXEXIT3 NO OPTIONS, JUST LEAVE SINGLE LINE 08308000 XXEXIT2 EQU * DON'T HAVE TO SET R0, USE XXPRINTL 08310000 BAL R8,XXPRINTL PRINT XXLABEL FOR A BLNKA LINE 08312000 XXEXIT3 L R14,XXSAVE14 RELOAD RETURN @, CC 08314000 SPM R14 RESTORE CONDITION CODE 08316000 BR R14 RETURN TO CALLING XSNAP 08318000 EJECT 08320000 * *** INTERNAL SUBROUTINE AREA *** * 08322000 SPACE 1 08322100 * XXSNBLNC BLANKS XXLABEL, SETS CARRIAGE CONTROL = 0. 08322200 * XXSNBLNK JUST BLANKS XXLABEL, NOT CHANGING CC. 08322300 XXSNBLNC MVI XXLABEL,C'0' MAKE NORMAL DOUBLE SPACE CC 08322400 XXSNBLNK MVC XXLABEL+1(L'XXLABEL-1),XXBLANKS+1 REBLANK ENTIRE AREA 08322500 BR R8 RETURN TO CALLER 08322600 SPACE 2 08324000 * XXREGS1 CONVERTS AND PRINTS 1 LINE OF 8 REGISTERS * 08326000 SPACE 1 08328000 XXREGS1 LA R4,12 INCREMENT FOR BXLE 08330000 LA R5,XXREGOUT+16+7*12 LIMIT ADDRESS FOR BXLE 08332000 XXREGS2 LA R3,XXREGOUT+16 START POINT,INDEX FOR COMING BXLE 08334000 XXREGS3 UNPK 0(9,R3),0(5,R2) CONVERT 1 REGISTER VALUE 08336000 MVI 8(R3),C' ' BLANK OUT EXTRA BYTE USED IN CONVERT 08338000 LA R2,4(R2) INCREMENT POINTER TO REGISTER 08340000 BXLE R3,R4,XXREGS3 LOOP-DO 1 LINE OF 8 REGISTER VALUES 08342000 TR XXREGOUT+16(92),XXTAB1 FOR REST OF HEX CONVERT 08344000 LA R0,XXREGOUT ADDRESS OF OUTPUT LINE 08346000 BR R8 RETURN TO CALLER 08348000 SPACE 2 08350000 * XXMEMP1 CONVERTS 1 BLOCK OF 16 BYTES TO HEX. * 08352000 SPACE 1 08354000 XXMEMP1 LA R5,12(R2) SET UP LIMIT FOR BXLE 08356000 XXMEMP2 UNPK 0(9,R1),0(5,R2) UNPACK 1 WORD OF MEMORY 08358000 MVI 8(R1),C' ' BLANK OUT EXTRA BYTE UNPACKED 08360000 LA R1,9(R1) INCREMENT POINTER TO OUTPUT AREA 08362000 BXLE R2,R4,XXMEMP2 CONTINUE,CONVERTING 16 BYTES 08364000 BR R8 RETURN TO CALLER 08366000 SPACE 2 08368000 * XXPRINTL PRINTS 121 CHARACTERS STARTING AT XXLABEL. * 08370000 * XXPRINT PRINTS 121 CHARACTERS STARTING AT @ IN R0. * 08370050 SPACE 1 08372000 XXPRINTP EQU * ***COME HERE IF MIGHT BE PAGE SKIP POSSIBLE*** J 08373800 XXPRINTL LA R0,XXLABEL SHOW @ XXLABEL 08373900 XXPRINT EQU * 08374000 AIF (&$DEBUG).XXS50 SKIP IF PRODUCTION 08376000 *** XSNAP LABEL='XPRNT LINE',STORAGE=(XXLABEL,XXLABEL+127) CPP 08378000 AGO .XXS60 SKIP 08380000 .XXS50 $PRNT (0),121,XXSNPROV PRINT OUTPUT,GO TO LABEL IF OVERFLOW 08382000 .XXS60 ANOP 08384000 BR R8 RETURN TO CALLER 08386000 EJECT 08386010 * EXIT TAKEN IF RECORD LIMIT OVERRUN. THIS CHECKS TO * 08386020 * SEE IF OUTPUT IS FOR AN EXECUTION-TIME XDUMP, IN WHICH CASE * 08386030 * EXECUTION IS STOPPED, SINCE USER IS OVERRUNNING HIS LIMIT. * 08386040 XXSNPROV EQU * 08386050 TM XXSFLAGS,XXSASNAP WAS THIS A USER SNAP (XDUMP) 08386060 BZ XXEXIT3 NO, FINAL DUMP-WE'RE DONE 08386070 SPACE 1 08386080 * OVERFLOW OCCURED. QUIT, FLAGGING ECONTROL. 08386090 L R11,XXSRGSAV+4*R10 GET PTR TO ECONTROL, WAS IN R10 08386100 USING ECONTROL,R11 NOTE POINTER 08386110 MVI ECFLAG1,$ECRECEX SHOW EXECUT THAT RECORD OVERFLOWED 08386120 B XXEXIT3 GO RETURN CONTROL 08386130 DROP R11 NOT NEEDED ANYMORE 08386140 SPACE 5 08386150 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08390050 *--> ENTRY: XXXXSNIN XXXXSNAP INITIALIZATION ENTRY * 08390100 * CALLED TO INITIALIZE 'XSNAP - CALL' NUMBER TO 1 (IN CASE * 08390200 * BATCHED RUNS ARE USED). * 08390300 * ENTRY CONDITIONS * 08390400 * R14= RETURN ADDRESS * 08390500 * R15= @ XXXXSNIN * 08390600 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08390700 ENTRY XXXXSNIN INITIALIZATION ENTRY FOR ASSIST 08392000 USING XXXXSNIN,R15 NOTE USING 08394000 XXXXSNIN ZAP XXCOUNT,=P'1' INITILZE COUNTER TO 1 08396000 BR R14 RETURN TO CALLER 08398000 SPACE 08400000 EJECT 08402000 * *** OUTPUT LINE,CONSTANT, AND TRANSLATE TABLE AREA *** * 08404000 SPACE 2 08406000 XXSAVE14 DS A SAVE WORD FOR RETURN @, CC,MASK 08408000 XXWORK1 DC F'0',X'04' FIELD + REVERSED BLANK FOR HEX CONVT 08410000 XXCOUNT DC PL3'1' COUNTER FOR NUMBER OF CALLS 08412000 AIF (&$DEBUG).XXS70 SKIP IF PRODUCTION VERSION 08414000 PRINT NOGEN 08416000 ENTRY XXSNDCB SO PEOPLE CAN CHANGE,IF THEY WISH 08418000 AIF (&$ASMLVL).XXSNDTF SKIP IF UNDER OS GENERATION 08418200 XXSNDCB DTFPR DEVADDR=SYSLST,BLKSIZE=121,CTLCHR=YES,IOAREA1=XXSNIOAR, X08418400 WORKA=YES 08418600 XXSNIOAR DC 121C' ' DOS XSNAP IOAREA 08418800 .XXSNDTF AIF (NOT &$ASMLVL).XXS70 SKIP IF UNDER DOS GENERATION 08419000 XXSNDCB DCB DSORG=PS,MACRF=PM,RECFM=FA,LRECL=121,BLKSIZE=121, #08420000 DDNAME=XSNAPOUT,BUFNO=1 08422000 .XXS70 ANOP 08424000 SPACE 1 08425000 DS 0D ALIGN FOR SPEED 08425500 XXSNP1ST DC C'BEGIN XSNAP - CALL' HEADER TITLE 08426000 DC X'402020202021' EDIT PATTERN FOR CALL NUMBER 08428000 DC C' AT ' FOR XSNAP LOCATION MESSAGE 08430000 XXSN1B EQU *-XXSNP1ST LENGTH OF HEADER,NUMBER,LOCATION 08432000 SPACE 1 08433000 DS 0D ALIGN FOR SPEED 08433500 XXSAME DC CL9'LINES' BEGINNING OF SAME LINE MSG 08434000 XXSAML DC CL7' ' LOWEST ADDRESS AREA 08436000 XXSAMH DC CL7' ',C' SAME AS ABOVE' END OF SAME LINES MSG 08438000 XXSAM$L EQU *-XXSAME LENGTH OF MESSAGE 08438500 SPACE 1 08439000 DS 0D ALIGN FOR SPEED 08440000 XXLABEL DC CL121'0' MAIN PRINTING AREA, WITH SKIP CARCON 08442000 DC CL7' ' PAD TO DOUBLEWORD BOUNDARY 08444000 SPACE 1 08445000 DS 0D ALIGN FOR SPEED 08452000 XXBLANKS DC CL121' ',CL7' ' BLANKS, ALSO FOR XXREGLAB PRINTING 08454000 DS 0D ALIGN FOR SPEED 08456000 XXREGOUT DC CL121' ' REGISTER PRINTING AREA 08458000 SPACE 1 08459000 DS 0D ALIGN FOR SPEED 08459500 XXTAB DC C'0123456789ABCDEF' TR TABLE FOR HEX CONVERT 08460000 XXTAB1 EQU XXTAB-240 TO MAKE CONSTANT TR'S EASIER FOR HEX 08462000 SPACE 1 08463000 DS 0D ALIGN FOR SPEED 08463500 XXTAB2 DC 64C'.',C' ',128C'.',C'ABCDEFGHI',7C'.',C'JKLMNOPQR' 08464000 DC 8C'.',C'STUVWXYZ',6C'.',C'0123456789',6C'.' ALPH TR TAB 08466000 SPACE 1 08467000 DS 0D ALIGN FOR SPEED 08467900 XXCORADD DC CL7' ',CL3' ' 10 BYTES - LINE ADDRESS 08468000 XXCORE1 DC 4CL9' ',CL3' ' 39 BYTES - SPACE FOR 4 WORDS 08470000 XXCORE2 DC 4CL9' ',CL3' *' 39 BYTES - SPACE FOR 2ND BLOCK 08472000 XXCORE3 DC CL32' ',C'*' 33 BYTES - ALPHAMERICS + * 08474000 SPACE 1 08475000 ORG XXLABEL+30 ORG BACK TO MAIN LABEL AREA 08476000 XXCORETL DS C'CORE ADDRESSES SPECIFIED-' SPACE FPR HDR 08477000 ORG XXCORETL+30 SPACE UPWARD 08477500 XXCOREL DS CL7,CL3 SPACE FOR LOW ADDR, 'TO ' 08478000 XXCOREH DS CL7' ' SPACE FOR 2ND @ 08479000 XXCORE$L EQU *-XXCORETL GET LENGTH OF HDR 08480000 ORG , RESTORE NORMAL LOCATION CTR 08480500 EJECT 08482000 DS 0D ALIGN FOR SPEED 08484000 XXAS1HD DC C'&$DMPAG*** ASSIST COMPLETION DUMP ***' CPP 08486000 SPACE 1 08488000 ORG XXLABEL+1 ORG BACK TO LABEL PRINTING AREA+1 08490000 XXAS2HD DS C'*** PSW AT ABEND' 08492000 DS C SPACING BYTE 08493000 XXAS2P1 DS CL9 1ST HALF OF PSW 08494000 XXAS2P2 DS CL9 2ND HALF OF PSW 08496000 DS CL6' ' 08498000 XXAS2CC DS C'COMPLETION CODE',CL3' ' SPACE, L' 08500000 XXAS2TP DS CL8 SPACE FOR TYPE-SYTEM,ASSIST,USER = 08502000 DS C' ' 08504000 XXAS2MS EQU * FOR MESSAGE 08506000 ORG , ORG BACK TO NORMAL LOCATION CTR 08508000 SPACE 1 08510000 XXAS2TPM DC CL8'SYSTEM =',CL8'ASSIST =',CL8' USER =' 08512000 SPACE 1 08514000 XXAS3HD DC CL121'0*** TRACE OF INSTRUCTIONS JUST BEFORE TERMINATION#08516000 : PSW BITS SHOWN ARE THOSE BEFORE CORRESPONDING INSTRUCT#08518000 ION DECODED ***' 08520000 SPACE 1 08522000 XXAS4HD DC CL121'0 IM LOCATION INSTRUCTION : IM = PSW BITS 32-#08524000 39 (ILC,CC,MASK)' 08526000 SPACE 1 08530000 ORG XXLABEL+1 ORG BACK INTO MAIN LABEL 08532000 XXAS5HD DS C' ' SPACING 08534000 XXAS5CC DS XL2 ILC-CC-PM 08536000 DS C' ' SPACING 08538000 XXAS5AD DS XL6 PSW ADDRESS 08540000 DS CL5' ' 08542000 XXAS5I1 DS XL5 1ST HALFWORD OF INSTRUCTION 08544000 XXAS5I2 DS XL5 2ND HALFWORD OF INSTRUCTION 08546000 XXAS5I3 DS XL5 3RD HALFWORD OF INSTRUCTION 08548000 XXAS5$L EQU *-XXAS5HD DEFINE LENGTH OF THIS MESSAGE 08550000 AIF (NOT &$VIRT).VIXXAS3 SKIP GENERATING A CONSTANT 08550100 SPACE 1 08550200 ORG XXAS5I1 ORG BACK INTO PRINT LINE 08550300 VIXXAS10 DS CL12'PSW SWAP -- ' SPACE FOR SWAP MESSAGE 08550400 VIXXAS11 DS CL3'***' SPACE FOR SWAP TYPE CODE 08550500 SPACE 1 08550600 .VIXXAS3 ORG , RESTORE LOCATION COUNTER 08551000 XXAS5P DC C'<-- LAST INSTRUCTION DONE - PROBABLE CAUSE OF TERMINAT#08552000 ION' BOMB POINTER MSG 08554000 AIF (NOT &$VIRT).VIXXAS4 SKIP DC'S FOR PSW SWAPS NO VIRT 08555000 SPACE 1 08555100 VIXXAS12 DC CL12'PSW SWAP -- ' 08555200 SPACE 1 08555400 .VIXXAS4 ANOP 08555500 SPACE 1 08556000 XXAS6HD DC C'&$DMPAG*** USER STORAGE ***' CPP 08558000 LTORG 08558050 AIF (NOT &$EXINT).XXASNXT 08558100 SPACE 3 08558200 * THESE LABELS ARE ONLY USED IN THE LAST 10 BRANCH * 08558300 * INSTRUCTION COMPLETION MESSAGE * 08558400 SPACE 2 08558500 XXAS7HD DC CL121'0*** TRACE OF LAST 10 BRANCH INSTRUCTIONS EXECUTED#08558600 ***' 08558700 XXAS8HD DC C' *** NO BRANCHES WERE EXECUTED ***' 08558800 .XXASNXT ANOP 08558900 DROP R10,R13 DROP REGISTERS NO LONGER USED CPP 08562000 TITLE '*** XXXXSPIE ASSIST INTERRUPTS COMMUNICATIONS ***' 08562500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562502 *--> CSECT: XXXXSPIE INTERRUPT CONTROL & COMMUNICATIONS * 08562505 * SCOTT A SMITH - FALL 1971. * 08562510 * THIS IS CALLED ONLY FROM THE MACRO EXPANSION OF $SPIE. IT * 08562515 * CONTAINS THE ONLY MACROS THAT CAUSE LINKAGE TO BE SET UP * 08562520 * BETWEEN THE SUPERVISOR AND THE EXIT ROUTINE FOR INTERRUPT * 08562525 * HANDLING. THE INITIAL COMMUNICATIONS ARE NEVER MADE UNLESS * 08562530 * AT LEAST ONE $SPIE IS EXPANDED. ONLY ONE ACTUAL SUPERVISOR * 08562535 * CALL IS NECESSARY. ALL OTHER $SPIE EXPANSIONS JUST MANI- * 08562540 * PULATE THE CONTROL BLOCKS GENERATED BY THAT EXPANSION. * 08562545 * **NOTE** XXXXSPIE CONTAINS THE ONLY OCCURENCES OF THE * 08562550 * MACROS SPIE (OS) OR STXIT (DOS) * 08562555 * NAMES: XSP----- * 08562560 * * 08562565 * THIS ENTRY HANDLES THE UPDATING OF THE POINTER TO THE * 08562570 * ACTIVE XSPIEBLK . * 08562575 * ENTRY CONDITIONS * 08562580 * R1 = @ NEWLY CREATED ACTIVE XSPIEBLK (OR RESTORED XSPIEBLK) * 08562585 * R14= RETURN ADDRESS * 08562590 * R15= @ ENTRY POINT * 08562595 * EXIT CONDITIONS * 08562600 * R1 = @ LAST PREVIOUS ACTIVE XSPIEBLK * 08562605 * = 0 , IF NO PREVIOUS XSPIEBLK'S EXISTED * 08562610 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562615 SPACE 1 08562620 XXXXSPIE CSECT 08562625 $DBG ,NO SHOW NO DEBUG CODE - $SAVE/$RETURN 08562630 USING XXXXSPIE,REP SHOW OF ENTRY POINT REGISTER USING 08562635 L R0,XSPACBLK GET CURRENT XSPIEBLK @ 08562640 ST R1,XSPACBLK SAVE THE NEW ACTIVE XSPIEBLK @ 08562645 LR R1,R0 RETURN PREVIOUS XSPIEBLK @ 08562650 BR RET ACTIVE XSPIEBLK PTRS CHANGED, RETURN 08562655 DROP REP INFORM ASSEMBLER NO LONGER USING R15 08562660 SPACE 2 08562665 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562667 *--> ENTRY: XXXXSPIN INITIALIZATION OF INTERRUPT COMMUNICATIONS * 08562670 * THE ONLY NECESSARY SPIE(OS) OR STXIT(DOS) IS EXECUTED HERE * 08562675 * TO CATCH ALL INTERRUPTS AND TO REQUEST THE RETURN OF CONTROL * 08562680 * TO THE SAME EXIT ROUTINE HANDLER. AS SUBSEQUENT $SPIE'S * 08562685 * ARE ISSUED, NO SVC IS NEEDED; JUST AN ANALYSIS OF THE * 08562690 * STATUS OF THE ACTIVE CONTROL BLOCK(XSPIEBLK) BY THE COMMON * 08562695 * INTERRUPT EXIT ROUTINE. * 08562700 * USES MACROS: SPIE(OS) OR STXIT(DOS),$SAVE,$RETURN * 08562705 * ENTRY CONDITIONS * 08562710 * R14= RETURN ADDRESS * 08562715 * R15= @ ENTRY POINT * 08562720 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562725 SPACE 1 08562730 ENTRY XXXXSPIN 08562735 XXXXSPIN $SAVE RGS=(R14-R12),SA=XSPYSAVE 08562740 XC XSPACBLK,XSPACBLK SET PREVIOUS XSPIEBLK PTR TO ZERO 08562745 AIF (&$ASMLVL).XSPOS SKIP IF WE ARE IN OS GENERATION 08562750 STXIT PC,XXXXSPEX,XSPYSAVE CATCH ALL PROGRAM CHECKS 08562755 .XSPOS AIF (NOT &$ASMLVL).XSPDOS SKIP IF SET BY DOS GENERATION 08562760 SPIE XXXXSPEX,((1,15)) CATCH ALL PROGRAM EXCEPTIONS 08562765 .XSPDOS ANOP 08562770 $RETURN RGS=(R14-R12) RETURN AFTER ESTABLISHING COMMUNCTS 08562775 SPACE 2 08562780 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562785 *--> INSUB: XXXXSPEX INTERRUPT EXIT ROUTINE * 08562790 * RECEIVES CONTROL FOR ALL INTERRUPTS, REGARDLESS OF @ ON * 08562795 * MOST PREVIOUS $SPIE CALL. XXXXSPEX MONITORS THE INTERRUPT * 08562800 * HANDLING. IT FIRST DETERMINES IF THIS PARTICULAR INTERRUPT * 08562805 * WAS TO BE CAUGHT, SINCE ALL REAL INTERRUPTS WILL EFFEC- * 08562810 * TIVELY BE NAILED. IF IT WAS NOT TO BE CAUGHT, THEN CONTROL * 08562815 * IS RETURNED TO THE SUPERVISOR TO REINITIALIZE EXECUTION * 08562820 * WHERE IT WAS LEFT OFF. ***NOTE*** IT MIGHT BE DESIRABLE * 08562825 * TO INSERT CODE IN THIS CASE TO EITHER PRINT OUT A MESSAGE * 08562830 * OR TO TAKE SOME OTHER ACTION. THE CALLABLE EXIT(IF ANY) IS * 08562835 * GIVEN CONTROL , BUT IT MUST RETURN CONTROL. UPON RETURN * 08562840 * THE PSW IS CHANGED (IF EXIT @ GIVEN) AND SUPERVISOR GETS CNTL* 08562845 * USES DSECTS: XSPIEBLK * 08562850 * THIS ROUTINE PRESERVES THE CONTENTS OF R2-R12 FOR THE * 08562855 * INSPECTION BY THE CALLABLE EXIT ROUTINE. * 08562860 * ENTRY CONDITIONS * 08562865 * R1 = @ OF OS PIE BLOCK (*DOS*MOST LOAD @ INTRPT SAVEAREA(PSW) * 08562870 * R14= RETURN ADDRESS * 08562875 * R15= @ ENTRY POINT