TITLE '*** BROPS2 - BASE REGISTER OPERATIONS - PASS 2 ***' 08564000 **--> CSECT: BROPS2 2 ALL BASE REGISTER OPERATIONS - ALL PASS 2 . . 08566000 *. USES DSECTS: AVWXTABL . 08567000 *. USES MACROS: $RETURN,$SAVE . 08567500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08568000 BROPS2 CSECT 08570000 $DBG A0,SNAP 08572000 ENTRY BRINIT,BRUSIN,BRDROP,BRDISP 08574000 USING AVWXTABL,RAT NOTE MAIN USING 08576000 SPACE 2 08578000 **--> ENTRY: BRINIT 2 INITIALIZE BASE REGISTER TABLES . . . . . . . 08580000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08582000 BRINIT $SAVE SA=NO 08584000 MVC BRVALS(4*16),AWZEROS ZERO OUT VALUE /ID TABLE 08586000 $RETURN SA=NO 08588000 SPACE 2 08590000 **--> ENTRY: BRUSIN 2 ENTER A REGISTER-VALUE PAIR . . . . . . . . . 08592000 *. ENTRY CONDITIONS . 08594000 *. RA = NUMBER OF REGISTER FOR WHICH USING TO BE SET UP = 0-15 . 08596000 *. RB = ADDRESS DECLARED IN USING FOR GIVEN REGISTER = 0-2**24-1 . 08598000 *. RC = ESDID OF THE USING VALUE, IN LOW ORDER BYTE = 1-255 . 08600000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08602000 BRUSIN $SAVE SA=NO 08604000 SLL RA,2 REG #*4 FOR FULLWORD INDEXING 08608000 ST RB,BRVALS(RA) STORE VALUE OF REG IN RIGHT SLOT 08610000 STC RC,BRVALS(RA) STORE ID IN HI-ORDER BYTE 08611000 $RETURN SA=NO 08612000 SPACE 2 08614000 **--> ENTRY: BRDROP 2 DROP A REGISTER FROM USING. . . . . . . . . . 08616000 *. ENTRY CONDITIONS . 08618000 *. RA = NUMBER OF REGISTER TO BE DROPPED FROM USING - = 0-15 . 08620000 *. EXIT CONDITIONS . 08622000 *. RB = 0 THE REGISTER WAS CURRENTLY USABLE . 08624000 *. RB = ^0 THE REGISTER WAS NOT CURRENTLY IN USE . 08626000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08628000 BRDROP $SAVE SA=NO 08630000 SLL RA,2 REG# * 4 FOR INDEX TO TABLE 08631000 LA RB,BRVALS(RA) SET RB^=0, @ WORD FOR DESIRED REG 08632000 CLI 0(RB),0 WAS THE REG IN USE 08634000 BE BRDRRET NO,BRANCH,LEAVING RB^=0-ERROR 08636000 MVI 0(RB),0 SET ID = 0, DEFINITELY DROPPING REG 08638000 SR RB,RB SET RB=0 TO SHOW OK 08640000 BRDRRET $RETURN SA=NO 08642000 EJECT 08644000 **--> ENTRY: BRDISP 2 GIVEN VALUE&ESDID, RETURN BASE-DISPLACEMENT . 08646000 *. ENTRY CONDITIONS . 08648000 *. RA = ADDRESS VALUE TO BE DECOMPOSED TO BASE-DISPLACEMENT (24 BITS). 08650000 *. RB = ESDID OF ADDRESS TO BE DECOMPOSED - LOW ORDER BYTE . 08652000 *. VALUE IS FROM 1-255. 0 CAN BE USED TO MARK NONUSABLE. . 08653000 *. EXIT CONDITIONS . 08654000 *. RA = BASE-DISPLACEMENT FORM OF ADDRESS, IF ADDRESSABLE . 08656000 *. RB = 0 NORMAL RETURN - ADDRESS WAS DECOMPOSABLE . 08658000 *. = ^0 ADDRESSIBILITY ERROR(NO REG,OR DISP TOO LARGE) . 08660000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08662000 BRDISP $SAVE RGS=R14,SA=NO 08664000 STC RB,BRCESD+1 PLACE ESDID INTO CLI INSTRUCTION 08666000 SLL RB,24 SHIFT ID TO HI-ORDER BYTE OF RB 08668000 ALR RA,RB PUT SECITON ID IN WITH VALUE 08670000 LM RC,RE,BRRGSCDE GET INITIAL VALUES FOR RC,RD,RE 08672000 SR R14,R14 R14 = 0 ==> NO REGISTER FOUND YET 08674000 SPACE 1 08676000 * THE FOLLOWING LOOP EXECUTED 16 TIMES, CHECK EACH REG * 08678000 BRCESD CLI 0(RC),$CHN COMPARE INCOMING ESDID WITH 1 OLD 08680000 BNE BRLOOP IF NOT EQUAL,GO TO NEXT 08682000 CL RA,0(,RC) COMP INCOMING VALUE TO ONE IN USE RG 08684000 BL BRLOOP REGISTER HIGHER THAN ADDRESS-NO USE 08686000 CL RB,0(,RC) COMP PREVIOUS BEST REG TO NEXT ONE 08688000 BH BRLOOP IF PREVIOUS BEST > NEW, SKIP 08690000 L RB,0(,RC) GET NEW BEST ID/VALUE 08692000 LR R14,RC SAVE FOR INDEX TO BEST REG 08694000 BRLOOP BXLE RC,RD,BRCESD BUMP TO NEXT REG, GO BACK TO CHK 08696000 SPACE 1 08700000 S R14,BRRGSCDE S R14,=A(BRVALS) = 4* REG #, IF OK 08702000 BM BRNOGOOD IF R14 WAS =0, NO USABLE REG, BRANCH 08704000 SLR RA,RB COMPUTE DISPLACEMENT FOUND 08706000 C RA,AWF4095 C RA,=F'4095' -MAKE SURE NOT BOG 08708000 BH BRNOGOOD JUMP IF ILLEGALLY BIG 08710000 SLL R14,10 SHIFT REG NUMBER TO RIGHT SPOT 08712000 AR RA,R14 PUT BASE AND SIP TOGETHER 08714000 SR RB,RB ZERO TO SHOW SUCCESSFUL COMPLETE 08716000 BRRET $RETURN RGS=R14,SA=NO 08718000 BRNOGOOD LR RB,RD RB = 4 ==> ADDRESSIBLITY ERROR 08720000 B BRRET GO RETURN TO CALLER 08722000 SPACE 1 08724000 BRRGSCDE DC A(BRVALS,4,BRVALS+60) 2NDEX,INCREM,LIMIT-REGS RC,RD,RE 08725000 * * * * * INTERNAL VARIABLES * 08726000 DS 0D FOR ALIGNEMENT 08728000 BRVALS DS 16F TABLE OF USABLE VALUES IN REGS 08730000 * 1ST BYTE OF EACH HAS ID, RESTS HAVE ADDRESS. 08732000 DROP RAT,REP CLEAN UP USING 08734000 TITLE '*** CACONS - A-TYPE CONSTANT PROCESSING ***' 08736000 **--> CSECT: CACONS 1-2 PROCESS A-TYPE ADDRESS CONSTANTS. . . . . . . 08738000 *. USES DSECTS: AVWXTABL . 08739000 *. USES MACROS: $CALL,$RETURN,$SAVE . 08739500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08740000 CACONS CSECT 08742000 $DBG A0,SNAP 08744000 ENTRY CACON1,CACON2 08746000 USING AVWXTABL,RAT NOTE MAIN USING 08748000 SPACE 2 08750000 **--> ENTRY: CACON1 SCAN ACON, BUT DO NOT ASSEMBLE VALUE. . . . . . 08752000 *. ENTRY CONDITIONS . 08754000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08756000 *. EXIT CONDITIONS . 08758000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08760000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 08762000 *. RB = NONZERO ==> ILLEGAL CONSTANT ($ERINVCN) . 08764000 *. CALLS SCANCO . 08766000 *. **NOTE** EXPRESSION ENDING IN ) INSIDE MULTIPLE CONSTANT . 08766200 *. WILL BE PROCESSED IMPROPERLY, SUCH AS DC A(B+(C),D) . . 08766400 *. THE CHARACTERS C) ARE TREATED AS END OF THE ACON. . 08766600 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08768000 CACON1 $SAVE RGS=(R14-R1),BR=R1,SA=CACOSAVE 08770000 LR R0,RA SAVE ORIG SCAN POINTER 08772000 $CALL SCANCO SCAN TO COMMA OR BLANK 08774000 LTR RB,RB WAS THERE ERROR 08776000 BNZ CAC1RET YES-ERROR-RETURN WITH IT 08778000 CR R0,RA WAS THERE A NULL CONSTANT 08780000 BE CAC1ERR YES-ERROR-BRANCH 08782000 SPACE 1 08782500 BCTR RA,0 BACK UP SCAN PTR 1 BYTE 08783000 CLI 1(RA),C',' WAS SCAN STOPPER A COMMA 08784000 BNE CAC1RET NO, MUST BE END OF CONST: EXPR) 08786000 SPACE 1 08788000 CLI 0(RA),C')' MAKE SURE THS IS RIGHT PAREN 08790000 BE CAC1RET SKIP IF SO 08792000 LA RA,1(RA) CONST ENDED WITH EXPR, RESET PTR=>, 08794000 B CAC1RET GO EXIT 08795000 CAC1ERR LA RB,$ERINVCN NULL CONSTANT 08796000 CAC1RET $RETURN RGS=(R14-R1) 08798000 EJECT 08800000 **--> ENTRY: CACON2 1-2 SCAN ACON, ASSEMBLE VALUE . . . . . . . . . . 08802000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08804000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 08806000 *. EXIT CONDITIONS . 08808000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08810000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 08812000 *. RB = NONZERO VALUE - ERROR CODE (FROM EVALUT) . 08814000 *. = $ERRELOC IF SECTION ID IS A DSECT, WHICH IS NOT ALLOWED. . 08815000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 08816000 *. RD = ESDID OF CONSTANT, IF =0 ==> ABSOLUTE EXPRESSION . 08818000 *. CALLS EVALUT . 08820000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08822000 CACON2 $SAVE RGS=(R14-R0),BR=R13,SA=CACOSAVE 08824000 LR R0,RB SAVE THE LENGTH-1 FOR ASSEMBLY 08826000 $CALL EVALUT CALL EXPRESSION EVALUATOR 08828000 LTR RB,RB WAS THERE ERROR 08830000 BNZ CAC2RET ERROR-RETURN 08832000 * CHECK TO MAKE SURE DON'T DC A(DSECT SYMBOL) 08833000 STC RD,AVFWORK1 STORE FOR TEST OF EVEN/ODD 08833100 TM AVFWORK1,$ESDSECT TEST FOR ODD 08833200 BZ *+8 NO, EVEN=> CSECT TYPE OR ABS TERM-OK 08833300 LA RB,$ERRELOC NO GOOD- FLAG ERROR-DSECT RELOC 08833400 ST RC,AVCONBLD STORE THE VALUE 08834000 LCR RE,R0 GET NEGATIVE OF LENGTH-1 FOR ASSMBLY 08836000 LA RC,AVCONBLD+3(RE) GET REAL STARTING ADDRESS 08838000 CAC2RET $RETURN RGS=(R14-R0) 08840000 DROP RAT,R1,R13 08842000 TITLE '*** CBCONS - SCAN AND/OR ASSEMBLE BINARY CONSTANTS ***' 08844000 **--> CSECT: CBCONS 1-2 PROCESS BINARY CONSTANTS. . . . . . . . . . . 08846000 *. USES DSECTS: AVWXTABL . 08847000 *. USES MACROS: $RETURN,$SAVE . 08847500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08848000 CBCONS CSECT 08850000 $DBG A0,SNAP 08852000 ENTRY CBCON1,CBCON2 08854000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 08856000 SPACE 2 08858000 **--> ENTRY: CBCON1 1 SCAN B CONSTANT, DO NOT ASSEMBLE. . . . . . . 08860000 *. ENTRY CONDITIONS . 08862000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08864000 *. EXIT CONDITIONS . 08866000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08868000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 08870000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 08872000 *. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 08874000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08876000 CBCON1 $SAVE RGS=(R1-R2),SA=NO 08878000 MVC AWTDECT+C'2'(8),AWBLANK CAUSE 2-9 TO BE ^=0 08880000 SR R1,R1 CLEAR SO TRT WORKSA RIGHT 08882000 TRT 0(256,RA),AWTDECT MUST ENCOUNTER DELIMITER (3CRD LIM) 08884000 MVC AWTDECT+C'2'(8),AWZEROS+C'2' REZERO TRT TABLE 08886000 LA RC,7(R1) MOVE ENDING PTR,ROUND UP 08888000 SR RC,RA GET # 0'S & 1'S,ROUNDED UP TO 8 08890000 LR RA,R1 MOVE ENDING POINTER FOR RETURN 08892000 CLI 0(RA),C'''' WAS DELIMIER ' LIKE SUPPOSED TO 08894000 BNE CB1ERR NO, ERROR, INVALID DELIMITER 08896000 SRA RC,3 DIVIDE BY 8, GET # BUTES REQUIRED 08898000 BZ CB1ERR IF 0, CONST WAS B'', ERROR,BRANCH 08900000 SR RB,RB SHOW NO ERROR 08902000 CB1RET $RETURN RGS=(R1-R2),SA=NO 08904000 SPACE 1 08906000 CB1ERR LA RB,$ERINVCN INVALID CONSTANT -SET FLAG FOR RETUR 08908000 B CB1RET GO RETURN, SHOWING ERROR 08910000 EJECT 08912000 **--> ENTRY: CBCON2 1-2 ASSEMBLE BINARY CONSTANT. . . . . . . . . . . 08914000 *. ENTRY CONDITIONS . 08916000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08918000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 08920000 *. EXIT CONDITIONS . 08922000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08924000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 08926000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08928000 CBCON2 $SAVE RGS=(R0-R2),SA=NO 08930000 STC RB,*+5 STORE LENGTH-1 INTO NEXT MVC 08932000 MVC AVCONBLD($CHN),AWZEROS ZERO OUT WHOLE AREA 08934000 SR R1,R1 CLEAR FOR COMING TRT 08936000 L RD,AWFM1 =F'-1' FOR DECREMENTING LATER 08938000 TRT 0(256,RA),AWTDECT WE CHECKED IN PASS 1, LOOK FOR DLM 08940000 LA RE,0(RD,RA) GET LIMIT FOR BXH, @ 1ST ' OF CONST 08942000 LR RA,R1 GET @ OF ENDING ' 08944000 BXH R1,RD,CB2L2 DECREM LAST PTR, ENTER LOOP RIGHT 08946000 SPACE 1 08948000 CB2L1 BCT R2,CB2L3 DECREMENT BIT POSITION POINTER,BRNCH 08950000 STC R0,AVCONBLD(RB) STORE ASSEMBLED BYTE INTO POSITION 08952000 AR RB,RD SUBTRACT 1 FROM BYTE COUNT 08954000 BM CB2RETA IF <0, WE ARE DONE, QUIT 08956000 SPACE 1 08958000 * INITIALIZATION - 1 TIME FOR EACH BYTE REQUIRED * 08960000 CB2L2 SR R0,R0 CLEAR FOR BUILDING UP BYTE 08962000 LA R2,8 # BITS IN 1 BYTE 08964000 LCR RC,RD RC = 1, FOR SHIFTING BIT TO ADD 08966000 SPACE 1 08968000 CB2L3 CLI 0(R1),C'0' IS NEXT CHAR A 0 08970000 BE *+6 SKIP ADDING BIT IN, IF SO 08972000 ALR R0,RC ADD 1 BIT IN IN RIGHT BIT POSITION 08974000 ALR RC,RC == SLL RC,1 - SHIFT 1 BIT OVER FOR N 08976000 BXH R1,RD,CB2L1 DECREMENT POINTER, JUMP TO CHECK 08978000 SPACE 1 08980000 STC R0,AVCONBLD(RB) RAN OUT OF DIGITS, STORE THE BYTE 08982000 CB2RETA LA RC,AVCONBLD GET @ BEGINNING OF ASSEMBLED CONST 08984000 CB2RET $RETURN RGS=(R0-R2),SA=NO 08986000 DROP RAT,REP KILL USINGS 08988000 TITLE '*** CCCONS - SCAN AND/OR ASSEMBLE C-TYPE CONSTANTS ***' 08990000 **--> CSECT: CCCONS 1-2 PROCESS CHARACTER TYPE CONSTANTS. . . . . . . 08992000 *. USES DSECTS: AVWXTABL . 08993000 *. USES MACROS: $RETURN,$SAVE . 08993500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08994000 CCCONS CSECT 08996000 $DBG A0,SNAP 08998000 ENTRY CCCON1,CCCON2 09000000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 09002000 SPACE 2 09004000 **--> ENTRY: CCCON1 1 SCAN,RETURN LENGTH,DO NOT ASSEMBLE. . . . . . 09006000 *. ENTRY CONDITIONS . 09008000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09010000 *. EXIT CONDITIONS . 09012000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09014000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09016000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09018000 *. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 09020000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09022000 CCCON1 $SAVE SA=NO 09024000 SR RC,RC INDEX FOR BXLE, WILL GO FROM 0==>255 09026000 LA RD,1 INCREMENT FOR BXLE FOR LOOP 09028000 LA RE,255 LIMIT=LENGTH OF MAXIMUM CONSTANT 09030000 SPACE 1 09032000 * INITIALIZATION DONE, NOW DO CHECKING LOOP * 09034000 CC1LOOP CLI 0(RA),C'''' IS THE NEXT CHAR A ' 09036000 BNE CC1CHK2 NO, GO CHECK FOR & OR OTHER 09038000 CLI 1(RA),C'''' IS NEXT CHARACTER & ' 09040000 BNE CC1OUT NO IT ISNT, MUST BE END OF CONSTANT 09042000 BXH RA,RD,CC1LOOPA BUMP SCAN POINTER 1 AND BRANCH 09044000 SPACE 1 09046000 CC1CHK2 CLI 0(RA),C'&&' IS CHAR AN & 09048000 BNE CC1LOOPA BRANCH IF NOT==> NORMAL CHARACTER 09050000 AR RA,RD INCREMENT TO 2ND &,HOPEFULLY 09052000 CLI 0(RA),C'&&' MAKE SURE 2ND & IS THERE TOO 09054000 BNE CC1ERR ERROR IF IT ISNT-BRANCH 09056000 SPACE 1 09058000 CC1LOOPA AR RA,RD INCREMENT POINTER TO NEXT CHAR 09060000 BXLE RC,RD,CC1LOOP CONTINUE LOOPING 09062000 SPACE 1 09064000 CC1ERR LA RB,$ERINVCN NOTE THIS IS AN INVALID CONSTANT 09066000 B CC1RET RETURN, WITH ERROR 09068000 SPACE 1 09070000 CC1OUT LTR RC,RC MAKE SURE LENGTH OF CONST>0 09072000 BZ CC1ERR NULL CONSTANT==>ERROR 09074000 SR RB,RB CLEAR TO SHOW LEGAL CONSTANT 09076000 CC1RET $RETURN SA=NO 09078000 EJECT 09080000 **--> ENTRY: CCCON2 2 SCAN, ASSEMBLE. . . . . . . . . . . . . . . . 09082000 *. ENTRY CONDITIONS . 09084000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09086000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 09088000 *. EXIT CONDITIONS . 09090000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09092000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 09094000 *. RD = LENGTH-1 OF CONSTANT (WAS IN RB ON ENTRY) CPP 09095000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09096000 CCCON2 $SAVE SA=NO 09098000 LA RD,1 FOR INCREMENT AND USEFUL CONST 09100000 SR RE,RE CLEAR FOR COUNTER 09102000 * **NOTE** BXH'S WORK OK SINCE RA>256 ALWAYS. 09104000 SPACE 1 09106000 CC2LOOP CLI 0(RA),C'''' IS CHAR A ' 09108000 BNE CC2CHK2 BRANCH IF IT ISN'T 09110000 CLI 1(RA),C'''' SEE IF NEXT 1 IS ' 09112000 BNE CC2PAD BRANCH==>HIT END OF CONST,PAD NEEDED 09114000 BXH RA,RD,CC2MOV INCREMENT POINT TO 2ND '&JUMP 09116000 SPACE 1 09118000 CC2CHK2 CLI 0(RA),C'&&' IS CHAR AN & 09120000 BNE CC2MOV JUMP IF IT IS NORMAL CHARACTER 09122000 AR RA,RD INCREMENT TO POINT AT 2ND & 09124000 CC2MOV IC RC,0(RA) GET THE CHARACTER 09126000 STC RC,AVCONBLD(RE) SAVE THIS IN THE RIGHT PLACE IN CONS 09128000 AR RE,RD INCREMENT NUMBER OF BYTES DONE 09130000 BXH RA,RD,CC2LOOP INCREMENT AND JUMP BACK FOR NEXT 09132000 SPACE 1 09134000 CC2PAD LR RD,RB SAVE LENGTH-1 OF CONSTANT CPP 09135000 SR RB,RE RE=LENGTH-1 OF PAD, IF ANY CPP 09136000 BM CC2RETA IF <0, NO PAD REQUIRED, QUIT 09138000 LA RE,AVCONBLD(RE) RE=@ OF FIRST BYTE TO BLANK CPP 09140000 STC RB,*+5 STORE LENGTH INTO MVC 09142000 MVC 0($CHN,RE),AWBLANK PAD--BLANK OUT ENOUGH CPP 09144000 SPACE 1 09146000 CC2RETA LA RC,AVCONBLD POINT TO BEGINNING OF ASSEMBLED CONS 09148000 CC2RET $RETURN SA=NO 09150000 DROP RAT,REP CLEAN UP USING 09152000 TITLE '*** CDECNS - D AND E TYPE CONSTANT PROCESSING ***' 09154000 **--> CSECT: CDECNS 1-2 PROCESS D&E TYPE CONSTS . . . . . . . . . . . 09156000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09158000 CDECNS CSECT 09160000 $DBG A0,SNAP 09162000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 09164000 ENTRY CDECN1,CDECN2 09166000 SPACE 2 09168000 **--> ENTRY: CDECN1 1 SCAN, BUT DO NOT ASSEMBLE D OR E TYPE CONSTS. 09170000 *. ENTRY CONDITIONS . 09172000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09174000 *. EXIT CONDITIONS . 09176000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09178000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09180000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09182000 *. CALLS CDECN2 . 09182100 *. USES DSECTS: AVWXTABL . 09182200 *. USES MACROS: $RETURN,$SAVE . 09182300 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09184000 CDECN1 EQU * USE SAMEENTRY AS CDECN2 FOR THIS 09186000 EJECT 09208000 **--> ENTRY: CDECN2 1-2 SCAN,ASSEMBLE D&E TYPE CONSTANTS. . . . . . . 09210000 *. ENTRY CONDITIONS . 09212000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09214000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 09216000 *. EXIT CONDITIONS . 09218000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09220000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09222000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09224000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 09226000 *. CALLS SDDTRM . 09228000 *. USES DSECTS: AVWXTABL . 09229000 *. USES MACROS: $CALL,$RETURN,$SAVE . 09229500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09230000 SPACE 1 09230100 * * * * * REGISTER ALLOCATION - CDECN2 * * * * * * * * * * * * * * * * 09230200 * F0 = ACCUMULATOR FOR VALUE BUILT UP FOR CONSTANT * 09230300 * F2 = FLOATING POINT 10.0 * 09230400 * F4 = INITIALLY FLOATING POINT 10.0. MULTIPLIED BY 10 FOR FRACTION * 09230450 * F6 = FLOATING POINT WORK REGISTER * 09230500 * RA = SCAN POINTER ADDRESS REGISTER, ADVANCED DURING SCAN * 09230600 * RC = UNUSED CURRENTLY * 09230700 * RD = UNUSED CURRENTLY * 09230800 * RE = 1 USEFUL CONSTANT IN ODD REGISTER, USED FOR BXH'ING. * 09230900 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09231000 AIF (&$FLOTA AND &$FLOTM).CD2FULL SKIP IF OK TO HAVE D&E 09231050 * RESTRICTED VERSION - IF NOT ACCEPTING FLOATING PT, OR 09231100 * NOT ON MACHINE, ASSEMBLE ONLY D'0' OR E'0'. 09231150 CDECN2 $SAVE SA=NO 09231200 CLI 0(RA),C'0' WAS IT LEGAL ZERO 09231250 BNE CD2INVCN NO, BAD, WE ONLY ACCEPT 0 09231300 LA RA,1(RA) BUMP SCAN PTR 1 09231350 LA RC,AWZEROS SHOW @ 8 BYTES OF ZERO 09231400 SR RB,RB SHOW ACCEPTABLE 09231450 CD2RET $RETURN SA=NO RETURN FROM SMALL MODULE 09231500 CD2INVCN LA RB,$ERINVCN SHOW INVALID, WASN'T 0 09231550 B CD2RET RETURN WITH RROR 09231600 DROP RAT,REP AVWXTABL,ENTRY BASE 09231650 AGO .CD2MINI SKIP OVER REGULAR CODE 09231700 .CD2FULL ANOP 09231750 SPACE 1 09231800 CDECN2 $SAVE SA=CDE2SAVE,RGS=(R14-R15),BR=R13 09232000 MVI CD2CON+1,X'F0' MAKE NOOP TO BRANCH,INIT 09234000 MVI CD2FTEST+1,0 INIT THIS TEST TO NOOP 09236000 LD F0,AWD0 GET CONSTANT 0 09238000 LD F2,AWD10 GET USEFUL CONSTANT 10 09240000 STD F2,AVDWORK1 STORE VALUE WITH X'41' EXPONENT 09242000 MVI CD2PERI+1,0 INIT . BRANCH TO NOOP 09244000 LDR F4,F2 INIT F4 TO FLOATING PT 10 FOR DIVIDE 09246000 LA RE,1 FOR BXHING AND OTHER INCREMNTING 09248000 MVI CD2SIGN,X'20' MAKE INST A LPDR-ASSUME + # 09250000 CLI 0(RA),C'0' DO WE START WITH DIGIT 09252000 BNL CD2DIG YES,GO PROCESSES 09254000 CLI 0(RA),C'.' DO WE HAVE . AT BEGINNING 09256000 BE CD2PERI GO THERE IF SO 09258000 CLI 0(RA),C'+' DO WE HAVE + 09260000 BE CD2INCA YES,BUMP SCAN PTR,LEAVE SIGN OK 09262000 CLI 0(RA),C'-' DO WE HAVE - 09264000 BNE CD2INVCN NO,MUST BE ERROR 09266000 MVI CD2SIGN,X'21' MAKE INST LNDR SINCE NEGATIVE SIGN 09268000 CD2INCA AR RA,RE BUMP SCAN PTR BEYOND SIGN 09270000 EJECT 09272000 * LOOP HEAD FOR SCANNING FOLLOWS. * 09274000 CD2LOOP CLI 0(RA),C'0' DO WE HAVE DIGIT 09276000 BL CD2NDIG NO,BRANCH OUT 09278000 CD2DIG MVI CD2CON+1,0 MAKE BRANCH NOOP,SHOW 1 DIGIT,AT LEA 09280000 UNPK AVDWORK1+1(1),0(1,RA) MOVE SWITCHED NIBBLES TO WORK 09282000 NI AVDWORK1+1,X'F0' REMOVE EXTRA NIBBLE AT END, LEAVE # 09284000 CD2FTEST BC $CHN,CD2LDIV BRANCH OUT IF IN FRACTIONAL PART 09290000 MDR F0,F2 MULT ACCUMULATED VALUE BY 10 09292000 AD F0,AVDWORK1 ADD NEW VALUE INTO ACCUMUALTOR 09294000 BXH RA,RE,CD2LOOP BUMP SCAN POINTER, GO FOR NEXT 09296000 SPACE 1 09298000 CD2LDIV LD F6,AVDWORK1 GET VALUE OF NEXT DIGIT 09300000 DDR F6,F4 DIVIDE BY CURRENT POWER OF 10 09302000 MDR F4,F2 RAISE POWER OF 10 IN F4 BY ANOTHER 09303000 ADR F0,F6 ADD NEW VALUE IN 09304000 BXH RA,RE,CD2LOOP BUMP SCAN PTR, GET NEXT 09306000 SPACE 1 09308000 CD2NDIG CLI 0(RA),C'.' IS IT PERIOD 09310000 BNE CD2NOPR NEITHER DIG NOR PERIOD 09312000 CD2PERI BC $CHN,CD2INVCN IF WE COME HERE 2 TIMES-GO TO ERROR 09314000 MVI CD2PERI+1,X'F0' MAKE NOOP A BRANCH TO ERROR 09316000 MVI CD2FTEST+1,X'F0' MAKE BRANCH-SHOW FRACTION NOW 09318000 BXH RA,RE,CD2LOOP BUMP SCAN PTR,GET NEXT 09320000 EJECT 09322000 * FOLLOWING SECTION SCANS FOR AN EXPONENT E AND SIGN 09324000 CD2NOPR CLI 0(RA),C'E' WAS THIS EXPONENT INDICATOR 09326000 BNE CD2DLM NO,MUST BE DELIMITER 09328000 AR RA,RE BUMP SCAN PTR BEYOND E 09330000 MVI CD2SIGNE,X'2C' MAKE EXPONENT SIGN + (MDR INST) 09332000 CLI 0(RA),C'0' IS NUMBER THERE 09334000 BNL CD2EVAL IF DECIMAL,GO EVALUATE 09336000 CLI 0(RA),C'+' WAS THERE A + SIGN 09338000 BE CD2INCB YES,JUST BUMP SCAN PTR 09340000 CLI 0(RA),C'-' WAS THERE - SIGN 09342000 BNE CD2INVCN NO,ERROR 09344000 MVI CD2SIGNE,X'2D' -EXPONENT, MAKE INST A DDR 09346000 CD2INCB AR RA,RE BUMP SCAN PTR BY 1 09348000 SPACE 1 09350000 * HAVE EXPONENT VALUE CONVERTED. ADJUST FRACTION BY IT. 09352000 CD2EVAL $CALL SDDTRM 09354000 LTR RB,RB WAS IT OK 09356000 BNZ CD2INVCN NO,ERROR 09358000 LTR RC,RC WAS EXPONENT 0 09360000 BZ CD2CON YES,DON'T DO ANYTHING 09362000 * THERE SHOULD BE SOME MAGNITUDE CHECKING HERE 09364000 CD2SIGNE MDR $CHN+F0,F2 **MODIFIED** MUL OR DIV,DEP ON SIGN 09366000 BCT RC,CD2SIGNE LOOP FOR REQUIRED AMOUNT 09368000 SPACE 1 09370000 * MAKE ENDING CHECKS, THEN RETURN TO CALLER. 09372000 CD2DLM CLI 0(RA),C'''' WAS THIS ' DELIMITER 09374000 BE CD2CON YES,OK 09376000 CLI 0(RA),C',' WAS IT , DELIM 09378000 BNE CD2INVCN INVALID DELIMITER 09380000 CD2CON BC $CHN,CD2INVCN BRANCH OUT IF NO FRACTIO ANYWHERE 09382000 CD2SIGN LPDR $CHN+F0,F0 **MODIFIED** GET RIGHT SIGN 09384000 STD F0,CD2CONB SAVE THIS VALUE 09386000 LA RC,CD2CONB POINT TO THIS @ 09388000 SR RB,RB SHOW OK 09390000 CD2RET $RETURN RGS=(R14-R15) 09392000 CD2INVCN LA RB,$ERINVCN SHOW ERROR 09394000 B CD2RET RETURN 09396000 CD2CONB DS D SPACE FOR SAVING CONSTANT 09400000 DROP RAT,R13 KILL USINGS 09402000 .CD2MINI ANOP 09402100 TITLE '*** CFHCNS - FULLWORD-HALFWORD FIXED CONSTANTS ***' 09404000 **--> CSECT: CFHCNS 1-2 PROCESS FULLWORD-HALFWORD CONSTANTS . . . . . 09406000 *. USES DSECTS: AVWXTABL . 09407000 *. USES MACROS: $RETURN,$SAVE . 09407500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09408000 CFHCNS CSECT 09410000 $DBG A0,SNAP 09412000 USING AVWXTABL,RAT NOTE MAIN USING 09414000 ENTRY CFHCN1,CFHCN2 09416000 SPACE 2 09418000 **--> ENTRY: CFHCN1 1 SCAN CONST, DO NOT ASSEMBLE . . . . . . . . . 09420000 *. ENTRY CONDITIONS . 09422000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09424000 *. EXIT CONDITIONS . 09426000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09428000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09430000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09432000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09434000 CFHCN1 $SAVE RGS=(R1-R2),SA=NO 09436000 SPACE 1 09438000 * INITIALIZE, CHECK FOR LEADING SIGN. **NOTE** THIS * 09440000 * ROUTINE DOES NOT PERMIT DECIMAL POINTS INSIDE CONSTANTS. * 09442000 SR R1,R1 CLEAR FOR ADDRESS INSERT 09444000 CLI 0(RA),C'+' PLUS SIGN CHECK 09446000 BE CFH1INC GO BUMP SCAN POINTER IF SO 09448000 CLI 0(RA),C'-' MUST BE MINUS SIGN 09450000 BNE CF1TRT SKIP IF NOT ASIGN 09452000 CFH1INC LA RA,1(RA) INCR SCAN POINTER PAST + OR - 09454000 SPACE 1 09456000 * SCAN DECIMAL DIGITS, MAKE SURE THERE'S AT LEAST 1. 09458000 CF1TRT TRT 0(11,RA),AWTDECT SCAN FOR DELIMITER 09460000 BZ CFH1BIG BRANCH IF TOO BIG 09462000 SR R1,RA GET NUMBER OF CHARS 09464000 BZ CFH1INVC NO DIGITS, SO INVLAID, LIKE F'' 09466000 SPACE 1 09468000 AR RA,R1 GET POINTER BACK 09470000 SR RB,RB CLEAR TO SHOW OK 09472000 CFH1RET $RETURN RGS=(R1-R2),SA=NO 09474000 SPACE 1 09476000 CFH1INVC LA RB,$ERINVCN INVALID CONSTANT ERROR 09478000 B CFH1RET GO RETUN 09480000 CFH1BIG EQU CFH1INVC TOO BIG, USE JUST INVALID MESSAGE 09482000 EJECT 09484000 **--> ENTRY: CFHCN2 2 ASSEMBLE F OR H CONST . . . . . . . . . . . . 09486000 *. ENTRY CONDITIONS . 09488000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09490000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 09492000 *. EXIT CONDITIONS . 09494000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09496000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09498000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09500000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 09502000 *. **NOTE** - THIS ROUTINE WILL ASSEMBLE VALUES INTO F OR H * 09504000 *. CONSTANTS OF LENGTH 1-8, BUT THE VALUE OF ANY CONSTANT MUST * 09506000 *. BE OF SIZE TO FIT INTO 1 FULLWORD, I.E. THE OTHER FULLWORD * 09508000 *. MUST EITHER BE ALL 0'S OR ALL 1'S (BINARY). . * 09510000 *. **NOTE** IT IS POSSIBLE FOR THIS ROUTINE TO CAUSE A FIXED PT * 09512000 *. OVERFLOW, WHICH WILL CAUGHT AND LAGGED BY SPIE MONITOR IN * 09514000 *. MAIN PROGRAM MPCON0. * 09516000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09518000 CFHCN2 $SAVE RGS=(R1-R2),SA=NO 09520000 SPACE 1 09522000 * INITIALIZE. CHECK SIGN, KAE CFH2SIG EITHR LR OR LCR. 09524000 SR R1,R1 CLEAR FOR ADDRESS INSERTION 09526000 MVI CFH2SIG+1,X'FF' ASSUME + SIGN WILL OCCUR 09528000 CLI 0(RA),C'0' IS THERE NO SIGN 09530000 BNL CFH2TRT NO SIGN-BRANCH 09532000 CLI 0(RA),C'+' PLUS SIGN CHECK 09534000 BE CFH2INC BRANCH IF SO 09536000 MVI CFH2SIG+1,X'FD' SET TO SHOW MINUS 09538000 CFH2INC LA RA,1(RA) BUMP PAST SIGN 09540000 SPACE 1 09542000 * SCAN CONSTANT, CONVERT TO BIANRY FORM. 09544000 CFH2TRT TRT 0(11,RA),AWTDECT GO FOR DELIMITER 09546000 SR R1,RA GET DIFFERENCE=#OF DIGITS 09548000 BCTR R1,0 DECREMENT FOR LENGTH-1 09550000 EX R1,CFH2PACK PACK THE NUMBER 09552000 CFH2SIG NI AVDWORK1+7,$ CHANGE SIGN TO SHOW + (F) OR - (D) 09553000 CVB RD,AVDWORK1 CONVERT THE VALUE 09554000 SPACE 1 09556000 * GIVE CONSTANT RIGHT SIGN, STORE IT, POINT TO IT. 09558000 SRDA RD,32 MAKE CONSTANT A DOUBLE WORD- 09562000 STM RD,RE,AVCONBLD STORE IN BUILDING AREA 09564000 LCR RB,RB MAKE LENGTH-1 NEGATIVE-GET OFFSET 09566000 LA RC,AVCONBLD+7(RB) GET START ADDR OF DESIRED CONST 09568000 SR RB,RB SHOW THE CONSTANT IS OK 09570000 LA RA,1(R1,RA) GET SCAN POINTER TO ENDING ' , 09572000 CFH2RET $RETURN RGS=(R1-R2),SA=NO 09574000 SPACE 1 09576000 CFH2PACK PACK AVDWORK1,0(0,RA) PACK DECIMAL STRING 09578000 DROP RAT,REP CLEAN UP USING 09580000 TITLE '*** CNDTL2 - CONSTANT PROCESSOR CONTROL - PASS 2 ***' 09582000 **--> CSECT: CNDTL2 2 CONSTANT PROCESSOR CONTROL - PASS 2 . . . . . 09584000 *. ENTRY CONDITIONS . 09586000 *. RB = NUMBER OF CONSTANT CONTROL BLOCKS TO BE PROCESSED . 09588000 *. RC = ADDRESS OF FIRST OR ONLY CNCBLOCK TO BE DONE . 09590000 *. CALLS CACON2,CBCON2,CCCON2,CDECN2,CFHCN2,CPCON2,CVCON2,CXCON2. 09592000 *. CALLS CZCON2,ERRTAG,OUTPT2,UTPUT2 . 09594000 *. USES DSECTS: AVWXTABL,CNCBLOCK . 09594100 *. USES MACROS: $ALIGR,$CALL,$GLOC,$GTAD,$RETURN,$SAVE . 09594200 *. USES MACROS: $SCPT,$SLOC . 09594300 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09596000 CNDTL2 CSECT 09598000 $DBG A0,SNAP 09600000 * * * * * REGISTER ALLOCATION AND USAGE FOR CNDTL2 * * * * * * * * * * 09602000 * R0 = # CONSTANTS REMAINING TO BE DONE IN CURRENT CNCBLOCK(CNCNUM) * 09604000 * R1 = LENGTH-1 OF CONSTANT(S) IN INDIVIDUAL OPERAND, (FROM CNCLEN) * 09606000 * ALSO USED AS BYTE REGISTER, 3 HI-ORD* BYTES=0 * 09608000 * R2 = DUPLICATION FACTOR FOR CONSTANT OPERAND ( FROM CNCDUP) * 09610000 * RW = @ CURRENT CNCBLOCK BEING PROCESSED. * 09612000 * RX = @ AREA FOR BUILDING UP MULTIPLE CONSTANTS (AVCONBL2) * 09614000 * RY = @ SPECIFIC CONSTANT PASS 2 ROUTINE * 09616000 * RZ = CURRENT TOTAL LENGTH OF ASSEMBLED CONSTANTS (MULTIPLE OPRNDS)* 09618000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09620000 SPACE 1 09622000 USING AVWXTABL,RAT 09624000 $SAVE RGS=(R14-R6),BR=R13,SA=CNDTSAVE 09626000 SPACE 1 09628000 * INITIALIZEREGISTERS, COUNTERS. ENTER CODE LOOP. 09630000 SR R0,R0 CLEAR FOR INSERIONS 09632000 SR R1,R1 CLEAR FOR INSERTIONS 09634000 LR RW,RC MOVE @ 1ST OR ONLY CNCBLOCK OVER 09636000 USING CNCBLOCK,RW NOTE POINTER 09638000 MVC CNDOCNT,AWHM1 =H'-1' = 6-1 OF BYTES FOR PRINTING 09640000 B CNDAA1 ENTR RIGHT SPOT TO BEGIN 09642000 SPACE 1 09644000 * CNDA IS ENTERED 1 TIME FOR EACH OPERAND AFTER FIRST * 09646000 CNDA LH R15,CNCTOT GET TOTAL LENGTH OF LAST CONSTANT 09648000 A R15,AVLOCNTR ADD LOCATION COUNTER 09650000 LA RW,CNC$LEN(RW) INCREMENT CNCBLOCK POINTER TO NEXT 09652000 TM CNCTYP,$CNALN DOES NEW OPERAND REQUIRE ALIGNMENT 09654000 BZ CNDNOLN NO,SKIP ALIGNING THE LOCCNTR 09656000 IC R1,CNCLEN GET L-1 OF CONST(NOTE R1 BYTE REG) 09658000 $ALIGR R15,(R1) ALIGN LOCATION COUNTER 09660000 CNDNOLN $SLOC R15 RESET LOCATION COUNTER 09662000 SPACE 1 09664000 * CNDAA1 IS ENTERED 1 TIME FOR EACH CNCBLOCK PROCESSED. * 09666000 CNDAA1 STH RB,CND#CNCS SAVE CURRENT # CNCBLOCKS TO BE DONE 09668000 CNDAA $SCPT RA,CNCSCAN CONVERT OFFSET TO ACTUAL @ PTR 09670000 IC R1,CNCTYP GET TYPE BYTE 09672000 N R1,AWF15 REMOVE LEADING BITS 09674000 IC R1,AWCONADS(R1) GET OFFSET TO PASS 1 CONSTANT SUBR 09682000 $GTAD RY,C$BASE+4(R1) GET @ PASS 2 CONSTANT ROUTINE 09684000 IC R0,CNCNUM GET # OF CONSTANTS IN THIS OPERAND 09686000 IC R1,CNCLEN GET THE LENGTH-1 OF EACH CONSTANT 09688000 LA RX,AVCONCAT SET UP @ OF BUILDING AREA 09690000 SR RZ,RZ CLEAR THE TOTAL LENGTH BUILT UP 09692000 EJECT 09694000 * CNDBB ENTERED ONCE FOR EACH CONSTANT IN EACH OPERAND * 09696000 CNDBB LR RB,R1 MOVE LENGTH-1 OVER FOR CALL TO ROUTI 09698000 LR REP,RY MOVE @ ROUTINE OVER 09700000 BALR RET,REP CALL THE ROUTINE 09702000 TM CNCTYP,$CNERR SHOULD WE TEST RB FOR ERRORS 09704000 BZ CNDNERR SKIP IF NO TEST NEEDED 09706000 LTR RB,RB WAS THERE AN ERROR 09708000 BZ CNDNERR SKIP IF NO ERROR 09710000 SPACE 1 09712000 * ERROR FOUND IN PASS 2. FLAG IT,PRINT STMT, AND QUIT. * 09714000 $CALL ERRTAG HAVE ERROR FLAGGED 09716000 B CNDRETA RETURN TO CALLER 09718000 SPACE 1 09720000 CNDNERR EQU * 09722000 LA RE,0(RX,RZ) GET @ WHERE NEXT CODE TO GO 09730000 LA RZ,1(R1,RZ) INCREM TOTAL LENGTH BY NEW AMOUNT 09732000 CLI CNCNUM,1 WAS THERE ONLY 1 CONSTANT(LIKELY) 09734000 BE CNDPRNT1 SKIP TO SIMPLE CASE IF SO 09736000 STC R1,*+5 STORE L-1 INTO NEXT INST 09738000 MVC 0($CHN,RE),0(RC) MOVE CODE OVER 09740000 LA RA,1(RA) BUMP THE SCAN POINTER TO NEXT OPERAN 09742000 BCT R0,CNDBB GO BACK FOR NEXT CONSTANT IN OPERAND 09744000 SPACE 1 09746000 * FALL THRU AFTER ASSEMBLING 2 OR MORE CONSTS IN 1 OPRND.* 09748000 LR RC,RX MOVE @ ASSEMBLED CONSTANT OVER 09750000 CNDPRNT1 BCTR RZ,0 DECREMENT TOTAL LENGTH TO L-1 09752000 LH R2,CNCDUP GET DUPLICATION FACTOR 09754000 LTR R2,R2 TEST (MAX VAL FOR DUPL=X'7FFF') 09756000 BZ CNDLOOP2 SKIP REST IF ZERO DUPLICATION FACTOR 09758000 SPACE 1 09760000 * ACCUMULATE ENOUGH BYTES FOR PRINTING, IF NOT ALREADY. * 09762000 LH RA,CNDOCNT GET LENGTH-1 CUR›ENTLY READY 09764000 LA R15,6 FOR COMPARISON A(D LIMIT VALUE 09766000 CR RA,R15 IS THERE ENOUGH ALREADY 09768000 BH CNDUTPUT BRANCH OUT IF ALREADY ENOUGH 09770000 SPACE 1 09772000 LA R14,1 FOR BXLE INCREME(T 09774000 SR RD,RD INIT FOR INDEX I(TO ASSEMBLED CONT 09776000 LR RE,R2 DUPLICATE DUPLIC"ATION FACTOR,>0 09778000 B CNDLC ENTER LOOP APPRO&RIATELY 09780000 SPACE 1 09782000 * LOOP TO ACCUMULATE PRINTING CODE, 1 BYTE AT TIME. 09784000 CNDLA AR RD,R14 INCREMENT WITHIN CONSTANT PTR TO NXT 09786000 CR RD,RZ HAVE WE REACHED END OF CONST 09788000 BNH CNDLC NO,KEEP GOING 09790000 SR RD,RD END OF CONST,CLEAR TO BEGIN AGAIN 09792000 SR RE,R14 DECREMENT TEMPORARY DUPLICATION FAC 09794000 BNP CNDLE QUIT IF RUN OUT OF DUPLFAC 09796000 SPACE 1 09798000 CNDLC IC RB,0(RD,RC) GET 1 BYTE OF CONSTANT OPERAND 09800000 STC RB,CNDOCOD+1(RA) STORE FOR PRINTING 09802000 BXLE RA,R14,CNDLA LOOP UNTIL HAVE 8 BYTES OR RUN OUT 09804000 SPACE 1 09806000 CNDLE STH RA,CNDOCNT STORE BACK THE UPDATED PR COUNT 09808000 EJECT 09810000 * CALL UTPUT2 TO DUPLICATE AND LOAD OBJECT CODE * 09812000 CNDUTPUT EQU * 09814000 LR RE,R2 MOVE DUPLICATION FACTOR OVER 09818000 $GLOC RA GET LOCATION COUNTER FOR CODE 09820000 LR RD,RZ TOTAL L-1 OF CODE(NOT CNTING DUPL) 09822000 $CALL UTPUT2 HAVE OBJECT CODE LOADED,DUPLICATED 09824000 SPACE 1 09826000 * LOOP BACK FOR NEXT OPERAND, IF >1 WAS USED. 09828000 CNDLOOP2 LH RB,CND#CNCS GET # CNCBLOCKS LEFT TO DO 09830000 BCT RB,CNDA GET NEXT OPERAND (UNLIKELY) 09832000 SPACE 1 09834000 CNDRETA EQU * INSERT $DALLOCH CODE LATER 09836000 LA RB,$OUCONS SHOW WE WANT LOCATION COUNTER 09838000 LA RC,CNDOCOD GET @ OF CODE TO BE PRINTED 09840000 LH RD,CNDOCNT GET LENGTH-1 OF CONST TO PRINT 09842000 $CALL OUTPT2 HAVE STMT PRINTED 09844000 CNDRET $RETURN RGS=(R14-R6) 09846000 SPACE 1 09870000 * * * * * INTERNAL VARIABLES * 09872000 CND#CNCS DS H # CNCBLOCKS TO BE PROCESSED (U=1) 09874000 CNDOCNT DS H FOR LENGTH-1 OF CODE TO PRINT 09876000 CNDOCOD DS D AREA TO BUILD UP PRINTED CODE 09878000 DROP RAT,R13,RW KILL USINGS 09882000 TITLE '*** CODTL1 - SCAN DUPL FAC,TYPE,LENGTH,CONST-PASS1 ***' 09884000 **--> CSECT: CODTL1 1 SCAN DUPFAC,TYPE,LENGTH-CALL C ROUTINES . . . 09886000 *. ENTRY CONDITIONS . 09888000 *. RA = SCAN POINTER TO DUPLICATION FACTOR OR CONSTANT TYPE . 09890000 *. RB = 0 CONSTANT IS IN A DEFINE STORAGE STMT . 09892000 *. RB = 4 CONSTANT IS IN A DC STATEMENT . 09894000 *. RB = 8 CONSTANT IS A LITERAL - (I.E. DUPLFAC ^= 0, DECIMALS) . 09896000 *. EXIT CONDITIONS . 09898000 *. RA = SCAN POINTER TO DELIMITER FOLLOWING CONSTANT . 09900000 *. RB = 0 LEGAL SPECIFICATION OF CONSTANT . 09902000 *. RB = NONZERO VALUE - ERROR CODE - ILLEGAL . 09904000 *. RC = ADDRESS OF A CONSTANT CONTROL BLOCK . 09906000 *. RE = TOTAL LENGTH OF OPERAND,INCLUDING MULTIPLE OPERANDS,IF ANY . 09908000 *. CALLS CACON1,CBCON1,CCCON1,CDECN1,CFHCN1,CPCON1,CVCON1,CXCON1. 09910000 *. CALLS CZCON1,EVALUT,SDDTRM . 09912000 *. USES DSECTS: AVWXTABL,CONBLK . 09914000 *. USES MACROS: $CALL,$GTAD,$RETURN,$SAVE,$SCOF,CONG 09916000 * NOTE RESTRICTIONS - DUPLICATION FACTOR AND TOTAL LENGTH MUST * 09922000 * BOTH BE ABLE TO FIT IN HALFWORD EACH. LENGTH MAY BE GREATER * 09924000 * THAN 256 FOR A DS,BUT LENGTH ATTRIBUTE WILL NOT BE CORRECT * 09926000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09927000 SPACE 1 09928000 CODTL1 CSECT 09929000 $DBG A0,SNAP 09929500 * * * * * REGISTER ALLOCATION FOR CODTL1 * * * * * * * * * * * * * * * 09930000 * R0 = 0 ==> PROCESSING DS, = 4 ==> PROCESSING DC STATEMENT. * 09932000 * = 8 ==> LITERAL CONSTANT, I.E. REQUIRE DECIMAL MODIFIERS. * 09934000 * R1 = 1 USED TO BUMP SCAN POINTER IN BXH'S,ETC. * 09936000 * R2 = ADDRESS OF CONSTANT BLOCK ENTRY (CONBLK),AFTER TYPE FOUND * 09938000 * RW = LENGTH-1 OF OPERAND BEING PROCESSED.IMPLIED OR SPECIFIED. * 09940000 * RX = NUMBER OF CONSTANTS IN THE OPERAND * 09942000 * RY = DUPLICATION FACTOR OF THE OPERAND * 09944000 * RZ USED AS LINK OR WORK REGISTER * 09946000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09948000 SPACE 1 09950000 USING AVWXTABL,RAT NOTE MAIN USING 09952000 $SAVE RGS=(R14-R6),BR=R13,SA=COSAVE 09954000 SPACE 1 09956000 * INITIALIZATION OF REGISTERS, CONSTANT BLOCK, FLAGS. 09958000 LR R0,RB SAVE R0=0==>DS,R0=4==>DC 09960000 SR RB,RB SHOW NO ERRORS AT BEGINNING 09962000 LA R1,1 HANDY CONSTANT 09964000 LR RY,R1 SET DEFAULT DUPLICATION FACTOR=1 09966000 LM R2,R4,AWZEROS ZERO POINTER REG,LENGTH,#OF CONSTS 09968000 STM R2,R3,COBLK ZERO OUT BLOCK 09970000 MVI CODXLEN+1,0 INITIALIZE TO NO EXPLICIT LENGTH 09972000 SPACE 1 09974000 * BEGIN PROCESSING OF DUPLICATION FACTOR, IF PRESENT. 09976000 BAL R14,CODNUM GO GET DUPLICATION FACTOR 09978000 B CODLOOK NO DUPLICATION FACTOR,SKIP 09980000 SPACE 1 09982000 * DUPLICATION FACTOR EXPLICIT-CHECK IT,MOVE TO RY. * 09984000 C RC,AWFX7FFF =XL4'7FFF' COMPARE TO MAX SIZE LEGAL 09986000 BH CODEDUPL BRANCH IF TOO BIG 09988000 LTR RY,RC MOVE FACTOR OVER AND TEST 09990000 BNZ CODLOOK BRANCH IF DEFINITELY LEGAL 09992000 C R0,AWF7 0 DUPLICATION FACTOR, IS IT LITERL 09994000 BNL CODEDUPL BRANCH - 0 DUPLFAC IN LITERAL -ERROR 09996000 SPACE 1 09998000 * CHECK TYPE FOR LEGALITY. GET ADDR OF CONBLK ENTRY. * 10000000 CODLOOK CLI 0(RA),C'A' MAKE SURE LEGITAMATE 10002000 BL CODERTYP NO,IT IS AN ERROR 10004000 IC R2,0(RA) GET THE TYPE CODE 10006000 IC R2,CODINXO(R2) GET OFFSET INTO CONTABL ENTRIES 10008000 LTR R2,R2 IS THE TYPE LEGAL 10010000 BZ CODERTYP NO,ERROR 10012000 SPACE 1 10014000 LA R2,CONTAB1(R2) GET ACTUAL ADDRESS OF RIGHT ENTRY 10016000 USING CONBLK,R2 NOTE DUMMY SECT FOR CONTABL ENTRY 10018000 MVC COTYP,CONTYP MOVE TYPE+FLAGS OVER 10020000 AR RA,R1 INCREMENT SCAN POINT BEYOND TYPE 10022000 SPACE 1 10024000 * CHECK FOR EXPLICIT LENGTH SPECIFICATION,EVAL IT IF SO. * 10026000 CLI 0(RA),C'L' IS THERE A LENGTH SPECIFICATION 10028000 BNE CODEFAL NO,USE DEFAULT LENGTH 10030000 EJECT 10032000 * LENGTH EXPLICITLY SUPPLIED - PROCESS IT,NOTE NO ALIGN. * 10034000 AR RA,R1 INCREMENT SCAN POINTER TO BEYOND L 10036000 BAL R14,CODNUM GO GET LENGTH 10038000 B CODINVD INVALID DELIMITER OR SOMETHING 10040000 CODEDL LR RW,RC MOVE LENGTH OVER 10042000 SR RW,R1 DECREMENT TO LENGTH-1 10044000 NI COTYP,255-$CNALN WIPE OUT ALIGNMENT FLAG,IF ANY 10046000 MVI CODXLEN+1,X'F0' MAKE NOP A BRANCH-EXPLICIT LENGTH 10048000 SPACE 1 10050000 * CHECK EXPLICIT LENGTH FOR BEEING IN RIGHT RANGE. 10052000 SR RD,RD CLEAR REG FOR INSERT 10054000 IC RD,CONLLW GET LOWEST LIMIT VALUE 10056000 CR RW,RD IS LENGTH TOO LOW 10058000 BL CODLBAD ILLEGAL LENGTH 10060000 IC RD,CONLHI GET HIGH LIMIT ON LENGTH-1 10062000 CR RW,RD COMPARE TO SEE IF HIGH 10064000 BNH CODCONGO THE LENGTH IS IN RANGE 10066000 LTR R0,R0 IS THIS IN A DS 10068000 BNZ CODEBIG NO,IT IS DC, THEREFORE ILLEGAL 10070000 SPACE 1 10072000 * NOTE C & X DC'S MAY EXCEED NORMAL 256 LENGTH LIMIT. 10074000 CLI CONTYP,$CNVLN+$CNC IS IT C TYPE 10076000 BE CODCONGO YES,SO IT IS OK 10078000 CLI CONTYP,$CNVLN+$CNX IS IT HEX CONST 10080000 BE CODCONGO YES,SO ITS OK 10082000 B CODEBIG NO,IT IS TOO LARGE,SINCE NOT X OR C 10084000 SPACE 1 10086000 CODEFAL IC RW,CONLEN GET DEFALUT LENGTH-1 10088000 * HAVE GOTTEN DUPFAC-TYPE-LENGTH,NOW SCAN FOR CONSTANT. * 10090000 CODCONGO CLI 0(RA),C' ' CHECK,IS THIS THE END 10092000 BE *+12 SKIP NEXT 2 INSTS==> NO OPERAND 10094000 CLI 0(RA),C',' CHECK FOR , AFTER LENGTH 10096000 BNE CODOPR NO,THERE'S STILL MORE 10098000 LTR R0,R0 IF FIELD OMITTED,MUST BE DS 10100000 BNZ CODEOMOP OMITTED OPERAND IN DC==>ERROR 10102000 BXLE RX,R1,CODFIN SET # OEPRANDS = 1 AND BRANCH 10104000 SPACE 1 10106000 * GET ADDRESS OF APPROPRIATE PASS 1 CONSTANT SUB&CALL IT * 10108000 CODOPR CLC 0(1,RA),CONLD IS THE LEFT DELIMITER OK 10110000 BNE CODINVD NO IT ISNT-BRANCH TO ERROR 10112000 AR RA,R1 BUMP SCAN POINTER TO 1ST CHAR OF CON 10114000 IC RD,CONTYP GET TYPE VALUE 10116000 N RD,AWFXF =XL4'F' WIPE OUT FLAG BITS FROM NIBL 10118000 IC RD,AWCONADS(RD) GET OFFSET TO ADDR OF TYPE 10120000 $GTAD R0,C$BASE(RD) GET @ PASS 1 ROUTINE - C#CON1 10122000 $SCOF R15,RA,COSCAN GET THE OFFSET AND SAVE IT 10124000 EJECT 10126000 * CONSTANT TYPE KNOWN. CALL ROUTINE TO PROCESS IT. * 10128000 CODCALL LR REP,R0 MOVE ADDRESS OV ROUTIN OVER 10130000 BALR RET,REP CALL THE ROUTINE 10132000 LTR RB,RB WAS THERE AN ERROR 10134000 BNZ CODRETA YES,RETURN WITH THE RROR 10136000 AR RX,R1 INCREMENT THE # OF OPERANDS 10138000 CLC 0(1,RA),CONRD IS DELIM THE RIGHT DELIM 10140000 BE CODCONA YES,THIS IS END OF OPERAND 10142000 * THE FOLLOWING TAKES CARE OF MULTIPLE OPERANDS WHERE OK * 10144000 CLI 0(RA),C',' IS DELIMITER RIGHT 10146000 BNE CODINVD NO,IT IS BAD DELIMITER 10148000 TM COTYP,$CNMUL ARE MULTIPLE DELIMS ALLOWED 10150000 BZ CODINVD SKIP IF THEY AREN'T ERROR 10152000 BXH RA,R1,CODCALL BUMP SCAN POINTER AND CALL ROUTINE 10154000 SPACE 1 10156000 * HAVE PROCESSED WHOLE OPERAND. CHECK FOR OVERRIDE LENGTH* 10158000 CODCONA AR RA,R1 INCREMENT SCAN POINTER 10160000 CODXLEN BC $CHN,CODFIN BRANCH IF LENGTH EXPLICIT,NOP IFNOT 10162000 TM COTYP,$CNVLN WAS LENGTH VARIABLE,ALLOWING OVERD 10164000 BZ CODFIN NO,LEAVE THE LENGTH ALONE 10166000 LR RW,RC MOVE THE RETURNED LENGTH OVER 10168000 SR RW,R1 DECREMENT BY 1 TO GET CONSISTENT 10170000 SPACE 1 10172000 * STORE FLAGS INTO COBLK. COMPUTE TOTAL LENGTH INTO RE * 10174000 CODFIN STC RX,CONUM STORE NUMBER OF OPERANDS 10176000 STC RW,COLEN SAVE THE LENGTH-1 OF OPERAND 10178000 LTR RE,RY MOVE OVER AND TEST DUPL FACTOR 10180000 BZ CODRETA YES,0 DUP FACTOR-0 EVERYTHING 10182000 STH RY,CODUP STORE A NONZERO DUPLICATION FACTOR 10184000 BAL R14,*+6 SKIP 1ST AR AND GO TO BCTR 10186000 AR RE,RY ADD DUPLFAC TO SLEF 10188000 BCTR RX,R14 LOOP ON NUMBER OF CONSTANTS IN OPRND 10190000 * DUPLICATION FACTOR * NUMBER OF OPERANDS IS IN RE * 10192000 CR RE,R1 IS DUP FAC*#OPERANDS =1 10194000 BNE CODMULT IF NOT,GIVE UP AND MULTIPLY 10196000 LA RE,1(RW) MOVE THE LENGTH OVER&ADD 1 10198000 B CODSTOR HAVE LENGTH SAVED AND QUIT 10200000 CODMULT AR RW,R1 INCREMENT LENGTH-1 TO LENGTH 10202000 MR RD,RW MULTIPLY TO GET TOTL LENGTH 10204000 CODSTOR STH RE,COTOT SAVE THE TOTAL LENGTH 10206000 CL RE,AWFX7FFF MAKE SURE WHOLE LENGTH NOT TOO BIG 10208000 BH CODEBIG TOTAL LENGTH IS TOO BIG 10210000 * POINT AT THE COBLK AND RETURN * 10212000 CODRETA LA RC,COBLK SHOW ADDRESS OF OUR CODE BLOCK 10214000 CODRET $RETURN RGS=(R14-R6) 10216000 EJECT 10218000 * * * * * CODNUM - CALLED TO EVALUATE DUPLICATION FACTOR OR LENGTH - * 10220000 * RETURNS 0(R14) IF EXPRESSION OMITTED. RETURNS TO 4(R14) IF OK* 10222000 * RC HAS VALUE OF EXPRESSION * 10224000 CODNUM LA RZ,4(R14) SET UP GOOD RETURN FOR SECTIONS 10226000 CLI 0(RA),C'0' DO WE HAVE DECIMAL NUMBER 10228000 BNL CODECAL YES,DECIMAL NUMBER,GO CONVERT 10230000 CLI 0(RA),C'(' EITHER EXPRESSION,OR OMITTED 10232000 BCR NE,R14 RETURN IF IT WAS OMITTED 10234000 SPACE 1 10236000 * IF FALLS THRU==>EXPRESSION,ENCLOSED IN PARENS. EVALUATE* 10238000 C R0,AWF7 ARE WE IN LITERAL 10240000 BH CODESYNT YES, ILLEGAL DUPLFAC OR LENGTH 10242000 AR RA,R1 BUMP SCAN POINTER PAST 1ST ( 10244000 $CALL EVALUT 10246000 LTR RB,RB CHECK FOR ERROR 10248000 BNZ CODRET RETURN WITH ERROR CODE IF SO 10250000 LTR RD,RD WAS IT RELOCATABLE 10252000 BNZ CODNEABS RELOCATABLE RELOCATION FACTOR,ERROR 10254000 CLI 0(RA),C')' SEE IF THIS WAS END 10256000 BNE CODINVD INVALID DELIMITER IF NOT 10258000 BXH RA,R1,0(RZ) INCREMENT SCAN POINTER PAST ) AND BR 10260000 SPACE 1 10262000 * DUPLFAC OR LENGTH WAS DECIMAL NUMBER. GET ITS VALUE * 10264000 CODECAL $CALL SDDTRM GET DECIMAL SELF-DEFINING TERM 10266000 LTR RB,RB WAS THERE AN ERROR 10268000 BCR Z,RZ RETURN IF THE NUM WAS OK 10270000 B CODRET RETURN WITH ERROR CODE IN RB 10272000 SPACE 1 10274000 * * * * * INDIVIDUAL ERROR CODE SECTIONS * 10276000 CODERTYP LA RB,$ERCNTYP UNKNOWN TYPE OF CONSTANT 10278000 B CODRET RETURN SHOWING ERROR 10280000 CODEOMOP LA RB,$ERNOOPR MISSING OPERAND(CONSTANT) 10282000 B CODRET RETURN SHOWING ERROR 10284000 CODEBIG LA RB,$EREXGTA NUMBER OR EXPRESSION TOO LARGE 10286000 B CODRET RETURN SHOWING ERROR 10288000 CODLBAD LA RB,$EREXLTA NUMBER OR EXPRESSION TOO SMALL P 10290000 B CODRET RETURN SHOWING ERROR 10292000 CODINVD LA RB,$ERINVDM INVALID DELIMITER 10294000 B CODRET RETURN,SHOWING ERROR CODE 10296000 CODNEABS LA RB,$ERNEABS ABSOLUTE EXPRESSION REQUIRED 10298000 B CODRET RETURN 10300000 CODESYNT LA RB,$ERVSYNT SYNTAX - ILLEGAL () IN LITERAL 10302000 B CODRET RETURN 10304000 CODEDUPL LA RB,$ERDUPLF ILLEGAL DUPLICATION FACTOROR 10306000 B CODRET RETURN 10308000 EJECT 10310000 * * * * * INTERNAL CONSTANTS * 10312000 CODINX DC XL(256-C'A')'0' CONSTANT INDEX TABLE 10314000 CODINXO EQU CODINX-C'A' GET SYMBOL WITH OFFSET 10316000 CONTABL EQU * BEGINNING OF CONSTANT DESCRIPTOR TAB 10318000 CONTAB1 EQU CONTABL-1 GET OFFSET SYMBOL SO OFFSETS NOT ZER 10320000 CONG A,$CNALN+$CNMUL,4,LD='(',RD=')',HI=4 10322000 CONG B,$CNVLN,1,HI=256,E=0 10324000 CONG C,$CNVLN,1,HI=256,E=0 10326000 CONG D,$CNALN+$CNMUL,8 10328000 CONG E,$CNALN+$CNMUL,4 10330000 CONG F,$CNALN+$CNMUL,4 10332000 CONG H,$CNALN+$CNMUL,2 10334000 CONG P,$CNVLN+$CNMUL,1,HI=16,E=0 10336000 CONG V,$CNALN+$CNMUL,4,LD='(',RD=')',LW=3,HI=4 10338000 CONG X,$CNVLN,1,HI=256,E=0 10340000 CONG Z,$CNVLN+$CNMUL,1,HI=16,E=0 10342000 LTORG 10344000 SPACE 1 10346000 * * * * * INTERNAL VARIABLES * 10348000 * * * * * COBLK AREA - SET UP LIKE CNCBLOCK FOR CONSTANT CODES * 10350000 COBLK DS 0D INTERNAL CONSTANT BLOCK LIKE CNCBLK 10352000 COTYP DS C TYPE + FLAGS 10354000 COLEN DS C LENGTH-1 OF CONSTANT OPERAND 10356000 COSCAN DS C SCAN POINTER OFFSET TO START OF CONS 10358000 CONUM DS C NUMBER OF OPERANDS IN CONSTANT 10360000 CODUP DS H DUPLICATION FACTOR 10362000 COTOT DS H TOTAL LENGTH OF CONSTANT 10364000 SPACE 1 10366000 **--> DSECT: CONBLK CONSTANT DESCRIPTOR CODES BLOCK(CODTL1) . . . . 10366100 *. THIS BLOCK CONTAINS DATA FOR A GIVEN CONSTANT TYPE, AND IS . 10366200 *. USED BY ASSEMBLER SUBR. CODTL1 IN SCANNING CONSTANTS AND . 10366300 *. BUILDING CNCBLOCKS DURING ASSEMBLY PASS 1. THE DATA . 10366400 *. GIVEN INCLUDES A FLAG BYTE, DEFAULT LENGTH-1, LEFT AND . 10366500 *. RIGHT DELIMITER CHARACTERS REQUIRED FOR THE CONSTANT, AND . 10366600 *. MINIMUM AND MAXIMUM VALUES FOR THE LENGTH-1 OF THE CONSTANT. . 10366700 *. THE FLAG BYTE, WITH MODIFICATIONS, BECOMES THE CNCTYPE BYTE . 10366800 *. OF THE CNCBLOCK CREATED FOR EACH CONSTANT OPERAND. . 10366900 *. LOCATION: TABLE CONTABL OF CSECT CODTL1 . 10367000 *. GENERATION: 1 CALL TO MACRO CONG CREATES A CONBLK ENTRY. . 10367100 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10367200 SPACE 1 10368000 CONBLK DSECT 10370000 CONTYP DS C CONSTANT TYPE+ FLAGS 10372000 CONLEN DS C DEFAULT LENGTH 10374000 CONLD DS C LEFT DELIMITER 10376000 CONRD DS C RIGHT DELIMITER 10378000 CONLLW DS C LOWEST VALUE OF LENGTH-1 10380000 CONLHI DS C HIGHEST VALUE OF LENGTH-1 10382000 DROP RAT,R13,R2 CLEAN UP USING 10384000 TITLE '*** CPCONS - PACKED DECIMAL CONSTANTS ***' 10386000 **--> CSECT: CPCONS 1-2 PROCESS PACKED CONSTANTS. . . . . . . . . . . 10388000 *. USES DSECTS: AVWXTABL . 10389000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10390000 CPCONS CSECT 10392000 $DBG A0,SNAP 10394000 ENTRY CPCON1,CPCON2 PASS 1 AND 2 ENTRIES 10396000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 10398000 SPACE 2 10400000 **--> ENTRY: CPCON1 1 SCAN,DO NOT ASSEMBLE PACKED CONSTATNT . . . . 10402000 *. ENTRY CONDITIONS . 10404000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10406000 *. EXIT CONDITIONS . 10408000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10410000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10412000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 10414000 *. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 10416000 *. USES MACROS: $RETURN,$SAVE . 10417500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10418000 CPCON1 $SAVE SA=NO 10420000 SR RC,RC CLEAR FOR USE AS FLAG 10422000 LA RD,32 (MAX # DIGITS IN CONST) + 1 AS LIMIT 10424000 LA RE,1 FOR INCREMENTING AND DECREMENTING 10426000 CLI 0(RA),C'+' IS THERE A + SIGN NEXT 10428000 BE CP1LOOP YES,BRANCH TO INCREMENT SCAN PTR 10430000 CLI 0(RA),C'-' IS IT - SIGN 10432000 BNE *+6 SKIP BUMPING SCAN PTR IF SO 10434000 SPACE 1 10436000 CP1LOOP AR RA,RE BUMP SCAN POINTER BY 1 10438000 CLI 0(RA),C'0' IS NEXT CHAR A DIGIT 10440000 BL CP1NODIG BRANCH IF NOT - SOME PUNCTUATION 10442000 BCT RD,CP1LOOP DIGIT-DECREMENT LIMIT COUNTER,BRANCH 10444000 B CP1INVCN INVALID (TOO LONG) 10446000 SPACE 1 10448000 CP1NODIG CLI 0(RA),C'.' WAS NON-DIGIT A PERIOD 10450000 BNE CP1QUOT NO,MUST BE ENDING ' OR , 10452000 BXLE RC,RE,CP1LOOP SET RC=1, BRANCH BACK IF 1ST TIME 10454000 CP1INVCN LA RB,$ERINVCN 2 PERIODS, OR OTHER ERROR 10456000 B CP1RET GO RETURN WITH ERROR MESSAGE 10457000 SPACE 1 10458000 CP1QUOT CLI 0(RA),C'''' WAS ENDING MARK A QUOT 10460000 BE CP1DONE YES,OK,BRANCH 10462000 CLI 0(RA),C',' WERE MULTIPLE OPS USED 10464000 BNE CP1INVCN INVALID (PROBABLY DELIMITER) 10466000 SPACE 1 10468000 CP1DONE SR RB,RB SHOW NO ERRRORS 10470000 LA RC,32 (MAX # DIGITS + 1) FOR SUBTRCT 10472000 SR RC,RD SUBTRACT COUNTER = ACTUAL # DIGITS 10474000 BZ CP1INVCN IF 0 DIGITS, QUIT - NULL CONTSNAT 10475000 SRA RC,1 SHIFT TO GET # OF BYTES REQUIRED 10476000 AR RC,RE HAD # BYTES - 1, NOW GET # BYTES 10478000 CP1RET $RETURN SA=NO 10482000 EJECT 10484000 **--> ENTRY: CPCON2 1-2 SCAN AND ASSEMBLE P TYPE CONSTANT . . . . . . 10486000 *. ENTRY CONDITIONS . 10488000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10490000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 10492000 *. EXIT CONDITIONS . 10494000 *. RA = SCAN POINTER TO DELIMITER ENDING SCAN . 10495000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10496000 *. USES MACROS: $RETURN,$SAVE,$SETRT . 10497000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10498000 CPCON2 $SAVE RGS=(R1-R2),SA=NO 10500000 MVC AVCONBLD(16),AWZEROS ZERO OUT WORK AREA 10502000 LA RC,AVCONBLD(RB) @ LAST BYTE OF ASSEMBLED CONSTANT 10504000 LA RE,1 FOR INCREMENTING,DECREMENTING 10506000 AR RB,RE RB = ACTUAL # OF BYTES DESIRED 10508000 SR R1,R1 CLEAR FOR INSERTION OF ADDRESS 10510000 $SETRT ('''',1,',',1) SET UP TABLE FOR SCANNING 10512000 TRT 1(32,RA),AWTZTAB SIGN+PERIOD+31 DIGS-1 = 32 MAX LEN 10514000 $SETRT ('''',0,',',0) RESET TABLE TO ZEROS 10516000 MVI CP2BRNCH+1,0 MAKE BRANCH A NOOP INITIALLY 10518000 LA RD,X'F0' MASK FOR REMOVING ZONE NIBBLES 10520000 MVI 0(RC),X'C' INIT SIGN TO A PLUS SIGN 10522000 CLI 0(RA),C'+' WAS PLUS THERE 10524000 BE CP2LOAD YES,SKIP 10526000 CLI 0(RA),C'-' WAS MINUS THERE 10528000 BNE CP2LOAD NO,MUST BE DIGIT OR PERIOD 10530000 MVI 0(RC),X'D' PLACE DECIMAL MINUS SIGN IN CONST 10532000 CP2LOAD LR RA,R1 DUPLICATE @ ENDING PUNCTUATION 10534000 SR R1,RE BACK POINTER UP TO LAST DIG IN CONST 10536000 SPACE 1 10538000 CP2NUMBR CLI 0(R1),C'0' ARE WE LOOKING AT DIGIT 10540000 BL CP2NODIG NOT DIGIT-BRANCH 10542000 IC R2,0(R1) GET THE DIGIT 10544000 CP2BRNCH BC $CHN,CP2EVEN COMMUTATOR - B(EVEN) NOOP(ODD) 10546000 SLL R2,4 ODD DIGIT - GET INTO LEFT NIBBLE 10548000 STC R2,*+5 PLACE INTO OI INSTRUCTION FOLLOWING 10550000 OI 0(RC),$CHN WILL OR IN 1 NIBBLE TO CONSTANT 10552000 SR RC,RE BACK POINTER UP,HAVE FINISHED THIS 1 10554000 BCT RB,CP2FLIP DECREMENT COUNTER,BRANCH IF MORE 10556000 B CP2RETA HAVE DONE REQUIRED # - NOW RETURN 10558000 SPACE 1 10560000 CP2EVEN SLR R2,RD REMOVE THE ZONE NIBBLE FROM DIGIT 10562000 STC R2,0(RC) STORE THE NUMERIC INTO CONSTNT 10564000 CP2FLIP XI CP2BRNCH+1,X'F0' FLIP COMMUTATOR SWITCH/EVEN/ODD 10566000 CP2DECR BCT R1,CP2NUMBR DECREM SCN PTR, BRANCH ALWAYS 10568000 SPACE 1 10570000 CP2NODIG CLI 0(R1),C'.' WAS NON-DGIT THE PERIOD 10572000 BE CP2DECR YES,DECREM SCAN PTR AND GET NEXT 10574000 SPACE 1 10576000 CP2RETA LA RC,AVCONBLD SHOW @ OF CONSTT,WITH L-PAD ZEROS 10578000 CP2RET $RETURN SA=NO,RGS=(R1-R2) 10580000 DROP RAT,REP KILL USINGS 10582000 TITLE '*** CVCONS - V-TYPE ADDRESS CONSTANT PROCESSING ***' 10584000 **--> CSECT: CVCONS 1-2 PROCESS V-TYPE ADCONS . . . . . . . . . . . . 10586000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10588000 CVCONS CSECT 10590000 $DBG A0,SNAP 10592000 USING AVWXTABL,RAT NOTE MAIN USING 10594000 ENTRY CVCON1,CVCON2 10596000 SPACE 2 10598000 **--> ENTRY: CVCON1 1 SCAN V-TYPE CONST, NO ASSEMBLE. . . . . . . . 10600000 *. ENTRY CONDITIONS . 10602000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10604000 *. EXIT CONDITIONS . 10606000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10608000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10610000 *. RB = NONZERO VALUE - ILLEGAL SYMBOL ($ERINVSY) . 10612000 *. USES DSECTS: AVWXTABL . 10613000 *. USES MACROS: $RETURN,$SAVE . 10613500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10614000 CVCON1 $SAVE RGS=(R1-R2),SA=NO 10616000 SR R1,R1 CLEAR FOR ADDRESS INSERT 10618000 TRT 0(9,RA),AWTSYMT SCAN FOR SYMBOL DELIMITER 10620000 BZ CVC1ERR ERROR IF NOT FOUND 10622000 CLI 0(RA),C'0' IS 1ST CHAR LETTER 10624000 BNL CVC1ERR NO-ERROR BRANCH 10626000 CR R1,RA MAKE SURE NOT NULL 10628000 BE CVC1ERR NULL ERROR-BRANCH 10630000 SR RB,RB SHOW OK 10632000 LR RA,R1 MOVE SCAN POINTER OVER 10634000 CVC1RET $RETURN RGS=(R1-R2),SA=NO 10636000 CVC1ERR LA RB,$ERINVSY INVALID SYMBOL 10638000 B CVC1RET RETURN 10640000 EJECT 10642000 **--> ENTRY: CVCON2 2 SCAN&ASSEMBLE VCON. . . . . . . . . . . . . . 10644000 *. ENTRY CONDITIONS . 10644500 *. RA = SCAN POINTER TO FIRST CHARACTER OF VCON. . 10645000 *. EXIT CONDITIONS . 10645500 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10646000 *. RB = 0 ==> NO ERRORS, NONZERO ==> ERROR CODE . 10648000 *. = NONZERO ERROR CODE ($ERUNRV OR $ERRELOC). . 10650000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10652000 *. CALLS SYFIND . 10654000 *. CALLS RESYMB (ONLY IF &$REPL=2 AND EXTRN SYMBOL USED). . 10654500 *. USES DSECTS: AVWXTABL,SYMSECT . 10655000 *. USES MACROS: $CALL,$RETURN,$SAVE . 10655500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10656000 CVCON2 $SAVE RGS=(R14-R2),BR=R13,SA=CVCOSAVE 10658000 LR R0,RB SAVE LENGTH-1 OF SSEMBLY 10660000 SR R1,R1 CLEAR FOR ADDRESS INSERT 10662000 TRT 0(9,RA),AWTSYMT SCAN SYMBOL 10664000 LR RB,R1 MOVE SCAN POINTER TO END BACK 10666000 SR RB,RA GET LENGTH OF SYMBOL 10668000 $CALL SYFIND LOOK UP SYMBOL 10670000 LTR RB,RB WAS IT FOUND 10672000 BNZ CVCONUNR UNRESOLVED REFERENCE 10674000 SPACE 1 10676000 USING SYMSECT,RA NOTE USING 10678000 AIF (&$REPL LT 2).CVNREPL SKIP IF NO REPL CALLS 10679000 TM SYFLAGS,$SYEXT WAS IT FLAGGED EXTRN 10679050 BZ CVC2NOEX NO, SO SKIP CALLING CODE 10679100 L R15,CVRESYMB GET =V(RESYMB) 10679150 BALR R14,R15 CALL HIM 10679200 LTR RB,RB WAS NAME LEGITAMATE 10679250 BZ CVC2VAL YES, RESYMB PUT VALUE INTO TABLE 10679300 B CVCONUNR NO, SO EXTRN, THUS UNRESOLVED 10679350 CVRESYMB DC V(RESYMB) SYMBOL CHECKING MODULE 10679400 CVC2NOEX EQU * BRANCH HERE IF NOT EXTRN SYMBOL 10679450 .CVNREPL ANOP 10679500 SPACE 1 10679550 TM SYFLAGS,$SYDEF IS IT DEFINED 10680000 BZ CVCONUNR NO, UNDEFINED, UNRESOLVED 10682000 TM SYFLAGS,$SYENT+$SYCSE IS IT EITHER CSECT OR ENTR 10684000 BZ CVCONUNR NO-ERROR 10686000 * CHECK TO SEE IF SYMBOL WAS A DSECT SYMBOL. 10688000 TM SYESDID,$ESDSECT WAS IT A DSECT 10688200 BZ CVC2VAL NO, OK, BRANCH 10688400 LA RB,$ERRELOC SHOW ERROR NOT ALLOWED 10688600 B CVC2RETA EXIT WITH ERROR 10688800 CVC2VAL LCR RE,R0 NEGATIVE OF LENGTH-1 FOR OFFSET 10690000 LA RC,SYVALUE+3(RE) GET ACTUAL STARTIN @ OF CONSTANT 10692000 SPACE 1 10694000 CVC2RETA LR RA,R1 MOVE SCAN POINTER BACK 10696000 CVC2RET $RETURN RGS=(R14-R2) 10698000 CVCONUNR LA RB,$ERUNRV UNRESOLVED EXTERNAL REFERENCE 10700000 B CVC2RETA RETURN 10702000 DROP RAT,RA,R13 REMOVE USINGS 10708000 TITLE '*** CXCONS - SCAN AND/OR ASSEMBLE HEX CONSTANTS ***' 10710000 **--> CSECT: CXCONS 1-2 PROCESS HEXADECIMAL CONSTANTS . . . . . . . . 10712000 *. USES DSECTS: AVWXTABL . 10713000 *. USES MACROS: $RETURN,$SAVE . 10713500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10714000 CXCONS CSECT 10716000 $DBG A0,SNAP 10718000 ENTRY CXCON1,CXCON2 10720000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 10722000 SPACE 2 10724000 **--> ENTRY: CXCON1 1 SCAN HEX CONST, DO NOT ASSEMBLE . . . . . . . 10726000 *. ENTRY CONDITIONS . 10728000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10730000 *. EXIT CONDITIONS . 10732000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10734000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10736000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 10738000 *. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 10740000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10742000 CXCON1 $SAVE RGS=(R1-R2),SA=NO 10744000 SR R1,R1 CLEAR FOR INSERTION OF ADDRESS HERE 10746000 TRT 0(256,RA),AWTHEXT SCAN AND CHECL CHARACTERS 10748000 CLI 0(R1),C'''' DELIMITER MUST BE A ' 10750000 BNE CX1ERR IF NOT,IT IS ERROR 10752000 LA RC,1(R1) GET END POINTER +1 10754000 SR RC,RA GET # OF HEX DIGITS+1 10756000 SRA RC,1 DIVIDE BY 2 FOR NUMBER OF BYTES 10758000 BZ CX1ERR NULL CONST==> ERROR BRANCH 10760000 SR RB,RB CLEAR REG TO SHOW A LEGAL CONST 10762000 CX1RETA LR RA,R1 GET SCAN POINTER OVER 10764000 CX1RET $RETURN RGS=(R1-R2),SA=NO 10766000 CX1ERR LA RB,$ERINVCN INVALID CONST (OR ILLEGAL DELIM) 10768000 B CX1RETA GO RETURN 10770000 EJECT 10772000 **--> ENTRY: CXCON2 1-2 ASSEMBLE HEX CONSTANT . . . . . . . . . . . . 10774000 *. ENTRY CONDITIONS . 10776000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10778000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 10780000 *. EXIT CONDITIONS . 10782000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10784000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10786000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10788000 CXCON2 $SAVE RGS=(R0-R2),SA=NO 10790000 SR R1,R1 CLEAR FOR TRT 10792000 SR R2,R2 CLEAR FOR LATER INSERTS 10794000 STC RB,*+5 STORE LENGTH-1 INTO MVC 10796000 MVC AVCONBLD($CHN),AWZEROS ZERO, IN CASE PADDING 10798000 L RC,AWFM1 GET =F'-1' FOR DECREMENT 10800000 TRT 0(256,RA),AWTHEXT SCAN FOR ENDING ' 10802000 MVI CX2EVOD+1,X'F0' SET UP BRANCH FOR ODD 1ST TIME 10804000 LA RD,0(RC,R1) GET @ LAST DIGIT OF CONST 10806000 SR RD,RA GET NUMBER OF HEX DIGITS IN CONST 10808000 SPACE 1 10810000 CX2HGET IC R2,0(RD,RA) GET THE NEXT HEX DIGIT 10812000 CX2EVOD BC $CHN,CX2ODD BRANCH IF ODD (FROM RIGHT END) 10814000 IC RE,AWTHEX2(R2) GET VALUE OF THE BYTE 10816000 SLL RE,4 SHIFT IT OVER 10818000 ALR RE,R0 ADD ODD BYTE TO THE EVEN ONE 10820000 STC RE,AVCONBLD(RB) STORE COMPLETED BYTE IN PLACE 10822000 BXH RB,RC,CX2FLIP DECREMENT REMAIN COUNT 10824000 B CX2RETA BRANCH IF EXACT OR TRUNCATION P 10826000 SPACE 10828000 CX2ODD IC R0,AWTHEX2(R2) GET THE VALUE OF THE DIGIT 10830000 CX2FLIP XI CX2EVOD+1,X'F0' SWITH B ODD, NOOP EVEN & VICE VRSA 10832000 BXH RD,RC,CX2HGET DECREMENT DIGITS REAMINING,LOOP 10834000 SPACE 1 10836000 * FALLS THRU ==> MAY BE ODD # DIGITS,STORE LAST IF SO * 10838000 CLI CX2EVOD+1,X'F0' WAS LAST DIGIT DONE AN EVEN ONE 10840000 BE *+8 YES,SO DON'T STORE ODD ONE 10842000 STC R0,AVCONBLD(RB) STORE INTO POSITION 10844000 CX2RETA LA RC,AVCONBLD SHOW @ CONSTANT 10846000 LR RA,R1 SHOW SCAN PTR TO DELIMITING ' 10848000 CX2RET $RETURN RGS=(R0-R2),SA=NO 10850000 DROP RAT,REP CLEAN UP USING 10852000 LTORG 10854000 TITLE '*** CZCONS - ZONED DECIMAL CONSTANTS ***' 10856000 **--> CSECT: CZCONS 1-2 PROCESS ZONED CONSTS. . . . . . . . . . . . . 10858000 *. USES DSECTS: AVWXTABL . 10859000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10860000 CZCONS CSECT 10862000 $DBG A0,SNAP 10864000 ENTRY CZCON1,CZCON2 10866000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 10868000 SPACE 2 10870000 **--> ENTRY: CZCON1 1 SCAN, BUT DO NOT ASSEMBLE . . . . . . . . . . 10872000 *. ENTRY CONDITIONS . 10874000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10876000 *. EXIT CONDITIONS . 10878000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10880000 *. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10882000 *. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 10884000 *. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 10886000 *. USES MACROS: $RETURN,$SAVE . 10887500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10888000 CZCON1 $SAVE SA=NO 10890000 SR RC,RC CLEAR FLAG FOR # OF PERIODS 10892000 LA RD,17 (MAX @ DIGITS) +1 10894000 LA RE,1 FOR INCREMENTING AND DECREMENTING 10896000 CLI 0(RA),C'+' IS THERE PLUS SIGN 10898000 BE CZ1LOOP YES,GO BUMP SCAN PTR 10900000 CLI 0(RA),C'-' IS THERE MINUS 10902000 BNE *+6 SKIP IF NOT 10904000 SPACE 1 10906000 CZ1LOOP AR RA,RE BUMP SCAN PTR BY 1 10908000 CLI 0(RA),C'0' IS NEXT CHAR A DIGIT 10910000 BL CZ1NODIG BRANCH IF NO DIGIT 10912000 BCT RD,CZ1LOOP DECREMENT LIMIT,BRANCH IF OK 10914000 B CZ1INVCN GO FLAG (TOO MANY DIGITS) 10916000 SPACE 1 10918000 CZ1NODIG CLI 0(RA),C'.' WAS NONDIGIT A PERIOD 10920000 BNE CZ1QUOT NO,MUST BE ' OR , 10922000 BXLE RC,RE,CZ1LOOP SET RC=1,BRANCH IF FIRST TIME 10924000 B CZ1INVCN 2 PERIODS - ERROR - BRANCH 10926000 SPACE 1 10928000 CZ1QUOT CLI 0(RA),C'''' WAS DELIMITER ' 10930000 BE CZ1DONE YES,QUIT 10932000 CLI 0(RA),C',' WAS DELIMITER , 10934000 BNE CZ1INVCN INVALID CONSTANT 10936000 SPACE 1 10938000 CZ1DONE SR RB,RB SHOW NO ERROR 10940000 LA RC,17 (MAX @ DIGITS+1) 10942000 SR RC,RD GET ACTUAL # BYTES REQUIRED 10944000 BNZ CZ1RET BRANCH IF LEGAL (NONZERO) LENGTH 10946000 CZ1INVCN LA RB,$ERINVCN SHOW INVALID CONSTANT 10948000 CZ1RET $RETURN SA=NO 10950000 EJECT 10952000 **--> ENTRY: CZCON2 1-2 SCAN AND ASSEMBLE Z-TYPE CONSTANT . . . . . . 10954000 *. ENTRY CONDITIONS . 10956000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10958000 *. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 10960000 *. EXIT CONDITIONS . 10962000 *. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10964000 *. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10966000 *. USES MACROS: $RETURN,$SAVE,$SETRT . 10967500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10968000 CZCON2 $SAVE SA=NO,RGS=(R1-R2) 10970000 MVI AVCONBLD,C'0' SET UP FOR PUTTING ZEROES 10972000 MVC AVCONBLD+1(14),AVCONBLD PROPAGATE DECIMAL 0'S 10974000 LA RC,AVCONBLD(RB) @ LAST BYTE OF CONSTANT 10976000 LA RE,1 HANDY CONST FOR INCREM-DECREM 10978000 AR RB,RE RB = # OF BYTES REQUIRED 10980000 LR RD,RC SAVE @ LAST BYTE FOR SIGN LATER 10982000 SR R1,R1 CLEAR FOR @ INSERTION 10984000 $SETRT ('''',1,',',1) SET UP TABLE FOR SCAN 10986000 TRT 1(17,RA),AWTZTAB SCAN TO ENDING DELIMITER 10988000 $SETRT ('''',0,',',0) ZERO TABLE OUT AGAIN 10990000 MVI CZ2SIGN+1,255-X'CF' SET UP FOR + SIGN 10992000 CLI 0(RA),C'+' IS THERRE A PLUS SIGN 10994000 BE CZ2LOAD YES,BRANCH 10996000 CLI 0(RA),C'-' IS THERE MINUS 10998000 BNE CZ2LOAD NO,BRANCH 11000000 MVI CZ2SIGN+1,255-X'DF' SET UP FOR MINUS SIGN 11002000 CZ2LOAD LR RA,R1 DUPLICATE PTR TO ENDING PUNCTUATION 11004000 SR R1,RE BACK UP PTR TO LAST DIGIT 11006000 SPACE 1 11008000 CZ2NUMBR CLI 0(R1),C'0' ARE WE LOOKING AT DIGIT 11010000 BL CZ2NODIG BRANCH IF NOT DIGIT 11012000 MVC 0(1,RC),0(R1) MOVE DIGIT TO CONSTANT 11014000 SR RC,RE DECREMENT CONSTANT POINTER 11016000 SR R1,RE DECREMENT SCAN POINTER 11018000 BCT RB,CZ2NUMBR DECREMENT,BRANCH IF MORE NEEDED 11020000 B CZ2RETA BRANCH TO RETURN 11022000 SPACE 1 11024000 CZ2NODIG CLI 0(R1),C'.' WAS THIS PERIOD 11026000 BNE CZ2RETA NO,SO MUST BE ENDING ' OR , - BRANCH 11028000 BCT R1,CZ2NUMBR DECREM SCAN PTR,BACK FOR NEXT DIGIT 11030000 SPACE 1 11032000 CZ2RETA LA RC,AVCONBLD SHOW @ OF ASSEMBLEE CONSTANT 11034000 CZ2SIGN XI 0(RD),$CHN CREAT RIGHT SIGN IN ZONE OF LAST BYT 11036000 CZ2RET $RETURN SA=NO,RGS=(R1-R2) 11038000 DROP RAT,REP KILL USINGS 11040000 TITLE '*** ERRORS - ERROR FLAGGING AND POINTER SETUP ***' 11042000 **--> CSECT: ERRORS 1-2 ERROR FLAGGING ROUTINES . . . . . . . . . . . 11044000 *. ENTRY CONDITIONS . 11046000 *. RA = SCAN POINTER TO CAUSE OF ERROR . 11048000 *. RB = ERROR CODE . 11050000 *. EXIT CONDITIONS . 11052000 *. RA,RB ARE UNCHANGED BY ERRTAG OR ERRLAB . 11054000 *. USES DSECTS: AVWXTABL,RSBLOCK . 11055000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11056000 ERRORS CSECT 11058000 $DBG 80,SNAP NOTE WE WANT TO SEE ALL ERRS 11060000 ENTRY ERRTAG,ERRLAB 11062000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 11064000 SPACE 2 11066000 **--> ENTRY: ERRTAG FLAG ERROR AT SCAN POINTER POSITION . . . . . 11068000 *. ENTRY CONDITIONS-EXIT CONDITIONS - SEE CSECT ERRORS . 11068500 *. USES MACROS: $RETURN,$SAVE,$SCOF . 11069000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11070000 ERRTAG $SAVE SA=NO 11072000 L RE,AVRSBPT GET ADDR OV RECORD SOURCE BLOCK 11074000 USING RSBLOCK,RE NOTE USING 11076000 TM RSBFLAG,$REBX DOES A RECORD ERROR BLOCK EXIST 11078000 BO ERREBEX REB ALREADY EXISTS 11080000 OI RSBFLAG,$REBX FLAG==>REB EXISTS,THERE ARE ERROR(S) 11082000 DROP RE NO LONGET USING 11084000 MVI AVREBLN,0 INITIALIZE TO LENGTH-1 OF 0 11086000 ERREBEX CLI AVREBLN,$ERREBMX*L'AVREBES CHECK IF MORE ROOM 11088000 BNL ERRTRET NO MORE ROOM-RETURN 11090000 SR RD,RD CLEAR FOR INSERT TO FOLLOW 11092000 IC RD,AVREBLN GET THE CURRENT LENGTH-1 OF REB 11094000 $SCOF RE,RA,AVREBSCN(RD) 11096000 STC RB,AVREBERR(RD) PLACE ERROR CODE IN ALSO 11098000 LA RD,L'AVREBES(RD) INCREMENT COUNTER 11100000 STC RD,AVREBLN PLACE NEW VALUE INTO COUNTER AREA 11102000 $DBG ,NO DON'T NEED TO SEE GOING OUT 11104000 ERRTRET $RETURN SA=NO 11106000 SPACE 2 11108000 **--> ENTRY: ERRLAB FLAG ERROR FOR A LABEL. . . . . . . . . . . . 11110000 *. ENTRY CONDITIONS-EXIT CONDITIONS - SEE CSECT ERRORS . 11110500 *. CALLS ERRTAG . 11111000 *. USES MACROS: $CALL,$RETURN,$SAVE . 11111500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11112000 ERRLAB $SAVE RGS=(R14-R0),SA=NO 11114000 LR R0,RA SAVE THE REAL SCAN POINTER 11116000 L RE,AVRSBPT GET POINTER TO RECORD SOURCE BLOCK 11118000 USING RSBLOCK,RE NOTE THE USING 11120000 LA RA,RSBSOURC MAKE A FAKE POINTER TO LABEL 11122000 DROP RE NOTE NO LONGER USING 11124000 $CALL ERRTAG CALL FLAGGING SECTION 11126000 USING ERRTAG,REP NOTE CHANGED USING 11128000 LR RA,R0 RETURN REAL SCAN POINTER 11130000 ERRLRET $RETURN RGS=(R14-R0),SA=NO 11132000 DROP RAT,REP CLEAN UP USING 11134000 TITLE '*** ESDOPR - EXTERNAL SYMBOL DICTIONARY ***' 11136000 **--> CSECT: ESDOPRS 1-2 EXTERNAL SYMBOL DICTIONARY&ESDID OPERATIONS . 11138000 *. THIS MODULE HANDLES ALL FLAGGING AND CHECKING OF SECTION . 11138500 *. AND EXTERNAL ATTRIBUTES, INCLUDING FLAGGING SYMBOL TABLE . 11139000 *. ENTRIES AND MANIPULATING LOCATION COUNTERS AND SECTION IDS. . 11139500 *. USES DSECTS: AVWXTABL,SYSMSECT . 11139600 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11140000 ESDOPR CSECT 11142000 $DBG 90,* 11144000 ENTRY ESINT1,ESCSEC,ESENX1,ESENX2 11146000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 11148000 SPACE 1 11150000 **--> ENTRY: ESINT1 INITIALIZATION . PASS 1 . . . . . . . . . . . 11152000 *. THIS SECTION FOR COMPLETENESS, FUTURE USE. DOES NOTHING 8/70.. 11153000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11154000 ESINT1 $SAVE SA=NO 11156000 * ***** FUTURE USE - DOES NOTHING AT PRESENT TIME.************** 11158000 ESINRET $RETURN SA=NO 11160000 SPACE 1 11162000 **--> ENTRY: ESCSEC DECLARE A CONTROL SECTION OR DUMMY SECTION. . 11164000 *. ENTRY CONDITIONS . 11166000 *. RB = 0 ==> CSECT . 11168000 *. = 2 ==> DSECT . 11170000 *. = 4 ==> START . 11172000 *. RC = VALUE TO BE USED TO SET LOCATION COUNTER(START ONLY,RB=4) . 11174000 *. EXIT CONDITIONS . 11176000 *. RB = 0 ==> NO ERRORS. ^=0 ==> AN ERROR CODE TO BE SET . 11178000 *. RB = NONZERO VALUE - ERROR CODE - ($ERDPCSE) . 11180000 *. AVCESDID IS INCREMENTED BY 1 OR 2 FOR NEXT VALUE OF REQUIRED TYPE. 11180500 *. I.E. CSECTS HAVE EVEN VALUES, DSECTS ODD ONES. . 11180700 *. LOCATION COUNTERS ARE MODIFIED (AVLOCHIH,AVLOCNTR). . 11181000 *. USES MACROS: $ALIGR,$AL2,$GLOC,$RETURN,$SAVE,$SLOC . 11181500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11182000 ESCSEC $SAVE SA=NO 11184000 L RE,AVLABPT GET POINTER TO LABEL ENTRY 11186000 LTR RE,RE WAS THER A STMT LABEL 11188000 BNZ ESCSLAB RE = @ SYMBOL TABLE ENTRY,BRANCH 11190000 TM AVTAGS1,$IBPRCD1 HAS PRIVATE CODE OCCURRED 11192000 BO ESCSERPC ERROR-RESUMPTION OF PRIVATE CODE 11194000 OI AVTAGS1,$IBPRCD1 FLAG THAT PRIVATE CODE HAS NOW OCCUR 11196000 AIF (NOT &$MACROS).ESNOMA1 SKIP IF NO MACROS 11196500 MVC AVSYSECT,AWBLANK SET &SYSECT FOR USE OF MEXPND 11197000 .ESNOMA1 ANOP 11197500 B ESCSINCR GO BUMP ESDID 11198000 SPACE 1 11200000 USING SYMSECT,RE NOTE SYMBOL TABLE USING 11202000 ESCSLAB TM SYFLAGS,$SYDEF HAS SYMBOL BEEN DEFINED ALREADU 11204000 BO ESCSERPC ERROR-RESUMPTION OF CONTROL SECT 11206000 AIF (NOT &$MACROS).ESNOMA2 SKIP IF NO MACRO EXPANDSER 11206200 * SET UP &SYSECT FOR MACRO EXAPNDER MEXPND. 11206400 MVC AVSYSECT,AWBLANK BLANK OUT SECTION NAME 11206600 MVC *+7(1),SYCHARS MOVE LEN-1 INTO NEXT INSTR 11206800 MVC AVSYSECT($),SYMBOL MOVE SYMBOL OVER, NOW RIGHT-PADDED 11207000 .ESNOMA2 ANOP 11207400 ESCSINCR SR RD,RD CLEAR FOR INSERTION 11208000 IC RD,AVCESDID GET CURRENT ESDID 11210000 LA RD,2(RD) INITIALLY INCREMENT BY 2 FOR NEXT 11212000 STC RD,AVCESDID REPLACE UPDATED SECTION ID 11214000 LH RB,ESCSJUMP(RB) GET OFFSET TO ROUTINE 11216000 ESCSJ B ESCSJ(RB) TAKE BRANCH TO RIGHT SECTION 11218000 SPACE 1 11220000 * * * * * PROCESS CSECT STATEMENT * 11222000 ESCSECT TM AVTAGS1,$IBDSEC1 ARE WE IN DSECT CURRENTLY 11224000 BZ ESCSCS NO WE AREN'T,SKIP 11226000 NI AVTAGS1,255-$IBDSEC1 REMOVE DSECT FLAG 11228000 L RC,AVLOCHIH GET HIGHEST LOCATION COUNTER VALUE 11230000 B ESCSTAG GO TO FLAG SYMBOL TABLE ENTRY 11232000 SPACE 1 11234000 ESCSCS $GLOC RC GET CURRENT LOCATION COUNTER 11236000 C RC,AVCSHIH COMPARE TO HIGHEST IN CSECT 11238000 BNL ESCSTAG GO TO TAG IF HIGHEST VALUE IN RC 11240000 L RC,AVCSHIH ORG *-X MUST HAVE OCCURED-GET HIGHES 11242000 EJECT 11244000 * * * * * COMMON CODE FOR START AND CSECT * 11246000 ESCSTART EQU * 11248000 ESCSTAG LTR RE,RE WAS THERE A SYMBOL 11250000 BZ ESCSDBL SKIP TO ALIGN IF NO SYMBOL 11252000 OI SYFLAGS,$SYCSE NOTE SYMBOL IS A CSECT 11254000 ESCSDBL LA RD,7 SET UP FOR D ALIGNING 11256000 $ALIGR RC,RD ALIGN VALUE TO DOUBLEWORD 11258000 NI AVCESDID,255-$ESDSECT FLAG AS A CSECT, EVEN VALUE 11259000 B ESCSETL GO SET LOCATION COUNTER,ETC. 11260000 SPACE 1 11262000 * * * * * ESCSDSEC - PROCESS DSECT * 11264000 ESCSDSEC SR RC,RC CLEAR FOR VALUE TO SET LOCATION COUN 11266000 OI SYFLAGS,$SYDSE FLAG SYMBOL WITH DSECT 11268000 OI AVCESDID,$ESDSECT MAKE SURE ODD, I.E. DSECT 11269000 TM AVTAGS1,$IBDSEC1 ARE WE ALREADY IN DSECT 11270000 BO ESCSETL GO SET LOCCNTR IF ALREADY IN DSECT 11272000 L RD,AVCSHIH GET HIGH IN CURRENT CSECT 11274000 C RD,AVLOCNTR IS IT HIGHER THAN LOCATION COUNTER 11276000 BNL *+8 SKIP IF VALUE IN RD IS HIGH 11278000 L RD,AVLOCNTR GET LOCATION COUNTER-IT IS HIGH 11280000 ST RD,AVLOCHIH SAVE THIS AS HIGHEST VALUE YET ENCOU 11282000 OI AVTAGS1,$IBDSEC1 NOTE THAT WE ARE NO WIN DSECT 11284000 SPACE 1 11286000 ESCSETL $SLOC RC SET NEW LOCATON COUNTER VALUE 11288000 LR RD,RC DUPLICATE VALUE OVER FOR SETTING UP 11290000 STM RC,RD,AVCSLOW STORE VALUE INTO AVCSLOW-AVCSHIH 11292000 SR RB,RB SHOW NO ERRORS 11294000 ESCSRET $RETURN SA=NO 11296000 ESCSERPC LA RB,$ERDPCSE ILLEGAL CSECT RESUMPTION 11298000 B ESCSRET RETURN 11300000 SPACE 1 11302000 * JUMP OFFSET TABLE FOR 3 TYPES OF CALLS TO ESCSEC * 11304000 ESCSJUMP $AL2 ESCSJ,(ESCSECT,ESCSTART,ESCSDSEC) 11306000 DROP RE CLEAR USING 11308000 EJECT 11310000 **--> ENTRY: ESENX1 ENTRY AND EXTRN STATEMENTS- PASS 1. . . . . . 11312000 *. ENTRY CONDITIONS . 11314000 *. RA = SCAN POINTER . 11316000 *. RB = 0 ==> ENTRY . 11318000 *. = 2 ==> EXTRN . 11320000 *. EXIT CONDITIONS . 11322000 *. RA = SCAN POINTER TO BLANK FOLLOWING OPERAND FIELD, OR ERROR . 11324000 *. RB = 0 ==> NO ERRORS. ^= 0 ==> ERROR CODE TO BE SET . 11326000 *. RB = NONZERO VALUE - ERROR CODE - ($ERINVDM,$ERINVSY) . 11328000 *. ALL LABEL'S IN STMT HAVE SYMSECTS FLAGGED APPROPRIATELY. . 11329000 *. CALLS SYENT1 . 11330000 *. USES MACROS: $CALL,$GTAD,$RETURN,$SAVE . 11331000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11332000 ESENX1 $SAVE SA=ESDOSAVE,RGS=(R14-R6),BR=RW 11334000 LA RZ,ESNX1RET SHOW @ FOR RETURN FROM ERROR 11336000 MVI ESENXF+1,$SYENT PLACE THIS INTO FLAGGING INST 11342000 LTR RB,RB WAS THIS CALL FOR ENTRY 11344000 BZ *+8 SKIP IF SO 11346000 MVI ESENXF+1,$SYEXT WAS EXTRN-PUT FLAG BYTE IN 11348000 LA RY,1 ST UP USEFUL 1 IN ODDREG 11350000 SPACE 1 11352000 ESENX1A BAL RX,ESSYMBOL GO HAVE SYMBOL SCANNED AND ENTERED 11354000 USING SYMSECT,RC NOTE USING(SET UP BY ESSYMBOL) 11356000 ESENXF OI SYFLAGS,$CHN WILL HAVE FLAG BYTE PLACED IN 11358000 CLI 0(RA),C' ' WAS THIS LAST ONE 11360000 BE ESN1RETA GO RETURN WITH NO ERRORS 11362000 CLI 0(RA),C',' IS DELIMITER RIGHT ONE 11364000 BNE ESERIND NO,ERROR 11366000 BXH RA,RY,ESENX1A BUMP SCAN PTR, GO FOR NEXT NAME 11367000 SPACE 1 11368000 ESN1RETA SR RB,RB SHOW NO ERRORS 11370000 ESNX1RET $RETURN RGS=(R14-R6) 11372000 EJECT 11374000 **--> ENTRY: ESENX2 ENTRY AND EXTRN STATEMENTS - PASS 2 . . . . . 11376000 *. CHECKS ENTRY/EXTRN STATEMENTS FOR CONFLICTS, ERRORS. . 11377000 *. ENTRY AND EXIT CONDITIONS EXACTLY SAME AS ESENX1 . 11378000 *. EXCEPT EXIT VALUE OF RB MEANS NOTHING. . 11380000 *. CALLS ERRTAG,SYENT1 . 11382000 *. USES MACROS: $CALL,$GTAD,$RETURN,$SAVE . 11383000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11384000 ESENX2 $SAVE SA=ESDOSAVE,RGS=(R14-R6),BR=RW 11386000 LA RZ,ESNX2RET SHOW @ FOR ERROR RETURN, IF ANY 11388000 LR R0,RB SAVE CODE, =0 ==> ENTRY, =2==>EXTRN 11394000 LA RY,1 FOR BXH'ING CONSTANT IN ODD REG 11396000 SPACE 1 11398000 ESNX2L BAL RX,ESSYMBOL CALL SYMBOL LOOKUP ROUTINE 11400000 LTR R0,R0 ENTRY OR EXTRN 11402000 BNZ ESNX2EXT EXTRN-BRANCH 11404000 SPACE 1 11406000 TM SYFLAGS,$SYDEF WAS ENTRY DEFINED 11408000 BZ ESNX2ERA NO IT WASNT, ERROR BRANCH 11410000 TM SYFLAGS,$SYDSE+$SYEXT WAS IT ALSO MARKED DSECT/EX 11412000 BZ ESNX2M NO, IT WAS LEGAL, BRANCH 11414000 ESNX2ERA LA RB,$ERENTRY ENTRY ERROR 11416000 B ESNX2ERR GO HAVE IT FLAGGED 11418000 SPACE 1 11420000 ESNX2EXT TM SYFLAGS,$SYDEF+$SYENT+$SYCSE+$SYDSE IS EXTRN OK 11422000 BZ ESNX2M YES, BRANCH, LEGAL 11424000 LA RB,$EREXTRN EXTERNAL NAME ERROR 11426000 ESNX2ERR SR RA,RY BACK SCAN PTR UP 1 11428000 $CALL ERRTAG HAVE THERROR FLAGGED 11430000 AR RA,RY INCREMENT BACK TO DELIMITER 11432000 SPACE 1 11434000 ESNX2M CLI 0(RA),C' ' WAS ENDING DELIMITER BLANK 11436000 BCR E,RZ B ESNX2RET - QUIT 11438000 BXH RA,RY,ESNX2L BUMP SCAN PTR AND CONTINUE 11440000 SPACE 1 11442000 ESNX2RET $RETURN RGS=(R14-R6),SA=ESDOSAVE 11444000 EJECT 11446000 USING ESDOSAVE,R13 GIVE SUBR COMMON BASE FROM 1-2 11447000 * INDIVIUDAL ERROR EXITS AND FLAGGING * 11448000 ESERIND LA RB,$ERINVDM INVALID DELIMITER 11450000 BR RZ RETURN TO REQUIRED LOCATION 11452000 ESERSYM LA RB,$ERINVSY INVALID SYMBOL 11454000 BR RZ RETURN TO REQUIRED LOCATION 11456000 SPACE 1 11458000 * * * * * ESSYMBOL - SCAN SYMBOL,HAVE IT ENTERED IN TABLE,RETURN @ * 11460000 ESSYMBOL SR R1,R1 CLEAR SO TRT'S WORK 11462000 TRT 0(9,RA),AWTSYMT SCAN FOR DELIMITER 11464000 BZ ESERIND FLAG ERROR, IF SYMBOL TOO LONG 11465000 CLI 0(RA),C'0' MAKE SURE NOT LEADING DIGTI 11466000 BNL ESERSYM LEADING DIGIT-ILLEGAL 11468000 LR RB,R1 MOVE END SCAN POINTER OVER 11470000 SR RB,RA GET LENGTH OF SYMBOL 11472000 BZ ESERIND ZWRO LENGTH SYMBOL -DELIMITER 11474000 $CALL SYENT1 HAVE SYMBOL ENTRED IN TABLE 11476000 LR RC,RA MOVE POINTER TO SYMBOL ENTRY OVER 11478000 LR RA,R1 UPDATE SCAN POINTER 11480000 BR RX RETURN TO CALLER 11482000 DROP RC,RW,R13 SYMSECT, REGUALR BASE, 2ND BASE 11484000 TITLE '*** EVALUT - EXPRESSION EVALUATOR ***' 11486000 **--> DSECT: EVCTDSCT EVALUT TRANSITION TABLE ENTRY . . . . . . . . . 11486100 *. THIS DESCRIBES 1 ENTRY IN 1 ROW OF THE GENERAL EXPRESSION . 11486200 *. EVALUATOR EVALUT, AND GIVES A SECTION OFFSET @ TO USE, AND . 11486300 *. EITHER A NEXT STATE(ROW) IN TABLE OR AN ERROR CODE FOR AN . 11486400 *. ILLEGAL CURRENT STATE/CURRENT VALUE COMBINATION. . 11486500 *. LOCATION: TABLE EVCTAB IN CSECT EVALUT. . 11486600 *. GENERATION: 1 ROW OF EVCTDSCTS IS GENERATED BY 1 EVCG MACRO. . 11486700 *. NAMES: EVCT---- . 11488000 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11490000 SPACE 1 11490500 EVCTDSCT DSECT 11492000 EVCTADR DS AL1 JUMP OFFSET INDEX FOR ROUTINES 11494000 EVCTCOD DS AL1 NEXT ROW OFFSET OR ERROR CODE 11496000 EVCTL EQU *-EVCTDSCT LENGTH OF SINGLE TABLE ENTRY 11498000 * EQU'S DEFINING OFFSETS ALONG ROWS IN EVCTAB * 11500000 EVCLP EQU 0 ( 11502000 EVCRP EQU EVCTL ) 11504000 EVCPL EQU 2*EVCTL + - 11506000 EVCMU EQU 3*EVCTL * 11508000 EVCDI EQU 4*EVCTL / 11510000 EVCAB EQU 5*EVCTL ABSOLUTE TERM 11512000 EVCRE EQU 6*EVCTL RELOCATABLE TERM 11514000 EVCBL EQU 7*EVCTL BLANK OR , 11516000 SPACE 2 11518000 **--> CSECT: EVALUT 1-2 GENERAL EXPRESSION EVALUATION ROUTINE . . . . 11520000 *. ENTRY CONDITIONS . 11522000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF EXPRESSION) . 11524000 *. EXIT CONDITIONS . 11526000 *. RA = SCAN POINTER TO DELIMITER STOPPING SCAN, OR ERROR . 11528000 *. RB = 0 ==> EXPRESSION GOOD, = NONZERO VALUE==>ERROR CODE . 11530000 *. RC = VALUE OF EXPRESSION, IF IT WAS GOOD . 11532000 *. RD = 0 ==> EXPRESSION WAS AN ABSOLUTE EXPRESSION . 11534000 *. = ESDID FOR A RELOCATABLE EXPRESSION (1-255) . 11536000 *. RE = LENGTH ATTRIBUTE - 1 OF EXPRESSION. . 11538000 *. CALLS SDBCDX,SYFIND . 11540000 *. USES DSECTS: AVWXTABL,EVCTDSCT,RCODBLK,RSBLOCK,SYMSECT . 11540500 *. USES MACROS: $CALL,$GLOC,$RETURN,$SAVE,EVCG . 11541000 *. . 11541100 *. **NOTE** SEE IBM PLM Y26-3700-0, PP. 45-47. EVALUT SOMEWHAT . 11541200 *. RESEMBLES IEUF7V-EXPRESSION EVALUATION ROUTINE. NOTE EVALUT . 11541300 *. HAS 1 LESS STATE SETTING, SINCE IEUF7V COND=0 IS UNNEEDED. . 11541400 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11542000 EJECT 11543000 EVALUT CSECT 11544000 $DBG B0,SNAP 11546000 * * * * * REGISTER ALLOCATION AND USAGE FOR EVALUT* * * * * * * * * * * 11548000 * R0 UNRESTRICTED WORK REGISTER * 11550000 * R1 ADDRESS WORK REGISTER - HIGH-ORDER BYTE =0 ALWAYS * 11552000 * R2 BYTE WORK REGISTER - HIGH-ORDER 3 BYTES = 0 ALWAYS * 11554000 * RW TERM /SIGN/ID STACK INDEX = INDEX OF NEXT EMPTY H IN EVTRID * 11556000 * RX OPERATOR STACK POINTER = @ LAST OPERATOR CODE IN EVOPRS * 11558000 * RY = 1 USEFUL CONSTANT IN ODD REGISTER, CAN BE USED FOR BSH'S * 11560000 * RZ STATE REGISTER = @ ROW IN EVCTAB OR @ ENTRY IN EVCTAB * 11562000 * RA SCAN POINTER TO NEXT CHARACTER TO BE EXAMINED * 11564000 * RB-RE GENERAL WORK REGISTERS AND PARAMETER REGISTERS * 11566000 * R13 BASE REGISTER AND SAVE AREA POINTER * 11568000 * R14 INTERNAL AND EXTERNAL LINK REGISTER * 11570000 * R15 UNRESTRICTED WORK REGISTER * 11572000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11574000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 11576000 $SAVE RGS=(R14-R6),BR=R13,SA=EVALSAVE 11578000 EVLPC EQU 2 AWTSYMT CODE FOR LEFT PAREN 11580000 SPACE 1 11582000 * INITIALIZATION SECTION * 11584000 NI EVFLENG+1,X'0F' MAKE SURE BRANCH IS A NOPR 11586000 LA R0,16 FOR INIT OF EVPCNT-EVTRNM 11588000 STH R0,EVPCNT STORE EVPCNT=0, EVTRNM=16 11590000 LM R1,RW,AWZEROS ZERO OUT 11592000 LA RX,EVOPRS INIT TO BEFINNING OF STACK 11594000 LA RY,1 HANDY CONSTANT IN ODD REGISTER 11596000 USING EVCTDSCT,RZ NOTE TRANSITION TABLE ENTRY USING 11598000 B EVCNEXTA ENTER AT RIGHT PLACE TO START 11600000 EJECT 11602000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11604000 * MAIN CONTROL POINT - PICK UP CODE FROM PREVIOUS ENTRY * 11606000 * IN TRANSITION TABLE, TO MAKE IT THE CURRENT STATE. FIND FROM * 11608000 * THIS THE @ NEW ROW INT ABLE (NEW STATE). GET THE NEXT CHAR * 11610000 * TO BE SCANNED, GET CODE FORM AWTSYMT WHICH DESCRIBES IT. IF * 11612000 * THE CHAR IS A DELIMITER, SKIP TO EVCOPRT. FOR A CHARACTER * 11614000 * WHICH MIGHT BEGIN A TERM (ALPHANUMERIC), SCAN AND EVALUATE * 11616000 * THE TERM, DETERMINING ITS RELOCATIBILITY ATTRIBUTE FOR LATER * 11618000 * IN REGS RC & RD FOR USE BY EVTERM, IF LEGAL. * 11622000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11624000 SPACE 1 11626000 EVCNEXT IC R2,EVCTCOD GET CODE FROM PREVIOUS ENTRY 11628000 EVCNEXTA LA RZ,EVCTAB(R2) GET @ REQUIRED ROW IN EVCTAB 11630000 AIF (&$DEBUG).EVCX0 SKIP IF PRODUCTION MODE 11632000 XSNAP IF=(AVDEBUG,O,X'B0',TM),STORAGE=(EVOPRS,EVALQ), #11634000 LABEL='EVCNEXTA' 11636000 .EVCX0 ANOP 11638000 IC R2,0(RA) GET THE NEXT SOURCE BYTE 11640000 IC R2,AWTSYMT(R2) GET THE CODE FROM THE TABLE 11642000 CR R2,RY COMPARE TO 1 FOR TYPE 11644000 BH EVCOPRT IF >1, CHARACTER WAS OPERATOR 11646000 BE EVZILCH ILLEGAL CHARACTER, IF =1 11648000 SPACE 1 11650000 * TERM-PROCESSING SECTION - CODE IN R2 = 0 * 11652000 CLI 0(RA),C'0' WAS IT A DIGIT 11654000 BNL EVCSDT2 SKIP TO SELF-DEFINING TERM SECTION 11656000 CLI 1(RA),C'''' IS NEXT CHAR A ' 11658000 BE EVCSDT1 SKIP IF SO, I.E. L' B' C' OR X' 11660000 SPACE 1 11662000 * SYMBOL FOUND - HAVE IT SCANNED. GET VALUE,SECTION ID. 11664000 BAL R14,EVSYMB CALL SYMBOL ROUTINE 11666000 USING SYMSECT,RB NOTE POINTER 11668000 L RC,SYVALUE GET VALUE OF SYMBOL INTO RC 11670000 IC R2,SYLENG GET LENGTH-1 11672000 BAL R14,EVFLENG CALL LENGTH ATTRIB SAVER 11674000 IC R2,SYESDID GET SECTION ID 11676000 LTR RD,R2 MOVE SECTION ID AND TEST IT 11678000 BZ EVCABSA SKIP IF0, I.E. ABSOLUTE SYMBOL 11680000 LA R2,EVCRE SHOW OFFSET FOR RELOCATABLE TERM 11682000 B EVCJUMPA GO TO MAKE CHOICE 11684000 EJECT 11686000 * ABSOLUTE TERM - SELF-DEFINING OR LENGTH ATTRIBUTE * 11688000 EVCSDT1 CLI 0(RA),C'L' WAS IT L' 11690000 BNE EVCSDT2 NO, MUST BE X' B' OR C' 11692000 * TERM IS A LENGTH ATTRIBUTE - L'SYMBOL OR L'*. 11694000 LA RA,2(RA) BUMP SCAN PTR PAST L' 11696000 CLI 0(RA),C'*' IS IT L'* 11698000 BNE EVCSDT2A SKIP IF NOT (BRANCH PROBABLE) 11700000 BAL R14,EVFLQAS CALL L'* ROUTINE 11702000 BXH RA,RY,EVCSDT2B BRANCH, INCREM SCAN PTR BEYOND * 11704000 SPACE 1 11718000 * PROCESS SELF-DEFINING TERM * 11720000 EVCSDT2 $CALL SDBCDX CALL SELF-DEF TERM PROCESSOR 11724000 LTR RB,RB WAS RESULT OK 11726000 BZ EVCSDT3 YES,OK,RESULT IN RC 11728000 BP EVZERROR ERROR,BRANCH 11730000 BXH RA,RY,EVZSYNT ' BAD, LETTER NOT B,C,X-ERROR 11732000 SPACE 1 11734000 EVCSDT2A BAL R14,EVSYMB CALL SYMBOL LOOKUP 11736000 IC R2,SYLENG GET LENGTH-1 11736500 DROP RB REMOVE SYMSECT USING 11737000 EVCSDT2B LA RC,1(R2) MOVE, CONVERT LENGTH-1 TO LENGTH 11737500 BAL R14,EVFLENG HAVE LENGTH ATTRIB SAVED,IF NEEDED 11738000 * IF EVCSDT3 ENTERED THRU EVCSDT1, R2 STILL =0 (L' =1) 11738500 EVCSDT3 BAL R14,EVFLENG HAVE LENGTH-1 SAVED, IF NOT ALREADY 11739000 SR RD,RD SHOW ABSOLUTE TERM 11740000 EVCABSA LA R2,EVCAB SHOW OFFSET FOR ABSOLUTE TERM 11742000 B EVCJUMPA GO TO MAKE BRANCH 11744000 EJECT 11746000 * * * * * EVFLQAS - OBTAIN L'*-1, RETURN IT IN R2, IF IT EXISTS * 11748000 * THIS ROUTINE CALLED ONLY BY TERM PROCESSING SECTION * 11750000 * EXIT CONDITIONS * 11752000 * R2 = L'* - 1, FOR USE AS EXPLICIT LENGTH ATTRIBUTE, OR IMPLIED L * 11754000 SPACE 1 11756000 EVFLQAS L R15,AVRSBPT GET RSB POINTER 11758000 USING RSBLOCK,R15 NOTE USING FOR RSBLOCK 11760000 SR R2,R2 SET R2=0, I.E. L'* = 1 11762000 TM RSBFLAG,$RCBX IS THERE AN RCB 11764000 BCR Z,R14 RETURN IF THERE ISN'T ANY,USE 1 11766000 L R15,AVRCBPT RCB EXISTS, GET THE @ OF IT 11768000 USING RCODBLK,R15 NOTE NEW USING 11770000 IC R2,RCLQ GET THE L'* VALUE 11772000 * BR R14 FALL THRU INTO EVFLENG, SET LENGTH-1 OR JUST RETURN. 11774000 DROP R15 KILL RCODBLK USING 11776000 SPACE 1 11778000 * * * * * EVFLENG - STORE LENGTH ATTRIBUTE-1, IF 1ST TIME * 11780000 * THIS ROUTINE CALLED ONLY FROM TERM PROCESSING SECTION. * 11782000 * MUST IMMEDIATELY FOLLOW SECTION EVFLQAS. * 11783000 * ENTRY CONDITIONS * 11784000 * R2 = LENGTH ATTRIVUTE-1 * 11786000 SPACE 1 11788000 EVFLENG BCR $CHN,R14 RETURN TO CALLER IF NOT 1ST TIME 11790000 OI EVFLENG+1,X'F0' CHANGE NOPR TO BR 11792000 STC R2,EVALQ SAVE LENGTH ATTRIBUTE - 1 11794000 BR R14 RETURN TO CALLER 11796000 SPACE 1 11798000 * * * * * EVSYMB - SCAN SYMBOL AND HAVE IT LOOKED UP BY SYFIND * 11800000 * THIS SECTION CALLED ONLY FROM TERM PROCESSING SECTION. * 11802000 * ENTRY CONDITIONS * 11804000 * RA = SCAN POINTER TO 1ST CHARACTER OF SYMBOL * 11806000 * EXIT CONDITIONS * 11808000 * RA = SCAN POINTER TO DELIMITER FOLLOWING SYMBOL * 11810000 * RB = @ SYMSECT ENTRY IN SYMBOL TABLE OF THE SYMBOL * 11812000 SPACE 1 11814000 EVSYMB TRT 0(9,RA),AWTSYMT SCAN FOR DELIMITER 11816000 BZ EVZINVSY IF NOT FOUND,SYMBOL TOO LONG-ERROR 11818000 LR RB,R1 GET PTR TO DELIMITER INTO RB 11820000 SR RB,RA GET LENGTH OF SYMBOL 11822000 BZ EVZILCH ILLEGAL CHARACTER 11824000 LR R0,R14 SAVE RETURN @ 11826000 SPACE 1 11828000 $CALL SYFIND CALL LOOKUP ROUTINE 11830000 LTR RB,RB WAS THE SYMBOL UNDEFINED 11832000 BNZ EVZUNDEF UNDEFINED SYMBOL,ERROR 11834000 LR RB,RA MOVE POINTER TO SYMBOL OVER 11836000 USING SYMSECT,RB NOTE SYMBOL POINTE 11838000 TM SYFLAGS,$SYDEF WAS SYMBOL DEFINED 11840000 BZ EVZUNDEF NO,UNDEFINED-BRANCH 11842000 LR RA,R1 GET SCAN PTR TO DELIMITER 11844000 LR R14,R0 RESTORE RETURN @ 11846000 BR R14 RETURN TO CALLING SECTION 11848000 DROP RB KILL USING 11850000 EJECT 11852000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11854000 * BRANCH ACCORDING TO CURRENT STATE (GIVEN BY RZ) AND * 11856000 * TYPE OF TERM OR DELIMITER. USE VALUES IN EVCTAB, WHICH * 11858000 * CONTAIN OFFSET JUMP VALUES, AND EITHER A NEXT STATE VALUE, * 11860000 * OR AN ERROR CODE IF A BRANCH TAKEN DIRECTLY TO EVCERR. * 11862000 * THE LABELS EVERR, EVLOCNT, EVTERM, EVPCHIH, EVPCTES, EVPCZER,* 11864000 * AND EVOPCHK MUST ALL BE WITHIN 256 BYTES OF EVDJUMP. * 11866000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11868000 SPACE 1 11870000 EVCOPRT LR R1,R2 SAVE OPERATOR CODE FROM AWTSYMT 11872000 IC R2,EVCOFFS(R2) GET OFFSET FOR TRANSITION TABLE 11874000 EVCJUMPA LA RZ,EVCTDSCT(R2) GET @ INDIVIDUAL ENTRY INTABLE 11876000 IC R2,EVCTADR GET JUMP INDEX VALUE FROM TABLE 11878000 AIF (&$DEBUG).EVCX1 SKIP IF PRODUCTION MODE 11880000 XSNAP IF=(AVDEBUG,O,X'B0',TM), #11882000 STORAGE=(*EVDJUMP(R2),*EVDJUMP+4(R2)),LABEL='EVDJUMP' 11884000 .EVCX1 ANOP 11886000 B EVDJUMP(R2) TAKE BRANCH TO PARTICULAR ROUTINE 11888000 EVDJUMP EQU * BASE FOR RPUTINE JUMPS 11890000 SPACE 1 11892000 * * * * * EVERR - OBTAIN ERROR CODE FROM TRANSITION TABLE, EXIT. * 11894000 EVERR IC R2,EVCTCOD GET ERROR CODE 11896000 LR RB,R2 MOVE TO EXPECTED LOCATION 11898000 B EVZERROR GO TO FINISH 11900000 SPACE 1 11902000 * * * * * EVLOCNT - PROCESS LOCATION COUNTER REFERENCE * 11904000 EVLOCNT $GLOC RC GET LOCATION COUNTER 11906000 IC R2,AVCESDID GET SECTION ID CURRENT 11908000 LR RD,R2 MOVE OVER WHERE EXPECTED 11910000 BAL R14,EVFLQAS CALL L'* ROUTINE, SAVE LENGTH-1 ATT 11912000 AR RA,RY BUMP SCAN PTR 1, FALL THRU TO EVTERM 11916000 SPACE 1 11918000 * * * * * EVTERM - ENTER TERM VALUE AND ID INTO EVTRMS/EVTRID * 11920000 * THIS SECTION MUST IMMEDIATELY FOLLOW EVLOCNT. * 11922000 * ENTRY CONDITIONS * 11924000 * RC = VALUE OF TERM TO BE ENTERED * 11926000 * RD = SECTION ID (1-255) FOR RELOCATABLE, 0 FOR ABSOLUTE TERM * 11928000 * RW = INDEX OF NEXT EMPTY SLOT IN EVTRID * 11930000 * EXIT CONDITIONS * 11932000 * RW = RW+2 (I.E. ONE ENTRY HAS BEEN PUSHED INTO STACK) * 11934000 SPACE 1 11936000 EVTERM IC R2,EVTRNM GET # TERMS LEFT TO GO 11938000 SR R2,RY DECREMENT 11940000 BM EVZTMTR TOO MANY TERMS IN EXPRESSION 11942000 STC R2,EVTRNM STORE BACK UPDATED VALUE 11944000 STH RD,EVTRID(RW) STORE SECTION ID 11946000 LA R15,0(RW,RW) GET INDEX FOR EVTRMS ENTRY 11948000 ST RC,EVTRMS(R15) STORE THE VALUE OF TERM 11950000 LA RW,2(RW) INCREMENT THE OFFSET INDEX 11952000 B EVCNEXT GO BACK FOR NEXT ONE 11954000 EJECT 11956000 * * * * * EVPCHIH - ( FOUND, INCREMENT AND TEST PAREN COUNT * 11958000 EVPCHIH CLI EVPCNT,4 CHECK PAREN COUNT 11960000 BH EVZPARN TOO MANY PARENS-BRANCH 11962000 IC R2,EVPCNT GET PAREN COUNT 11964000 AR R2,RY INCREMENT BY 1 11966000 STC R2,EVPCNT STORE BACK 11968000 B EVOPENT GO ENTER OPERATOR 11970000 SPACE 1 11972000 * * * * * EVPCTES - , OR BLANK FOUND, MAKE SURE PAREN COUNT = 0 * 11974000 EVPCTES CLI EVPCNT,0 IS PAREN COUNT 0 LIKE IT SHOULD BE 11976000 BE EVFRCA YES, GO FORCEBACK ALL OPERATORS 11978000 B EVERR ERR-UNEXPECTED END OF EXPRESSION 11980000 SPACE 1 11982000 * * * * * EVPCZER - ) FOUND, TEST AND DECREMENT PAREN COUNT, FORCEBACK* 11984000 EVPCZER IC R2,EVPCNT GET PAREN COUNT 11986000 SR R2,RY DECREMENT PAREN COUNT 11988000 BNM *+8 IF WAS NOT PREVIOUSLY ZERO, JUMP 11990000 BXLE R2,RY,EVFRCA SET R2=0, BRANCH TO FINISH UP 11992000 STC R2,EVPCNT STORE BACK 11994000 SPACE 1 11996000 * * * * * EVFRCP - FORCE EVALUATION BACK TO LAST LEFT PAREN * 11998000 * LOOP UNTIL LEFT PAREN CODE FOUND IN OPERATOR STACK * 12000000 EVFRCP BALR R14,0 SET R14 = @ NEXT INSTRUCTION, LOOP 12002000 CLI 0(RX),EVLPC IS CURRENT CODE THAT OF LEFT PAREN 12004000 BNE EVFRCO NO, SO EVALUATE UNTIL WE FIND ( 12006000 SPACE 1 12008000 SR RX,RY DECREMENT OPERATOR STACK POINTER 12010000 AR RA,RY BUMP SCAN POINTER PAST ) 12012000 LH R15,EVTRID-2(RW) GET CURRENT SIGN/ID 12014000 LTR R15,R15 IS IT ABSOLUTE 12016000 BZ EVCNEXT ABSOLUTE, SO USE NEXT STATE FROM TAB 12018000 LA R2,EVCT4-EVCTAB OFFSET FOR RELOCATABLE 12020000 B EVCNEXTA GO FOR NEXT 12022000 SPACE 1 12024000 * * * * * EVOPCHK - CHECK OPERATOR PRECEDENCE, EVALUATE IF NEEDED * 12026000 * ENTRY CONDITIONS * 12028000 * R1 = OPERATOR CODE OF CURRENT OPERATOR, FROM AWTSYMT * 12030000 EVOPCHK IC R2,0(RX) GET CODE OF PREVIOUS OPERATOR 12032000 IC R2,EVOPREC(R2) PRECEDENCE OF PREV OP +- = 0 12032500 SR R15,R15 CLEAR FOR INSERT 12033000 IC R15,EVOPREC(R1) GET PRECEDENCE OF NEW OPERATOR 12033500 CR R15,R2 IF NEW PREC > OLD, SKIP EVALUATRE 12034000 BH *+8 IF NEW CODE> OLD CODE, SKIP EVAL 12036000 BAL R14,EVFRCO FORCE 1 OPERATOR EVALUATION 12038000 SPACE 1 12040000 EVOPENT AR RX,RY INCREMENT POINTER TO EMPTY SLOT 12042000 STC R1,0(RX) STORE CODE OF NEW OPERATOR 12044000 BXH RA,RY,EVCNEXT BUMP SCAN POINTER, GET NEXT CODE 12046000 SPACE 1 12048000 EJECT 12050000 * * * * * EVFRCO - EVALUATE 1 OPERATOR AND 2 TERMS IN STACKS * 12052000 * ENTRY CONDITIONS * 12054000 * RW = INDEX OF NEXT EMPTY HALFWORD IN EVTRID STACK * 12056000 * RX = @ LAST OPERATOR CODE ENTERED IN OPERATOR STACK EVOPRS * 12058000 * R14= RETURN ADDRESS TO CALLING SECTION OF CODE. * 12060000 * EXIT CONDITONS * 12062000 * RC = COMPUTED RESULT OF OPERATION * 12064000 * RW = RW-2 (I.E. 1 ENTRY OF EVTRID&EVTRMS WAS POPPED) * 12066000 * RX = RX-1 (I.E. ONE ENTRY FROM OPERATOR STACK WAS POPPED) * 12068000 EVFRCO SR RW,RY SUBTRACT 1 FROM INDEX 12070000 SR RW,RY SUBTRACT ANOTHER 1, MAKING -2 12072000 LH RE,EVTRID(RW) GET PREVIOUS SIGN CODE/SECTION ID 12074000 LA R15,0(RW,RW) GET 2* RW FOR INDEX INTO EVTRMS 12076000 LA R15,EVTRMS-4(R15) GET @ 2ND PREVIOUS ENTRY 12078000 LM RC,RD,0(R15) GET 2ND PREVIOUS,PREVIOUS EVTRMS 12080000 IC R2,0(RX) GET CURRENT OPERAOTR CODE 12082000 IC R2,EVFRCT-5(R2) GET OFFSET VALUE FOR TYPE JUMP 12084000 B EVFRJ(R2) TAKE BRANCH TO SECTION 12086000 EVFRJ EQU * BASE FOR OPERATOR JUMPS 12088000 SPACE 1 12090000 * - OPERATOR * 12092000 EVFRMI SR RC,RD PERFORM OPERATION 12094000 LCR RE,RE COMPLEMENT SIGN CODE/SECTION ID 12096000 B EVFRPLA CONTINUE WITH COMMON +- CODE 12098000 SPACE 1 12100000 * + OPERATOR * 12102000 EVFRPL AR RC,RD PERFORM OPERATION 12104000 LTR RE,RE WAS PREVIOUS AN ABS TERM(RE=0 IF SO) 12106000 EVFRPLA BZ EVFRCOEX YES, SO LEAVE 2ND PREV CODE AS IS 12108000 LH RB,EVTRID-2(RW) GET 2ND PREVIOUS SIGN CODE/ID 12110000 LTR RB,RB WAS 2ND PREV TETRM ABSOLUTE 12112000 BZ EVFRPLB YES, SO USE PREV CODE UNCHANGED-BRAN 12114000 AR RE,RB 2 RELOCATABLE TERMS, ADD SIGN/ID 12116000 BNZ EVZCXREL IF NO 0, COMPLEX RELOCATIBILITY 12118000 EVFRPLB STH RE,EVTRID-2(RW) SAVE COMPUTED SIGN/ID INTO RESULT 12120000 B EVFRCOEX HAVE RESULT SAVED AND EXIT 12122000 SPACE 1 12124000 * * OPERATOR * 12126000 EVFRMU MR RB,RD 1ST OP IN RC, RESULT VALUE ALSO 12128000 B EVFRCOEX GO HAVE RESULT STORED 12130000 SPACE 1 12132000 * / OPERATOR * 12134000 EVFRDI LR RB,RC MOVE 2ND PREVIOUS VALUE OVER 12136000 LTR RC,RD MOVE AND TEST DIVISOR OVER 12138000 BZ EVFRCOEX IF DIVISOR =0, LEAVE RC=0,BRANCH 12140000 SRDA RB,32 PROPAGATE SIGN,MOVE DIVIDEND BACK 12142000 DR RB,RD PERFORM OPEATION ,HAVING CHECKED 0 12144000 SPACE 1 12146000 EVFRCOEX ST RC,0(R15) STORE RESULT INTO EVTRMS STACK 12148000 AIF (&$DEBUG).EVCX2 SKIP IF PRODUCTION MODE 12150000 XSNAP IF=(AVDEBUG,O,X'B0',TM),LABEL='EVFRCOEX' 12152000 .EVCX2 ANOP 12154000 BCTR RX,R14 BACK UP OPERATOR POINTER 1, RETURN 12156000 EJECT 12158000 * * * * * EVFRCA - FORCE EVALUATION OF ALL VALUES, RETURN TO CALLER * 12160000 * LOOP CALLING EVFRCO UNTIL LEFT PAREN CODE FOUND * 12162000 * NOTE THAT EVFRCO LEAVE RESULT IN RC, SO NEED NOT BE FETCHED. * 12164000 EVFRCA BALR R14,0 SET R14 = @ NEXT INSTRUCTION 12166000 CLI 0(RX),EVLPC IS CURRENT OP CODE LEFT PAREN 12168000 BNE EVFRCO IF NOT, CALL FORCE 1 OPERATOR SECTIO 12170000 SPACE 1 12172000 LH RD,EVTRID GET 1ST RELOCATE ID HALFWORD 12174000 LTR RD,RD IS IT ACCEPTABLE (0 OR +) 12176000 BM EVZCXREL IF <0, NEGATIVE RELOCATABLE TERM 12178000 CL RC,AWFX6F IS VALUE WITHIN 24 BITS 12184000 BH EVZEXGTA NO,ERROR BRANCH 12186000 IC R2,EVALQ GET LENGTH ATTRIBUTE - 1 12188000 LR RE,R2 MOVE LENGTH ATTRIBUTE - 1 OVER 12190000 SR RB,RB SHOW THE EXPRESSION WAS OK 12192000 EVZERROR EQU * DEFINE LABEL FOR ERROR EXIT 12194000 EVRET $RETURN RGS=(R14-R6) 12196000 SPACE 1 12198000 * * * * * ERROR EXIT SECTION * 12200000 EVZCXREL LA RB,$ERCXREL COMPLEX RELOCATIBILITY ILLEGAL 12202000 B EVZERROR EXIT, WITH ERROR CODE 12204000 EVZEXGTA LA RB,$EREXGTA SHOW LARGER THAN 24 BITS 12206000 LTR RC,RC WAS VALUE POSITIVE 12207000 BP EVZERROR BRANCH IF SO, FALL THRU IS NOT 12208000 EVZEXLTA LA RB,$EREXLTA SHOW EXPRESSION NEGATIVE 12210000 B EVZERROR GO RETURN WITH ERROR 12212000 EVZILCH LA RB,$ERVILCH ILLEGAL CHARACTER 12214000 B EVZERROR EXIT, WITH ERROR CODE 12216000 EVZINVSY LA RB,$ERINVSY SHOW INVALID SYMBOL 12218000 B EVZERROR GO TO SHOW ERROR 12220000 EVZPARN LA RB,$ERVPARN TOO MANY PARENS 12222000 B EVZERROR EXIT, WITH ERROR CODE 12224000 EVZSYNT LA RB,$ERVSYNT SYNTAX 12226000 B EVZERROR EXIT, WITH ERROR CODE 12228000 EVZTMTR LA RB,$ERVTMTR TOO MANY TERMS IN EXPRESSION 12230000 B EVZERROR GO RETURN WITH ERROR 12232000 EVZUNDEF LR RA,R1 MOVE SCAN POINTER BACK 12234000 SR RA,RY DECREMNT BY 1 FOR BETTER POINTER 12236000 LA RB,$ERUNDEF SHOW UNDEFINED 12238000 B EVZERROR GO TO ERROR SECTION 12240000 EJECT 12242000 * * * * * INTERNAL CONSTANTS * 12244000 EVCOFFS EQU *-2 OFFSET BACKWARDS SMALLEST INDEX 12246000 * OFFSETS OBTAINED USING INDEX VALUE FROM AWTSYMT * 12248000 DC AL1(EVCLP,EVCRP,EVCBL,EVCPL,EVCPL,EVCMU,EVCDI) 12250000 * JUMP OFFSET TABLE FOR EVFRCO - FOR + - * / OPERATORS * 12252000 EVFRCT DC AL1(EVFRPL-EVFRJ,EVFRMI-EVFRJ,EVFRMU-EVFRJ,EVFRDI-EVFRJ) 12254000 EVOPREC EQU *-2 ORIGIN RIGHT FOR INDICES 2 UP 12254100 DC AL1(0,0,0,1,1,2,2) PRECEDENCES: ( X X + - * / (2-8) 12254200 SPACE 1 12256000 EVCTAB DS 0H TRANSITION TABLE 12258000 EVCT1 EVCG (PCHIH,1,ERR,SYNT,ERR,SYNT,LOCNT,4,ERR,SYNT,TERM,3,TERM,#12260000 4,ERR,UNEX) BEGINNING ( + - LAST FOUND 12262000 EVCT2 EVCG (PCHIH,1,ERR,SYNT,ERR,SYNT,ERR,SYNT,ERR,SYNT,TERM,3,ERR,#12264000 RELO,ERR,UNEX) * / OPERATORS LAST ENCOUNTERD 12266000 EVCT3 EVCG (PCTES,SYNT,PCZER,3,OPCHK,1,OPCHK,2,OPCHK,2,ERR,SYNT,ERR#12268000 ,SYNT,PCTES,UNEX) ABSOLUTE TERM WAS LAST 12270000 EVCT4 EVCG (PCTES,SYNT,PCZER,3,OPCHK,1,ERR,RELO,ERR,RELO,ERR,SYNT,E#12272000 RR,SYNT,PCTES,UNEX) RELOCATABLE TERM LAST PREVIOUS 12274000 SPACE 1 12276000 * OPERATOR STACK - 1ST ENTRY IS CODE FOR ( * 12278000 EVOPRS DC AL1(EVLPC) BEGINNING OF OPERATOR STACK,LEFT PRN 12280000 DS 21C REMAINING SECTION OF EVOPRS 12282000 SPACE 1 12284000 * TERM STACK - COMPUTED VALUES KEPT TO 32 BITS. * 12286000 EVTRMS DS 16F TERM STACK 12288000 SPACE 1 12290000 * SIGN CODE/ID STACK. EACH HALFWORD IS ASSOCIATED WITH * 12292000 * CORRESPONDING FULLWORD IN EVTRMS. FOR ABSOLUTE VALUES, THE * 12294000 * EVTRID ENTRY = 0, FOR RELOCATABLE VALUES, THE SECTION ID IS * 12296000 * ENTERED IN THE 2ND BYTE OF A HALFWORD, WITH ZEROS IN THE 1ST * 12298000 * BYTE. IF THE VALUE IS NEGATIVE, THE HALFWORD IS COMPLEMENTED* 12300000 EVTRID DS 16H SIGN CODE/ID STACK 12302000 * EVPCNT AND EVTRNM MUST BE IN ORDER, ON H BOUNDARY * 12304000 EVPCNT DS C PAREN COUNT - 0<=EVPCNT<=5 12306000 EVTRNM DS C # TERMS LEFT (INIT TO 16 12308000 EVALQ DS C LENGTH ATTRIVUTE - 1 OF EXPRESSION 12310000 DROP RAT,R13,RZ KILL USINGS 12312000 TITLE '*** IAMOP1 - MACHINE OPCODES - PASS 1 ***' 12314000 **--> CSECT: IAMOP1 1 MACHINE OPERATIONS - PASS 1 . . . . . . . . . 12316000 *. THIS IS 1 OF 2 PASS 1,LEVEL 2 PROGRAMS. IT PERFORMS ALL . 12316100 *. PASS 1 MACHINE INSTRUCTION PROCESSING, INCLUDING ALIGNMENT . 12316200 *. OF THE LOCATION COUNTER, SCANNING FOR LITERAL CONSTANTS, . 12316300 *. AND BUILDING AN RCODBLK FOR THE STATEMENT. THE RCODBLK . 12316400 *. INCLUDES THE INSTRUCTION FORMAT TYPE, THE MACHINE CODE FOR . 12316500 *. THE GIVEN INSTRUCTION, MASK (EXTENDED MNEMONICS), FLAGS . 12316600 *. AND ALIGNMENT VALUES NEEDED, THE LENGTH ATTRIBUTE-1 FOR THE . 12316700 *. INSTRUCTION, AND THE ADDRESS OF A LITERAL CONSTANT IN THE . 12316800 *. LITERAL TABLE, IF THERE IS ONE USED. . 12316900 *. ENTRY CONDITIONS . 12318000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 12320000 *. RC = ADDRESS OF OPCODE CONTROL TABLE ENTRY FOR OPCODE USED . 12322000 *. EXIT CONDITIONS . 12324000 *. RB = 0 NO ERRORS WERE ENCOUNTERED . 12326000 *. = >0 ERRORS WERE FOUND IN STATEMENT . 12328000 *. RC = @ RECORD CODE BLOCK(RCODBLK) FOR THE STATEMENT. . 12330000 *. THE RCODBLK HAS ALL VALUES FILLED IN EXCEPT RCLOC(IARCLOC). . 12331000 *. RD = LENGTH OF CODE - TO BE ADDED AFTER ALIGNMENT DONE . 12332000 *. CALLS ERRTAG,LTENT1,SCANEQ . 12334000 *. USES DSECTS: AVWXTABL,OPCODTB . 12334500 *. USES MACROS: $CALL,$CKALN,$GLOC,$LTENT1,$RETURN,$SAVE,$SLOC . 12335000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 12336000 IAMOP1 CSECT 12338000 $DBG 90,* 12340000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 12342000 $SAVE RGS=(R14-R3),BR=R13,SA=IAMOSAVE 12344000 USING OPCODTB,RC NOTE TABLE POINTER 12348000 MVC IARCTYPE(3),OPCTYPE MOVE CODE BYTES OVER 12350000 DROP RC NO LONGER NEED POINTER HERE 12352000 MVI IARCLENG,RC$LEN PUT IN NORMAL LENGTH-1 12354000 LM R1,R3,AWZEROS GET HANDY ZEROS 12356000 IC R1,IARCHEX GET HEX OPCODE 12360000 SRL R1,6 SHIFT TO GET INDEX 12362000 IC R3,IALENGS(R1) GET LENGTH-1 FOR LENGTH ATTRIBUTE 12364000 STC R3,IARCLQ SAVE FOR L' ATTRIBUTE 12366000 SPACE 1 12368000 CLI AVCESDID,0 WAS CODE PRECEDED BY A CSECT 12370000 BNE IALICHK CSECT OR DSECT BEFORE-BRANCH 12371000 SPACE 1 12371200 MVI AVCESDID,2 NO, UNITIATED PRIVAT CODE 12371400 OI AVTAGS1,$IBSTAR1+$IBPRCD1 SHOW NO START, PRIV CODE IN 12371600 SPACE 1 12372000 IALICHK $CKALN 1,IALNOK CHECK ALIGNMENT AND BRANCH OK 12374000 $GLOC R1 GET LOCATION COUNTER VALUE 12376000 LA R1,1(R1) INCREMENT TO HALFWORD BOUNDARY 12378000 $SLOC R1 SET NEW LOCATION COUNTE VALUE 12380000 EJECT 12382000 * SCAN FOR LITERAL OR END OF OPERAND FIELD * 12384000 IALNOK EQU * 12386000 $CALL SCANEQ SCAN TO = OR LBANK 12388000 CLI 0(RA),C' ' ARE WE TO END OF STATEMENT 12390000 BE IARETA YES,WE'RE DONE 12392000 CLI 0(RA),C'=' MAKE SURE IT IS = 12394000 BNE IARETA IF NOT, ERROR, BUT DON'T FLAG NOW 12396000 SPACE 1 12398000 * LITERAL FOUND- HAVE IT SAVED, WITH POINTER VALUES. 12400000 $CALL LTENT1 CALL TO ENTER LITERAL 12402000 LTR RB,RB WAS LITERAL OK 12404000 BNZ IAERROR NO IT WASN'T,BRANCH 12406000 MVI IARCLENG,RC$LEN2 SET LENGTH TO LENGTH WITH LITERAL 12408000 ST RC,IARCLITA SAVE ADDRESS OF LITERAL 12410000 SPACE 1 12412000 IARETA EQU * EXIT LABEL 12412020 AIF (&$COMNT EQ 0).IANOCOM SKIP IF NO COMMENT CHEK 12412040 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12412060 * MACHINE INSTRUCTION COMMENT COUNTING ROUTINE. * 12412080 * IF THE COMMENT CHECK OPTION IS SPECIFIED, EITHER BY THE * 12412100 * COMNT PARM OPTION, OR BY ACCOUNT NUMBER SETTING, THIS CODE * 12412120 * COUNTS THE NUMBER OF MACHINE INSTRUCTIONS, AND ALSO COUNTS THE * 12412140 * APPROXIMATE NUMBER OF THEM WHICH HAVE A COMMENT OF 4 OR MORE * 12412160 * NONBLANK CHARACTERS. (SEE VARIABLES AVMACHIN AND AVCOMNTN). * 12412180 * THESE VALUES ARE INITIALIZED TO ZERO IN OUINT1, AND ARE USED IN * 12412200 * OUEND2 TO MAKE SURE THAT STUDENT PROGRAMMERS PUT A GIVEN AMOUNT * 12412220 * OF COMMENTS ON THEIR INSTRUCTIONS (I.E. &$COMNT PER CENT OF THE * 12412240 * MACHINE INSTRUCTIONS MUST HAVE COMMENTS ARE ELSE THE PROGRAM WILL * 12412260 * NOT BE EXECUTED.). * 12412280 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12412300 SPACE 1 12412320 TM AVTAGS2,AJOCOMNT IS COMMENT CHK IN EFFECT 12412340 BZ IARETA2 NO, SO DON'T CHECK THEM 12412360 SPACE 1 12412380 LA R1,1 SET R1 FOR USEFUL VALUE, BXHING 12412400 AR RA,R1 BUMP SCAN PTR BEYOND POSSIBLE '(LIT) 12412420 LH RE,AVMACHIN GET CURRENT # MACHINE INSTS 12412440 AR RE,R1 INCREMENT FOR THIS INSTRUCTION 12412460 STH RE,AVMACHIN STORE UPDATED COUNTER BACK 12412480 SPACE 1 12412500 * SCAN TO FIND THE COMMENT FIELD, IF ANY. 12412520 CLI 0(RA),C' ' IS NEXT CHAR BLANK 12412540 BNE *+8 NO-JUMP OUT, COMMENT BEGUN 12412560 BXH RA,R1,*-8 BUMP SCAN PTR BY 1, LOOP 12412580 SPACE 1 12412600 L RE,AVSOLAST GET @ BLANK BEFORE AFTER QUOTE 12412620 LR RD,R1 MOVE A 1 TO REG RD FOR BXLE INCREM 12412640 LA R1,4 ***** # NONBLANKS REQUIRED ********* 12412660 SPACE 1 12412680 * LOOP UNTIL EITHER AFTERQUOTE FOUND OR 4 NONBLANKS. 12412700 CLI 0(RA),C' ' IS THIS A BLANK 12412720 BNE *+12 NO, SKIP TO BCT TO COUNT IT 12412740 BXLE RA,RD,*-8 INCREMENT SCN PTR, LOOP BACK 12412760 B IARETA2 FELL THRU - SHORT COMMENT-DON'T COUN 12412780 BCT R1,*-8 COUNT # CHARS, LOOP TO BXLE 12412800 SPACE 1 12412820 * LEGITAMATE COMMENT FILED-GIVE PROGRAMMER CREDIT FOR IT. 12412840 LH RE,AVCOMNTN GET ACCUMULATD # COMMENTS 12412860 AR RE,RD INCREMENT BY 1 FROM RD 12412880 STH RE,AVCOMNTN RESTORE UPDATED # COMMENTS 12412900 SPACE 1 12412920 .IANOCOM ANOP 12412940 * POINT TO OUR RCB AND RETURN TO MAIN CONTROL. 12414000 IARETA2 LA RC,IARCB SHOW @ OF OUR RCB FOR MAINPROG 12416000 LA RD,1(R3) GET TOTAL LENGTH IN RD FOR RETURN 12418000 IARET $RETURN RGS=(R14-R3) RETURN TO CALLER 12420000 SPACE 1 12422000 * * * * * INDIVIDUAL ERROR SECTIONS 12424000 IAERROR $CALL ERRTAG CALL ERROR FLAGGING ROUTINE 12428000 B IARETA GO RETURN 12430000 EJECT 12432000 * * * * * INTERNAL CONSTANTS * 12434000 IALENGS DC HL1'1,3,3,5' LENGTH-1 BYTES FOR EACH INST TYPE 12436000 SPACE 1 12438000 * * * * * INTERNAL VARIABLES * 12440000 * RCB ENTRIES FOR IAMOP1 * 12442000 IARCB DS 0D RECORD CODE BLOCK 12444000 IARCLENG DS C LENGTH OF RCB 12446000 IARCLOC DS AL3 LOCATION COUNTER VALUE (BY MOCON1) 12448000 IARCTYPE DS C PRIMARY TYPE BYTE 12450000 IARCHEX DS C HEX OPCODE FOR MACH INSTS 12452000 IARCMASK DS C MASK/LITERAL TAGS/ALIGNMENT 12454000 IARCLQ DS C FOR L'* 12456000 IARCLITA DS A ADDRESS OF A LITERAL,IF EXISTS 12458000 IARCEND DS 0C END OF RCB ENTRY 12460000 DROP RAT,R13 CLEAR USING 12462000 TITLE '*** IBASM1 - ASSEMBLER OPCODES - PASS 1 ***' 12464000 **--> CSECT: IBASM1 1 ASSEMBLER INSTRUCTIONS - PASS 1 . . . . . . . 12466000 *. THIS MODULE IS 1 OF THE 2 PASS 1,LEVEL 2 ROUTINES OF THE . 12466100 *. ASSIST ASSEMBLER. IT PERFORMS ALL PROCESSING FOR ASSEMBLER . 12466200 *. INSTRUCTIONS DURING PASS 1, INCLUDING SCANNING, MODIFYING . 12466300 * LOCATION COUNTERS, AND BUILDING AN RCODBLK FOR THE STMT. . 12466400 *. ENTRY CONDITIONS . 12468000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 12470000 *. RC = ADDRESS OF OPCODE CONTROL TABLE ENTRY FOR OPCODE USED . 12472000 *. EXIT CONDITIONS . 12474000 *. RB = 0 NO ERRORS WERE ENCOUNTERED . 12476000 *. = >0 ERRORS WERE FOUND IN STATEMENT . 12478000 *. RC = ADDRESS OF RECORD CODE BLOCK (RCB) . 12480000 *. RD = LENGTH OF CODE - TO BE ADDED AFTER ALIGNMENT DONE . 12482000 *. CALLS CCCON1,CODTL1,ERRLAB,ERRTAG,ESCSEC,ESENX1 . 12484000 *. CALLS EVALUT,LTDMP1,SDBCDX,SDDTRM . 12484500 *. USES DSECTS: AVWXTABL,CNCBLOCK,IBPSECT,OPCODTB,SYMSECT . 12485000 *. USES MACROS: $AL2,$ALIGR,$CALL,$CKALN,$GLOC,$RETURN,$SAVE . 12485500 *. USES MACROS: $SDEF,$SLOC,IBPRTAB . 12485800 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 12486000 SPACE 1 12487000 IBASM1 CSECT 12488000 $DBG 90,* 12490000 SPACE 1 12492000 * * * * * REGISTER ALLOCATION AND USAGE IN IBASM1 * * * * * * * * * * * 12494000 * R0 = WORK REGISTER. SCAN POINTER SAVED HERE BY SOME INTERNAL SUBRS* 12496000 * R1 = 1 USEFUL VALUE, IN ODD REG FOR BXH'ING SCAN POINTER. * 12498000 * R2 = BYTE REGISTER (HI-ORDER 3 BYTES = 0). * 12500000 * R3(IBLN) LENGTH TO BE ADDED TO LOCATION COUNTER (INIT = 0). * 12502000 * R4(IBLB) @ IN SYMBOL TABLE OF LABEL. IF NO LABEL, = 0. * 12504000 * R5(IBLR) INTERNAL LINKAGE REGISTER. * 12506000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12508000 SPACE 1 12510000 IBLN EQU R3 LENGTH REGISTER 12512000 IBLB EQU R4 LABEL POINTER,IF EXISTS 12514000 IBLR EQU R5 LINKAGE REGISTER 12516000 IBMAXCON EQU 10 MAXIMUM NUMBER OF CONSTANTS 12518000 SPACE 1 12520000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 12522000 $SAVE RGS=(R14-R6),BR=R13,SA=IBSAVE 12524000 SPACE 1 12526000 * INITIALIZATION - SET UP REGISTERS,GET OPCODTB CODES * 12528000 LA R1,1 SET UP USEFUL VALUE IN R1 12530000 SR R2,R2 CLEAR REGISTER 12532000 SR IBLN,IBLN SET LENGTH TO 0 12534000 STM R2,IBLN,IBRCB ZERO OUT RCB 12536000 USING OPCODTB,RC NOTE OPCODE TABLE 12538000 MVC IBRCTYPE(3),OPCTYPE MOVE CODE BYRS OVER 12540000 MVC IBRCLQ,OPCMASK PLACE DEFAULT LENGTH ATTRIBUTE IN 12542000 DROP RC NO LONGER NEEDED 12544000 MVI IBRCLENG,RC$LEN MOVE IN NORMAL LENGTH-1 OF RCB 12546000 SR RB,RB CLEAR, TYPICAL NO ERROR SETTING 12548000 SPACE 1 12550000 * TEST FOR LEGALITY/FLAG START INSTRUCTION * 12552000 TM AVTAGS1,$IBSTAR1+$IBDSEC1 CHECK TAGS1 SETTING 12554000 BNZ IBALAB ALREADY SET OR SHOUDLN'T-SKIP 12556000 TM IBRCHEX,$IBSTAR1 IS THIS A START PREVENTER 12558000 BZ IBALAB NO IT ISN'T,DON'T FLAG 12560000 OI AVTAGS1,$IBSTAR1 FLAG THE START NO LONGER GOOD 12562000 CLI AVCESDID,0 DOES A CSECT EXIST 12564000 BNE IBALAB SOMETHING EXIST-BRANCH 12565000 MVI AVCESDID,2 UNITIATED PRIV CODE STARTS NOW 12565500 OI AVTAGS1,$IBPRCD1 SHOW PRIV CODE EXISTS NOW 12566000 SPACE 1 12568000 * CHECK FOR LABEL WHERE NONE ALLOWED,OR MISSING WHERE REQ* 12570000 IBALAB L IBLB,AVLABPT GET ADDRESS OF LABEL,IF EXISTS 12572000 LTR IBLB,IBLB SEE IF A LABEL EXISTS 12574000 BNZ IBANOLB SKIP IF LABEL EXISTS 12576000 TM IBRCHEX,IBNENAM NO NAME EXISTS,SEE IF IT IS REQUIRED 12578000 BZ IBAOPTST NO NAME NEEDED,SKIP TO CHEK OPERAND 12580000 LA RB,$ERNONAM NAME IS NEEDED,DOESN'T EXIST-ERR 12582000 B IBERLAB GO FLAG ERROR-NO LABEL 12584000 SPACE 1 12586000 IBANOLB TM IBRCHEX,IBNONAM IT HAS A LABEL,SEE IF IT IS ALLOWED 12588000 BZ IBAOPTST NAME IS ALLOWED,GO CHK OPERAND 12590000 LA RB,$ERILLAB LABEL NOT PERMITTED 12592000 $CALL ERRLAB FLAG ERROR AT LABEL FIELD 12594000 SPACE 1 12596000 * IF OPERAND IS OMITTED, CHECK THAT ITS NOT ILLEGALLY SO * 12598000 IBAOPTST CLI 0(RA),C' ' SEE IF OPERAND EXISTS 12600000 BNE IBALEV2 OPERAND EXISTS-JUMP 12602000 TM IBRCHEX,IBOMOP MAKE SURE OPERAND MAY BE OMITTED 12604000 BZ IBERNOPR MISSING OPERAND-ILLEGAL 12606000 SPACE 1 12608000 IBALEV2 IC R2,IBRCTYPE GET TYPE BYTE FOR TABLE 12610000 LH R14,IBAJUMP-$IB(R2) GET OFFSET TO INDIVIDUAL SECTION 12612000 IBASMJ B IBASMJ(R14) BRANCH TO INDIVIDUAL SECTION 12614000 SPACE 1 12616000 IBARBZER SR RB,RB CLEAR RB TO SHOW NO ERRORS 12618000 IBASCAN EQU * NO LONGER NEED SCAN TO END OF FIELDS 12620000 * * * * * EXIT CODE * 12622000 IBRETA LR RD,IBLN PLACE LENGTH TO BE ADDED TO LOCCNTR 12624000 LA RC,IBRCB PLACE ADDRESS FOR MAIN PROG 12626000 IBRET $RETURN RGS=(R14-R6) 12628000 SPACE 2 12630000 * * * * * CCW * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12632000 IBCCW EQU * 12634000 LA RB,$ERNOIMP NOT CURRENTLY IMPLEMENTED 12636000 B IBERRORA HAVE THIS FLAGGED FOR NOW 12638000 EJECT 12640000 * * * * * CNOP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12642000 * SETS RCMASK = # BYTES TO BE GENERATED (=0,2,4,6). * 12644000 IBCNOP $GLOC IBLB GET VALUE OF LOCATION COUNTER 12646000 $CKALN 1,IBCNOL CHECK HALFWORD ALIGNMENT 12648000 AR IBLB,R1 INCREMENT LOCCNTR BY 1 TO ALIGN 12650000 $SLOC IBLB SET LOCCNTR VALUE 12652000 SPACE 1 12654000 IBCNOL BAL IBLR,IBCNEV CALL EXPRESSION EVAL, CHECK ROUTINE 12656000 STC RC,AVFWORK1 STORE VALUE,SO CAN TEST FOR ODD 12660000 TM AVFWORK1,1 WAS THE VALUE ODD 12662000 BZ *+8 SKIP AND CONTINUE IF EVEN-OK 12664000 BCT RA,IBERICNO MOVE SCAN PTR BACK, GO FLAG ERROR 12666000 CLI 0(RA),C',' IS DELIM COMMA 12668000 BNE IBERIND NO,ERROR 12670000 AR RA,R1 ADD 1 TO SCAN POINTER 12672000 LR IBLN,RC SAVE 1ST OPERAND HERE 12672050 SPACE 1 12672100 BAL IBLR,IBCNEV CALL EXPRESSION EVAL, CHECK 12672150 SR RC,R1 GET 2ND OPERAND - 1 12672200 C RC,AWF3 WAS 2ND OPERAND ORIGINALLY 4 12672250 BE *+12 YES, SKIPP IF OK 12672300 C RC,AWF7 WAS 2ND OPERAND ORIGINALLY 8 12672350 BNE IBERICNO NO, SO ERROR 12672400 NR IBLB,RC GET LAST 2-3 BITS OF LOCCNTR 12672450 LA IBLN,1(IBLN,RC) GET 1ST OPERAND + 4 OR 8 12672500 SR IBLN,IBLB GET (1ST OPRND + 4 OR 8) - LOCNTR 12672550 NR IBLN,RC GET LAST 2-3 BITS OF RESULT = LENGTH 12672600 STC IBLN,IBRCMASK STORE RESULTING LENGTH FOR PASS 2 12672650 CLI 0(RA),C' ' WAS THIS ALL 12672700 BE IBRETA YES, SO DONE 12672750 B IBERIND NO, INVALID DELIMIETER 12672800 SPACE 1 12672850 IBCNEV $CALL EVALUT CALL EXPRESSION EVALUATOR 12672900 LTR RB,RB WAS EXPRESSION OK 12672950 BNZ IBERRORA NO ,ERROR, FLAG IT 12673000 LTR RD,RD WAS EXPRESSION ABSOLUTE 12673050 BCR Z,IBLR YES, RETURN TO CALLING SECTION 12673100 B IBERICNO NO, CNOP ERROR 12673150 SPACE 2 12716000 * * * * * CSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12718000 IBCSECT SR RB,RB SHOW THIS IS A CSECT CALL 12720000 B IBESCALL GO TO COMMON CODE SECTION 12722000 SPACE 2 12724000 * * * * * DROP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12726000 IBDROP EQU IBASCAN NOTHING TO DO THIS PASS 12728000 AIF (&$DEBUG).IBNOD1 SKIP IF NOT DEBUG MODE 12730000 SPACE 1 12732000 * * * * * DEBUG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12734000 IBDEBUG MVC IBRCHEX,0(RA) GET 1ST CHAR,EITHER 1 OR 2 12736000 LA RA,2(RA) BUMP SCAN POINTER PAST 1, OR 2, 12738000 BAL IBLR,IBEVCALL CALL EXPRESSION EVALUATOR FOR VALUE 12740000 STC RC,IBRCMASK SAVE THE BYTE CODE 12742000 CLI IBRCHEX,C'2' WAS THIS PASS 2 ONLY 12744000 BE IBRETA YES,DON'T CHANGE AVDEBUG 12746000 STC RC,AVDEBUG SAVE THE NEW FLAG INTO DEBUG 12748000 B IBRETA GO RETURN 12750000 .IBNOD1 ANOP 12752000 EJECT 12754000 * * * * * DC - DS * * * * * * * * * * * * * * * * * * * * * * * * * * * 12756000 * SETS RCMASK = # OPERANDS IN DC STMT (= 1 TO IBMAXCON). * 12758000 * ADDS TO RCODBLK 1 CNCBLOCK FOR EACH OPERAND. * 12760000 * SETS RCLQ = LENGTH ATTRIBUTE - 1 OF 1ST OPERAND. * 12762000 * **NOTE** MUST CHECK FOR MISSING QUOTE, ELSE ABEND MAY OCCUR. * 12762100 SPACE 1 12764000 * * * * * REGISTER ALLOCATION FOR DC-DS PROCESSING * * * * * * * * * * 12766000 * R0 = CURRENT NUMBER OF OPERANDS PROCESSED * 12768000 * R1 = 1 CONSTANT FOR BXHING * 12770000 * R2 = CURRENT LENGTH-1 OF IBRCB,WILL BE INCREMENTED BY DC'S * 12772000 * RW(IBLN) = LOCATION COUNTER FOR BEGINNING OF STATEMENT * 12774000 * RX = 0 ==> DS, 4 ==> DC STATEMENT. * 12776000 * RY = MAXIMUM # OPERANDS ALLOWED(= IBMAXCON IF DC, = 4095 IF DS). * 12778000 * RZ = ADDRESS OF CURRENT CNCBLOCK PART OF IBRCB BEING FILLED(DC'S) * 12780000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12782000 SPACE 1 12784000 IBDC LA RX,4 SHOW THIS IS A DC 12786000 LA RZ,IBRCONS ADDRESS OF 1ST CONST BLOCK 12788000 LA RY,IBMAXCON MAXIMUM NUMBER OF CONSTANTS ALOOWED 12790000 B IBDCDS BRANCH TO COMMON CODE 12792000 SPACE 1 12794000 IBDS SR RX,RX CLEAR TO SHOW CODTL1 THIS IS DS 12796000 LA RY,4095 PUT HUGE NUMBER SO WON'T FLAG EXCED 12798000 IBDCDS SR R0,R0 CLEAR TO SHOW NO OPERANDS RIGHT NOW 12800000 IC R2,IBRCLENG GET CURRENT LENGTH OF IBRCB 12802000 $GLOC IBLN GET THE LOCATION COUNTER 12804000 SPACE 1 12806000 * LOOP FOR 1 OR MORE OPERANDS. * 12808000 IBDSCAL LR RB,RX SHOW CODTL1 WHETHER DC OR DS 12810000 $CALL CODTL1 CALL THE OPERAND PROCESSOR 12812000 LTR RB,RB WAS THERE AND ERROR 12814000 BNZ IBDCENDA IF RB^=0, ==> ERROR 12816000 SPACE 1 12818000 USING CNCBLOCK,RC RC POINTS AT CODTL1'S CNCBLOCK 12820000 IC RB,CNCLEN GET LENGTH-1 OF CONSTANT 12822000 TM CNCTYP,$CNALN IS ALIGNMENT REQUIRED 12824000 BZ IBDSLQ DO NOT ALIGN UNLESS NEEDED 12826000 $ALIGR IBLN,RB 12828000 IBDSLQ BXH R0,R1,IBDSADD SKIP FOLLOWING 2 STMTS IF NOT 1ST 12830000 $SLOC IBLN SET LOCATION COUNTER FOR STMT START 12832000 STC RB,IBRCLQ SAVE THE LENGTH ATTRIBUTE 12834000 IBDSADD AR IBLN,RE ADD THE TOTAL LENGTH OVER 12836000 LTR RX,RX IS THIS A DS OR A DC 12838000 BZ IBDSOPA IT IS A DS, BRANCH 12840000 CR R0,RY COMPARE # OF OPS TO MAXIMUM ALLOWED 12842000 BH IBDCEXT IF EXCEEDS, FLAG ERROR 12844000 SPACE 1 12846000 IBDCMOV MVC 0(CNC$LEN,RZ),CNCBLOCK MOVE BLOCK OVER(DC ONLY) 12848000 LA R2,CNC$LEN(R2) INCREMENT THE LENGTH 12850000 LA RZ,CNC$LEN(RZ) BUMP POINTER OF NEXT EMPTY SPACE 12852000 IBDSOPA CLI 0(RA),C' ' IS THIS THE END 12854000 BE IBDCHEKA GO TO CHECK FOR MISSING DELIMT 12856000 CLI 0(RA),C',' IS DELIM ACTUALLY A COMMA 12857000 BNE IBDCINDL NO, BAD USER, GET HIM 12857100 BXH RA,R1,IBDSCAL BUMP SCAN POINT AND GET NEXT OPERAND 12858000 SPACE 1 12858100 IBDCHEKA C RA,AVSOLAST COMPARE TO @ BLANK BEFORE AFTER ' 12858200 BL IBDCEND LOW, THEREFOR NO MISSING ' 12858300 LA RB,$ERNODLM MISSING ', ERROR-SHOW IT 12858400 B IBDCENDA HAVE IT FLAGGED, , NO ASMBLY 12858500 SPACE 1 12860000 IBDCINDL LA RB,$ERINVDM INVALID DELIMITER-SHOW IT 12861000 B IBDCENDA GO FLAG ERROR 12861100 IBDCEXT LA RB,$ERDCEXT TOO MANY CONSTANT OPERANDS IN DC 12862000 IBDCENDA $CALL ERRTAG HAVE THE ERROR FLAGGED 12864000 LA R2,RC$LEN GET REGULAR LENGTH-1 BACK 12866000 IBDCEND S IBLN,AVLOCNTR GET DIFFERENCE, TO BE ADDED TO LOCCN 12868000 STC R0,IBRCMASK SAVE NUMBER OF OPERANDS 12870000 STC R2,IBRCLENG PLACE THE LENGTH-1 BACK INTO RCB 12872000 B IBRETA RETURN 12874000 DROP RC 12876000 SPACE 2 12878000 * * * * * DSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12880000 IBDSECT LA RB,4 SHOW ESD ROUTINE THIS IS DSECT 12882000 B IBESCALL GO CALL ROUTINE 12884000 SPACE 2 12886000 * * * * * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12888000 IBEJECT EQU IBRETA NOTHING TO DO 12890000 SPACE 2 12892000 * * * * * END PLUS COMMON END-LTORG CODE* * * * * * * * * * * * * * * * 12894000 IBEND LR R0,RA SAVE SCAN POINTER 12896000 $CALL LTDMP1 CALL LITERAL DUMP 12898000 LR IBLN,RA MOVE LENGTH REQUIRED OVER 12900000 TM AVTAGS1,$IBDSEC1 ARE WE IN A DSECT RIGHT NOW 12902000 BO IBEND1 SKIP OVER IF SO,AVLOCHIH IS OK 12904000 SPACE 1 12906000 A RA,AVLOCNTR ADD LOCATION COUNTER TO INCREMENT 12908000 C RA,AVCSHIH IS THIS LARGE THAN PREVIOUS LARGEST 12910000 BNL *+8 YES,SO USE JUST COMPUTED VALUE 12912000 L RA,AVCSHIH BACKWARDS ORG,USE PREVIOUS HIGHEST 12914000 ST RA,AVLOCHIH SAVE HIGHEST VALUE OF CODE,USE IT 12916000 IBEND1 LR RA,R0 RESTORE THE SCAN POINTER 12918000 B IBARBZER GO ZERO RB TO SHOW OK 12922000 SPACE 2 12924000 * * * * * ENTRY * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12926000 IBENTRY SR RB,RB SHOW ESENX1 THIS IS ENTRY 12928000 B IBENEXCL GO CALL ROUTINE 12930000 SPACE 2 12932000 * * * * * EQU * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12934000 * SETS RCEQU = VALUE OF SYMBOL (IF EVALUATION COMPLETE). * 12936000 * ALSO ZEROS AVLABPT SO THAT MPCON0 DOESNT REDEFINE SYMBOL. * 12938000 IBEQU EQU * SHOW LENGTH 4> THAN USUAL 12944000 MVC AVLABPT,AWZEROS ZERO IT, MOCON1 WILL THINK NO LABEL 12946000 BAL IBLR,IBEVCALL CALL GEN EXPRESSION EVALUTAR 12962000 BNZ IBERRORA NOGOOD, QUIT,FLAG ERROR. 12963000 SPACE 1 12976000 USING SYMSECT,IBLB NOT SYMBOL TABLE USING 12978000 CLI 0(RA),C' ' RIGHT DELIMITER 12980000 BNE IBERIND NO,ERROR 12982000 $SDEF RC,RD,RE DEFINE THE SYMBOL 12984000 DROP IBLB ERASE USING 12986000 ST RC,IBRCEQU PLACE VALUE FOR LATER USE 12988000 MVI IBRCLENG,RC$LEN2 SHOW LENGTH 4> THAN USUAL 12990000 B IBRETA GO RETURN 12992000 SPACE 2 12994000 * * * * * EXTRN * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12996000 IBEXTRN LA RB,2 SHOW ESENX1 THIS IS EXTRN CALL 12998000 IBENEXCL $CALL ESENX1 CALL EXTRN-ENTRY ROUTINE 13000000 LTR RB,RB WERE THERE ERRORS 13002000 BZ IBRETA NO ERRORS-QUIT 13004000 B IBERRORA GO HAVE ERROR FLAGGED AND QUIT 13006000 SPACE 2 13008000 * * * * * LTORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13010000 IBLTORG EQU IBEND USE SAME CODE. LTDMP1 ALIGNS LOCNTR. 13012000 SPACE 2 13016000 * * * * * ORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13018000 IBORG CLI 0(RA),C' ' WAS OPERAND OMITTED 13020000 BE IBORGOM YES,OMITTED 13022000 BAL IBLR,IBEVCALL GET EXPRESSION EVALUATED 13024000 BNZ IBERRORA IF ERROR,RETURN 13026000 CLI 0(RA),C' ' MAKE SURE ENDS WITH ' ' 13028000 BNE IBERIND INVALID DELIM 13030000 IC R2,AVCESDID GET ESDID 13032000 CR R2,RD MAKE SURE THEY ARE SAME 7 13034000 BNE IBERORG WRONG SECTION - BAD ORG 13036000 C RC,AVCSLOW IS IT LOWER THAN LOWEST LEGAL VALUE 13038000 BL IBERORG LOWERR THAN LOWEST LEGAL, ERROR 13040000 SPACE 1 13042000 L R0,AVCSHIH GET HIGHEST VALUE 13044000 C R0,AVLOCNTR IS HIGHEST NOT HIGHER THAN LOCCNTR 13046000 BNL IBORGH1 SKIP IF HIGH VALUE>=LOCCNTR 13048000 $GLOC R0 GET CURRENT LOCCNTR 13050000 IBORGH1 CR R0,RC IS HIGHEST VALUE LESS THAN NEW 13052000 BNL IBORGH2 NO IT ISNT,BRANCH 13054000 LR R0,RC NEW HIGHEST VALUE 13056000 IBORGH2 ST R0,AVCSHIH STORE NEW HIGH VALUE 13058000 $SLOC RC SET LOCATION COUNTER 13060000 B IBRETA GO RETURN 13062000 SPACE 1 13064000 * OMITTED OPERAND IN ORG==>SET TO HIGHEST UNUSED VALUE * 13066000 IBORGOM $GLOC R0 GET LOCCNTR 13068000 C R0,AVCSHIH COMPARE TO HIGHEST VALUE 13070000 BNL IBORGO1 SKIP IF LOCCNTR HIGH 13072000 L R0,AVCSHIH USE HIGHEST VALUE 13074000 IBORGO1 ST R0,AVCSHIH SET POSSIBLY NEW HIGHEST LOCCNTR VAL 13076000 $SLOC R0 SET NEW LOCCNTR VALUE 13078000 B IBRETA GO RETURN 13080000 EJECT 13082000 * * * * * PRINT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13084000 * SETS RCMASK = VALUE OF PRINT CODE TO BE SET BY PRINT. * 13086000 * ALSO IMMEDIATELY SETS AVPRINT1 TO CORECT PRINT CONTROL. * 13086100 IBPRINT LA RE,IBPLAST ADDRSS OF LAST IN TABLE 13088000 SR RD,RD CLEAR FOR INSERTIONS 13090000 MVI AVFWORK1,0 INIT=0 FOR CORRECTNESS TESTS 13091000 MVC IBRCMASK,AVPRINT1 COPY CURRENT PRINT STATUS 13091500 SPACE 1 13092000 * LOOP TO LOOK UP NEXT OPERAND IN LEGAL PRINT LIST * 13094000 IBPLOOP LA R14,IBPTAB @ BEGINNING OF TABLE 13096000 USING IBPSECT,R14 NOTE THE TABLE 13098000 SPACE 1 13100000 IBPLOOPA IC RD,IBPLENG GET LENGTH-1 OF ENTRY 13102000 STC RD,*+5 STORE L-1 INTO CLC INST 13104000 CLC 0($CHN,RA),IBPOPR COMPARE INCOMING OPERAND 13106000 BNE IBPLOOPB GO TO BOTTOM IF NOT 13108000 SPACE 1 13110000 MVC *+7(1),IBPVO COPY BIT TO CHECK INTO TM NEXT 13112000 TM AVFWORK1,$ TEST: SEE IF 2 OF SAME OR CONTRADCT 13114000 BNZ IBERINVF INVALID 13116000 OC AVFWORK1(1),IBPVO OR IN: RECORD FOR COMPATIBLITY TST 13117000 OC IBRCMASK,IBPVO SET DESIRED BIT DEFINITELY = 1 13118000 XC IBRCMASK,IBPVX XOR: SET BIT OFF IF REQUIRED OFF 13119000 MVC AVPRINT1,IBRCMASK KEEP AVPRINT1 SAME VALUE AS RCMASK 13119500 LA RA,1(RD,RA) BUMP SCP TO DELIMITER 13120000 CLI 0(RA),C' ' IS THIS THE END 13122000 BE IBRETA YES,RETURN 13124000 CLI 0(RA),C',' CHECK DELIMITER 13126000 BNE IBERIND ERROR IF NOT 13128000 BXH RA,R1,IBPLOOP GO BACK FOR NEXT OP,BUMP SCPTR 13130000 SPACE 1 13132000 IBPLOOPB LA R14,IBPOPR-IBPSECT+1(R14) INCREMENT BY RITHT OFFSET 13134000 BXLE R14,RD,IBPLOOPA INCREMENT WITH VARIABLE LENGTH 13136000 B IBERINVF IF FALSS THRU==>UNRECOGNIZABLE 13138000 DROP R14 CLEAR USING 13140000 SPACE 2 13142000 * * * * * SPACE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13144000 * SETS RCMASK = # LINES TO BE SPACED. OMITTED OPERAND ==> 1. * 13146000 IBSPACE CLI 0(RA),C' ' IS OPERAND OMITTED 13148000 BE IBRETA SKIP CALL,LEAVE IBRCMASK=1 13150000 $CALL SDDTRM GET VALUE FOR SPACING 13152000 LTR RB,RB WAS VALUE OK 13153000 BNZ IBERRORA BRANCH IF ERROR 13154000 LTR RC,RC WAS VALUE ^=0 13156000 BZ IBRETA RETURN IF =0,LEAVE 1 AS SPACE VALUE 13158000 STC RC,IBRCMASK STORE VALUE FOR PASS 2. 13160000 B IBRETA RETURN 13162000 EJECT 13164000 * * * * * START PLUS COMMON START,DSECT,CSECT CODE * * * * * * * * * * 13166000 * SETS RCMASK = NEW CURRENT ESDID NUMBER. * 13168000 * START SETS ITS VALUE INTO AVLOCLOW&AVFENTER FOR INIT. * 13169000 IBSTART TM AVTAGS1,$IBSTAR1 IS START NO LONGER ALLOWED 13170000 BO IBSTERR BRANCH-ERROR 13172000 SR RC,RC CLEAR FOR VALUE IF OMITTED 13174000 CLI 0(RA),C' ' WAS OPERAND OMITTED. 13176000 BE IBESCALA YES,GO CALL SED ROUTINE 13178000 $CALL SDBCDX GET SELF-DEFINING TERM 13179000 LTR RB,RB WAS VALUE OK 13180000 BP IBERRORA BRANCH, ERROR CODE IN RB 13181000 BM IBERINVF RB=-4, NOT SELF-DEFTERM, ERROR 13181500 CLI 0(RA),C' ' MAKE SURE DELIMITER OK 13182000 BNE IBERIND INVALID DELIMITER 13184000 LA RB,7 FOR DBLWD ALIGNMENT 13185000 $ALIGR RC,RB ALIGN STARTING VALUE TO *8 13185500 ST RC,AVLOCLOW THIS IS NOW LOWEST LOC(UT WANTS IT) 13186000 ST RC,AVFENTER STORE FOR BEGINNING @ 13187000 IBESCALA LA RB,2 SHOW ESD ROUTINE THIS IS A START 13188000 SPACE 1 13190000 * COMMON CODE - START, DSECT, CSECT. 13192000 IBESCALL LR R0,RA SAVE SCAN POINTER 13194000 $CALL ESCSEC CALL FOR CSECT,DSECT,OR START 13196000 OI AVTAGS1,$IBSTAR1 FLAG NO MORE STARTS 13198000 LR RA,R0 RESTORE SCAN POINTER 13200000 LTR RB,RB CHECK FOR ERRPRS 13202000 BNZ IBERLAB GO HAVE ERRORS FLAGGED IF NEEDED 13204000 MVC IBRCMASK,AVCESDID KEEP NEW ESDID VALUE 13206000 B IBRETA RETURN 13208000 SPACE 2 13210000 * * * * * TITLE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13212000 * SETS RCMASK = LENGTH OF TITLE OPERAND FIELD. * 13214000 IBTITLE CLI 0(RA),C'''' MAKE SURE DELIM OK 13216000 BNE IBERIND ERROR IF NOT 13218000 AR RA,R1 BUMP SCAN POINTER BY 1 13220000 $CALL CCCON1 HAVE THE TITLE CHECKED 13222000 LTR RB,RB WAS THERE ERROR 13224000 BNZ IBERRORA YES,GO FLAG IT 13226000 CLI 1(RA),C' ' MAKE SURE ENDS WITH QUOTE BLANK 13228000 BNE IBERIND BRANCH IF ERROR 13230000 C RA,AVSOLAST WAS IT >= @ BLANK BEFORE AFERQUOTE 13231000 BNL IBERNODL TOO LONG, MISSING DELIMITER 13231500 SR RC,R1 S RC,=F'1' GET LENGTH-1 AS NEEDED 13231900 STC RC,IBRCMASK SAVE THE LEGNTH REQUIRED 13232000 BXH RA,R1,IBRETA BUMP SCAN POINTER AND RETURN 13234000 SPACE 2 13236000 * * * * * USING * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13238000 IBUSING EQU IBASCAN NOTHING TO DO THIS PASS 13240000 EJECT 13242000 * * * * * INDIVIDUAL ERROR EXITS * 13244000 IBERNODL LA RB,$ERNODLM MISSING DELIMITER ERROR 13245000 B IBERRORA GO FLAG AND EXIT 13245500 IBERICNO LA RB,$ERICNOP ILLEGAL CNOP OPERAND COMBINATION 13246000 B IBERRORA GO TO FLAG 13248000 IBERIND LA RB,$ERINVDM INVALID DELIMITER 13250000 B IBERRORA SET ERROR CODE AND RETUN 13252000 IBERINVF LA RB,$ERINVF ILLEGAL FIELD OF SOME SORT 13254000 B IBERRORA GO FLAG IT 13256000 IBERNOPR LA RB,$ERNOOPR MISSING OPERAND 13258000 B IBERRORA GO PUT OUT ERROR CODE 13260000 IBERORG LA RB,$ERILORG ILLEGAL ORG 13262000 B IBERRORA GO FLAG IT 13264000 IBSTERR LA RB,$ERSTART SHOW BAD START, FALL THRU-IBERRORA 13270000 SPACE 2 13272000 * * * * * ALL ERRORS EXCEPT LABEL ERRORS * 13274000 IBERRORA $CALL ERRTAG HAVE LABEL FLAGGED 13276000 B IBRETA RETURN TO CALLER 13278000 SPACE 2 13280000 * * * * * LABEL ERRORS * 13282000 IBERLAB $CALL ERRLAB CALL LABEL ERROR 13284000 B IBRETA RETURN TO CALLER 13286000 SPACE 2 13288000 * INTERNAL SUBROUTINES. 13290000 SPACE 2 13320000 * * * * * EXPRESSION EVALUATION - CALL TO EVALUT * 13322000 IBEVCALL $CALL EVALUT CALL EXPRESSION EVALUATOR 13324000 LTR RB,RB SET THE CONDTION CODE 13326000 BR IBLR RETURN TO CALLER 13328000 EJECT 13330000 * * * * * INTERNAL CONSTANTS * 13332000 * * * * * 2ND LEVEL JUMP TABLE FOR IBASM1 * 13334000 IBAJUMP $AL2 IBASMJ,(IBUSING,IBDROP,IBSTART,IBCSECT,IBDSECT,IBENTRY,I#13336000 BEXTRN,IBEQU,IBDC,IBDS,IBCCW,IBTITLE,IBEJECT,IBSPACE,IBP#13338000 RINT,IBORG,IBLTORG,IBCNOP,IBEND),-2 13340000 AIF (&$DEBUG).IBNOD2 SKIP IF NOT DEBUG MODE 13342000 DC AL2(IBDEBUG-IBASMJ) OFFSET TO DEBUG ROUTINE 13344000 .IBNOD2 ANOP 13346000 SPACE 1 13348000 * * * * * PRINT OPERAND TABLE * 13350000 IBPTAB IBPRTAB ON,$IBPON SET BIT ON 13350200 IBPRTAB OFF,$IBPON,* SET 'ON' BIT OFF 13350400 IBPRTAB GEN,$IBPGEN SERT GEN BIT ON 13350600 IBPRTAB NOGEN,$IBPGEN,* SET 'GEN' BIT OFF 13350800 IBPRTAB DATA,$IBPDAT SET DATA BIT ON (ONLY COMPATIBLITY) 13351000 IBPRTAB NODATA,$IBPDAT,* SET 'DATA' BIT OFF 13352000 IBPLAST EQU *-1 @ LAST BYTE FOR LIMIT 13354000 SPACE 1 13356000 LTORG 13370000 SPACE 1 13372000 * * * * * INTERNAL VARIABLES * 13374000 * * * * * RCB AREA FOR IBASM1 * 13376000 IBRCB DS 0D RECORD CODE BLOCK 13378000 IBRCLENG DS C LENGTH OF RCB 13380000 IBRCLOC DS AL3 LOCATION COUNTER VALUE 13382000 IBRCTYPE DS C OPCODE TYPE 13384000 IBRCHEX DS C 2ND LEVEL TAGS-LABLE&OPERAND 13386000 IBRCMASK DS C FROM OPCTYPE=LENGTH ATTRIBUTE 13388000 IBRCLQ DS C BYTE FOR LENGTH ATTRIBUTE L'* 13390000 IBRCEQU DS 0F VALUE OF AN EQUATE SYMBOL 13392000 IBRCONS DS (IBMAXCON)CL(CNC$LEN) CONSTANT CODE BLOCKS 13394000 SPACE 1 13396000 * * * * * DSECT USED BY PRINT ROUTINE FOR TABLE LOOKUP * * * * * * * * 13398000 IBPSECT DSECT 13400000 IBPLENG DS C NUMBER OF CHARACTERS IN CODE 13402000 IBPVO DS B BIT TO BE OR'D IN: BIT TO TEST 13404000 IBPVX DS B BIT TO BE XOR'D IN, RESET =0 IF NEED 13406000 IBPOPR DS C OPERAND CHARACTERS(ON,OFF,ETC) 13408000 DROP RAT,R13 CLEAN UP USING SIUTATION 13410000 TITLE '*** ICMOP2 - MACHINE INSTRUCTIONS - PASS 2 ***' 13412000 **--> CSECT: ICMOP2 2 MACHINE OPERATIONS - PASS 2 . . . . . . . . . 13414000 *. THIS MODULE IS 1 OF THE 2 PASS 2,LEVEL 2 ROUTINES IN THE . 13414100 *. ASSIST ASSEMBLER. IT PROCESSES ALL MACHINE INSTRUCTIONS IN . 13414200 *. THE SECOND PASS, SCANNING ALL THE OPERAND FIELDS AND CREATING. 13414300 *. THE OBJECT CODE FOR THEM. IT ALSO DOES THE SETUP REQUIREED . 13414400 *. FOR OUTPT2 TO PRODUCE THE PRINTED LISTING. THIS ROUTINE HAS . 13414500 *. MANY SPECIAL-CASE SECTIONS WHICH ARE USED FOR SPEED, AND . 13414600 *. WHICH COULD USE LESS SPACE IF CALLS TO THE GENERAL EXPRESSION. 13414700 *. EVALUATOR EVALUT WERE USED INSTEAD. . 13414800 *. ENTRY CONDITIONS . 13416000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 13418000 *. RC = ADDRESS OF RECORD CODE BLOCK(RCODBLK) FOR STATEMENT . 13420000 *. RE = ADDRESS OF RECORD SOURCE BLOCK(RSBLOCK) FOR STATEMENT . 13422000 *. CALLS BRDISP,ERRTAG,EVALUT,LTGET2,SDBCDX,SDDTRM . 13424000 *. CALLS SDBCDX,SYFIND,OUTPT2,UTPT2 . 13424100 *. USES MACROS: $AL2,$CALL,$GLOC,$RETURN,$SAVE,ICT . 13424200 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 13426000 SPACE 1 13427000 ICMOP2 CSECT 13428000 $DBG 90,* 13430000 ICB1D1 EQU X'10' (ICYFLAG) - ==> B(D) OPERAND FORMAT 13432000 ICBX2 EQU X'08' (ICYFLAG) ==> D(X,B) FORMAT,NOT L 13434000 ICBSOPN2 EQU X'04' (ICYFLAG) ==> B(D) STORED INTO OPN2 13436000 ICBSEA2 EQU X'02' (ICYFLAG) ==> @ GOES TO ICYEA2 13438000 ICYXLFN EQU X'80' (ICYF2) ==> X OR L FIELD PRESENT 13440000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 13442000 USING RCODBLK,RC NOTE POINTER TO CODE BLOCK 13444000 EJECT 13446000 * * * * * OVERALL REGISTER USAGE FOR ICMOP2 * * * * * * * * * * * * * * 13448000 * R1 = @ REGISTER-HI-ORDER BYTE =0. OFTEN USED TO SAVE SCAN PTR RA * 13450000 * R2 = BYTE REGISTER - HI-ORDER 3 BYTES = 0. USED FOR INSERTIONS,ETC* 13452000 * RW = LEVEL 1 LINK REGISTER * 13454000 * RX = LEVEL 3 LINK REGISTER * 13456000 * RY = 1 USED FOR INCREMENTING,DECREMENTING REGS,BXH'ING SCAN PTR* 13458000 * RZ = LEVEL 2 LINK REGISTER * 13460000 * RA = SCAN POINTER REGISTER - @ NEXT CHARACTER TO BE EXAMINED * 13462000 * RB = USUAL PLACE FOR AN ESDID TO BE KEPT,IF THERE IS ONE * 13464000 * RC = NORMAL PARAMATER REGISTER FOR RETURN OF A CONVERTED VALUE * 13466000 * R13= @ SAVEAREA AND BASE REGISTER * 13468000 * R14-R15 LOCAL WORK REGISTERS, EXTERNAL LINK REGISTERS * 13470000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13472000 SPACE 1 13474000 $SAVE RGS=(R14-R6),BR=R13,SA=ICMOSAVE 13476000 MVC ICRCB(RCLITEQ-RCODBLK+4),RCODBLK MOVE TO FREE RC 13478000 DROP RC NO LONGER USING,WILL NEED EVERY REG 13480000 LM R0,R3,AWZEROS ZERO OUT THESE REGS 13482000 STM R0,R3,ICYBLOCK ZERO OUT BLOCK FOR OBJ CODE 13484000 LA RY,1 INITIALIZE REGISTER 13486000 MVC ICYOP(2),ICRCHEX MOVE OPCODE-MASK OVER 13488000 AIF (NOT &$XREF).NOXRF15 A 13488050 IC R2,ICYOP GET OPCODE A 13488100 IC R2,ICXRTAB(R2) GET FLAG BYTE FROM TABLE A 13488200 STC R2,AVXRMDFT STORE FLAG BYTE IN FLAG A 13488400 .NOXRF15 ANOP 13488410 NI ICYR1R2,X'F0' REMOVE 2ND NIBBLE,LEAVING MASK ONLY 13490000 SPACE 1 13490500 * OBTAIN TYPE INFORMATION,INSTRUCTION SECTION @. TAKE 13491000 * BRANCH TO ONE OF LEVEL 0 INSTRUCTION PROCESSORS. 13491500 IC R2,ICRCTYPE GET TYPE BYTE 13492000 LH R14,ICOJUMP(R2) GET OFFSET @ FOR LEVEL 0 ROUTINE 13494000 SRL R2,1 DIVIDE BY 2 FOR BYTE INDEX 13496000 IC R2,ICTTAB(R2) GET FLAG BYTE BELONGING TO TYPE 13498000 STC R2,ICYFLAG STORE FLAG BYTE FOR LATER USE 13500000 ICMOJ B ICMOJ(R14) TAKE BRANCH TO INSTRUCTION TYPE SUBR 13502000 * * * * * JUMP OFFSET TABLE FOR INSTRUCTION TYPE PROCESSORS (LEVEL 0) * 13504000 ICOJUMP $AL2 ICMOJ,(ICRRM,ICRXM,ICRR,ICRX,ICRS,ICRSH,ICSI,ICSS,ICSS2,#13506000 ICRSO,ICSPC),-2 13508000 EJECT 13510000 * * * * * INDIVIDUAL ERROR EXITS * 13512000 ICNUNDEF LA RB,$ERUNDEF UNDEFINED SYMBOL 13514000 LR RA,R1 GET A SCAN POINTER BACK 13516000 BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13518000 ICNEABS LA RB,$ERNEABS AN ABSOLUTE TERM OR EXPRESSION NEEDD 13520000 B ICNERROR GO FLAG ERROR 13522000 ICNBADSY LA RB,$ERINVSY INVALID SYMBOL 13524000 BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13526000 ICNLITER LA RB,$ERTLIT ILLEGAL USE OF LITERAL 13528000 B ICNERROR GO FLAG ERROR 13530000 ICNRELC LA RB,$ERRELOC RELOCATABILITY ERROR 13532000 BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13534000 ICNEXGTB AR RA,RY BUMP SCAN PTR TO ALLOW FOR BCT 13536000 ICNEXGTA LA RB,$EREXGTA EXPRESSION TOO LARGE 13538000 BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13540000 ICNADDR LA RB,$ERADDR ADDRESSIBILITY ERROR 13542000 BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13544000 ICNILLEG CLI 0(RA),C' ' WAS ILLEGAL A BLANK (MISSING) 13546000 BNE ICNINVDM NO,SOMETHING ELSE ILLEFAL 13548000 ICNNOOPR LA RB,$ERNOOPR MISSING OPERAND 13548500 B ICNERROR GO HAVE IT FLAGGED 13549000 ICBLANK CLI 0(RA),C' ' FINAL CHECK FOR BLANK 13550000 BE ICOUTPT BRANCH OUT IF OK 13552000 ICNINVDM LA RB,$ERINVDM INVALID DELIMITER (MOST COMMON) 13554000 ICNERROR $CALL ERRTAG HAVE ERROR FLAGGED 13556000 ICNERRF MVC ICYEA1(14),AWZEROS ZERO THE INSTRUCTION OUT 13558000 SPACE 1 13560000 * * * * * ICOUTPT - COMMON EXIT - PRODUCE OBJECT CODE,PRINT STMT * 13562000 ICOUTPT $GLOC RA GET LOCATION COUNTER FOR UTPUT2 13564000 LA RC,ICYOP @ OBJECT CODE FOR UTPUT2 13568000 IC R2,ICRCLQ GET LENGTH-1 OF STATEMENT CODE 13570000 LR RD,R2 MOVE OVER FOR LENGTH-1 FOR UTPUT2 13572000 LR RE,RY SET RE = 1 ==> PRODUCE 1 OF OBJECT 13574000 $CALL UTPUT2 HAVE OBJECT CODE LOADED 13576000 SPACE 1 13578000 * SET UP AND CALL PRINTER ROUTINE * 13580000 LA RB,$OUMACH SHOW THIS IS A MACHINE INSTRUCTION 13582000 LA RC,ICYBLOCK GET @ BLOCK 13584000 LR RD,R2 MOVE LENGTH-1 WHERE OUTPT2 WANTS IT 13586000 $CALL OUTPT2 CALL OUTPUT ROUTINE 13588000 AIF (NOT &$XREF).ICNXRF1 SKIP IF NO CROSS-REF OPTION J 13589000 MVI AVXRTYPE,AVXRFTCH MAKE FETCH TYPE NORMAL FOR REST J 13589010 .ICNXRF1 ANOP 13589020 ICRET $RETURN RGS=(R14-R6) 13590000 EJECT 13592000 * * * * * ICRR - NORMAL RR INSTRUCTIONS,EXTENDED MNEM RR'S - LEVEL - 0* 13594000 ICRRM BAL RZ,ICREG GO GET REG 2 FIELD 13594500 EX RC,ICOIR HAVE IT ORED IN 13594600 B ICBLANK GO CHECK FOR BLANK 13594700 ICRR EQU * A 13596000 CROSSET 1 SET FLAG M/F FIRST OPRND A 13596500 BAL RW,ICWREG1 GO GET FIRST REGISTER A 13597000 CROSSET 2 SET FLAG M/F 2ND OPERAND A 13598000 BAL RZ,ICREG GO GET 2ND REGISTER 13600000 EX RC,ICOIR HAVE IT OR'D INTO R2 FIELD 13602000 AIF (NOT(&$FLOTA OR &$FLOTAX OR &$S370A)).ICRRNF 13604000 TM ICRCMASK,IAB SHOULD R2 BE EVEN? 13606000 BNO ICBLANK NO, SO BRANCH TO CHECK FOR BLANK 13608000 TM ICYR1R2,X'01' WAS THRE AN ODD REG IN 2ND POSITION 13610000 BZ ICBLANK NO, SO OK -BRANCH 13612000 BAL RZ,ICWODDR HAVE ODD REG FLAGGED 13614000 .ICRRNF B ICBLANK GO TO CHECK FOR BLANK AND QUIT 13616000 SPACE 2 13618000 * * * * * ICRX - NORMAL RX AND RX EXTENDED MNEMONICS - LEVEL - 0 * 13620000 ICRX EQU * A 13620050 CROSSET 1 SET FLAG FOR 1ST OPERAND A 13620100 BAL RW,ICWREG1 CALL FOR 1ST REG A 13622000 ICRXM EQU * ENTRY FOR RX EXTENDED MNEMONICS 13624000 CROSSET 2 SET FLAG 2ND OPERAND A 13624500 BAL RW,ICXBD GO GET THE OPERAND 13626000 TM ICYF2,ICYXLFN WAS INDEX SPECIFIED 13628000 BZ *+10 SKIP OVER IF SO 13630000 OC ICYR1R2,ICYXL PLACE X2 FIELD IN,IF IT WAS SPECIFIE 13632000 B ICBLANK GO CHECK FOR BLANK 13634000 SPACE 2 13636000 * * * * * ICRS - REGULAR NON-SHIFT RS INSTRUCTIONS - LEVEL - 0 * 13638000 ICRS EQU * A 13640000 CROSSET 1 SET 1ST OPERAND FLAG A 13640200 BAL RW,ICWREG1 GET 1ST REGISTER A 13640400 CROSSET 2 SET SECOND OPERAND A 13640600 BAL RZ,ICREG GET 2ND REG 13642000 EX RC,ICOIR HAVE 2ND REG PLACED ALSO 13644000 CLI 0(RA),C',' IS DELIM WHAT IT SHOULD BE 13646000 BNE ICNINVDM NO-ERROR 13648000 CROSSET 3 SET 3RD OPERAND A 13648500 BXH RA,RY,ICRSH1 BUMP PAST , AND GO GET D2-B2 13650000 SPACE 2 13652000 * * * * * ICRSH - RS SHIFT INSTRUCTIONS - LEVEL - 0 * 13654000 ICRSH EQU * A 13656000 CROSSET 1 SET FLAG A 13656200 BAL RW,ICWREG1 GET 1ST REGISTER A 13656400 CROSSET 2 SET SECOND OPERAND A 13656600 ICRSH1 BAL RW,ICXBD GET BASE-DISP (COMMON RS CODE) 13658000 B ICBLANK GO TEST FR BLANK AND QUIT 13660000 EJECT 13662000 * * * * * ICSI - NORMAL SI INSTRUCTIONS - OP D1(B1),I2 - LEVEL - 0 * 13664000 ICSI EQU * A 13664050 CROSSET 1 1ST OPERAND A 13664200 BAL RW,ICXBD GET B(D) FIELD A 13666000 CLI 0(RA),C',' CHECK FOR COMMA 13668000 BNE ICNINVDM BRANCH IF NOT-ILLEGAL 13670000 AR RA,RY BUMP SCAN POINTER PAST , 13672000 SPACE 1 13674000 ICSI1 LR R1,RA SAVE SCAN PTR, IN CASE NOT JUST SDT 13675000 BAL RX,ICSDTRM GO GET SDT IF IT IS ONE 13676000 BM ICSI2 NO IT WAN'T-GIVE UP AND USE EXPRESSI 13678000 CLI 0(RA),C' ' WAS THIS ALL (WE HOPE SO) 13680000 BE ICSI3 YES,WE GOT BY WITH SIMPLE CASE 13682000 LR RA,R1 NOT SD TERM BY SELF-RESTORE SCP 13684000 SPACE 1 13686000 ICSI2 BAL RX,ICEXP GO GET EXPRESSION 13688000 BP ICNEABS EXPRESSION HAD TO BE ABSOLUTE-ERROR 13690000 ICSI3 CL RC,AWFXFF WAS EXPRESSION SMALL ENOUGH 13692000 BH ICNEXGTA NO-TOO BIG 13694000 STC RC,ICYR1R2 SAVE I2 FIELD 13696000 B ICBLANK GO CHECK FOR BLANK AND FINISH UP 13698000 SPACE 1 13700000 ICSS EQU * A 13700050 * * * * * ICSS - SS INSTRUCTIONS WITH 1 LENGTH - LEVEL - 0 * 13702000 CROSSET 1 1ST OPERAND FLAG SET A 13702500 BAL RW,ICXBD GET 1ST BASE DISPLACEMENT A 13704000 BAL RX,ICULEN PICK UP LENGTH IN R2 13706000 STC R2,ICYR1R2 SAVE INTO INSTRUCTION 13708000 CLI 0(RA),C',' IS DELIMITER OK 13710000 BNE ICNINVDM NO,ERROR 13712000 AR RA,RY BUMP SCAN POINTER PAST , 13714000 SPACE 1 13716000 OI ICYFLAG,ICB1D1+ICBSOPN2+ICBSEA2 SET FOR 2ND OP 13718000 CROSSET 2 2ND OPERAND A 13718500 BAL RW,ICXBD GO PROCESS 2ND OPERAND 13720000 B ICBLANK GO CHECK FOR BLANK AND QUIT 13722000 SPACE 1 13724000 * * * * * ICSS2 - SS INSTRUCTIONS WITH 2 LENGTHS - LEVEL - 0 * 13726000 ICSS2 EQU * A 13728000 CROSSET 1 SET 1ST OPERAND FLAG A 13728500 BAL RW,ICXBD GET 1ST BASE DISPLACEMNT J 13728700 BAL RX,ICULEN GO GET LENGTH 13730000 C R2,AWF15 MAKE SURE LEGAL SIZE 13732000 BH ICNEXGTA TOO BIG-BRANCH 13734000 SLL R2,4 SHIFT OVER FOR L1 POSITION 13736000 STC R2,ICYR1R2 SAVE THE LENGTH 13738000 CLI 0(RA),C',' CHECK DELIMITER 13740000 BNE ICNINVDM ERROR IF NOT 13742000 AR RA,RY BUMP SCAN POINTER 13744000 SPACE 1 13746000 AIF (NOT &$S370A).ICSS2 SKIP IF NOT ASSEMBLING S/370'S 13746100 CLI ICYOP,240 IS THIS A SRP INSTRUCTION? 13746200 BE ICSS2A YES - BRANCH 13746300 SPACE 2 13746400 .ICSS2 ANOP 13746500 OI ICYFLAG,ICBSOPN2+ICBSEA2 RESET FLAGS FOR 2ND OPRND 13748000 MVI ICYF2,0 REZERO RETURN CODES FLAG 13750000 CROSSET 2 SET FLAGS A 13751000 BAL RW,ICXBD GET 2ND LENGTH-BASE-DISP 13752000 BAL RX,ICULEN GO PICK UP LENGTH IN R2 13754000 C R2,AWF15 MAKE SURE LEGAL SIZE 13756000 BH ICNEXGTA NO-TOO BIG-ERROR 13758000 EX R2,ICOIR HAVE THE LENGTH OR'D IN 13760000 B ICBLANK GO CHECK FOR BLANK AND QUIT 13762000 AIF (NOT &$S370A).ICSS2A SKIP IF NOT ASSEMBLIN& S/3 0'S 13762100 SPACE 2 13762200 * * * * * ICSS2A - SPECIAL CODE FOR SRP (S/370) INSTRUCTION 13762300 ICSS2A OI ICYFLAG,ICB1D1+ICBSOPN2+ICBSEA2 SET FOR 2ND OPND 13762400 CROSSET 2 SET 2ND OPERAND FLAG A 13762450 BAL RW,ICXBD GO PROCESS 2ND OPERAND 13762500 CLI 0(RA),C',' CHECK DELIMITER 13762600 BNE ICNINVDM ERROR IF NOT 13762700 AR RA,RY BUMP SCAN POINTER 13762800 BAL RZ,ICREG GO GET IMMEDIATE FIELD 13762900 CH RC,AWH10 IS IMMEDIATE TO LARGE? 13763000 BNL ICNEXGTA YES - ERROR 13763100 EX RC,ICOIR HAVE IMMEDIATE OR'ED IN 13763200 B ICBLANK GO CHECK FOR BLANK AND QUIT 13763300 .ICSS2A ANOP 13763400 EJECT 13764000 * * * * * ICRSO - SPM,SVC, AND IO-TYPE SI'S - LEVEL - 0 * 13766000 ICRSO EQU * 13768000 CLI ICYOP,X'0A' IS IT SVC 13772000 BE ICSI1 YES, USE IMMEDIATE FIELD PART OF SI 13774000 CLI ICYOP,X'01' IS THIS AN XOPC INSTRUCTION M 13775000 BE ICSI1 YES, USE IMMEDIATE FIELD PART OF SIM 13775100 CLI ICYOP,X'04' IS IT SPM 13776000 BE ICRSO1 YES,GO PROCESS 13778000 * FALL THRU ==> ODD SI INSTRS (TS, SIO, TCH, ETC) 13780000 MVI ICYFLAG,$ICBEA1+ICB1D1 CHANGE FLAG FOR SEMI-SI 13782000 AIF (NOT &$P370A).ICRSO IF NO PRIVELEGED S/370'S, BRANCH 13782100 MVO ICYR1R2(2),ICRCMASK MOVE IN MASK DIGIT FOR S/370 13782200 .ICRSO ANOP 13782300 BAL RW,ICXBD GET BASE-DISPLACEMENT 13784000 B ICBLANK GO FOR BLANK AND QUIT 13786000 SPACE 1 13788000 ICRSO1 BAL RZ,ICREG SPM HAS 1 REG,GO GET IT 13790000 SLL RC,4 SHIFT OVER FOR RIGHT POSITION 13792000 STC RC,ICYR1R2 STORE R1 FIELD 13794000 B ICBLANK LOOK FOR BLANK AND QUIT 13796000 SPACE 1 13798000 * * * * * ICSPC - SPECIAL INSTRUCTIONS - XREAD,XPRNT,XPNCH - LEVEL - 0* 13800000 ICSPC EQU * FOR SPECIAL IO INSTRUCTIONS 13802000 AIF (NOT &$XIOS).ICXIO SKIP IF THESE SPECIALS NOT ALLOWED 13804000 MVI ICSPCDUM+1,0 MAKE A NOOP 13806000 CLI ICYR1R2,X'60' WAS IT XDUMP 13808000 BNE ICSPCO SKIP IF NOT XDUMP IN 1ST PLACE 13810000 MVI ICSPCDUM+1,X'F0' SHOW XDUMP WITH ARGUMENTS 13811000 CLI 0(RA),C' ' ARE THERE ANY OPERANDS 13812000 BNE ICSPCO YES, ALREADY SET RIGHT, CONTINUE 13814000 MVI ICYOP,X'E1' CHANGE OPCODE E0 TO E1-REGS XDUMP 13816000 B ICOUTPT GO OUTPUT CODE 13817000 SPACE 1 13818000 ICSPCO BAL RW,ICXBD GET ADDRESS OPERAND 13820000 TM ICYF2,ICYXLFN WAS INDEX REG USED 13822000 BZ *+10 NO,SKIP IT 13824000 OC ICYR1R2,ICYXL PUT LENGTH IN 13826000 CLI 0(RA),C' ' WAS THIS ALL 13828000 BNE ICSPC1 SKIP IF LENGTH FOLLOWS 13830000 IC R2,ICYR1R2 GET MASK VALUE 13832000 SRL R2,5 SHIFT OVER FOR BYTE INDEXING 13834000 IC R2,ICSPCDLT(R2) GET DEFAULT LENGTH VALUE 13836000 STH R2,ICYOPN2 SAVE THE VALUE IN D(B) FIELD 13838000 B ICOUTPT GO HAVE PRINTED AND RETURN 13840000 SPACE 1 13842000 ICSPC1 CLI 0(RA),C',' MAKE SURE DELIM WHAT IT'S SUPPOSED T 13844000 BNE ICNINVDM ERROR - BRANCH 13846000 AR RA,RY BUMP SCAN POINTER 13848000 CLI 0(RA),C'(' IS THIS REGISTER FORM 13850000 BNE ICSPC2 NO,MUST BE SPECIFIED LENGTH 13852000 ICSPCDUM BC $CHN,ICNINVDM XDUMP WITH ARGS DOESN'T ALLOW (R) FM 13854000 AR RA,RY BUMP SCAN POINTER PAST ( 13856000 BAL RZ,ICREG GET REGISTER VALUE 13858000 SLL RC,4 SHIFT FOR POSITION 13860000 STC RC,ICYOPN2 SAVE INTO B POSTION 13862000 CLI 0(RA),C')' IS DELIMITER RIGHT 13864000 BNE ICNINVDM NO-ERROR-BRANCH 13866000 BXH RA,RY,ICBLANK BUMP SCP AND GO CHK BLANK P 13868000 SPACE 1 13870000 ICSPC2 BAL RX,ICEXP GO GET EXPRESSION 13872000 BNZ ICNEABS SHOULD BE ABSOLUTE-ERR IF NOT 13874000 STH RC,ICYOPN2 SAVE THE VALUE 13876000 B ICBLANK GO CHK BLANK AND FINISH UP 13878000 ICSPCDLT DC AL1(80,133,80,4,1) DFLT L'S-READ,PRNT,PUNCH,DUMP,LIMD 13880000 .ICXIO ANOP 13882000 EJECT 13884000 * * * * * ICWREG1 - PROCESS 1ST REGISTER OR MASK - LEVEL - 1 * 13886000 * ENTRY CONDITIONS * 13888000 * RA = SCAN POINTER TO 1ST CHAR OF 1ST REGISTER * 13890000 * RW = RETURN ADDRESS OF CALLING SECTION * 13892000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13894000 SPACE 1 13896000 ICWREG1 BAL RZ,ICREG GET 1ST REG CONVERTED 13898000 SLL RC,4 SHIFT OVER 13900000 STC RC,ICYR1R2 STORE INTO AREA 13902000 TM ICRCMASK,IAA MUST THE REGISTER BE EVEN 13904000 BZ ICWR1 NO,GO FINISH UP 13906000 TM ICYR1R2,X'10' MAKE SURE REG IS EVEN 13908000 BZ ICWR1 REG IS OK,SKIP 13910000 LA RZ,ICWR1 SET UP RETURN @ TO CONTINUE 13912000 SPACE 1 13914000 * ICWODDR MAY BE CALLED TO FLAG ODD FLT-PT REG - LEVEL-2 * 13916000 ICWODDR SR RA,RY DECREMENT SCAN PTR BY 1 TO REG 13918000 LA RB,$ERODDRG REGISTER IS ODD-FLAG IT 13920000 $CALL ERRTAG FLAG ERROR 13922000 BXH RA,RY,0(RZ) PUT SCAN PTR FORWARD 1, RETURN TO CL 13924000 SPACE 1 13926000 ICWR1 CLI 0(RA),C',' IS REG FOLLOWED BY , 13928000 BNE ICNINVDM NO-ERROR 13930000 BXH RA,RY,0(RW) BUMP PAST , AND RETURN 13932000 EJECT 13934000 * * * * * ICXBD - PROCESS 1 OPERAND - D(B) OR D(X-L,B) - LEVEL - 1 * 13936000 * ENTRY CONDITIONS * 13938000 * RW = RETURN ADDRESS OF CALLING SECTION * 13940000 * EXIT CONDITIONS * 13942000 * ICYEA1 OR ICYEA2 WILL BE FILLED IN. ICYOPN1 OR ICYOPN2 WIIL * 13944000 * BE FILLED IN AND A LENGTH OR INDEX REGISTER WILL BE STORED * 13946000 * INTO ICYFL, IF PRESENT. * 13948000 * **NOTE** MOST OF THE CODE IN THIS SECTION IS DESIGNED TO * 13950000 * MAKE NORMAL CASE PROCESSING AS FAST AS POSSIBLE. THE PROGRAM * 13952000 * ATTEMPTS TO FIND ONE OF SEVERAL TYPICAL OPERAND FORMATS, AND IF * 13954000 * SUCCESSFULL, PROCESSES THEM QUICKLY. IF NOT, IT GIVES UP AND * 13956000 * USES THE EXPRESSION EVALUATOR EVALUT INSTEAD. THE ROUTINE WILL * 13958000 * CONVERT ANY OF THE FOLLOWING SORTS OF OPERANDS WITHOUT CALLING * 13960000 * THE EVALUT ROUTINE : * 13962000 * 1. FOR OPERANDS OF FORM S OR D(B) - IF D IS A DECIMAL # OR * 13964000 * SELF-DEFINING TERM BY ITSELF, AND (B) IS PRESENT OR NOT, OR * 13966000 * IF S IS EITHER A SYMBOL BY ITSELF, OR SYMBOL+# OR SYMBOL-#, WHERE * 13968000 * SYMBOL IS EITHER AN ORDINARY SYMBOL OR LOCATION COUNTER REF * 13970000 * 2. FOR OPERANDS OF FORM S(XL) OR D(XL,B) OR D(XL) OR D(,B) * 13972000 * SYMBOL IS EITHER AN ORDNIARY SYMBOL OR LOCATION COUNTER REFE * 13974000 * IF S OR D ARE AS DESCRIBED BY 1., AND IF XL DESIGNATES A * 13976000 * LENGTH, IT IS GIVEN BY A DECIMAL #. * 13978000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13984000 AIF (&$OPTMS LT 2).ICX2 SKIP IF MEMORY TIGHT 13986000 ICXBD ST RA,ICZ1RA SAVE THE SCAN POINTER IF BACK-UP NEE 13988000 IC R2,0(RA) GET THE FIRST CHARACTER OF OPERAND 13990000 IC R2,AWTDECT(R2) GET INDEX VALUE FROM TABLE 13992000 C R2,AWF12 MAKE SURE NOT ILLEGAL 13994000 BH ICNILLEG ILLEGAL CHAR-BRANCH 13996000 LH R14,ICXJUMP(R2) GET THE OFFSET @ 13998000 ICXBDJ B ICXBDJ(R14) JUMP TO RIGHT BEGINNING SECTION 14000000 * * * * * JUMP OFFSET TABLE FOR 1ST CHARACTER FOR ICXBD ROUTINE * 14002000 ICXJUMP $AL2 ICXBDJ,(ICXDEC,ICNINVDM,ICXSDT,ICXSYM,ICXLOC,ICXLIT,ICXL#14004000 PARN) 14006000 .ICX2 AIF (&$OPTMS GE 2).ICX3 SKIP IF NOT GREAT MEMORY OPT 14006100 ICXBD CLI 0(RA),C'=' CHECK FOR LITERAL (MEMORY OPT CODE) 14006200 BNE ICXDEXP2 NOT LITERAL, GO CALL EXPRESSION EVAL 14006300 .ICX3 ANOP 14006400 EJECT 14008000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14010000 * THE FOLLOWING CODE SECTIONS PROCESS AN OPERAND SPECIFIED AS * 14012000 * A LITERAL, A RELOCATABLE SYMBOL OR EXPRESSION, OR AN EXPLICIT * 14014000 * DISPLACEMENT. EXPLICIT BASES,LENGTHS, OR INDEX REGISTERS ARE * 14016000 * PROCESSED BY ICXABS-ICXRELOC * 14018000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14020000 SPACE 1 14022000 * * * * * ICXLIT - PROCESS A LITERAL OPERAND - 1ST CHAR WAS = * 14024000 ICXLIT TM ICRCMASK,IAL2 IS LITERAL ALLOWED 14026000 BZ ICNLITER NO,GO FLAG IT 14028000 CLI ICRCLENG,RC$LEN2 DOES A LITERAL @ EXIST 14030000 BNE ICNERRF NO,BUT IT WAS ALREADY FLAGGED-QUIT 14032000 L RC,ICRCLITA GET @ LITERAL IN LITERAL TABLE 14034000 $CALL LTGET2 GET THE PROGRAM @ LITERAL(IN RC) 14036000 STC RD,ICYLQT STORE LENGTH-1 ATTRIBUTE 14038000 NI ICYF2,255-ICYXLFN ZERO TO SHOW NO EXPLICIT LENGTH 14040000 BAL RZ,ICGBD HAVE IT CONVERTED TO B-D FORM 14042000 BR RW RETURN TO CALLER OF ICXBD 14044000 AIF (&$OPTMS LT 2).ICX4 SKIP IF MEMORY OPTMIZED 14045000 SPACE 1 14046000 * * * * * ICXSDT - CHECK SELF-DEFING TERM OR L' - 1ST CHAR WAS BCLX * 14048000 ICXSDT CLI 1(RA),C'''' IS ' 2ND CHAR OF OPERAND 14050000 BNE ICXSYM NO,SO GO PROCESS SYMBOL 14052000 BAL RX,ICSDTRM GO GET SELF-DEFINING TERM 14054000 BZ ICXDEC1 IF WAS SDTERM-ENTER DEC ROUTINE 14056000 B ICXDEXP2 IF NOT,MUST HAVE BEEN L'-GO EVAL EXP 14058000 SPACE 1 14060000 * * * * * ICXLOC - PROCESS LOCATION COUNTER REFERENCE - 1ST CHAR WAS ** 14062000 ICXLOC $GLOC RC GET CURRENT LOCATION COUNTER VALUE 14064000 SR RB,RB CLEAR FOR INSERTION 14066000 IC RB,AVCESDID GET CURRENT ESDID 14068000 IC RE,ICRCLQ GET LENGTH ATTRIBUTE,IF NEEDED 14072000 BXH RA,RY,ICXSYM1 BUMP SCAN POINTER AND CONTINUE 14074000 EJECT 14076000 * * * * * ICXSYM - PROCESS SYMBOL REFERENCE - 1ST CHARACTER WAS ALPH * 14078000 ICXSYM BAL RX,ICSYM GO GET SYMBOL VALUE,ETNRY 14080000 USING SYMSECT,RA NOTE USING, RC=VALUE,RB=ESDID 14082000 IC RE,SYLENG GET LENGTH ATTRIBUTE 14086000 DROP RA NO LONGER USING 14088000 LR RA,R1 RESTORE SCAN POINTER 14090000 SPACE 1 14092000 * COMMON CODE - SYMBOL AND LOCATION COUNTER REFERENCE. 14094000 ICXSYM1 STC RE,ICYLQT SAVE LENGTH ATTRIBUTE IN CASE NEEDED 14096000 IC R2,0(RA) GET NEXT CHARACTER 14098000 IC R2,AWTDECT(R2) GET INDEX VALUE OF CHARACTER 14100000 C R2,AWF12 COMPARE TO VALUE FOR ( 14102000 BNL ICXSTEST SKIP IF ( COMMA OR BLANK-DONE 14104000 SPACE 1 14106000 MVI ICXSUBAD,X'1A' MAKE INSTRUCTION AN AR 14108000 CLI 0(RA),C'+' IS IT PLUS LIKE WE HOPE 14110000 BE ICXSINC YES,GO HAVE# CONVERTED 14112000 CLI 0(RA),C'-' IS IT - 14114000 BE ICXSUB YES,GO SET INSTRUCTION 14116000 LTR RB,RB WAS THE SYMBOL ABSOLUTE 14118000 BZ ICXDEXP1 YES,SO GO EVALUATE WHOLE EXPRESSION 14120000 B ICNRELC NO,RELOCATABLE TERM IN * OR / 14122000 SPACE 1 14124000 ICXSUB MVI ICXSUBAD,X'1B' MAKE INSTRUCTION SUBTRACT TEMPORARIL 14126000 ICXSINC AR RA,RY BUMP THE SCAN POINTER 14128000 CLI 0(RA),C'0' ARE WE LOOKING AT DECIMAL # 14130000 BL ICXDEXP1 IF NOT,GIVE UP AND USE EXPRESION EVA 14132000 STM RB,RC,ICZ1A SAVE THES REGS 14134000 BAL RX,ICDNUM GET # CONVERTED 14136000 IC R2,0(RA) GET NEXT CHAR 14138000 IC R2,AWTDECT(R2) GET INDEX VALUE 14140000 C R2,AWF12 IS IT ( COMMA OR BLANK 14142000 BL ICXDEXP1 NO,SO MUST BE MORE COMPLEX EXPR-JUMP 14144000 SPACE 1 14146000 LR RD,RC SAVE VALUE OF DECIMAL # 14148000 LM RB,RC,ICZ1A GET SYMBOL VALUE-ESDID BACK 14150000 ICXSUBAD AR $CHN+RC,RD ADD OR SUBTRACT VALUE(OPCODE CHNG) 14152000 ICXSTEST LTR RB,RB WAS SYMBOL ABSOLUTE OR RELOCATABLE 14154000 BZ ICXABS SKIP IF ABSOLUTE(UNLIKELY) 14156000 .ICX4 ANOP 14157000 SPACE 2 14158000 * * * * * ICXRELOC - RELOCATABLE OPERAND- CONVERT TO D(B) FORM * 14160000 * ON ENTRY TO ICXRELOC, RC = ADDRESS, RB = ESDID OF ADDRESS * 14162000 ICXRELOC BAL RZ,ICGBD GET BASE-DISPLACEMENT FORM 14164000 TM ICYFLAG,ICB1D1 WAS THERE ONLY BASE-DISPLACEMENT 14166000 BCR O,RW YES RETURN TO CALLER 14168000 CLI 0(RA),C'(' WAS INDEX OR LENGTH SPECIFIED 14170000 BCR NE,RW NO,SO JUST RETURN TO CALLER 14172000 AR RA,RY BUMP SCAN POINTER PAST ( 14174000 BAL RZ,ICX2L12 GO GET INDEX OR LENGTH AS NEEDED 14176000 STC RC,ICYXL SAVE THIS VALUE FOR LATER 14178000 CLI 0(RA),C')' IS ) THERE LIKE IT SHOULD BE 14180000 BNE ICNINVDM NO-ERROR 14182000 BXH RA,RY,0(RW) BUMP SCAN POINTER AND RETURN 14184000 EJECT 14186000 AIF (&$OPTMS LT 2).ICX6 SKIP IF MEMORY OPT 14187500 * * * * * ICXDEC - PROCESS DECIMAL DISPLACEMENT - 1ST CHAR WAS DEC # * 14188000 ICXDEC BAL RX,ICDNUM GO GET DECIMAL # 14190000 ICXDEC1 CLI 0(RA),C'(' IS NEXT ( 14192000 BE ICXABSA YES,BASE-X-L FOLLOW 14194000 CLI 0(RA),C' ' IS BLANK NEXT 14196000 BE ICXABSB YES,GO INTO ABS SECTION 14198000 CLI 0(RA),C',' IS THIS FIRST OPERAND OF SEVERAL 14200000 BE ICXABSB YES,GO FINISH OFF 14202000 SPACE 1 14204000 * FALLS THRU==> NOT SIMPL,HOPED-FOR DECIMAL #-USE EXPRESSION EV* 14206000 ICXDEXP1 L RA,ICZ1RA GET THE ORIGINAL SCAN POINTER BACK 14208000 ICXLPARN EQU * 1ST CHAR WAS ( ==> PROCESS EXPRESSN 14210000 .ICX6 ANOP 14210500 ICXDEXP2 BAL RX,ICEXP GO GET EXPRESSION EVALUATED 14212000 STC RE,ICYLQT SAVE THIS AS LENGTH ATTRIBUTE 14214000 BNZ ICXRELOC CC SET BY ESDID TEST-GO TO RELOC IF 14216000 SPACE 2 14218000 * * * * * ICXABS - OPERAND DISPLACEMENT EXPLICIT - GET X,L,B,ETC * 14220000 * ON ENTRY TO ICXABS,ICXABSA,ICXABSB, RC = DISPLACEMENT VALUE * 14222000 ICXABS CLI 0(RA),C'(' WAS DISPLACEMENT ALONE(PROB SHIFT) 14224000 BNE ICXABSB YES,GO FINISH UP 14226000 ICXABSA CL RC,AWFXFFF IS DISPLACEMENT > 4095 14228000 BH ICNEXGTA DISPLACEMENT TOO LARGE 14230000 ST RC,ICZ1A SAVE THE DISPLACEMENT VALUE 14232000 AR RA,RY BUMP SCAN POINTER PAST ( 14234000 TM ICYFLAG,ICB1D1 IS THER LENGTH OR INDEX 14236000 BO ICXABSN NO-BASE-DISPLACEMENT ONLY 14238000 SPACE 1 14240000 CLI 0(RA),C',' IS L OR X FIELD OMITTED 14242000 BNE *+8 SKIP IF NOT OMITTED 14244000 BXH RA,RY,ICXABSN BUMP PAST , AND JUMP-OMITTED X OR L 14246000 BAL RZ,ICX2L12 GET LENGTH OR INDEX 14248000 STC RC,ICYXL SAVE LENGTH OR INDEX 14250000 SPACE 1 14252000 SR RC,RC CLEAR FOR OMITTED BASE,INCASE IT IS 14254000 CLI 0(RA),C',' IS BASE SPECIFIED 14256000 BNE ICXABSP NO,MUST BE OMITTED 14258000 AR RA,RY BUMP SCAN POINTER BY 1 14260000 ICXABSN BAL RZ,ICREG GET BASE REGISTER 14262000 ICXABSP CLI 0(RA),C')' IS THE DELIMITER AN ENDING ) 14264000 BNE ICNINVDM NO-EEROR 14266000 LR RD,RC MOVE VALUE OF REGISTER OVER 14268000 SLL RD,12 SHIFT INTO RIGHT POSITOON 14270000 L RC,ICZ1A GET DISPLACEMENT BACK 14272000 AR RD,RC PUT BAS AND DISPLACEMENT TOGETHER 14274000 BXH RA,RY,ICXABSB2 BUMP SCAN PTR PAST ) AND BRANCH 14276000 EJECT 14278000 * ICXABSB ENTERED IF DISPLACEMENT ALONE,NO X,L,B * 14280000 ICXABSB CL RC,AWFXFFF IS DISPLACEMENT > 4095 14282000 BH ICNEXGTA NO-ERROR -DISPLACEMNT >4095 14284000 LR RD,RC DUPLICATE VALUE OF ADDRESS AS B-D 14286000 SPACE 1 14288000 * ICXABSB2 ENTERED AS COMMON EXIT FROM ICXABS. * 14290000 ICXABSB2 BAL RX,ICPEA HAVE ADDRESS CHECKED AND STORED 14292000 BAL RZ,ICQOPN HAVE BASE-DISPLACEMENT STORED 14294000 BR RW RETURN TO CALLER 14296000 EJECT 14298000 * * * * * ICGBD - GET AND STORE BASE-DISP OF @ - LEVEL - 2 * * * * * * 14300000 * RB = ESDID OF THE @ * 14302000 * RC = @ FOR WHICH BASE-DISPLACEMENT IS TO BE FOUND * 14304000 * RZ = RETURN ADDRESS OF CALLING ROUTINE * 14306000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14308000 SPACE 1 14310000 ICGBD BAL RX,ICPEA HAVE ACTUAL ADDRESS CHECKED AND SAVE 14312000 LR R1,RA SAVE THE SCAN POINTER 14314000 LR RA,RC MOVE @ OVER FOR BRDISP CALL 14316000 $CALL BRDISP GO HAVE BASE-DISPLACEMENT FOUND 14318000 LR RD,RA MOVE VALUE OVER TO FALL INTO ICQOPN 14320000 LR RA,R1 RESTORE THE SCAN POINTER 14322000 LTR RB,RB WAS BASE-DISP OK 14324000 BNZ ICNADDR NO,ADDRESSIBILITY ERROR 14326000 SPACE 2 14328000 * * * * * ICQOPN - STORE BASE-DISPLACEMENT INTO OPN1-OPN2 - LEVEL - 2 * 14330000 * ENTRY CONDITIONS * 14332000 * RD = VALUE TO BE STORED INTO ICYOPN1-OPN2 FIELD 14334000 * RZ = RETURN ADDRESS OF CALLING ROUTINE * 14336000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14338000 SPACE 1 14340000 ICQOPN TM ICYFLAG,ICBSOPN2 SHOULD IT GO INTO OPN2 14342000 BO *+10 YES,SKIP OVER IF OPN2 14344000 STH RD,ICYOPN1 STORE INTO 1ST OPERAND D(B) FIELD 14346000 BR RZ RETURN TO CALLER 14348000 STH RD,ICYOPN2 STORE INTO 2ND FIELD (SS INSTS ONLY) 14350000 BR RZ RETURN TO CALLER 14352000 EJECT 14354000 * * * * * ICREG - SCAN AND CONVERT A REGISTER VALUE. - LEVEL - 2. * 14356000 * AS OF VERSION 3.0/A, ANY ABSOLUTE EXPRESSION <= 15 IS J* 14358000 * ALLOWED FOR REGISTER. CODE IS ORIENTED TOWARDS NORMAL CASE.J* 14360000 * ENTRY CONDTIONS * 14362000 * RA = @ FIRST CHARACTER OF REGISTER. * 14364000 * RZ = RETURN ADDRESS. * 14366000 * EXIT CONDITIONS * 14368000 * RA = SCAN POINTER TO CHARACTER FOLLOWING REGISTER * 14370000 * RC = VALUE OF REGISTER,RIGHT JUSTIFIED. 0 <= RC <= 15 * 14372000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14374000 SPACE 1 14376000 ICREG LR R0,RA SAVE @ OF 1ST CHAR OF EXPRESSION J 14377500 BAL RX,ICSDTRM NOW GO TRY FOR SELF-DEFINING TERM J 14378000 BZ ICREGSYC IF OK, BRANCH TO CHECK DELIM AFTER J 14380000 * NOT SELF-DEF TERM, TRY EXPRESSION OR SYMBOL. J 14382000 CLI 0(RA),C'(' MAKE SURE NOT EXPRESSION IN PARENS J 14384000 BE ICREGSYE WAS EXPRESS IN PARENS-BRANCH OUT J 14386000 BAL RX,ICSYM SYMBOL, GO TO EVALUATE IT J 14420000 LR RA,R1 MOVE SCAN POINTER BACK RIGHT 14421000 BNZ ICNEABS BRANCH ==> RELOCATABLE REGISTER-ERR 14422000 * MAKE SURE ACTUALLY IS END OF REGISTER FIELD J 14422100 ICREGSYC CLI 0(RA),C',' MOST COMMON ENDING DELIMITER J 14422200 BE ICREGSYO YES, WAS COMMA, DONE, BRANCH OUT J 14422300 CLI 0(RA),C' ' NEXT COMMON DELIMITER J 14422400 BE ICREGSYO YES, IT WAS BLANK, BRANCH OUT J 14422500 CLI 0(RA),C')' LAST CAHNCE, RIGHT PAREN J 14422600 BE ICREGSYO BRANCH OUT, WAS END OF EXPRESSION J 14422700 * WAS MORE COMPLEX EXPRESSSION, PROCESS IT (R), R+1, ETC.J 14422800 ICREGSYE LR RA,R0 RESTORE ORIGINAL PTR, FROM ICREG. J 14422900 BAL RX,ICEXP CALL GENERAL EXPRESSION EVAL (SLOW)J 14423000 BNZ ICNEABS MUST BE ABSOLUTE EXPRESS-BR IF NOT J 14423100 ICREGSYO C RC,AWF15 WAS IT LEGAL SIZE 14424000 BCR NH,RZ RETURN TO CALLER IF SMALL ENOUGH 14428000 B ICNEXGTA TOO BIG-ERROR-FLAG IT 14430000 EJECT 14432000 * * * * * ICX2L12 - FLAG X-L FOUND, MAKE CHOICE OF ROUTINE - LEVEL - 2* 14434000 * ENTRY CONDITIONS * 14436000 * RA = SCAN POINTER TO 1ST CHAR OF LENGTH OR INDEX * 14438000 * RZ = RETURN ADDRESS OF CALLING ROUTINE * 14440000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14442000 SPACE 1 14444000 ICX2L12 OI ICYF2,ICYXLFN NOTE THAT LENGTH OR INDEX FOUND 14446000 TM ICYFLAG,ICBX2 ARE WE LOOKING FOR AN INDEX REG 14448000 BO ICREG SKIP IF REG,FLL THRU TO LENGTH IF NT 14450000 SPACE 2 14452000 * * * * * ICLENG - SCAN AND CONVERT A LENGTH. LEVEL - 2 * 14454000 * ENTRY CONDITIONS * 14456000 * RA = SCAN POINTER TO 1ST CHARACTER OF LENGTH. * 14458000 * RZ = RETURN ADDRESS TO CALLING ROUTINE * 14460000 * EXIT CONDITIONS * 14462000 * RA = SCAN POINTER TO DELIMITER FOLLOWING LENGTH, EITHER , OR ) * 14464000 * RC = LENGTH FOR ASSEMBLY(I.E. L-1,EXCEPT L=0). 0 <= RC <= 255 * 14466000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14468000 SPACE 1 14470000 AIF (&$OPTMS LT 2).ICX10 SKIP IF MEMORY OPT 14471500 ICLENG CLI 0(RA),C'0' DO WE HAVE DECIMAL # (WE HOPE SO!) 14472000 BL ICLEXP NO WE DON'T - USE EXPRESSION EVAL 14474000 ST RA,ICZ2A SAVE THE SCAN POINTER 14476000 BAL RX,ICDNUM GO GET DECIMAL # 14478000 CLI 0(RA),C',' IS IT FOLLOWED BY COMMA 14480000 BE ICLSIZE YES- LENGTH WAS JUST DECIMAL # 14482000 CLI 0(RA),C')' IS DELIM ) 14484000 BE ICLSIZE YES,GO CHECK FOR SIZE 14486000 SPACE 1 14488000 L RA,ICZ2A GET SCAN POINTER BACK-MORE THAN # 14490000 .ICX10 AIF (&$OPTMS GE 2).ICX11 SKIP IF NOT EMMORY OPT 14490100 ICLENG EQU * 14490200 .ICX11 ANOP 14490300 ICLEXP BAL RX,ICEXP GO GET EXPRESSION EVALUATED 14492000 BNZ ICNEABS BRANCH==> RELOCATABLE EXP-ERR 14494000 ICLSIZE SR RC,RY DECREMENT LENGTH TO LENGTH-1 14496000 BNM *+6 SKIP IF ORIG LENGTH ^= 0 14498000 SR RC,RC MAKE LENGTH ZERO 14500000 C RC,AWFXFF IS THE VALUE <= 255 14502000 BCR NH,RZ RETURN IF VALUE OK 14504000 B ICNEXGTA LENGTH > 255-DEFINITELY BAD 14506000 EJECT 14508000 * * * * * ICPEA - CHECK @ ALIGNMENT, SET UP EA1 OR EA2 - LEVEL - 3 * 14510000 * **NOTE** REGS RA-RD ARE SAFE ACROSS CALL TO ICPEA * 14512000 * ENTRY CONDITIONS * 14514000 * RC = ADDRESS VALUE TO BE STORED INTO ICYEA1 OR ICYEA2 * 14516000 * RX = RETURN ADDRESS TO CALLING SECTION * 14518000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14520000 SPACE 1 14522000 ICPEA ST RC,ICYEA2 STORE VALUE IN 2ND SLOT ALWAYS 14524000 TM ICYFLAG,ICBSEA2 DID VALUE ACTUALLY BELONG IN 2ND POS 14526000 BO *+8 BRANCH IF WAS 2ND OPERAND 14528000 ST RC,ICYEA1 STORE VALUE IN FIRST SLOT 14530000 IC R14,ICRCMASK GET MAK FOR ALIGNMENT 14532000 N R14,AWF7 REMOVE ALL BUT LAST 3 BITS 14534000 NR R14,RC TEST FOR RIGHT ALIGNMENT 14536000 BCR Z,RX IF ZERO==> ALIGNMENT OK 14538000 SPACE 1 14540000 * FALLS THRU ==> ALIGNMENT ERROR MESSAGE * 14542000 STM RB,RD,ICZ3A SAVE THE VALUES OF REGS 14544000 LA RB,$ERALIGN NOTE ALIGNMENT ERROR 14546000 SR RA,RY MOVE SCAN PTR BACK 1 14548000 $CALL ERRTAG HAVE IT FLAGGED 14550000 AR RA,RY PUT SCAN PTR BACK WHERE BELONGS 14552000 LM RB,RD,ICZ3A RESTORE REGS 14554000 BR RX RETURN TO CALLER 14556000 SPACE 2 14558000 * * * * * ICDNUM - SCAN AND CONVERT DECIMAL #. LEVEL - 3 * 14560000 * ENTRY CONDITIONS * 14562000 * RA = SCAN POINTER TO 1ST DIGIT OF DECIMAL # * 14564000 * RX = RETURN ADDRESS OF CALLING SECTION * 14566000 * EXIT CONDITIONS * 14568000 * RA = @ DELIMITER BEYOND # * 14570000 * RC = VALUE OF #, RIGHT JUSTIFIED. * 14572000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14574000 SPACE 1 14576000 ICDNUM EQU * 14578000 $CALL SDDTRM CALL DECIMAL CONVERTER 14580000 LTR RB,RB WAS THERE ERROR 14582000 BCR Z,RX NO ERRORS,RETURN 14584000 B ICNERROR ERROR-GO HAVE IT FLAGGED 14586000 EJECT 14588000 * * * * * ICEXP - SCAN AND EVALUATE EXPRESSION - LEVEL - 3 * 14590000 * ENTRY CONDITIONS * 14592000 * RA = SCAN POINTER TO 1ST CHARACTER OF EXPRESSION * 14594000 * RX = RETURN ADDRESS OF CALLING SECTION * 14596000 * EXIT CONDITIONS * 14598000 * RA = SCAN POINTER TO DELIMITER FOLLOWING EXPRESSION * 14600000 * RB = ESDID OF EXPRESSION, =0 FOR ABSOLUTE EXPRESSION * 14602000 * RC = VALUE OF EXPRESSION * 14604000 * RE = LENGTH ATTRIBUTE - 1 OF EXPRESSION * 14606000 * CC = SET BY TESTING ESDID * 14608000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14610000 SPACE 1 14612000 ICEXP $CALL EVALUT EVALUATE EXPRESSION 14614000 LTR RB,RB WAS IT LEGAL 14616000 BNZ ICNERROR NO-GO FLAG AND QUIT 14618000 LTR RB,RD MOVE ESDID OVER AND SET CC 14620000 BR RX RETURN TO CALLER 14622000 SPACE 2 14624000 * * * * * ICSDTRM - GET SELF-DEFINING TERM VALUE - LEVEL - 3 * 14626000 * ENTRY CONDITIONS * 14628000 * RA = SCAN POINTER TO 1ST CHARACTER * 14630000 * RX = RETURN ADDRESS OF CALLING SECTION * 14632000 * EXIT CONDITIONS * 14634000 * RA = UNCHANGED IF NOT SD TERM, SCAN PTR TO DELIMITER IF WAS SDTERM* 14636000 * RC = VALUE OF SELF-DEFING TERM, IF IT WAS ONE * 14638000 * CC SET BY TESTING RB ON RETURN (<0 ==> NOT SD TERM) * 14640000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14642000 SPACE 1 14644000 ICSDTRM EQU * DON'T NEED TO SET RB ANYMORE 14646000 $CALL SDBCDX CALL GENERAL SD TERM PROCESSOR 14648000 LTR RB,RB TEST CONDITON 14650000 BCR NP,RX RETURN IF EITHER GOOD, OR NOT SD TER 14652000 B ICNERROR IT WAS SD TERM, BUT ILLEGAL ONE 14654000 EJECT 14656000 * * * * * ICSYM - SCAN AND LOOK UP SYMBOL,RETURN VALUES. LEVEL - 3 * 14658000 * ENTRY CONDITIONS * 14660000 * RA = SCAN POINTER TO 1ST CHARACTER OF SYMBOL * 14662000 * RX = RETURN ADDRESS OF CALLING SECTION * 14664000 * EXIT CONDTIONS * 14666000 * R1 = SCAN POINTER TO DELIMITER FOLLOWING SYMBOL * 14668000 * RA = @ SYMSECT ENTRY FOR THE SYMBOL * 14670000 * RB = ESDID OF THE SYMBOL * 14672000 * RC = VALUE OF THE SYMBOL * 14674000 * CC = SET BY TESTING THE ESDID OF THE SYMBOL * 14676000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14678000 SPACE 1 14680000 ICSYM TRT 0(9,RA),AWTSYMT SCAN FOR END OF SYMBOL 14682000 BZ ICNBADSY BAS SYMBOL - TOO LONG 14684000 LR RB,R1 MOVE ENDING POINTER OVER 14686000 SR RB,RA GET LENGTH OF SYMBOL 14688000 BZ ICNBADSY SYMBOL OF 0 LENGTH -ERROR 14690000 $CALL SYFIND HAVE IT LOOKED UP IN TABLE 14692000 LTR RB,RB WAS IT ALREADY THERE 14694000 BNZ ICNUNDEF UNDEFINED-NOT IN TABLE 14696000 SPACE 1 14698000 USING SYMSECT,RA NOTE SYMBOL TABLE USING 14700000 TM SYFLAGS,$SYDEF IS SYMBOL DEFINED 14702000 BZ ICNUNDEF NOT FLAGGED DEFINED - ERROR 14704000 IC RB,SYESDID GET ESDID OF THE SYMBOL 14706000 L RC,SYVALUE GET VALUE OF THE SYMBOL 14708000 LTR RB,RB SRT CC HERE 14710000 BR RX RETURN TO CALLER 14712000 DROP RA KILL USING FOR SYMSECT 14713000 SPACE 2 14714000 * * * * * ICULEN - GET SPECIFIED LENGTH, OR IMPLIED LENGTH - LEVEL - 3* 14716000 * ENTRY CONDITIONS * 14718000 * RX = RETURN ADDRESS OF CALLING SECTION * 14720000 * EXIT CONDITIONS * 14722000 * R2 = LENGTH-1,SUITABLE FOR USE IN SS INSTRUCTION * 14724000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14726000 SPACE 1 14728000 ICULEN IC R2,ICYXL GET LENGTH (IF SPECIFIED) 14730000 TM ICYF2,ICYXLFN WAS A LENGTH EXPLICITYLY SPECIFIED 14732000 BCR O,RX YES,RETUNR NOW 14734000 IC R2,ICYLQT NO, IMPLIED LENGTH, GET THE LENGTH-1 14736000 BR RX RETUNR TO CALLER 14738000 SPACE 1 14740000 ICOIR OI ICYR1R2,$CHN REG OR LENGTH SUPPLIED BY EXECUTE 14742000 EJECT 14744000 * * * * * INTERNAL CONSTANTS * 14746000 * * * * * TABLE OF ICYFLAG VALUES FOR VARIOUS INSTRUCTION TYPES. * 14748000 * A MACRO IS USED TO KEEP INDEPENDENCE ON ACTUAL EQUATE VALUES * 14750000 ICTTAB EQU *-1 OFFSET SYMBOL 14752000 DS ($ICTMX)C DEFINE ENOUGH STORAGE FOR MAX TYPES 14754000 ICT $RRM,0 14756000 ICT $RXM,$ICBEA2+ICBX2+ICBSEA2 14758000 ICT $RR,0 14760000 ICT $RX,$ICBEA2+ICBX2+ICBSEA2 14762000 ICT $RS,$ICBEA2+ICB1D1+ICBSEA2 14764000 ICT $RSH,$ICBEA2+ICB1D1+ICBSEA2 14766000 ICT $SI,$ICBEA1+ICB1D1 14768000 ICT $SS,$ICBEA1+$ICBEA2 WILL BE CHANGED AFTER 1ST OP DONE 14770000 ICT $SS2,$ICBEA1+$ICBEA2 ILL BE CHANGED AFTER 1ST OP DONE 14772000 ICT $RSO,0 FOR SPM,SVC. OTHERS WILL CHANGE 14774000 ICT $SPC,$ICBEA1+ICBX2 14776000 ORG 14778000 SPACE 1 14780000 * * * * * INTERNAL VARIABLES * 14782000 AIF (&$OPTMS LT 2).ICX12 SKIP IF MEMORY OPT 14782500 ICZ1A DS 2F USED BY LEVEL 1 ROUTINES AS SAVE 14784000 ICZ1RA DS F FOR SAVING SCAN POINTER IN ICXBD 14786000 ICZ2A DS F SAVE WORD FOR LEVEL 2 ROUTINES 14788000 .ICX12 AIF (&$OPTMS GE 2).ICX13 SKIP IF MEMORY NO OPT 14788100 ICZ1A DS F LEVEL 1 SAVE WORD (MEMORY OPTMZ) 14788200 .ICX13 ANOP 14788300 ICZ3A DS 3F USED BY LEVEL 3 ROUTINES AS SAVE 14790000 SPACE 1 14792000 * INTERNAL LOCATION FOR RCODBLK VARIABLES * 14794000 ICRCB DS 0F ALIGN ON FULLWORD 14796000 ICRCLENG DS C LENGTH - 1 OF ICRCB 14798000 DS AL3 ICRCLOC 14800000 ICRCTYPE DS C INSTRUCTION TYPE 14802000 ICRCHEX DS C HEX OPCODE 14804000 ICRCMASK DS C MASK AND FLAG BITS 14806000 ICRCLQ DS C LENGTH-1 ATTRIBUTE OF INSTRUCTION 14808000 ICRCLITA DS A @ LITERAL IN LITERAL TABLE,IF EXISTS 14810000 SPACE 1 14812000 * INTERNAL LOCATION FOR OBJECT CODE BLOCK-ICBLOCK * 14814000 ICYBLOCK DS 0F ALIGN ON F 14816000 ICYEA1 DS F INSTRUCTION @ 1 FOR OUTPT2 14818000 ICYEA2 DS F INSTRUCTION @ 2 FOR OUTPT2 14820000 ICYOP DS C OPCODE 14822000 ICYR1R2 DS C REGISTERS,MASK,LENGTHS 14824000 ICYOPN1 DS H 1ST BASE DISPLACEMENT 14826000 ICYOPN2 DS H 2ND BASE-DISPLACEMENT 14828000 ICYFLAG DS C CONTROLS PROCESSING&PRINTING OF OPRD 14830000 * THE ABOVE VARS ARE USED BY OUTPT2 * 14832000 ICYF2 DS C BYTE FOR ICXBD TO RETURN STATUS 14834000 ICYXL DS C INDEX OR LENGTH STORED HERE -ICXBD 14836000 ICYLQT DS C FOR IMPLIED LENGTH - LENGTH-1 HERE 14838000 AIF (NOT &$XREF).NOXRF16 14838025 * 0 1 2 3 4 5 6 7 8 9 A B C D E F A 14838050 ICXRTAB DC X'000000000884840C0C0C080000000C0C' 0 A 14838100 DC X'84848484840C8484840C848484848484' 1 A 14838200 DC X'84848484848484840C84848484848484' 2 A 14838300 DC X'8484848484848484840C848484848484' 3 A 14838400 DC X'488448840C84840C840C848484004884' 4 A 14838500 DC X'48004884840C8484840C848484848484' 5 A 14838600 DC X'4884480000000084840C848484848484' 6 A 14838700 DC X'4800000000000000840C848484848484' 7 A 14838800 DC X'08000800000086868484848484848484' 8 A 14838900 DC X'2C00840C840C8484C200000000000000' 9 A 14839000 DC X'00000000000000000000000000000000' A A 14839100 DC X'00000000000000000000000000882C86' B A 14839200 DC X'06000000000000000000000000000000' C A 14839300 DC X'00848484840C84840000000084848484' D A 14839400 DC X'00000000000000000000000000000000' E A 14839500 DC X'84848484000000008484848484840000' F A 14839600 .NOXRF16 ANOP A 14839700 DROP RAT,R13 KILL USINGS 14840000 TITLE '*** IDASM2 - ASSEMBLER INSTRUCTIONS - PASS 2 ***' 14842000 **--> CSECT: IDASM2 2 ASSEMBLER INSTRUCTIONS - PASS 2 . . . . . . . 14844000 *. THIS MODULE IS 1 OF THE 2 PASS 2,LEVEL 2 ROUTINES IN THE . 14844100 *. ASSIST ASSEMBLER. IT PERFORMS ALL PROCESSING OF ASSEMBLER . 14844200 *. INSTRUCTIONS IN THE SECOND PASS. IT PRODUCES SOME OBJECT . 14844300 *. CODE, AND DOES SETUP FOR PRINTING. MOST OF THE WORK HAS . 14844400 *. ALREADY BEEN DONE IN THE CORREPONDING PASS 1 MODULE, IBASM1. . 14844500 *. ENTRY CONDITIONS . 14846000 *. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 14848000 *. RC = ADDRESS OF RECORD CODE BLOCK(RCODBLK) FOR STATEMENT . 14850000 *. RE = ADDRESS OF RECORD SOURCE BLOCK(RSBLOCK) FOR STATEMENT . 14852000 *. CALLS BRDROP,BRUSIN,CCCON2,CNDTL2,ERRTAG,ESENX2,EVALUT,LTDMP2. 14854000 *. CALLS OUTPT2,UTPUT2 . 14856000 *. USES DSECTS: AVWXTABL,RCODBLK,RSBLOCK,SYMSECT . 14856500 *. USES MACROS: $AL2,$CALL,$GLOC,$RETURN,$SAVE,$SDEF,$STV . 14857000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 14858000 SPACE 1 14859000 IDASM2 CSECT 14860000 $DBG 90,* 14862000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 14864000 USING RCODBLK,RC RC HAS POINTER ON ENTRY 14866000 USING RSBLOCK,RE NOTE ADDRESSIBILITY 14868000 SPACE 1 14870000 * * * * * REGISTER USAGE FOR IDASM2 * * * * * * * * * * * * * * * * * * 14872000 * R2 = BYTE REGISTER (HI-ORDER 3 BYTES = 0). * 14874000 * RW = INTERNAL LINK REGISTER - LEVEL - 1 (IDREGET,IDEVAL) * 14876000 * RY = 1 USEFUL CONSTANT IN ODD REGISTER. * 14880000 * RC = @ RCODBLK FOR STMT (= AVRCBPT). * 14881000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14882000 SPACE 1 14884000 $SAVE RGS=(R14-R6),SA=IDSAVE,BR=R13 14886000 LA RY,1 SET UP HANDY CONSTANT FOR MANY SECTS 14894000 SR R2,R2 CLEAR FOR INSERTIONS 14896000 IC R2,RCTYPE GET TYPE BYTE 14898000 LH R14,IDAJUMP-$IB(R2) GET OFFSET @ TO RIGHT SECTION 14900000 TM RSBFLAG,$REBX DO ERRORS EXIST ALREADY 14900200 DROP RE REMOVE RSBLOCK USING NOW 14900400 IDASMJ BZ IDASMJ(R14) GO IF NO ERRORS 14900600 * ERRORS EXIST - CURRENTLY, PROCESS END CARDS ONLY 14900800 CLI RCTYPE,$IB+$IEND WAS IT AN END CARD 14901000 BNE IDOUT2 ANYTHING ELSE - FORGET IT 14901200 B IDEND PROCESS END WHETHER ERRS OR NOT 14902000 EJECT 14904000 * * * * * INDIVIDUAL ERROR EXITS * 14906000 IDERELOC LA RB,$ERRELOC NEED RELOCATABLE VALUE 14912000 B IDERROR GO HAVE ERROR FLAGGED 14914000 IDERELC LA RB,$ERNEABS ABSOLUTE VALUE REQUIRED 14916000 B IDERROR GO HAVE ERROR FLAGGED 14920000 IDREGBIG LA RB,$EREXGTA REGISTER OR OTHER VALUE TOO LARGE 14922000 B IDERROR GO HAVE ERROR FLAGGED 14924000 IDERIND LA RB,$ERINVDM INVALID DELIMITER 14932000 IDERROR $CALL ERRTAG FLAG IT 14934000 SPACE 1 14936000 * * * * * PRINT STATEMENT AND RETURN TO CALLER. * 14938000 IDOUT2 L RD,AWFM4 PUT NEG # TO SHOW NO CODE PRINTED 14940000 IDOUT2A LA RB,$OUCONS SHOW TYPE OF CALL TO OUTPT2 14942000 IDOUT $CALL OUTPT2 HAVE LINE PRINTED 14944000 IDRET $RETURN RGS=(R14-R6) 14946000 EJECT 14948000 * * * * * CCW * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14950000 IDCCW EQU IDOUT2 **UNTIL CCW CODE WRITTEN * 14952000 SPACE 1 14954000 * * * * * CNOP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14956000 IDCNOP IC R2,RCMASK GET LENGTH 0-2-4-6 14958000 SR R2,RY DECREMENT LENGTH TO LENGTH - 1 14960000 BM IDOUT2 IF L<0,NO OBJECT CODE NEEDED-SKIP 14962000 LR RD,R2 MOVE LEN-1 OVER FOR UTPUT2 14964000 LR RE,RY PLACE A 1 IN REG RE-DUPFAC OF 1 14966000 LA RC,=3X'0700' GET @ 3 NOPRS 14970000 $GLOC RA GET LOCATION COUNTER FOR UTPUT2 14972000 $CALL UTPUT2 CALL OBJECT CODE ROUTINE 14974000 LA RC,=3X'0700' GET @ 3 NOPRS 14976000 LR RD,R2 MOVE LENGTH-1 OVER FOR OUTPT2 14978000 B IDOUT2A GO HAVE CODE PRINTED 14980000 SPACE 1 14982000 * * * * * CSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14984000 IDCSECT NI AVTAGS1,255-$IBDSEC1 MAKE SURE FLAGGED CSECT 14986000 B IDESCH GO CHANGE ESDID 14988000 SPACE 1 14990000 * * * * * DC * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14992000 IDDC SR RB,RB CLEAR FOR INSERT 14994000 IC RB,RCMASK GET THE NUMBER OF OPERANDS IN DC 14996000 LA RC,RCLITEQ GET @ FIRST OR ONLY CNCBLOCK 14998000 $CALL CNDTL2 CALL 2ND PASS CONSTANT PROCESSOR 15000000 B IDRET RETURN(CNDTL2 PRINTED LINE) 15002000 SPACE 1 15004000 AIF (&$DEBUG).IDNOD1 SKIP OVER IF NOT DEBUG MODE 15006000 SPACE 1 15008000 * * * * * DEBUG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15010000 IDDEBUG CLI RCHEX,C'2' WAS THIS FOR PASS 2 15012000 BNE IDOUT2 QUIT IF WASN'T FOR 2 15014000 MVC AVDEBUG,RCMASK MOVE BYTE INTO DEBUG FIELD 15016000 B IDOUT2 GO HAVE PRINTED OUT 15018000 .IDNOD1 ANOP 15020000 SPACE 1 15022000 * * * * * DS * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15024000 IDDS EQU IDOUT2 EVERYTHING DONE IN PASS 1 15026000 SPACE 1 15028000 * * * * * DROP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15030000 IDDROP BAL RW,IDREGET GET THE REGISTER VALUE 15032000 $CALL BRDROP HAVE REG DROPPED 15034000 LR RA,R1 RESTORE SCAN POINTER 15036000 LTR RB,RB WAS THERE AN ERROR 15038000 BZ IDDROK NO ERROR CONTINUE 15040000 SR RA,RY BACK UP SCAN POINTER BY 1 15042000 LA RB,$ERRGNUS REGISTER NOT USED-ONLY ERROR POSSIBL 15044000 $CALL ERRTAG HAVE THE ERROR TAGGED 15046000 AR RA,RY BUMP SCAN POINTER TO NEXT CHAR 15048000 SPACE 1 15050000 IDDROK CLI 0(RA),C' ' WAS THIS LAST REGISTER 15052000 BE IDOUT2 YES-QUIT 15054000 CLI 0(RA),C',' IS DELIMITER OK 15056000 BNE IDERIND INVALID DELIMITER-NO COMMA 15058000 BXH RA,RY,IDDROP BUMP SCAN POINTER AND GO BACK 15060000 EJECT 15062000 * * * * * DSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15064000 IDDSECT OI AVTAGS1,$IBDSEC1 FLAG DSECT NOW 15066000 IDESCH MVC AVCESDID,RCMASK MOVE NEW ESDID OVER 15068000 B IDOUT2 GO HAVE STATEMENT PRINTED 15070000 SPACE 1 15072000 * * * * * ENTRY * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15074000 IDENTRY SR RB,RB SHOW THIS IS ENTRY CALL 15076000 B IDENEXCL GO CALL ESENX2 ROUTINE 15078000 SPACE 1 15080000 * * * * * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15082000 IDEJECT SR RE,RE SHOW THIS IS SPACE OR EJECT 15084000 B IDPRIN2 GO TO CALL PRINTOUT ROUTINE 15086000 SPACE 1 15088000 * * * * * END * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15090000 * SETS AVFENTER=ENTRY @, LEAVES = START VALUE OR 0 IF NO END SY* 15092000 IDEND CLI 0(RA),C' ' WAS THERE A SYMBOL ON THE END CARD 15094000 BE IDLTORG GO HANDLE AS LTORG 15096000 BAL RW,IDEVAL HAVE EXPRESSION EVALUATED 15102000 ST RC,AVFENTER SAVE THIS ENTRY POINT VALUE 15108000 B IDLTORG GO HANDLE AS LTORG NOW 15110000 SPACE 1 15112000 * * * * * EQU * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15114000 * SETS RCLOC = VALUE OF EQU SYMBOL FOR LISTING. * 15116000 IDEQU MVC RCLOC,RCLITEQ+1 MOVE VALUE OF SYMBOL OVER FOR PRINT 15116500 B IDOUT2 GO PRINT STMT 15117000 SPACE 1 15140000 * * * * * EXTRN * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15142000 IDEXTRN LA RB,2 SHOW ESENX2 THIS IS EXTRN 15144000 IDENEXCL $CALL ESENX2 CALL ROUTINE 15146000 B IDOUT2 PRINT STATEMENT AND RETURN 15148000 SPACE 1 15150000 * * * * * LTORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15152000 * END CARD PROCESSING ALSO USES THIS CODE * 15154000 IDLTORG LA RB,$OUCOMM SHOW NO LOCATION COUNTER-END-LTORG 15156000 L RD,AWFM4 SHOW THERE IS NO CODE TO BE PRINTED 15158000 $CALL OUTPT2 15160000 $CALL LTDMP2 HAVE LITERALS DUMPED AND PRINTED 15162000 B IDRET RETURN 15164000 SPACE 1 15166000 * * * * * ORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15168000 IDORG EQU IDOUT2 EVERYTHING ALREADY DONE IN PASS 1 15170000 EJECT 15172000 * * * * * PRINT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15174000 IDPRINT LA RE,2 SHOW THIS IS A PRINT COMMAND 15176000 IDPRIN2 LA RC,RCMASK @ TAG BITS(PRINT) OR # (SPACE,EJECT) 15178000 B IDLIST GO TO CALL ROUTINE 15180000 SPACE 1 15182000 * * * * * SPACE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15184000 IDSPACE EQU IDEJECT HANDLED SAME AS EJECT 15186000 SPACE 1 15188000 * * * * * START * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15190000 IDSTART EQU IDCSECT HANDLE SAME AS CSECT 15192000 SPACE 1 15194000 * * * * * TITLE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15196000 IDTITLE EQU * PROCESS TITLE STATEMENT CPP 15198000 LA RA,1(RA) RA=>1ST BYTE OF TITLE (AFTER ') CPP 15199000 SR RB,RB CLEAR FOR INSERT CPP 15200000 IC RB,RCMASK GET LENGTH-1 OF TITLE CPP 15201000 $CALL CCCON2 EVALUATE OPD. (SAME AS C-TYPE DC) CP 15202000 LA RE,4 SHOW THIS IS A TITLE 15208000 * COMMON CODE - EJECT,PRINT,SPACE,TITLE. 15210000 IDLIST LA RB,$OULIST SHOW LISTING CONTROL 15212000 B IDOUT GO FINALLY TO CALL OUTPT2 15214000 SPACE 1 15216000 * * * * * USING * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15218000 IDUSING BAL RW,IDEVAL CALL EXPRESSION EVALUATORE 15236000 SPACE 1 15244000 * INITIALIZES FOR POSSIBLE MULTIPLE USING, LOOP IF SO. 15246000 IDUSB LR RX,RC MOVE LOCATION COUNTER VALUE OVER 15248000 L RC,AVRCBPT GET RCODBLK POINTER BACK,USING THER 15249000 $STV RX,RCLOC SAVE LOCATION FOR PRINTING 15250000 SPACE 1 15251000 IDUSC CLI 0(RA),C',' MAKE SURE COMMA IS THERE 15252000 BNE IDERIND BRANCH IF NOT-INVALIDDELIM 15254000 AR RA,RY BUMP SCAN POINTER BEYOND , 15256000 BAL RW,IDREGET GO GET 1ST OR AFTER REGISTER VALUE 15258000 LR RB,RX PUT CURRENT USING VALUE IN REG 15260000 LR RC,RZ MOVE THE ESDID OVER FOR THE CALL 15262000 $CALL BRUSIN HAVE USING ENTERED 15264000 SPACE 1 15266000 CLI 0(R1),C' ' SCAN PT IN R1,CHECK FOR LAST 15268000 BE IDOUT2 QUIT IF DONE 15270000 LA RX,4095(RY,RX) BUMP CURRENT USING 4096 15272000 LR RA,R1 MOVE SCAN POINTER BACK OVER 15274000 B IDUSC BUMP SCAN POINTER AND CONTINUE 15276000 EJECT 15286000 **--> INSUB: IDREGET CONVERT REGISTER, CHECK VALIDITY + + + + + + + 15288000 *+ ENTRY CONDITIONS + 15290000 *+ RA = SCAN POINTER TO 1ST CHARACTER OF REGISTER + 15291000 *+ RW = RETURN @ TO CALLING SECTION OF CODE + 15292000 *+ EXIT CONDITIONS + 15294000 *+ R1 = SCAN PTR TO @ DELIMITER FOLLOWING SCAN (IF REGISTER GOOD). + 15296000 *+ RA = VALUE OF REGISTER IF GOOD, = SCAN PTR TO ERROR IF BAD. + 15298000 *+ RC = VALUE OF REGISTER IF GOOD. + 15300000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 15301000 SPACE 1 15302000 IDREGET $CALL EVALUT USE EXP EVAL (LOW PROB USAGE) 15303000 LR R1,RA SAVE SCAN PTR 15304000 LTR RB,RB WAS REGISTER OK 15305000 BNZ IDERROR NO, BRANCH AND FLAG IT 15306000 LTR RD,RD CHECK FOR ABSOLUTE VALUE, NOT RELOC 15310000 BNZ IDERELC ^=0 ==> RELOCATABLE==> ERROR 15312000 SPACE 1 15313000 IDREGCHK C RC,AWF15 MAKE SURE REG NOT TOOT LARGE 15314000 BH IDREGBIG NO,REGISTER TOO LARGE 15316000 LR RA,RC PUT REGISTER WHERE DESIRED 15318000 BR RW RETURN TO CALLER,READY FOR DROP,USIN 15320000 SPACE 1 15382000 **--> INSUB: IDEVAL EVALUATE RELOCATABLE EXPRESSION + + + + + + + + 15382100 *+ ENTRY CONDITIONS + 15382200 *+ RA = SCAN PTR TO 1ST CHARACTER OF EXPRESSION + 15382300 *+ RW = RETURN @ TO CALLING SECTION IN IDASM2 + 15382400 *+ EXIT CONDITIONS + 15382500 *+ RZ = SECTION ID OFTHE EXPRESSION (SAME AS VALUE IN RD) + 15382600 *+ RA = SCAN PTR @ TO DELIMITER IF GOOD, TO ERROR IF NOT. + 15382700 *+ RC = VALUE OF THE EXPRESSION + 15382800 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 15384000 IDEVAL $CALL EVALUT 15386000 LTR RB,RB WAS EXPRESSION OK 15388000 BNZ IDERROR NO, ERROR 15389000 LTR RZ,RD DUPLICATE ESDID, TEST FOR RELOCATBL 15390000 BCR NZ,RW RETURN IF RELOCATABLE (RD ^= 0) 15391000 B IDERELOC ERROR, NEED RELOCATABLE EXPRESSION 15392000 SPACE 1 15394000 * * * * * INTERNAL CONSTANTS * 15396000 * * * * * BRANCH OFFSET TABLE FOR INDIVIDUAL INSTRUCTIONS * 15398000 IDAJUMP $AL2 IDASMJ,(IDUSING,IDDROP,IDSTART,IDCSECT,IDDSECT,IDENTRY,I#15400000 DEXTRN,IDEQU,IDDC,IDDS,IDCCW,IDTITLE,IDEJECT,IDSPACE,IDP#15402000 RINT,IDORG,IDLTORG,IDCNOP,IDEND),-2 15404000 AIF (&$DEBUG).IDNOD2 SKIP IF NOT DEBUG MODE 15406000 DC AL2(IDDEBUG-IDASMJ) OFFSET TO DEBUG ROUTINE 15408000 .IDNOD2 ANOP 15410000 LTORG 15412000 DROP RAT,R13,RC KILL USINGS 15414000 TITLE '*** INPUT1 - INPUT CARDIMAGE READER/PROCESSORS ***' 15416000 **--> CSECT: INPUT1 1 INPUT AND MANIPULATION OF SOURCE CARDS. . . . 15418000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15420000 INPUT1 CSECT 15422000 $DBG 90,* 15424000 USING AVWXTABL,RAT MAIN TABLE USING 15426000 ENTRY INCARD 15428000 SPACE 2 15430000 **--> ENTRY: INCARD CALLED TO GET CARD AND CREATE RSBLOCK . . . . 15432000 *. THIS ENTRY READS 1 STATEMENT (1-3 CARDS), AND SETS UP THE . 15432100 *. RECORD BLOCKS RSBLOCK, AND RSCBLK (IF CONTINUATIONS OR . 15432200 *. SEQUENCE NUMBERS ARE USED). IT IS CALLED DURING PASS 1 OF . 15432300 *. THE ASSEMBLY. IF AN ENDFILE INDICATION IS ENCOUNTERED, IT . 15432400 *. CREATES A PSEUDO ENDCARD, SINCE THE MAIN PROGRAM OF PASS 1 . 15432500 *. MOCON1 ONLY STOPS AFTER AN END CARD IS FOUND. AS OF 8/17/70,. 15432600 *. INCARD IS THE ONLY ASSEMBLER ENTRY DOING CARD READING. . 15432700 *. IN SETTING UP THE RSBLOCK, INCARD CONCATENATES THE SECTIONS . 15432800 *. OF A CONTINUED STATEMENT, AND REMOVES BLANKS TO SOME DEGREE . 15432900 *. FROM THE TRAILING EDGE OF THE STATEMENT. IT ALSO INSERTS . 15433000 *. THE 3 CHARACTERS BLANK,APOSTROPHE,BLANK AFTER THE LAST . 15433100 *. NONBLANK CHARACTER IN THE SOURCE STATEMENT. THIS IS CRUCIAL . 15433200 *. TO THE PROPER SCANNING OF THE SOURCE STATEMENT WITHOUT . 15433300 *. REQUIRING LENGTHS TO BE CARRIED FROM ROUTINE TO ROUTINE. . 15434000 *. . 15434020 *. IF THE MACRO PROCESSOR EXISTS (&$MACROS=1), INCARD . 15434025 *. ALSO HANDLES RECOVERY OF GENERATED STMTS (CREATED BY MEXPND .. 15434030 *. IN THE DYNAMIC-HIGH AREA). . 15434035 *. IF A MACRO LIBRARY FACILITY EXISTS (&$MACSLB=1), . 15434040 *. INCARD CAN BE SWITCHED TO READ FROM IT, INSTEAD OF $SORC. . 15434045 *. EXIT CONDITIONS . 15434100 *. RA = SCAN PTR TO ERROR, ONLY IF RB ^= 0. NO MEANING IF RB = 0. . 15434200 *. RB = 0 NO ERRORS FOUND IN STATEMENT BY INCARD . 15434300 *. RB = ERROR CODE (NONZERO) OF ERROR. RA HAS SCAN PTR OF IT. . 15434400 *. AVSOLAST = @ BLANK IMMEDIATELY BEFORE ' IN THE 4-BYTE FIELDWHICH . 15434410 *. INCARD PLACES AFTER THE SOURCE STMT TO STOP SCANNING OVERRUN.. 15434420 *. USES DSECTS: AVWXTABL,RSBLOCK,RSCBLK,RSOURCE . 15434500 *. USES MACROS: $RETURN,$SAVE,$SORC . 15435000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15436000 SPACE 1 15437000 * * * * * REGISTER ALLOCATION FOR INCARD * * * * * * * * * * * * * * * 15438000 * R1 = NUMBER OF CARDS INCLUDED IN CURRENT RSBLOCK (FROM 1-3) * 15440000 * R2 = 0 (INITIALLY) - BYTE REGISTER FOR INSERTION * 15442000 * RW = ADDRESS OF RSBLOCK BEING BUILT * 15444000 * RX = ADDRESS OF RSCBLK BEING BUILT(IF ANY) * 15446000 * RY = ADDRESS WHERE NEXT SOURCE SHOULD BE READ(RSOURCE) * 15448000 * RZ = CURRENT LENGTH-1 OF RSBLOCK BEING BUILT * 15450000 * R14= INTERNAL LINK REGISTER (FOR INCRSMV). * 15451000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15452000 EJECT 15454000 INCARD $SAVE RGS=(R14-R6),SA=NO 15456000 AIF (&$DEBUG).INNZ SKIP IF NOT DEBUGGIN MODE 15458000 MVC AVRSBLOC(256),AWTZTAB ZERO OUT ***DEBUGGING *** 15460000 .INNZ LA R1,1 INIT # CARDS TO 1 15462000 LM RW,RX,AVRSBPT VRSBPT,VRSCPT POINTERS 15464000 USING RSBLOCK,RW NOTE RSBLOCK USING SETUP 15466000 USING RSCBLK,RX NOTE RSCBLK USING SETUP 15468000 LA RY,RSBSOURC INIT POINTER TO NEXT INPUT AREA 15470000 USING RSOURCE,RY NOTE CARDIMAGE USING 15472000 LA RZ,RSB$LN1 INIT LENGTH-1 OF RSBLOCK 15474000 SR R2,R2 CLEAR FOR ZERO VALUE 15476000 ST R2,RSBLENG ZERO OUT WHOLE CODES SECTION 15478000 SR RB,RB CLEAR INITIALLLY==> NO ERRORS 15479000 TM AVTAGS2,$INEND2 HAS THERE BEEN EOF, END CARD NEEDED 15480000 BO INCREOF END CARD NEEDED-GO CREATE IT 15482000 SPACE 1 15482020 AIF (NOT &$MACROS).INNOMA SKIP IF NO MACROS 15482040 * SEE IF EXPANDED STMTS EXIST. IF SO, PROCESS NEXT ONE. 15482060 L RC,AVGEN1CD @ 1ST BYTE BEYOND NEXT GEN'D STMT 15482080 C RC,AVGEN2CD CHECK AGAINST LOWER LIMIT 15482100 BNH INNOTGEN SKIP IF THERE ARE NO MORE CARDS 15482120 SPACE 1 15482140 C RC,AVADDHIH MAKE SURE AVGEN1CD <= AVADDHIH 15482160 BH INMOVRGN RAN OVER GENERATED CODE FROM TOP 15482180 CLC AVGEN2CD,AVADDLOW CHECK FOR OVERRUN FROM BOTTO4 15482200 BNH INMOVRGN YES IT DID (MORE LIKELY) - GO 15482220 SPACE 1 15482240 * MOVE NEXT EXPANDED STMT OVER TO RSBLOCK AREA. 15482260 LA RD,RSB$L = LENGTH OF CONSTANT PART OF RSBLOCK 15482280 SR RC,RD DECREMENT GEN PTR 15482300 MVC RSBLOCK(RSB$L),0(RC) COPY CONSTANT PART 15482320 IC RZ,RSBLENG GET L-1 OF GEN'D STMT 15482340 STC RZ,INMMOVE+1 PUT L-1 INTO MVC INSTR 15482360 SR RC,RZ GET @ 2ND BYTE OF GEN'D STMT (L-1) 15482380 SR RC,R1 GET @ 1ST BYTE OF GEN'D STMT 15482400 INMMOVE MVC RSBSOURC($),0(RC) MOVE WHOLE STMT OVER 15482420 SPACE 1 15482440 * IF THERE ARE ALREADY ERRORS IN THE STMT, MOVE THE 15482460 * RESULTING REBLK OVER TO NORMAL LOCATION. 15482480 TM RSBFLAG,$REBX DOES THE STMT HAVE ERRORS 15482500 BZ INMNOREB NO, JUMP (NORMAL CASE) 15482520 IC R2,RSBNUM GET REBLN FROM TEMPORARY LOCATION 15482540 STC R2,AVREBLN STORE THE LENGTH-1 OF ERROR BLOCK 15482560 SR RC,R2 RC = @ OF REST OF REBLK (NOT REBLN) 15482580 SR R2,R1 GET L-1 OF PART OF REBLK LEFT 15482600 STC R2,*+5 PLACE L-1 INTO MVC INSTR 15482620 MVC AVREBES($),0(RC) MOVE REST OF ERROR BLOCK OVER 15482640 SPACE 1 15482660 INMNOREB ST RC,AVGEN1CD UPDATE PTR TO NEXT GEN'D STMT 15482680 SPACE 1 15482700 * STMT FROM MACRO PROCESSOR MAY HAVE 1-2 EXTRA BLANKS AT 15482720 * END: REMOVE THEM SO DON'T CAUSE UNNECESSARY CONT CARDS. 15482740 LA RC,RSBSOURC-1(RZ) @ NEXT TO LAST CHAR OF STMT 15482760 CLI 1(RC),C' ' WAS LAST BYTE A BLANK 15482780 BNE INMOBLN NO, SKIP, DON'T REMOVE 15482800 CLI 0(RC),C' ' WAS NEXT TO LAST A BLANK 15482820 BNE *+6 NO, REMOVE ONLY 1 - BRANCH 15482840 SR RZ,R1 YES, REMOVE 2 BLANKS FROM COUNT 15482860 SR RZ,R1 REMOVE OTHER BLANK 15482880 * NOW CONSTRUCT RSCBLK, IF STMT REQUIRES IT BY BEING TOO * 15482900 * LARGE TO FIT ON 1 CARD. AT THIS PT, RZ = LENGTH-1 OF STMT. * 15482920 * (RZ) <= 70 ==> 1 CARD, NO RSCBLK. * 15482940 * (RZ) <= 126 ==> 2 CARDS, RSCBLK, 21 BYTES LONG * 15482960 * RSCLENG = 2*RSC$LEN; RSCILEN(1) = RSOL1; * 15482980 * RSCILEN(2) = (RC) - (RSOL1-1) . 15483000 * (RZ) <= 182 ==> 3 CARDS, RSCBLK, 31 BYTES LONG. * 15483020 * RSCLEN = 3*RSC$LEN; RSCILEN(1) = RSOL1; 15483040 * RSCILEN(2) = RSOLC; RSCILEN(3) = (RC) -(RSOL1-1)-RSOLC. 15483060 SPACE 1 15483080 INMOBLN LR RC,RZ GET L-1 TO BE DESTROYED 15483100 AR RZ,RD GET L-1 OF ENTIRE RSBLOCK, AS NEEDED 15483120 SPACE 1 15483140 SH RC,=AL2(RSOL1-1) GET # BYTES IN GEN'D CARDS 2,3 15483160 BNP INCNORM <=0, SO ONLY 1 CARD- BRANCH(NORMAL) 15483180 TM RSBFLAG,$RSBMERR MACRO ERROR? J 15483182 BO INCNORM YES, CAN'T BE CONTINUED ANYWAY J 15483183 SPACE 1 15483200 * CONTINUATION CARDS NEEDED, LIKEWISE RSCBLK (MOAN). 15483220 LA RY,AWBLANK FAKE BLANK CARDIMAGE FOR INCRSMV 15483240 LA RE,RSOLC GET LENGTH OF CONTINUED CARDIMAGE 15483260 AR R1,R1 SET # CARDS SO FAR = 2 (AT LEAST) 15483280 BAL R14,INCRSMV1 HAVE 1ST SECTION OF RSCBLK SET UP 15483300 MVI RSCONSQ-RSCILEN(RD),C'X' INDICATE CONTINUED CARD 15483320 BAL R14,INCMOV MOVE SECOND CARD SEQNO/SET CODES 15483340 SPACE 1 15483360 CR RC,RE ARE THERE 2 CARDS OR 3 15483380 BNH INMCONT2 <= RSOLC ==> ONLY 2 CARDS TOTAL - GO 15483400 SPACE 1 15483420 SR RC,RE GET LENGTH OF 3RD CARD IMAGE 15483440 MVI RSCONSQ-RSCILEN(RD),C'X' SHOW 2ND CARD CONINUED 15483460 BAL R14,INCMOV SAVE 3RD AND LAST SECTION OF RSCBLK 15483480 LA R1,1(,R1) SET TOTAL # CARDS = 3. 15483500 * IT IS ASSUMED THAT MEXPND NEVER CREATES STMTS HAVING * 15483520 * MORE THAN 193 (RSOL1+2*RSOLC) BYTES OF SOURCE DATA. * 15483540 * OTHERWISE, IT WOULD BE NECESSARY TO CHECK (RC) <= RSOLC* 15483560 INMCONT2 STC RC,RSCILEN-RSCILEN(,RD) SAVE LENGTH OF LAST PART <=56. 15483580 B INCNORM ALL SET, NO GO PROCESS NORMALLY 15483600 SPACE 1 15483620 INMOVRGN EQU * COME HERE IF OVERRUN OCCURS 15483640 MVC AVGEN1CD,AVGEN2CD COPY, SO THINKS NO MORE GEN'D STMTS 15483660 MVC 0(80,RY),AWBLANK FAKE A BLANK CARD 15483680 OI RSBFLAG,$RSBNPNN DON'T PROCESS FURHTER 15483700 LA RB,$EROVRGN FLAG ERROR: GEN'D STMTS OVERRUN 15483720 B INCHECK SKIP OVER CARD READ AND GO ON 15483740 EJECT 15483760 SPACE 1 15484420 INNOTGEN EQU * ENTERED IF NOT GENRTED STMT 15484440 .INNOMA ANOP 15484460 $SORC 0(RY),80,INCREOF READ FIRST,HOPEFULLY ONLY,CARD 15486000 INCHECK CLI RSOCONT,C' ' CHECK FOR CONTINUATION CAHR 15498000 BNE INCCONT CARD MUST BE CONTINUED-BRANCH 15500000 CLC RSOSEQN,AWBLANK IS THERE SEQUENCE INFO 15502000 BE INCNORM NO SEQNO-BRANCH NORMAL 15504000 INCHC BAL R14,INCRSMV CALL CONTINUATION/SENO SAVER 15506000 EJECT 15508000 * ENTIRE STATEMENT READ-FINISH UP AND RETURN * 15510000 INCNORM STC R1,RSBNUM SAVE # CARDS(HOPEFULLY 1) 15512000 LA RE,RSBLOCK(RZ) GET @ LAST ACTUAL SOURCE BYTE 15514000 * FOLLOWING SECTION REMOVES BLANKS FROM END OF CARD. * 15516000 BCT R1,INCBLC SKIP BLANK-CRUNCH IF >1 CARD 15518000 * REMOVE 36 BLANKS QUICKLY, IF POSSIBLE 15520000 LH R2,=H'-36' GET VALUE TO BACK UP @ PTR 15522000 AR R2,RE GET @ BEGINNING OF COMMENTS FIELD 15524000 CLC 1(36,R2),AWBLANK IS HALF OF CARD ALL BLANK 15526000 BE INCBL YES,SO LEAVE R2 WHERE IT IS, BLANKS 15528000 LR R2,RE WASN'T BLANK, DO WHOLE THING 15530000 INCBL LA R1,RSBSOURC+9 LIMIT @, INCLUDING POSSIBLE LABEL 15531000 LH R0,=H'-8' DECREMENT: 8 BLANKS PER CHUNK 15532000 BXLE R2,R0,INCBLN DECREMENT/TEST, SKIP IF TERHE ALREAD 15533000 SPACE 1 15534000 CLC 1(8,R2),AWBLANK CHOP OFF 8 BLANKS IF POSSIBLE 15535000 BNE INCBLN NOT BLANKS, TOO BAD, SKIP OUT 15536000 BXH R2,R0,*-10 LOOP UNTIL LIMIT REACHED 15536500 INCBLN SR R2,R0 SUBTRCT DECREMNT, PUT PTR BACK OK 15537000 SPACE 1 15537500 L R0,AWFM1 GET NEW DECREMENT FOR 1 AT A TIME 15538000 SPACE 1 15540000 * LOOP TO REMOVE BLANKS FROM END OF STMT, 1 AT A TIME. * 15542000 INCBLA CLI 0(R2),C' ' IS THIS A BLANK 15544000 BNE INCBLB NO IT ISNT, SO QUIT REMOVING-BRANCH 15546000 BXH R2,R0,INCBLA LOOP UNTIL LIMIT @ REACHED 15548000 SPACE 1 15550000 SR R2,R0 SUBTRCT -1,PUT POINTER BACK RIGHT 15552000 INCBLB SR R2,RE GET # BLANKS REMOVED 15554000 AR RZ,R2 ADD DECREMENT TO LENGTH VALUE IN RZ 15556000 AR RE,R2 OBTAIN @ LAST BYTE(NEW) 15558000 SPACE 1 15558100 * CONCATENATE ENDING FIELD " ' " TO SOURCE STMT TO * 15558200 * PREVENT SCANNING BEYOND END OF STMT. SAVE LIMIT @ IN * 15558300 * AVSOLAST, SAVE FINAL LENGTH-1 OF RSBLOCK. RETURN. * 15558400 INCBLC EQU * FOR SKIP IF >1 CARD, NO CRUNCH 15560000 MVC 1(4,RE),INCBQB MOVE IN DELIMITER VALUE 15562000 LA RC,2(RE) GET @ OF BLANK BEFORE ENDING ' 15562500 ST RC,AVSOLAST STORE THIS FOR OTHER'S USE 15563000 LA RZ,2(RZ) INCREMENT RZ BY 1 TO GET >=2BLANKS 15564000 STC RZ,RSBLENG SAVE L-1 OF RSBLOCK 15566000 INCRET $RETURN RGS=(R14-R6),SA=NO 15568000 EJECT 15570000 * FOLLOWING SECTION ENTERED FOR CONTINUATION CARD * 15572000 INCCONT BAL R14,INCRSMV HAVE CONTINUATION FIELD-SEQNO SAVED 15574000 C R1,AWF3 IS # OF CARDS<3(MAXIMUM) 15576000 BNL INCERR1 NO,WE HAVE TOO MANY CONTS(3 OR MORE) 15578000 LA RY,RSBLOCK+1(RZ) GET NEXT ADDRESS TO BE INPUT 15580000 $SORC 0(RY),80,INCREOFA GET NEXT CARD 15582000 CLC RSOLOPC,AWBLANK ARE 1ST 15 COLUMNS BLANK 15584000 BE INCCOK BRANCH IF IT IS BLANK(OK) 15586000 LR RA,RY ERROR-MOVE ADDRESS OVER 15588000 LA RB,$ERCONT ILLEGAL CONTINUATION-ERROR 15590000 SPACE 1 15594000 INCCOK MVC RSOURCE(L'RSOOPRCM),RSOOPRCM MOVE CARD IMAGE OVER 15596000 LA RZ,L'RSOOPRCM(RZ) INCREMENT LENGTH-1 OD RSBLOCK 15598000 LA R1,1(R1) INCRMENT NUMBER OF CARDS 15600000 CLI RSOCONT,C' ' IS CONTINUATION CARD CONINUED ALSO 15602000 BE INCHC NO IT ISNT,HAVE LAST CONT/SEN SAVED 15604000 B INCCONT CONINUED AGAIN-KEEP GOING 15606000 INCREOF MVC RSBSOURC(71),AWBLANK BLANK OUT SOURCE AREA 15608000 SPACE 1 15610000 MVC RSBSOURC+9(3),=C'END' MAKE UP END CARD 15612000 LA RA,RSBSOURC+10 SET PTR TO END FOR WARNING 15614000 LA RB,$ERNOEND WARNING-MESSAGE CODE-NO END CARD 15616000 INCREOFA OI AVTAGS2,$INEND2 EOF==> CREATE END CARD NEXT TIME 15620000 B INCNORM GO SET FLAGS AND RETURN 15622000 INCERR1 LA RB,$ERCONTX TOO MANY CONTINUATIONS(>2) 15624000 LA RA,RSOCONT-1 GET THE POINTER 15626000 LA R14,INCNORM SET RETURN ADDR OF INCRSMV 15630000 * FALL THRU INTO INCRSMV (WHICH MUST FOLLOW). 15632000 SPACE 1 15634000 **--> INSUB: INCRSMV SAVE CON/SEQNO INTO RSCBLK + + + + + + + + + + 15634200 *+ ENTRY CONDITIONS + 15634400 *+ RY = @ CARDIMAGE FROM WHICH CON/SEQNO TAKEN (RSOURCE DSECT) + 15634600 *+ EXIT CONDITIONS + 15634800 *+ RD = @ VARIABLE PART OF RSCBLK JUST CREATED (I.E. NEWEST RSCILEN) + 15635000 *+ R14= RETURN @ TO CALLING SECTION OF CODE IN INCARD. + 15635200 *+ R2 IS DESTROYED. + 15635400 *++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 15635600 SPACE 1 15636000 INCRSMV TM RSBFLAG,$RSCX HAVE THERE BEEN PREVIOUS CONT/SEQS 15638000 BO INCMOV YES THERE HAVE,BRANCH 15640000 INCRSMV1 OI RSBFLAG,$RSCX SHOW 1ST ONE - RSC EXISTS 15642000 MVI RSCLENG,0 ZERO OUT LENGTH AT FIRST 15644000 MVI RSCILEN,RSOCONT-RSOURCE LENGTH FOR 1ST CRD(71) 15646000 INCMOV IC R2,RSCLENG GET CURRENT L-1 OF BYTES 15648000 LA RD,RSCILEN(R2) GET ADDR OF NEXT SLOT 15650000 LTR R2,R2 WAS THIS 1ST CARD 15652000 BZ *+8 SKIP MVI IF IT WAS 1ST 15654000 MVI 0(RD),L'RSOOPRCM MOVE IN LENGTH FOR CONT CARD (56, 15656000 MVC RSCONSQ-RSCILEN(9,RD),RSOCONT MOVE CONT/SEQ OVER 15658000 LA R2,RSC$LEN(R2) INCREMENT LENGTH-1 15660000 STC R2,RSCLENG UPDATE LENGTH-1 15662000 BR R14 RETURN TO CALLING SECTION 15664000 SPACE 1 15666000 * * * * * INTERNAL CONSTANTS * 15668000 INCBQB DC C' '' ' DELIMITER FIELD FOR END OF SOURCE 15670000 LTORG 15672000 DROP RAT,REP,RW,RX,RY REMOVE ALL USINGS 15674000 TITLE '*** LTOPRS - LITERAL OPERATIONS ***' 15676000 **--> CSECT: LTOPRS 1-2 ALL LITERAL TABLE OPERATIONS. . . . . . . . . 15678000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15680000 LTOPRS CSECT 15682000 $DBG A0,* 15684000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15686000 * NOTE RESTRICTION - A-TYPE ADCONS IN LITERALS MAY NOT * 15688000 * MAKE REFERENCES TO THE LOCATION COUNTER. A WARNING * 15690000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15692000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 15694000 ENTRY LTINT1,LTENT1,LTDMP1,LTEND1,LTGET2,LTDMP2 15696000 SPACE 2 15698000 **--> ENTRY: LTINT1 1 INITIALIZE LITERAL TABLE IF NEEDED. . . . . . 15700000 *. ALLOCATES AND ZEROS 1ST LITERAL POOL BASE TABLE. INITS 1ST AND * 15702000 *. CURRENT BLOCK POINTERS TO 1ST LTBASETB. * 15704000 *. CALLS MOSTOP . 15704100 *. USES DSECTS: AVWXTABL,LTBASETB . 15704200 *. USES MACROS: $ALLOCH,$RETURN,$SAVE . 15704300 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15706000 LTINT1 $SAVE SA=NO 15708000 LA RB,LTB$LEN GET LENGTH OF 1 LTBASETB ENTRY 15710000 $ALLOCH RA,RB,LTZOVER GET NEEDED SPACE 15712000 LR RB,RA DUPLICATE THIS VALUE 15714000 STM RA,RB,LTBFIRST LTBFIRST-LTBNOW - SET POINTERS 15716000 USING LTBASETB,RA NOTE USING 15718000 MVC LTBASETB(LTB$LEN),AWZEROS ZERO OUT THE TABLE 15720000 DROP RA CLEAN UP USING 15722000 $RETURN SA=NO 15724000 EJECT 15726000 **--> ENTRY: LTENT1 1 ENTER A LITERAL INTO THE TABLE. . . . . . . . 15728000 *. THIS ENTRY IS CALLED DURING PASS 1 TO SCAN A LITERAL BY . 15728100 *. IAMOP1. THE LITERAL IS SCANNED BY CODTL1, AND IT IS ENTERED . 15728200 *. IF IT IS NOT ALREADY PRESENT. NOTE THAT NO DUPLICATES . 15728300 *. ARE EVER KEPT IN THE SAME POOL, EVEN FOR A-TYPE CONSTANTS . 15728400 *. WITH LOCATION COUNTER REFERENCES. . 15728500 *. ENTRY CONDITIONS . 15730000 *. RA = SCAN POINTER (ADDRESS OF = IN LITERAL) . 15732000 *. EXIT CONDITIONS . 15734000 *. RA = SCAN POINTER (ADDRESS OF ERROR OR DELIMETER) . 15736000 *. RB = 0 IF LITERAL LEGAL, ERROR CODE OTHER WISE . 15738000 *. RC = ADDRESS OF LITERAL TABLE ENTRY . 15740000 *. CALLS CODTL1,MOSTOP . 15741000 *. USES DSECTS: AVWXTABL,CNCBLOCK,LTBASETB,LTLENTRY,RSBLOCK . 15742000 *. USES MACROS: $ALLOCH,$CALL,$RETURN,$SAVE,$SCPT . 15743000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15744000 SPACE 1 15746000 * * * * * REGISTER ALLOCATION FOR LTENT1 * * * * * * * * * * * * * * * 15748000 * R1 = #-1 OF CHARACTERS IN THE LITERAL BEING PROCESSED * 15750000 * R2 = # OF CHARACTERS IN LITERAL,ROUNDED TO FULLWORD, THEN -1 * 15752000 * RW = BASE REGISTER * 15754000 * RX = INITIAL SCAN POINTER TO = OF LITERAL * 15756000 * RC = @ CNCBLOCK PROVIDED BY CODTL1 * 15758000 * RD = TOTAL LENGTH OF NEW LTENTRY BLOCK * 15760000 * RE = @ LTENTRY BLOCK FOR A NEW LITERAL * 15762000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15764000 SPACE 1 15766000 LTENT1 $SAVE RGS=(R14-R6),SA=LTOPSAVE,BR=R3 15768000 SPACE 1 15770000 * INITIALIZES, CALL 1ST-PASS CONSTANT PROCESSOR. 15772000 LR RX,RA SAVE SCAN POINTER 15774000 LA RA,1(RA) INCREMENT POINTER PAST = 15776000 LA RB,8 SHOW CODTL1 WE ARE IN LITERAL 15778000 $CALL CODTL1 CALL DUPLFAC-TYPE-LENGTH PROCESSOR 15780000 LTR RB,RB WAS THERE AN ERROR 15782000 BNZ LTE1RET IF SO,RETURN SHOWING ERROR 15784000 SPACE 1 15786000 * CHECK TO MAKE SURE NO MISSING DELIMITER. 15788000 C RA,AVSOLAST COMPARE TO @ BLANK BEFORE ' 15788500 BNL LTE1ERR3 MISSING QUOTE ON C-CON-ERROR 15789000 USING CNCBLOCK,RC CODTL1 HAS SET UP A CNCBLOCK 15806000 SPACE 1 15808000 * SET UP FOR LOOKING FOR A DUPLICATE LITERAL * 15810000 LR R1,RA MOVE NEW SCAN POINTER OVER 15812000 SR R1,RX GET LENGTH OF LITERAL-# OF CHARS 15814000 LA R15,112 GET LENGTH FOR COMPARISON 15816000 CR R1,R15 MAKE SURE NO MORE THAN 2 CARDS 15818000 BH LTE1ERR4 BRANCH IF TOO LONG 15820000 BCTR R1,0 GET # CHARS - 1 IN LITERAL 15822000 BCTR RE,0 GET TOTAL LENGTH-1 OF LITERAL DC 15824000 N RE,AWF7 REMOVE ALL BUT LAST 3 BITS OF LENGTH 15826000 IC R15,LTEB1248(RE) GET THE OFFSET TO POINTER -LTBASETB 15828000 L R14,LTBNOW GET @ CURRENT LTBASETB 15830000 USING LTBASETB,R14 NOTE TABLE USING 15832000 LA RE,LTBCH1(R15) GET @ ACTUAL POINTER -LTBCH1-2-4-8 15834000 DROP R14 NO LONGER NEEDED 15836000 USING LTLENTRY,RE WILL POINT AT 1ST ENTRY,IF ^=0 15838000 STC R1,LTE1CLI+1 SAVE #-1 OF CHARS INTO CLI 15842000 STC R1,LTE1CLC+1 SAVE #-1 OF CHARS INTO CLC ALSO 15844000 BAL R15,LTE1L BEGIN SEARCH,SETTING REG FOR BCR TOO 15846000 SPACE 1 15848000 * SEARCH FOR LITERAL IN CHAIN OF RIGHT LENGTH. * 15850000 LTE1CLI CLI LTLCHARS,$CHN CHECK 1ST FOR SAME # OF CHARS 15852000 BNE LTE1L IF NOT,LOOP TO NEXT ON CHAIN 15854000 LTE1CLC CLC LTLITRAL($CHN),0(RX) IS LITERAL THE SAME 15856000 BE LTE1OLD BRANCH OUT IF SAME LITERAL 15858000 SPACE 1 15860000 LTE1L LR RD,RE SAVE @ OLD LTLENTRY 15862000 L RE,LTLINK GET @ NEXT LTLENTRY FROM OLD ONE 15864000 LA RE,0(RE) REMOVE 1ST BYTE 15866000 LTR RE,RE IS THE LINK = 0 15868000 BCR NZ,R15 BNZ LTE1CLI - GO BACK FOR NEXT TEST 15870000 SPACE 1 15872000 * FALL THRU==> THIS IS A NEW LITERAL-GET SPACE&ENTER IT * 15874000 LA R14,LTL$LEN+4(R1) GET TOTAL LENGTH,ROUNDED OVER FULL 15876000 O R14,AWF3 MAKE LAST 2 BITS 1'S 15878000 S R14,AWF3 ALIGN TO FULLWORD AMOINT 15880000 $ALLOCH RE,R14,LTZOVER GET SPACE FOR NEW ENTRY 15882000 STC R1,*+5 PUT LENGTH-1 INTO MVC 15884000 MVC LTLITRAL($CHN),0(RX) MOVE LITERAL OVER 15886000 LR R15,RE MOVE POINTER OVER 15888000 AL R15,0(RD) ADD LTLCHARS OF PREVIOUS ENTRY 15890000 ST R15,0(RD) STORE LTLCHARS-LTLINKA BACK 15892000 MVC LTLTYP(CNC$LEN),CNCBLOCK MOVE ALL THE CODES OVER 15894000 DROP RC HAVE GOTTEN CODES,NO MORE USING 15896000 SLL R1,24 SHIFT LENGTH-1 FOR POSITION TO STORE 15898000 ST R1,LTLINK STORE LTLCHARS FIELD, WITH 0 LTLINKA 15900000 $SCPT R15,LTLSCAN GET SCAN POINTER ADDRESS 15902000 SR R15,RX GET OFFSET FROM = SIGN 15904000 STC R15,LTLSCAN SAVE THIS SCAN POINTER INSTEAD 15906000 LTE1OLD LR RC,RE MOVE @ LITERAL ENTRY FOR RETURN 15908000 LTE1RET $RETURN RGS=(R14-R6) 15910000 SPACE 1 15912000 * INDIVIDUAL ERROR EXITS. * 15914000 LTE1ERR3 LA RB,$ERNODLM MISSING DELIMITER 15916000 B LTE1RET RETURN 15918000 LTE1ERR4 LA RB,$ERCNLNG CONSTANT TOO LONG FOR LITERAL 15920000 B LTE1RET GO RETURN 15922000 EJECT 15924000 **--> ENTRY: LTDMP1 1 DUMP LITERALS ON FINDING LTORG AND END. . . . 15926000 *. LTDMP1 IS CALLED BY IBASM1 TO FIND LENGTH OF THE CURRENT . 15928000 *. LITERRAL POOL, AND AVANCE THE CURRENT POOL PTR TO THE NEXT 1.. 15928050 *. EXIT CONDITIONS . 15930000 *. RA = TOTAL LENGTH REQUIRED FOR THE LITERAL BLOCK . 15932000 *. CALLS MOSTOP . 15932100 *. USES DSECTS: AVWXTABL,LTBASETB,LTLENTRY . 15932200 *. USES MACROS: $ALIGN,$ALLOCH,$CALL,$GLOC,$RETURN,$SAVE . 15932300 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15934000 LTDMP1 $SAVE RGS=(R14-R0),SA=NO 15936000 SPACE 1 15938000 * INITIALIZE PROCESSING FOR 1 LITERAL POOL. 15940000 SR RA,RA CLEAR TOTAL LENGTH 15942000 L RB,LTBNOW GET POINTER TO CURRENT LTBASETB 15944000 USING LTBASETB,RB TELL ASSEMBLER 15946000 $GLOC RE GET LOCATION COUNTER 15948000 $ALIGN RE,7,* ALIGN TO DOUBLEWORD 15950000 ST RE,LTBVALUE SAVE THIS VALUE IN LTBLOCK 15952000 LA RC,4 # OF LITERAL CHAINS - LTBCH1-2-4-8 15954000 LA RD,LTBCH8 @ FIRST CHAING POINTER TO BE DONE 15956000 SPACE 1 15958000 * OUTSIDE LOOP - GET NEXT CHAIN OF LITERALS - 8-4-2-1. 15960000 LTD1L L RE,0(RD) GET NEXT POINTER FORM LTBCH1-2-4-8 15962000 USING LTLENTRY,RE NOTE ENTRY POINTER(@ SET LOWER DOWN) 15964000 A RD,AWFM4 SUBTRACT 4 TO GET NEXT ONE NEXT TIME 15966000 BAL R14,LTD1LTR GO TEST LINK PTR,ALSO SETING R14 15968000 SPACE 1 15970000 * LOOP ALONG LITERAL CHAINS,ADDING LENGTHS,GETTING OFSETS* 15972000 LTD1E STH RA,LTLOFSET SAVE OFFSET OF LITERAL 15974000 AH RA,LTLTOT ADD THE TOTAL LENGTH OF LITERAL IN 15976000 AIF (&$DEBUG).LTXS1 SKIP IF PRODUCTION 15978000 XSNAP STORAGE=(*LTLENTRY,*LTLITRAL),IF=(AVDEBUG,O,X'84',TM) 15980000 .LTXS1 ANOP 15982000 L RE,LTLINK GET @ NEXT LITERAL ON CHAIN 15984000 LA RE,0(RE) REMOVE FIRST BYTE(LTLCHARS) 15986000 LTD1LTR LTR RE,RE IS POINTER 0. IF SO==> LAST ON CHAIN 15988000 BCR NZ,R14 BNZ LTD1E - KEEP GOING IF MORE 15990000 SPACE 1 15992000 BCT RC,LTD1L LOOP TO GET ALL LITERALS - 8-4-2-1 15994000 DROP RE NO LONGER NEEDED 15996000 SPACE 1 15998000 LA RD,LTB$LEN GET LENGTH FOR NEXT LTBASETB 16000000 $ALLOCH RE,RD,LTZOVER GET THE SPACE 16002000 ST RE,LTBLINK SAVE POINTER TO NEW LTBASETB IN OLD 16004000 MVC LTBESDID,AVCESDID MOVE CURRENT ESDID OVER 16006000 DROP RB NO MORE REFS TO OLD LTBASETB 16008000 USING LTBASETB,RE USING FOR JUST CREATED LTBASETB 16010000 MVC LTBASETB(LTB$LEN),AWZEROS ZERO IT OUT 16012000 ST RE,LTBNOW SAVE NEW POINTER 16014000 LTD1RET $RETURN RGS=(R14-R0),SA=NO 16016000 DROP RE NO LONGER USING 16018000 EJECT 16020000 * * * * * LTZOVER IS ENTERED IF STORAGE OVERFLOW OCCURS, PASS 1 * 16022000 LTZOVER $GTAD REP,MOSTOP GET ADDR OF OVERFLOW ERROR EXIT 16024000 BR REP GO THERE, WILL EVENTAULLY PRINT 999 16026000 SPACE 1 16030000 **--> ENTRY: LTEND1 1 CLEANUP AFTER PHASE 1 PREPARE FOR PHASE 2 . . 16032000 *. THIS ENTRY SETS UP FOR ASSEMBLER PASS 2 LITERAL PROCESSING. . 16032500 *. USES MACROS: $RETURN,$SAVE . 16033000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16034000 LTEND1 $SAVE SA=NO 16036000 MVC LTBNOW,LTBFIRST RESET ORIG POINTER TO CURRENT ONE 16038000 $RETURN SA=NO 16040000 SPACE 2 16042000 **--> ENTRY: LTGET2 2 GET ADDRESS OF LITERAL IN ASSEMBLY. . . . . . 16044000 *. LTGET2 IS CALLED BY ICMOP2 EACH TIME A LITERAL IS FOUND IN . 16044100 *. SCANNING MACHINE INST OPERANDS DURING PASS 2. IT RETURNS THE . 16044200 *. ATTRIBUTES OF THE LITERAL, INCLUDING THE USER PROGRAM @ FOR . 16044300 *. THE LITERAL, THE SECTION ID OF THE LITERAL, AND THE LENGTH . 16044400 *. ATTRIBUTE OF THE LITERAL. ICMOP2 SUPPLIES A POINTER TO THE . 16044500 *. LTLENTRY OF THE LITERAL, WHICH HAD BEEN SAVED IN THE . 16044600 *. STATEMENT'S RCODBLK . . 16044700 *. ENTRY CONDITIONS . 16046000 *. RA = SCAN POINTER TO 1ST CHAR OF LITERAL = . 16048000 *. RC = @ LITERAL TABLE ENTRY IN LITERAL TABLE(WAS SAVED IN RCB) . 16050000 *. EXIT CONDITIONS . 16052000 *. RA = SCAN POINTER TO CHARACTER AFTER LITERAL . 16054000 *. RB = ESDID OF CSECT IN WHICH LITERAL EXISTS . 16056000 *. RC = ADDRESS OF LITERAL (PROGRAM ADDRESS-FOR LISTING,ETC) . 16058000 *. RD = IMPLIED LENGTH-1 OF THE LITERAL(LOW ORDER BYTE, OTHERS INDTR). 16060000 *. USES DSECTS: AVWXTABL,LTBASETB,LTLENTRY . 16060500 *. USES MACROS: $RETURN,$SAVE . 16061000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16062000 USING LTLENTRY,RC NOTE USING,ON ENTRANCE 16064000 LTGET2 $SAVE SA=NO 16066000 L RE,LTBNOW GET POINTER TO CURRENT LTBASETB 16068000 USING LTBASETB,RE NOTE THE USING HERE 16070000 SR RB,RB CLEAR FOR INSERT OF ESDID 16072000 IC RB,LTLCHARS GET LENGTH-1 OF LITERAL STRING 16074000 LA RA,1(RA,RB) BUMP SCAN POINTER PAST LITERAL 16076000 IC RB,LTBESDID GET THE ESDID OF LITERAL POOL 16078000 AIF (&$DEBUG).LTXS2 SKIP IF PRODUCTION 16080000 XSNAP STORAGE=(*LTLENTRY,*LTLITRAL),IF=(AVDEBUG,O,X'84',TM) 16082000 .LTXS2 ANOP 16084000 IC RD,LTLLEN GET LENGTH-1 BEFORE RC ERASED 16085000 LH RC,LTLOFSET GET OFFSET FROM LITERAL POOL BASE 16086000 A RC,LTBVALUE GET ACTUAL ADDRESS 16088000 LTG2RET $RETURN SA=NO 16092000 DROP RC,RE REMOVE THE USINGS 16094000 EJECT 16096000 **--> ENTRY: LTDMP2 2 DUMP LITERALS IN PASS 2 . . . . . . . . . . . 16098000 *. LTDMP2 IS CALLED BY IDASM2 DURING PASS 2, WHENEVER A LTORG . 16098100 *. OR END STMT IS FOUND, TO PRODUCE THE OBJECT CODE AND LISTING . 16098200 *. OF ANY LITERALS IN THE CURRENT LITERAL POOL. THE CURRENT . 16098300 *. POOL BASE POINTER IS ADVANCED TO THE NEXT LTBASETB. . 16098400 *. CALLS CNDTL2 . 16098500 *. USES DSECTS: AVWXTABL,LTBASETB,LTLENTRY . 16098600 *. USES MACROS: $CALL,$GLOC,$RETURN,$SAVE,$SLOC . 16100000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16102000 LTDMP2 $SAVE RGS=(R14-R6),SA=LTOPSAVE,BR=R13 16104000 SPACE 1 16106000 * * * * * REGISTER ALLOCATION AND USAGE FOR LTDMP2 * * * * * * * * * * 16108000 * R1 = @ CURRENT LTBASETB BEING PROCESSED. 1 IS DONE FOR EACH CALL. * 16110000 * R2 = BYTE REGISTER FOR INSERTIONS. * 16112000 * RW = @ LOOP HEAD FOR 1 LINK OF 1 LITERAL CHAIN. * 16114000 * RX = @ CURRENT LTLENTRY BLOCK BEING PROCESSED. * 16116000 * RY = -4 FOR BXH INDEX AND LIMIT VALUE. * 16118000 * RZ = OFFSET(0-4-8-12) TO LTBCH# POINTER OF LENGTH BEGIN DONE * 16120000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16122000 SPACE 1 16124000 * INITIALIZATION - SET UP FAKE RECORD PTRS,ETC. * 16126000 LA RA,LTRCODBL GET @ FAKE RCODBLK SET UP 16128000 ST RA,AVRCBPT SAVE THIS ADDRESS 16130000 LA RA,LTRSBLOC GET @ FAKE RSBLOCK 16132000 LA RB,LTRSCBLK GET @ FAKE RSCBLOCK 16134000 STM RA,RB,AVRSBPT STORE PTRS IN AVRSBPT-AVRSCPT 16136000 $GLOC R0 GET LOCATION COUNTER 16138000 L R1,LTBNOW GET @ NEXT LTBASETB 16140000 USING LTBASETB,R1 NOTE THE POINTER 16142000 SR R2,R2 BYTE REGISTER-CLEAR FOR INSERTS 16144000 L RY,AWFM4 GET -4 FOR BXH'ING 16146000 LA RZ,LTBCH8-LTBCH1 GET OFFSET FROM LTBCH1-DO LENGTH 8 16148000 EJECT 16150000 * PROCESS CHAINS OF LITERALS, IN ORDER OF LENGTH 8-4-2-1.* 16152000 * LTD2LRX ENTERD 4 TIMES,1 FOR EACH CHAIN OF LITERALS. * 16154000 LTD2LRX L RX,LTBCH1(RZ) GET NEXT POINTER FROM LTBASETB 16156000 USING LTLENTRY,RX NOTE POINTER 16158000 BAL RW,LTD2LTR GO CHECK FOR LITERALS OF THIS LENGTH 16160000 SPACE 1 16162000 * FOLLOWING CODE EXECUTED 1 TIME FOR EACH LITERAL IN POOL* 16164000 * PLACE LITERAL FOR PASS 2 SCAN AND PRINTING. * 16166000 LTD2LTL IC R2,LTLSCAN GET SCAN POINTER OFFSET FROM = TO CN 16168000 LA R2,LTRSBOPR-LTRSBLOC(R2) GET CORRECT OFFSET 16170000 STC R2,LTLSCAN SAVE WHERE CNDTL2 WILL EXPECT IT 16172000 IC R2,LTLCHARS GET #-1 OF CHARS IN LITERAL 16174000 MVC LTRSBLOC(3),LTRSBCO1 GET CODES FOR 1 CARD LITER 16176000 CLI LTLCHARS,55 ARE THERETOO MANY CHARS FOR 1 CARD 16178000 BNH *+10 SKIP IF ONLY 1 CARD NEEDED 16180000 MVC LTRSBLOC(3),LTRSBCO2 GET CODES FOR 2 CARDS 16182000 SPACE 1 16184000 STC R2,*+5 STORE LENGTH-1 INTO MVC 16186000 MVC LTRSBOPR($CHN),LTLITRAL MOVE LITERAL FROM TABLE 16188000 $SLOC R0 SET LOCATION COUNTER 16190000 MVC LTRCLOC,AVLOCNTR+1 MOVE LOCATION COUNTER INTO FK RCB 16192000 AH R0,LTLTOT ADD TOTAL LENGTH OF LITERAL TO LOC 16194000 SPACE 1 16196000 LA RB,1 SHOW CNDTL2 WE HAVE 1 OPERAND 16198000 LA RC,LTLTYP GET @ CNCBLOCK PART OF LTLENTRY 16200000 $CALL CNDTL2 HAVE CONSTANT PROCESSED,PRINTED 16202000 STC R2,*+5 SAVE LENGTH-1 INTP BLANKING MVC 16204000 MVC LTRSBOPR($CHN),AWBLANK+15+RSB$L BLANK,KEEPING BD 16206000 L RX,LTLINK GET @ NEXT LTLENTRY ON CHAIN 16208000 LA RX,0(RX) REMOVE 1ST BYTE IF ANY 16210000 SPACE 1 16212000 * CONTINUE LOOPING UNTIL LAST LITERAL FOUND ON CHAIN. * 16214000 * THEN DECREMENT TO NEXT CHAIN BEGINNING AND PROCESS IT. * 16216000 LTD2LTR LTR RX,RX WAS THIS LAST ONE ON CHAIN 16218000 BCR NZ,RW BNZ LTD2LTL - GO BACK FOR NEXT 16220000 BXH RZ,RY,LTD2LRX DONE WITH 1 CHAIN,GO ON TO NEXT 16222000 SPACE 1 16224000 MVC LTBNOW,LTBLINK MOVE POINTER TO NEXT LTBASETB OVER 16226000 LTD2RET $RETURN RGS=(R14-R6) RETURN TO CALLER 16228000 DROP R1,RX KILL USINGS 16230000 EJECT 16232000 * * * * * INTERNAL CONSTANTS * 16234000 LTEB1248 DC X'000400080004000C' OFFSETS TO LTBCH1-2-4-8 FOR LENGTHS 16236000 LTRSBCO1 DC AL1(RSB$LN1,$RCBX,1) CODES FOR FAKE RSBLOCK-1CD 16238000 LTRSBCO2 DC AL1(RSB$LN1+56,$RCBX+$RSCX,2) CODES FOR RSBLOCK-2 CARDS 16240000 SPACE 1 16242000 * FAKE RSCBLK, USED IF MORE THAN 1 CARD REQUIRED FOR LIT.* 16244000 LTRSCBLK DC AL1(1+2*RSC$LEN,71) RSCLEN,1ST RSCILEN FOR CONT/SEQ 16246000 DC CL9'X' CONTINUATION FLAG,SEQNO 16248000 DC AL1(56) LENGTH OF 2ND CARD IMAGE 16250000 DC CL9' ' SEQNO OF 2ND CARD IMAGE 16252000 SPACE 1 16254000 * * * * * INTERNAL VARIABLES * 16256000 LTBFIRST DS A @ FIRST LTBASETB IN EXISTENCE 16258000 LTBNOW DS A @ CURRENT LTBASETB BEING PROCESSED 16260000 SPACE 1 16262000 * FAKE RCODBLK-RCLOC WILL BE USED AS LOCATION COUNTER. * 16264000 LTRCODBL DS 0F LINE UP ON RIGHT BOUNDARY 16266000 DC X'7' RCLENG - LENGTH-1 OF BLOCK 16268000 LTRCLOC DS AL3 LOCATION COUNTER WILL BE PLACE HERE 16270000 DC F'0' FILL OUT BLOCK 16272000 SPACE 1 16274000 * FAKE RSBLOCK - WILL BE USED TO ASSEMBLE AND PRINT. * 16276000 LTRSBLOC DS 0D LINE UP 16278000 DS CL4 RSBLEN-RSBFLAG,RSBNUM,RSBSCAN BYTES 16280000 LTRSBSOU DC CL15' ' 15 BLANKS IN FRONT OF = 16282000 LTRSBOPR DC CL56' ' OPERAND FIELD, IF ONLY 1 CARD USED 16284000 DC CL56' ' CONTINUATION OF OPERAND FIELD 16286000 EJECT 16288000 **--> DSECT: LTBASETB LITERAL POOL BASE TABLE - 1 FOR EACH POOL . . . 16288050 *. ONE LTBASETB IS CREATED FOR EACH LITERAL POOL, BY LTINT1 OR . 16288100 *. LTDMP1. THE TOTAL # CREATED = # LTORGS + 2, WHICH INCLUDES . 16288150 *. 1 FOR THE END STMT, AND 1 EXTRA 1 FOR CODE SIMPLIFICATION. . 16288200 *. WHEN LTDMP1 IS CALLED, IT FILLS IN THE SECTION ID OF THE . 16288250 *. SECTION WHERE THE POOL WILL BE ASSEMBLED, THE BEGINNING @ OF . 16288300 *. THE POOL, AND THE OFFSET @ VALUES FROM THE BEGINNING @ TO . 16288350 *. EACH LITERAL IN THE POOL. IN ADDITION TO ADDRESS AND SECTION. 16288400 *. ID, THE LTBASETB ALSO CONTAINS THE LIST HEADS FOR 4 LISTS . 16288450 *. OF LITERAL ENTRIES (LTLENTRY BLOCKS). USED ONLY IN LTOPRS. . 16288500 *. LOCATION: HIGH END OF DYNAMIC AREA ($ALLOCH MACRO). . 16288550 *. NAMES: LTB----- . 16288600 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16288650 SPACE 1 16290000 LTBASETB DSECT 16292000 LTBLINK DS 0F ADDRESS OF NEXT LTB, =0 IF LAS 16294000 LTBESDID DS C ESDID OF CSECT IN WHICH OCCURS 16296000 LTBLINKA DS AL3 ACTUAL LINKA ADDRESS 16298000 LTBVALUE DS F ADDRESS OF LTORG OR END,D BOUNDARY 16300000 LTBCH1 DS A ADDRESS OF 1ST LTENRY FOR LENGTH 1 16302000 LTBCH2 DS A ADDRESS OF 1ST ENTRY FOR LENGTH 2 16304000 LTBCH4 DS A ADDRESS OF 1ST ENTRY FOR LENGTH 4 16306000 LTBCH8 DS A ADDRESS OF 1ST ENTRY FOR LENGTH 8 16308000 LTB$LEN EQU *-LTBASETB LENGTH OF 1 LITERAL BASE TABLE 16310000 EJECT 16310050 **--> DSECT: LTLENTRY LITERAL TABLE ENTRY FOR EACH LITERAL. . . . . . 16310100 *. 1 LTLENTRY BLOCK IS CREATED BY LTENT1 FOR EACH UNIQUE . 16310150 *. LITERAL IN A GIVEN LITERAL POOL. THE LTLENTRY BLOCKS ARE . 16310200 *. ORGANIZED IN 4 LINKED LISTS, WITH LIST HEADS IN THE CURRENT . 16310250 *. LTBASETB BLOCK. EACH LTLENTRY INCLUDES THE OFFSET FROM THE . 16310300 *. BEGINNING OF THE CURRENT LITERAL POOL @ (ENTERED BY LTDMP1), . 16310350 *. A COMPLETE CNCBLOCK DESCRIBING THE LITERAL CONSTANT, AND THE . 16310400 *. CONSTANT IN CHARACTER FORM. LTGET2 USES THESE BLOCKS TO . 16310450 *. DETERMINE THE USER PROGRAM ADDRESS FOR ANY DESIRED LITERAL, . 16310500 *. AND LTDMP2 USES THEM TO PRINT LITERAL POOL LISTING AND . 16310550 *. HAVE THE CODE ASSEMBLED FOR THE POOL. USED ONLY IN LTOPRS. . 16310600 *. LOCATION: HIGH END OF DYNAMIC AREA ($ALLOCH MACRO). . 16310650 *. NAMES: LTL----- . 16310700 *. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16312000 SPACE 1 16314000 LTLENTRY DSECT 16316000 LTLINK DS 0F ADDRESS OF NEXT ENTRY ON CHAIN 16318000 LTLCHARS DS C #-1 OF CHARACTERS IN LITERAL 16320000 LTLINKA DS AL3 ACTUAL POINTER TO NEXT LTLENTRY 16322000 LTLOFSET DS H OFFSET OF THIS LITERAL FROM BASE 16324000 SPACE 1 16325000 * FOLLOWING SECTION (INCLD LTLTOT) = 1 CNCBLOCK DSECT. 16325500 LTLTYP DS C CONSTANT TYPE+ FLAGS 16326000 LTLLEN DS C LENGTH-1 OF OPERAND 16328000 LTLSCAN DS C SCAN POINTER TO 1ST CONSTANT 16330000 LTLNUM DS C NUMBER OF CONSTANTS IN OPERAND 16332000 LTLDUP DS H DUPLICATION FACTOR 16334000 LTLTOT DS H TOTAL LENGTH OF OPERAND 16336000 LTL$LEN EQU *-LTLENTRY LENGTH OF CONSTANT SECTION 16338000 LTLITRAL DS C LITERAL, LENGTH ROUNDED UP TO F 16340000 DROP RAT,R13 KILL USINGS 16342000 TITLE '*** MOCON1 - MAIN CONTROL - ASSEMBLER PASS ONE ***' 16344000 **--> CSECT: MOCON1 1 MAIN CONTROL - ASSEMBLER PASS 1 . . . . . . . 16346000 *. MOCON1 PROVIDES OVERALL CONTROL FOR PASS 1 OF THE ASSIST . 16346050 *. ASSEMBLER, AND SUPERVISES OR PERFORMS THE FOLLOWING: . 16346100 *. 1. READING INPUT CARDS, CREATING RECORD BLOCKS (INCARD). . 16346150 *. 2. SCANNING LABELS, ENTERING THEM IN SYMBOL TABLE(SYENT1). . 16346200 *. 3. SCANNING CARD FOR THE OPCODE, IF ANY. . 16346250 *. 4. FINDING OPCODE IN OPCODE TABLE (OPFIND). . 16346300 *. 5. SCANNING FOR OPERAND FIELD, SAVING SCAN POINTER. . 16346350 *. 6. 2ND LEVEL INSTRUCTION PROCESSING (IAMOP1,IBASM1). . 16346400 *. 7. DEFINING ATTRIBUTES, VALUE OF LABEL, IF REQUIRED. . 16346450 *. 8. UPDATING LOCATION COUNTER TO NEXT LOCATION. . 16346500 *. 9. STORING RECORD BLOCKS FOR STMT (UTPUT1). . 16346550 *. . 16346560 *. NOTE: PRINT CONTROL/COMMENTS STMTS ARE PROCESSED COMPLETELY . 16346570 *. DURING PASS 1 AND NOT SAVED, IF POSSIBLE. . 16346580 *. . 16346590 *. CALLS ERRLAB,ERRTAG,IAMOP1,IBASM1,INCARD,OPFIND,SYENT1,UTPUT1. 16346600 *. CALLS OUTPT2 . 16346610 *. USES DSECTS: AVWXTABL,OPCODTB,RCODBLK,RSBLOCK . 16346650 *. USES MACROS: $CALL,$GLOC,$GTAD,$PRNT,$RETURN,$SAVE . 16346700 *. USES MACROS: $SCOF,$SDEF,$SLOC . 16346750 *. CALLS ERRLAB,ERRTAG,IAMOP1,IBASM1,INCARD,OPFIND,SYENT1 . 16348000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16350000 SPACE 1 16351000 MOCON1 CSECT 16352000 $DBG 90,* 16354000 ENTRY MOSTOP NOTE DISASTER ENTRY POINT 16356000 * * * * * REGISTER USAGE IN MOCON1 * * * * * * * * * * * * * * * * * * 16358000 * R0 CURRENTLY UNUSED. * 16360000 * R2 = BYTE REGISTER, USED FOR INSERTIONS * 16362000 * RW = ADDRESS OF RSBLOCK(NORMALLY IN AVWXTABL) * 16364000 * RX = ADDRESS OF SYMBOL TABLE ENTRY,IF ANY,SAME AS AVLABPT. * 16366000 * R5 = 1, USED FOR BXH'S,ETC. * 16368000 * RA = SCAN POINTER ADDRESS REGISTER * 16369000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16370000 SPACE 1 16372000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 16374000 $SAVE RGS=(R14-R6),BR=R13,SA=MOCOSAVE 16376000 LA R2,AVREBLK RECORD ERROR BLOCK 16378000 LA RW,AVRSBLOC RECORD SOURCE BLOCK 16380000 USING RSBLOCK,RW RECORD SOURCE BLOCK 16382000 LA RX,AVRSCBLK RECORD SOURCE CODE BLOCK 16384000 STM R2,RX,AVREBPT SORE THE ADDRESSES IN TABLE 16386000 SR R1,R1 CLEAR,SO TRT'S WILL WORK 16388000 LR R2,R1 CLEAR THIS FOR INSERTS 16390000 LA R5,1 INIT FOR BXH'S,ETC 16392000 MVI MOBACK+1,X'F0' MAKE THE BC A BRANCH,UNTIL END FOUND 16394000 AIF (NOT &$MACSLB).MONOMC1 16394500 XCALL XXXXLBED MAKE SURE XXXXSORC SWITCH SET NORMALLY 16395000 .MONOMC1 ANOP 16395500 EJECT 16396000 * MAIN LOOP - PASS 1. THRU MOSTINIT 1 TIME FOR EACH STMT.* 16398000 MOSTINIT EQU * LOOP HEAD FOR ALL STATEMENTS 16400000 SPACE 1 16400100 * IF TIME/RECORDS EXCEEDED, HALT PROCESSING NOW. 16400200 TM AVTAGS2,AJOASTOP WAS STOP BIT SET BY TIMER EXIT 16400300 BO MORET YES, QUIT 16400400 SPACE 1 16400500 $CALL INCARD GET NEXT SOURCE CARD 16402000 LTR RB,RB DID INCARD FIND AN ERROR 16402100 BZ MOSTINIV NO, SO DON'T FLAG IT 16402200 $CALL ERRTAG FLAG ERROR FOUND BY INCARD 16402300 SPACE 1 16402400 MOSTINIV EQU * 16402500 AIF (NOT &$MACROS).MONMC1 SKIP IF NO MACROS 16403000 TM RSBFLAG,$RSBNPNN+$RSBNP## DOES STMT NEED NO PROCESS 16403050 BNZ MOUTOUCK NO PROC - SKIP TO SAVE OR PRINT NOW 16403100 .MONMC1 ANOP 16403150 SR RX,RX CLEAR TO SHOW NO LABEL YET ENCOUNTER 16408000 LA RA,RSBSOURC SET UP ADDRESS FOR START SCAN 16410000 SPACE 1 16411000 * CHECK FOR COMMENT OR LACK OF LABEL ON STMT. 16411500 CLI RSBSOURC,C' ' IS THIS NORMAL SOURCE,NO LABEL 16412000 BE MONOLB YES,BRANCH TO HANDLE IT 16414000 CLI RSBSOURC,C'*' IS IT A COMMENT 16416000 BE MOCMSYSC SKIP TO CHK *SYSLIB POSSIBILITY 16418000 SPACE 1 16420000 * STATEMENT HAS A LABEL IF FALLS THRU HERE. * 16422000 CLI RSBSOURC,C'0' MAKE SURE BEGINNING OF SYMBOLILLEGAL 16426000 TRT RSBSOURC(9),AWTSYMT SCAN A SYMBOL 16428000 BZ MOLABR1 SYMBOL 9+ CHARACTERS LONG-ERROR 16430000 CLI 0(R1),C' ' IS DELIMITER BLANK LIKE SUPPOSED TO 16432000 BNE MOLABR2 NO IT ISNT==> ERROR-BRANCH 16434000 SPACE 1 16434500 * LEGAL LABEL FOUND. ENTER IN SYMBOL TABLE. CHECK FOR 16435000 * MULTIPLE DEFINITION, FLAG STMT IF SO. 16435500 LR RB,R1 MOVE POINTER TO BLANK OVER 16436000 SR RB,RA GET LENGTH OF SYMBOL 16438000 $CALL SYENT1 HAVE SYMBOL ENTERED OR LOOKED UP 16440000 LR RX,RA MOVE POINTER TO SYMBOL BACK OVER 16442000 USING SYMSECT,RX NOTE SYMBOL TABLE USING 16444000 TM SYFLAGS,$SYDEF WAS SYMBOL ALREADY DEFINED 16446000 BZ MOLABGO NO IT WASNHT-OK 16448000 MOLABMUL EQU * ENTER HERE IF MULTIPLE DEFINED LABEL 16449000 LA RB,$ERMULDF MULTUPLY-DEFINED SYMBOL 16450000 $CALL ERRLAB LABEL ERROR 16452000 MOLABGO LR RA,R1 MOVE POINTER TO BLANK AFTER LABEL 16454000 BXH RA,R5,MOOPC BUMP SCAN POINTER 1 AND BRANCH 16456000 SPACE 1 16458000 * THE FOLLOWING IS ENTERED IF THERE WAS NO LABEL * 16460000 MONOLB CLC RSBSOURC+1(8),AWBLANK HOPE THAT THESE COLS BLANK 16462000 BNE MOOPC NO THEY WERE'T,SKIP AND DO GENERALLY 16464000 LA RA,RSBSOURC+9 HAPPINESS-1ST 9 COLS BLANK 16466000 MOOPC ST RX,AVLABPT SAVE POINTER(IF LABEL) OR 0(IF NOT) 16468000 EJECT 16470000 * SCAN LOOP TO FIND OPCODE * 16472000 MOOPCA CLI 0(RA),C' ' IS THIS ANOTHER BLANK 16474000 BNE MOOPCB NO IT ISNT BLANK-BRANCH OUT 16476000 BXH RA,R5,MOOPCA BUMP SCAN POINTER AND CONTINUE 16478000 SPACE 1 16480000 * OPCODE IS FOUND-RA POINTS THERE. IF OMITTED,RA==> ' * 16482000 MOOPCB C RA,AVSOLAST COMPAE TO @ BLANK BEFORE ' AFTER 16484000 BNL MOOPNONE BRANCH OUT - - MISSING OPCODE 16486000 $CALL OPFIND LOOK UP TYPE OF OPCODE 16488000 LTR RB,RB WAS IT LEGAL 16490000 BNZ MOMACHK GO TO ERROR OR MACRO CHECK 16492000 USING OPCODTB,RC NOTE OPCODE TABLE POINTER 16494000 AR RA,R5 INCREMENT SCAN POINTER BY 1 16496000 LR RE,RA SAVE SCAN POINTER FOR LATER 16498000 SPACE 1 16500000 * SEARCH FOR OPERAND FIELD. * 16502000 MOOPRA CLI 0(RA),C' ' IS THIS STILL BLANK FIELD 16504000 BNE MOOPRB NO-BRANCH OUT-WE HAVE OPERAND FIELD 16506000 BXH RA,R5,MOOPRA BUMP SCAN POINT AND CONTINUE 16508000 SPACE 1 16510000 * FOUND FIRST NONBLANK CHAR IN OPERAND FIELD. TEST FOR 16512000 * OMITTED OPERAND, EITHER COMPLETELY OR SHOWN BY ,. 16512200 MOOPRB CLC 0(2,RA),=C', ' DOES HE SHOW OMITTED OPERAND 16512400 BNE MOOPRB2 NO,SO SKIP TO CHK FOR TOTAL OMIT 16512600 BXH RA,R5,MOOPRC BUMP SCAN PTR TO SHOW BLANK,FAKE OMI 16512800 SPACE 1 16513000 MOOPRB2 C RA,AVSOLAST CHK WITH @ BLANK BEFORE AFTERQUOTE 16514000 BL MOOPRC OPERAND EXISTS, BRANCH 16516000 LR RA,RE OMITTED,SO REPLACE ADDR OF 1ST BLNK 16518000 MOOPRC $SCOF RE,RA,RSBSCAN PLACE SCAN POINTER 16520000 SPACE 1 16521000 * MAKE TYPE TEST TO DETERMINE WHICH 2ND LEVEL PROCESSOR. 16521500 TM OPCTYPE,$IB MAKE TEST FOR TUPE OF OPCODE 16522000 BZ MOCALLIA BRANCH TO CALL MACHINE INSTRUCTIONS 16524000 BO MOCALLIB CALL ASSEMBLER INSTS 16528000 AIF (NOT &$SPECIO).MONS SKIP IF NO SPECIALS 16530000 AIF (NOT &$MACROS).MOSPNM SKIP IF SPECIALS,NO MACROS 16532000 TM OPCTYPE,$IS WAS INSTRUCTION A SPECIAL 16534000 BZ MOCALLMA BRANCH TO CALL MACRO1 16536000 .MOSPNM IC R2,OPCTYPE GET TYPE OF OPCODE 16538000 SLL R2,2 MULT BY 4 FOR ADDRESS 16540000 $GTAD REP,SPECAD-4*$IS(R2) GET RIGHT ADDRESS 16542000 B MOCALLXX GO TO CALL SECTION 16544000 .MONS AIF (NOT &$MACROS).MONSM SKIP IF NO MACROS 16546000 MOCALLMA TM AVTAGSM,AJOMACRO ARE WE IN MACRO MODE 16547000 BZ MOOPNONE NO, FALG AS UNDERINFED OPCODE 16547500 MOCALLMC EQU * ENTRY FROM OPEN CODE CHECK J 16547800 $CALL MACRO1 CALL THE MACRO DEFINITOON PROCESSOR 16548000 B *+4(RB) TAKE INDEXED BRANCH ACCORDINGLY 16549000 B MOSTINIT NORMAL RETURN - GO BACK FOR NEXT CRD 16549500 B MOSTINIV NO, PROB AIF-AGO - CARD ALREADY EXIS 16550000 B MOPUT ERROR ALREADY FLAGGED, GO TO SAVE 16550010 .MONSM ANOP 16552000 SPACE 1 16554000 MOCMSYSC EQU * COME HWERE FOR ALL COMMENT CARDS 16554500 AIF (NOT &$MACSLB).MONSYS1 SKIP IF NO MACRO LIBRARY 16554600 CLC RSBSOURC+1(6),=C'SYSLIB' WAS THIS *SYSLIB CARD 16554700 BE MOCOMSYS GO TO CHECK AND PROCESS IT 16554800 .MONSYS1 ANOP 16554900 AIF (NOT &$XREF).NOXRF12 A 16554905 * CHECK FOR *XREF CARD A 16554910 CLC RSBSOURC+1(4),=C'XREF' IS IT XERF A 16554920 BNE MOUTOUCK NO GO ON A 16554930 LA RA,RSBSOURC+5 FOR ENTRY TO XRSCAN (@ TO BEGIN) L 16554935 SR RD,RD CLEAR FOR PROPER ENTRY CONT L 16554940 $CALL XRSCAN CALL SCANNING ROUTINE A 16554950 .NOXRF12 ANOP A 16554960 SPACE 1 16555000 * BRANCH HERE TO DETERMINE WTHER STMT SHOULD BE SAVED VIA 16555100 * UTPUT1, OR PRINTED IMMEDIATELY AS A COMMENT TYPE. 16555200 MOUTOUCK TM AVPRINT1,AVPRSAVE MUST WE SAVE THE CARD 16555300 BO MOPUT YES, SO GO DO IT 16555400 MOOUCOMM LA RB,$OUCOMM SHOW COMMENT TYPE ( NO LC CTR) 16555500 B MOIBOUTA GO TO PUT IT OUT TO LISTING 16555600 * ASSEMBLER INSTRUCTIONS * 16556000 MOCALLIB EQU * PROCESSING FOR ASSEMBLER OPS FOLLOWS 16556030 AIF (NOT &$MACOPC).MOIBA SKIP ID NO OPEN CODE J 16556035 BAL R14,MOOPAMPC GO CHECK FOR SUBSTITUTE OF EVAR J 16556040 .MOIBA ANOP J 16556045 $CALL IBASM1 CALL ASSEMBLER OPS PROCESSOR 16556060 USING RCODBLK,RC IBASM1 RETURNED PTR TO BLK IN RC 16556090 L RX,AVLABPT RELOAD PTR: IF EQU, MAY NOW BE = 0 16556120 TM RCHEX,IBMOSPEC+IBMOPRCT WAS SPECIAL OF ANY KIND 16556150 BZ MOCALLXX NO, SO SKIP TO COMPLETE PROCESSING 16556180 * FALL THRU ==> SOME SPECIAL KIND OF HANDLING NEEDED. 16556210 BM MOCASEND AT PRSENT, THIS COND ==> END CARD-B 16556240 SPACE 2 16556270 * SPECIAL HANDLING: BYPASS PASS 2 PROCESSING. * 16556300 * DURING PASS 1, IT IS POSSIBLE TO PROCESS A STMT COMPLETELY, * 16556330 * INCLUDING PRINTING IT, UNTIL ANY STMT EXCEPT ONE OF THE FOLLOWING * 16556360 * IS FOUND IN THE INPUT STREAM: * 16556390 * COMMENT CARD, PRINT, SPACE, EJECT, TITLE. * 16556420 * MACRO DEFINITIONS, GBL OR LCL IN OPEN CODE. * 16556450 * THESE STMTS CAN BE COMPLETELY PROCESSED, THUS SAVING SPACE * 16556480 * AND TIME. THE SECTIONS OF CODE BELOW HANDLE THIS. * 16556510 SPACE 1 16556540 TM AVPRINT1,AVPRSAVE MUST WE SAVE RATHER THAN FINISH 16556570 BO MOCALLXY YES, BRANCH, MUST SAVE IT 16556600 SPACE 1 16556630 * PROCESS PRINT CONTROL STMTS: SEE CORRESPOND IDASM2 CODE. 16556660 * NOTE: SOME ERROS IN PRINT WILL CAUSE PRINT ON,NOGEN. 16556690 CLI RCTYPE,$IB+$ITITLE IS THIS ACTUALLY TITLE STMT 16556780 BNE MOIBPR1 NO, BRANCH FOR NEXT CHECK 16556810 SR RB,RB YES, WAS TITLE; CLEAR FOR INSERT CP 16556840 IC RB,RCMASK GET LENGTH-1 OF TITLE CPP 16556870 $SCPT RA,RSBSCAN GET SCAN POINTER BACK CPP 16556930 AR RA,R5 (R5=1) RA=>1ST BYTE TITLE CPP 16556960 $CALL CCCON2 ASSEMBLE AS IF C-TYPE CONST. CPP 16556965 * RETURNS: RC=> ASSEMBLED TITLE, RD=LEN-1 OF TITLE CPP 16556970 LA RE,4 SHOW THIS WAS A TITLE CPP 16556975 B MOIBOUTL BRANCH TO PRINT OR STORE TITLE CPP 16556980 SPACE 1 16556990 MOIBPR1 CLI RCTYPE,$IB+$IPRINT WAS IT ACTUALLY PRINT STMT 16557020 LA RC,RCMASK @ CONTROL BYTE(PRINT,SPACE,EJECT) 16557050 LA RE,2 SHOW THIS WAS A PRINT STMT. CPP 16557070 BE MOIBOUTL WAS PRINT; ALL REGS SET, PRINT CPP 16557080 SR RE,RE FALL THRU==> SPACE OR EJCT, RESET =0 16558000 MOIBOUTL LA RB,$OULIST SHOW THIS WAS A LISTING CTRL CPP 16559000 SPACE 1 16560000 * IMMEDIATE PRINT CONTROL: CALL PRINT ROUTINE. 16562000 MOIBOUTA $CALL OUTPT2 REGS RB,RC,RD,RE ALREADY SET UP 16564000 B MOSTINIT GO BACK, PICK UP NEXT STMT 16566000 SPACE 1 16568000 MOCASEND EQU * COME HERE FOR END CARD 16570000 MVI MOBACK+1,0 MAKE BRANCH A NOOP SO WE FALL THROUG 16572000 B MOCALLXX GO CALL ROUTINE 16574000 DROP RC NOTE NO LONGER USING RC BLOCK 16576000 SPACE 1 16578000 * MACHINE OPCODES * 16580000 MOCALLIA EQU * COME HERE FOR MACHINE OPS J 16581000 AIF (NOT &$MACOPC).MOIAA J 16581500 BAL R14,MOOPAMPC GO CHECK FOR SUBSTITUTEION OF &VAR J 16582000 .MOIAA ANOP J 16582500 $CALL IAMOP1 CALL MACHINE OP PROCESSOR J 16583000 EJECT 16584000 * CALL THE 2ND LEVEL PROCESSOR ROUTINE REQUIRED. * 16586000 MOCALLXX EQU * 16588000 MOCALLXY EQU * SKIP HERE IF AVPRINT1 SET ALREADY 16589000 USING RCODBLK,RC RC--> RCB OF 2ND LEVEL ROUTINE 16590000 SPACE 1 16591000 * FINISH CREATION OF RCODBLK,ADDING LOC.COUNTER VALUE. 16591500 OI RSBFLAG,$RCBX NOTE THAT AN RCB EXISTS NOW 16592000 $GLOC RE GET LOCATION COUNTER 16594000 MVC RCLOC,AVLOCNTR+1 MOVE THE LOCATION COUNTER IN 16596000 SPACE 1 16597000 * DEFINE STMT LABEL, IF ANY, IF NOT ALREADY DEFINED. 16597500 LTR RX,RX IS THERE A LABEL ON STATMENT 16598000 BZ MONOLB2 NO,SKIP DEFINING IT 16600000 TM SYFLAGS,$SYDEF HAS THIS BEEN DEFINED YET 16602000 BO MONOLB2 YES,DON'T REDEFINE IF ALREADY 16604000 IC R14,AVCESDID GET ESDID 16606000 IC RB,RCLQ GET LENGTH ATTRIBUTE 16608000 $SDEF RE,R14,RB DEFINE THE SYMBOL 16610000 SPACE 1 16611000 * INCREMENT LOCATION COUNTER BY LENGTH OF THIS STMT. 16611500 MONOLB2 AR RE,RD ADD INCREMENT TO LOCATION COUNTER 16612000 $SLOC RE 16614000 ST RC,AVRCBPT SAVE ADDR OF RCB 16616000 AIF (&$DEBUG).MONOXS SKIP IF PRODUCION 16618000 XSNAP STORAGE=(*0(RC),*12(RC),*AVLOCNTR,*AVDWORK1-1),T=NO, #16620000 IF=(AVDEBUG,O,X'88',TM) 16622000 .MONOXS ANOP 16624000 SPACE 1 16630000 MOPUT $CALL UTPUT1 OUTPUT THE EXPANDED RECORDS 16632000 MOBACK BC $CHN,MOSTINIT B MOSTINIT UNTIL END-BECOMES NOOP 16634000 SPACE 1 16635000 MORET $RETURN RGS=(R14-R6) 16636000 EJECT 16638000 **--> ENTRY: MOSTOP CALLED IF DISASTROUS ERROR OCCURS IN PASS 1 . . 16638500 *. RESTORES CONDITIONS FOR MOCON1, NOTE OVERFLOW OCCURRENCE. . 16639000 *. ENDS EXECUTION FOR PASS 1, FLAGGING PROGRAM NONEXECUTABLE. . 16639500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16641500 USING MOSTOP,REP NOTE TEMPORARY USING 16642000 MOSTOP L R13,=A(MOCOSAVE) GET @ SAVE AREA,BAS REG 16644000 DROP REP KILL TEMPORARY USING,BACK TO NORMAL 16646000 OI AVTAGS3,AVOVERFL SHOW OVERFLOW OCCURRED. 16652000 B MORET RETURN TO MAIN CONTROL 16654000 AIF (NOT &$MACOPC).MOAMP1 J 16654100 SPACE 1 J 16654110 **--> INSUB: MOOPAMPC CHECK STATEMENT FOR SET VARIABLE SUBSTITUTION *J 16654120 *+ ENTRY CONDITIONS: +J 16654130 *+ RA= @ OPERAND FIELD / UNCHENGED ON EXP +J 16654140 *+ R14 = RETURN ADDRESS +J 16654150 *+ EXIT CONDITIONS +J 16654160 *+ RETURN IF NO POSSIBLE SUBSTITUTION +J 16654170 *+ -->MOCALLMC IF SUBSTITUTION POSSIBLE +J 16654180 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +J 16654190 MOOPAMPC TM AVMTAG00,AVMOPENC HAVE SET VARS FOUND ALRESDY J 16654200 BCR Z,RET NO, NO SUBSTITUTION POSSIBLE J 16654210 TM RSBFLAG,$RSBGENR GENERATE STATMENT J 16654220 BCR O,RET YES, CAN'T SUBSTITUTE AGAIN J 16654230 IC R2,RSBLENG GET LENGTH-1 OF WHOLE STMT J 16654240 SH R2,=AL2(RSB$L) GET LENGTH-1 OF STMT J 16654250 STC R2,MOOPAMPT+1 PUT L-1 INTO TRT J 16654260 $SETRT ('&&',4) FLAG TO STOP ONE J 16654270 MOOPAMPT TRT RSBSOURC($),AWTZTAB SCAN FOR & J 16654280 $SETRT ('&&',0) REZERO J 16654290 BCR Z,RET NO SUBSTITUTION-RET J 16654300 LA RC,AWZEROS SHOW @ ZEROS: MACRO WANTS THIS J 16654310 B MOCALLMC GO TO CALL MACRO1 TO SCAN J 1665432- .MOAMP1 ANOP J 16654330 SPACE 1 16656000 * * * * * OUT-OF-LINE ERROR PROCESSING SECTIONS * * * * * * * * * * * * 16657000 SPACE 2 16657500 * ERROR IN LABEL - FLAG, MOVE SCAN PTR TO 1ST BLANK. 16658000 SPACE 1 16658100 MOLABR2 EQU * 16658200 AIF (NOT &$MACOPC).MOLABR J 16658300 * IF MACROS MAY BE PRESENT, CHECK FOR SEQUENCE SYMBOL. 16658400 TM AVTAGSM,AJOMACRO ARE WE IN MACRO RUN A 16658500 BZ MOLABR2B NO, SO ERROR FOR SURE 16658600 TRT RSBSOURC+1(8),AWTSYMT SCAN SYMBOL 16659400 BZ MOLABR1 TOO LONG, ERROR 16659500 CLI 0(R1),C' ' TERMINATE PROPERLY 16659600 BNE MOLABR2B NO ERROR FLAG IT J 16659610 TM RSBFLAG,$RSBGENR WAS IT GENERATED J 16659620 BO MOLABGO YES,SO IGNOR LABEL J 16659630 CLI 0(RA),C'&&' SET VARIABLE J 16659640 BE MOLABGO YES,CONTINUE J 16659650 CLI 0(RA),C'.' SEQUENCE SYMBOL? A 16659660 BNE MOLABR2B NO ERROR J 16659670 CLI 1(RA),C'0' CHECK FOR LEGALITY J 16659680 BNL MOLABR2B BAD-1ST CHAR IS DIGIT J 16659690 * LEGAL SET SYMBOL-PLACE IT IN SYMBOL TABLE J 16659700 LR RB,R1 @ TERMINATOR BLANK J 16659710 SR RB,RA GET LENGTH J 16659720 $CALL SYENT1 HAVE SYMBOL LOOKED UP J 16659730 USING SYMSECT,RA NOT PTR J 16659740 TM SYFLAGS,$SYDEF YES ERROR J 16659750 BO MOLABMUL YES ERROR J 16659760 OI SYFLAGS,$SYDEF SHOW DEFINED NOW J 16659770 B MOLABGO CONTINUE AS USUAL J 16659780 DROP RA ZAP USING J 16659790 SPACE 1 16659800 * DEFINITE ILLEGAL LABEL FIELD. 16659900 .MOLABR ANOP 16660000 MOLABR2B LR RA,R1 INVALID CHARACTER, SHOW SCAN PTR 16661000 MOLABR1 LA RB,$ERINVSY INVALID SYMBOL 16662000 $CALL ERRTAG FALG IT 16664000 MOLABLP CLI 0(RA),C' ' SEARCH FOR BLANK 16666000 BE MOOPC FOUND BLANK AFTER SYMBOL-BRANCH 16668000 BXH RA,R5,MOLABLP BUMP SCAN POINTER AND CONTINUE 16670000 SPACE 1 16680000 * MISSING OPERATION CODE ERROR. 16681000 MOOPNONE LA RA,RSBSOURC+9 POINT WHERE OPCODE SHOULD BE 16682000 LA RB,$ERIVOPC OMITTED OPCODE 16684000 B MOERRORA GO HAVE IT FLAGGED 16686000 SPACE 1 16688000 MOMACHK EQU * DEFINE LABEL, EITHER MACRO CHECK, ER 16690000 AIF (NOT &$MACROS).MONMAC SKIP IF NO MACROS 16692000 * THIS CODE ENTERED IF UNRECOGNIZED OPCODE. AT THIS PT, 16692100 * RB = $ERIVOPC, SET BY OPFIND. MAKE SURE STMT WAS NOT 16692200 * ALREADY A GENERATED ONE. CALL MEXPND TO SEE IF MACRO. 16692300 TM AVTAGSM,AJOMACRO ARE WE IN MACRO MODE 16692350 BZ MOERRORA NO, FLAG AS UNDEFINED OPCODE 16692360 BAL R14,MOOPAMPC CHECK FOR SUBSTITUTION OF &VAR S 16692400 $CALL MEXPND CALL TO EXPAND MACROS 16694000 *********CODE MAY BE REQUIRED TO SHOW WE ARE IN EXPANSION MODE * 16696000 LTR RB,RB WAS THE MACRO KNOWN 16698000 BZ MOSTINIT OK,BRANCH IF OS 16700000 .MONMAC ANOP 16702000 SPACE 1 16703000 * GENERAL 1-STMT UNRECOVERABLE ERROR SECTION. 16703500 MOERRORA $CALL ERRTAG HAVE ERROR FLAGGED 16704000 B MOUTOUCK GO TO CHK PRINT/SAVE OPTION 16706000 SPACE 1 16707000 EJECT 16707030 AIF (NOT &$MACSLB).MONOMC2 16707035 * . . . . MOCOMSYS SECTION . . . . . . . . . . . . . . . . . . . . . 16707040 * . 16707045 * THIS SECTION OF MOCON1 IS CALLED WHENEVER A '*SYSLIB CARD . 16707050 * HAS BEEN FOUND. IT COORDINATES THE ACTIVITIES OF MACRO . 16707055 * LIBRARY PROCESSING AND THE MACRO PROCESSOR . 16707060 * . 16707065 * ENTRY CONDITIONS: . 16707070 * REGISTER RA --> SCAN POINTER TO SYSLIB CARD . 16707075 * . 16707080 * EXIT CONDITIONS: . 16707085 * REGISTERS UNCHANGED . 16707090 * . 16707095 * USES MACROS: . 16707100 * $CALL, $ALLOCL . 16707105 * . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16707110 SPACE 2 16707115 MOCOMSYS STM RA,RE,MOCOMSVE SAVE CONDITION OF WORK REGISTERS 16707120 MVC MOCPRTSV,AVPRINT SAVE CURRENT PRINT STATUS 16707125 TM AVTAGSM,AJOMACRO RETURN IF MACRO DISENABLED 16707130 BZ MOUTOUCK NOT MACRO MODE GO TO PRINT CARD 16707135 TM AVPRINT1,AVPRSAVE IS SYSLIB CARD IN LEGAL POSITION 16707140 BO MOCLBER1 IN ERROR--GO THERE TO FINISH 16707145 AIF (NOT &$MACOPC).MOMXX1 SKIP IF NO OPEN CODE 16707150 TM AVMTAG00,AVMOPENC HAVE GBLX, LCLX BEEN FOUND 16707155 BO MOCLBER1 YES, ERROR - FLAG IT 16707160 .MOMXX1 ANOP 16707165 LA RA,7(RA) SYSLIB LEGAL-INCREMENT POINTER PAST 16707170 * SYSLIB TO THE FOLLOWING BLANK 16707175 SPACE 1 16707180 * SCAN AND SKIP BLANKS TILL FIRXT SYMBOL OF NAME FOUND 16707185 MOCBLNK CLI 0(RA),C' ' IS THIS A BLANK 16707190 BNE MOCLBSC NO BRANCH OUT TO CONTINUE 16707195 BXH RA,R5,MOCBLNK BUMP SCAN POINTER AND CONTINUE 16707200 SPACE 1 16707205 MOCBUMP LA RA,1(R1) KICK PAST A LEGAL DELIMITER 16707210 MOCLBSC LR R1,RA MOVE POINTER OVER FOR ERROR FLUSH 16707215 C RA,AVSOLAST IS SYSLIB CARD BLANK 16707220 BNL MOCNLSYS YES--> SO SKIP NAME SCAN CODE 16707225 CLI 0(RA),C'0' DOES NAME START WITH LEGAL CHARACTE 16707230 BNL MOCLBER2 NOT LEGAL STARTING CHARACTER 16707235 TRT 0(9,RA),AWTSYMT SCAN THE NAME 16707240 BZ MOCLBER2 NAME TOO LONG--ERROR 16707245 LR RB,R1 MOVE BLANK POINTER OVER 16707250 SR RB,RA GET LENGTH OF NAME 16707255 SR RB,R5 DECREMENT FOR LENGTH-1 OF NAME 16707260 MVC AVMSYMBL,AWBLANK BLANK OUT SEARCH AREA 16707265 EX RB,MOCMVEL MOVE NAME INTO SEARCH AREA 16707270 L RC,AVMACLIB SET UP TO SEARCH LIST WITH MACFND 16707275 BAL RD,MOCLOOK SEARCH LIST FOR NEW NAME 16707280 LTR RB,RB SET CC ON RETURNED MAGNITUDE OF RB 16707285 BNZ MOCNMADD NOT FOUND- PUT NAME IN THE LIST 16707290 MOCNAMNT CLI 0(R1),C',' IF LEGAL NAME DELIMITER LOOP FOR ALL 16707295 * NAMES 16707300 BE MOCBUMP LOOP FOR ALL NAMES 16707305 CLI 0(R1),C' ' IS SCAN CHARACTER A BLANK 16707310 BNE MOCLBER3 NOT BLANK OR COMMA--ERROR INVALID 16707315 * DELIMITER 16707320 MOCNLSYS LA RB,$OUCOMM SET TO PRINT A COMMNNT 16707325 $CALL OUTPT2 PRINT STATEMENT AND ANY ERRORS 16707330 L RC,AVMACLIB GET BEGIN ADDRESS OF MACRO LIST M 16707331 USING MACLIB,RC NOTE USING ON MACRO LIST DSECT M 16707332 SR RB,RB ZERO FOR SEARCH END LIST M 16707333 CL RB,MCLIBNXT IF LIST HEADER IS NULL M 16707334 BE MOCLBOUT THEN NO OPEN - JUST QUIT M 16707335 DROP RC CLEAR USING M 16707336 XCALL XXXXLBOP CALL TO OPEN LIBRARY DCB M 16707337 BM MOCLBER4 NO--SET UP ERROR 16707340 SPACE 2 16707345 TM AVTAGSM,AJOLIBMC SHOULD WE PRINT MACRO DEFINITIONS 16707350 BO *+8 NO -- PROCESS NORMALLY 16707355 NI AVPRINT,255-$IBPON TURN PRINT STATUS OFF 16707360 SPACE 1 16707365 MOCLBMOR L RC,AVMACLIB GET BEGIN ADDRESS OF MACRO LIST 16707370 USING MACLIB,RC NOTE USING ON MACRO LIST DSECT 16707375 SR RB,RB ZERO FOR SEARCH END TEST 16707380 CL RB,MCLIBNXT IF LIST HEADER IS NULL 16707385 BE MOCLBOUT THEN NOTHING TO DO -- GO HOME 16707390 L RC,MCLIBNXT ELSE START LIST SCAN 16707395 B MOCLBFD2 SKIP TO LOOK AT FIRST ENTRY 16707400 MOCLBFD1 L RC,MCLIBNXT GET @ OF NEXT ENTRY 16707405 MOCLBFD2 TM MCLBTAGS,AVMCLBDF PREVIOUSLY DEFINED? 16707410 BO MOCLBFD5 DEFINED -- GO LOOK AT NEXT ENTRY 16707415 TM MCLBTAGS,AVMCLBNF PREVIOUSLY SEARCHED FOR 16707420 BNO MOCLBFND N/- GO DO FIND AND MACRO DEFINITION 16707425 MOCLBFD5 CL RB,MCLIBNXT IS THIS FINAL ENTRY 16707430 BNE MOCLBFD1 NO--LOOK AT NEXT 16707435 SPACE 5 16707440 MOCLBSP XCALL XXXXLBED CALL LIBRARY ENDUP ROUTINE 16707445 L RC,AVMACLIB GET BEGIN @ OF MACRO LIST 16707450 SR RB,RB ZERO FOR SEARCH EBD TEST 16707455 B MOCLBFD4 SKIP TO LOOK AT FIRST ENTRY 16707460 MOCLBFD3 L RC,MCLIBNXT GET @ OF NECT ENTRY 16707465 MOCLBFD4 TM MCLBTAGS,AVMCLBDF HAS THIS MACRO BEEN DEFINED 16707470 BO MOCLBMR1 DEFINED -- SKIP ERROR SET 16707475 MVC MOCER7MS+10(8),MCLBNAM MOVE BAD NAME INTO MESS 16707480 BAL RE,MOCLBER7 GO TO MARK NAME AS ERROR 16707485 MOCLBMR1 CL RB,MCLIBNXT IS THIS FINAL ENTRY 16707490 BNE MOCLBFD3 NO--CONTINUE SEARCH 16707495 SPACE 2 16707500 MOCLBOUT MVC AVPRINT,MOCPRTSV RESTORE THE PRINT STATUS 16707505 LM RA,RE,MOCOMSVE RESTORE REGISTER TO PREVIOUS CONDIT 16707510 SPACE 2 16707515 B MOSTINIT RETURN FOR NEXT SOURCE CARD 16707520 SPACE 2 16707525 MOCLBFND MVC AVMSYMBL,MCLBNAM MOVE NAME INTO WORK AREA FOR FIND 16707530 OI MCLBTAGS,AVMCLBNF MARK NAME AS SEARCHED FOR 16707535 XCALL XXXXFIND CALL FIND ROUTINE 16707540 BM MOCLBMOR ERROR NOT FOUND -- MESSAGE WILL 16707545 * COME OUT LATER 16707550 DROP RC KILL USING 16707555 MOCLIBNI $CALL INCARD CALL INCARD TO READ FROM MACRO 16707560 * LIBRARY 16707565 LTR RB,RB TEST MAGNITUDE OF RETURN REGISTER 16707570 BNZ MOCLBER5 ERROR ON NON-ZERO VALUE 16707575 LA RC,MOCMAC GET OPCODTB ENTRY FOR MACRO 16707580 $CALL MACRO1 START MACRO DEFINITION PHASE 16707585 B MOCLBMOR GO BACK TO PICK UP REST OF NAMES 16707590 SPACE 2 16707595 * ERROR ROUTINES FOLLOW 16707600 SPACE 2 16707605 MOCLBER1 LA RB,$ERSTMNA SET ERROR-SYSLIB OUT OF ORDER 16707610 $CALL ERRTAG CALL TO SET ERROR FLAG BIT 16707615 $CALL UTPUT1 SEND ILLEGAL CARD OUT 16707620 B MOCLBOUT RETURN 16707625 SPACE 2 16707630 MOCLBER2 BAL RB,MOCERALL GO FOR COMMON ERROR CODE 16707635 DC AL2($ERINVSY) DEFINE ERROR--INVALID SYMBOL 16707640 SPACE 2 16707645 MOCLBER3 BAL RB,MOCERALL GO FOR COMMON ERROR CODE 16707650 DC AL2($ERINVDM) DEFINE ERROR--INVALID DELIMITER 16707655 SPACE 2 16707660 MOCLBER4 MVC RSBLENG(RSB$L+MOCER4LN+1),MOCER4ST MOVE ERROR IN 16707665 LA RB,$OUCOMM SET COMMENT FLAG A 16707667 $CALL OUTPT2 PRINT ALLREADY DEFINED ERROR 16707670 B MOCLBOUT RETURN 16707675 SPACE 2 16707680 MOCLBER5 $CALL ERRTAG SET ERROR BIT-DEFINED BY INCARD 16707685 B MOCCOM GO FOR COMMON RETURN CODE 16707690 SPACE 2 16707695 MOCLBER7 MVC RSBLENG(RSB$L+MOCER7LN+1),MOCER7ST MOVE THE ERROR IN 16707700 MOCCOM LA RB,$OUCOMM SET TO PRINT A COMMENT 16707705 $CALL OUTPT2 PRINT THE MESSAGE 16707710 SR RB,RB ER-ZERO RG TO CONTINUE 16707715 BR RE RETURN TO CALLER 16707720 MOCERALL LH RB,0(,RB) GET THE ERROR FLAG FOR ERRTAG 16707725 LR RA,R1 MOVE BAD CHAR POINTER OVER 16707730 $CALL ERRTAG CALL TO SET ERROR BIT 16707735 B MOCNLSYS ON BAD CHAR -- PROCESS WHAT THERE 16707740 * IS UP TO THIS POINT 16707745 SPACE 5 16707750 USING MACLIB,RC NOTE USING ON MACRO LIST 16707755 MOCLOOK SR RB,RB ZERO WORK REG FOR END TEST 16707760 B MOCLOOK2 SKIP FIRST LINK JUMP 16707765 MOCLOOK1 L RC,MCLIBNXT LINK TO NEXT ENTRY 16707770 MOCLOOK2 CLC AVMSYMBL,MCLBNAM IS THIS THE ONE WE ARE LOOKING FOR 16707775 BE MOCLKRT YESYES -- GO BACK TO PRCESS 16707780 CL RB,MCLIBNXT IS THIS THE LAST ENTRY 16707785 BNE MOCLOOK1 NO -- LINK TO THE NEXT ENTRY 16707790 LA RB,$ERUNDEF NAME NOT IN LIST INDICATE THIS 16707795 MOCLKRT BR RD RETURN TO CONTINUE 16707800 SPACE 2 16707805 MOCNMADD LA RE,$LMACLIB GET LIST ENTRY LENGTH 16707810 $ALLOCL RB,RE,MOCLBOUT GET LIST SPACE 16707815 ST RB,MCLIBNXT LINK LIST TO NEW ENTRY 16707820 DROP RC CLEAR USING 16707825 USING MACLIB,RB NOTE USING ON MACLIB DSECT 16707830 MVC MACLIB($LMACLIB),AWZEROS ZERO NEW ENTRY 16707835 MVC MCLBNAM,AVMSYMBL MOVE NAME INTO LIST 16707840 DROP RB KILL USING 16707845 SR RB,RB REZERO REGISTER TO CONTINUE 16707850 B MOCNAMNT CONTINUE SCAN FOR NEW NAMES 16707855 SPACE 2 16707860 MOCOMSVE DS 5F TEMP REGISTER SAVE AREA 16707865 MOCPRTSV DS C SAVE BYTE FOR PRINT STATUS 16707870 MOCMVEL MVC AVMSYMBL($),0(RA) VARIABLE LENGTH NAME MOVE 16707875 MOCMAC DC AL1($IM,$MACRO,0) SEE OPG CALL TO MACRO 16707880 MOCER4ST DC AL1(RSB$L+MOCER4LN,$RSBMERR,1,0) DEFINE THIS ERROR 16707885 MOCER4MS DC C'289 UNABLE TO OPEN MACRO LIBRARY: OPTION CANCELED' 16707890 MOCER4LN EQU *-MOCER4MS LENGTH OF THE MESSAGE 16707895 MOCER7ST DC AL1(RSB$L+MOCER7LN,$RSBMERR,1,0) DEFINE THIS ERROR 16707900 MOCER7MS DC C'288 MACRO COULD NOT BE FOUND' 16707905 MOCER7LN EQU *-MOCER7MS GET LENGTH OF THE MESSAGE 16707910 .MONOMC2 ANOP 16707915 LTORG 16708000 DROP RAT,R13,RW,RX CLEAN UP USINGS 16710000 TITLE '*** MPCON0 - ASSIST ASSEMBLER MAIN CONTROL PROGRAM ***' 16712000 **--> CSECT: MPCON0 0 MAIN PROGRAM CONTROL-INIT,SET UP TABLES,ETC.. 16714000 *. MPCON0 INITIALIZES AVWXTABL DSECT VALUES FOR WHOLE ASSEMBLY, . 16714100 *. SETS A $SPIE TO INTERCEPT SOME TYPES OF INTERRUPTS, SETS THE . 16714200 *. PROGRAM AMSK TO ONLY HAVE FIXED-OVERFLOW INTRPTS, AND CALLS . 16714300 *. ALL THE SUBROUTINES REQUIRED FOR AN ASSEMBLY IN A TABLE- . 16714400 *. DRIVEN MANNER, USING A LIST OF POINTERS TO ADDRESS CONSTNATS.. 16714500 *. AFTER THE ASSEMBLY IS COMPLETED, IT PRINTS VARIOUS STATISTICS. 16714600 *. AND THEN RETURNS CONTROL TO THE ASSIST MONITOR. NOTE THAT . 16714700 *. MPCON0 IS THE ONLY CSECT IN THE ASSEMBLER WHICH ACTUALLY . 16714800 *. REFERS TO AJOBCON, ALTHOUGH OTHERS USE EQU FLAGS FROM IT. . 16714900 *. ENTRY CONDITIONS . 16716000 * R12(RAT)= @ VWXTABL CSECT, INITIALIZED BY ASSIST CONTROL PROG. . 16720500 * AVAJOBPT,AVECONPT HAVE BEEN INITIALIZED IF NEEDED BY ASSIST. . 16721000 *. CALLS ESINT1,LTINT1,OPINIT,SYINT1,UTINT1,OUINT1,MOCON1 . 16722000 *. CALLS LTEND1,UTEND1,BRINIT,MTCON2 . 16724000 *. CALLS OUEND2,SYEND2,UTEND2 . 16726000 *. USES DSECTS: AVWXTABL . 16727000 *. USES MACROS: $AL2, $CALL, $PRNT, $RETURN, $SAVE, $SPIE . 16727500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16728000 MPCON0 CSECT 16730000 $DBG ,NO 16732000 $SAVE RGS=(R14-R12),BR=R13,SA=MPSAVE 16744000 SPACE 1 16746000 * INITIALIZATION FOR ASSEMBLY - OBTAIN VARIOUS VALUES * 16748000 * FROM AJOBCON. ZERO FLAGS. SET SPIE,PROGRAM MASK. * 16750000 SPACE 1 16752000 USING AVWXTABL,RAT NOTE MAIN USING FROM NOW ON 16756000 LM R2,R3,AVADDLOW GET ORIG CORE LIMITS FOR STATS LATER 16762000 MVC AWZEROS+C' '(64),AWZEROS MAKE SURE ZERO(SEE SCANRS) 16763000 MVC AVZAREA1(AVZAREA2-AVZAREA1),AWZEROS ZERO OUT AREA 16764000 MVC AVRCBPT(7*4),AWZEROS ZERO AVRCBPT---AVSOLAST 16765000 * REQUIRED FOR REPLACE, GOOD DEBUG 16765500 NI AVTAGS1,255-$IBSTAR1-$IBDSEC1-$IBPRCD1 INIT VALUES 16766000 NI AVTAGS2,255-$INEND2 CLEAR EOF FLAG 16768000 SPACE 1 16770000 $SPIE ,((7,15)),ACTION=CR,CE=MPSPIEXT GET CONTROL FOR ERRS 16772000 ST R1,AVMPSPIE SAVE @ PREVIOUS SPIE CONTROL BLOCK 16773000 L R0,=XL4'08000000' GET MASK FOR SPM (FIXED OVER ONLY) 16774000 SPM R0 SET TO STOP ANY FP INTERRUPTS 16776000 SPACE 1 16778000 * SET UP VALUES FOR CALLS TO ALL SUBROUTINES * 16780000 LA RZ,MPCALL1 INIT INDEX FOR BXLE CALL LOOP 16782000 LA RX,2 INCREMENT FOR BXLE 16784000 LA RY,MPCALL2-2 LIMIT ADDRESS FOR BXLE 16786000 SPACE 1 16788000 * FOLLOWING LOOP PERFORMS ENTIRE ASSEMBLY PROCESS. 16790000 MPCALLR LH REP,0(,RZ) GET OFFSET @ FROM OFFSET LIST 16792000 $CALL $BASE(REP) CALL THE RIGHT ROUTINE 16794000 BXLE RZ,RX,MPCALLR LOOP THRU CALL LIST 16796000 EJECT 16798000 * IF 'STOP' BIT SET, FLAG NOLOAD ALSO 16799000 TM AVTAGS2,AJOASTOP HAS STOP BIT BEEN SET FOR ANY REASON 16799100 BZ *+8 NO, CONTINUE 16799200 OI AVTAGS1,AJNLOAD SHOW NO LOAD CAN BE DONE 16799300 SPACE 1 16799400 * CONVERT AND PRINT STORAGE USAGE. NOTE THAT THIS CODE, * 16800000 * MPCONV, AND DATA MPAT-MPHLEN ARE NOT REQUIRED FOR * 16802000 * ACTUAL WORKING OF THE PROGRAM, AND COULD BE REMOVED. * 16804000 LM R0,R1,AVADDLOW GET CURRENT FREE AREA POINTERS 16808000 SPACE 1 16810000 SR R3,R1 AJOTADH -AVADDHIH = HIGH CORE USED 16814000 SR R0,R2 AVADDLOW-AJOTADL = LOW CORE USED 16816000 LR R5,R0 SAVE TO CALCULATE TOTAL SPACE. 16818000 S R1,AVADDLOW AVADDHIH-AVADDLOW = REMAINING AREA 16820000 LA R2,MPARL @ FIRST AREA FOR LOW STORAGE 16822000 BAL RZ,MPCONV HAVE LOW VALUE(R0) CONVERTED 16824000 LA R2,MPARH ADDRESS OF HIGH AREA USED 16826000 LR R0,R3 MOVE DIFFERENCE OVER WHERE EXPECTED 16828000 SPACE 1 16830000 BAL RZ,MPCONV CALL CONVERTER ROUTINE 16832000 LA R2,MPREM @ REMAINING AREA TO BE PRINTED 16834000 LR R0,R1 MOVE VALUE OVER FOR CONVERTER 16836000 BAL RZ,MPCONV CALL CONVERTER 16838000 SPACE 1 16840000 * COMPUTE AVERGAE # BYTES PER STATEMENT USED. 16842000 AR R5,R3 ADD HIGH USED (R5) TO LOW USED(R3) 16844000 SR R4,R4 CLEAR SO DIVIDE WORKS OK 16846000 LH R0,AVSTMTNO GET # STATEMENTS 16848000 DR R4,R0 DIVIDE TO GET BYTES/STATEMENT 16850000 LR R0,R5 MOVE QUOTIENT OVER 16852000 LA R2,MPBYSTMT FOR # BYTES/STMT 16854000 BAL RZ,MPCONV CALL CONVERTER 16856000 SPACE 1 16858000 $PRNT MPHEAD,MPHLEN PRINT THE ASSEMBLED LINE 16860000 AIF (NOT &$XREF).NOXREF9 SKIP IF NO XREF A 16860100 TM AVXRFLAG,AVXRON DO WE WANT A CROSS REFERENCE A 16860150 BZ MPRETA NO SKIP CALL A 16860200 $CALL XRPRNT CALL CROSS REF PRINT ROUTINE A 16860250 .NOXREF9 ANOP A 16860300 MPRETA EQU * 16862000 L R1,AVMPSPIE GET @ PREVIOUS SPIE BLOCK BACK 16863000 $SPIE ACTION=(RS,(1)) RESTORE PREVIOUS SPIE BLOCK 16863010 MPRET $RETURN RGS=(R14-R12) 16864000 EJECT 16868000 * SPIE EXIT ROUTINE - FLAGS INTERRUPTS 0C7-0CF. * 16870000 USING MPSPIEXT,R15 NOTE ENTRY PT AT SPIE 16872000 MPSPIEXT STM R14,R12,12(R13) SAVE ALL THE REGS 16874000 LA RB,$ERINTPT SHOW INTERRUPT MESSAGE 16876000 $CALL ERRTAG CALL ERROR FLAGGING 16878000 LM R14,R12,12(R13) RELOAD REGS 16880000 BR R14 RETURN TO SUPERVISOR 16882000 DROP R15 KILL TEMPORARY USING 16884000 SPACE 1 16886000 SPACE 2 16888000 * * * * * MPCONV - CONVERT 1 ADDRESS DIFERENCE AND EDIT IT * 16890000 * ENTRY CONDITIONS * 16892000 * R0 = ADDRESS DIFFERENCE TO BE CONVERTED * 16894000 * R2 = ADDRESS OF AREA WHERE EDITED VALUE TO BE PUT * 16896000 * RZ = RETURN ADDRESS TO CALLING CODE * 16898000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16900000 SPACE 1 16902000 MPCONV CVD R0,AVDWORK1 CONVERT DIFFERENCE TO DECIMAL 16904000 MVC 0(L'MPAT,R2),MPAT MOVE THE PATTERN IN 16906000 ED 0(L'MPAT,R2),AVDWORK1+8-L'MPAT/2 EDIT VALUE OVER 16908000 BR RZ RETURN TO CALLER 16910000 SPACE 1 16912000 * * * * * INTERNAL CONSTANTS * 16914000 * OFFSETS TO ADCONS FOR ROUTINES TO BE CALLED * 16916000 MPCALL1 DS 0H 16918000 $AL2 AX$BASE,(AXESINT1,AXLTINT1,AXOPINIT,AXSYINT1,AXUTINT1) 16920000 AIF (NOT &$MACROS).MPNOMA1 SKIP IF NO MACRO MODS 16920200 $AL2 AX$BASE,(AXMACINT) OPCODE INITIALIZATION 16920400 .MPNOMA1 ANOP 16920600 AIF (NOT &$XREF).NOXREF8 A 16920610 $AL2 AX$BASE,(AXXRINT1) XREF INTIALIZATION PASS 1 A 16920620 .NOXREF8 ANOP A 16920630 $AL2 AX$BASE,(AXOUINT1,AXMOCON1) 16922000 MPCALL1A $AL2 AX$BASE,(AXLTEND1,AXUTEND1,AXBRINIT) A 16924000 AIF (NOT &$XREF).NOXRF70 SKIP IF NO XREF 16924100 $AL2 AX$BASE,(AXXRINT2) XREF INITIALIZATION 2ND PASS 1 16924200 .NOXRF70 ANOP 16924300 $AL2 AX$BASE,(AXMTCON2) 16924400 $AL2 AX$BASE,(AXOUEND2,AXSYEND2,AXUTEND2) 16926000 MPCALL2 EQU * 16928000 SPACE 1 16930000 * STORAGE USAGE OUTPUT HEADING,EDIT PATTERN * 16932000 MPAT DC X'4020202020202120' EDIT PATTERN FOR ADDRESSES 16934000 MPHEAD DC C'0*** DYNAMIC CORE AREA USED: LOW:' 16936000 MPARL DS CL(L'MPAT) FOR LOW AREA USAGE 16938000 DC C' HIGH:' 16940000 MPARH DS CL(L'MPAT) FOR HIGH AREA USAGE(SYMBOL TABLE) 16942000 DC C' LEAVING:' 16944000 MPREM DS CL(L'MPAT) FOR REMAINING STORAGE 16946000 DC C' FREE BYTES. AVERAGE: ' 16948000 MPBYSTMT DS CL(L'MPAT) FOR AVERAGE BYTES/STMT 16950000 DC C' BYTES/STMT ***' 16952000 MPHLEN EQU *-MPHEAD DEFINE LENGTH OF AREA 16954000 LTORG 16956000 DROP RAT,R13 CLEAR UP USING 16958000 TITLE '*** MTCON2 - MAIN CONTROL - PASS 2 ***' 16960000 **--> CSECT: MTCON2 2 MAIN CONTROL - ASSEMBLER PASS 2 . . . . . . . 16962000 *. MTCON2 IS THE CONTROL PROGRAM FOR THE 2ND PASS OF THE ASSIST . 16962100 *. OF THE ASSIST ASSEMBLER. IT IS RELATIVELY SMALL, SINCE . 16962200 *. MOST OF THE WORK HAS BEEN DONE IN PASS 1. IT PERFORMS OR . 16962300 *. SUPERVISES THE FOLLOWING ACTIONS, FOR EACH SOURCE STMT: . 16962400 *. 1. RETRIEVES POINTERS TO THE RECORD BLOCKS (UTGET2). . 16962500 *. 2. SETS UP THE LOCATION COUNTER AND OPERAND SCAN POINTER. . 16962600 *. 3. CALLS 2ND LEVEL INSTRUCTION PROCESSORS(ICMOP2,IDASM2). . 16962700 *. 4. PRINTS ANY STATEMENT WITH NO RCODBLK (OUTPT2). . 16962800 *. FINISH BY ROUNDING UP LENGTH OF PROG TO DOUBLEWORD BOUNDARY. . 16963000 *. CALLS ICMOP2,IDASM2,OUTPT2,UTGET2 . 16964000 *. USES DSECTS: AVWXTABL,RCODBLK,RSBLOCK . 16965000 *. USES MACROS: $CALL,$RETURN,$SAVE,$SLOC . 16965500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16966000 MTCON2 CSECT 16968000 $DBG 90,* 16970000 USING AVWXTABL,RAT NOTE MAIN USING 16972000 $SAVE RGS=(R14-R6),SA=MTCOSAVE,BR=R13 16974000 SR R2,R2 CLEAR FOR INSERTIONS 16976000 MVI AVCESDID,2 INIT TO VALUE IN CASEE UNIT PRIV CD 16977000 SPACE 1 16978000 * MTGET2 ENTERED 1 TIME FOR EACH STATEMENT. CALLS UTGET2 * 16980000 * TO GET @'S OF RECORD BLOCKS. @ RSBLOCK IS RETURNED IN RC, * 16982000 * AND ALL EXISTING VALUES HAVE BEEN FILLED IN FOR RECORD PTRS. * 16984000 SPACE 1 16985000 MTGET2 EQU * ENTRY FOR LOOP HEAD FOR 1 STMT 16985100 * IF 'STOP' BIT SET BY ANYONE, QUIT NOW. 16985200 TM AVTAGS2,AJOASTOP HAS IT BEEN SET 16985300 BO MTRET YES, QUIT 16985400 SPACE 1 16985500 $CALL UTGET2 CALL TO OBTAIN NEXT BLOCKS 16986000 LTR RE,RE WAS THIS THE END 16988000 BNZ MTENDOF YES,NO MORE TO DO-QUIT 16990000 LR RE,RC MOVE @ RSBLOCK OVER 16992000 USING RSBLOCK,RE NOTE POINTER 16994000 TM RSBFLAG,$RCBX DOES A RCB EXIST 16996000 BZ MTPRINT NO IT DOESN'T,EITHER ERROR OR COMM 16998000 SPACE 1 17000000 * GET INFORMATION FROM RCODBLK. SRT UP FOR LEVEL 2 SUBRS. 17002000 L RC,AVRCBPT GET @ RCODBLK BACK INTO REG 17004000 USING RCODBLK,RC NOTE THIS USING 17006000 IC R2,RSBSCAN GET SCAN POINTER TO BEGINNING OF OPE 17008000 LA RA,RSBLOCK(R2) GET @ OPERAND FIELD 17010000 L RD,RCLOC-1 GET THE LOCATION COUNTER FOR STMT 17012000 LA RD,0(RD) REMOVE 1ST BYTE 17014000 $SLOC RD SET THE LOCATION COUNTER 17016000 SPACE 1 17018000 * CHOOSE CORRECT 2ND-LEVEL PROCESSOR. 17020000 TM RCTYPE,$IB MAKE TYPE TEST 17022000 BO MTCID BRANCH TO CALL ASSEMBLER ROUTINE 17024000 AIF (NOT &$SPECIO).MTNOSPC SKIP IF NO SPECIALS 17026000 BZ MTCID BRANCH IF ASSEMBLER INSTRUCTIONS 17028000 * FALLS THRU ==> SPECIAL INST * 17030000 IC R2,RCTYPE GET TYPE BYTE 17032000 SLL R2,2 *4 FOR FULLWORD @ INDEXING 17034000 $CALL SPECA2-4*$IS(R2) GET 2ND PASS SPECIAL ROUTINES 17036000 B MTGET2 GO GET NEXT RECORD 17038000 .MTNOSPC ANOP 17040000 MTCIC $CALL ICMOP2 PASS 2 MACHINE INSTRUCTIONS 17042000 B MTGET2 GO GET NEXT ONE 17044000 SPACE 1 17046000 MTCID $CALL IDASM2 ASSEMBLER INSTRUCTIONS 17048000 B MTGET2 GO GET NEXT ONE 17050000 SPACE 1 17052000 MTPRINT LA RB,$OUCOMM SHOW OUTPT2 NO LOCCNTR OR CODE 17054000 $CALL OUTPT2 CALL PRINTER ROUTINE 17056000 AIF (NOT &$XREF).NOXRF13 A 17056005 * CHECK FOR THE * XREF CARD A 17056100 CLI RSBSOURC,C'*' IS IT A COMMENT CARD A 17056200 BNE MTNXREFF NO, CAN'T BE * XREF CARD A 17056300 CLC RSBSOURC+1(4),=C'XREF' IS IT XREF A 17056500 BNE MTNXREFF NO, GO ON A 17056600 LA RA,RSBSOURC+5 FOR ENTRY TO XRSCAN (@ TO BEGIN) L 17056625 LA RD,8 SET ENTRY CONDITIONS TO XRSCAN L 17056650 $CALL XRSCAN CALL SCANNING ROUTINE A 17056700 MTNXREFF EQU * A 17056800 .NOXRF13 ANOP A 17056900 B MTGET2 GO GET NEXT ONE 17058000 MTENDOF EQU * 17060000 * ALIGN LENGTH OF PROG TO MULTIPLE OF 8. 17060100 L R0,AVLOCHIH GET HIGHEST LOCATION COUNTER VALUE 17060200 LA R1,7 GET VALUE FOR DOUBLEWORD ALIGN 17060300 $ALIGR R0,R1 ALIGN UP TO DOUBLEWORD BOUNDARY 17060400 ST R0,AVLOCHIH RESTORE UPDATED,ALIGNED VALUE 17060500 S R0,AVLOCLOW LENGTH= HIGH LOCATION-LOW LOCATION 17061000 A R0,AVRADL + LOWEST REAL LOCATION 17061100 ST R0,AVRADH = HIGH LIMIT FOR REAL @'S 17061200 MTRET $RETURN RGS=(R14-R6) 17062000 DROP RAT,RC,RE,R13 CLEAR USINGS 17064000 LTORG A 17064100 TITLE '*** OPCOD1 - IDENTIFY MNEMONIC OPERATION CODES ***' 17066000 **--> CSECT: OPCOD1 1 OPCODE TABLES AND LOOKUP CODE . . . . . . . . 17070000 *. THIS MODULE CONTAINS THE CODE,TABLES TO IDENTIFY OPCODES. . 17070100 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17072000 OPCOD1 CSECT 17074000 $DBG 90,* 17076000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 17078000 OP1 EQU IAL2+1 COMMON MASK FIELD==>LIT ALLOWED,H AL 17080000 OP3 EQU IAL2+3 MASK FIELD==>LIT ALLOWED, FULL ALIG 17082000 OP7 EQU IAL2+7 MASK FIELD==>LIT ALLOWED,D ALIGN 17084000 IAR EQU IAA+IAB MASK FIELD==>R1 AND R2 MUST BE EVEN 17085000 ENTRY OPINIT,OPFIND 17086000 SPACE 2 17088000 **--> ENTRY: OPINIT 1 INITILIAZE OPCODE ROUTINE IF NEEDED . . . . . 17090000 *. AS OF 8/17/70, THIS ENTRY DOES NOTHING. IT IS INCLUDED FOR . 17091000 *. COMPLETENESS, POSSIBLE MODIFICATION REQUIRING INITIALIZATION.. 17091500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17092000 OPINIT BR R14 RETURN-NOTHING TO DO NOW 17094000 SPACE 2 17096000 **--> ENTRY: OPFIND 1 LOOK UP AN OPCODE . . . . . . . . . . . . . . 17098000 *. ENTRY CONDITIONS . 17100000 *. RA = SCAN POINTER TO 1ST CHARACTER OF OPCODE . 17102000 *. EXIT CONDITIONS . 17104000 *. RA = SCAN POINTER TO 1ST BLANK FOLLOWING LEGAL OPCODE,OR SAME AS O. 17106000 *. ENTRY IF OPCODE WAS NOT RECOGNIZED. . 17108000 *. RB = 0 IF THE OPCODE WAS FOUND IN OPCODE TABLE . 17110000 *. RB = NONZERO VALUE - ERROR CODE FOR ILLEGAL OPCODE ($ERIVOPC) . 17112000 *. RC = ADDRESS OF OPCODTB ENTRY FOR THE OPCODE, IF IT WAS FOUND . 17114000 *. USES DSECTS: AVWXTABL,OPCODTB . 17115000 *. USES MACROS: $RETURN,$SAVE,OPG,OPGT . 17115500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17116000 OPFIND $SAVE RGS=(R1-R2),SA=NO 17118000 CLI 0(RA),C'A' MAKE SURE NO ILLEGAL 17120000 BL OPFERR ILLEGAL,NOTE ERROR 17122000 LR R1,RA DUPLICATE THE SCAN POINTER 17124000 LA RE,6(R1) GET THE LIMIT FOR THE BXLE 17126000 LA RD,1 GET INCREMENT FOR BXLE 17128000 SPACE 1 17130000 * SCAN LOOP TO FIND END OF MNEMONIC * 17132000 OPFLOOP CLI 1(R1),C' ' LOOK FOR BLANK 17134000 BE OPFLNG BLANK FOUND-END OF OPCODE 17136000 BXLE R1,RD,OPFLOOP CONTINUE SEARCHING 17138000 B OPFERR ERROR- NOT RIGHT SIZE 17140000 SPACE 1 17142000 * END OF MNEMONIC FOUND, GET POINTERS ET UP FOR LOOKUP * 17144000 OPFLNG LR R2,R1 DUPLICATE PT TO LAST CHAR OF OPCODE 17146000 SR R2,RA GET LENGTH-1 OF OPCODE = 0-7 17148000 STC R2,OPFCOMP+1 PLACE INTO CLC INSTRUCTION 17150000 LA RD,OPCMNEM-OPCODTB+1(R2) GET TOTAL LENGTH OF ENTRY 17152000 IC R2,OPFL1(R2) GET 1ST OFFSET VALUE,DEPNDING ON LEN 17154000 LTR R2,R2 MAKE SURE THERE ARE SOME OF THIS LEN 17156000 BZ OPFERR NO THERE AREN'T-ERROR 17158000 SPACE 1 17160000 LA RE,OPADS(R2) ADDR OF RIGHT TABLE SET 17162000 IC R2,0(RA) GET THE 1ST CHAR OF OPCODE 17164000 IC R2,OPFCH1-C'A'(R2) GET 2ND OFFSET VALUE FOR LETTERS 17166000 LH RC,0(R2,RE) GET THE CORRECT POINTER 17168000 AR RC,R15 ADD ADDRESS OF OPFIND TO GET REAL AD 17170000 USING OPCODTB,RC NOTE DSECT FOR TABLE ENTRY 17172000 LH RE,2(R2,RE) GET THE LIMIT ADDRESS IN TABLE 17174000 AR RE,R15 ADD TO GET REAL ADDRESS 17176000 SPACE 1 17178000 * SEARCH LOOP TO LOOK UP MNEMONIC * 17180000 OPFCOMP CLC 0($CHN,RA),OPCMNEM COMPARE MNEMONIC WITH TABLE ENTRY 17182000 BNH OPFCHK IF NOT HIGH, EITHER SAME, OR NO GOOD 17184000 BXLE RC,RD,OPFCOMP CONTINUE LOOPING 17186000 OPFCHK BNE OPFERR NE==>ERROR(GET LOOP FALL THRU TOO) 17188000 SPACE 1 17190000 SR RB,RB CLEAR RB TO SHOW OK. 17192000 LA RA,1(R1) UPDATE SCAN POINTER TO BLANK 17194000 OPFRET $RETURN RGS=(R1-R2),SA=NO 17196000 OPFERR LA RB,$ERIVOPC INVALID OPCODE 17198000 B OPFRET RETURN 17200000 EJECT 17202000 * * * * * INTERNAL CONSTANTS * 17204000 * 1ST LEVEL POINTER TABLE-HAS OFFSET ADDRESSES OF POINTER SETS * 17206000 * BELONGING TO EACH USABLE OPCODE LENGTH FROM 1 TO 8. * 17208000 OPFL1 DC AL1(OPF1-OPADS,OPF2-OPADS,OPF3-OPADS,OPF4-OPADS,OPF5-OPA#17210000 DS,OPF6-OPADS,OPF7-OPADS,OPF8-OPADS) 17212000 SPACE 2 17214000 * INDIVIDUAL OPCODTB ENTRY TABLES, IN ORDER BY LENGTH, THEN * 17216000 * ALPHABETICALLY WITHIN LENGTH * 17218000 SPACE 1 17220000 * 1-CHARACTER INSTRUCTIONS * 17222000 OP1A EQU * 17224000 OPG A,$RX,90,OP3 ADD 17226000 OP1B EQU * 17228000 OPG B,$RXM,71,X'F0'+1 BRANCH 17230000 OP1C EQU * 17232000 OPG C,$RX,89,OP3 COMPARE 17234000 OP1D EQU * 17236000 OPG D,$RX,93,OP3+IAA DIVIDE 17238000 OP1L EQU * 17240000 OPG L,$RX,88,OP3 LOAD 17242000 OP1M EQU * 17244000 OPG M,$RX,92,OP3+IAA MULTIPLY 17246000 OP1N EQU * 17248000 OPG N,$RX,84,OP3 AND 17250000 OPG O,$RX,86,OP3 OR 17252000 OP1S EQU * 17254000 OPG S,$RX,91,OP3 SUBTRACT 17256000 OP1T EQU * 17258000 OPG X,$RX,87,OP3 EXCLUSIVE OR 17260000 OP1END EQU * 17262000 EJECT 17264000 * 2-CHARACTER INSTRUCTIONS * 17266000 OP2A EQU * 17268000 OPG AD,$RX,106,OP7+IAA,F ADD NORM LONG 17270000 OPG AE,$RX,122,OP3+IAA,F ADD NORM SHORT 17272000 OPG AH,$RX,74,OP1 ADD HALFWORD 17274000 OPG AL,$RX,94,OP3 ADD LOGICAL 17276000 OPG AP,$SS2,250,IAL2,D ADD DECIMAL 17278000 OPG AR,$RR,26 ADD REGISTER 17280000 OPG AU,$RX,126,OP3+IAA,F ADD UNNORM SHORT 17282000 OPG AW,$RX,110,OP7+IAA,F ADD UNNORM LONG 17284000 OP2B EQU * 17286000 OPG BC,$RX,71,1 BRANCH ON CONDITION 17288000 OPG BE,$RXM,71,X'80'+1 BRANCH ON EQUAL 17290000 OPG BH,$RXM,71,X'20'+1 BRANCH ON HIGH 17292000 OPG BL,$RXM,71,X'40'+1 BRANCH ON LOW 17294000 OPG BM,$RXM,71,X'40'+1 BRANHC ON MINUS 17296000 OPG BO,$RXM,71,X'10'+1 BRANCH ON ONES 17298000 OPG BP,$RXM,71,X'20'+1 BRANCH ON PLUS 17300000 OPG BR,$RRM,7,X'F0' BRANCH REGISTER 17302000 OPG BZ,$RXM,71,X'80'+1 BRANCH ON ZERO 17304000 OP2C EQU * 17306000 OPG CD,$RX,105,OP7+IAA,F COMPARE LONG 17308000 OPG CE,$RX,121,OP3+IAA,F COMPARE SHORT 17310000 OPG CH,$RX,73,OP1 COMPARE HALFWORD 17312000 OPG CL,$RX,85,OP3 COMPARE LOGICAL 17314000 OPG CP,$SS2,249,IAL1+IAL2,D COMPARE DECIMAL 17316000 OPG CR,$RR,25 COMPARE REGISTER 17318000 OP2D EQU * 17320000 OPG DC,$IDC+$IB,$IBSTAR1 DEFINE CONSTANT 17322000 OPG DD,$RX,109,OP7+IAA,F DIVIDE LONG 17324000 OPG DE,$RX,125,OP3+IAA,F DIVIDE SHORT 17326000 OPG DP,$SS2,253,IAL2,D DIVIDE DECIMAL 17328000 OPG DR,$RR,29,IAA DIVIDE REGISTER 17330000 OPG DS,$IDS+$IB,$IBSTAR1 DEFINE STORAGE 17332000 OPG ED,$SS,222,IAL2,D EDIT 17334000 OPG EX,$RX,68,OP1 EXECUTE 17336000 OPG IC,$RX,67,IAL2 INSERT CHARACTER 17338000 OP2L EQU * 17340000 OPG LA,$RX,65,IAL2 LOAD ADDRESS 17342000 OPG LD,$RX,104,OP7+IAA,F LOAD LONG 17344000 OPG LE,$RX,120,OP3+IAA,F LOAD SHORT 17346000 OPG LH,$RX,72,OP1 LOAD HALFWORD 17348000 OPG LM,$RS,152,OP3 LOAD MULTIPLE 17350000 OPG LR,$RR,24 LOAD REGISTER 17352000 EJECT 17353000 OP2M EQU * 17354000 OPG MD,$RX,108,OP7+IAA,F MULTIPLY LONG 17356000 OPG ME,$RX,124,OP3+IAA,F MULTIPLY SHORT 17358000 OPG MH,$RX,76,OP1 MULTIPLY HALFWORD 17360000 OPG MP,$SS2,252,IAL2,D MULTIPLY DECIMAL 17362000 OPG MR,$RR,28,IAA MULTIPLY REGISTER 17364000 OP2N EQU * 17366000 OPG NC,$SS,212,IAL2 AND CHARACTER 17368000 OPG NI,$SI,148 AND IMMEDIATE 17370000 OPG NR,$RR,20 AND REGISTER 17372000 OPG OC,$SS,214,IAL2 OR CHARACTER 17374000 OPG OI,$SI,150 OR IMMEDIATE 17376000 OPG OR,$RR,22 OR REGISTER 17378000 OP2S EQU * 17380000 OPG SD,$RX,107,OP7+IAA,F SUBTRACT NORM LONG 17382000 OPG SE,$RX,123,OP3+IAA,F SUBTRACT NORM SHORT 17384000 OPG SH,$RX,75,OP1 SUBTRACT HALFWORD 17386000 OPG SL,$RX,95,OP3 SUBTRACT LOGICAL 17388000 OPG SP,$SS2,251,IAL2,D SUBTRACT DECIMAL 17390000 OPG SR,$RR,27 SUBTRACT REGISTER 17392000 OPG ST,$RX,80,3 STORE 17394000 OPG SU,$RX,127,OP3+IAA,F SUBTRACT UNNORM SHORT 17396000 OPG SW,$RX,111,OP7+IAA,F SUBTRACT UNNORM LONG 17398000 OP2T EQU * 17400000 OPG TM,$SI,145,IAL1 TEST UNDER MASK 17402000 OPG TR,$SS,220,IAL2 TRANSLATE 17404000 OPG TS,$RSO,147 TEST AND SET (ONLY NON-PRIV TYPE) 17406000 OPG XC,$SS,215,IAL2 EXCLUSIVE OR CHARACTER 17408000 OPG XI,$SI,151 EXCLUSIVE OR IMMEDIATE 17410000 OPG XR,$RR,23 EXCLUSIVE OR REGISTER 17412000 OP2END EQU * 17414000 EJECT 17416000 * 3-CHARACTER INSTRUCTIONS * 17418000 OP3A EQU * 17420000 OPG ADR,$RR,42,IAR,F ADD NORM LONG REGISTER 17422000 OPG AER,$RR,58,IAR,F ADD NORM SHORT REGISTER 17424000 OPG AGO,$IM,$AGO,,M 17425000 OPG AIF,$IM,$AIF,,M 17425200 OPG ALR,$RR,30 ADD LOGICAL REGISTER 17426000 OPG AUR,$RR,62,IAR,F ADD UNNORM SHORT REGISTER 17428000 OPG AWR,$RR,46,IAR,F ADD UNNORM LONG REGISTER 17430000 OPG AXR,$RR,54,IAR,FX ADD EXTENDED REGISTER 17431000 OP3B EQU * 17432000 OPG BAL,$RX,69,1 BRANCH AND LINK 17434000 OPG BCR,$RR,7 BRANCH ON CONDITION REGISTER 17436000 OPG BCT,$RX,70,1 BRANCH ON COUNT 17438000 OPG BER,$RRM,7,X'80' **EXTENDED BRANCH MNEMONIC** J 17439000 OPG BHR,$RRM,7,X'20' **EXTENDED BRANCH MNEMONIC** J 17439200 OPG BLR,$RRM,7,X'40' **EXTENDED BRANCH MNEMONIC** J 17439400 OPG BMR,$RRM,7,X'40' **EXTENDED BRANCH MNEMONIC** J 17439800 OPG BNE,$RXM,71,X'70'+1 BRANCH ON NOT EQUAL 17440000 OPG BNH,$RXM,71,X'D0'+1 BRANCH ON NOT HIGH 17442000 OPG BNL,$RXM,71,X'B0'+1 BRANCH ON NOT LOW 17444000 OPG BNM,$RXM,71,X'B0'+1 BRANCH ON NOT MINUS 17446000 OPG BNO,$RXM,71,X'E0'+1 BRANCH ON NOT ONES 17448000 OPG BNP,$RXM,71,X'D0'+1 BRANCH ON NOT PLUS 17450000 OPG BNZ,$RXM,71,X'70'+1 BRANCH ON NOT ZERO 17452000 OPG BOR,$RRM,7,X'10' **EXTENDED BRANCH MNEMONIC** J 17452600 OPG BPR,$RRM,7,X'20' **EXTENDED BRANCH MNEMONIC** J 17452800 OPG BXH,$RS,134,1 BRANCH ON INDEX HIGH 17454000 OPG BZR,$RRM,7,X'80' **EXTENDED BRANCH MNEMONIC** J 17455000 OP3C EQU * 17456000 OPG CCW,$ICCW+$IB,$IBSTAR1,7,P CHANNEL COMMAND WORD 17458000 OPG CDR,$RR,41,IAR,F COMPARE LONG REGISTER 17460000 OPG CER,$RR,57,IAR,F COMAPRE SHORT REGISTER 17462000 OPG CLC,$SS,213,IAL1+IAL2 COMPARE LOGICAL CHARACTER 17464000 OPG CLI,$SI,149,IAL1 COMPARE LOGICAL IMMEDIATE 17466000 OPG CLM,$RS,189,IAL2,S370 COMPARE LOGICAL UNDER MASK 17467000 OPG CLR,$RR,21 COMPARE LOGICAL REGISTER 17468000 OPG CVB,$RX,79,OP7 CONVERT TO BINARY 17470000 OPG CVD,$RX,78,7 CONVERT TO DECIMAL 17472000 OP3D EQU * 17474000 OPG DDR,$RR,45,IAR,F DIVIDE LONG REGISTER 17476000 OPG DER,$RR,61,IAR,F DIVIDE SHORT REGISTER 17478000 OPG END,$IEND+$IB,IBOMOP+IBNONAM+IBMOSPEC END 17480000 OPG EQU,$IEQU+$IB,IBNENAM+$IBSTAR1,1 EQUATE 17482000 OPG HDR,$RR,36,IAR,F HALVE LONG 17484000 OPG HER,$RR,52,IAR,F HALVE SHORT 17486000 OPG HIO,$RSO,158,,P HALT I/O 17488000 OPG ICM,$RS,191,IAL2,S370 INSERT CHARACTERS UNDER MASK 17489000 OPG ISK,$RR,9,,P INSERT STORAGE KEY 17490000 OP3L EQU * 17492000 OPG LCR,$RR,19 LOAD COMPLEMENT REGISTER 17494000 OPG LDR,$RR,40,IAR,F LOAD LONG REGISTER 17496000 OPG LER,$RR,56,IAR,F LOAD SHORT REGISTER 17498000 OPG LNR,$RR,17 LOAD NEGATIVE REGISTER 17500000 OPG LPR,$RR,16 LOAD POSITIVE REGISTER 17502000 OPG LTR,$RR,18 LOAD AND TEST REGISTER 17504000 EJECT 17505000 OP3M EQU * 17506000 OPG MDR,$RR,44,IAR,F MULTIPLY LONG REGISTR 17508000 OPG MER,$RR,60,IAR,F MULTIPLY SHORT REGISTER 17510000 OPG MVC,$SS,210,IAL2 MOVE CHARACTER 17512000 OPG MVI,$SI,146 MOVE IMMEDIATE 17514000 OPG MVN,$SS,209,IAL2 MOVE NUMERICS 17516000 OPG MVO,$SS2,241,IAL2 MOVE WITH OFFSET (2 LENGTHS) 17518000 OPG MVZ,$SS,211,IAL2 MOVE ZONES 17520000 OPG MXD,$RX,103,IAA+OP7,FX MULTIPLY EXTENDED/LONG 17520100 OPG MXR,$RR,38,IAR,FX MULTIPLY EXTENDED REGISTER 17520200 OP3N EQU * 17522000 OPG NOP,$RXM,71,X'00'+1 NO OPERATION 17524000 OPG ORG,$IORG+$IB,IBNONAM+IBOMOP+$IBSTAR1 ORIGIN 17526000 OPG RDD,$SI,133,,P READ DIRECT 17528000 OP3S EQU * 17530000 OPG SCK,$RSO,178,X'40'+OP7,P370 SET CLOCK 17531000 OPG SDR,$RR,43,IAR,F SUBTRACT NORM LONG REGISTER 17532000 OPG SER,$RR,59,IAR,F SUBTRACT NORM SHORT REGISTER 17534000 OPG SIO,$RSO,156,,P START I/O 17536000 OPG SLA,$RSH,139,IAL2 SHIFT LEFT ALGEBRAIC 17538000 OPG SLL,$RSH,137,IAL2 SHIFT LEFT LOGICAL 17540000 OPG SLR,$RR,31 SUBTRACT LOGICAL REGISTER 17542000 OPG SPM,$RSO,4 17544000 OPG SRA,$RSH,138,IAL2 SHIFT RIGHT ALGEBRAIC 17546000 OPG SRL,$RSH,136,IAL2 SHIFT RIGHT LOGICAL 17548000 OPG SRP,$SS2,240,,S370 SHIFT AND ROUND PACKED 17549000 OPG SSK,$RR,8,,P SET STORAGE KEY 17550000 OPG SSM,$RSO,128,,P SET SYSTEM MASK 17552000 OPG STC,$RX,66 STORE CHARACTER 17554000 OPG STD,$RX,96,7+IAA,F STORE LONG 17556000 OPG STE,$RX,112,3+IAA,F STORE SHORT 17558000 OPG STH,$RX,64,1 STORE HALFWORD 17560000 OPG STM,$RS,144,3 STORE MULTIPLE 17562000 OPG SUR,$RR,63,IAR,F SUBTRACT UNNORM SHORT REGISTER 17564000 OPG SVC,$RSO,10 SUPERVISOR CALL 17566000 OPG SWR,$RR,47,IAR,F SUBTRACT UNNORM LONG REGISTER 17568000 OPG SXR,$RR,55,IAR,FX SUBTRACT EXTENDED REGISTER 17569000 OP3T EQU * 17570000 OPG TCH,$RSO,159,,P TEST CHANNEL 17572000 OPG TIO,$RSO,157,,P TEST I/O 17574000 OPG TRT,$SS,221,IAL1+IAL2 TRANSLATE AND TEST 17576000 OPG WRD,$SI,132,,P WRITE DIRECT 17578000 OPG ZAP,$SS2,248,IAL2,D ZERO AND ADD DECIMAL 17580000 OP3END EQU * 17582000 EJECT 17584000 * 4-CHARACTER INSTRUCTIONS * 17586000 OP4A EQU * 17588000 OPG ACTR,$IM,$ACTR,,M 17588200 OPG ANOP,$IM,$ANOP,,M 17588400 OP4B EQU * 17590000 OPG BALR,$RR,5 BRANCH AND LINK REGISTER 17592000 OPG BCTR,$RR,6 BRANCH ON COUNT REGISTER 17594000 OPG BNER,$RRM,7,X'70' **EXTENDED BRANCH MNEMONIC** J 17596200 OPG BNHR,$RRM,7,X'D0' **EXTENDED BRANCH MNEMONIC** J 17596400 OPG BNLR,$RRM,7,X'B0' **EXTENDED BRANCH MNEMONIC** J 17596600 OPG BNMR,$RRM,7,X'B0' **EXTENDED BRANCH MNEMONIC** J 17596800 OPG BNOR,$RRM,7,X'E0' **EXTENDED BRANCH MNEMONIC** J 17597000 OPG BNPR,$RRM,7,X'D0' **EXTENDED BRANCH MNEMONIC** J 17597200 OPG BNZR,$RRM,7,X'70' **EXTENDED BRANCH MNEMONIC** J 17597400 OPG BXLE,$RS,135,1 BRANCH INDEX LOW OR EQUAL J 17597800 OP4C EQU * 17598000 OPG CLCL,$RR,15,IAR,S370 COMPARE LOGICAL CHARACTERS LONG 17599000 OPG CNOP,$ICNOP+$IB,IBNONAM+$IBSTAR1 CONDITIONAL NOP 17600000 OP4D EQU * 17602000 AIF (&$DEBUG).OPDIAG SKIP DIAGNOSE IF NOT DEBUG MODE 17604000 OPG DIAG,$SI,131 DIAGNOSE(EXECUT EQUIV OF DEBUG) 17606000 .OPDIAG ANOP 17608000 OPG DROP,$IDROP+$IB,IBNONAM DROP REGISTER 17610000 OPG EDMK,$SS,223,IAL2,D EDIT AND MARK 17612000 OPG GBLA,$IM,$GBLA,$ARITH,M 17612400 OPG GBLB,$IM,$GBLB,$BOOL,M 17612600 OPG GBLC,$IM,$GBLC,$CHAR,M 17612800 OP4L EQU * 17614000 OPG LCDR,$RR,35,IAR,F LOAD COMPLEMENT LONG REGISTER 17616000 OPG LCER,$RR,51,IAR,F LOAD COMPLEMENT SHORT REGISTER 17618000 OPG LCLA,$IM,$LCLA,$ARITH,M 17618200 OPG LCLB,$IM,$LCLB,$BOOL,M 17618400 OPG LCLC,$IM,$LCLC,$CHAR,M 17618600 OPG LCTL,$RS,183,OP3,P370 LOAD CONTROL 17619000 OPG LNDR,$RR,33,IAR,F LOAD NEGATIVE LONG REGISTER 17620000 OPG LNER,$RR,49,IAR,F LOAD NEGATIVE SHORT REGISTER 17622000 OPG LPDR,$RR,32,IAR,F LOAD POSITIVE LONG REGISTER 17624000 OPG LPER,$RR,48,IAR,F LOAD POSITIVE SHORT REGISTER 17626000 OPG LPSW,$RSO,130,7,P LOAD PROGRAM STATUS WORD 17628000 OPG LRDR,$RR,37,IAR,FX LOAD ROUNDED EXTENDED ==> LONG 17629100 OPG LRER,$RR,53,IAR,FX LOAD ROUNDED LONG ==> SHORT 17629200 OPG LTDR,$RR,34,IAR,F LOAD AND TEST LONG REGISTER 17630000 OPG LTER,$RR,50,IAR,F LOAD AND TEST SHORT REGISTER 17632000 OP4M EQU * 17634000 OPG MEND,$IM,$MEND,,M 17634200 OPG MVCL,$RR,14,IAR,S370 MOVE CHARACTERS LONG 17635000 OPG MXDR,$RR,39,IAR,FX MULTIPLY EXTENDED / LONG REG 17635100 OP4N EQU * 17636000 OPG NOPR,$RRM,7,X'00' NO OPERATION 17638000 OPG PACK,$SS2,242,IAL2 PACK 17640000 OP4S EQU * 17642000 OPG SETA,$IM,$SETA,$ARITH,M 17642200 OPG SETB,$IM,$SETB,$BOOL,M 17642400 OPG SETC,$IM,$SETC,$CHAR,M 17642600 OPG SIOF,$RSO,156,X'10',P370 START I/O FAST 17643000 OPG SLDA,$RSH,143,IAL2+IAA SHIFT LEFT DOUBLE ALGEBRAI 17644000 OPG SLDL,$RSH,141,IAL2+IAA SHIFT LEFT DOUBLE LOGICAL 17646000 OPG SRDA,$RSH,142,IAL2+IAA SHIFT RIGHT DOUBLE ALGEBRA 17648000 OPG SRDL,$RSH,140,IAL2+IAA SHIFT RIGHT DOUBLE LOGICAL 17650000 OPG STCK,$RSO,178,X'50',P370 STORE CLOCK 17650500 OPG STCM,$RS,190,,S370 STORE CHARACTERS UNDER MASK 17651000 OP4T EQU * 17652000 OPG UNPK,$SS2,243,IAL2 UNPACK 17654000 AIF (&$XXIOS).OP4TSK1 SKIP IF NO XGETS ALLOWED CPP 17654200 OPG XGET,$SPC,224,X'A0' GENERAL INPUT D 17654400 .OP4TSK1 AIF (NOT &$EXINT).OP4TSK2 SKIP IF NO XOPC'S CPP 17654450 OPG XOPC,$RSO,1 EXTENDED USER DEBUG CONTROL INSTR 17654500 .OP4TSK2 AIF (&$XXIOS).OP4TSK SKIP IF NO XPUTS ALLOWED CPP 17654550 OPG XPUT,$SPC,224,X'C0'+IAL2 GENERAL OUTPUT OP J 17654600 .OP4TSK ANOP 17654800 OP4END EQU * 17656000 EJECT 17658000 * 5-CHARACTER INSTRUCTIONS * 17660000 OP5A EQU * 17662000 OP5B EQU * 17664000 OP5C EQU * 17666000 OPG CSECT,$ICSECT+$IB,IBOMOP CSECT 17668000 OP5D EQU * 17670000 AIF (&$DEBUG).OPNOD1 SKIP IF NOT DEBUG MODE 17672000 OPG DEBUG,$IDEBUG+$IB DEBUG FLAG SETTING OPCODE 17674000 .OPNOD1 ANOP 17676000 OPG DSECT,$IDSECT+$IB,IBOMOP+IBNENAM DUMMY SECTION 17678000 OPG EJECT,$IEJECT+$IB,IBNONAM+IBOMOP+IBMOPRCX,255 EJECT 17680000 OPG ENTRY,$IENTRY+$IB,IBNONAM ENTRY DECLARATION 17682000 OPG EXTRN,$IEXTRN+$IB,IBNONAM EXTERNAL DECLARATION 17684000 OP5L EQU * 17686000 OPG LTORG,$ILTORG+$IB,IBOMOP+$IBSTAR1 LTORG 17688000 OP5M EQU * 17690000 OPG MACRO,$IM,$MACRO,,M 17690200 OPG MEXIT,$IM,$MEXIT,,M 17690400 OPG MNOTE,$IM,$MNOTE,,M 17690600 OP5N EQU * 17692000 OPG PRINT,$IPRINT+$IB,IBNONAM+IBMOPRCX,$IBPON+$IBPGEN 17694000 OP5S EQU * 17696000 OPG SPACE,$ISPACE+$IB,IBNONAM+IBOMOP+IBMOPRCX,1 SPACE 17698000 OPG START,$ISTART+$IB,IBOMOP START 17700000 OPG STCTL,$RS,182,3,P370 STORE CONTROL 17700500 OPG STIDC,$RSO,178,X'30',P370 STORE CHANNEL ID 17701000 OPG STIDP,$RSO,178,X'20',P370 STORE CPU ID 17701500 OP5T EQU * 17702000 OPG TITLE,$ITITLE+$IB,IBNONAM+IBMOPRCX,0 TITLE 17704000 OPG USING,$IUSING+$IB,IBNONAM+$IBSTAR1 USING 17706000 AIF (NOT &$XIOS).OPNOXIO SKIP IF NO XIOS WANTED 17708000 OPG XDECI,$RX,83 DECIMAL INPUT 17710000 OPG XDECO,$RX,82 DECIMAL OUTPUT 17712000 OPG XDUMP,$SPC,224,X'60'+IAL2 DUMP 17714000 AIF (NOT &$HEXI).OPNOHXI SKIP IF NO XHEXI 17714100 OPG XHEXI,$RX,97 OP CODE FOR XHEXI 17714200 .OPNOHXI ANOP 17714300 AIF (NOT &$HEXO).OPNOHXO SKIP IF NO XHEXO 17714400 OPG XHEXO,$RX,98 OP CODE FOR XHEXO 17714500 .OPNOHXO ANOP 17714600 AIF (NOT &$XIOS).OPNOXIO SKIP IF NO X-I/O PSEUDOS CPP 17714900 OPG XLIMD,$SPC,224,X'80' LIMIT AREA (COMPLETION DUMP) 17715000 OPG XPNCH,$SPC,224,X'40'+IAL2 PUNCH 17716000 OPG XPRNT,$SPC,224,X'20'+IAL2 PRINT 17718000 OPG XREAD,$SPC,224,X'00' READ 17720000 .OPNOXIO ANOP 17722000 AIF (&$REPL EQ 0).OPNREPL SKIP IF NOT REPLACE 17722500 OPG XREPL,$SI,160 XREPL SPECIAL COMMAND 17723000 .OPNREPL ANOP 17723500 OP5END EQU * 17724000 SPACE 2 17726000 * SECOND LEVEL OFFSET TABLE - HAS POINTERS FOR EACH BEGINNING * 17728000 * CHARACTER, IN TABLE DETERMINED BY LENGTH. * 17730000 * TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 17732000 OPFCH1 DC X'000204060606060606060606060606' C 17734000 DC X'060606080A0C0C0C0C0C0C0C0C0C0C0C' D 17736000 DC X'0C0C0E10101010101010101010101010' E 17738000 DC X'10101010101010101010101010101010' F 17740000 SPACE 2 17742000 * OFFSET VALUES INTO OPCODTB ENTRY AREA * 17744000 OPADS DS H BASE ADDRESS OF 2ND LEVEL OFFSET TAB 17746000 OPGT 17748000 DROP REP,RC CLEAN UP USINGS 17750000 TITLE '*** OUTPUT - SOURCE AND OBJECT LISTING ***' 17752000 **--> CSECT: OUTPUT PRINTED LISTING ROUTINE . . . . . . . . . . . 17754000 *. OUTPUT HANDLES THE FORMATTING AND PRINTING OF THE ASSEMBLY . 17755000 *. LISTING FOR THE ASSIST ASSEMBLER. . 17755500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17756000 OUTPUT CSECT 17758000 $DBG C0,SNAP 17760000 ENTRY OUINT1,OUTPT2,OUEND2 17764000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 17766000 SPACE 1 17768000 * LIST OF LINE/PAGE CONTROL EQUATE VALUES FOLLOWS. 17768100 $OU#LNS EQU 60 MAXIMUM PRINTED LINES/PAGE 17768200 OUH# EQU 3 # LINES USED BY STANDARD HEADING 17768300 $OU#NORM EQU $OU#LNS-OUH# NORMAL LINES/PAGE FOR ACTIAL STMTS 17768400 $OU#PAG1 EQU $OU#NORM-5 # LINES FOR STMTS ON 1ST PAGE ONLY 17768500 SPACE 1 17768600 **--> ENTRY: OUINT1 1 INITIALIZATION ENTRY - CALLED BEFORE PASS 1 . 17770000 *. OUINT1 IS CALLED TO INITIALIZE FLAG VALUES AND COUNTERS . 17770100 *. USED IN OUTPUT, INCLUDING LISTING CONTROL, STATEMENT #, . 17770200 *. PAGE COUNT, WITHIN-PAGE LINE COUNT, AND TITLE AREA. . 17770300 *. USES DSECTS: AVWXTABL . 17770400 *. USES MACROS: $RETURN,$SAVE . 17770500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17772000 SPACE 1 17773000 OUINT1 $SAVE SA=NO 17774000 AIF (&$COMNT EQ 0).OUNCOM1 SKIP IF NO COMMENT CHK 17774500 MVC AVMACHIN(4),AWZEROS ZERO VARIABLES(SEE IAMOP1 CSECT) 17775000 .OUNCOM1 ANOP 17775500 MVI AVPRINT,$IBPON+$IBPGEN PRINT ON,GEN,NODATA 17776000 TM AVTAGS1,AJNLIST IS LIST ON OR OFF 17778000 BO *+8 SKIP IF LIST IS OFF 17780000 OI AVPRINT,$IBPLIST SHOW LIST IS ON FOR LATER TEST 17782000 MVC AVPRINT1,AVPRINT COPY VALUE FOR USE DURING PASS 1 17783000 ZAP OULNCNT,AWP1 SET CURRENT STMT # = 1 17784000 ZAP OUPGCNT,AWP0 SET PAGE COUNT TO ZERO LASO 17786000 MVC OUCOUNT,AWH1 INIT WITHIN PAGE COUNT TO 1 17788000 MVC OUHEADNG,AWBLANK BLANK OUT SPOT FOR HEADING 17790000 * FOLLOWING STMTS HELP AVOID WASTED 1ST PAGE LISTING. 17790500 LA RE,$OU#PAG1 # LINES FOR STMTS ON 1ST PAGE ONLY 17790800 STH RE,OUH#LINE SET COUNTERSETTER TO INITIAL VALUE 17791000 MVI OUHEAD1,C'0' JUST DO DOUBLESPACE 1ST TIME 17791500 AIF (NOT &$CMPRS).OUINCM SKIP IF NO COMPRESS CODE 17791510 SPACE 2 17791520 * CMPRS OPTION INITIALIZATION&TESTING - IF ON, GET 17791530 * SPACE FOR OUCMPRSD BLOCK, INIT VARIABLES. 17791540 SPACE 1 17791550 TM AVTAGS2,AJOCMPRS IS CMPRS OPTION USED 17791560 BZ OUINOCMP NO, SO DON'T GET SPACE 17791570 SPACE 1 17791580 LA RA,OUCMPR$L TOTAL LENGTH OF OUCMPRSD BLOCK 17791590 $ALLOCH RB,RA,OUINCMOV ACQUIRE AREA 17791600 USING OUCMPRSD,RB NOTE PTR THERE 17791610 ST RB,OUCMPRAD STORE @ BLOCK FOR OUTPT2 USE 17791620 LA RE,$OU#PAG1+OUH# TOTAL # LINES FOR PAGE 1 17791630 STH RE,OUCMOPAG SET # LINES ON FIRST PAGE ONLY 17791640 STH RE,OUCMLEFT SET # LINES LEFT IN OUCMSAVE,PAGE1 17791650 SPACE 1 17791660 LA RC,OUCMSAVE @ 1ST BYTE OF STORAGE AREA 17791670 ST RC,OUCMSTMT SET @ SO 1ST STMT WILL BE THERE 17791680 NI OUCMPHAS,255-OUCMPHSB SHOW OUTPT2 IN PHASE 'A' 17791690 MVI OUCMCCIN,C'0' MAKE INITIAL CARRIAGE CONT D SPACE 17791700 MVC OUCMBREK,=C'. ' INITIALZE SEPARATER FIELD 17791710 B OUINOCMP SKIP OVER RESET CODE 17791720 DROP RB KILL USING 17791730 SPACE 1 17791740 * INSUFFICIENT SPACE - CANCEL CMPRS OPTION NOW. 17791750 OUINCMOV NI AVTAGS2,255-AJOCMPRS REMOVE CMPRS FLAG 17791760 OUINOCMP EQU * 17791770 SPACE 1 17791780 .OUINCM ANOP 17791790 OUINRET $RETURN SA=NO 17792000 EJECT 17794000 **--> ENTRY: OUTPUT2 PRINT 1 STATEMENT,WITH CODE AS NEEDED,ERROR . 17796000 *. OUTPT2 PRINTS 1 STATEMENT, WITH ANY ERROR MESSAGES NEEDED, . 17796100 *. PRINTS TITLES AND HEADINGS WHEN REQUIRED, PERFORMS PAGE AND . 17796200 *. LINE COUNTING, MAINTAINS LISTING CONTROL STATUS, AND KEEPS . 17796300 *. COUNTS OF NUMBER OF STATEMENTS FLAGGED, TOTAL # ERRORS, . 17796400 *. TOTAL # WARNING MESSAGES. . 17796500 *. ENTRY CONDITIONS . 17798000 *. RB = PRIMARY CALL TYPE CODE . 17800000 *. = 0 ($OUMACH) MACHINE INSTRUCTIONS . 17802000 *. = 2 ($OUCONS) CONSTANTS,CNOPS,ETC. PRINT LOCATION COUNTER,CO. 17804000 *. = 4 ($OULIST) - LISTING CONTROL - EJECT,SPACE,PRINT,TITLE . 17806000 *. = 6 ($OUCOMM) - COMMENTS,ETC.-DO NOT HAVE LOCATION COUNTER . 17808000 *. RC = AN INFORMATION ADDRESS OF SOME TYPE . 17810000 *. = @ OBJECT CODE (RB=0,2) . 17812000 *. = @ # LINES TO SPACE (RB=4,RE=0) . 17814000 *. = @ PRINT CONTROL CODE BYTE (RB=4,RE=2) I.E. PRINT . 17816000 *. = @ TITLE CODE (RB=4,RE=4) . 17818000 *. RD = #-1 OF BYTES OF OBJECT CODE OR TITLE . 17820000 *. RE = SECONDARY CODE OR ADDRESS . 17822000 *. = SECONDARY CODE FOR LISTING CONTROL OPERATIONS . 17826000 *. = 0 SPACE OR EJECT . 17828000 *. = 2 PRINT . 17830000 *. = 4 TITLE . 17832000 *. USES DSECTS: AVWXTABL,ICBLOCK,RCODBLK,RSBLOCK,RSCBLK,REBLK . 17833000 *. USES MACROS: $AL2,$PRNT,$RETURN,$SAVE,$SERR . 17833500 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17834000 EJECT 17836000 * * * * * REGISTER USAGE FOR OUTPT2 * * * * * * * * * * * * * * * * * * 17838000 * RW = CURRENT VALUE OF OUCOUNT. IF =1,NEW HEADING NEEDED * 17840000 * RX = BASE REGISTER * 17842000 * RY = UNUSED AT PRESENT * 17844000 * RZ = @ RSBLOCK BELONGING TO STATEMENT BEING PROCESSED. * 17846000 * R14= INTERNAL LINK REGISTER. LOCAL WORK REGISTRE. * 17847000 * R15= LOCAL WORK REGISTER. * 17847500 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 17848000 SPACE 1 17850000 OUTPT2 $SAVE RGS=(R14-R6),SA=NO LEAVE R15 AS IS 17852000 LR RX,R15 MOVE @ OUTPT2 OVER FOR NEW BASE 17852200 DROP R15 REMOVE OLD USING 17852400 USING OUTPT2,RX NOTE NEW USING 17852600 SPACE 1 17854000 * COMMON INITIALIZATION. MAKE PROCESSOR CHOICE, BASED * 17856000 * ON CONTENTS OF REG RB. PRINT IF PRINT ON, OR INSTRUCTION IS * 17858000 * A LISTING CONTROL, OR ANY STMT WITH AN ERROR IN IT. * 17860000 SPACE 1 17862000 L RZ,AVRSBPT GET POINTER TO RSBLOCK 17864000 USING RSBLOCK,RZ NOTE POINTER 17866000 LH RW,OUCOUNT GET WITHIN PAGE COUNT 17868000 MVC OUTLINE(OUTLEN),AWBLANK BLANK OUT LEFT HAND SIDE 17872000 AIF (NOT &$MACROS).OUNGEN SKIP IF NO MACRO CODE 17872100 SPACE 1 17872200 TM RSBFLAG,$RSBGENR WAS THIS GENERATED STMT 17872300 BZ OUNGEN NO, NORMAL, SKIP 17872400 MVI OUSOURC-1,C'+' MARK OUTPUT AS GENERATED 17872500 TM AVPRINT,$IBPGEN IS PRINT GEN: SHOULD WE PRINT 17872600 BO OUNGEN PRINT GEN-DEFINITELY PRINT 17872700 * FOLLOWING STMTS ALLOW GENERATED PRINT STMTS TO BE USED. 17872800 * WARNING: EXTENSION FROM ASMBLER F. 17872900 CH RB,=AL2($OULIST) IS IT LISTING CONTROL STMT 17873000 BNE OUTRETE NO, NOT LISTING CONTROL - GO CHK 17873100 CH RE,=H'2' WS IT ACTUALLY PRINT 17873200 BNE OUTRETE NO, SO IGNORE IT 17873300 * YES, FALL THRU AND DO IT 17873400 OUNGEN EQU * SKIP HERE IF NOT GEN'D STMT 17873500 SPACE 1 17873600 .OUNGEN ANOP 17873700 LH R14,OUJUMP1(RB) GET PRIMARY TUPE OF STATEMENT 17874000 TM AVPRINT,$IBPON+$IBPLIST SET CC=3 IF PRINT ON AND LIST 17876000 OUTJ1 BAL R14,OUTJ1(R14) GO TO RIGHT CODE, WITH CC SET 17878000 * IF SPECIFIC STMT TYPE CODE DOESN'T WANT TO PROCESS IT, 17879000 * IT CAN RETURN HERE VIA A BCR NO,R14, AND STMT WON'T BE 17880000 * PRINTED UNLESS IT HAS ERRORS IN IT. 17881000 SPACE 1 17888000 OUTRETE TM RSBFLAG,$REBX+$RSBMERR ARE THERE ANY ERRORS/ERR RECRD 17890000 BZ OUTRETA XKIP IF NONE,PRINT STMT IF SO 17892000 EJECT 17894000 * OUTSTMT - FORMAT AND PRINT STATEMENT,WITH ERRORS * 17896000 * NORMALLY ENTERED AFTER INDIVIUDAL TYPE PROCESSING. 17897000 OUTSTMT EQU * COME HERE IF STMT SHOULD BE PRINTED 17897100 AIF (NOT &$MACROS).OUNMAC1 SKIP IF NO MACROS ALLOWED 17897200 TM RSBFLAG,$RSBNPNN WAS THIS NOT TO BE NUMBERED 17897300 BO OUTSTMTN NO NUMBER - SKIP EDITING 17897400 .OUNMAC1 ANOP 17897500 SPACE 2 17897600 MVC OUDSTMNT-1(6),AWEP6 COPY THE EDIT PATTERN 17898000 ED OUDSTMNT-1(6),OULNCNT FORMAT STATEMENT # 17900000 * GET 1ST(OR ONLY) CARD-IMAGE IN PLACE FOR PRINTING * 17902000 * NEXT STMT ASSUMES 1ST CARD OF SEVERAL IS 71 BYTES LONG. 17903990 OUTSTMTN LA R1,RSOL1-1 NORMAL LENGTH-1, CLEAR FOR INSERT 17904000 L R2,AVRSCPT GET @ RSCBLK,IF IT EXISTS 17906000 USING RSCBLK,R2 NOTE USING,FOR ANY SECTION REQUIRING 17908000 CLI RSBNUM,1 WAS THERE ONLY 1 CARD 17910000 BNE OUTC1B NO, SKIP, R1 ALREADY SET OK 17912000 OUTC1A IC R1,RSBLENG GET THE LENGTH OF RSBLOCK, 1 SOURCE 17924000 LA R1,(255-RSB$L)(R1) SUBTRACT LENGTH, LOW-ORDER BYTE-WISE 17926000 MVC OUSOURCE,AWBLANK+9 BLANK STMT, CONT/SEQNO 17926100 SPACE 1 17926200 AIF (NOT &$MACROS).OUNMAC2 SKIP IF NO MACRO 17926300 TM RSBFLAG,$RSBMERR SPECIAL ERROR FORMT STMT 17926400 BZ OUTC1B NO, SO SKIP SPECIAL FORMATTING 17926500 SPACE 1 17926600 * SPECIAL ERROR MESSAGE - ISSUED BY MACRO PROCESSOR - 17926700 * STMT IMAGE IS CONSTRUCTED TEXT OF ERROR MESSAGE. 17926800 * **NOTE** THESE ARE NOT CURRENTLY COUNTED AS ERRORS 17926900 STC R1,OURSBMOV+1 PUT L-1 INTO MOVE FOR MESSAGE 17927000 MVC OUTLINE+1(L'OUTERRAS-1),OUTERRAS+1 ERROR PTR ON LEFT 17927100 MVC OUCONSQ+1(8),OUTEREND+1 ERROR PTE ON RIGHT 17927200 OURSBMOV MVC OUTLINE+L'OUTERRAS($),RSBSOURC MOVE MESSAGE IN 17927300 B OUTSPRNT GO PRINT WITHOUT FURHTER ADO 17927400 .OUNMAC2 ANOP 17927500 SPACE 1 17928000 OUTC1B STC R1,*+5 STORE LENGTH-1 INTO NEXT INSTR 17930000 MVC OUSOURC($CHN),RSBSOURC MOVE VARIABLE LENGTH OVER 17932000 SPACE 1 17933000 * PLACE CONTINUATION SEQNO IN IF NEEDED * 17934000 TM RSBFLAG,$RSCX DO WE HAVE CONT/SEQN 17936000 BZ OUTSPRNT NO,DON'T NEED CONT/SEQN 17938000 MVC OUCONSQ,RSCONSQ MOVE FIELD IN 17940000 SPACE 1 17942000 OUTSPRNT EQU * POINT FOR PRINTING 1ST /ONLY CARD 17942100 OUTSPRNU BAL R14,OUTLNSA HAVE THE STMT PRINTED 17942700 CLI RSBNUM,1 WAS THERE ONLY 1 CARD(HOPE) 17946000 BNE OUTSCON NO(GROAN)-MULTIPLE CARDS IN STMT 17948000 TM RSBFLAG,$REBX WERE THERE ERRORS 17950000 BNZ OUTERR BRANCH IF ERRORS(UNFORTUNATE) 17952000 SPACE 1 17954000 OUTRETA STH RW,OUCOUNT SAVE WITHIN PAGE COUNT 17956000 AIF (NOT &$MACROS).OUNMAC3 SKIP IF NO MACROS 17956100 TM RSBFLAG,$RSBNPNN SEE IF SHOULDN'T INCRE STMT # 17956200 BO OUTRETAA SKIP OVER STMT# ADD INSTR(S) J 17956300 .OUNMAC3 AP OULNCNT,AWP1 BUMP STMT # TO # OF NEXT ONE 17956400 AIF (NOT &$XREF).NOXRF10 A 17956405 AP AVXRLNCN,AWP1 INCREMENT ADDITIONAL LINE COUNTER A 17956410 .NOXRF10 ANOP A 17956415 OUTRETAA EQU * BRANCH HERE BEFORE EXIT J 17957000 $DBG C0,* JUST TRACE ON EXIT 17958000 OUTRET $RETURN RGS=(R14-R6),SA=NO 17960000 EJECT 17962000 * * * * * OUTSCON - HANDLE PRINTING OF CONTINUATION CARDS.SET UP OFFSE* 17964000 * * * * * REGISTER USAGE * 17966000 * R1 = CURRENT COUNT OF # CARDS REMAINING TO BE PRINTED(INIT-RSBNUM)* 17968000 * R2 = @ CURRENT RSCBLK SECTION BEING PROCESSED * 17970000 * RD = CURRENT TOTAL OFFSET. USED TO EXTRACT CARDS,SET ERROR MESSGS * 17972000 * INIT. LOOP THOURHG OUTSCON2 FOR EACH CONT/CARD. SET * 17974000 * UP OFFSETS IN OUTOFFS FOR USE IN ERROR POINTERS. * 17976000 SPACE 1 17978000 OUTSCON SR R1,R1 CLEAR FOR INSERTION 17980000 IC R1,RSBNUM GET TOTAL # OF CARDS 17982000 LA RC,OUTOFFS(R1) GET @ LAST BYTE FOR OFFSETS 17984000 MVI 0(RC),RSB$L MOVE BEGINNING OFFSET IN 17986000 SR RD,RD CLEAR FOR INSERT 17988000 IC RD,RSCILEN GET LENGTH OF 1ST CARDIMAGE 17990000 LA RD,RSB$L(RD) INCREMENT LENGTH BY 1ST OFFSET 17992000 STC RD,OUTOFFS-1(R1) STORE IN APPROPRAITE PART OF OUTOFFS 17994000 BCTR R1,0 DECREMENT # CARDS LEFT TO DO 17996000 MVC OUTLINE,AWBLANK BLANK WHOLE LINE 17998000 SPACE 1 18000000 OUTSCON2 LA R2,RSC$LEN(R2) BUMP RSCB POINTER TO NEXT FIELD 18002000 LA RC,RSBLOCK(RD) GET @ NEXT SOURCE CARD ELEMENT 18004000 SR RB,RB CLEAR FOR INSERT 18006000 IC RB,RSCILEN GET LENGTH OF NEXT CARD 18008000 AR RD,RB ADD TO TOAL OFFSET LENGTH 18010000 STC RD,OUTOFFS-1(R1) STORE NEXT OFFSET INTO LIST 18012000 BCTR RB,0 DECREMENT FOR LENGTH-1 18014000 STC RB,*+5 SAVE INTO MVC 18016000 MVC OUSOURC+15($CHN),0(RC) MOVE CARD IMAGE OVER 18018000 MVC OUCONSQ,RSCONSQ MOVE CONT/SEQNO OVER 18020000 BAL R14,OUTLNSA HAVE STMT PRINTED 18022000 STC RB,*+5 PUT LENGTH-1 INTO NEXT MVC 18024000 MVC OUSOURC+15($CHN),AWBLANK BLANK OUT PART OF LINE USE 18026000 BCT R1,OUTSCON2 LOOP UNTIL WHOLE STATEMENT FINISHED 18028000 SPACE 1 18030000 TM RSBFLAG,$REBX DO ERRORS EXIST 18032000 BZ OUTRETA NO ERRORS - QUIT 18034000 EJECT 18036000 * * * * * OUTERR - PRINT ERROR MESSAGES AND SCAN POINTERS * 18038000 * R2 = # ERROR CODE/SCAN POINTER PAIRS (= 1 TO $ERREBMX). * 18040000 * RE = CUMULATIVE COUNT OF ERRORS(NOT WARNINGS) THOURGHOUT SECTION. * 18042000 OUTERR L RD,AVREBPT GET POINTER TO ERRORS 18044000 USING REBLK,RD NOTE USING 18046000 LH RE,AVNERRA GET ACTUAL # ERRORS 18048000 LH R14,AVSTMTER GET TOTAL # STMT ERRORS 18050000 LA R14,1(R14) INCREMENT TO SHOW 1 MORE STMT FLAGD 18052000 STH R14,AVSTMTER STORE BACK UPDATED POINTER 18054000 SR R2,R2 CLEAR FOR INSERTION 18056000 IC R2,REBLN GET TOTAL ELNGTH OF ERROR BLOCK 18058000 SRL R2,1 DIVIDE BY TO=#ERRORS 18060000 SR R1,R1 CLEAR FOR CONSTANT INSERTS 18062000 SPACE 1 18063000 OUTERR1 IC R1,REBSCN GET SCAN POINTER 18064000 CLI RSBNUM,1 WAS THERE ONLY 1 STATEMENT 18066000 BE OUTERR5 SKIP OVER MULTIPLE SECTION IF SO 18068000 SPACE 1 18070000 * SECTION FROM HERE TO OUTERR5 REQUIRED FOR MULT CARDS. * 18072000 SR RC,RC CLEAR FOR INSERT 18074000 IC RC,RSBNUM GET NUMBER OF CARDS 18076000 SR R0,R0 CLEAR FOR INSERTS 18078000 OUTERR3 IC R0,OUTOFFS-1(RC) GET LIMIT SCAN POINTER FOR CARD 18080000 CR R0,R1 COMPARE WITH ERROR POINTER 18082000 BH OUTERR4 BRANCH OUT IF CORRECT SPOT FOUND 18084000 BCT RC,OUTERR3 LOOP FOR # OF CARDS 18086000 B OUTERR5 NOT FOUND-WILL BE TOO HIGH 18088000 OUTERR4 IC R0,OUTOFFS(RC) GET BEGINNING SCAN POINTER 18090000 SR R1,R0 GET OFFSET FROM CARD BEGINNING 18092000 LA R1,RSB$L(R1) ADD SCAN OFFSET FROM RSBLOCK 18094000 IC R0,RSBNUM GET # OF CARDS 18096000 CR R0,RC SEE IF SAME,I.E. IN 1ST CARDIMAGE 18098000 BE OUTERR5 SKIP OVER-ITS IN 1ST CARD,SO OK 18100000 LA R1,15(R1) CONTINUATION CARD-BUMP POINTER 18102000 SPACE 1 18104000 * FOLLOWING CONCLUDES PROCESSING FOR SINGLE CARD STMTS * 18106000 OUTERR5 LA RC,OUTEOFF(R1) GET @ WHERE $ SHOULD GO 18108000 LA R0,OUTEREND GERT LAST POSSIBLE SCAN POINTER 18110000 CR R0,RC MAKE SURE POINTER NOT BEYOND END 18112000 BNL *+6 SKIP IF OK 18114000 LR RC,R0 USE LAST POSSIBLE OFFSET @ 18116000 * RC = @ FOR $ SCAN POINTER AT THIS POINT. * 18118000 IC R1,REBERR GET THE ERROR CODE 18118500 AIF (&$OPTMS GT 2).OUOP1 SKIP IF BIG MEMORY 18118550 * SMALL SPACE==> NO PTRS, JUST MULT CODE BY 3/2. 18118600 LR RB,R1 MOVE ERROR CODE OVER 18118650 SRL RB,1 ITS EVEN NUMBER, SO DIVIDE BY 2 18118700 AR R1,RB = 3/2 CODE, DESIRED NUMBER 18118750 LA RB,OUERRMS-3-1(R1) @-1 OF 3BYTE ERROR NUMBER 18118800 AGO .OUOP2 18118850 .OUOP1 ANOP 18118900 LH RB,OUERRPT(R1) GET OFFSET TO ERROR MESSAGE 18119000 LA RB,OUERRMS(RB) GET ACTUAL @ ERROR MESSAGE 18119500 .OUOP2 ANOP 18119600 * INCREMENT ERROR OR WARNING MESSAGE TOTAL COUNT. 18119700 LA R15,1 SET UP FOR ERROR-WARNING INC 18120000 CLI 1(RB),C'0' WAS ERR # FROM 000-099 (WARNING) 18122000 BE *+10 YES, BRANCH IF IT IS A WARNING 18124000 AR RE,R15 INCREMENT # ERRORS (AVNERRA) 18126000 B *+12 BRANCH OVER WARNING CODE 18128000 AH R15,AVNWARN INCREMENT # WARNING MESSAGES 18130000 STH R15,AVNWARN PUT # WARNINGS BACK 18132000 SPACE 1 18134000 * SET UP MESSAGE, SCAN POINTER. PRINT MESSAGE. 18136000 AIF (&$OPTMS GT 2).OUOP3 SKIP IF LARGE MEMORY 18136100 MVC OUTERMS(3),1(RB) MOVE ERROR # INTO MSG 18136200 AGO .OUOP4 SKIP REGUALR CODE 18136300 .OUOP3 ANOP 18136400 IC R1,0(RB) GET LENGTH-1 OF ERROR MESSAGE 18140000 STC R1,OUTERR6+1 SAVE INTO BLANKING MVC 18142000 STC R1,*+5 STORE TO MOVE MESSAGE INTO BUFFER 18144000 MVC OUTERMS($CHN),1(RB) MOVE ERROR MESSAGE INTO BUFFER 18146000 .OUOP4 ANOP 18147000 MVI 0(RC),C'$' PLACE SCAN POINTER IN 18148000 LA RA,OUTERROR SET UP @ ERROR LINE 18150000 BAL R14,OUTLNS HAVE ERROR MESSAGE PRINTED 18152000 SPACE 1 18153000 AIF (&$OPTMS LE 2).OUOP5 SKIP IF SMALL MEMORY 18153500 OUTERR6 MVC OUTERMS($CHN),OUBLDASH RESTORE BLANKS-DASHES 18154000 .OUOP5 ANOP 18155000 MVI 0(RC),C'-' FILL IN DASH WIPED BY $ 18156000 LA RD,2(RD) INCREMENT ERROR BLOCK PTR 18158000 BCT R2,OUTERR1 LOOP FOR NUMBER OF ERRORS 18160000 SPACE 1 18162000 * UPDATE ERROR COUNT & CHECK FOR EXCEEDING LIMIT. 18164000 STH RE,AVNERRA STORE UPDATED ERROR COUNT 18166000 CH RE,AVNERR COMPARE TO ERROR LIMIT 18168000 BNH OUTRETA IF STILL OK,BRANCH 18170000 OI AVTAGS1,AJNLOAD FLAG NOLOAD,NO MORE OBJECT CODE 18172000 B OUTRETA GO RETURN 18174000 EJECT 18176000 * * * * * RB=$OUMACH - FORMAT LEFT-SIDE FOR MACHINE INSTRUCTIONS * * * 18178000 OUMACH EQU * 18179000 BCR NO,R14 RETURN UNLESS PRINT ON AND LIST 18180000 L R14,AVRCBPT GET # RCB TO PICK UP INFO 18181000 USING RCODBLK,R14 NOTE USING 18182000 UNPK OULOC(7),RCLOC(4) UNPACK LOCATION COUNTER 18184000 MVI OULOC+6,C' ' BLANK OT EXTRA BYE 18186000 DROP R14 LOCATION COUNTER ALL THAT WAS NEEDED 18188000 USING ICBLOCK,RC NOTE INSTRUCTION CODE BLOCK 18190000 * RD = LENGTH-1 OF INSTRUCTION = 1,3,5. * 18192000 UNPK OUOPR1R2(5),ICBOPR1R(3) GET OPCODE-R1-R2 FIELD 18194000 MVI OUOPR1R2+4,C' ' BLANK OUT EXTRA BYTE 18196000 C RD,AWF3 CHECK LENGTH-1 AND SET CC 18198000 BL OUMACH1 ONLY 2 BYTE INSTRUCTION-QUIT 18200000 UNPK OUOPN1(5),ICBOPN1(3) UNPACK 1ST BASE-DISP 18202000 MVI OUOPN1+4,C' ' BLANK OUT END BYTE 18204000 BE OUMACH1 IF RD=3,==> 4 BYTE INST-QUIT 18206000 UNPK OUOPN2(5),ICBOPN2(3) 6-BYTE INST.UNPK 2ND B-D 18208000 MVI OUOPN2+4,C' ' BLANK OUT END BYTE 18210000 SPACE 1 18212000 * OBJECT CODE ALL UNPACKED - NOW CHECK FOR INSTRUCT ADDRS* 18214000 OUMACH1 TM ICBFLAG,$ICBEA1 WAS THERE A 1ST INST ADDR 18216000 BZ OUMACH2 NO,DON'T LOOK FOR ONE 18218000 UNPK OUEA1+1(6),ICBEA1+1(4) GET 5 BYTES OF ADDRESS OVE 18220000 OUMACH2 TM ICBFLAG,$ICBEA2 WAS THERE A 2ND ADDRESS TO BE PRINTE 18222000 BZ OUMACH3 NO THERE WASN'T,BRANCH 18224000 UNPK OUEA2+1(6),ICBEA2+1(4) GET 5 BYTES OF ADDR 18226000 OUMACH3 TR OUTLINE+1(OUTLENM),AWTHEX3 TRANSLATE TO FINISH 18228000 B OUTSTMT GO HAVE STATEMENT PRINTED OUT 18230000 SPACE 1 18232000 * * * * * RB=$OUCONS - FORMAT LEFT-SIDE WITH LOC,CONSTANT IF NEEDED * * 18234000 OUCONS EQU * 18235000 BCR NO,R14 RETURN IF NOT PRINT ON, LIST 18236000 L R14,AVRCBPT GET @ RCB FOR INFO THERE 18237000 USING RCODBLK,R14 NOTE POINTER 18238000 UNPK OULOC(7),RCLOC(4) CONVERT THE LOCATION COUNTER 18240000 MVI OULOC+6,C' ' BLANK OT EXTRA BYE 18242000 DROP R14 18244000 LTR RD,RD IS LENGTH-1 <0,WHICH ==> NO CONSTANT 18246000 BM OUCONS2 NO CONSTANT - TRANSLATE LOCCNTR&QUIT 18248000 C RD,AWF7 IS LENGTH-1 > 7 18250000 BNH *+8 SKIP NEXT IF WITHIN RANGE 18252000 LA RD,7 USE ONLY 1ST 8 BYTES OF CONSTANT 18254000 SPACE 1 18256000 LA R14,0(RD,RD) GET 2*(L-1 OF CODE) FOR UNPACK LENGT 18258000 LA R15,OUCONST(R14) SAVE @ LAST UNPACKED BYTE 18260000 SLL R14,4 SHIFT OVER INTO 1ST NIBBLE OF LOW BT 18262000 AR RD,R14 PUT LENGTHS INTO LOW-ORDER BYTE 18264000 STC RD,*+5 STORE INTO UNPK INSTRUCTION 18266000 UNPK OUCONST($CHN),0($CHN,RC) CONVERT CONST CODE 18268000 UNPK 1(1,R15),0(1,R15) DUPLICATE AND REVERSE NIBBLES 18270000 OI 0(R15),X'F0' MAKE DIGIT PRINTABLE 18272000 OI 1(R15),X'F0' FIX UP LAST BYTE 18274000 OUCONS2 TR OUTLINE+1(24),AWTHEX3 CONVERT OT HEX OUTPUT 18276000 B OUTSTMT GO PRINT PUT STATEMENT 18278000 EJECT 18280000 * * * * * RB=$OULIST - LISTING CONTROL - SPACE,EJECT,PRINT,TITLE * * * 18282000 OULIST EQU * ""=3 IF PRINT ON, LIST OPTION 18284000 LH R15,OUJUMP2(RE) GET SECONDARY BRANCH CODE 18285000 OUTJ2 B OUTJ2(R15) BRANCH TO STMT TYPE, DON'T CHANGE CC 18286000 SPACE 1 18288000 * * * * * OUSPEJ - PROCESS SPACE OR EJECT,USING # OF LINES TO BE SPACD* 18290000 * AT THIS PT, CC MUST =3, ELSE NO SPACING DONE. 18292000 OUSPEJ BCR NO,R14 QUIT, (RETURN TO OUTRETE 18294000 LA RD,1 SET COUNTER CLEAR 18296000 LA RA,AWBLANK @ BLANK LINE 18296050 CLI 0(RC),255 REAL EJECT ? 18296100 BE OUSPEJ1A YES, GO DO THE EJECT 18296200 IC RD,0(RC) GET # OF LINES TO BE PSACED 18298000 OUSPEJ1 SR RW,RD GET # LINES LEFT ON THIS PAGE 18298200 BP OUSPEJ2 SKIP SOME LEFT - PRINT BLANK LINES 18298300 LCR RD,RW # BLANKS TO BE PRINTED AFTER TITIL 18298400 BZ OUTITL2 IF NO BLANK LINES, JUST RESET TITLE 18298500 OUSPEJ1A BAL R14,OUTLNSTI HAVE TITLE LINES PRINTED 18298600 B OUSPEJ1 LOOP-BE SAFE FOR PRINT 200 ETC 18298700 OUSPEJ2 BAL R14,OUXPRNT PRINT 1 BLANK LINE 18298800 BCT RD,OUXPRNT GO PRINT BLANK LINES 18308000 B OUTRETA GO RETURN 18310000 SPACE 1 18312000 * * * * * OUPRINT - PROCESS PRINT INSTRUCTION. RC = @ CONTROL BYTE * 18314000 OUPRINT MVC AVPRINT,0(RC) MOVE PRINT CONTROL BYTE OVER 18316000 B OUTRETE NOT ON,GO CHECK FOR ERRORS 18332000 SPACE 1 18334000 * * * * * OUTITLE - BRING IN NEW TITLE,FLAG TITLE EXISTS,PRINT IF ON. * 18336000 OUTITLE MVC OUHEADNG,AWBLANK BLANK THE HEADING OUT 18338000 STC RD,*+5 STORE LENGTH-1 OF NEW TITLE INTO MVC 18340000 MVC OUHEADNG($CHN),0(RC) MOVE NEW HEADING INTO FIEL 18342000 OUTITL2 LA RW,1 SET COUNT SO WILL CREATER HEADER NXT 18344000 B OUTRETE GO MAKE SURE THERE WAS NO ERROR 18352000 SPACE 2 18354000 OUCOMM EQU * COME HERE FOR COMMENTS, SPEC ERRS 18356000 BCR NO,R14 PRINT OFF/NOLIST - RETURN 18357000 B OUTSTMT PRINT LIST AND ON - GO PRINT STMT 18358000 EJECT 18360000 **--> INSUB: OUTLNSA/OUTLNS PRINT 1 LINE (WITH HEADING IF NEEDED)+ + + 18360050 *+ PRINTS A 121 BYTE LINE, DECREMENTS REMAINING LINE COUNT. + 18360100 *+ ENTRY CONDITIONS + 18360150 *+ RA = @ 121-BYTE LINE TO BE PRINTED (OUTLNS ONLY). + 18360200 *+ RW = LINE COUNT REMAINING. IF = 1, WILL PRODUCE HEADING. + 18360250 *+ R14= RETURN @ TO CALLING SECTION OF CODE. + 18360300 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 18360350 SPACE 1 18360400 OUTLNSA LA RA,OUTLINE ENTRY FOR MOST COMMON @ 18360450 OUTLNS BCT RW,OUXPRNT DECREMENT REMAINING, BRANCH IF OK 18360500 SPACE 1 18360550 * A HEADING AND PAGE SKIP ARE REQUIRED IF FALLS THRU HERE. 18360600 OUTLNSTI LR RW,RA SAVE ORIG LINE @ PTR INTO RW 18360650 LR R15,R14 SAVE THE ORIGIANL RETURN @ IN R15 18360700 SPACE 1 18362000 AP OUPGCNT,AWP1 INCREMENT PAGE COUNT 18366000 MVC OUPCNT,AWEP4 MOVE EDIT PATTERN OVER 18368000 ED OUPCNT,OUPGCNT EDIT PAGE COUNT OVER 18370000 LA RA,OUHEAD1 SHOW @ 1ST HEADING (TITLE) 18370100 BAL R14,OUXPRNT PRINT IT 18370200 LA RA,OUHEAD2 SHOW @ 2ND HEADNING 18370300 BAL R14,OUXPRNT HAVE IT PRINTED 18370400 SPACE 1 18370500 LR RA,RW RESTORE OLD LINE @ 18370600 LR R14,R15 RESTORE OLD RETURN @ 18370700 SPACE 1 18370800 LH RW,OUH#LINE GET # LINES LEFT TO DO 18370900 MVI OUHEAD1,C'1' MAKE SURE SET FOR PAGE SKIP 18371000 MVC OUH#LINE,=AL2($OU#NORM) SET COUNTERSETTER NORMAL 18371100 * FALL THRU INTO OUXPRNT TP PRINT STMT ITSELF. 18371200 SPACE 1 18371300 **--> INSUB: OUXPRNT LOW-LEVEL PRINT ROUTINE- 121-BYTE LINE + + + + 18380000 *+ ROUTINE PRINTS 1 LINE (NORMAL), OR ELSE BRANCHS TO CMPRS + 18380050 *+ OPTION CODE TO SAVE/PRINT 2 STMTS PER LINE, IF CMPRS CODE + 18380100 *+ EXISTS AND USER SPECIFIES THE OPTION. + 18380150 *+ ENTRY CONDITIONS + 18380200 *+ RA = @ 121-CHARACTER LINE TO BE PRINTED + 18380250 *+ R14= RETURN @ TO CALLING SECTION OF CODE. + 18380300 *++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 18380350 SPACE 1 18380400 OUXPRNT EQU * ENTRY FOR PRINTING OR SAVING 18380450 AIF (NOT &$CMPRS).OUXCM1 SKIP IF NO CMPRS CODE 18380500 TM AVTAGS2,AJOCMPRS IS CMPRS OPTION IN EFFECT 18380550 BO OUXCMINT YES, GO TO PROCESS NEW STMT 18380600 SPACE 1 18398000 .OUXCM1 ANOP 18400000 $PRNT 0(RA),121 PRINT 1 NORMAL LINE 18401000 BCR Z,R14 RETURN IF NO OVERFLOW 18401450 OI AVTAGS2,AJOASTOP RECORDS OVER-SHOW FLAG FOR STOPPING 18401500 BR R14 RETURN TO CALLING SECTION. 18402000 AIF (NOT &$CMPRS).OUXCM2 SKIP IF NO CMPRS OPTION 18402010 EJECT 18402020 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18402030 * CMPRS OPTION PROCESSING - 2 STMTS/LINE * 18402040 * THIS SECTION PERFORMS ALL MANIPULATION AND PRINTING REQUIRED TO * 18402050 * PRODUCE A LISTING IN WHICH THE FIRST HALF OF APPROX. 120 STMTS * 18402060 * IS PRINTED ON THE LEFT SIDE OF A PAGE, AND THE OTHER HALF ON THE * 18402070 * OTHER SIDE, THUS REDUCING THE LINES PRINTED BY THE ASSEMBLER BY * 18402080 * APPROXIMATELY 1/2. IT CONSISTS OF THE FOLLOWING STEPS: * 18402090 * INITIALIZATION CODE: OUXCMINT : CONVERTS NONBLANK CARRIAGE * 18402100 * CONTROL LINES TO BLANK LINES FOLLOWED BY ACTUAL LINES. * 18402110 * ALSO SAVES REGISTERS WHICH WILL BE MODIFIED BY THIS SECTION. * 18402120 * PHASE 'A' CODE : ENTERED FOR EACH LINE UNTIL ENTIRE LHS OF PAGE * 18402130 * IS STORED, THEN SETS FLAGS FOR PHASE 'B'. * 18402140 * PHASE 'B' CODE : OUXCMB : BUILD AND PRINT LINE CONSISTING OF * 18402150 * ONE STMT SAVED DURING PHASE 'A' AND THE LINE JUST GIVEN. * 18402160 * WHEN ALL SAVED STMTS HAVE BEEN PRINTED, RESET TO PHASE 'A'. * 18402170 * **NOTE** THIS SECTION IS ALSO USED FROM OUEND2 ENTRY. * 18402180 * REGISTER USAGE IN THIS SECTION * 18402190 * RA = @ INCOMING LINE TO BE PRINTED. * 18402200 * RB = @ CMPRS WORKAREA (OUCMPRSD DSECT) * 18402210 * RC = @ NEXT EMPTY STMT SLOT, NEXT TO BE PRINTED / WORK REG. * 18402220 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18402230 SPACE 1 18402240 **--> INSUB: OUXCMINT ENTRY POINT FOR CMPRS HANDLING + + + + + + + + 18402250 * INITIAL SECTION - CHECK FOR NONBLANK CARRIAGE CONTROL. + 18402260 * ENTRY CONDTIONS (ENTIRE SECTION) + 18402270 * RA = @ 121-BYTE LINE IMAGE FOR OUTPUT (OUSTMTIM DSECT) + 18402280 * R14= RETURN @ TO CALLING SECTION OF CODE + 18402290 * *NOTE* MODIFIES NO REGISTERS, DOES USE AVDWORK1&AVDWORK2. + 18402300 * NAMES: OUXCM--- + 18402310 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 18402320 SPACE 1 18402330 USING OUSTMTIM,RA NOTE DSECT FOR CONVENIENCE 18402340 OUXCMINT STM RA,RC,AVDWORK1 INTO AVDWORK1,AVDWORK2 D'S 18402350 CLI OUSTCC,C' ' WAS CARRIAGE CONTROL NORMAL ' ' 18402360 BE OUXCMPRT YES, DON'T NEED DO FIXUP-BRANHC 18402370 SPACE 1 18402380 * NONBLANK CC - INSERT BLANK LINE, SAVING/RESTORING REGS. 18402390 ST R14,AVDWORK2+4 SAVE INTO TEMPORARY AREA 18402400 LA RA,AWBLANK SHOW @ BLANK LINE 18402410 BAL R14,OUXCMPRT CALL INTERIOR SECTION 18402420 L RA,AVDWORK1 RESTORE ORIG LINE @ 18402430 L R14,AVDWORK2+4 RESTORE REAL RETURN @ 18402440 SPACE 1 18402450 * OUXCMPRT - GET WORKAREA @, CHOOSE CURRENT PHASE A,B 18402460 OUXCMPRT L RB,OUCMPRAD GET @ CMPRS CONTROL BLOCK 18402470 USING OUCMPRSD,RB NOTE THE POINTER 18402480 TM OUCMPHAS,OUCMPHSB IS IT PHASE B (PRINTOUT) 18402490 BO OUXCMB YES, SO GO TO PRINT OUT 2 STMTS 18402500 EJECT 18402510 * PHASE 'A' - SAVE STMT IMAGES UNTIL AREA FULL. 18402520 L RC,OUCMSTMT GET @ NEXT SLOT FOR STMT SEGMENT 18402530 MVC 0(OUCM$L1,RC),OUSTP1 GET 1ST SECTION OF STMT 18402540 MVC OUCM$L1(OUCM$L2,RC),OUSTP2 2ND STMT SECTION (SOURCE) 18402550 LA RC,OUCM$LT(RC) INCREMENT SLOT PTR TO NEXT ONE 18402560 ST RC,OUCMSTMT STORE UPDATED SLOT PROINTER BACK 18402570 SPACE 1 18402580 LH RC,OUCMLEFT GET # EMPTRY SLOTS LEFT THIS TIME 18402590 S RC,AWF1 DECREMENT # EMPTRY SLOTX 18402600 STH RC,OUCMLEFT RESTORE UPDATED # SLOTS 18402610 BP OUXCMRET IF SLOTS LEFT, GO TO EXIT CODE 18402620 SPACE 1 18402630 * NO EMPTY SLOTS LEFT FOR STMTS. RESET VARIABLES AND 18402640 * FLAG SO ENTERS PHASE 'B' OF CMPRS PROCESSING NEXT TIME. 18402650 OUXCMA1 LA RC,OUCMSAVE INIT @ TO 1ST SAVED STMT 18402660 ST RC,OUCMSTMT INIT PTR TO 1ST SAVED STMT 18402670 MVC OUCMLICC,OUCMCCIN INIT CARRIAGE CONTROL 1ST STMT 18402680 MVI OUCMCCIN,C'1' MAKE SURE NEW PAGE FOR PAGES 2- 18402690 OI OUCMPHAS,OUCMPHSB SHOW NOW PHASE 'B' 18402700 B OUXCMRET GO TO RETURN CODE 18402710 SPACE 2 18402720 * PHASE 'B' - RETIRIEVE AND PRINT SAVED STMT WITH NEW 1. 18402730 OUXCMB L RC,OUCMSTMT GET @ NEXT STMT TO PRINT 18402740 MVC OUCMSTMA,0(RC) MOVE THE STMTS TO PRINT AREA 18402750 MVC OUCMSTMB(OUCM$L1),OUSTP1 GET 1ST SECTION OF NEW 1 18402760 MVC OUCMSTMB+OUCM$L1(OUCM$L2),OUSTP2 2ND SECT OF NEW 18402770 $PRNT OUCMLINE,133 PRINT THE ENTIRE LINE, 2 STMTS 18402780 BM OUXCMOVR OVER NOW ON PRINTER-STOP 18402785 SPACE 1 18402790 MVI OUCMLICC,C' ' MAKE SURE CC IS ' ' FOR REST OF PAGE 18402800 LA RC,OUCM$LT(RC) INCREMENT PTR TO NEXT SAVED STMT 18402810 ST RC,OUCMSTMT STORE BACK UPDATE PTR @ 18402820 SPACE 1 18402830 LH RC,OUCMLEFT GET # EMPTY SLOTS LEFT 18402840 LA RC,1(RC) INCREMNT # EMPTY (JUST PRINTED 1) 18402850 STH RC,OUCMLEFT RESTORE UPDATED # EMPTRY SLOTS 18402860 CH RC,OUCMOPAG IS EMPTY # = # ON PAGE 18402870 BL OUXCMRET NO, STILL MORE TO DO, RETURN 18402880 SPACE 1 18402890 * HAVE PRINTED ALL SAVED STMTS, RETURN TO PHASE 'A' 18402900 LA RC,OUCMSAVE GET @ FIRST SLOT 18402910 ST RC,OUCMSTMT RE-INIT TO @ FIRST SLOT 18402920 LA RC,$OU#LNS NORMAL # LINES PER PAGE 18402930 STH RC,OUCMOPAG SET # ON PAGE TO NORMAL # FOR SURE 18402940 STH RC,OUCMLEFT SET COUNTER VALUE NORMAL TOO 18402950 NI OUCMPHAS,255-OUCMPHSB REST TO PHASE 'A' 18402960 SPACE 1 18402970 * OUXCMRET - EXIT CODE - RESTORE REGS,RETURN 18402980 OUXCMRET LM RA,RC,AVDWORK1 RESTORE REGS FROM SAVED WORDS 18402990 BR R14 RETURN TO CALLING SECTION OF CODE 18403000 OUXCMOVR OI AVTAGS2,AJOASTOP FLAG OVERRRUN 18403003 B OUXCMRET GO TO EXIT FROM CMPRS SECTION 18403006 DROP RA,RB REMOVE USINGS 18403010 .OUXCM2 ANOP 18403020 EJECT 18404000 **--> ENTRY: OUEND2 2 PRINT ENDING STATISTICS FOR ASSMBLY . . . . . 18406000 *. OUEND2 IS CALLED AT THE END OF THE ASSEMBLY TO PRINT SUMMARY . 18406100 *. OF ERRORS AND WARNINGS ISSUED. FIRST LINE PRINTED GIVES . 18406200 *. TOTAL # OF STMTS FLAGGED, TOTAL # ERRORS, TOTAL # WARNINGS. . 18406300 *. IF MAXIMUM # ERRORS IS EXCEEDED, ANOTHER LINE IS PRINTED. . 18406400 *. USES DSECTS: AVWXTABL . 18406500 *. USES MACROS: $PRNT,$RETURN,$SAVE . 18406600 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18408000 OUEND2 $SAVE SA=NO 18410000 AIF (NOT &$CMPRS).OUENC1 SKIP IF NO COMPRS CODE 18410020 SPACE 1 18410040 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18410060 * CMPRS OPTION COMPLETION CODE * 18410080 * SET UP COMMON USING CONDITIONS WITH OUTPT2, AND TEST * 18410100 * FOR CMPRS OPTION IN EFFECT. IF IT IS, THEN HAVE ANY * 18410120 * STATEMENTS PRINTED WHICH HAD BEEN SAVED, BUT NOT YET * 18410140 * PRINTED. * 18410160 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18410180 SPACE 1 18410200 TM AVTAGS2,AJOCMPRS DID USER SPECIFY CMPRS OPTION 18410220 BZ OUENCMNO NO HE DIDNT, SKIP 18410240 SPACE 1 18410260 STM R14,RX,12(R13) STORE REGS, ESPEC RX,R14 18410280 L RX,=A(OUTPT2) GET ADDR (SAFE IN OVERLAY) J 18410300 DROP R15 REMOVE OLD USING 18410320 USING OUTPT2,RX NOTE COMMON USING WITH OUTPT2 18410340 SPACE 1 18410360 * TEST PHASE OF CMPRS HANDLING. IF STMTS LEFT, SET TO 18410380 * PHASE B TO DUMP THOSE LEFT, IF NOT ALREADY PHASE B. 18410400 L RB,OUCMPRAD GET @ CONTROL BLOCK FOR CMPRS 18410420 USING OUCMPRSD,RB NOTE CONTROL BLOCK USING 18410440 TM OUCMPHAS,OUCMPHSB ARE WE IN PHASE B ALREADY 18410460 BO OUENPHSB YES, JUMP TO FINISH 18410480 BAL R14,OUXCMA1 IN PHASE A, CALL THIS TO SET TO B 18410500 L RB,OUCMPRAD RELOAD RB, WHICH WAS ERASED 18410520 SPACE 1 18410540 * CMPRS HANDLER IN PHASE 'B' - PRINT ANY REMAINING STMTS 18410560 OUENPHSB LH RD,OUCMOPAG GET # ON PAGE 18410580 SH RD,OUCMLEFT DIFFERENCE = # LEFT TO DO 18410600 BNP OUENCMDN NO STMTS LEFT, NO PRINTING NEEDED 18410620 LA RA,AWBLANK SHOW @ FAKE BLANK LINE 18410640 SPACE 1 18410660 BAL R14,OUXCMINT GO TO PRINT 1 MORE STMT/BLANK LINE 18410680 BCT RD,*-4 LOOP UNTIL ALL LINES LEFT PRINTED 18410700 SPACE 1 18410720 OUENCMDN LM R14,RX,12(R13) RESTORE REGS, ESP RX,R14 18410740 DROP RB REMOVE USING 18410760 USING OUEND2,R15 RESTORE REGULAR USING 18410780 EJECT 18410800 OUENCMNO EQU * NORMAL OUEND2 PROCESSING 18410820 .OUENC1 ANOP 18410840 SPACE 1 18411000 TM AVTAGS3,AVOVERFL DID OVERFLOW OF STORAGE OCCUR 18411100 BZ OUNOVRFL NO, DON'T PRINT MSG 18411200 $PRNT OUAS999,OUAS999L PRINT THE MESSAGE 18411300 OUNOVRFL EQU * BRANCH HERE IF STORAGE OK 18411400 SPACE 1 18411500 ZAP AVDWORK1,OULNCNT MOVE LINE COUNT OVER FOR CONVERT 18412000 CVB RE,AVDWORK1 CONVERT THE LINE COUNT TO BINARY 18414000 STH RE,AVSTMTNO SAVE AS NUMBER OF STATEMENTS 18416000 SPACE 1 18418000 LH RE,AVSTMTER GET # STATEMENTS FLAGGED 18420000 LA RD,OUSTMTER GET @ TO PUT RESULT 18422000 BAL RC,OUENCONV GO CONVERT VALUE 18424000 SPACE 1 18426000 LH RE,AVNWARN # WARNINGS ISSUED 18428000 LA RD,OUNWARN @ FOR RESULT 18430000 BAL RC,OUENCONV GO CONVERT VALUE 18432000 SPACE 1 18434000 LH RE,AVNERRA ACTUAL # ERRORS 18436000 LA RD,OUNERRA @ FOR RESULT 18438000 BAL RC,OUENCONV CONVERT VALUE 18440000 $PRNT OUEND2M,OUEND2ML PRINT 1ST MESSAGE 18442000 SPACE 1 18444000 LH RE,AVNERR GET LIMIT # ERRORS 18446000 CH RE,AVNERRA COMPARE TO ACTUAL 18448000 BNL OUENDREA SKIP TO EXIT CODE IF OK 18450000 SPACE 1 18451000 LA RD,OUNERR GET @ FOR CONVERTED RESULT 18452000 BAL RC,OUENCONV GO CONVERT ACTUAL # 18454000 $PRNT OUEND2N,OUEND2NL PRINT 2ND MESSAGE 18456000 SPACE 1 18457000 OUENDREA EQU * EXIT CODE LABEL 18457050 AIF (&$COMNT EQ 0).OUNCOM2 SKIP IF NO COMMENT CHEKCING 18457100 EJECT 18457150 * FINAL CHECK - IF COMMENT CHECK OPTION IN EFFECT, 18457200 * MAKE SURE PROGRAMMER HAS SUPPLIED COMMENTS ON AT LEAST 18457250 * &$COMNT PER CENT OF MACHINE INSTRUCTIONS. IF NOT, 18457300 * DELETE HIS EXECUTION. SEE OUINT1 AND IAMOP1 FOR CODE. 18457350 SPACE 1 18457400 TM AVTAGS2,AJOCOMNT IS COMMENT OPTION IN EFFECT 18457450 BZ OUENDRET NO, SO SKIP 18457500 SPACE 1 18457550 LH RE,AVMACHIN # MACHINE INSTRUCTIONS 18457600 MH RE,=H'&$COMNT' * PERCENT REQUIRED TO HAVE COMMENTS 18457650 LH RD,AVCOMNTN # COMMENTS ON THE MACH INSTRS 18457700 MH RD,=H'100' BY 100 FOR COMPARISON 18457750 CR RD,RE IS COMNTN>= MACHIN*&$COMNT/100 18457800 BNL OUENDRET YES, SO HE HAD ENOUGH COMMENTS-OK 18457850 SPACE 1 18457900 * INSUFFICIENT COMMENTS - ZAP USER WITH MESSAGE. 18457950 OI AVTAGS1,AJNLOAD NO EXECUTION 18458000 $PRNT OUEND2P,OUEND2PL PRINT THE MESSAGE 18458050 SPACE 1 18458100 .OUNCOM2 ANOP 18458150 OUENDRET $RETURN SA=NO RETURN TO CALLER 18458200 SPACE 1 18460000 * * * * * OUENCONV - CONVERT AND EDIT INTEGER TO 6 BYTE FIELD * 18462000 * ENTRY CONDTIONS * 18464000 * RC = RETURN @ TO CALLING SECTION * 18466000 * RD = @ 6-BYTE FIELD WHERE CONVERTED AND EDITED RESULT TO BE PLACED* 18468000 * RE = VALUE TO BE CONVERTED TO DECIMAL * 18470000 * EXIT CONDTIONS * 18472000 * 6-BYTE FIELD AT 0(RD) HAS EDITED RESULT, WITH 'NO' IF RE=0. * 18474000 OUENCONV LTR RE,RE IS RESULT 0 18476000 BZ OUENCONO YES, SO PU 'NO' IN 18478000 CVD RE,AVDWORK1 CONVERT VALUE TO DECIMAL 18480000 MVC 0(6,RD),AWEP6 MOVE 6-BYTE EDIT PATTERN IN 18482000 ED 0(6,RD),AVDWORK1+5 EDIT THE FIELD 18484000 BR RC RETURN TO CALLER 18486000 OUENCONO MVC 0(6,RD),=CL6' NO ' VALUE = 0, USE 'NO' INSTEAD 18488000 BR RC RETURN TO CALLER 18490000 EJECT 18492000 * * * * * INTERNAL CONSTANTS * 18494000 * PRIMARY TYPE BRANCH OFFSETS * 18496000 OUJUMP1 $AL2 OUTJ1,(OUMACH,OUCONS,OULIST,OUCOMM) 18498000 * SECONDARY BRANCH OFFSETS FOR LISTING CONTROL. * 18500000 OUJUMP2 $AL2 OUTJ2,(OUSPEJ,OUPRINT,OUTITLE) 18502000 SPACE 1 18504000 * * * * * INTERNAL VARIABLES * 18506000 OUCOUNT EQU AVOUCOUN H, WITHIN-PAGE LINES REMAINING 18508000 OULNCNT EQU AVOULNCN PL3 - STATEMENT # 18510000 OUPGCNT EQU AVOUPGCN PL2 - # PAGES 18512000 OUTOFFS DS ($RSMXCRD+1)C SPACE FOR SAVING OFFSETS FOR CARDS 18514000 OUH#LINE DS H # LINES PER PAGE, EXCEPT HEADING 18514500 AIF (NOT &$CMPRS).OUECMPA SKIP IF NO CMPRS MODE 18514600 OUCMPRAD DS A @ OUCMPRSD AREA, IF CMPRS OPT USED 18514700 .OUECMPA ANOP 18514800 SPACE 1 18516000 * PAGE HEADING 1 - TITLE FIELD,IF ANY, PAGE NUMBER * 18518000 DS 0D ALIGNMENT FOR MODEL 65+ 18520000 OUHEAD1 DS 0CL121 18522000 DC CL8'1' CARRIAGE CONTROL 18524000 OUHEADNG DS CL100 SPACE FOR TITLE FIELD 18526000 DC CL9' PAGE ' 18528000 OUPCNT DS ZL4 PAGE NUMBER 18530000 SPACE 1 18532000 * PAGE HEADING 2 - COLUMN HEADINGS AND DATE * 18534000 DS 0D ALIGNMENT FOR MODEL 65+ 18536000 OUHEAD2 DS 0CL121 18538000 DC C'0 LOC ' CARRIAGE CONTROL, LOCATION COUNTER 18540000 DC C'OBJECT CODE ADDR1 ADDR2 STMT SOURCE STATEMENT' 18542000 DC CL54' ' 18544000 OUDATE DC CL8' ' DATE (IF AVAILABLE) 18546000 EJECT 18548000 * OUTPUT BUFFER SETUP FOR ALL STATEMENTS * 18550000 DS 0D ALIGNMENT FOR SPEED IN MODELS 65+ 18552000 OUTLINE DS 0CL121 18554000 DS C CARRIAGE CONTROL 18556000 OULOC DS XL6 SPACE FORLOCATION COUNTER 18558000 DS C 18560000 OUCONST DS 0XL16 SPACE FOR UP TO 8 BYTES CONVERTED 18562000 OUOPR1R2 DS XL4 SPACE FOR CONVERTED OPCODE-R1-R2 18564000 DS C 18566000 OUOPN1 DS XL4 CONVERTED 1ST BASE-DISPLACEMENT 18568000 DS C 18570000 OUOPN2 DS XL4 CONVERTED 2ND BASE DISPLACEMENT 18572000 OUEA1 DS XL6 CONVERTED 1ST INSTRUCTION ADDRESS 18574000 OUEA2 DS XL6 CONVERTED 2ND INSTRUCTION ADDRESS 18576000 DS C 18578000 OUTLENM EQU *-OULOC LENGTH FOR TRANSLATE: MACHINE OPS 18578010 SPACE 1 18580000 OUDSTMNT DS ZL5 STATEMENT NUMBER 18582000 DS C BLANK OR PLUS 18584000 OUTLEN EQU *-OUTLINE LENGTH FOR BLANKING ORIGINAL 18585000 OUSOURCE DS 0CL80 SOURCE STATEMENT 18586000 OUSOURC DS CL71 SOURCE CARD,WITHOUT CONT/SEQNO 18588000 OUCONSQ DS CL9 CONTINUATION/SEQUENCE # FIELD 18590000 SPACE 1 18592000 * OUTPUT BUFFER SETUP FOR ERROR MESSAGES * 18594000 DS 0D 18596000 OUTERROR DS 0CL121 ERROR LINE 18598000 OUTERRAS DC CL9' ----->AS' ERROR FLAG - LEFT 18600000 OUTERMS DC CL32' ' SPACE FOR ERROR MESSAGE 18602000 OUTEOFF EQU *-RSB$L OFFSET FROM SOURCE IMAGE 18604000 DC 72C'-',CL8' <-ERROR' SPACE FOR $, END FLAG 18606000 OUTEREND EQU *-9 @ LAST POSSIBLE SCAN POINTER 18608000 AIF (&$OPTMS LE 2).OUOP5A SKIP IF SMALL MEMORY 18609000 OUBLDASH DC CL(L'OUTERMS)' ',18C'-' FOR REBLANKING ERROR FIELD 18610000 .OUOP5A ANOP 18611000 SPACE 1 18612000 * FINAL MESSAGE(S) ON STATEMENTS FLAGGED,WARNINGS,ETC. * 18614000 * THIS SECTION USED BY ENTRYPT OUEND2. 18615000 OUEND2M DC C'0***' 18616000 OUSTMTER DC ZL6'0',C' STATEMENTS FLAGGED -' 18618000 OUNWARN DC ZL6'0',C' WARNINGS,' # WARNINGS ISSUED 18620000 OUNERRA DC ZL6'0',C' ERRORS' # ERRORS 18622000 OUEND2ML EQU *-OUEND2M LENGTH OF THIS MESSAGE 18624000 SPACE 1 18626000 OUEND2N DC C'0***** NUMBER OF ERRORS EXCEEDS LIMIT OF' 18628000 OUNERR DC ZL6'0',C' ERRORS - PROGRAM EXECUTION DELETED *****' 18630000 OUEND2NL EQU *-OUEND2N LENGTH OF THIS ERROR MESSAGE 18632000 AIF (&$COMNT EQ 0).OUNCOM3 SKIP IF NO COMMENT CHEK 18632100 OUEND2P DC C'0***** EXECUTION DELETED - LESS THAN &$COMNT ' 18632200 DC C'PER CENT OF MACHINE INSTRUCTIONS HAVE COMMENTS *****' 18632300 OUEND2PL EQU *-OUEND2P GET LENGTH OF WHOLE MESSAGE 18632400 SPACE 1 18632500 .OUNCOM3 ANOP 18632600 SPACE 1 18632800 OUAS999 DC C'0AS999' MESSAGE NUMBER 18632810 AIF (&$OPTMS LE 2).OUAS999 SKIP IF LOW CORE USAGE 18632820 DC C' DYNAMIC STORAGE EXCEEDED' 18632830 .OUAS999 ANOP 18632840 OUAS999L EQU *-OUAS999 LENGTH OF MESSAGE 18632850 LTORG 18634000 EJECT 18636000 * ERROR POINTERS AND ERROR MESSAGES * 18638000 * FOR ADDRESSIBILITY, THIS SECTION SHOULD BE LAST. * 18640000 * **NOTE** FOR SMALL COMPUTERS, THIS CODE CAN BE GREATLY * 18642000 * BY MODIFYING MACRO $SERR TO GENERATE ONLY THE ERROR NUMBERS. * 18644000 AIF (&$OPTMS LE 2).OUOP6 SKIP IF SMALL MEMORY 18645000 * THE PROGRAM LOGIC REMIANS UNCHNAGED, BUT 1100 BYTES CAN BE * 18646000 * SAVED WHICH ARE CURRENTLY TAKEN BY THE ERROR MESSAGES. * 18648000 * THE TABLE CONSISTS OF 2 SECTIONS: A HALFWORD OFFSET * 18648100 * @ LIST, AND A LIST OF MESSAGES CREATED BY $SERR'S, * 18648200 * WHICH ARE POINTED TO BY THE OFFSET @'S. * 18648300 SPACE 1 18648400 DS 0H ALIGN ON HALF WORD BPUNDARY 18650000 OUERRPT EQU *-2 . OFFSET TO 1 ' BACKWARDS 18652000 DS (&$ERNUM/2)H . SPACE FOR HALFWORD ERROR POINTERS 18654000 .OUOP6 ANOP 18654100 EJECT 18655000 OUERRMS EQU * BASE ADDRESS FOR ERROR MESSAGES 18656000 ALIGN $SERR 'W-ALIGNMENT ERROR-IMPROPER BOUNDARY',000 18658000 ENTRY $SERR 'W-ENTRY ERROR-CONFLICT OR UNDEFINED',001 18660000 EXTRN $SERR 'W-EXTERNAL NAME ERROR OR CONFLICT',002 18662000 RGNUS $SERR 'W-REGISTER NOT USED',003 18664000 ODDRG $SERR 'W-ODD REGISTER USED-EVEN REQUIRED',004 18666000 NOEND $SERR 'W-END CARD MISSING-SUPPLIED',005 18668000 ADDR $SERR 'ADDRESSIBILITY ERROR',100 18670000 CNLNG $SERR 'CONSTANT TOO LONG',101 18672000 CNTYP $SERR 'ILLEGAL CONSTANT TYPE',102 18674000 CONT $SERR 'CONTINUATION CARD COLS. 1-15 NONBLANK',103 18676000 CONTX $SERR 'MORE THAN 2 CONTINUATION CARDS',104 18678000 CXREL $SERR 'COMPLEX RELOCATABILITY ILLEGAL',105 18680000 DCEXT $SERR 'TOO MANY OPERANDS IN DC',106 18682000 DPCSE $SERR 'MAY NOT RESUME SECTION CODING',107 18684000 DUPLF $SERR 'ILLEGAL DUPLICATION FACTOR',108 18686000 EXGTA $SERR 'EXPRESSION TOO LARGE',109 18688000 EXLTA $SERR 'EXPRESSION TOO SMALL',110 18690000 ICNOP $SERR 'INVALID CNOP OPERAND(S)',111 18692000 ILLAB $SERR 'LABEL NOT ALLOWED',112 18694000 ILORG $SERR 'ORG VALUE IN WRONG SECTION OR TOO LOW',113 18696000 INVCN $SERR 'INVALID CONSTANT',11