* /* START OF SPECIFICATIONS **** 00050020 *02* PROCESSOR = ASSEMBLER 00100020 **** END OF SPECIFICATIONS ***/ 00150020 GBLC &COMPNM,&ASMID 00240020 SPACE 2 00320020 JHEAD 'ASSEMBLY PHASE - DC EVALUATION', X00400020 PHASEID=X5D, X00480020 LEVEL=10 00560020 * * 00640020 *FUNCTION * 00720020 * 1. SCAN DC/DS/DXD OPERAND FIELDS ENCODED IN TEXT-BUCKET FORMAT. * 00800020 * NOTE- LITERAL-POOL GENERATED CONSTANTS ARE PROCESSED IN THE SAME * 00816020 * MANNER AS DC OPERANDS. * 00832020 * 2. CONVERT ALL CONSTANTS TO HEXADECIMAL AND OUTPUT THE REQUIRED * 00848020 * OBJECT CODE, EXCEPT ON DS/DXD CALLS, FOR PRINTING AND/OR PUNCHING.* 00864020 * 3. LIST THE CORRESPONDING SOURCE OR GENERATED STATEMENTS. * 00880020 * 4. ALIGN AND INCREMENT THE LOCATION-COUNTER FOR EACH CONSTANT * 00960020 * THAT DOES NOT HAVE A SYNTACTIC ERROR. PRINTING AND/OR PUNCHING * 01040020 * ALIGNMENT BYTES WHERE REQUIRED. * 01043220 * 5. OUTPUT RLD RECORDS FOR A-, Y-, V- AND Q-TYPE CONSTANTS. * 01046420 * 7. LOG THOSE ERRORS THAT ARE DETECTED. * 01049620 * * 01049720 *ENTRY POINT * 01049820 * DCEVAL * 01049920 * * 01050020 *INPUT * 01066020 * R10 POINTS TO THE 1ST TEXT-BUCKET OF THE OPERAND FIELD. * 01069220 * R7 POINTS TO THE ASSEMBLY PHASE WORK AREA, X5COM. * 01072420 * THE HALF-WORD AT LCTRSAV+D8 IS A COUNT OF THE NUMBER OF VALID * 01075620 * OPERANDS. * 01078820 * FLAGS IN THE COMMON REGION ARE SET TO INDICATE THE TYPE * 01079420 * OF CALL- * 01080020 * DSSW - DS STATEMENT * 01080620 * DXDSW - DXD STATEMENT * 01081220 * * 01081820 *OUTPUT * 01081920 * NO INFORMATION IS RETURNED TO THE CALLING ROUTINE. IN DC AND * 01082020 * LITERAL-POOL CONSTANTS, OBJECT CODE IS PASSED TO THE PRINT/PUNCH * 01085220 * ROUTINE FOR OPTION-CONTROLLED OUTPUT. SIMILARLY, PRINT/PUNCH IS * 01088420 * CALLED FOR STATEMENT LISTING. RLD RECORDS ARE OUTPUT FOR THOSE * 01089020 * RELOCATABLE A- AND Y-TYPE CONSTANTS AND VALID V- AND Q-TYPE * 01089620 * CONSTANTS WHICH OCCUR IN A DC OR LITERAL-POOL IN A REAL CONTROL- * 01089720 * SECTION, WITHOUT A ZERO DUP-FACTOR. * 01089820 * THE LOCATION-COUNTER WILL BE ALIGNED AND INCREMENTED AS REQUIRED. * 01089920 * SEMANTIC ERRORS ARE LOGGED BUT DO NOT AFFECT THE LOCATION-COUNTER * 01090020 * ADJUSTMENTS. * 01090620 * * 01091220 *EXTERNAL REFERENCES * 01091320 * IFNX5A21 - FOR LOCATION-COUNTER ALIGNMENT * 01091420 * IFNX5A31 - FOR LOCATION-COUNTER INCREMENTING * 01094620 * IFNX5A41 - FOR RLD OUTPUT * 01097820 * IFNX5A51 - FOR XREF OUTPUT * 01098420 * IFNX5F01 - FOR FIXED- AND FLOATING-POINT CONVERSION * 01099020 * IFNX5L01 - FOR ERROR LOGGING * 01099620 * IFNX5P01 - FOR PRINT/PUNCH * 01100220 * IFNX5V01 - FOR EXPRESSION EVALUATION * 01100820 * * 01100920 *EXITS, NORMAL * 01101020 * THIS ROUTINE ALWAYS EXITS NORMALLY, VIA THE JRETURN MACRO. * 01104220 * * 01107420 *EXITS, ERROR * 01108020 * NONE * 01108620 * * 01109220 *TABLES/WORK AREAS * 01109820 * ONLY ONE INTERNAL TABLE IS USED - * 01110420 * DCTABLE CONTAINS THE INFORMATION NECESSARY TO PROCESS EACH * 01110520 * CONSTANT TYPE. * 01113720 * EXTERNAL TABLES ACCESSED ARE - * 01114320 * JTRTABLE - INTERNAL-TO-EXTERNAL CHARACTER-SET TRANSLATE TABLE, * 01114420 * USED FOR C-TYPE CONSTANT. * 01114520 * USINGT - USED FOR ADDRESS DECOMPOSITION IS S-TYPE CONSTANTS. * 01114620 * WORK SPACE IS CURRENTLY 106 BYTES, FULL-WORD ALIGNED, AT LOCATION * 01114720 * WORKAREA IN THE X5COM AREA. * 01117920 * * 01118520 *ATTRIBUTES * 01119120 * REENTRANT, READ-ONLY, REUSABLE * 01119720 * * 01119820 *NOTES * 01119920 * THE STATUS OF PRINTSW IS SAVED ON ENTRY AND RESTORED ON EXIT. * 01120020 * * 01123220 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - COPY CODE' 01126420 PRINT OFF DON'T PRINT JCOMMON COPY CODE 01127020 COPY JCOMMON COPY ASSEMBLER COMMON MODULE 01127620 PRINT OFF DON'T PRINT JTEXT COPY CODE 01128220 COPY JTEXT GET TEXT DEFINITION 01200020 PRINT OFF DON'T PRINT X5COM COPY CODE 01250020 COPY X5COM GET COMMON WORK AREA DSECT 01360020 PRINT OFF DON'T PRINT JERMSGCD COPY CODE 01370020 COPY JERMSGCD DEFINE ERROR CODES AND SEVERITY 01380020 PRINT ON WE'RE PAST THE COPY CODE 01410020 SPACE 2 01420020 BASE EQU X'01' BASE MASK - XREF DEFN 01440020 REF EQU X'02' REFERENCE MASK - XREF 01520020 DUP EQU X'03' DUPLICATE MASK - XREF 01600020 USING X5COM,R7 ESTABLISH COMMON USING 01680020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - INITIALIZATIO01730020 ON' 01780020 JCSECT (X5D00) START MODULE CSECT 02000020 * VS1 RELEASE 2 CHANGES 02050020 *A027700-027920,075700 OX00221 02060020 * VS1 RELEASE 2.6 CHANGES 02070002 *A718900-719120 OX00223 02072026 *A027800-027980,045300,075720 OX00107 02074002 *C075700 OX00107 02076002 * VS1 RELEASE 3.1 CHANGES 02078031 *C527200,5278800 OX02675 02078431 *A027700 OY02614 02078831 * VS2 RELEASE 3.0 CHANGES 02079231 *C359200 OY02610 02079631 *A025100 @OX08862 02079705 *A593500,593520 @OY06592 02079805 *C593600 @OY06592 02079905 *A480100,481500 @OX09734 02080305 *C736800,737000 @OX09734 02080705 *C614400,615200 @OZ04407 02080805 *C603200,604000 @OX08876 02081205 *C623200 @OY11250 02131206 *C475600-480100 D78 @AX21436 02135200 JMODID , CREATE MODULE ID 02140005 DCEVAL JSAVE BASE=YES SAVE ENTRY REGISTERS 02160020 JENTRY (X5D01=DCEVAL) DEFINE ENTRY POINT 02240020 XC CLEAR2(CLEAR1-CLEAR2),CLEAR2 CLEAR BIG WORK 02320020 XC X5ATEMP,X5ATEMP CLEAR ERROR LOGGING AREA 02360020 XC DCLNG,DCLNG CLEAR ACC LENGTH AREA 02410020 XC ZDUPSW,ZDUPSW CLEAR ZERO DUPFACTOR SWITCH 02420020 LR R6,R10 SET TEXT POINTER 02460020 ST R10,JFWORD2 SAVE OPER ADDR @OX08862 02510005 LITSKIP MVC DCPRSW,PRINTSW SAVE PRINT SWITCH 02720020 NI EVALMODE,BITFF-(SUBLIST) JUST IN CASE OY02614 02770031 LR R4,R10 SAVE REG OX00107 02780002 BCTR R4,0 POINT TO LENGTH OX00107 02790002 CLI 0(R4),X'00' LENGTH EQ ZERO OX00107 02792002 BNE LITSKIP1 BRANCH IF NOT ZERO OX00107 02794002 SET NOOP,ON SET FLAG FOR NO OPERAND OX00107 02796002 LITSKIP1 EQU * OX00107 02798002 GOIF DSSW,ON=SETPDUM IS ENTRY A DS 02800020 GOIF DXDSW,OFF=PNODUM NO, IS THIS DXD 02880020 SETPDUM OI PRINTSW,BIT5 TURN ON PRINT DUMMY-BIT 02960020 MVI DUMSW,TESTER AND LOCAL DUMMY FLAG 03040020 PNODUM LA R5,LEFTHF SET PRINT-AREA BASE 03120020 USING LEFTHF,R5 ESTABLISH LEFT HALF USING 03200020 L R1,ELCTR GET CURRENT LC 03280020 LA R1,D0(,R1) CLEAR WRAP BITS 03360020 ST R1,LOCATN TO PRINT 03440020 SLL R1,D3 CHANGE TO BITS 03520020 ST R1,BITLC SET BIT LC 03600020 XC DCDATA,DCDATA CLEAR PRINT DATA 03680020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - NEXT OPERAND*03730020 INIT && DUP FACTOR CHECK' 03810020 NEXTOP XC WORKAREA(CLEAR2-WORKAREA),WORKAREA SMALL CLEAR 03920020 MVI TUBEOP,TESTER-TESTER TURN OFF DUP FACTOR ERROR IND 03960020 LH R1,OPNDCT STEP 04000020 LA R1,D1(,R1) OPERAND 04080020 STH R1,OPNDCT COUNT 04160020 SET XRFNO,ON SET XREF SWITCH ON 04240020 MVC LCTRSAV+D12,ELCTR SAVE LOCATION COUNTER 04320020 MVC LCTRSAV+D10(D2),OBITS SAVE OUTPUT BIT COUNT 04400020 SPACE 5 04480020 GOIF NOOP,ON=NOOPRND TEST IF NO OPERAND OX00107 04530002 LA R11,D1 PRE-SET VALUE TO 1. 04560020 BAL R9,EVAL1 GO SET UP EVAL CALL 04640020 B DFZCHEK0 GO CHECK FOR ZERO DUPLICATION 04720020 GOIF D0(R6),JLPARN,NE=DFVSET IS THERE AN EXPRESSION 04800020 SET (SUBLIST,PRDEFREQ),ON INIT SWITCHES ON 04900020 LR R10,R6 POINT AT LEFT PAREN 05040020 JCALL EVAL CALL THE EVALUATION ROUTINE 05120020 JEXTRN (X5V01=EVAL) DEFINE EVAL AS EXTERNAL 05200020 LR R6,R14 RESTORE POINTER 05280020 BC D1,DUPERR FATAL DUP FACTOR ERROR BRANCH 05360020 BZ DFZCHEK LOG ERROR IF NOT ABSOLUTE 05440020 DSCAN2 MVI TUBEOP,TESTER INDICATE DUP FACTOR ERROR 05520020 LA R11,D1 DUMMY UP DUP FACTOR 05600020 B DFZCHEK GO SAVE DUP FACTOR 05650020 DFZCHEK0 LTR R11,R11 SELF DEFINING ZERO 05660020 BNZ DFVSET SET VALUE 05670020 OI ZDUPSW,BITFF INDICATE SELFDEF ZERO 05672020 DFZCHEK LTR R11,R11 TEST FOR ZERO DUP FACTOR 05680020 BP DFVSET NO - POSITIVE - OK 05730020 BM DSCAN2 NO - NEGATIVE - NOT OK 05780020 OI ZDUPSW,TESTER SET ZERO DUP-FACTOR FLAG 05840020 DFVSET ST R11,DUPF SAVE DUP FACTOR 05920020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - TYPE RANGE CH06000020 HECK' 06016020 GOIF D0(R6),JALFAMIN,LT=TYPERR CHECK TYPE FOR LEGAL 06080020 GOIF D0(R6),JALFAMAX,GT=TYPERR RANGE OF ALLOWABLE TYPES 06160020 MVC TYPE(D1),D0(R6) SAVE TYPE 06240020 TR TYPE(D1),DCTRBL-JALFAMIN TRANSLATE TYPE 06320020 SR R3,R3 ZERO REGISTER 06400020 IC R3,TYPE GET TYPE 06480020 LTR R3,R3 IS TYPE VALID 06560020 BZ TYPERR BRANCH IF ILLEGAL TYPE 06640020 BCTR R3,0 DECREMEN FOR LOOKUP 06720020 MH R3,TABLENG TIMES LENGTH OF TABLE 06800020 LA R3,DCTABLE(R3) PLUS TABLE ORIGIN 06880020 LH R1,IMPLINC(,R3) IMPLIED LENGTH 06960020 ST R1,LMOD TO L-MODIFIER 07040020 SLL R1,D3 BYTES TO BITS 07120020 ST R1,BITMOD IN BIT-LENGTH MODIFIER 07200020 LA R6,D1(,R6) STEP TEXT PNTR 07280020 B LTEST GO TEST FOR LENGTH MODIFIER 07360020 TYPERR ST R6,ERRPTR SAVE ERROR COLUMN PTR 07440020 X5ERRL 198,CLMPTR INVALID DC,DS, OR DXD TYPE 07470020 TM TUBEOP,TESTER DUP FACTOR ERROR 07500020 BZ STMEND NO 07530020 DUPERR X5ERRL 206,0,STMEND INVALID DUPFACTOR 07560020 NOOPRND SET NOOP,OFF RESET FLAG OX00107 07570002 X5ERRL 62,0,STMEND OMITTED OPERAND OX00221,OX00107 07572002 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - CHECK AND ALI07576020 IGNMENT IF NONE' 07592020 LTEST GOIF D0(R6),JL,NE=LNOBIT IS THERE A LENGTH MODIFIER 07680020 LA R6,D1(,R6) STEP OVER L BUCKET 07760020 MVI LMODSW,TESTER TURN ON EXPLICIT-LENGTH FLAG 07840020 GOIF D0(R6),JPERIOD,NE=LNOBIT IS LENGTH MODIFIER BIT LENGTH 07920020 TM FLAGINC(R3),BIT1 IS BIT LENGTH LEGAL 08000020 BO LTEST1 YES,BRANCH AROUND 08080020 ST R6,ERRPTR SAVE COLUMN PTR FOR LOGGING 08160020 B LIMITH GO LOG LENGTH ERROR 08260020 LTEST1 MVI BITLSW,TESTER YES, TURN ON BIT-LENGTH FLAG 08400020 LA R6,D1(,R6) STEP OVER POINT BUCKET 08480020 B TUBECHK TO CHECK INTERLUDE ERROR 08560020 LNOBIT LH R2,OBITS GET OUTPUT-BIT COUNT 08640020 LA R2,D7(,R2) PAD PARTIAL BYTE 08720020 N R2,BYTEMSK 08800020 STH R2,OBITS 08880020 CLI OBITS+D1,D8*D8 CHECK FULL OUTPUT 08960020 BL SETEMP NO 09040020 LA R1,ENTDC SET FOR DC PRINT 09120020 L R12,=A(DCPRINT) SET FOR DCPRINT 09200020 BALR R9,R12 BRANCH TO ROUTINE 09280020 SETEMP L R1,BITLC PAD BIT LOCATION COUNTER 09360020 AH R1,SEVEN TO BYTES AND 09440020 SRL R1,D3 STORE IN TEMPORARY LC 09520020 LA R1,D0(,R1) CLEAR WRAP BIT 09600020 ST R1,TEMPLC 09680020 L R2,ELCTR GET NON-WRAP 09760020 LA R2,0(,R2) CURRENT LC 09840020 SR R1,R2 CHECK FOR PADDING INCREMENT 09920020 BZ NOLCINC NO 10000020 ST R1,LOCLEN YES, SET 1 BYTE INCREMENT 10080020 JCALL LOCUPD CALL LOCATION COUNTER UPDATE 10160020 JEXTRN (X5A31=LOCUPD) DEFINE EXTERNAL SYMBOL 10240020 NOLCINC L R1,TEMPLC UPDATE BIT LC 10320020 SLL R1,3 10400020 ST R1,BITLC 10480020 TM LMODSW,TESTER WAS THERE AN L-MODIFIER 10560020 BNZ TUBECHK YES 10640020 LH R2,ALININC(,R3) NO, GET ALIGNMENT 10720020 EX R2,ALNTEST IS ALIGNMENT REQUIRED 10800020 BZ NOLIGN NO 10880020 TM ZDUPSW,BITFF ZERO SELF DEF DUP FACTOR 10890020 BO ALIGN0 YES DO ALWAYS ALIGN IF NEEDED 10892020 GOIF JALGN,OFF=NOLIGN DON'T ALIGN IF NOALIGN OPTION 10900020 ALIGN0 SET VLIT,ON TURN ON SWITCH FOR ALIGN 10960020 JCALL ALIGN CALL ALIGNMENT ROUTINE 11040020 SET VLIT,OFF TURN OFF SWITCH USED IN ALIGN 11120020 JEXTRN (X5A21=ALIGN) DEFINE EXTERNAL SYMBOL 11200020 MVC LCTRSAV+D12,ELCTR SAVE LOC CTR 11240020 L R4,ELCTR GET ALIGNED LC 11280020 LA R4,D0(,R4) CLEAR WRAP BITS 11360020 SLL R4,D3 UPDATE BIT LC 11440020 ST R4,BITLC STORE BIT LOCATION CAONTER 11520020 TM DUMSW,TESTER ARE WE IN DS OR DXD 11600020 BZ LNODUM NO 11680020 MVC LOCATN,ELCTR UPDATE PRINT LC 11760020 XC DCDATA,DCDATA CLEAR PRINT DATA 11840020 MVI OBITS+D1,D0 CLEAR OUTPUT-BIT COUNT 11920020 B NOLIGN TO CHECK PASS 1 ERROR 12000020 * TO PRINT INTER-OPERAND ALIGNMENT ON SEPARATE LINES, REPLACE THE 12080020 * FOLLOWING SEGMENT OF CODE WITH THE COMMENT CODE. 12160020 LNODUM CLI OPNDCT+D1,D1 IS THIS 1ST OPERAND 12240020 BE ALINOUT YES, PRINT SEPARATE ALIGNMENT 12320020 LA R10,ALINMT POINT TO ALIGN BYTES 12400020 SR R2,R2 CLEAR BIT REMAINDER 12480020 L R11,FULLWD GET BYTE COUNT 12560020 SLL R11,D3 CONVERT TO BIT COUNT 12640020 L R12,=A(KOUTPUT) CALL OUTPUT 12720020 BALR R9,R12 BRANCH TO ROUTINE 12800020 B NOLIGN 12880020 *LNODUM CLI OBITS+D1,D0 CHECK ANY OUTPUT LEFT 12960020 * BE ALINOUT NO 13040020 * LH R2,OBITS YES, PRINT THEM 13120020 * LA R1,X'40' 13200020 * LA R12,DCPRINT 13280020 * BALR R5,R12 13360020 ALINOUT L R2,FULLWD GET BYTES SKIPPED 13440020 LA R1,ENTALN SET FOR ALIGNMENT PRINT 13520020 L R12,=A(DCPRINT) SET FOR DCPRINT 13600020 BALR R9,R12 CALL ROUTINE 13680020 TUBECHK EQU * BRANCH LABEL 13760020 NOLIGN TM TUBEOP,TESTER INVALID DUP FACTOR 13790020 BZ NOLIGN2 OK 13820020 X5ERRL 206,0,STMEND3 INVALID DUP FACTOR 13850020 NOLIGN2 MVC STRTLC(D4),BITLC SAVE OPERAND START 13880020 TM LMODSW,TESTER CHECK EXPLICIT LENGTH 13920020 BZ STEST NO, TO S-MOD TEST 14000020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - EVALUATE LENG14080020 GTH MODIFIER' 14160020 BAL R9,EVAL1 GO SET UP EVAL CALL 14240020 B SETLMOD TO STORE 14320020 CLI D0(R6),JLPARN IS IT LEFT PAREN? 14340020 BNE LDELIM3 GO LOG ERROR IF NOT 14360020 SET (SUBLIST,PRDEFREQ),ON SET SUBLIST AND PRDEFREQ BITS 14400020 LR R10,R6 POINT AT LEFT PAREN 14640020 JCALL EVAL CALL THE EVALUATION ROUTINE 14720020 LR R6,R14 RESTORE POINTER 14800020 BC D1,STMEND3 SYNTAX ERROR, EXIT 14880020 BZ SETLMOD LOG ERROR IF NOT ABSOLUTE 14960020 X5ERRL 179,CLMPTR,STMEND3 INVALID LENGTH - NOT ABSOLUTE 15040020 SPACE 15120020 SETLMOD LR R1,R11 SAVE VALUE 15200020 ST R1,LMOD STORE L-MOD VALUE 15280020 TM BITLSW,TESTER CHECK BIT-LENGTH 15360020 BNZ LBITM YES 15440020 SLL R1,D3 NO, CHANGE TO BITS 15520020 LBITM ST R1,BITMOD SET BIT-LENGTH 15600020 LH R15,HILMINC(,R3) GET L-MOD HIGH LIMIT 15680020 TM DUMSW,TESTER IS IT DS OR DXD 15760020 BZ LIMITL NO 15840020 CLI TYPE,XBKT YES,IS IT C OR X TYPE? 15920020 BH LIMITL NO 16000020 L R15,BIGLIM GET SPECIAL UPPER LIMIT 16080020 LIMITL CH R1,LOLMINC(,R3) IS IT TOO SHORT? 16160020 BL LIMITH YES, GO LOG ERROR 16260020 CR R1,R15 IS IT TOO LONG ? 16360020 BNH STEST NO, CONTINUE 16460020 LIMITH X5ERRL 199,CLMPTR,STMEND LENGTH ERROR 16560020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - SCALE MODIFIE16720020 ER SCAN && EVALUATION' 16736020 STEST SET PRDEFREQ,OFF TURN PRIOR DEF REQ BIT OFF 16770020 GOIF D0(R6),JS,NE=ETEST IS THERE A SCALE FACTOR 16820020 TM FLAGINC(R3),BIT2 IS SCALE ALLOWED? 16880020 BNO SMBAD LOG ERROR IF NOT ALLOWED 16960020 LA R6,D1(,R6) STEP OVER S 17040020 MVI SIGNSW,D0 SET SIGN FLAG PLUS 17120020 GOIF D0(R6),JMINUS,EQ=SNEG IS IT NEGATIVE 17200020 GOIF D0(R6),JPLUS,EQ=SPOS IS IT POSITIVE 17280020 B SNOSIGN NO, TO GET VALUE 17360020 SNEG MVI SIGNSW,TESTER SET SIGN FLAG MINUS 17440020 SPOS LA R6,D1(,R6) STEP OVER SIGN 17520020 SNOSIGN BAL R9,EVAL1 GO SET UP EVAL CALL 17680020 B SLIMCHK TO VALIDITY CHECK 17760020 CLI D0(R6),JLPARN IS IT LEFT PAREN? 17780020 BNE LDELIM3 GO LOG ERROR IF NOT 17800020 SET SUBLIST,ON TURN SUBLIST BIT ON 17840020 LR R10,R6 POINT AT LEFT PAREN 18080020 JCALL EVAL CALL THE EVALUATION ROUTINE 18160020 LR R6,R14 RESTORE POINTER 18240020 BC 1,STMEND3 SYNTAX ERROR, EXIT 18320020 BNZ SMBAD TO BAD VALUE 18400020 SLIMCHK TM SIGNSW,TESTER CHECK MINUS 18480020 LR R1,R11 GET VALUE 18560020 BZ CHKSBIT YES 18640020 LCR R1,R1 NO, COMPLEMENT VALUE 18720020 CHKSBIT LH R14,LOSMINC(,R3) GET VALUE LIMITS 18800020 LH R15,HISMINC(,R3) 18880020 CR R1,R14 CHECK LO LIMIT 18960020 BL SMBAD TOO LOW 19040020 CR R1,R15 CHECK HI LIMIT 19120020 BH SMBAD TOO HIGH 19200020 ST0SCAL ST R1,SMOD STORE GOOD S-MOD 19280020 B ETEST TO E-MOD TEST 19360020 SMBAD BAL R9,ERLOG GO LOG ERROR 19410020 DC AL1(SEV200,ERR200,CLMPTR,0) INVALID SCALE MODIFIER 19460020 SR R1,R1 SET SCALE TO ZERO 19520020 B ST0SCAL GO DO IT 19560020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - EXPONENT MODI19600020 IFIER SCAN && EVALUATION' 19616020 ETEST GOIF D0(R6),JE,NE=KSCAN IS THERE AN EXPONENT 19680020 TM FLAGINC(R3),BIT3 IS EXPONENT ALLOWED? 19760020 BNO EMBAD ERROR IF NOT ALLOWED 19840020 LA R6,D1(,R6) STEP OVER E 19920020 MVI SIGNSW,D0 SET SIGN FLAG PLUS 20000020 GOIF D0(R6),JMINUS,EQ=ENEG IS IT NEGATIVE 20080020 GOIF D0(R6),JPLUS,EQ=EPOS IS IT POSITIVE 20160020 B ENOSIGN NO, TO GET VALUE 20240020 ENEG MVI SIGNSW,TESTER SET SIGN FLAG MINUS 20320020 EPOS LA R6,D1(,R6) STEP OVER SIGN 20400020 ENOSIGN BAL R9,EVAL1 GO SET UP EVAL CALL 20560020 B ELIMCHK TO VALIDITY CHECK 20640020 CLI D0(R6),JLPARN IS IT LEFT PAREN? 20660020 BNE LDELIM3 GO LOG ERROR IF NOT 20680020 SET SUBLIST,ON TURN SUBLIST BIT ON 20720020 LR R10,R6 POINT AT LEFT PAREN 20960020 JCALL EVAL CALL THE EVALUATION ROUTINE 21040020 LR R6,R14 RESTORE POINTER 21120020 BC D1,STMEND3 SYNTAX ERROR, EXIT 21200020 BNZ EMBAD TO BAD VALUE 21280020 ELIMCHK TM SIGNSW,TESTER CHECK MINUS 21360020 LR R1,R11 GET VALUE 21440020 BZ CHKEBIT YES 21520020 LCR R1,R1 NO, COMPLEMENT VALUE 21600020 CHKEBIT TM FLAGINC(R3),EBIT IS E-MOD LEGAL FOR TYPE 21680020 BZ EMBAD NO 21760020 LH R14,LOEMINC(,R3) YES, GET VALUE LIMITS 21840020 LH R15,HIEMINC(,R3) 21920020 CR R1,R14 CHECK LO LIMIT 22000020 BL EMBAD TOO LOW 22080020 CR R1,R15 CHECK HI LIMIT 22160020 BH EMBAD TOO HIGH 22240020 ST0EXP ST R1,EMOD STORE GOOD E-MOD 22320020 B KSCAN TO CONSTANT PRE-SCAN 22400020 EMBAD BAL R9,ERLOG GO LOG ERROR 22450020 DC AL1(SEV201,ERR201,CLMPTR,0) INVALID EXPONENT MODIFIER 22500020 SR R1,R1 SET EXPONENT TO ZERO 22560020 B ST0EXP GO DO IT 22600020 EVAL1 CLI D0(R6),JNUMMAX IS IT NUMERIC? 22640020 BC D2,D4(R9) NO, RETURN 22720020 MVI SELFDEFN,D0 SET SELF DEFN FLAG OFF 22800020 LR R10,R6 POINT TO NUMBER FOR EVAL 22880020 L R12,=A(EVAL) GET EVAL ADDRESS 22960020 LR R2,R9 SAVE R9 23040020 BALR R9,R12 CALL EVAL 23120020 LR R9,R2 RESTORE R9 23200020 MVI SELFDEFN,BITFF RESET SELFDEFN FLAG 23280020 LR R6,R14 SET TEXT POINTER 23360020 BR R9 RETURN 23440020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - CONSTANT SCAN' 23520020 KSCAN ST R6,ERRPTR SAVE COL PTR FOR LOGGING 23600020 TM DUMSW,TESTER IS THIS DS OR DXD 23760020 BZ LDELIM NO 23840020 TM FSTPSW,TESTER YES, HAVE WE PRINTED YET 23920020 BNZ MTCHK YES 24000020 SR R1,R1 FORCE STATEMENT PRINT 24080020 L R12,=A(DCPRINT) SET FOR DCPRINT 24160020 BALR R9,R12 CALL ROUTINE 24240020 MTCHK GOIF D0(R6),JBLANK,EQ=KEMPTY 24320020 GOIF D0(R6),JCOMMA,NE=LDELIM IS DS VARIABLE LENGTH 24400020 KEMPTY L R2,BITMOD YES, FORM TOTAL LENGTH 24480020 L R1,DUPF IN BITS 24560020 MR R0,R2 24640020 DUPDS ST R1,BITMOD 24720020 SLDL R0,D5 CHECK ADDRESS OVERFLOW 24800020 MVI MTSW,TESTER TURN ON EMPTY FLAG 24880020 LTR R0,R0 24960020 BZ KDELIM TO OK 25040020 ST R2,BITMOD TOO BIG, TREAT LIKE NO DUP-F 25120020 B LENER2 GO LOG ERROR 25140020 LENER XC BITMOD,BITMOD ZERO OUTPUT LENGTH 25160020 LENER2 BAL R9,ERLOG2 GO LOG LENGTH ERROR 25180020 DC AL1(SEV224,ERR224,CLMPTR,0) LENGTH ERROR 25200020 B KDELIM PLOW ON 25240020 SPACE 25280020 LDELIM GOIF D0(R6),JLPARN,NE=LDELIM2 IS IT LEFT PAREN? 25360020 TM FLAGINC(R3),BIT0 IS IT ADDRESS TYPE? 25440020 BO LDELIM1 YES,BRANCH AROUND 25520020 LDELIM3 ST R6,ERRPTR SAVE COL PTR FOR LOGGING 25600020 SPACE 25680020 B SYN178 GO LOG SYNTAX ERROR 25760020 SPACE 25840020 LDELIM2 GOIF D0(R6),JQUOTE,NE=LDELIM3 IS IT A QUOTE? 25920020 TM FLAGINC(R3),BIT0 IS IT ADDRESS TYPE? 26000020 BO LDELIM3 ERROR IF ADDRESS TYPE 26080020 SPACE 26160020 LDELIM1 LA R6,D1(,R6) STEP OVER QUOTE OR LEFT PAREN 26240020 ST R6,KONSTRT SAVE CONSTANT START PNTR 26320020 CLC DUPF,=F'1' IS DUP FACTOR GREATER THAN 1 26400020 BNH DUPLOOP NO, DON'T WORRY ABOUT POINT 26480020 CLI TYPE,ABKT IS DC AN ADDRES CONSTANT 26560020 BL DUPLOOP NO, WILL NOT HAVE TO POINT 26640020 SET NOTEWL,ON SET ON SWITCH TO NOTE IF NECESS 26720020 DUPLOOP XC KCOUNT(D2),KCOUNT CLEAR CONSTANT COUNT 26800020 MLTLOOP L R4,ALPTR SET EVAL WORK FOR BUILD 26880020 ST R4,OUTSTART SAVE BUILD START ADDRESS 26960020 L R15,ADDRINC(,R3) GET PROCESS LOC FOR TYPE 27040020 MVI KLENGTH+D3,D32 SET TRUNCATION INSURANCE 27120020 BR R15 27200020 ALNTEST TM TEMPLC+D3,D0 DUMMY ALIGNMENT TESTER 27280020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - PROCESS C-TYP27360020 PE CONSTANT' 27376020 CKON LH R12,ONE SET STEPPER 27440020 LR R15,R4 SAVE OUTPUT START 27520020 MVI D0(R4),EXBLANK PRE-SET OUTPUT 27600020 MVC D1(D17*D15,R4),D0(R4) TO EXTERNAL BLANKS 27680020 CNEXTCH GOIF D0(R6),JQUOTE,NE=CAMPR IS IT A QUOTE 27760020 GOIF D1(R6),JQUOTE,EQ=CDOUBL ARE THEY PAIRED? 27840020 GOIF D1(R6),JBLANK,EQ=CENDS OK IF BLANK 27920020 GOIF D1(R6),JCOMMA,EQ=CENDS OK IF COMMA 28000020 B LDELIM3 GO LOG ERROR 28080020 CAMPR GOIF D0(R6),JAMPER,NE=CNOTDBL IS IT AN AMPERSAND 28160020 GOIF D1(R6),JAMPER,NE=CERR ARE THEY PAIRED 28240020 CDOUBL AR R6,R12 SKIP OVER DOUBLE 28320020 CNOTDBL MVC D0(D1,R4),D0(R6) NEXT CHARACTER TO OUTPUT 28400020 AR R6,R12 STEP POINTER TO NEXT CHARACTER 28480020 AR R4,R12 STEP OUTPUT POINTER 28560020 C R6,OPNEND CHECK FOR END OF OPERAND 28640020 BL CNEXTCH NO, CONTINUE SCAN 28720020 X5ERRL 35,0,STMEND3 NO ENDING QUOTE 28800020 CENDS SR R4,R15 GET DATA LENGTH 28880020 LTR R4,R4 IS IT ZERO? 28960020 BZ LDELIM3 ERROR IF YES 29040020 LR R1,R4 SAVE VALUE 29120020 BCTR R4,0 FORM MACHINE LENGTH 29200020 EX R4,CTRANS TRANSLATE TO EXTERNAL CODE 29280020 SLL R1,D3 CHANGE IMPL-LENGTH TO BITS 29360020 TM LMODSW,TESTER CHECK EXPLICIT LENGTH 29440020 BNZ CSPECL YES, TO ERROR CHECK 29520020 ST R1,BITMOD NO SET IMPLICIT LENGTH 29600020 CSPECL L R0,BITMOD GET MOD BIT-LENGTH 29680020 ST R0,KLENGTH SET FOR RIGHT-PADDING 29760020 B LJUST TO OUTPUT 29840020 CERR ST R6,ERRPTR SAVE COLUMN PTR FOR LOGGING 29920020 X5ERRL 176,CLMPTR,STMEND3 UNPAIRED AMPERSAND 30000020 CTRANS TR D0(0,R15),JTRTABLE DUMMY TRANSLATE 30240020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - PROCESS X-TYP30320020 PE CONSTANTS' 30336020 XKON SR R2,R2 CLEAR CHARACTER REGISTER 30400020 LR R1,R2 ZERO TO INDEX 30480020 LA R14,D4 SET SHIFT CONTROL 30560020 LR R15,R14 SET SHIFT SWITCHER 30640020 STH R2,D0(R4) CLEAR WORKAREA 30720020 MVC D2(D16*D16,R4),D0(R4) CLEAR WORKAREA 30800020 LA R0,UNBKT SET TEXT-BUCKET START TESTER 30880020 XNEXTCH IC R2,D0(R1,R6) GET NEXT TEXT BYTE 30960020 CR R2,R0 IS IT HEX DIGIT 31040020 BL XDIGIT YES 31120020 B XCHECK GO CHECK FURTHER 31200020 XDIGIT SLL R2,D0(R14) SHIFT FOUR OR ZERO 31280020 EX R2,BSTORE DIGIT TO OBJECT BYTE 31360020 LA R1,D1(,R1) STEP INDEX 31440020 XR R14,R15 SWITCH SHIFT CONTROL 31520020 BZ XNEXTCH CONTINUE IF NEW SHIFT 15 ZERO 31600020 LA R4,D1(,R4) STEP OBJECT POINTER 31680020 B XNEXTCH CONTINUE 31760020 XFINISH AR R6,R1 UPDATE TEXT POINTER 31840020 SLL R1,2 HEX COUNT TO BITS 31920020 BFINISH ST R1,KLENGTH STORE IMPLICIT BIT-LENGTH 32000020 LTR R1,R1 IS IT ZERO? 32080020 BZ LDELIM3 ERROR IF YES= 32160020 LA R4,D1(,R4) POINT TO PAD BYTES 32240020 TM LMODSW,TESTER CHECK EXPLICIT LENGTH 32320020 BNZ LJUST YES, TO OUTPUT 32400020 AH R1,SEVEN NO, PAD BITS TO BYTES 32480020 N R1,BYTEMSK 32560020 ST R1,BITMOD SET IMPLICIT LENGTH 32640020 B LJUST TO LEFT PAD TEST 32720020 BSTORE OI D0(R4),D0 DUMMY BIT-STORE 32800020 SPACE 32880020 XCHECK LA R0,JQUOTE PUT JQUOTE IN REG 32960020 CR R2,R0 IS IT A QUOTE? 33040020 BE XFINISH FINISH IF EQUAL 33120020 LA R0,JCOMMA GET COMMA TEXT 33200020 CR R2,R0 IS IT COMMA? 33280020 BE XFINISH GO TO FINISH SCAN 33360020 XBERR1 ST R6,ERRPTR SAVE COL PTR FOR LOGGING 33440020 X5ERRL 236,CLMPTR,STMEND3 ILLEGAL CHARACTER 33520020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - PROCESS B-TYP33600020 PE CONSTANTS' 33616020 BKON SR R1,R1 CLEAR BIT-LENGTH 33680020 STH R1,D0(,R4) CLEAR WORK AREA 33760020 MVC D2(D16*D16,R4),D0(R4) CLEAR WORKAREA 33840020 BCTR R4,0 COMPENSATE FOR 1ST INCREMENT 33920020 BBITMSK LA R15,X'80' POSITION OBJECT BIT 34000020 LA R2,D8 SET SHIFT COUNTER 34080020 LA R4,D1(,R4) STEP OBJECT POINTER 34160020 BNEXTCH CLI D0(R6),D1 IS TEXT BYTE 1 34240020 BL BZERO NO, IT IS ZERO 34320020 BE BONE YES 34400020 CLI D0(R6),JQUOTE IS IT A QUOTE? 34480020 BE BFINISH FINISH IF EQUAL 34560020 CLI D0(R6),JCOMMA IS IT COMMA? 34640020 BE BFINISH YES, GO TO FINISH 34720020 B XBERR1 GO LOG ERROR 34800020 BONE EX R15,BSTORE BIT TO OBJECT BYTE 34880020 BZERO SRL R15,D1 SHIFT OBJECT BIT 34960020 LA R1,D1(,R1) STEP BIT-LENGTH 35040020 LA R6,D1(,R6) STEP TEXT POINTER 35120020 BCT R2,BNEXTCH REDUCE SHIFT COUNTER AND LOOP 35200020 B BBITMSK GO RE-SET FOR NEW BYTE 35280020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - PROCESS P-TYP35360020 PE CONSTANTS' 35376020 PKON SR R2,R2 CLEAR CHARACTER REGISTER 35440020 LR R1,R2 ZERO TO INDEX 35520020 LA R14,D4 SET SHIFT CONTROL 35600020 LR R15,R14 SET SHIFT SWITCHER 35680020 LA R0,JQUOTE SET QUOTE TESTER 35760020 LA R10,JCOMMA SET COMMA TESTER 35840020 XC D0(D18,R4),D0(R4) CLEAR 1ST 17 BYTES OY02610 35920031 LA R9,X'0C' SET PLUS-ZONE CODE 36000020 CLI D0(R6),JPLUS CHECK PLUS SIGN 36080020 BE PTSTEP YES 36160020 CLI D0(R6),JMINUS NO, CHECK MINUS SIGN 36240020 BNE PNEXTCH NO 36320020 LA R9,X'0D' YES, SET MINUS-ZONE CODE 36400020 PTSTEP LA R6,D1(,R6) STEP TEXT POINTER 36480020 PNEXTCH IC R2,D0(R1,R6) GET NEXT TEXT BYTE 36560020 LA R12,D0(R1,R6) GET OPERAND POINTER 36640020 CLI D0(R12),J9 IS IT NUMERIC? 36720020 BNH PDIGIT BRANCH IF YES 36800020 CLI D0(R12),JPERIOD IS IT A PERIOD? 36880020 BE PCHECK BRANCH IF EQUAL 36960020 CR R2,R10 IS IT A COMMA? 37040020 BE PKON1 BRANCH IF EQUAL 37120020 CR R2,R0 IS IT A QUOTE? 37200020 BNE XBERR1 LOG ILLEGAL CHARACTER ERROR 37280020 SPACE 37360020 PKON1 LTR R1,R1 NULL OPERAND? 37440020 BZ LDELIM3 ERROR IF YES 37520020 AR R6,R1 DONE, UPDATE TEXT POINTER 37600020 SLL R9,D0(R14) SHIFT ZONE CODE FOUR OR ZERO 37680020 EX R9,BSTORE ZONE TO LAST OBJECT BYTE 37760020 CH R1,HISMINC(,R3) IS IT GREATER THAN 31 37810020 BH LENER ERROR IF YES 37820020 LA R1,D1(,R1) INCLUDE ZONE IN COUNT 37840020 SLL R1,D2 DIGIT COUNT TO BITS 37920020 B BFINISH TO CHECK L-MOD 38000020 PDIGIT SLL R2,D0(R14) SHIFT FOUR OR ZERO 38080020 EX R2,BSTORE DIGIT TO OBJECT BYTE 38160020 LA R1,D1(,R1) STEP INDEX 38240020 XR R14,R15 SWITCH SHIFT CONTROL 38320020 BZ PNEXTCH CONTINUE IF NEW SHIFT IS ZERO 38400020 LA R4,D1(,R4) STEP OBJECT POINTER 38480020 B PNEXTCH CONTINUE 38560020 PCHECK GOIF VLIT,ON=ZCHECK1 GO IF PERIOD SWITCH IS ON 38660020 SET VLIT,ON SET PERIOD SWITCH ON 38760020 B PTSTEP GO SKIP PERIOD 39120020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - PROCESS Z-TYP39200020 PE CONSTANTS' 39216020 ZKON SR R2,R2 CLEAR CHARACTER REGISTER 39280020 LR R1,R2 ZERO TO INDEX 39360020 LA R0,JQUOTE SET QUOTE TESTER 39440020 LA R10,JCOMMA SET COMMA TESTER 39520020 LA R15,X'F0' SET NUMERIC ZONE CODE 39600020 STC R15,D0(,R4) PRE-SET 15 PAD BYTES 39680020 MVC D1(D14,R4),D0(R4) 39760020 LA R4,D15(,R4) STEP OUTPUT OVER PAD 39840020 LA R9,X'CF' SET PLUS ZONE MASK 39920020 CLI D0(R6),JPLUS CHECK PLUS SIGN 40000020 BE ZTSTEP YES 40080020 CLI D0(R6),JMINUS CHECK MINUS SIGN 40160020 BNE ZNEXTCH NO 40240020 LA R9,X'DF' YES, SET MINUS ZONE MASK 40320020 ZTSTEP LA R6,D1(,R6) STEP TEXT POINTER 40400020 ZNEXTCH IC R2,D0(R1,R6) GET NEXT TEXT BYTE 40480020 LA R12,D0(R1,R6) GET OPERAND POINTER 40560020 CLI D0(R12),J9 IS IT NUMERIC? 40640020 BNH ZDIGIT BRANCH IF YES 40720020 CLI D0(R12),JPERIOD IS IT A PERIOD? 40800020 BE ZCHECK BRANCH IF EQUAL 40880020 CR R2,R10 IS IT A COMMA? 40960020 BE ZKON1 BRANCH IF EQUAL 41040020 CR R2,R0 IS IT A QUOTE? 41120020 BNE XBERR1 LOG ILLEGAL CHARACTER ERROR 41200020 SPACE 41280020 ZKON1 LTR R1,R1 IS IT ZERO? 41360020 BZ LDELIM3 ERROR IF YES 41440020 AR R6,R1 DONE, UPDATE TEXT POINTER 41520020 BCTR R4,0 BACK UP OUTPUT POINTER 41600020 AR R4,R1 POINT TO LAST OUTPUT BYTE 41680020 EX R9,ZSIGN CHANGE LAST BYTE ZONE TO SIG 41760020 CH R1,HISMINC(,R3) IS IT GREATER THAN 16 41810020 BH LENER ERROR IF YES 41820020 SLL R1,D3 DIGIT COUNT TO BITS 41840020 TM LMODSW,TESTER CHECK EXPLICIT LENGTH 41920020 BNZ ZINC YES 42000020 ST R1,BITMOD NO, SET IMPLICIT LENGTH 42080020 ZINC LA R1,D8*D15(,R1) INSURE NEEDED PADDING 42160020 ST R1,KLENGTH STORE IMPLICIT BIT-LENGTH 42240020 B LJUST TO LEFT PAD TEST 42320020 ZDIGIT OR R2,R15 SET NUMERIC ZONE 42400020 STC R2,D0(R1,R4) STORE OBJECT BYTE 42480020 LA R1,D1(,R1) STEP INDEX 42560020 B ZNEXTCH CONTINUE 42640020 ZCHECK GOIF VLIT,ON=ZCHECK1 GO IF PERIOD SWITCH IS ON 42740020 SET VLIT,ON SET PERIOD SWITCH ON 42840020 B ZTSTEP GO SKIP PERIOD 42960020 ZCHECK1 SET VLIT,OFF SET PERIOD SWITCH OFF 42980020 ST R6,ERRPTR STORE PTR FOR ERROR LOGGING 43000020 SYN178 X5ERRL 178,CLMPTR,STMEND3 ILLEGAL FORMAT 43020020 ZSIGN NI D0(R4),D0 DUMMY ZONE CHANGER 43040020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION - PROCESS L-, D43120020 D-, E-, F-, H-TYPE CONSTANTS' 43136020 DKON LA R11,WORKAREA SET PARAMETER POINTER 43200020 LA R2,D16*D8 SET TRUNCATION INSURANCE 43280020 ST R2,KLENGTH 43360020 LR R10,R6 SET TEXT POINTER 43440020 JCALL DKVERT CALL DECIMAL CONVERSION 43520020 JEXTRN (X5F01=DKVERT) DEFINE EXTERNAL SYMBOL 43600020 TM EBYTE,X'FF' WERE ANY ERRORS FLAGGED 43680020 BZ DKFINISH NO, GO TO OUTPUT 43760020 ST R10,ERRPTR SAVE ERROR POINTER 43800020 LA R6,ERLOG2 PT TO ERROR LOGGING ROUTINE 43840020 SPACE 1 43880020 TM EBYTE,BIT0 SCALE INVALID ERROR 43920020 BZ DK10 BR NO ERROR 43960020 BALR R9,R6 GO LOG ERROR 44000020 DC AL1(SEV200,ERR200,CLMPTR,0) SCALE INVALID 44040020 SPACE 1 44080020 DK10 TM EBYTE,BIT1 EXPONENT INVALID ERROR 44120020 BZ DK20 BR NO ERROR 44160020 BALR R9,R6 GO LOG ERROR 44200020 DC AL1(SEV201,ERR201,CLMPTR,0) EXPONENT INVALID 44240020 SPACE 1 44280020 DK20 TM EBYTE,BIT2 TRUNCATION ERROR 44320020 BZ DK30 BR NO ERROR 44360020 BALR R9,R6 GO LOG ERROR 44400020 DC AL1(SEV203,ERR203,CLMPTR,0) TRUNCATION 44440020 SPACE 1 44480020 DK30 TM EBYTE,BIT4 FLOATING POINT CHAR ERROR 44520020 BZ DK40 BR NO ERROR 44560020 BALR R9,R6 GO LOG ERROR 44600020 DC AL1(SEV239,ERR239,CLMPTR,0) FLOATING POINT CHAR 44640020 SPACE 1 44680020 DK40 TM EBYTE,BIT5 PRECISION LOST ERROR 44720020 BZ DK50 BR NO ERROR 44760020 BALR R9,R6 GO LOG ERROR 44800020 DC AL1(SEV202,ERR202,CLMPTR,0) PRECISION LOST ERROR 44840020 SPACE 1 44880020 DK50 TM EBYTE,BIT3+BIT6+BIT7 INVALID DELIMITER ERROR 44920020 BZ DKFINISH BR NO ERROR 44960020 BALR R9,R6 GO LOG ERROR 45000020 DC AL1(SEV255,ERR255,CLMPTR,0) INVALID DELIMITER ERROR 45040020 LR R6,R10 RESTORE TEXT POINTER 45060020 B NOTINC SYNTAX ERROR, FLUSH STATEMENT 45080020 DKFINISH LR R6,R10 UPDATE TEXT PTR 45120020 LA R11,D16(,R11) POINT TO OUTPUT 45160020 ST R11,OUTSTART '' 45200020 B LJUST TO LEFT PAD TEST 45240020 SPACE 45600020 SPACE 45640020 TITLE '&COMPNM&ASMID - ASSEMBLY PHASE - DC EVALUATION ' 45680020 AYKON LR R10,R6 SET TEXT POINTER 45760020 L R2,ELCTR SAVE CURRENT LOCTR 45840020 JCALL EVAL CALL THE EVALUATION ROUTINE 46160020 LR R6,R14 UPDATE TEXT PTR 46240020 ST R2,ELCTR RESTORE CURRENT LOCATION CTR 46290020 BZ MAGCHK ABSOLUTE, TO SIZE CHECK 46400020 BH AYREL TO RELOCATABLE 46480020 BC ERRX,STMEND3 SYNTAX ERROR,EXIT 46560020 GOIF COMPLEX,EQ=AYREL IS EXPRESSION COMPLEXLY RELOC 46640020 SR R1,R1 ZERO VALUE 46800020 B NOTY TO STORE VALUE 46880020 AYREL CLI D0(R6),JRPARN IS IT RIGHT PAREN? 46960020 BE AYREL1 BRANCH IF YES 47040020 CLI D0(R6),JCOMMA IS IT COMMA? 47120020 BE AYREL1 BRANCH IF YES 47200020 B LDELIM3 IF NOT GO LOG ERROR 47280020 AYREL1 EQU * BRANCH LABEL 47360020 TM BITLSW,TESTER CHECK BIT-LENGTH-MOD 47440020 BZ YCHK NO, OK 47520020 RELOERR BAL R9,ERLOG2 GO LOG ERROR @AX21436 47560000 DC AL1(SEV204,ERR204,0,0) RELOCATION ERROR @AX21436 47610000 SR R11,R11 ZERO EXPRESSION VALUE @AX21436 47660000 B MAGCHK CHECK FURTHER @AX21436 47710000 YCHK L R1,LMOD GET L-MODIFIER @AX21436 47760000 LA R2,2 SET A L-TESTER @AX21436 47810000 CLI TYPE,YBKT CHECK Y-TYPE @AX21436 47860000 BNE ALCHK NO @AX21436 47910000 BCTR R2,0 SET Y L-TESTER @AX21436 47960000 ALCHK CLR R1,R2 CHECK RELOC LGTH LIMIT @AX21436 48010000 BNH RELOERR LOG ERROR IF NEEDED @AX21436 48060000 CLI TYPE,YBKT CHECK Y-TYPE @AX21436 48110000 BNE AYZCHK NO @AX21436 48160000 GOIF JYFLAG,OFF=AYZCHK SUPR ERR MSG YFLAG OFF @AX21436 48210000 BAL R9,ERLOG2 GO LOG ERROR 48260000 DC AL1(SEV205,ERR205,0,0) RELOCATABLE Y-CON 48310000 AYZCHK TM ZDUPSW,TESTER CHECK ZERO DUP-F 48480020 BNZ MAGCHK YES, BYPASS RLD 48560020 MVC DWORD1+D1(D3),ELCTR+D1 GET LOCATION OF A OR Y CON 48640020 ST R11,EMOD SAVE SYMBOL VALUE 48720020 MVI DWORD1,D0 SET RLD FLAGS 48800020 MVC DWORD2(D2),LMOD+D2 MOVE LENGTH FOR RLD 48880020 JCALL RLDOUT CALL RLD OUTPUT ROUTINE 48960020 JEXTRN (X5A41=RLDOUT) DEFINE EXTERNAL SYMBOL 49040020 L R11,EMOD RESTORE VALUE 49120020 MAGCHK LR R1,R11 GET VALUE 49200020 CLI D0(R6),JRPARN IS IT RIGHT PAREN? 49280020 BE MAGCHK1 BRANCH AROUND IF YES 49360020 CLI D0(R6),JCOMMA IS IT COMMA? 49440020 BE MAGCHK1 BRANCH AROUND IF YES 49520020 B LDELIM3 LOG ERROR 49600020 MAGCHK1 EQU * BRANCH LABEL 49680020 CLI TYPE,YBKT IS IT A Y-CON 49760020 BNE NOTY NO 49840020 C R1,YMASK YES, IS IT TOO BIG 49920020 BH YDATA YES 50000020 C R1,YNMASK TOO SMALL 50010020 BNL NOTY NO 50020020 YDATA LR R10,R1 SAVE REGISTER CONTENT 50050020 BAL R9,ERLOG2 GO LOG ERROR 50070020 DC AL1(SEV203,ERR203,CLMPTR,0) TRUNCATION 50090020 LR R1,R10 RESTORE REGISTER CONTENT 50130020 * 50160020 NOTY ST R1,0(,R4) SET OUTPUT 50240020 B LJUST TO OUTPUT 50320020 EJECT 50400020 VKON LR R10,R6 SET TEXT POINTER 50480020 LR R1,R6 GET OPERAND POINTER 50560020 GOIF D0(R6),JALFAMIN,LT=LDELIM3 ERROR IF NOT ALPHABTIC 50640020 VESCAN GOIF D0(R1),JALFAMAX,GT=VSCN10 IS SYMBOL CONTINUING 50720020 LA R1,D1(,R1) YES, CHECK NEXT CHARACTER 50800020 B VESCAN CONTINUE SCAN 50880020 VSCN10 GOIF D0(R1),JCOMMA,EQ=VSCN20 V-CON IS DELIMITED BY A COMMA 50960020 GOIF D0(R1),JRPARN,EQ=VSCN20 OR A RIGHT PARN 51040020 ST R1,ERRPTR SAVE OPERAND PTR FOR ERROR LOG 51120020 B SYN178 GO LOG SYNTAX ERROR 51200020 VSCN20 SR R1,R6 DETERMINE LENGTH OF SYMBOL 51280020 AR R6,R1 STEP OPERAND POINTER 51360020 CH R1,=H'8' IS SYMBOL LENGTH LEGAL 51440020 BNH VSCN30 YES,GO MAKE RLD 51520020 VSCN25 EQU * BRANCH LABEL 51600020 ST R6,ERRPTR SAVE OPERAND PTR FOR ERROR LOG 51680020 X5ERRL 187,CLMPTR,STMEND3 INVALID SYMBOL 51760020 VSCN30 LTR R1,R1 WAS FIELD NULL 51840020 BZ LDELIM3 GO LOG ERROR 51920020 LH R10,JINFILE POINT TO REFERENCE FILE 52000020 JGETL FILE=(R10) GET REFERENCE RECORD 52080020 GOIF NOTEWL,OFF=VSCN15 IS NOTE NECESSARY? 52160020 SET NOTEHS,ON TURN ON FILE NOTED SWITCH 52240020 SET NOTEWL,OFF TURN OFF NOTE REQUIRED SWITCH 52320020 LR R2,R11 SAVE RECORD POINTER 52360020 LH R10,JINFILE GET INPUT FILE NUMBER 52400020 JNOTE FILE=(R10) NOTE INPUT FILE 52480020 MVC NOTEVAL,JNOTEVAL SAVE NOTED VALUE 52560020 LR R11,R2 RESTORE RECORD POINTER 52600020 VSCN15 EQU * 52640020 L R14,SYMXRF INCREMENT OX02675 52720031 LA R14,D1(R14) SYMBOL COUNT 52800020 ST R14,SYMXRF RESTORE SYMBOL XREFED OX02675 52880031 SPACE 53040020 TM ZDUPSW,TESTER IS DUP FACTOR ZERO 53120020 BNZ LJUST YES, NO RLD 53200020 GOIF DSSW,ON=LJUST NO RLD IF DS 53280020 MVI RELOCTR,D1 SET UP RLD DATA 53360020 MVC RLIST,D6(R11) SAVE ESD 53440020 MVC DWORD1+D1(D3),ELCTR+D1 SAVE LOCATION OF V-CON 53520020 MVI DWORD1,BIT3 SET RLD FLAG 53600020 MVC DWORD2(D2),LMOD+D2 MOVE LENGTH FOR RLD 53680020 JCALL RLDOUT GO CREATE RLD 53760020 XC D0(D4,R4),D0(R4) ZERO OUTPUT AREA 53840020 B LJUST CONTINUE OUTPUT 53920020 EJECT 54000020 QKON LR R10,R6 SET TEXT POINTER 54080020 GOIF D0(R10),JALFAMIN,LT=LDELIM3 ERROR IF NOT ALPHABETIC 54160020 QESCAN GOIF D0(R10),JALFAMAX,GT=QEND SCAN SYMBOL 54240020 LA R10,D1(,R10) STEP SCAN POINTER 54320020 B QESCAN CONTINUE SCAN 54400020 QEND GOIF D0(R10),JCOMMA,EQ=QSCN10 DELIMITER MUST BE A COMMA 54480020 GOIF D0(R10),JRPARN,EQ=QSCN10 OR A RIGHT PAREN 54560020 ST R10,ERRPTR SAVE OPERAND PTR FOR ERROR LOG 54640020 B SYN178 GO LOG SYNTAX ERROR 54720020 QSCN10 SR R10,R6 DETERMINT SYMBOL LENGTH 54800020 BZ LDELIM3 BRANCH TO LOG ERROR 54880020 CH R10,=H'8' 8 CHARACTERS OR LESS 54960020 BH VSCN25 BRANCH TO LOG INVALID SYMBOL 55040020 AR R6,R10 POINT TO DELIMITER 55120020 LH R10,JINFILE POINT TO INPUT FILE 55200020 JGETL FILE=(R10) GET NEXT RECORD 55280020 TM D5(R11),BIT1+BIT2 IS IT PREVIOUSLY DEFINED? 55360020 BO QSCN15 BRANCH IF YES 55440020 ST R11,ERRPTR SAVE RECORD PTR FOR LOGGING 55520020 BAL R9,ERLOG2 GO LOG ERROR 55570020 DC AL1(SEV231,ERR231,DTAPTR,0) SYMBOL NOT PREVIOUSLY DEF'D 55620020 QSCN15 EQU * BRANCH LABEL 55680020 GOIF NOTEWL,OFF=QSCN20 IS NOTE NECESSARY? 55760020 SET NOTEHS,ON TURN ON FILE NOTED SWITCH 55840020 SET NOTEWL,OFF TURN OFF NOTE REQUIRED SWITCH 55920020 LH R10,JINFILE GET INPUT FILE NUMBER 56000020 LR R2,R11 SAVE SYMBOL RECORD PTR 56080020 JNOTE FILE=(R10) NOTE INPUT FILE 56160020 MVC NOTEVAL,JNOTEVAL SAVE NOTED VALUE 56240020 LR R11,R2 RESTOR RECORD PTR 56320020 QSCN20 EQU * 56400020 GOIF XRFNO,OFF=QSCN30 DO WE MAKE XREF? 56560020 LA R2,REF INDICATE XREF REF 56640020 JCALL XREF GO MAKE XREF ENTRY 56720020 QSCN30 EQU * 56800020 TM ZDUPSW,TESTER IS DUP FACTRO ZERO? 56880020 BNZ LJUST BRANCH IF YES 56960020 TM D3(R11),BIT4+BIT6+BIT7 IS IT DSECT OR DXD? 57040020 BNO QER4 57120020 MVI RELOCTR,D1 SET UP RLD DATA 57200020 MVC RLIST,D6(R11) SAVE ESD 57280020 NI RLIST,X'0F' CLEAR FLAG 57360020 MVC DWORD1+D1(D3),ELCTR+D1 SAVE LOCATION FOR RLD 57440020 MVC DWORD2(D2),LMOD+D2 SAVE LENGTH FOR RLD 57520020 MVI DWORD1,BIT2 SET Q-CON RLD FLAG 57600020 JCALL RLDOUT GO CREATE RLD 57680020 QRLD1 EQU * BRANCH LABEL 57730020 XC D0(D4,R4),D0(R4) ZERO WORK AREA 57760020 B LJUST GO OUTPUT Q-CON 57840020 SPACE 57920020 QER4 BAL R9,ERLOG2 GO LOG ERROR 57960020 DC AL1(SEV207,ERR207,CLMPTR,0) NOT A DXD OR DSECT NAME 58000020 B QRLD1 PLOW ON 58040020 JEXTRN (X5A51=XREF) DEFINE EXTERNAL SYMBOL 58080020 EJECT 58160020 SKON MVI SIGNSW,0 TURN OFF SUB-FIELD FLAG 58240020 XC DECKON(4),DECKON CLEAR ESD POINTER 58320020 SVLOOP LR R10,R6 SET TEXT POINTER 58400020 JCALL EVAL CALL THE EVALUATION ROUTINE 58480020 LR R6,R14 UPDATE TEXT PTR 58560020 ST R11,EMOD SET EXPRESSION VALUE 58640020 BZ SDELIM ABSOLUTE, TO CHECK DELIMITER 58720020 BO SDELIM GO CHECK SUB FIELD 58800020 BM SPLEX TO NON-SYNTAX ERROR CHECK 58880020 ST R10,DECKON SET EXPRESSION ESD 58960020 B SDELIM TO CHECK DELIMITER 59040020 SPLEX XC EMOD(4),EMOD ZERO TO VALUE 59120020 GOIF COMPLEX,NE=SDELIM IS EXPRESSION COMPLEXLY RELOC 59200020 BAL R9,ERLOG2 GO LOG ERROR 59250020 DC AL1(SEV213,ERR213,CLMPTR,0) COMPLEXLY RELOCATABLE 59300020 SDELIM TM EVALSW1,FATALER HAS AN ERROR OCCURED @OY06592 59350005 BO STMEND3 GO TO NEXT @OY06592 59352005 CLI D0(R6),JLPARN CHECK SUB-FIELD @OY06592 59360005 BNE SDCHK NO, CHECK DECOMPOSE 59440020 MVI SIGNSW,TESTER TURN ON SUB-FIELD FLAG 59520020 MVC SMOD(4),EMOD SET DISPLACEMENT VALUE 59600020 LA R6,D1(,R6) STEP TEXT POINTER 59680020 B SVLOOP TO SCAN SUB-FIELD 59760020 SDCHK TM SIGNSW,TESTER CHECK IF SUB-FIELD 59840020 BNZ SUBF YES 59920020 L R9,DECKON GET POF POINTE 60000020 L R12,EMOD GET VALUE 60080020 LA R14,USINGT POINT TO USING TABLE 60160020 USING UESD,R14 ESTABLISH USING 60240020 SCOMPB TM UREG,X'0F' THE END OF TABLE? @OX08876 60320005 BO SCOMPF YES, GO CHECK ABSOLUTE @OX08876 60400005 CH R9,UESD NO, DO ESD'S COMPARE 60480020 BH SADLOG NO, GO LOG ADDRESSING ERROR 60560020 BE SCOMPD YES, GO CHECK DISPLACEMENT 60640020 SCOMPC LA R14,USNXT STEP TO NEXT USING ENTRY 60720020 B SCOMPB GO CONTINUE SEARCH 60800020 SCOMPD LR R1,R12 GET EXPRESSION VALUE 60880020 S R1,UVAL SUBTRACT USING VALUE 60960020 BM SCOMPC USING VALUE TOO LARGE 61040020 CH R1,=H'4096' IS DISPLACEMENT 4096 OR GREATER 61120020 BNL SCOMPC YES, GO CONTINUE SEARCH 61200020 LTR R12,R12 IS DISPLACEMENT POSITIVE 61280020 BL SCOMPE NO, GO ALLOW NEG DISPLACEMENT 61360020 TM UVAL,BITFF IS USING OUT OF RANGE OZ04407 61440005 BM SCOMPC YES, DON'T ALLOW IT OZ04407 61520005 SCOMPE LH R0,UREG GET USING REGISTER 61600020 SLL R0,D12 FORM VALUE 61680020 OR R1,R0 61760020 B SKONOUT TO SET OUTPUT 61840020 SCOMPF LTR R9,R9 IS USING ABSOLUTE 61920020 BNZ SADLOG NO, GO LOG ERROR 62000020 LR R1,R12 GET VALUE 62080020 CH R1,=H'4096' IS DISPLACEMENT TOO LARGE 62160020 BNL SADLOG YES, GO LOG ERROR 62240020 LTR R1,R1 IS NEG DISP TO BIG @OY11250 62320006 BL SADLOG YES, GO LOG ERROR 62400020 N R1,=A(X'FFF') CLEAR ANY NEGATIVE BITS 62480020 B SKONOUT GO COMPLETE OUTPUT 62560020 SADLOG BAL R9,ERLOG2 GO LOG ERROR 62610020 DC AL1(SEV209,ERR209,CLMPTR,0) ADDRESSABILITY ERROR 62660020 SZVAL SR R1,R1 ZERO TO VALUE 62720020 B SKONOUT TO OUTPUT 62800020 SUBF L R0,DECKON CHECK ESD PTR 62880020 LA R6,D1(R6) STEP OVER RIGHT PAREN OF SUBFLD 62960020 LTR R0,R0 63040020 BZ SDISP OK 63120020 BAL R9,ERLOG2 GO LOG ERROR 63160020 DC AL1(SEV159,ERR159,0,0) RELOCATION ERROR 63200020 B SZVAL PLOW ON 63240020 SDISP L R1,SMOD GET DISPLACEMENT 63280020 CL R1,DISPLIM CHECK TOO BIG 63360020 BL SREG OK 63440020 BAL R9,ERLOG2 GO LOG ERROR 63480020 DC AL1(SEV208,ERR208,0,0) BAD DISPLACEMENT 63520020 B SZVAL PLOW ON 63560020 SREG L R2,EMOD GET REGISTER 63600020 CL R2,REGLIM CHECK TOO BIG 63680020 BNH SFVAL OK 63760020 BAL R9,ERLOG2 GO LOG ERROR 63800020 DC AL1(SEV230,ERR230,CLMPTR,0) INVALID REGISTER 63840020 B SZVAL PLOW ON 63880020 SFVAL SLL R2,12 FORM VALUE 63920020 CH R1,=H'-4096' IS NEGATIVE DISPLACEMENT TO BIG 64000020 BL SADLOG YES, GO LOG ERROR 64080020 N R1,=A(X'FFF') CLEAR ANY NEGATIVE BITS 64160020 OR R1,R2 64240020 SKONOUT ST R1,0(,R4) SET OUTPUT 64320020 EJECT 64400020 LJUST GOIF LITRSW,ON=LITEV OPERAND OF LITERAL ? 64440020 CLC OPNDCT(D2),LCTRSAV+D8 OVER OPERAND COUNT 64460020 BH NOTINC YES FORGET OUTPUT 64480020 LITEV TM ZDUPSW,TESTER CHECK ZERO DUP FACTOR 64500020 BZ NOZDP2 NO 64560020 XC BITMOD(4),BITMOD YES, CLEAR BIT-LENGTH 64640020 B KDELIM SKIP OUTPUT 64720020 NOZDP2 TM DUMSW,TESTER IS THIS A DXD OR DS 64800020 BNZ KDELIM YES, SKIP OUTPUT 64880020 L R10,BITMOD GET EXPLICIT BIT-LENGTH 64960020 S R10,KLENGTH SUBTRACT IMPLICIT LENGTH 65040020 BZ KNORMAL TO NO PAD OR TRUNCATION 65120020 BP KPAD TO OUTPUT PADDING 65200020 LCR R10,R10 GET POSITIVE DIFFERENCE 65280020 SRDL R10,3 CHANGE TO BYTES 65360020 A R10,OUTSTART TRUNCATED START ADDRESS 65440020 LR R2,R11 SET BIT REMAINDER 65520020 SRL R2,29 65600020 L R11,BITMOD SET TRUNCATED COUNT 65680020 B KALLOUT TO OUTPUT 65760020 KPAD LR R11,R10 SET PAD OUTPUT COUNT 65840020 SR R2,R2 CLEAR BIT REMAINDER 65920020 LA R10,1(,R4) SET PAD OUTPUT POINTER 66000020 L R12,=A(KOUTPUT) CALL OUTPUT 66080020 BALR R9,R12 BRANCH TO ROUTINE 66160020 KNORMAL L R10,OUTSTART SET CONSTANT START 66240020 SR R2,R2 CLEAR BIT REMAINDER 66320020 L R11,KLENGTH SET CONSTANT BIT LENGTH 66400020 KALLOUT L R12,=A(KOUTPUT) CALL OUTPUT 66480020 BALR R9,R12 BRANCH TO ROUTINE 66560020 EJECT 66640020 KDELIM L R1,BITLC INCREMENT BIT LOCATION COUNTER 66720020 A R1,BITMOD 66800020 LR R0,R1 SAVE IT 66880020 L R2,ELCTR GET CURRENT LC 66960020 LA R2,0(,R2) CLEAR WRAP BITS 67040020 SRL R0,3 TRUNCATE BIT LC TO BYTES 67120020 N R1,WRAPMSK CLEAR BIT LC WRAP 67200020 ST R1,BITLC SET UPDATED BIT LC 67280020 SR R0,R2 FORM LC INCREMENT 67360020 BZ NOTINC TO NO INCREMENT 67440020 ST R0,LOCLEN STORE INCREMENT 67520020 JCALL LOCUPD CALL LOCATION COUNTER UPDATE 67600020 NOTINC SET VLIT,OFF TURN OFF PERIOD SWITCH 67680020 L R1,LMOD ACCUMULATE LENGTH OF DC 67700020 A R1,DCLNG 67720020 ST R1,DCLNG SAVE ACCUMULATED LENGTH 67740020 TM MTSW,TESTER IS EMPTY DS SWITCH ON? 67760020 BNZ OPEND YES, TO FINISH OPERAND 67840020 CLI 0(R6),JCOMMA CHECK MULTIPLE CONSTANT 67920020 LA R6,1(,R6) STEP OVER DELIMITER 68000020 BE MLTKON YES 68080020 L R1,DUPF REDUCE DUP-FACTOR 68160020 SH R1,ONE 68240020 ST R1,DUPF 68320020 BNP OPEND TO NO DUPLICATE SCAN 68400020 GOIF LTDECV,ON=STMEND IS THIS A LITERAL REFERENCE 68480020 GOIF DSSW,OFF=NOTDS IS ENTRY A DS 68560020 L R2,BITLC FORM BIT INCREMENT 68640020 S R2,STRTLC 68720020 MR R0,R2 TIMES DUP FACTOR LESS 1 68800020 SR R2,R2 68880020 B DUPDS TO OVERFLOW CHECK 68960020 NOTDS BCTR R6,0 BACK-UP TEXT POINTER 69040020 SET XRFNO,OFF TURN OFF XREF 69120020 MVI SKLOG,TESTER TURN OFF ERLOG 69200020 TM FLAGINC(R3),ABIT CHECK ADDRESS-TYPE 69280020 BO REPSCAN YES, TO SCAN AGAIN 69360020 LH R0,KCOUNT TEST MULTIPLE CONSTANTS 69440020 LTR R0,R0 69520020 BZ LJUST NO, TO REPEAT OUTPUT 69600020 REPSCAN L R6,KONSTRT RE-SET TEXT POINTER 69680020 SET DUPEVAL,ON INDICATE DUPLICATE EVALUATION 69730020 GOIF NOTEHS,OFF=DUPLOOP IS POINT NECESSARY 69760020 LH R10,JINFILE POINT TO INPUT FILE 69840020 JPOINT FILE=(R10),NEXT=GET,ADDR=NOTEVAL POINT BACK FOR SYMBOLS 69920020 SET XRFNO,OFF TURN XREF OFF 70000020 * TO BE RESCANNED 70080020 B DUPLOOP 70160020 MLTKON LH R1,KCOUNT STEP CONSTANT COUNT 70240020 LA R1,1(,R1) 70320020 STH R1,KCOUNT 70400020 B MLTLOOP TO SCAN NEXT CONSTANT 70480020 EJECT 70720020 OPEND SET (NOTEWL,NOTEHS),OFF TURN OFF NOTE POINT SWITCHES 70800020 SET DUPEVAL,OFF RESET DUP EVALUATION 70850020 GOIF LTDECV,ON=OPEND1 IF LITERAL,EXIT 70880020 GOIF LITRSW,ON=STMEND IF LITERAL DC THEN EXIT 70960020 CLI D0(R6),JCOMMA IS COMMA NEXT 71120020 BNE STMEND1 GO CHECK FOR BLANK 71200020 LA R6,1(,R6) YES, STEP OVER COMMA 71280020 B NEXTOP TO NEXT OPERAND 71360020 OPEND1 LR R10,R6 RESTORE OPERAND POINTER 71440020 B KLEANUP GO CLEAN UP AND EXIT 71520020 STMEND3 EQU * BRANCH LABEL 71600020 MVC ELCTR,LCTRSAV+D12 RESTORE LOCTR 71680020 MVC OBITS(2),LCTRSAV+D10 RESTORE OUTPUT BIT COUNT 71760020 SET (NOTEWL,NOTEHS),OFF TURN OFF NOTE SWITCHES 71840020 TM DUMSW,TESTER IS IT A DS OX00223 71890026 BZ NOFNINC NO, GO TO EXIT OX00223 71900026 GOIF PGEN,ON=NOFNINC YES, IF PRT GEN ON EXIT OX00223 71910026 MVI FSTPSW,D0 NO, CLEAR FIRST PRNT SW OX00223 71912026 B NOFNINC GO TO EXIT 71920020 STMEND1 GOIF D0(R6),JBLANK,EQ=OPEND2 IS IT BLANK? 72000020 BAL R9,ERLOG GO LOG ERROR 72080020 DC AL1(SEV178,ERR178,CLMPTR,0) BLANK EXPECTED 72160020 OPEND2 CLC OPNDCT(2),LCTRSAV+D8 OVER OPERAND COUNT? 72240020 BNH STMEND BRANCH AROUND IF NO 72320020 MVC ELCTR,LCTRSAV+D12 RESTORE LOCTR 72400020 MVC OBITS(2),LCTRSAV+D10 RESTORE OUTPUT BIT COUNT 72480020 B NOFNINC EXIT 72560020 EJECT 72720020 STMEND L R1,BITLC PADDED BIT LOCATION COUNTER 72800020 AH R1,SEVEN TO BYTES 72880020 SRL R1,3 72960020 L R2,ELCTR GET CURRENT LC 73040020 LA R2,0(,R2) CLEAR WRAP BITS 73120020 SR R1,R2 IS INCREMENT NEEDED 73200020 BZ NOFNINC NO 73280020 ST R1,LOCLEN YES, SET INCREMENT = 1 73360020 LR R10,R6 SAVE TEXT POINTER 73440020 SET (NOTEWL,NOTEHS),OFF BE SURE NOTE-POINT SWITCHES OFF 73520020 JCALL LOCUPD CALL LOCATION COUNTER UPDATE 73600020 NOFNINC CLI DCLNG,X'00' IS DC TOO LONG @OX09734 73680005 BE OKLNG @OX09734 73700005 X5ERRL 157,0 LENGTH ERROR 73720020 OKLNG SR R1,R1 73740020 TM DUMSW,TESTER IS THIS DS OR DXD 73760020 BNZ CHEK1ST YES 73840020 LH R2,OBITS NO, SET OUTPUT BIT COUNT 73920020 LA R1,ENTDC SET FOR DC PRINT 74000020 LTR R2,R2 CHECK UNPRINTED DATA 74080020 BNZ FPRCALL YES 74160020 CHEK1ST TM FSTPSW,TESTER HAVE WE PRINTED YET 74240020 BNZ KLEANUP YES 74320020 FPRCALL L R12,=A(DCPRINT) SET FOR DCPRINT 74400020 BALR R9,R12 BRANCH TO ROUTINE 74480020 KLEANUP SET XRFNO,ON TURN ON XREF 74560020 MVC PRINTSW,DCPRSW RESTORE PRINT SWITCH 74640020 SET PRDEFREQ,OFF TURN PRIOR DEF REQUIRED OFF 74720020 GETOT JRETURN , EXIT 74800020 JEXTRN (X5L01=LOGERR) DEFINE EXTRNAL SYMBOL 74880020 DISPLIM DC F'4096' DISPLACEMENT UPPER LIMIT 74960020 REGLIM DC F'15' REGISTER UPPER LIMIT 75040020 BIGLIM DC F'524280' L-MOD BIT LIMIT FOR C/X IN DS 75120020 YMASK DC X'00007FFF' Y-CON OVERFLOW CHECKER 75200020 YNMASK DC X'FFFF8000' Y-CON LOWER LIMIT 75250020 WRAPMSK DC X'07FFFFFF' BIT LOCTR WRAP MASK 75280020 BYTEMSK DC X'FFFFFFF8' PARTIAL-BYTE PAD MASK 75360020 ALINMT DC 4F'0' ALIGNMENT BYTES FOR PRINT 75440020 TABLENG DC H'20' TYPE-TABLE ITEM LENGTH 75520020 ONE DC H'1' 75600020 SEVEN DC H'7' 75760020 EJECT 75762020 * 75764020 * SUBROUTINE LINKAGE TO CHECK FOR DUPLICATE ERROR MESSAGES AND TO 75766020 * CALL THE ERROR LOGGING ROUTINE IF IT IS NOT 75768020 * 75770020 * NOTE - R0 AND R1 ARE DESTROYED 75772020 * 75774020 ERLOG ST R6,ERRPTR SAVE COLUMN POINTER 75776020 ERLOG2 SR R0,R0 ZERO FOR INSERT 75778020 IC R0,D1(,R9) PICK UP THE ERROR CODE 75780020 SLL R0,D24 POSITON IT 75782020 SRA R0,D16 WITH A SIGN 75784020 IC R0,KCOUNT+D1 AND COUNT 75786020 L R1,X5ATEMP GET INDEX 75788020 LTR R1,R1 ARE ANY LOGGED YET THIS OPERAND 75790020 BZ LOGIT NO, DO IT 75792020 LOGLOOP CH R0,X5ATEMP+D2(R1) YES, IS IT A DUPLICATE 75794020 BE D4(R9) YES, BYPASS ERROR LOGGING 75796020 BCTR R1,0 BACK UP THE INDEX 75798020 BCT R1,LOGLOOP TO NEXT COMPARE 75800020 LOGIT CLI X5ATEMP+D3,ELIM ANY ROOM LEFT 75802020 BE NOTABE NO, SKIP ENTRY 75804020 L R1,X5ATEMP YES, REFRESH INDEX 75806020 STH R0,X5ATEMP+D4(R1) PLUG CODE & CONSTANT ID 75808020 LA R1,D2(,R1) BUMP INDEX 75810020 ST R1,X5ATEMP AND SAVE IT 75812020 NOTABE L R12,=A(LOGERR) POINT AT ERROR ROUTINE 75814020 BR R12 GO THERE 75816020 ELIM EQU L'X5ATEMP-D4 MAXIMUM ERROR ENTRY DISP 75818020 LTORG 75840020 DCTRBL DC 26X'00' DC TYPE TRANSLATE TABLE 75920020 DCTABLE DC 0F'0' 76000020 DC H'1,0,1,2048,0,0,0,0',B'01000000',AL3(CKON) C 76080020 DC H'1,0,1,2048,0,0,0,0',B'01000000',AL3(XKON) X 76160020 DC H'1,0,1,2048,0,0,0,0',B'01000000',AL3(BKON) B 76240020 DC H'1,0,1,128,0,31,0,0',B'01000000',AL3(PKON) P 76320020 DC H'1,0,1,128,0,16,0,0',B'01000000',AL3(ZKON) Z 76400020 DC H'16,7,1,128,0,28,-85,75',B'01110000',AL3(DKON) L 76480020 DC H'8,7,1,64,0,14,-85,75',B'01110000',AL3(DKON) D 76560020 DC H'4,3,1,64,0,14,-85,75',B'01110000',AL3(DKON) E 76640020 DC H'4,3,1,64,-187,346,-85,75',B'01110000',AL3(DKON) F 76720020 DC H'2,1,1,64,-187,346,-85,75',B'01110000',AL3(DKON) H 76800020 DC H'4,3,1,32,0,0,0,0',B'11000000',AL3(AYKON) A 76880020 DC H'2,1,1,16,0,0,0,0',B'11000000',AL3(AYKON) Y 76960020 DC H'4,3,24,32,0,0,0,0',B'10000000',AL3(VKON) V 77040020 DC H'4,3,8,32,0,0,0,0',B'10000000',AL3(QKON) Q 77120020 DC H'2,1,16,16,0,0,0,0',B'10000000',AL3(SKON) S 77200020 EJECT 77280020 KOUTPUT JSAVE BASE=YES SAVE REGISTERS 77360020 MVC FULLWD(4),0(R10) GET 1ST 4 BYTES 77440020 LR R4,R7 SAVE REGISTER 77520020 L R7,FULLWD GET FIRST 4 BYTES 77600020 LA R10,4(,R10) SET FOR NEXT PICKUP 77680020 LA R3,32 SET INPUT BIT COUNT 77760020 SLL R7,D0(R2) TRUNCATE 1ST BYTE 77840020 SR R3,R2 ADJUST IN-BIT COUNT 77920020 B KOBCHEK TO CHECK OUT-BIT LIMIT 78000020 KOUTSET LH R14,OBITS GET PRINT BIT COUNT 78080020 SRDL R14,3 DIVIDE BY 8 78160020 LA R9,DCDATA(R14) POINT TO CURRENT PRINT BYTE 78240020 SR R14,R14 78320020 SLDL R14,3 8 - REMAINDER 78400020 LA R2,8 INTO SHIFT CONTROL 78480020 SR R2,R14 78560020 SR R3,R2 ADJUST INBIT COUNT BY SHIFT 78640020 BM KNEGCT TO NOT ENOUGH IN-BITS 78720020 SR R6,R6 CLEAR OUTPUT REGISTER 78800020 SLDL R6,0(R2) SHIFT IN BITS 78880020 EX R6,KBITOR OR BITS TO PRINT 78960020 AH R2,OBITS INCREMENT OUT-BIT COUNT 79040020 STH R2,OBITS 79120020 SRA R2,6 IS PRINT FULL 79200020 BZ KOUTSET NO, KEEP SHIFTING 79280020 * PRINT 8 BYTES HERE 79360020 LA R2,64 CALL PRINT FOR 79440020 LA R1,ENTDC SET FOR DC PRINT 79520020 STM R10,R11,PREGSV SAVE IN-BIT CONTROLS 79600020 XR R7,R4 EXCHANGE 79680020 XR R4,R7 REGISTERS 79760020 XR R7,R4 FOR NEXT ROUTINE 79840020 LA R12,DCPRINT 79920020 BALR R9,R12 BRANCH TO ROUTINE 80000020 XR R7,R4 RESTORE 80080020 XR R4,R7 BY EXCHANGING 80160020 XR R7,R4 THEM 80240020 LM R10,R11,PREGSV RESTORE IN-BIT CONTROLS 80320020 B KOUTSET TO NEXT OUTPUT 80400020 KNEGCT LCR R1,R3 SET ZERO-FILL SHIFT 80480020 AR R2,R3 REDUCE INITIAL SHIFT 80560020 SR R6,R6 CLEAR OUTPUT REGISTER 80640020 SLDL R6,0(R2) SHIFT IN REMAINING BITS 80720020 SLL R6,0(R1) POSITION FOR OUTPUT 80800020 EX R6,KBITOR OR BITS TO PRINT 80880020 AH R2,OBITS INCREMENT OUT-BIT COUNT 80960020 STH R2,OBITS FULL PRINT IS IMPOSSIBLE 81040020 MVC FULLWD(4),0(R10) GET NEXT 4 BYTES 81120020 L R7,FULLWD GET NEXT 4 BYTES 81200020 LA R10,4(,R10) SET FOR NEXT PICKUP 81280020 LA R3,32 RE-SET INPUT BIT COUNT 81360020 KOBCHEK SR R11,R3 REDUCE TOTAL IN-BIT COUNT 81440020 BNM KOUTSET TO OUTPUT UNLESS NEGATIVE 81520020 AR R3,R11 FORM REMAINING IN-BIT COUNT 81600020 BP MORPRNT EXIT IF ZERO 81680020 KXIT JRETURN , EXIT 81760020 MORPRNT SR R11,R11 ZERO TO TOTAL REMAINDER 81840020 B KOUTSET TO OUTPUT THE REST 81920020 KBITOR OI D0(R9),D0 EXECUTED OR FOR PRINT 82000020 DROP R5 RETURN TO COMMON USING REGISTER 82080020 EJECT 82160020 PRINT DATA 82240020 * SUBROUTINE TO CALL PRINT 82320020 * TO CALL - LA R12,DCPRINT - BALR R5,R12 82400020 * SAVES R3 THRU R13 82480020 * CLEARS PRINT DATA, CONTROL BYTE, AND OBITS AFTER PRINT 82560020 * TURNS OFF 1ST TIME SWITCH IF NOT ALIGN CALL 82640020 * PRINT LOCATION COUNTER IS UPDATED AFTER PRINT 82720020 * PARAMETERS - 82800020 * R1 = 0 FORCES ENTIRE STATEMENT PRINT, NO DATA (FOR DS, DXD) 82880020 * R1 = X'80' FORCES ALIGNMENT PRINT 82960020 * R2 = ALIGNMENT BYTE COUNT 83040020 * R1 = X'40' FORCES DATA PRINT 83120020 * R2 = OUTPUT BIT COUNT (PARTIAL BYTE GETS PADDED) 83200020 DCPRINT JSAVE BASE=YES SAVE REGISTERS 83280020 STM R10,R12,PRNTSV SAVE REGISTERS 83360020 LTR R1,R1 CHECK STATEMENT PRINT 83440020 BNZ DCPACT NO 83520020 SR R2,R2 ZERO DATA BYTES 83600020 MVI LHFLGS,D0 YES, ZERO CONTROL BYTE 83680020 MVI FSTPSW,TESTER TURN OFF 1ST TIME SWITCH 83760020 GOIF DXDSW,OFF=DCPCALL IS THIS DXD 83840020 MVI LHFLGS,DNTPLH SET NO LEFT-HALF 83920020 B DCPCALL TO PRINT 84000020 DCPACT LA R0,ENTALN CHECK ALIGN CALL 84080020 CLR R1,R0 84160020 BNE POBITS NO 84240020 XC DCDATA,DCDATA CLEAR PRINT DATA 84320020 B PCTROL TO SET CONTROL 84400020 POBITS LA R2,7(,R2) PAD PARTIAL BYTE 84480020 SRL R2,3 FORM BYTE COUNT 84560020 MVI FSTPSW,TESTER TURN OFF 1ST TIME SWITCH 84640020 PCTROL LA R1,0(R1,R2) SET CONTROL BYTE 84720020 STC R1,LHFLGS SET LEFT HALF FLAGS 84800020 DCPCALL LA R10,DC0OUT SET PRINT INDEX 84880020 LR R3,R2 SAVE DATA BYTES 84960020 L R5,TXTPTR GET TEXT POINTER 85040020 JCALL OUTPUT CALL PRINT PUNCH ROUTINE 85120020 LA R5,LEFTHF POINT TO WORK AREA 85200020 JEXTRN (X5P01=OUTPUT) DEFINE EXTERNAL SYMBOL 85280020 XC DCDATA,DCDATA CLEAR DATA 85360020 MVI OBITS+1,0 CLEAR OUTPUT-BIT COUNT 85440020 L R1,LOCATN INCREMENT PRINT LOCATION 85520020 ALR R1,R3 OR ALIGNMENT BYTES 85600020 ST R1,LOCATN STORE NEW LOCATION COUNTER 85680020 LM R10,R12,PRNTSV RESTORE REGISTERS 85760020 DCXIT JRETURN , EXIT 85840020 EJECT 86000020 * DC CHARACTERISTICS AND GO-TO TABLE 86080020 * EACH TABLE ITEM IS 20 BYTES LONG 86160020 * BYTES 0-1 - IMPLIED LENGTH 86240020 * BYTES 2-3 - ALIGNMENT FACTOR 86320020 * BYTES 4-5 - LENGTH-MOD LOWER LIMIT 86400020 * BYTES 6-7 - LENGTH-MOD UPPER LIMIT 86480020 * BYTES 8-9 - SCALE-MOD LOWER LIMIT 86560020 * BYTES 10-11 - SCALE-MOD UPPER LIMIT 86640020 * BYTES 12-13 - EXPONENT-MOD LOWER LIMIT 86720020 * BYTES 14-15 - EXPONENT-MOD UPPER LIMIT 86800020 * BYTE 16 - FLAG BYTE 86880020 * BIT 0 = 1 IF ADDRESS TYPE 86960020 * BIT 1 = 1 IF BIT-LENGTH LEGAL 87040020 * BIT 2 = 1 IF SCALE-MOD LEGAL 87120020 * BIT 3 = 1 IF EXPONENT-MOD LEGAL 87200020 * BITS 4 - 7 CURRENTLY UNUSED 87280020 * BYTES 17-19 - BRANCH ADDRESS FOR CONSTANT SCAN 87360020 IMPLINC EQU 0 IMPLICIT LENGTH ACCESS 87440020 ALININC EQU 2 ALIGNMENT ACCESS 87520020 LOLMINC EQU 4 LO L-MOD ACCESS 87600020 HILMINC EQU 6 HI L-MOD ACCESS 87680020 LOSMINC EQU 8 LO S-MOD ACCESS 87760020 HISMINC EQU 10 HI S-MOD ACCESS 87840020 LOEMINC EQU 12 LO E-MOD ACCESS 87920020 HIEMINC EQU 14 HI E-MOD ACCESS 88000020 FLAGINC EQU 16 FLAG BYTE ACCESS 88080020 ADDRINC EQU 16 ADDRESS WORD ACCESS 88160020 ABIT EQU X'80' ADDRESS TYPE TESTER 88240020 EBIT EQU X'10' E-MOD VALIDITY TESTER 88480020 CBKT EQU 1 C TYPE FLAG (DC) 88560020 XBKT EQU CBKT+1 X TYPE FLAG (DC) 88640020 BBKT EQU XBKT+1 B TYPE FLAG (DC) 88720020 PBKT EQU BBKT+1 P TYPE FLAG (DC) 88800020 ZBKT EQU PBKT+1 Z TYPE FLAG (DC) 88880020 LBKT EQU ZBKT+1 L TYPE FLAG (DC) 88960020 DBKT EQU LBKT+1 D TYPE FLAG (DC) 89040020 EBKT EQU DBKT+1 E TYPE FLAG (DC) 89120020 FBKT EQU EBKT+1 F TYPE FLAG (DC) 89200020 HBKT EQU FBKT+1 H TYPE FLAG (DC) 89280020 ABKT EQU HBKT+1 A TYPE FLAG (DC) 89360020 YBKT EQU ABKT+1 Y TYPE FLAG (DC) 89440020 VBKT EQU YBKT+1 V TYPE FLAG (DC) 89520020 QBKT EQU VBKT+1 Q TYPE FLAG (DC) 89600020 SBKT EQU QBKT+1 S TYPE FLAG (DC) 89680020 ORG DCTRBL+JC-JALFAMIN ORG TO CORRECT PLACE FOR C 89760020 DC AL1(CBKT) C ENTRY IN TABLE 89840020 ORG DCTRBL+JX-JALFAMIN ORG TO CORRECT PLACE FOR X 89920020 DC AL1(XBKT) X ENTRY IN TABLE 90000020 ORG DCTRBL+JB-JALFAMIN ORG TO CORRECT PLACE FOR B 90080020 DC AL1(BBKT) B ENTRY IN TABLE 90160020 ORG DCTRBL+JP-JALFAMIN ORG TO CORRECT PLACE FOR P 90240020 DC AL1(PBKT) P ENTRY IN TABLE 90320020 ORG DCTRBL+JZ-JALFAMIN ORG TO CORRECT PLACE FOR Z 90400020 DC AL1(ZBKT) Z ENTRY IN TABLE 90480020 ORG DCTRBL+JL-JALFAMIN ORG TO CORRECT PLACE FOR L 90560020 DC AL1(LBKT) L ENTRY IN TABLE 90640020 ORG DCTRBL+JD-JALFAMIN ORG TO CORRECT PLACE FOR D 90720020 DC AL1(DBKT) D ENTRY IN TABLE 90800020 ORG DCTRBL+JE-JALFAMIN ORG TO CORRECT PLACE FOR E 90880020 DC AL1(EBKT) E ENTRY IN TABLE 90960020 ORG DCTRBL+JF-JALFAMIN ORG TO CORRECT PLACE FOR F 91040020 DC AL1(FBKT) F ENTRY IN TABLE 91120020 ORG DCTRBL+JH-JALFAMIN ORG TO CORRECT PLACE FOR H 91200020 DC AL1(HBKT) H ENTRY IN TABLE 91280020 ORG DCTRBL+JA-JALFAMIN ORG TO CORRECT PLACE FOR A 91360020 DC AL1(ABKT) A ENTRY IN TABLE 91440020 ORG DCTRBL+JY-JALFAMIN ORG TO CORRECT PLACE FOR Y 91520020 DC AL1(YBKT) Y ENTRY IN TABLE 91600020 ORG DCTRBL+JV-JALFAMIN ORG TO CORRECT PLACE FOR V 91680020 DC AL1(VBKT) V ENTRY IN TABLE 91760020 ORG DCTRBL+JQ-JALFAMIN ORG TO CORRECT PLACE FOR Q 91840020 DC AL1(QBKT) Q ENTRY IN TABLE 91920020 ORG DCTRBL+JS-JALFAMIN ORG TO CORRECT PLACE FOR S 92000020 DC AL1(SBKT) S ENTRY IN TABLE 92080020 ORG , GET LOCATION COUNTER IN STEP 92120020 EJECT 92160020 TESTER EQU X'F0' FLAG TEST MASK 92320020 EXBLANK EQU X'40' EXTERNAL BLANK CODE 92640020 UNBKT EQU X'10' UNCLASSIFIED TEXT BKT TYPE 93520020 JPATCH X5D00,122C 5% PATCH AREA 93620020 END 93760020