MACRO 00100000 &ID XEVAL &DUMMY,&TESTRAN=NO,&DIAG=NO,&LEVEL=1,&LOGERR=NO 00200000 GBLC &COMPNM 00300000 LCLC &NM 00400000 JHEAD 'EXPRESSION EVALUATION SUBROUTINE', ,00500000 PHASEID=&ID, ,00600000 LEVEL=&LEVEL 00700000 &NM SETC '&COMPNM&ID' 00800000 *TITLE- ASSEMBLER EXPRESSION EVALUATION SUBROUTINE * 00900000 * * 01000000 *FUNCTION/OPERATION- * 01100000 * EVALUATE EXPRESSIONS * 01200000 * CONVERT SELF-DEFINING TERMS * 01300000 * DETECT ERRORS IN EXPRESSIONS * 01400000 * SYNTACTIC ERRORS- * 01500000 * ILLEGAL CHARACTER IN EXPRESSION * 01600000 * ILLEGAL COMBINATION OF OPERATORS * 01700000 * MORE THAN TWENTY TERMS IN EXPRESSION * 01800000 * MORE THAN SIX LEVELS OF PARENTHESES IN EXPRESSION * 01900000 * PREMATURE END OF EXPRESSION * 02000000 * NON-SYNTACTIC ERRORS- * 02100000 * SELF-DEFINING TERM TOO LARGE * 02200000 * SELF-DEFINING TERM CONTAINS TOO MANY CHARACTERS * 02300000 * RELOCATABLE TERM IN A MULTIPLY OR DIVIDE OPERATION * 02400000 * ARITHMETIC OVERFLOW ON AN INTERMEDIATE VALUE * 02500000 * UNDEFINED SYMBOL IN EXPRESSION * 02600000 * INVALID SYMBOL * 02700000 * * 02800000 *ENTRY POINT- * 02900000 ENTRY &NM.01 * 03000000 * * 03100000 *INPUT- * 03200000 * REGISTERS- * 03300000 * R5- REGISTER CONTAINING THE ADDRESS OF THE FIRST * 03400000 * CHARACTER OF THE EXPRESSION TO BE EVALUATED * 03500000 * PARAMETERS- * 03600000 * SELFDEFN- A BYTE IN STORAGE, WHEN SET TO ZERO, CAUSES * 03700000 * ONE DECIMAL SELF-DEFINING TERM TO BE * 03800000 * CONVERTED ONLY * 03900000 * ELCTR- A FULLWORD IN STORAGE CONTAINING THE VALUE OF * 04000000 * THE CURRENT LOCATION COUNTER * 04100000 * EESDI- A HALFWORD IN STORAGE CONTAINING THE CURRENT * 04200000 * ESDID * 04300000 * CLCLNG- A HALFWORD IN STORAGE CONTAINING THE LENGTH * 04400000 * ATTRIBUTE OF THE CURRENT LOCATION COUNTER * 04500000 * SUBLIST- A BIT IN STORAGE, WHEN SET TO ONE, INDICATES * 04600000 * THAT THE LOGICAL END OF THE EXPRESSION IS * 04700000 * WHEN THE PARENTHESES LEVEL GOES FROM ONE TO * 04800000 * ZERO * 04900000 * * 05000000 *OUTPUT- * 05100000 * CONDITION CODE SETTING- * 05200000 * 0- VALUE OF THE EXPRESSION IS ABSOLUTE * 05300000 * 1- IF 'EVALSW1' IS 0, VALUE OF THE EXPRESSION IS * 05400000 * COMPLEXLY RELOCATABLE. IF 'EVALSW1' IS NOT * 05500000 * 0, ONE OR MORE NON-SYNTACTIC ERROR WAS * 05600000 * ENCOUNTERED IN THE EVALUATION. * 05700000 * 2- VALUE OF THE EXPRESSION IS SIMPLY RELOCATABLE * 05800000 * 3- A SYNTATIC ERROR WAS ENCOUNTERED * 05900000 * REGISTERS- * 06000000 * R10- REGISTER CONTAINING THE ESDID OF THE * 06100000 * EXPRESSION, IF THE VALUE OF THE EXPRESSION IS * 06200000 * ABSOLUTE OR SIMPLY RELOCATABLE. THE ESDID IN * 06300000 * COMPLEMENT FORM, IF THE VALUE OF THE * 06400000 * EXPRESSION IS COMPLEXLY RELOCATABLE WITH ONLY * 06500000 * ONE RELOCATION FACTOR. * 06600000 * R11- REGISTER CONTAINING THE VALUE OF THE * 06700000 * EXPRESSION * 06800000 * R14- REGISTER CONTAINING THE ADDRESS OF THE FIRST * 06900000 * CHARACTER FOLLOWING THE CHARACTER WHICH * 07000000 * LOGICALLY TERMINATED THE EXPRESSION * 07100000 * PARAMETERS- * 07200000 * IMPLNG- A HALFWORD IN STORAGE CONTAINING THE LENGTH * 07300000 * ATTRIBUTE OF THE EXPRESSION * 07400000 * LOCCTREF- A BIT IN STORAGE, WHEN SET TO ONE, INDICATES * 07500000 * THAT AT LEAST ONE LOCATION COUNTER REFERENCE * 07600000 * HAD BEEN MADE * 07700000 * RELOCTR- A BYTE IN STORAGE CONTAINING THE NUMBER OF * 07800000 * ESDID(S) ASSOOCIATED WITH THE VALUE OF THE * 07900000 * EXPRESSION * 08000000 * RLIST- A LIST OF HALFWORDS IN STORAGE CONTAINING * 08100000 * THE ESDID(S) ASSOCIATED WITH THE VALUE OF THE * 08200000 * EXPRESSION, THE ESDID IS STORED IN COMPLEMENT * 08300000 * FORM IF THE RELOCATION FACTOR IS APPLIED * 08400000 * NEGATIVLY. * 08500000 * * 08600000 *EXITS, NORMAL- * 08700000 * EXITS TO THE CALLER. * 08800000 * * 08900000 *EXITS, ERROR- * 09000000 * EXITS TO THE CALLER. * 09100000 * * 09200000 *TABLES/WORK AREAS- * 09300000 * EVALWORK- * 09400000 * OPRNS- UP TO 20 ENTRIES OF ONE BYTE EACH, AN ENTRY IS * 09500000 * MADE FOR EACH OPERATOR ENCOUNTERED. * 09600000 * RLIST- UP TO 20 ENTRIES OF ONE HALFWORD EACH, AN ENTRY IS * 09700000 * MADE FOR THE ESDID OF EACH TERM ENCOUNTERED. * 09800000 * TERMS- UP TO 15 ENTRIES OF TWO FULLWORDS EACH, AN ENTRY * 09900000 * IS MADE FOR EACH TERM ENCOUNTERED. * 10000000 * * 10100000 *ATTRIBUTES- * 10200000 * REFRESHABLE. * 10300000 * * 10400000 *NOTES- * 10500000 * * 10600000 EJECT 10700000 COPY JCOMMON 10800000 AIF ('&ID' NE 'X4V').NOTX4V 10900000 EJECT 11000000 COPY ICOMMON 11100000 EJECT 11200000 &NM.00 CSECT 11300000 * VS1 REL 2.6 CHANGES 11350002 *A585500-585900 OX00106 11370002 * VS1 RELEASE 3.1 CHANGES 11380003 *C643000,645000 OX02675 11390003 JMODID 11400000 USING &NM.01,R8 BASE REGISTER 11500000 &NM.01 BALR R14,R7 SAVE REGISTERS 11600000 LR R8,R12 BASE REGISTER 11700000 AGO .X4V 11800000 .NOTX4V EJECT 11900000 COPY X5COM 12000000 EJECT 12100000 DSECT10 DSECT 12200000 COPY RSYMRCD 12300000 EJECT 12400000 COPY BMDSECTS GET POST PROCESSOR RECORD DSECT 12500000 EJECT 12600000 COPY JERMSGCD DEFINE ERROR CODES AND SEVERITY 12700000 EJECT 12800000 * VS1 RELEASE 3.1 CHANGES 12850003 *C625000,631000 OX02953 12860003 *C648000 @OY08064 12860105 *A648100-648200 @OY08064 12860205 *A589100,589200 @VM05316 12870200 &NM.00 CSECT 12900000 JMODID 13000000 &NM.01 JSAVE 13100000 EVAL EQU &NM.01 LABEL 13200000 USING DSECT2,R2 13300000 USING DSECT3,R3 13400000 USING JTEXT,R4 13500000 USING DSECT5,R5 13600000 USING X5COM,R7 13700000 USING DSECT10,R11 DEFINITION FILE USING 13800000 USING DSECT14,R14 13900000 LR R5,R10 INPUT COLUMN POINTER 14000000 .X4V XC EVALWORK,EVALWORK INITIALIZE WORK AREA 14100000 LM R2,R4,EVALREGS INITIAL SETTING OF REGISTERS 14200000 SPACE 14300000 * SCAN EXPRESSION * 14400000 SPACE 14500000 SCAN ST R5,ERRPTR SAVE FOR ERROR DIAGNOSTICS 14600000 AIF ('&ID' EQ 'X5V').X5V1 14700000 CLI CHAR1,JBLANK SEE IF A BLANK 14850000 BH SYNTAXER ILLEGAL CHARACTER IN EXPRESSION 14860000 CLI CHAR1,JEQUAL SEE IF AN EQUAL SIGN 14950000 BE SYNTAXER ILLEGAL CHARACTER IN EXPRESSION 14960000 AGO .X4V1 15000000 .X5V1 CLI CHAR1,JBLANK SEE IF A BLANK 15250000 BH SYNERR1 ILLEGAL CHARACTER IN EXPRESSION 15260000 CLI CHAR1,JEQUAL SEE IF AN EQUAL SIGN 15270000 BE SYNERR1 ILLEGAL CHARACTER IN EXPRESSION 15280000 .X4V1 ANOP 15300000 BL ALPHANUM TERM 15350000 SPACE 15400000 * GO TO SPECIAL CHARACTER HANDLING * 15500000 SPACE 15600000 SR R14,R14 ZERO REGISTER FOR INDEX 15700000 IC R14,CHAR1 GET NEXT CHARACTER 15800000 STC R14,NEWOP ENTER IN OPERATOR STACK 15900000 IC R14,GOTOTBL-JLPARN(R14) INDEXED ADDRESS FETCH 16000000 GOIF STATUS1,ELSE=GOTO(R14) GO TO ROUTINE, PASS STATUS 16100000 EJECT 16200000 * (1) PLUS OR MINUS SIGN * 16300000 SPACE 16400000 GOTO BH BINARYOP 2/3 - BINARY OPERATOR 16500000 SPACE 16600000 * (2) UNARY OPERATOR * 16700000 SPACE 16800000 AIF ('&ID' EQ 'X5V').X5V2 16900000 GOIF LNGQUOTE,ON=SYNTAXER ILLEGAL L'ATTRIBUTE REFERENCE 17000000 AGO .X4V2 17100000 .X5V2 GOIF LNGQUOTE,ON=SYNERR2 ILLEGAL L'ATTRIBUTE REFERENCE 17200000 .X4V2 ANOP 17300000 GOIF ADD1,EQUAL=CALC3 '+' - UNARY PLUS, IGNORE 17400000 SET UNY1 '-' - SET UNARY MINUS CODE 17500000 GOIF UNY0,EQUAL=CALC5,ELSE=CALC2 CHECK PREVIOUS OPERATOR 17600000 SPACE 17700000 * (3) SLASH * 17800000 SPACE 17900000 AIF ('&ID' EQ 'X5V').X5V3 18000000 SLASH BNH SYNTAXER 0/1 - TWO CONSECUTIVE OPERATORS 18100000 AGO .X4V3 18200000 .X5V3 ANOP 18300000 SLASH BNH SYNERR3 0/1 - TWO CONSECUTIVE OPERATORS 18400000 .X4V3 ANOP 18500000 SPACE 18600000 * (4) BINARY OPERATOR * 18700000 SPACE 18800000 BINARYOP SET STATUS1 1 - PLUS OR MINUS SIGN 18900000 B CALC1 GO CALCULATE 19000000 SPACE 19100000 * (5) ASTERISK * 19200000 SPACE 19300000 ASTERISK BH BINARYOP 2 - MULTIPLICATION SIGN 19400000 SPACE 19500000 * (6) LOCATION COUNTER REFERENCE * 19600000 SPACE 19700000 SET LOCTREF,ON LOCATION COUNTER REFERENCED 19800000 LA R5,CHAR2 ADVANCE COLUMN POINTER 19900000 GOIF LNGQUOTE,ON=LOCCTR1 SEE IF LENGTH ATTRIBUTE 20000000 SPACE 20100000 * (7) LOCATION COUNTER * 20200000 SPACE 20300000 SET DLOCTREF,ON LOCATION COUNTER REFERENCED 20400000 LH R15,CLCLNG LENGTH ATTRIBUTE 20700000 AIF ('&ID' NE 'X4V').X5V41 20750000 LH R0,EESDI CURRENT ESDID 20800000 L R1,ELCTR CURRENT LOCATION COUNTER 20850000 B CLEANUP1 GO TO CLEANUP 20860000 AGO .X4X5V 20870000 .X5V41 GOIF LITRSW,ON=SKIPLITR BRANCH AROUND IF NOT PROC. LITR 20880000 LH R0,EESDI GET CURRENT ESDID 20890000 L R1,ELCTR GET CURRENT LOCATION CTR 20892000 B CLEANUP1 GO TO CLEANUP 20894000 SKIPLITR EQU * BRANCH LABEL 20896000 LH R0,LITRSD GET LITR ESDID 20898000 L R1,LITRLC GET LITR LOCATION CTR 20898400 B CLEANUP1 GO TO CLEANUP 20898800 .X4X5V ANOP 20899200 SPACE 20900000 * (8) L - QUOTE ASTERISK * 21000000 SPACE 21100000 LOCCTR1 LH R1,CLCLNG GET CURRENT LOCATION LENGTH 21200000 B ABSOLUTE CLEANUP 21300000 SPACE 21400000 * (9) LEFT PARENTHESIS * 21500000 SPACE 21600000 LFPAREN BH BLANK1 2/3 - MAY BE END OF EXPRESSION 21700000 AIF ('&ID' EQ 'X5V').X5V4 21800000 GOIF MAXPARN,NOTLOW=SYNTAXER TOO MMNY LEVELS OF PARENS 21900000 AGO .X4V4 22000000 .X5V4 GOIF MAXPARN,NOTLOW=SYNERR4 TOO MANY LEVELS OF PARENS 22100000 .X4V4 ANOP 22200000 LH R14,PARENCNT GET PARENTHESES COUNT 22300000 LA R14,D1(,R14) BUMP IT BY ONE 22400000 STH R14,PARENCNT AND SAVE 22500000 B CALC2 EXIT 22600000 SPACE 22700000 * (10) RIGHT PARENTHESIS * 22800000 SPACE 22900000 AIF ('&ID' EQ 'X5V').X5V5 23000000 RTPAREN BNH SYNTAXER 0/1 - INVALID SYNTAX 23100000 AGO .X4V5 23200000 .X5V5 ANOP 23300000 RTPAREN BNH SYNERR6 0/1 - INVALID SYNTAX 23400000 .X4V5 ANOP 23500000 GOIF NOPAREN,EQUAL=BLANK2,ELSE=CALC MAY BE END OF OPERAND 23600000 SPACE 23700000 * (11) BLANK OR COMMA * 23800000 SPACE 23900000 AIF ('&ID' EQ 'X5V').X5V6 24000000 BLANK BNH SYNTAXER 0/1 - PREMATURE END OF EXPRESSION 24100000 BLANK1 GOIF NOPAREN,HIGH=SYNTAXER UNBALENCED PARENTHESES 24200000 AGO .X4V6 24300000 .X5V6 ANOP 24400000 BLANK BNH SYNERR6 PREMATURE END OF EXPRESSION 24500000 BLANK1 GOIF NOPAREN,HIGH=SYNERR6 OR UNBALANCED PARENTHESIS 24600000 .X4V6 ANOP 24700000 BLANK2 SET ENDOFEXP,ON SET END-OF-EXPRESSION INDICATOR 24800000 EJECT 24900000 * ARITHMETIC CALCULATION * 25000000 SPACE 25100000 CALC SET DEL1 FORCE COMPUTATION 25200000 CALC1 CL R4,AOPTR READY TO GO TO WORK 25300000 BH CALC6 YEAH 25400000 GOIF ENDOFEXP,ON=FINIS1 LEAVE IF FINISHED 25500000 CALC2 LA R4,NEWOP BUMP OPERATOR STACK POINTER 25600000 CALC3 LA R5,CHAR2 POINT TO NEXT CHARACTER 25700000 B SCAN LOOK FOR NEXT TERM OR OPERATOR 25800000 CALC4 GOIF DEL0,HIGH=WORK GO TO WORK 25900000 LH R14,PARENCNT GET PARENTHESES LEVEL 26000000 BCT R14,CALC41 SEE IF WITHOUT 26100000 GOIF SUBLIST,ON=FINIS PROCESSING MODIFIER EXPRESSIONS 26200000 CALC41 STH R14,PARENCNT SAVE PARENTHESES LEVEL COUNTER 26300000 CALC5 BCTR R4,0 POP OPERATOR STACK 26400000 B CALC3 GO SCAN SOME MORE 26500000 CALC6 CLC NEWOP,OLDOP DO WE HAVE TO GO 26600000 BNH CALC4 MAYBE NOT 26700000 SPACE 26800000 * REDUCE HIERARCHY TO THREE LEVELS * 26900000 SPACE 27000000 GOIF SUB1,NOTEQ=CALC7 '-' - SUBTRACTION 27100000 GOIF ADD0,EQUAL=WORK '+' - ADDITION 27200000 CALC7 GOIF DIV1,NOTEQ=CALC2 '/' - DIVISION 27300000 GOIF MUL0,NOTEQ=CALC2 '*' - MULTIPLICATION 27400000 SPACE 27500000 * PERFORM ARITHMETIC OPERATION ON LAST 2 TERMS * 27600000 SPACE 27700000 WORK LA R14,TERM2+L'TERM2-TERM1CNT GET LENGTH OF TWO TERMS 27800000 SR R2,R14 POINT TO FIRST OF TWO TERMS 27900000 L R1,TERM2 GET THE SECOND TERM 28000000 LR R11,R3 SAVE POINTER 28100000 LR R10,R3 SAVE POINTER 28200000 SH R3,TERM2CNT+2 POINT TO BEGINNING FOR RLIST2 28300000 LR R15,R3 SAVE POINTER 28400000 GOIF UNY0,EQUAL=UNARY UNARY 28500000 LR R0,R3 SAVE 28600000 SH R3,TERM1CNT+2 POINT TO BEGINNING OF RLIST1 28700000 SR R11,R3 GET LENGTH OF ENTIRE LIST 28800000 STH R11,TERM1CNT+2 FOR NEW LENGTH 28900000 GOIF SUB0,HIGH=MULTDIV,EQUAL=SUBTRACT +,- VS *,/ 29000000 SPACE 29100000 * ADJUST RELOCATION INFORMATION * 29200000 SPACE 29300000 RELOC LH R11,ESDID GET NEXT ESDID FROM RLIST 29400000 GOIF (R11),ZERO=RELOC4 SKIP TEST IF ZERO 29500000 AH R11,ESDID-ESDID(,R15) SEE IF MATCH FOUND 29600000 BZ RELOC2 THIS PAIR CANCELS 29700000 RELOC1 LA R15,NEXTESD-ESDID(,R15) POINT TO NEXT ESDID IN RLIST2 29800000 GOIF (R15),(R10),NOTEQ=RELOC,ELSE=RELOC3 END OF LIST 29900000 RELOC2 STH R11,ESDID INDICATE CANCELLED 30000000 STH R11,ESDID-ESDID(,R15) INDICATE CANCELLED 30100000 IC R15,RELOCTR GET COUNT OF RELOCATABLE TERMS 30200000 BCTR R15,0 DECREMENT COUNT BY 2 30300000 BCTR R15,0 X 30400000 STC R15,RELOCTR SAVE 30500000 RELOC3 LR R15,R0 POINT TO BEGINNING OF RLIST2 30600000 RELOC4 LA R3,NEXTESD POINT TO NEXT ESDID IN RLIST1 30700000 GOIF (R3),(R0),NOTEQ=RELOC END OF LIST 30800000 SPACE 30900000 * ADDITION * 31000000 SPACE 31100000 A R1,TERM1 ADD THE TWO TERMS 31200000 BNO STORE GO IF NO OVERFLOW 31300000 OVERFLOW SET OVERFLO,ON SET OVERFLOW BIT 31400000 AIF ('&ID' NE 'X5V').X4VO 31500000 X5ERRL 235,CLMPTR ARITHMETIC OVERFLOW 31600000 .X4VO ANOP 31700000 STORE ST R1,TERM1 STORE RESULT 31800000 LA R2,TERM2CNT POINT TO NEXT TERM ENTRY SPACE 31900000 LR R3,R10 POINT TO NEXT RLIST ENTRY SPACE 32000000 MVC OLDOP,NEWOP REDUCE STACK 32100000 BCTR R4,0 DECREMENT OPERATOR STACK 32200000 B CALC1 ALL DONE FOR NOW 32300000 SPACE 32400000 * MULTIPLICATION OR DIVISION * 32500000 SPACE 32600000 MULTDIV BCTR R11,0 GET MACHINE LENGTH 32700000 EX R11,ABSCHECK ABSCHECK NC ESDID(0),ESDID 32800000 BZ MULTDIV1 NO RELOCATABLE TERMS 32900000 SET RELOCER,ON RELOCATABLE TERM IN OPERATION 33000000 AIF ('&ID' NE 'X5V').X4VR 33010000 X5ERRL 217,CLMPTR RELOCATION ERROR 33020000 .X4VR ANOP 33030000 MULTDIV1 GOIF (R1),ZERO=STORE RESULT IS ZERO IF TERM2 IS ZERO 33100000 L R14,TERM1 GET FIRST TERM 33200000 SRDA R14,32 PROPAGATE SIGN 33300000 GOIF MUL0,EQUAL=MULTIPLY MULTIPLICATION OR DIVISION 33400000 SPACE 33500000 * DIVISION * 33600000 SPACE 33700000 DR R14,R1 DIVISION 33800000 LR R1,R15 PASS RESULT 33900000 B STORE STORE RESULT 34000000 SPACE 34100000 * MULTIPLICATION * 34200000 SPACE 34300000 MULTIPLY MR R14,R1 PERFORM MULTIPLICATION 34400000 LTR R1,R15 TEST AND PASS RESULT 34500000 BNL SIGNCHK SKIP COMPLEMENT IF POSITIVE 34600000 LCR R14,R14 COMPLEMENT 34700000 BCTR R14,0 MAKE ZERO 34800000 SIGNCHK GOIF (R14),ZERO=STORE,NOTZERO=OVERFLOW TEST FOR OVERFLOW 34900000 EJECT 35000000 * SUBTRACTION * 35100000 SPACE 35200000 UNARY LA R2,TERM2CNT GOT NOTHING TO DO WITH TERM 1 35300000 SUBTRACT LCR R1,R1 COMPLEMENT TERM2 35400000 BO OVERFLOW CHECK FOR OVERFLOW 35500000 LESS LH R11,ESDID-ESDID(,R15) GET NEXT ESDID FROM RLIST2 35600000 LCR R11,R11 COMPLEMENT IT 35700000 STH R11,ESDID-ESDID(,R15) AND PUT IT BACK 35800000 LA R15,NEXTESD-ESDID(,R15) CONTINUE WITH REST OF RLIST2 35900000 GOIF (R15),(R10),LOW=LESS NOT DONE YET 36000000 LR R15,R0 RESTORE TO BEGINNING OF RLIST2 36100000 GOIF UNY0,NOTEQ=RELOC,ELSE=STORE ALL DONE IF UNARY 36200000 SPACE 36300000 * CHECK FOR SELF DEFINING VALUES * 36400000 SPACE 36500000 ALPHANUM GOIF STATUS1,HIGH=BLANK1 MAY BE END OF EXPRESSION 36600000 CLI CHAR1,JA SEE IF CHARACTER 'A' 36750000 BL DECIMAL 0-9 - DECIMAL SELF DEFINING VALUE 36760000 LR R14,R5 SAVE COLUMN POINTER 36800000 CLI CHAR2,JQUOTE IS NEXT CHARACTER A ' 36900000 BNE SYM MAYBE WE'VE HIT UPON A SYMBOL 36950000 AIF ('&ID' EQ 'X5V').X5V7 37000000 GOIF LNGQUOTE,ON=SYNTAXER L' FOLLOWED BY ANYTHING IS BAD 37100000 AGO .X4V7 37200000 .X5V7 GOIF LNGQUOTE,ON=SYNERR2 INVALID LENGTH ATTR REFERENCE 37300000 .X4V7 ANOP 37400000 LA R5,CHAR3 ADVANCE COLUMN POINTER 37500000 GOIF BQUOTE,EQUAL=BINARY PROCESS IF BINARY TYPE 37600000 GOIF CQUOTE,EQUAL=CHARACTR PROCESS IF CHARACTER TYPE 37700000 GOIF XQUOTE,EQUAL=HEXADEC PROCESS IF HEXADECIMAL TYPE 37800000 AIF ('&ID' EQ 'X5V').X5V8 37900000 GOIF LQUOTE,NOTEQ=SYNTAXER ILLEGAL CHARACTER IN EXPRESSION 38000000 AGO .X4V8 38100000 .X5V8 GOIF LQUOTE,NOTEQ=SYNERR1 ILLEGAL CHARACTER IN EXPRESSION 38200000 .X4V8 ANOP 38300000 SET LNGQUOTE,ON INDICATE ATTRIBUTE REFERENCE 38400000 B SCAN LOOK FOR SYMBOL 38500000 EJECT 38600000 * DECIMAL SELF-DEFINING VALUE * 38700000 SPACE 38800000 DECOFLO SET SDVSIZE,ON SELF DEFINING VALUE TOO LARGE 38900000 AIF ('&ID' EQ 'X5V').X5V9 39000000 DECIMAL GOIF LNGQUOTE,ON=SYNTAXER DECIMAL AFTER L' ISN'T KOSHER 39100000 AGO .X4V9 39200000 .X5V9 ANOP 39300000 X5ERRL 235,CLMPTR OVERFLOW ERROR 39350000 DECIMAL GOIF LNGQUOTE,ON=SYNERR2 INVALID LENGTH ATTR REFERENCE 39400000 .X4V9 ANOP 39500000 SR R1,R1 SR R1,R1 39600000 LR R0,R1 ZERO DIGIT VALUE 39700000 LR R10,R1 ZERO DIGIT COUNT 39800000 LA R15,MAXDEC GET MAXIMUM DIGIT COUNT 39900000 DECIMAL1 CLI CHAR1,J9 SEE IF CHARACTER '9' 40050000 BH DIGITCHK NOT NUMERIC 40060000 LA R10,D1(,R10) COUNT DIGIT 40100000 LR R14,R1 SAVE CURRENT TOTAL 40200000 SLA R1,3 MULTIPLY BY EIGHT 40300000 BO DECOFLO OVERFLOW ONE FULLWORD 40400000 IC R0,CHAR1 GET DIGIT 40500000 AR R14,R14 DOUBLE 40600000 AR R14,R0 PLUS NEXT DIGIT 40700000 AR R1,R14 GRAND TOTAL 40800000 BO DECOFLO SELF DEFINING VALUE TOO LARGE 40900000 LA R5,CHAR2 POINT TO NEXT DIGIT 41000000 B DECIMAL1 GO SOME MORE 41100000 SPACE 41200000 * BINARY SELF-DEFINING VALUE * 41300000 SPACE 41400000 BINARY LA R14,SHIFTB GET BINARY SHIFT VALUE 41500000 GOTO SDVEVAL GO EVALUATE SELF DEFINING TERM 41600000 LA R15,MAXBIT GET MAXIMUM NUMBER OF BITS 41700000 B DELIMCHK PERFORM VALIDITY TESTS 41800000 SPACE 41900000 * CHARACTER SELF-DEFINING VALUE * 42000000 SPACE 42100000 CHARACTR LA R14,SHIFTC GET CHARACTER SHIFT VALUE 42200000 GOTO SDVEVAL GO EVALUATE SELF DEFINING TERM 42300000 LA R15,MAXCHAR GET MAXIMUM NUMBER OF CHARACTER 42400000 ST R1,JFWORD1 PUT VALUE IN STORAGE 42500000 TR JFWORD1,JTRTABLE TRANSLATE TO EBCDIC 42600000 L R1,JFWORD1 PASS RESULT IN REGISTER 42700000 B DELIMCHK PERFORM VALIDITY TESTS 42800000 SPACE 42900000 * HEXADECIMAL SELF-DEFINING VALUE * 43000000 SPACE 43100000 HEXADEC LA R14,SHIFTH GET HEXADECIMAL SHIFT VALUE 43200000 GOTO SDVEVAL GO EVALUATE SELF DEFINING TERM 43300000 LA R15,MAXHEX GET MAXIMUM NUMBER OF HEX DIGIT 43400000 EJECT 43500000 * VALIDITY TESTS * 43600000 SPACE 43700000 AIF ('&ID' EQ 'X5V').X5V10 43800000 DELIMCHK CLI CHAR1,JQUOTE SEE IF CHARACTER ''' 43950000 BNE SYNTAXER INVALID DELIMITER 43960000 AGO .X4V10 44000000 .X5V10 ANOP 44100000 DELIMCHK CLI CHAR1,JQUOTE SEE IF CHARACTER ''' 44150000 BNE SYNERR8 INVALID DELIMITER 44200000 .X4V10 ANOP 44300000 LA R5,CHAR2 ADVANCE COLUMN POINTER 44400000 GOIF (R10),ZERO=EMPTYSDV NULL BETWEEN QUOTES 44500000 DIGITCHK GOIF (R10),(R15),NOTHIGH=ABSOLUTE CHECK FOR MAXIMUM DIGITS 44600000 EMPTYSDV SET SDVSIZE,ON ERROR 44700000 AIF ('&ID' NE 'X5V').X4V16 44750000 X5ERRL 169,CLMPTR INVALID SELF-DEFINING TERM 44760000 .X4V16 ANOP 44770000 ABSOLUTE SR R0,R0 ESDID 44800000 SET LNGQUOTE,OFF NOT APPLICABLE FROM NOW ON 44900000 SPACE 45000000 * CLEANUP * 45100000 SPACE 45200000 CLEANUP LA R15,D1 LENGTH ATTRIBUTE OF TERM 45300000 CLEANUP1 CL R3,EVALREGS SEE IF MAXIMUM TERMS 45400000 AIF ('&ID' EQ 'X5V').X5V11 45500000 BNL SYNTAXER OF 20 EXCEEDED 45600000 AGO .X4V11 45700000 .X5V11 BNL SYNERR9 TOO MANY TERMS 45800000 .X4V11 ANOP 45900000 STH R0,ESDID SAVE ESDID 46000000 ST R1,TERM1 VALUE TO TERM1 46100000 MVI TERM1CNT+D3,L'RLIST COUNT IS LENGTH OF ONE ENTRY 46200000 LA R2,TERM2CNT ADVANCE POINTER TO NEXT ENTRY 46300000 LA R3,NEXTESD ADVANCE POINTER TO NEXT ENTRY 46400000 SET STATUS2 2 - TERM 46500000 GOIF (R0),ZERO=CLEANUP2 SEE IF ABSOLUTE TERM 46600000 IC R14,RELOCTR GET COUNT OF RELOCATABLE TERMS 46700000 LA R14,1(,R14) BUMP THE COUNT BY 1 46800000 STC R14,RELOCTR SAVE THE COUNT 46900000 CLEANUP2 TS FIRST SEE IF THIS IS THE FIRST TERM 47000000 BNZ SCAN GO ON IF NOT 47100000 STH R15,IMPLNG LENGTH ATTRIBUTE OF EXPRESSION 47200000 TS SELFDEFN SDV EXPECTED 47300000 BNZ SCAN NOT PARTICULAR, GO ON 47400000 B FINIS1 YES, MY JOB IS DONE 47500000 EJECT 47600000 * SELF-DEFINING VALUE EVALUATION * 47700000 SPACE 47800000 SDVEVAL STC R14,SHIFTN SAVE SHIFT VALUE 47900000 IC R11,SDVLIMIT-D1(R14) GET VALID HIGH LIMIT 48000000 SR R15,R15 ZERO REGISTERS 48100000 LR R10,R15 ZERO DIGIT COUNTER 48200000 LR R1,R15 ZERO ACCUMULATOR 48300000 GOIF SHIFTC,NOTEQ=SDVEVAL1 SHIFT 48400000 L R1,BCDZEROS GET EXTERNAL ZEROS 48500000 SDVEVAL1 EX R11,CHAR1CLI CLI CHAR1,0 48600000 BHR R9 EXIT ON HIGH 48700000 IC R15,CHAR1 GET NEXT CHARACTER 48800000 GOIF SHIFTC,NOTEQ=SDVEVAL4 CHARACTER SELF DEFINING TERM 48900000 CLI CHAR1,JQUOTE SEE IF CHARACTER ''' 49050000 BNE SDVEVAL2 NO, SEE IF CHARACTER '&' 49060000 CLI CHAR2,JQUOTE SEE IF CHARACTER '''' 49070000 BE SDVEVAL3 YES, TREAT AS ONE 49080000 BR R9 OR ELSE IT COULD BE END OF TERM 49090000 SDVEVAL2 CLI CHAR1,JAMPER SEE IF CHARACTER '&' 49250000 BNE SDVEVAL4 NO, JUST ANY OTHER CHARACTER 49260000 AIF ('&ID' EQ 'X5V').X5V12 49300000 CLI CHAR2,JAMPER SEE IF CHARACTER '&&' 49450000 BNE SYNTAXER NO, ILLEGAL USE OF AMPERSAND 49460000 AGO .X4V12 49500000 .X5V12 CLI CHAR2,JAMPER SEE IF CHARACTER '&&' 49650000 BNE SYNERR10 NO, ILLEGAL USE OF AMPERSAND 49660000 .X4V12 ANOP 49700000 SDVEVAL3 LA R5,CHAR2 ADVANCE COLUMN POINTER 49800000 SDVEVAL4 SLL R1,D0(R14) SHIFT BY SPECIFIED VALUE 49900000 ALR R1,R15 ADD TO ACCUMULATOR 50000000 LA R10,D1(,R10) KEEP COUNT OF DIGITS 50100000 LA R5,CHAR2 POINT TO NEXT CHARACTER 50200000 B SDVEVAL1 LOOP 50300000 SPACE 50400000 * SYNTAX ERROR IN EXPRESSION * 50500000 SPACE 50600000 SYNTAXER SET FATALER,ON SYNTAX ERRORS ARE FATAL 50700000 EJECT 50800000 * SET RETURN CONDITION CODE * 50900000 SPACE 51000000 FINIS LA R5,CHAR2 POINT PAST CHARACTER 51100000 FINIS1 L R11,TERMS+TERM1-TERM1CNT PASS RESULT IN PARAMETER REG 51200000 SET (SUBLIST,DCOP),OFF RESET 51300000 TS SELFDEFN RESET 51400000 SR R10,R10 ABSOLUTE TERM IF EVALUATION ERR 51500000 GOIF FATALER,ON=FINIS3 3 - SYNTAX ERROR 51600000 TM EVALSW1,BITFF ANY ERROR IN EXPRESSION 51700000 BM FINIS3 1 - ERROR IN EXPRESSION 51800000 GOIF NORELOC,EQUAL=FINIS3 0 - ABSOLUTE EXPRESSION 51900000 TM RELOCTR,BITFF-1 MORE THAN ONE RELOCATABLE TERM 52000000 BM FINIS3 NO, COMPLEXLY RELOCATABLE 52100000 LA R3,RLIST-L'RLIST START AT HEAD OF LIST 52200000 FINIS2 LA R3,NEXTESD POINT TO NEXT ITEM 52300000 LH R10,ESDID PICK IT UP 52400000 GOIF (R10),ZERO=FINIS2 0 - NOT RELOCATABLE TERM 52500000 SPACE 52600000 *NOTES- WHEN THE ONE AND ONLY RELOCATABLE TERM IS FOUND, WHETHER IT * 52700000 * IS SIMPLY OR COMPLEXLY RELOCATABLE, IT WILL FALL THROUGH THIS * 52800000 * POINT AND RETURN TO THE CALLER WITH THE PROPER CONDITION CODE * 52900000 * SETTING. * 53000000 SPACE 53100000 FINIS3 LR R14,R5 RETURN COLUMN POINTER 53200000 B EXIT EXIT 53300000 EJECT 53400000 * SPECIAL CHARACTER GO TO TABLE * 53500000 SPACE 53600000 GOTOTBL EQU * ORIGIN OF GO-TO TABLE 53700000 DC YL1(LFPAREN-GOTO) ( - LEFT PARENTHESIS 53800000 DC YL1(PLUS-GOTO) + - PLUS SIGN 53900000 DC YL1(MINUS-GOTO) - - MINUS SIGN 54000000 DC YL1(ASTERISK-GOTO) * - ASTERISK 54100000 DC YL1(SLASH-GOTO) / - SLASH 54200000 DC YL1(RTPAREN-GOTO) ) - RIGHT PARENTHESIS 54300000 DC YL1(COMMA-GOTO) , - COMMA 54400000 DC YL1(BLANK-GOTO) - BLANK 54500000 SPACE 54600000 PLUS EQU GOTO X 54700000 MINUS EQU GOTO X 54800000 COMMA EQU BLANK X 54900000 SPACE 55000000 * CONSTANTS * 55100000 SPACE 55200000 LTORG 55300000 BCDZEROS DC C'0000' PAD 55400000 ABSCHECK NC ESDID(0),ESDID EXECUTED INSTRUCTION 55500000 CHAR1CLI CLI CHAR1,D0 EXECUTED INSTRUCTION 55600000 SDVLIMIT DC X'0100000F000000FF' LIMITS OF VALID CHARACTERS FOR- 55700000 * / / /............ CHARACTER 55800000 * / /..................... HEXADECIMAL 55900000 * /............................ BINARY 56000000 EJECT 56100000 * LOOKUP SYMBOL * 56200000 SPACE 56300000 DEFNERR SET NOTDEFN,ON UNDEFINED SYMBOL 56400000 SR R1,R1 DEFAULT VALUE TO ZERO 56500000 B ABSOLUTE GO ON 56600000 SYM LA R5,CHAR2 POINT TO NEXT CHARACTER 56700000 CLI CHAR1,JEQUAL SEE IF ALPHAMERIC 56850000 BL SYM LOOK FOR DELIMITER 56860000 LR R15,R5 GET ADDRESS OF DELIMITER 56900000 SR R15,R14 MINUS FIRST CHARACTER ADDRESS 57000000 BCTR R15,D0 YIELD LENGTH OF SYMBOL 57100000 CH R15,=H'7' SYMBOL TOO LONG 57200000 AIF ('&ID' NE 'X4V').NOTX4V1 57300000 BH SYNTAXER SYMBOL LENGTH GREATER THAN 8 57400000 MVC XNAME,=8AL1(JBLANK) PAD 57500000 EX R15,NAMEMOVE PASS SYMBOL 57700000 GOIF DCOP,OFF=SYM0 SKIP IF NOT DC 57800000 LH R14,SYMCOUNT GET SYMBOL COUNT 57900000 LA R14,D1(,R14) INCREMENT IT BY 1 58000000 STH R14,SYMCOUNT SAVE 58100000 GOIF LTORGSCN,OFF=SYM0 SKIP IF NOT PROCESSING LTORG 58200000 GOTO REFER GO GENERATE A REFERENCE RECORD 58300000 SYM0 LA R10,XWORK ADDRESS OF SYMBOL 58360000 GOTO FIND LOOKUP IN SYMBOL TABLE 58420000 BNZ SYM2 NOT FOUND 58500000 GOIF ESW,OFF=SYM05 CHECK EXTRN/EQU FLAG OX00106 58550002 LA R10,XWORK MAKE SURE R10 POINTS OK OX00106 58570002 OI XESDI-XWORK(R10),ESW TRANSFER EXTRN/EQU FLAG OX00106 58580002 SYM05 EQU * OX00106 58590002 GOIF ENTRYSW,ON=DEFNERR NOT DEFINED 58600002 LA R1,D1 LENGTH ATTRIBUTE 58700000 GOIF ESDNRSW,ON=SYM1 FOR EXTERNAL SYMBOLS 58800000 LH R1,SLNGQ LENGTH ATTRIBUTE FOR OTHERS 58900000 SLL R1,16 MAY BE A 16 BIT @VM05316 58930000 SRL R1,16 POSITIVE NUMBER @VM05316 58950000 SYM1 GOIF LNGQUOTE,ON=SYM4 LENGTH ATTRIBUTE REFERENCE 59000000 LR R15,R1 PASS LENGTH ATTRIBUTE 59100000 LH R0,SESDI ESDID 59200000 L R1,SLCTR VALUE 59300000 B CLEANUP1 CLEANUP 59400000 SYM4 GOIF LNGDEF,OFF=ABSOLUTE ILLEGAL LENGTH ATTRIBUTE 59450000 SYM2 GOIF LTORGSCN,ON=DEFNERR UNDEFINED 59500000 GOIF IOFLO,OFF=DEFNERR UNDEFINED 59600000 GOIF INOTE,OFF=SYM5 SEE IF REWIND NECESSARY 59660000 LH R10,JINFILE INPUT FILE ADDRESS 59720000 JPOINT FILE=(R10),ADDR=INOTEVAL,NEXT=GET REPOSITION FILE 59780000 SYM5 LH R10,JINFILE GET INPUT FILE ADDRESS 59840000 JGETL FILE=(R10) READ NEXT RECORD 59900000 GOIF INOTE,ON=SYM6 SEE IF ALREADY NOTED 59960000 SET INOTE,ON INDICATE FILE NOTED 60020000 ST R11,INOTEVAL SAVE RECORD POINTER 60080000 LH R10,JINFILE GET INPUT FILE ADDRESS 60140000 JNOTE FILE=(R10) NOTE FILE POSITION 60200000 L R11,INOTEVAL GET RECORD POINTER 60260000 MVC INOTEVAL,JNOTEVAL SAVE NOTED ADDRESS 60320000 SYM6 CLC XNAME,XNAME-XWORK(R11) SEE IF CORRESPONDING RECORD 60380000 BNE SYM5 IF NOT, TRY AGAIN 60440000 SYM3 TM XFLDI-XWORK(R11),DEFINED 60490000 DEFINED EQU BIT1 60540000 BZ DEFNERR UNDEFINED 60600000 GOIF LTCALL,OFF=SYM7 SEE IF PROCESSING LITERAL 60620000 LR R10,R11 PASS TO ENTER 60640000 ST R10,JFWORD1 SAVE 60660000 GOTO ENTER ENTER IN SYMBOL TABLE 60680000 L R11,JFWORD1 RESTORE POINTER 60700000 SYM7 LH R1,XLNGQ-XWORK(,R11) LENGTH 60720000 GOIF LNGQUOTE,ON=ABSOLUTE THAT'S ALL WE'RE INTERESTED IN 60800000 LR R15,R1 LENGTH ATTRIBUTE 60900000 LH R0,XESDI-XWORK(,R11) ESDID 61000000 L R1,XLCTR-XWORK(,R11) VALUE 61100000 B CLEANUP1 FINIS 61200000 NAMEMOVE MVC XNAME(0),CHAR1-CHAR1(R14) EXECUTED INSTRUCTION 61300000 MEXIT 61400000 .NOTX4V1 BH SYNERR1 SYMBOL LENGTH > 8 61500000 GOIF (JXREF,JLIST),NOTALL=SYM01 CHECK IF CROSS-REFERENCE 61600000 GOIF XRFNO,OFF=SYM01 IS XREF TO BE MADE 61700000 LH R10,JOUTFILE GET OUTPUT FILE NUMBER 61800000 JPUTL FILE=(R10),BUFREQ=XRFND GET BUFFER 61900000 LR R6,R11 SAVE BUFFER POINTER 62000000 SYM01 EQU * BRANCH LABEL 62100000 LH R10,JINFILE GET FILE NUMBER 62200000 JGETL FILE=(R10) GET FROM FILE 62300000 GOIF NOTEWL,OFF=SYM02 SHOULD WE NOTE SYMBOL LOCATION 62400000 ST R11,JFWORD1 SAVE SYMBOL FILE PTR OX02953 62500003 SET NOTEHS,ON YES, FIRST SET POINT INDICATOR 62600000 SET NOTEWL,OFF SET NOTE SWITCH OFF 62700000 LH R10,JINFILE POINT INPUT FILE 62800000 JNOTE FILE=(R10) NOTE SYMBOL LOCATION FOR RESCAN 62900000 MVC NOTEVAL,JNOTEVAL SAVE NOTE VALUE 63000000 L R11,JFWORD1 RESTORE SYMBOL FILE PTR OX02953 63100003 SYM02 EQU * BRANCH LABEL 63200000 USING XRFIN,R6 CREATE 63300000 GOIF XRFNO,OFF=SYM03 XREF NECESSARY 63500000 GOIF (JXREF,JLIST),NOTALL=SYM03 !OTH OPTIONS MUST BE ON 63600000 SET JXREFCHK,ON THEY ARE SET XREF SWITCH ON 63700000 MVC XRECLN(D6),=AL2(XRFND,0,XRFTYPE*256) CROSS REFERENCE 63800000 MVC XRFSYM,RNAME RECORD 63900000 MVI XRFFLG,REF NAME, TYPE 64000000 MVC XRFSTM,STMTN+D2 AND STATEMENT NUMBER 64100000 SYM03 EQU * BRANCH LABEL 64200000 L R6,SYMXRF GET NUMBER THUS FAR OX02675 64300003 LA R6,D1(,R6) ADD 1 64400000 ST R6,SYMXRF SAVE NEW CNT THIS CARD OX02675 64500003 GOIF (PRIORDEF,DEFINED),ALL=SYM1,NONE=SYMR1 IS IT DEFINED 64600000 GOIF PRDEFREQ,ON=SYMR2 PRIOR DEFINITION REQUIRED 64700000 SYM1 EQU * @OY08064 64800005 GOIF EQUF1,ON=SYNERR2 LENGTH ATTR ERROR @OY08064 64810005 XC JFWORD1,JFWORD1 ALIGN LENGTH ATTR @OY08064 64820005 MVC JFWORD1+D2(D2),RLNGQ A FULLWORD AREA 64830000 L R1,JFWORD1 GET LENGTH ATTRIBUTE 64860000 GOIF LNGQUOTE,ON=ABSOLUTE LENGTH ATTRIBUTE REFERENCE 64900000 LR R15,R1 LENGTH ATTRIBUTE OF SYMBOL 65000000 LH R0,RESDI ESDID OF SYMBOL 65100000 L R1,RLCTR VALUE OF SYMBOL 65200000 B CLEANUP1 GO BACK 65300000 SYNERR1 X5ERRL 236,CLMPTR,SYNTAXER ILLEGAL CHARACTER 65400000 SYNERR2 X5ERRL 120,CLMPTR,SYNTAXER INVALID LENGTH ATTR REFERENCE 65500000 SYNERR3 X5ERRL 170,CLMPTR,SYNTAXER CONSECUTIVE OPERATOR 65600000 SYNERR4 X5ERRL 233,CLMPTR,SYNTAXER TOO MANY LEVELS OF PARENS 65700000 SYNERR6 X5ERRL 234,CLMPTR,SYNTAXER PREMATURE END OF EXPRESSION 65800000 SYNERR8 X5ERRL 240,0,SYNTAXER MISSING QUOTE 65900000 SYNERR9 X5ERRL 168,0,SYNTAXER TOO MANY TERMS 66000000 SYNERR10 X5ERRL 238,CLMPTR,SYNTAXER ILLEGAL USE OF & 66100000 SYNERR11 X5ERRL 187,CLMPTR,SYNTAXER SYMBOL LENGTH > 8 66200000 SYMR1 ST R11,ERRPTR 66300000 X5ERRL 188,DTAPTR,DEFNERR UNDEFINED SYMBOL 66400000 JEXTRN (X5L01=LOGERR) DEFINE EXTERNAL SYMBOL 66500000 SYMR2 ST R11,ERRPTR 66600000 X5ERRL 231,DTAPTR,DEFNERR SYMBOL NOT PREVIOUSLY DEFINED 66700000 EXIT JRETURN 66900000 MEND 67100000