TITLE '*** EQU''S FOR MACRO ROUTINES ' 40000000 AIF (NOT &$MACROS).MAXXXX SKIP MACROS J 40000001 * FOLLOWING EQU'S HANDLE ERROR MESSAGES IN MEXPND NOT TAKEN CAREOF 40005000 * BY ERRTAG 40010000 $ER#ACTR EQU 2 ACTR EXCEEDED S 40015000 $ER#DMER EQU 4 SET SYMBOL SUBSCRIPT S 40020000 $ER#SBST EQU 6 SUBSTRING EXPRESSION S 40025000 $ER#CVCA EQU 8 CHAR TO ARITH CONV ERR S 40030000 $ER#CVAB EQU 10 ARITH TO BOOL CONV ERR S 40035000 $ER#CVCB EQU 12 CHAR TO BOOL CONV ERR S 40040000 $ER#ATER EQU 14 ATTRIBUTE USE ERR S 40045000 $ER#SYSL EQU 16 &SYSLIST ERR S 40050000 $ER#SYER EQU 18 SYSTEM ERR S 40055000 $ER#EXBF EQU 20 CHAR BUFFER EXCEEDED S 40060000 $ER#MXST EQU 22 MAX # OF STMTS EXCEEDED S 40065000 $ER#ZDIV EQU 24 FIXED PT OVERFLOW OR ZERO DIVIDE S 40070000 $ER#PRVR EQU 26 A 40070100 SPACE 2 40075000 * FOLLOWING FLAGS SET IN AVMSNBY1 WILL TURN ON RESPECTIVE SNAPS 40080000 $MSNP01 EQU X'80' MACINT SNAP FLAG 40085000 $MSNP02 EQU X'40' MACRO1 SNAP FLAG 40090000 $MSNP03 EQU X'20' MACSCN SNAP FLAG 40095000 $MSNP04 EQU X'10' MCSCOP SNAP FLAG 40100000 $MSNP05 EQU X'08' MACFND,MCVSCN SNAP FLAG 40105000 $MSNP06 EQU X'04' MCSYSR, DECTRM, MCGTST, ATTERM SNAP FLAG 40110000 $MSNP07 EQU X'02' MCBODY SNAP FLAG 40115000 $MSNP08 EQU X'01' BSU'S SNAP FLAG 40120000 SPACE 40125000 * FOLLOWING FLAGS SET IN AVMSNBY2 WILL TURN ON RESPECTIVE SNAPS 40130000 $MSNP09 EQU X'80' MACLEX SNAP FLAG 40135000 $MSNP10 EQU X'40' MCGNCD SNAP FLAG - ONE OPS 40140000 $MSNP11 EQU X'20' MEXPND SNAP - INIT AND INTERPRET 40145000 $MSNP12 EQU X'10' MEXPND SNAP - INTERNAL ROUTINES 40150000 $MSNP13 EQU X'08' MXERRM, MXMVSR SNAP CONTROL 40155000 $MSNP14 EQU X'04' SET MEXPND ENTER EXIT SNAPS 40160000 SPACE 40165000 $MINDEF EQU X'80' AVMBYTE1 - IN MACRO DEFINITION 40170000 $MINEXP EQU X'40' AVMBYTE1 - IN MACRO EXPANSION 40175000 $MGBLFLG EQU X'80' MCLBFLG2 - GLOBALS NO LONGER OK S 40180000 $MLCLFLG EQU X'40'+$MGBLFLG MCLBFLG2 - LOCALS NO LONGER OK S 40185000 $MACTFLG EQU X'20'+$MLCLFLG MCLBFLG2 - ACTR NO LONGER OK S 40190000 $MCOCFL1 EQU B'00000001' (MCLBFLG2) - OPEN CODE - DECLARE S#40190100 TYPES ALLOWED S 40190150 $MCOCFL2 EQU B'00000011' (MCLBFLG2) - OPEN CODE - DECLARE S#40190200 TYPES NOT ALLOWED S 40190201 $MC1DCL EQU B'10000000' DECLARE TYPE S 40190500 $MC1ERR EQU B'01000000' ORDER ERROR S 40190600 $MC1SKIP EQU B'00100000' DON'T CALL MXINST S 40190700 $MC1RET EQU B'00010000' RETURN AFTER MXINST S 40190800 $MSBLIST EQU X'04' AVMBYTE1 - PROCESSING OPERAND SUBLST 40195000 $MINQUOT EQU X'02' AVMBYTE1 - INSIDE QUOTED STRING 40200000 $MKEYOPR EQU X'01' KEYWORD OPRND PROCESSSED, POSIT NOGO 40205000 SPACE 1 40210000 $MOPRTR EQU X'80' AVMBYTE2 - PREV SYMBOL = OPRTR 40215000 $MTERM EQU X'40' AVMBYTE2 - PREV SYMBOL = TERM 40220000 $MINARIT EQU X'20' AVMBYTE2 - IN ARITHMETIC EXPRESSION 40225000 $MINBOOL EQU X'10' AVMBYTE2 - IN BOOLEAN EXPRESSION 40230000 $MINCHAR EQU X'08' AVMBYTE2 - IN CHARACTER EXPRESSION 40235000 $MDIMVAR EQU X'04' AVMBYTE2 - PREV SYMBOL = DIMEN SYMB 40240000 $MINAPAR EQU X'02' AVMBYTE2 - IN ARITH SUBSCR EXPRESS 40245000 $MINPEXP EQU X'01' AVMBYTE2 - DO EXPRES IN PARENS ONLY 40250000 SPACE 1 40255000 $MRPARST EQU X'80' AVMBYTE4 - RIGHT PAREN IN INPUT 40260000 $MINSTRN EQU X'40' AVMBYTE4 - PROC VAR SYMB IN STRING 40265000 $MCOMST EQU X'20' AVMBYTE4 - COMMA IN BSU INPUT STRM 40270000 $MGENSTP EQU X'10' AVMBYTE4 - STOP MACRO GENERATION 40275000 $MXJMPFL EQU X'08' AVMBYTE4 - AGO OR SUCCESSFUL AIF SWT 40280000 $MSTOPEX EQU X'04' AVMBYTE4 - DON'T EXPAND CRRNT MACRO 40285000 SPACE 2 40290000 $GLOBAL EQU 4 40295000 $LOCAL EQU 8 40300000 $SYMPAR EQU 12 40305000 $SYSVAR EQU 16 SYSTEM VARIABLE INDEX 40310000 SPACE 2 40315000 $LCHWRK EQU 1024 40320000 $LSUBENT EQU 12 LENGTH OF SUB-OPERAND ENTRY 40325000 $LMSRCMX EQU (RSOL1+2*RSOLC)-1 MAXIMUM LENGTH-1 OF GEN'D STMT 40330000 SPACE 2 40345000 $BSAR EQU X'20' MCBSFLGS, ARITHMETIC TYPE 40350000 $BSBOOL EQU X'10' MCBSFLGS, BOOLEAN TYPE 40355000 $BSCHAR EQU X'08' MCBSFLGS, CHARACTER TYPE 40360000 SPACE 2 40365000 * EQUATES FOR INDEX VALUES FOR OPERATOR BSU'S 40370000 $BSPLUS EQU 2 40375000 $BSMIN EQU 4 40380000 $BSMULT EQU 6 40385000 $BSDIV EQU 8 40390000 $BSOR EQU 10 40395000 $BSAND EQU 12 40400000 $BSNOT EQU 14 40405000 $BSNE EQU 16 40410000 $BSGE EQU 18 40415000 $BSLE EQU 20 40420000 $BSLT EQU 22 40425000 $BSEQ EQU 24 40430000 $BSGT EQU 26 40435000 $BSCAT EQU 28 40440000 $BSAGO EQU 30 40445000 $BSAIF EQU 32 40450000 $BSETA EQU 34 40455000 $BSETB EQU 36 40460000 $BSETC EQU 38 40465000 $BSRPAR EQU 40 40470000 $BSLPAR EQU 42 40475000 $BSBSCRP EQU 44 40480000 $BSBSTR EQU 46 40485000 $BSBSYL EQU 48 40490000 $BSCOMMA EQU 50 HIERARCHY = ZERO 40495000 $BSPRINT EQU 52 HIERARCHY = 2 40500000 $BSMEXIT EQU 54 HIERARCHY = 2 40505000 $BSMEND EQU 56 HIERARCHY = 2 40510000 $BSANOP EQU 58 HIERARCHY = 2 40515000 $BSERR01 EQU 60 HIERARCHY = 2 40520000 $BSINMAC EQU 62 SET INNER MACRO CALL CODE HIER = 2 40525000 $BSMVSTM EQU 64 BSU INDEX FOR MOVE STMT 40530000 $BSMNTER EQU X'80' FLAG TO FORCE ERR MSSGE ON MNOTE 40535000 $BSRLCHR EQU X'80' FLAG FOR CHAR TYPE RELATIONAL OPRTR 40540000 $MPRCOM EQU 1 (MCBSFLGS)=> SPECIAL PRINT A 40542000 SPACE 2 40545000 * EQUATES FOR OPERATOR HIERARCHIES 40550000 $MCOMMHR EQU 0 40555000 $MPARHR EQU 0 40560000 $MPRNTHR EQU 2 40565000 $MSETHR EQU 2 40570000 $MORHR EQU 4 40575000 $MANDHR EQU 6 40580000 $MRELHR EQU 8 40585000 $MCATHR EQU 10 40590000 $MPLUSHR EQU 12 40595000 $MMULTHR EQU 14 40600000 $MNOTHR EQU 16 40605000 $MAGOHR EQU 16 40610000 $MAIFHR EQU 16 40615000 SPACE 2 40620000 * EQUATES FOR TERM BSU INDEXES 40625000 $BSTSYAG EQU 2 GLOBAL ARITH SET SYMBOL 40630000 $BSTSYBG EQU 4 GLOBAL BOOLEAN SET SYMBOL 40635000 $BSTSYCG EQU 6 GLOBAL CHAR SET SYMBOL 40640000 $BSTSYAL EQU 8 LOCAL ARITH SET SYMBOL 40645000 $BSTSYBL EQU 10 LOCAL BOOL SET SYMBOL 40650000 $BSTSYCL EQU 12 LOCAL CHAR SET SYMBOL 40655000 $BSYMPAR EQU 14 SYMBOLIC PARAMETER 40660000 $BSIMMA EQU 16 ARITH IMMEDIATE BALUE 40665000 $BSIMMB EQU 18 BOOLEAN IMMEDIATE VALUE 40670000 $BSTRING EQU 20 STRING VALUE 40675000 $BSYSNDX EQU 22 &SYSNDX SYSTEM VARIABLE 40680000 $BSYSLST EQU 24 &SYSLIST SYSTEM VARIABLE 40685000 $BSYSECT EQU 26 &SYSECT SYSTEM VARIABLE 40690000 $BSLABEL EQU 28 40695000 $BSTEMP EQU 30 40700000 $BSATI EQU 34 BSU NBR FOR I' ATTRIBUTE 40705000 $BSATK EQU 36 BSU NBR FOR K' ATTRIBUTE 40710000 $BSATL EQU 38 BSU NBR FRR L' ATTRIBUTE 40715000 $BSATN EQU 40 BSU NBR FOR N' ATTRIBUTE 40720000 $BSATS EQU 42 BSU NBR FOR S' ATTRIBUTE 40725000 $BSATT EQU 44 BSU NBR FOR T' ATTRIBUTE 40730000 $BSADDRA EQU 46 BSU NBR FOR ARITH TYPE @ 40735000 $BSADDRB EQU 48 BSU NBR FOR BOOL @ 40740000 $BSADDRC EQU 50 BSU NBR FOR CHAR TYPE @ 40745000 SPACE 2 40750000 * EQUATES FOR VARIOUS LEFT PAREN TYPES 40755000 $MINLPAR EQU X'80' ARITH LEFT PAREN 40760000 $MINSBST EQU X'40' SUBSTRING LEFT PAREN 40765000 $MINSBSC EQU X'20' SUBSCRIPT LEFT PAREN 40770000 $MINSYSL EQU X'10' &SYSLIST LEFT PAREN 40775000 TITLE '*** DSECTS FOR MACRO CAPABILITY IN ASSIST***' 40780000 **--> DSECT: MCGLBDCT FORMAT FOR GLOBAL DICTIONARY ENTRY * 40785000 *. * 40790000 *.********************************************************************* 40795000 SPACE 40800000 MCGLBDCT DSECT 40805000 MCGLBNXT DS F LINK TO NEXT GLOBAL ENTRY 40810000 MCGLBLEN DS C LENGTH OF GLOBAL NAME 40815000 MCGLBNAM DS CL8 GLOBAL DICT ENTRY NAME 40820000 MCGLBTYP DS C ENTRY TYPE, ARITH, BOOL OR CHAR 40825000 MCGLBDIM DS H DIMENSION OF SET VARIABLE 40830000 MGLCLPNT DS 0F POINTER OFFSET FOR LOCAL VALUE 40835000 MCGLBDEF DS F COUNT # OF MACRO DEFINITION 40840000 $LGLBENT EQU *-MCGLBDCT LEN OF GLOBAL DICT ENTRY STND PART 40845000 MCGBAVAL DS 0F GLOBAL ARITH VALUE 40850000 MCGBBVAL DS 0F GLOBAL BOOL VALUE 40855000 MCGBCLEN DS F GOBAL CHAR VALUE LENGTH 40860000 MCGBCVAL DS CL8 GLOBAL CHAR VALUE 40865000 EJECT 40870000 **--> DSECT: MCLCLDPV FORMAT FOR LOCAL DICTIONARY DOPE VECTOR * 40875000 *. * 40880000 *.********************************************************************* 40885000 SPACE 40890000 MCLCLDPV DSECT 40895000 MCLOCNXT DS F POINTER TO NEXT ENTRY 40900000 MCLCLLEN DS C LOCAL ENTRY NAME LENGTH 40905000 MCLCLNAM DS CL8 LOCAL ENTRY NAME 40910000 MCLCLTYP DS C TYPE, IE ARITH, BOOL OR CHAR 40915000 MCLCLDIM DS H DIMENSION OF LOCAL ENTRY 40920000 MCLCLPNT DS F OFFSET POINTER FOR VALUE 40925000 $LLCLDV EQU *-MCLCLDPV LEN OF LOCAL DICT D.V. 40930000 SPACE 2 40935000 **--> DSECT: MCPARENT FORMAT FOR SYMBOLIC PARAMETER ENTRY * 40940000 *. * 40945000 *.********************************************************************* 40950000 SPACE 40955000 MCPARENT DSECT 40960000 MCPARNXT DS F POINTER TO NEXT ENTRY 40965000 * NOTE: NEXT 3 ENTRIES MUST BE IN ORDER GIVEN. JRM. J 40969900 MCPARNLN DS C PARAM ENTRY NAME LENGTH 40970000 MCPARNAM DS CL8 SYMBOLIC PARAM NAME 40975000 MCPARTYP DS C PARAMETER TYPE, POSIT OR KEYWORD 40980000 MCPARNTL EQU *-MCPARNLN LENGTH MOVED TOGETHER J 40981000 MCPARNDX DS H PARAMETER POSITION IN LIST 40985000 MCPROPLN DS C LENGTH OF OPERAND 40990000 MCPRATYP DS C ATTRIBUTE TYPE, IE 'N', 'O' 40995000 MCPARNB DS C UNUSED AT PRESENT J 41000000 MCPARFIL DS C UNUSED AT MOMENT JRM 41005000 MCPROPRN DS F OPERAND STANDARD VALUE POINTER 41010000 $LPARENT EQU *-MCPARENT LEN OF SYM PARAM ENTRY 41015000 SPACE 2 41020000 **--> DSECT: MCBSU FORMAT OF BASIC SYNTACTIC UNIT * 41025000 *. * 41030000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41035000 SPACE 41040000 MCBSU DSECT 41045000 MCBSFLGS DS C INDICATES OPRTR, TERM ETC 41050000 MCBSINDX DS C BSU INDEX OF SYMBOL 41055000 MCBSOFST DS C SYMBOL OFFSET RELATIVE TO SOURCE 41060000 MCBSTRLN DS 0C STRING LENGTH 41065000 MCBSHIER DS C HIERARCHY OF OPERATOR, IF OPRTR 41070000 MCBSVALU DS 0F ARITH OR BOOL IMMEDIATE VALUE 41075000 MCBSLOC DS F LOCATION OF TERM VALUE 41080000 $LMCBSU EQU *-MCBSU LENGTH OF BSU ENTRY 41085000 SPACE 2 41090000 **--> DSECT: MCSEQ FORMAT OF SEQUENCE SYMBOL ENTRY * 41095000 *. * 41100000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41105000 SPACE 41110000 MCSEQ DSECT 41115000 MCSEQNXT DS F POINTER TO NEXT ENTRY 41120000 MCSEQNLN DS C LENGTH OF NAME 41125000 MCSEQNAM DS CL8 NAME OF SEQ SYMBOL 41130000 MCSEQFLG DS C ENTRY FLAG BYTE 41135000 MCSEQDUM DS H UNUSED 41140000 MCSEQVAL DS F POINTER TO SEQ SYMBOL LOCATION * 41145000 $LMCSEQ EQU *-MCSEQ LENGTH OF SEQ SYMBOL ENTRY 41150000 SPACE 2 41155000 **--> DSECT: MCOPQUAD FORMAT OF ONE OP ENTRY. MACRO DEFINITIONS * 41160000 *. ARE TRANSLATED INTO ONE OPS FOR SUBSEQUENT INTERPRETATION * 41165000 *. * 41170000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41175000 SPACE 41180000 MCOPQUAD DSECT 41185000 * EACH STATEMENT BEGINS WITH A PARTIAL ONE OP GIVEN FIRST, A 41186000 * FOLLOWED BY 0 OR MORE NORMAL-SIZE ONE-OPS A 41186100 MCQUDNXT DS A ADDRESS OF NEXT STMT'S CODE A 41186200 MCQSTMNO DS PL3 STATEMENT NUMBER A 41186300 MCQS1FLG DS C FLAGE BYTE OR UNUSED A 41186400 $LMCOPL1 EQU *-MCOPQUAD LENGTH OF 1ST ONE-OP IN STMY A 41186500 SPACE 1 A 41186600 * FORMAT OF NORMAL ONE-OPS IN STATEMENT FOLLOWS A 41186700 ORG MCOPQUAD BACK TO BEGINNING A 41186800 MCBOPRTR DS C OP CODE 41190000 MCARG1DX DS C ARG #1 BSU INDEX 41195000 MCARG2DX DS C ARG #2 BSU INDEX 41200000 MCRSLTYP DS C RESULT TYPE 41205000 MCARG1LC DS F ARG #1 LOCATION 41215000 MCARG2LC DS A ADDRESS OF ARGUMENT #1 A 41220000 MCRESULT DS F RESULT 41235000 $LMCQUAD EQU *-MCOPQUAD LENGHT OF ONE-OP 41240000 SPACE 2 41245000 **--> DSECT: MCBSTRMS FORMAT OF TWO BSU'S FOR EASE * 41250000 *. OF MANIPULATION IN TERM STACK * 41255000 *. * 41260000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41265000 SPACE 41270000 MCBSTRMS DSECT 41275000 MCBSFLG1 DS C TERM #1 FLAG BYTE 41280000 MCBSNDX1 DS C TERM #1 BSU INDEX 41285000 MCBOFST1 DS C TERM #1 OFFSET 41290000 MCBLN1 DS C TERM #1 LENGTH 41295000 MCBSLOC1 DS F TERM #1 LOCATION OR VALUE 41300000 MCBSFLG2 DS C TERM#2 FLAG BYTE 41305000 MCBSNDX2 DS C TERM #2 BSU INDEX 41310000 MCBOFST2 DS C TERM #2 OFFSET 41315000 MCBLN2 DS C TERM #2 LENGTH 41320000 MCBSLOC2 DS F TERM #2 LOCATION OR VALUE 41325000 SPACE 2 41330000 *.--> DSECT: MCBOPRST FORMAT OF OPERATOR STACK ENTRY * 41335000 *. * 41340000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41345000 MCBOPRST DSECT 41350000 MCBOPFL DS C OPERATOR FLAGS 41355000 MCBSOPST DS C OPERATOR BSU INDEX 41360000 MCBOPOF DS C OFFSET 41365000 MCBOPHR DS C OPRTR HIERARCHY 41370000 MCBOPVAL DS F NOT USED 41375000 SPACE 2 41380000 **--> DSECT: MXPNTSAV CONTROL FOR LEVEL OF MACRO EXPANSION * * S 41385000 *. ONE IS ALLOCATED FOR EACH LEVEL OF MACRO CALL A 41390000 *. NAMES:MXP_____ A 41395000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41400000 SPACE 41405000 MXPNTSAV DSECT 41410000 MXPNLINK DS A @ LAST PREVIOUS MXPNTSAV A 41415000 MXPLSYPT DS F PNTR TO SYM PARAM D.V.'S 41420000 MXPSYSDX DS PL3 CURRENT SYSNDX VALUE 41430000 MXPNFLG1 DS C FLAG BYTE 41435000 MXPCHRBF DS F PNTR TO CHAR BUFFER FOR CATEN OPRTNS 41440000 MXPNMCLB DS F PNTR TO MAC LIB ENTRY 41445000 MXPNKYPT DS F PNTR TO 1ST KEYWORD SYM PAR DV 41450000 MXPNKLPT DS F PNTR TO 1ST KEYWORD DICT ENTRY 41455000 MXPNLDBS DS F PNTR TO SET SYMB LOCAL DICT 41460000 MXPNCDPT DS F PNTR TO 1ST INSTRUCTION 41465000 MXPNCRCD DS F PNTR TO CURRENT INST 41470000 MXPNBOPS DS F NBR OF POSITIONAL OPRNDS 41480000 MXPNLSPT DS F PNTR TO SYM PAR DICT ENTRIES 41485000 $LMXPTSV EQU *-MXPNTSAV LEN OF DYNAMIC WORK AREA IN MEXPND 41490000 SPACE 2 41495000 **--> DSECT: MCPAROPR FORMAT FOR SYMBOLIC PARAMETER DICTIONARY * 41500000 *. ENTRY. ONE ENTRY FOR EACH SYM PARAM ON ENTRY TO MEXPND * 41505000 *. * 41510000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41515000 SPACE 41520000 MCPAROPR DSECT 41525000 MCPAROFL DS C OPRNDS FLAGS 41530000 MCPAROLN DS C OPRND LENGTH, IE K' 41535000 MCPARONB DS C # OF SUBOPRNDS IE N' 41540000 MCPAROTP DS C OPRND TYPE, IE N, O OR U 41545000 MCPAROPT DS F POINTER TO OPRND 41550000 MCPRSBPT DS F POINTER TO LSUB OPRND LIST 41555000 $LMPAROP EQU *-MCPAROPR LEN OF SYM PAR DICT ENTRY 41560000 SPACE 2 41565000 **--> DSECT: MCPARSUB FORMAT FOR DICT ENTRY FOR SUBLIST OPRNDS * 41570000 *. ONE ENTRY FOR EACH ELEMENT OF SUBLIST OF SYM PARAM ENTRY * 41575000 *. * 41580000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41585000 SPACE 41590000 MCPARSUB DSECT 41595000 MCPARSFL DS C SUBOPRND FLAGS 41600000 MCPARSNU DS C NOT USED 41605000 MCPARSTP DS C SUB OPRND TYPE 41610000 MCPARSLN DS C SUB OPRND LENGTH 41615000 MCPARSPT DS F PNTR TO SUB OPRND 41620000 $LMPARSB EQU *-MCPARSUB LEN OF SUBLIST OPRND ENTRY 41625000 AIF (NOT &$DEBUG).MACDBG SKIP IF DEBUG 41635000 XSET XSNAP=OFF KILL REMAINING XSANPS 41640000 .MACDBG ANOP 41645000 TITLE '*** MACINT - MACRO INITIALIZATION ROUTINE' S 41651000 **--> CSECT: MACINT THIS ROUTINE IS CALLED IN INITIALIZATION * 41655000 *. PHASE OF ASSIST. IT PERFORMS CERTAIN REQUIRED STORAGE * 41660000 *. ALLOCATION AND SETS POINTERS AVGEN1CD AND AVGEN2CD. * 41665000 *. OVERFLOW MESSAGE FOR GENERAL USE IS ALSO CREATED. * 41670000 *. G.M.CAMPBELL - SUMMER - 1972 * 41675000 *. * 41680000 *. USES MACROS: $ALLOCL, $SAVE, $RETURN, $CALL * 41685000 *. USES DSECTS: AVWXTABL * 41690000 *. * 41695000 *. REGISTER USAGE: S 41695050 *. WORK REGS: RA,RB S 41695100 *. * 41700000 *.********************************************************************* 41705000 SPACE 41710000 MACINT CSECT 41715000 $DBG ,NO 41720000 $SAVE SA=NO 41725000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 41730000 MVI AVMSNBY1,X'FF' TURN OFF SNAPS S 41730100 MVI AVMSNBY2,X'FF' TURN OFF SNAPS S 41730200 AIF (&$DEBUG).MACINT1 SKIP IF IF NOT DEBUG 41735000 MVI AVMSNBY1,X'00' CLEAR SNAP BYTE 1 41740000 MVI AVMSNBY2,X'00' CLEAR SNAP BYTE 2 41745000 XSNAP LABEL='***MACINT ENTERED***',IF=(AVMSNBY1,O,$MSNP01,TM) 41750000 .MACINT1 ANOP 41755000 MVC AVMBYTE1(4),AWZEROS CLEAR FLAGS 41760000 LA RA,AVMWRK1+255 GET UPPER LIMIT OF WORK AREA1 41765000 ST RA,AVMWRKL1 SAVE IN MAIN CONTROL AREA 41770000 LA RA,AVMWRK2+255 GET WORK AREA2 LIMIT 41775000 ST RA,AVMWRKL2 SAVE IN MAIN CONTROL AREA 41780000 SPACE 2 41785000 XC AWZEROS(256),AWZEROS ZERO TABLE S 41790000 TM AVTAGSM,AJOMACRO MACRO OPTION USED? 41800000 BZ MACINTRT RETURN IF NOT 41805000 SPACE 1 41810000 * CONSIDER MODIFYING CODE FOR LIST HANDLING ******************** 41815000 LA RB,$LMACLIB+$LGLBENT+$LCHWRK TOTAL WORKAREA LENGTH J 41820000 $ALLOCL RA,RB,MCINITOV GET DUMMY AREA FOR MACLIB 41825000 ST RA,AVMACLIB STORE @ IN MAIN TABLE 41830000 MVC 0($LMACLIB+$LGLBENT,RA),AWZEROS ZERO MAC,GBLX TABLES A 41835000 USING MACLIB,RA NOTE USING ON MACLIB ENTRY 41840000 OI MCLBTAGS,AVMCLBDF SET DEFINED FLAG ON DUMMY 41845000 DROP RA 41850000 * SPACE FOR 1 DUMMY MCGLBDCT. J 41855000 LA RA,$LMACLIB(,RA) BUMP PTR BEYOND MACRO ENTRY J 41860000 ST RA,AVMGDICT STORE @ IN MAIN TABLE 41865000 SPACE 1 REMV OLD MVC J 41870000 * BUMP, POINT AT $LCHWORK BYTES FOR CHARACTER WORKAREA. J 41875000 LA RA,$LGLBENT(,RA) BUMP PTR BEYOND GBLX ENTRY J 41880000 ST RA,AVMCHSTR SAVE @ IN AVWXTABL 41885000 LA RA,$LCHWRK-1(RA) GET @ OF LAST BYTE 41890000 ST RA,AVMCHLIM SAVE @ IN AVWXTABL 41895000 LA RA,MCINITOV GET @ OF OVRFLW ROUTINE 41900000 ST RA,AVMOVRFL SAVE IN AVWXTABL 41905000 MVC AVMACNST,AWZEROS INIT NEXTING COUNT TO ZERO 41910000 MVC AVMMACID,AWZEROS INITIALIZE MACRO ID TO ZERO 41915000 ZAP AVMSYSDX,AWP0 INIT SYSNDX TO ZERO 41920000 MACINTRT EQU * 41925000 MVC AVGEN1CD,AVADDHIH INIT EXPANSION POINTER 1 41930000 MVC AVGEN2CD,AVADDHIH INIT EXPANSION POINTER 2 41935000 XSNAP LABEL='***MACINT EXITED*** ',IF=(AVMSNBY1,O,$MSNP01,TM) 41940000 $RETURN SA=NO 41945000 SPACE 2 S 41950000 **--> INSUB: MCINITOV OVERFLOW ROUTINE + + + + + + + + + + + + +S 41950100 *+ CALLED BY ANY ROUTINE WHEN STORAGE OVERFLOW OCCURS. +S 41950200 *+ -- TERMINATES SECOND PASS +S 41950300 *+ +S 41950400 *+ USES MACROS: $SPIE,$CALL +S 41950500 *+ EXIT CONDITIONS: PROGRAM MARKED NON-EXECUTABLE +S 41950600 *+ CALLED BY: MACRO1,MCGTEST,MCBODY, AND MCGNCD +S 41950700 *+ +S 41955000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 41960000 SPACE 2 S 41965000 MCINITOV EQU * PROGRAM EXITS TO HERE IF OVERFLOW 41970000 BALR R15,0 **KLUDGE** NONSTANDRD BR'S ********* 41975000 USING *,R15 SHOULD HAVE THIS USING 41980000 * **WARNING** MACRO1 & MEXPND CANNOT BOTHE BE ACTIVE FOR THIS. 41985000 L R1,AVMBSPIE GET @ LAST PREVIOUS SPIE BLK 41990000 OI AVTAGS2,AJOASTOP STOP 2ND PASS PROCESSING 41995000 $SPIE ACTION=(RS,(1)) RESTORE PREVIOUS PTR 42000000 $CALL MOSTOP GO TO MOSTOP TO QUIT 42005000 LTORG 42010000 DROP RAT,R15 42015000 TITLE '*** MACRO1 - MAIN ROUTINE FOR MACRO DEFINITION' 42020000 **--> CSECT: MACRO1 CALLED BY MAIN CONTROL WHEN MACRO OPCODE * 42025000 *. ENCOUNTERED. AT PRESENT (DEC 31, 1971) ONLY MACRO * 42030000 *. DEFINITIONS ARE ALLOWED, NO CONDITIONAL ASSEMBLY. MACRO1 * 42035000 *. CREATES ENTRY IN MACLIB FOR FUTURE EXPANSION BY MEXPND * 42040000 *. ENTRY CONDITIONS * 42045000 *. RA = SCAN POINTER @ OF OPERAND * 42050000 *. RC = @ OPCODTB ENTRY FOR OPERATION * 42055000 *. * 42060000 *. CALLS MACSCN,OUTPT2,MACFND,ERRTAG,ERRLAB,MCVSCN,MCSCOP, * 42065000 *. MCBODY * 42070000 *. USES MACROS: $SAVE,$RETURN,$CALL,$ALLOCL * 42075000 *. USES DSECTS: RSBLOCK,OPCODTB,AVWXTABL,MACLIB,MCPARENT * 42080000 *. * 42085000 *. REGISTER USAGE: S 42085100 *. WORK REGS: R0,R1,R2,RA,RB,RD,RE S 42085200 *. BASE REGS: RAT,RW,RX,RY,R13,RC S 42085300 *. UNUSED: RZ S 42085400 *. S 42085500 *.********************************************************************* 42090000 XSET XSNAP=OFF A 42090100 SPACE 42095000 MACRO1 CSECT 42100000 $SAVE RGS=(R14-R6),SA=*,BR=13 42105000 USING AVWXTABL,RAT NOT MAIN TABLE USING 42110000 XSNAP LABEL='***MACRO1 ENTERED***',IF=(AVMSNBY1,O,$MSNP02,TM) 42115000 L RW,AVRSBPT GET @ OF SOURCE STATEMENT 42120000 USING RSBLOCK,RW ESTAB BASE FOR SOURCE 42125000 USING OPCODTB,RC ESTAB BASE FOR OPCODE ENTRY 42130000 AIF (&$DEBUG).MACQQ00 SKIP IF NO DEBUF 42135000 $SPIE ,,ACTION=CR,CE=MCBSPIEP 42140000 ST R1,AVMBSPIE SAVE PREV INT @ 42145000 .MACQQ00 ANOP 42150000 LA RA,RSBSOURC SET SCAN POINTER 42155000 LR R0,RC SAVE RC ACROSS MACSCN CALL A 42155100 $CALL MACSCN SCAN SOURCE STATEMENT FOR FIELDS 42160000 LR RC,R0 RESTORE RC A 42160100 L RA,AVMFLD2 GET OPCODE ADDRESS 42165000 CLI OPCHEX,$MACRO OPCODE=MACRO? 42170000 BNE MACR1R01 ERROR IF NOT 42175000 TM AVPRINT1,AVPRSAVE AFTER START STMNT OR EQUIV? 42180000 BO MACR1R01 ERROR IF YES 42185000 AIF (NOT &$MACOPC).MAC1A BRANCH IF NO OPEN CODE S 42185100 TM AVMTAG00,AVMNOMAC MACROS ALLOWED? S 42185200 BO MACR1R01 MACROS NOT ALLOWED S 42185300 .MAC1A ANOP S 42185400 CLI AVMFLDT1,X'00' LABEL PRESENT? 42190000 BE MACRO101 OK IF NOT 42195000 LA RB,$ERILLAB SET ERROR FLAG IF YES 42200000 $CALL ERRLAB MARK STATEMENT 42205000 MACRO101 EQU * 42210000 MCR1PRNT EQU * 42215000 LA RB,$OUCOMM SET PRINT FLAG 42220000 $CALL OUTPT2 PRINT STATEMENT 42225000 MVC AVMBYTE1(3),AWZEROS CLEAR ALL FLAGS 42230000 L RA,AVMMACID GET PREV MACRO ID 42235000 LA RA,1(RA) INCREMENT BY ONE 42240000 ST RA,AVMMACID RESTORE CURRENT ID 42245000 * 42255000 * NEXT SECTION READS AND PROCESSES THE PROTOTYPE STATEMENT 42260000 * 42265000 BAL RET,MACRORD READ PROTOTYPE STMT 42270000 LA RA,RSBSOURC SET SCAN POINTER TO ASTART 42275000 MACPROT1 EQU * 42280000 $CALL MACSCN SCAN SOURCE FOR FIELDS 42285000 CLI AVMFLDT2,C'I' OPCODE = MACRO INSTRUCTION? 42300000 BNE MACR1DUM IF ERR-BRANCH-BAD PROTOTYPE S 42305000 * S 42305100 * IMPROPER PROTOTYPE STMT FOUND OR PREVIOUSLY DEFINED MACRO- S 42305200 * ERROR FLAGS SET AND UNIQUE NAME INSERTED. S 42305300 * S 42305400 * S 42370100 * SCAN MACRO LIBRARY FOR MACRO NAME -- S 42370200 * PREVIOUSLY DEFINED FLAGGED AS ERROR S 42370300 * NOT PREVIOUSLY DEFINED ==> OK S 42370400 * S 42370500 MACPROT2 EQU * 42375000 SR RE,RE ZERO RE FOR EX USE 42380000 IC RE,AVMFLDL2 GET LENGTH OF SYMBOL 42385000 BCTR RE,0 DECR LENGTH FOR EX INST 42390000 MVC AVMSYMBL,AWBLANK BLANK OUT COMMON SYMBOL FIELD 42395000 L RA,AVMFLD2 MOVE @ OPCODE TO SCAN PNTR 42400000 EX RE,MCMVSYM MOVE SYMBOL INTO AVMSYMBL FOR SEARCH 42405000 MVC AVMSYMLN(1),AVMFLDL2 MOVE SYMBOL LENGTH INTO COMMON AREA 42410000 L RC,AVMACLIB GET @ OF MACRO LIBRARY 42415000 USING MACLIB,RX SET USING FOR MACLIB ENTRY 42420000 $CALL MACFND SEARCH MACRO LIBRARY FOR SYMBOL 42425000 LTR RB,RB ALREADY THERE? 42430000 BNZ MACPROT3 IF NOT, ENTER 42435000 LR RX,RC MOVE BASE TO RX 42440000 TM MCLBTAGS,AVMCLBDF PREVIOUSLY DEFINED? 42445000 BNO MACPROT4 NO, JUST MARK DEFINED NOW S 42450000 SPACE 1 S 42450500 * EITHER INCORRECT OR DUPLICATE MACRO NAME - GET @ S 42451000 * OF DUMMY MACLIB HAVING X'00' AS MACRO NAME (ALWAYS S 42451500 * POINTED TO BY AVMACLIB - THIS DUMMY IS REUSED FOR ALL S 42452000 * SUCH ERRONEOUS MACROS. ALSO FLAG ERROR. S 42452500 MACR1DUM LA RB,$ERILMNM DUPLICATE/BAD MACRO NAME S 42453000 L RA,AVMFLD2 GET @ OF OPCODE S 42453500 $CALL ERRTAG CALL ERROR FLAGGING S 42454000 L RX,AVMACLIB GET @ OF DUMMY ELEMENT S 42454250 MVC MCLBFLG2($LMACLIB-(MCLBFLG2-MACLIB)),AWZEROS RECLEAR S 42454500 B MACPROT4 AND PROCEED 42455000 * S 42455100 * MACRO NAME DEFINED AND ENTERED IN LIBRARY, SPACE ALLOCATED S 42455200 * S 42455300 MACPROT3 EQU * 42460000 LR RX,RC MOVE LIB ENTRY PNTR TO RX 42465000 LA RE,$LMACLIB GET LENGTH OF MACRO LIN ENTRY 42470000 $ALLOCL RD,RE,MCOVRPR GET AREA FOR NEW ENTRY 42475000 ST RD,MCLIBNXT SAVE @ OF NEW ENTRY IN PREV ENTRY 42480000 LR RX,RD MOVE BASE TO RD 42485000 MVC MACLIB($LMACLIB),AWZEROS ZERO NEW ENTRY 42490000 MVC MCLBNMLN(9),AVMSYMLN MOVE NAME INTO LIBRARY 42495000 SPACE 42500000 * MACLIB ENTRY ESTABLISHED. &SYSECT, &SYSNDX AND &SYSLIST ARE NEXT 42505000 * ENTERED IN PARAMETER LIST 42510000 SPACE 42515000 MACPROT4 EQU * 42520000 OI MCLBTAGS,AVMCLBDF SET DEFINED FLAG 42525000 USING MCPARENT,RY SET USING FOR PARAM ENTRY 42530000 LA RE,(MACSVAR#+1)*$LPARENT GET SLOTS FOR SYSTEM A 42535000 $ALLOCL RY,RE,MCOVRPR GET SPACE FOR ENTRY 42540000 MVC MCPARNLN(MCPARNTL),MACSVAR1 MOVE &SYSECT ENTRIES J 42545000 LA R1,AVSYSECT GET @ OF CURRENT CSECT NAME 42560000 ST R1,MCPROPRN SAVE IN ENTRY 42565000 ST RY,MCPARPNT SAVE POINTER IN MACLIB ENTRY 42570000 LA RC,$LPARENT(,RY) @ OF NEXT ENTRY A 42575000 ST RC,MCPARNXT SAVE POINTER IN PREV ENTRY 42580000 LR RY,RC MOVE BASE TO NEW ENTRY 42585000 MVC MCPARNLN(MCPARNTL),MACSVAR2 MOVE &SYSNDX ENTY J 42590000 MVC MCPROPRN,AWZEROS SET POINTER TO ZERO 42605000 LA RC,$LPARENT(,RC) @ OF NEXT ENTRY A 42610000 ST RC,MCPARNXT SAVE POINTER IN PREV ENTRY 42615000 LR RY,RC MOVE AASE TO NEW ENTRY 42620000 MVC MCPARNLN(MCPARNTL),MACSVAR3 MOVE &SYSLIST ENTRY J 42625000 SPACE 42640000 * SYSTEM VARIABLES ENTERED IN PARAM LEST. NEXT GET LABEL IF ANY 42645000 SPACE 42650000 LA RC,$LPARENT(,RC) @ OF NEXT ENTRY 42655000 ST RC,MCPARNXT SAVE LINK IN PREV ENTRY 42660000 LR RY,RC MOVE BASE TO NEW ENTRY 42665000 MVC MCPARENT($LPARENT),AWZEROS ZERO OUT ENTRY 42670000 L RA,AVMFLD1 GET @ OF LABEL, IF ANY 42675000 LTR RA,RA IS THERE A LABEL 42680000 BZ MCPARSCN IF NOT, PROCEED WITH OPERAND SCAN 42685000 $CALL MCVSCN ELSE SCAN LABEL FIELD 42690000 LTR RB,RB VARIABLE SYMBOL? 42695000 BZ MCLAB01 OKAY IF RB = 0 42700000 LA RB,$ERINVSY ELSE FLAG INVALID SYMBOL 42705000 MACLABER EQU * 42710000 $CALL ERRLAB FLAG ERROR 42715000 B MCPARSCN RESUME SCAN AFTER FLAGGING ERROR 42720000 SPACE 42725000 MCMVSYM MVC AVMSYMBL($),0(RA) DUMMY FOR EX INST TO MOVE SYMBOL 42730000 SPACE 42735000 * S 42735100 * SCAN FOR &LABEL -- IF NOT MULTIPLY DEFINED ENTER IN S 42735200 * PARAMETER LIST S 42735300 * S 42735400 MCLAB01 EQU * 42740000 L RC,MCPARPNT GET @ OF PARAM LIST 42745000 $CALL MACFND SCAN LIST 42750000 LTR RB,RB NAME ALREADY PRESENT 42755000 BNZ MCLAB02 OKAY IF NONZERO 42760000 LA RB,$ERMULDF ELSE SET MULTIPLE DEF FLAG 42765000 B MACLABER BRANCH AND FLAG ERROR 42770000 MCLAB02 EQU * 42775000 MVC MCPARNLN(9),AVMSYMLN MOVE LABEL NAME INTO ENTRY 42780000 MVI MCPARTYP,C'P' SET ENTRY TYPE TO POSITIONAL 42785000 SPACE 42790000 * START SCAN OF PARAMETER OPERAND FIELD 42795000 SPACE 42800000 MCPARSCN CLI AVMFLDL3,X'00' OPERAND PRESENT? 42805000 BE MACRO1RT IF NOT, FINI 42810000 L RA,AVMFLD3 ELSE GET @ OF OPERAND IN SCAN PNTR 42815000 SPACE 2 S 42815100 * BEGIN LOOP TO SCAN MACRO PARAMETER LIST S 42815200 SPACE 1 S 42815300 MCPARST EQU * 42820000 LR R0,RA COPY SCAN POINTER TEMPORRARILY 42825000 $CALL MCVSCN SCAN NEXT SYMBOL 42830000 LTR RB,RB VAR SYMBOL OK? 42835000 BZ MCPRSC01 IF YES, PROCEED 42840000 LA RB,$ERINVSY IF RB ^= 0, ILLEGAL S 42850000 B MACR1TG1 FLAG STNT 42855000 SPACE 42860000 * HAVE LEGAL PARAMETER -- SCAN, DETERMINE TYP) AND INSERT S 42860100 * S 42860200 MCPRSC01 EQU * 42865000 CLI 0(RA),C'=' KEYWORD PARAMETER? 42870000 BE MCPRSC11 IF YES, OKAY 42875000 TM AVMBYTE1,$MKEYOPR KEYWORD ALREADY PROCESSED? 42880000 BO MACR1R03 ERROR IF YES 42885000 *************** POSSIBLE CHANGE FOR ASM H OR VS *************** S 42890000 * S 42915100 * LEGAL PARM FOUND -- INSERT IF NOT DUPLICATE S 42915200 * S 42915300 MCPRSC11 EQU * 42920000 ST RA,AVMTSCNP SAVE SCAN POINTER TEMPORARILY 42925000 L RC,MCPARPNT GET @ OF PAR LIST 42930000 $CALL MACFND SEARCH PARAMETER LIST 42935000 LTR RB,RB SYMBOL ALREADY PRESENT? 42940000 BNZ MCPRSC02 IF NOT, OKAY 42945000 LR RA,R0 RESTORE SCAN POINTER FOR ERROR MSG 42950000 MCPRSCMD LA RB,$ERMULDF SET MULT DEF FLAG 42955000 B MACR1TG1 BRANCH AND FLAG STMT 42960000 * 42965000 * ALLOCATE SPACE FOR PARM ENTRY, CHACK TYPE AND BUMP COUNTERS S 42965100 * S 42965200 MCPRSC02 LA RE,$LPARENT GET LENGTH OF PAR ENTRY 42970000 $ALLOCL R1,RE,MCOVRPR GET AREA FOR NEW ENTRY 42975000 ST R1,MCPARNXT PUT POINTER IN PREV ENTRY 42980000 LH R2,MCPARNDX GET CURRENT OPERAND COUNT 42985000 LR RY,R1 MOVE BASE TO NEW ENTRY 42990000 MVC MCPARENT($LPARENT),AWZEROS CLEAR ENTRY 42995000 MVC MCPARNLN(9),AVMSYMLN MOVE SYMBOL INTO NIE ENTRY 43000000 LA R1,1(R2) BUMP OPERAND COUNT BY ONE 43005000 STH R1,MCPARNDX RESTORE NEW COUNT 43010000 STH R1,MCPOPRNB UPDATE TOTAL NBR OF OPRNDS 43015000 L RA,AVMTSCNP RESTORE SCAN POINTER 43020000 CLI 0(RA),C'=' KEYWORD PARAMETER? 43025000 MVI MCPARTYP,C'P' ELSE SET TYPE = POSITIONAL 43035000 BNE MCPRSC06 JUMP OUT IF POSITIONAL A 43040000 SPACE 43045000 * KEYWORD PARM FOUND -- PROCESS ACCORDINGLY S 43045100 * S 43045200 MCPRSCK LA RA,1(RA) BUMP SCAN PNTR PAST '=' 43050000 MVI MCPARTYP,C'K' IDENTIFY AS KEYWORD OPERAND 43055000 ST RA,AVMTSCNP SAVE SCAN PNTR TEMPORARILY 43060000 NI AVMBYTE1,X'FF'-$MSBLIST TURN OFF SUBLIST FLAG 43065000 OI AVMBYTE1,$MKEYOPR SET KEYWORD OPRND FLAG 43070000 $CALL MCSCOP SCAN OPERAND 43075000 LTR RB,RB OPERAND OK? 43080000 BNZ MACR1TG1 IF NOT, BRANCH AND FLAG 43085000 STC RD,MCPRATYP SAVE ATTRIBUTE TYPE 43090000 STC RC,MCPROPLN STORE LENGTH 43095000 LH RE,MCKOPRNB GET KEYWORD COUNT 43100000 LA RE,1(RE) BUMP KEYWORD COUNT 43105000 STH RE,MCKOPRNB RESTORE NEW COUNT 43110000 LTR RC,RC CHECK FOR NULL STRING 43115000 BZ MCPRSC03 IF YES, GO TO NEXT OPERAND 43120000 LA RE,3+1(,RC) ROUND TO FULLWORD+1 FOR DELIM AFTERJ 43130000 SRL RE,2 SHIFT RIGHT TO TRUNCATE 2 BITS 43135000 SLL RE,2 SHIFT LEFT TO RESTORE 43140000 $ALLOCL RB,RE,MCOVRPR GET AREA FOR KEYWORD VALUE 43145000 ST RB,MCPROPRN SAVE STND VALUE @ IN ENTRY 43150000 * OMIT BCTR RC,0 : USE LENG RATHER THAN LENG-1, SO WILL J 43155000 * PICK UP DELIMITER AFTER VALUE. HELPS MEXPND SCAN OK J 43155010 L RE,AVMTSCNP RESTORE SCAN POINTER FOR OPRND MOVE 43160000 EX RC,MCMVOPRN MOVE KEYWORD VALUE INTO ENTRY 43165000 * S 43165100 * PROCESS SUBLISTED PARAMETERS S 43165200 * S 43165300 MCPRSC03 EQU * 43170000 CLI MCPRATYP,C'S' SUBLIST? 43175000 BNE MCPRSC06 PROCEED IF NOT 43180000 LR R0,RA COPY SCAN PNTR 43205000 L RA,AVMTSCNP GET ORIGINAL SCAN PNTR 43210000 LA RA,1(RA) BUMP PAST '(' 43215000 OI AVMBYTE1,$MSBLIST SET SUBLIST FLAG 43220000 * S 43220100 * BEGIN LOOP TO PROCESS SUBOPERANDS S 43220200 * S 43220300 MCPRSC05 EQU * 43230000 $CALL MCSCOP SCAN SUBOPRND 43235000 LTR RB,RB OKAY? 43240000 BNZ MACR1TG1 IF NOT, BRANCH AND FLAG 43245000 CLI 0(RA),C')' END OF SUBLIST? 43255000 LA RA,1(RA) BUMP PAST DELIM 43260000 BNE MCPRSC05 RESUME SCAN IF NOT END 43265000 LR RA,R0 ELSE RESTORE SCAN PNTR 43270000 * S 43275000 * DELIMETER CHECK S 43275100 * S 43275200 MCPRSC06 EQU * 43280000 CLI 0(RA),C' ' END OF OPERAND? 43285000 BE MACRO1RT BRANCH AND PRINT IF YES 43290000 CLI 0(RA),C',' DELIM = ','? 43295000 BE MCPRBMP OK IF YES 43300000 LA RB,$ERINVDM ELSE SET BAD DELIM FLAG 43305000 B MACR1TG1 BRANCH AND FLAG 43310000 MCPRBMP EQU * 43315000 LA RA,1(RA) BUMP SCAN POINTER 43320000 CLI 0(RA),C' ' BLANK AFTER ','? 43325000 BNE MCPARST RESUME SCAN IF NOT 43330000 SPACE 1 43335000 * POSSIBLE NON-STD CONT CARDS -- MACROS ONLY S 43340000 CLI RSBNUM,1 ONLY 1 CARD? 43345000 BE MCPARST RESUME SCAN IF YES 43350000 LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 43355000 CR RA,RB POINTING AT WHICH CARD? 43360000 BNH MCPRCO#2 PROCESS 2ND CARD IF LOW 43365000 CLI RSBNUM,3 TWO CONT CARDS? 43370000 BNE MCPARST RESUME SCAN IF NOT 43375000 LA RB,RSOLC(RB) POINT TO 1ST BYTE, 3RD CARD 43380000 CR RA,RB WHERE IS SCAN POINTER? 43385000 BH MCPRCO#3 CHECK FOR 4TH CARD 43390000 MCPRCO#2 EQU * 43395000 LR RA,RB MOVE SCAN POINTER TO CONT CARD 43400000 B MCPARST GO BACK FOR NEXT OPRND 43405000 SPACE 2 43410000 MCPRCO#3 EQU * 43415000 CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 43420000 BNE MCPARST RESUME SCAN IF NOT 43425000 LA RB,$OUCOMM SET PRINT FLAG 43430000 $CALL OUTPT2 PRINT STMT 43435000 BAL RET,MACRORD GET NEXT STMT 43440000 OI RSBFLAG,$RSBNPNN SET NO ACTION FLAG 43445000 LA RA,RSBSOURC POINT TO START OF STMT 43450000 CLC 0(15,RA),AWBLANK ALL BLANKS IN COL 1-15? 43455000 BE MCPRCO#4 OKAY IF YES 43460000 LA RB,$ERCONT ELSE SET ERROR FLAG 43465000 $CALL ERRTAG FLAG STMT 43470000 MCPRCO#4 EQU * 43475000 LA RA,15(RA) BUMP SCN PNTR TO COL 16 43480000 B MCPARST AND RESUME SCAN 43485000 MCMVOPRN MVC 0($,RB),0(RE) DUMMY FOR EX INSTR TO MOVE OPRND S 43485100 SPACE 2 43490000 **--> INSUB: MACRORD MACRO READER + + + + + + + + + + + + + + +S 43490100 *+ CALLED BY MACRO1 THREE PLACES: +S 43490150 *+ 1ST TO READ PROTOTYPE STMT +S 43490200 *+ 2ND TO CHECK FOR CONT CARDS (MACRO) +S 43490250 *+ 3RD TO GET NEXT CONT CARD (NON-MACRO) +S 43490300 *+ ENTRY CONDS: +S 43490350 *+ RETURN POINT = RET +S 43490400 *+ EXIT CONDS: +S 43490450 *+ AVMBYTE5 (ERROR FLAG) SET IF MORE THAN ALLOWED +S 43490500 *+ CONTINUATION CARDS (LIMIT = 3) +S 43490550 *+ CALLS: INCARD TO ACTUALLY READ CARDS +S 43490600 *+ ERRTAG FOR ERROR PROCESSING +S 43490650 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 43490700 SPACE 2 S 43490750 MACRORD EQU * 43495000 ST RET,MACRDSAV SAVE RETURN @ 43500000 $CALL INCARD READ NEXT STMT 43505000 STC RB,AVMBYTE5 SAVE ERROR FLAG 43510000 CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 43515000 BE MACRDRTN PROCEED IF YES 43520000 LTR RB,RB ELSE TEST FOR OTHER ERROR 43525000 BZ MACRDRTN RETURN IF NONE 43530000 $CALL ERRTAG ELSE FLAG STMT 43535000 TM AVTAGS2,$INEND2 END OF FILE ERROR? 43540000 BO MACRO1RT RETURN IF YES 43545000 MACRDRTN EQU * 43550000 L RET,MACRDSAV RESTORE RETURN @ 43555000 BR RET AND RETURN 43560000 MACRDSAV DS F SPACE FOR RETURN @ 43565000 SPACE 4 43595000 * ERROR ROUTINE CALLED WHEN ERROR FOUND IN MAC DEF S 43595100 * S 43595200 MACR1R01 EQU * 43600000 AIF (NOT &$MACOPC).MAC1B BRANCH IF NO OPEN CODE S 43600020 EJECT S 43600040 * MAIN CONTROL BLOCK FOR OPEN CODE CONDITIONAL ASSEMBLY S 43600060 * S 43600062 * REGISTER USAGE FOR THIS SECTION: S 43600064 * S 43600066 * R0 - WORK REG S 43600068 * R1 - PTR TO CONTROL TABLE AND TRT REG S 43600070 * R2 - PTR TO CONTROL TABLE S 43600072 * RW - BASE FOR RSBLOCK S 43600074 * RX - BASE FOR MACLIB S 43600076 * RY - UNUSED (BUT --> BASE FOR MCPARENT IN MACRO1) S 43600078 * RZ - BASE FOR MXPNTSAV AND WORK REG S 43600080 * RA - WORK REG S 43600082 * RB - BASE FOR MCLCLDPV AND WORK REG S 43600084 * RC - BASE FOR OPCODTB AND WORK REG S 43600086 * RD - UNUSED S 43600088 * RE - UNUSED S 43600090 * RAT - BASE FOR AVWXTABL S 43600092 * R13 - BASE FOR THIS CSECT --> MACRO1 S 43600094 * S 43600096 OI AVMTAG00,AVMNOMAC FLAG => NO MORE MACROS S 43600100 SR R1,R1 CLEAR FOR TABLE INDEX S 43600120 IC R1,OPCHEX GET OPCODE INDEX S 43600140 LA R1,MC1CONTB(R1) LOAD @ OF TABLE ENTRY S 43600160 L RX,AVMACLIB GET @ OF OPEN CODE MACLIB S 43600180 * SET UP MACLIB ENTRY AND LOCAL DICTIONARY DUMMY ENTRY, S 43600220 * IF NOT ALREADY DONE S 43600240 TM AVMTAG00,AVMOPMIN IS LOCAL DUMMY BUILT ? S 43600260 BO MC1CLMCB BRANCH IF YES S 43600280 L RD,AVMMACID INCRESE MACID A 43600285 LA RD,1(RD) INCREASE BY ONE A 43600290 ST RD,AVMMACID STORE IT BACK A 43600295 MVC MACLIB+4($LMACLIB-4),AWZEROS ZERO OUT MACLIB ENTRY S 43600300 MVC MCLBNMLN(9),MC1OPNCD ENTER NAME AND LENGTH INTO MACLIBS 43600320 * ALLOCATE CORE FOR LOCAL DUMMY ENTRY (SEE MCBODY START) S 43600340 LA RA,$LLCLDV+$LGLBENT GET LENGTH OF DICTS A 43600360 USING MCLCLDPV,RB NOTE USING ON LOCAL DICT DOPE VECT S 43600370 $ALLOCH RB,RA,MC1OVRFL GET AREA FOR ENTRY S 43600380 ST RB,MCDDVPNT SAVE @ IN MACLIB S 43600400 MVC 0($LLCLDV+$LGLBENT,RB),AWZEROS CLEAR ENTRY A 43600420 MVI MCLCLTYP,$ARITH SET TYPE = ARITH FOR LENGTH S 43600440 MVI MCLCLDIM+1,1 SET DIMENSION TO 1 S 43600460 DROP RB S 43600470 MVI MCLOCDLN+3,4 INIT LENGTH OF DICT TO 4 S 43600480 OI AVMTAG00,AVMOPMIN+AVMNOMAC SET FLAGS A 43600500 OI MCLBFLG2,$MCOCFL1 SHOW OPEN CODE A 43600510 XSNAP LABEL='AFTER OPEN MACLIB',STORAGE=(*MACLIB,*MACLIB+100),X43600511 IF=(AVTAGSM,O,AJOMACRH,TM) A 43600512 MC1CLMCB EQU * S 43600520 XSNAP LABEL='MCICLMB,R1 TABLE ENTRY' A 43600521 TM 0(R1),$MC1DCL DECLARE TYPE OPCODE ? S 43600540 BNO MC1ACTON NO, ACTION TYPE S 43600560 TM AVPRINT1,AVPRSAVE LISTING CONTROL = SAVE ? S 43600580 BO MC1NORM BRANCH IF YES S 43600600 TM MCLBFLG2,$MCOCFL2 DECLARE TYPE ALLOWED ? S 43600620 BO MC1NORM NO, OUT OF ORDER S 43600640 OI AVMTAG00,AVMOPENC SET FLAG TO SHOW IN OPEN A 43600645 LR RC,RX COPY @ MACLIB WHERE EXPECTED J 43600650 $CALL MCBODY PROCESS STATEMENT S 43600660 B MC1RTN0 RETURN, RB=0 S 43600680 * ACTION TYPE MACRO OPCODE PROCESSED BELOW S 43600700 MC1ACTON EQU * S 43600720 XSNAP LABEL='ACTION TYPE FOUND' A 43600721 TM 0(R1),$MC1ERR ERROR FLAG ON ? S 43600740 BO MC1NORM BRANCH IF YES S 43600760 OI MCLBFLG2,$MCOCFL2 DECLARE TYPES NO LONGER ALLOWED S 43600780 TM AVMTAG00,AVMOPDIC HAS OPEN CODE LOCAL DICT BEEN S#43600800 ALLOCATED ? S 43600820 BO MC1SAVLO BRANCH IF YES S 43600840 * ALLOCATE SPACE FOR OPEN CODE LOCAL DICTIONARY AND MXPNTSAV S 43600860 L RA,MCLOCDLN GET LENGTH OF LOCAL DICT S 43600880 LA RA,$LMXPTSV(RA) ADD LENGTH OF MXPNTSAV S 43600900 $ALLOCH RB,RA,MC1OVRFL GET CORE FOR LOCAL DICT S 43600920 * INITIALIZE LOCAL DICTIONARY AND MXPNTSAV TO ZEROS S 43600940 ST RB,MC1PTSAV SAVE POINTER TO ALLOCATED CORE S 43600960 LR R0,RA COPY OVER LENGTH FOR LATER USE J 43600970 BCTR RA,0 DECR COUNT S 43600980 EX RA,MC1MOVZR CLEAR LENGTH MOD 256 S 43601000 SRA RA,8 SHIFT TO GET # 256 BYTE BLOCKS LEFTS 43601040 BNP MC1DNZER SKIP IF NO MORE TO DO S 43601060 N R0,AWFXFF REMOVE ALL BUT LAST BYTE OF LENGTH J 43601065 AR RB,R0 ADD LENGTH, GET @ FIRST BYTE TO 0 J 43601070 MVC 0(256,RB),AWZEROS CLEAR 256 BYTES AT A TIME S 43601080 LA RB,256(,RB) INCMT TO NEXT BLOCK S 43601100 BCT RA,*-10 LOOP, CLEAR TILL DONE S 43601120 * SET UP MXPNTSAV AND SET ACTR LIMIT S 43601140 MC1DNZER EQU * S 43601160 USING MXPNTSAV,RZ BASE REG FOR MXPNTSAV S 43601180 L RZ,MC1PTSAV BASE REG FOR MXPNTSAV S 43601200 ST RX,MXPNMCLB STORE @ OF MACLIB ENTRY A 43601210 LA RB,$LMXPTSV(RZ) GET ADDR OF LOCAL DICTIONARY S 43601220 ST RB,MXPNLDBS SAVE @ IN MXPNTSAV S 43601240 MVC 0(4,RB),AVMMACTR SET ACTR LIMIT S 43601260 OI AVMTAG00,AVMOPDIC FLAG => DICT ALLOCATED S 43601280 * CALL MCBODY TO CREATE ONE-OPS. IF NO ERROR ON RETURN, S 43601320 * CALL MXINST TO INTERPRET THE ONE-OPS. OTHERWISE RETURN. S 43601340 MC1SAVLO EQU * S 43601360 MVC MC1LOPTR(4),AVADDLOW SAVE CURRENT LO PTR S 43601380 LR RC,RX COPY @ MACLIB WHERE EXPECTED J 43601390 XSNAP LABEL='BEFORE CALL MCBODY OC', X43601391 IF=(AVTAGSM,O,AJOMACRH,TM) A 43601392 L RD,AVADDHIH GET HIGH PTR A 43601394 LR RE,RD COPY INTO RE A 43601396 STM RD,RE,AVGEN1CD STORE INTO AVGEN1DC,AVGEN2DC A 43601398 $CALL MCBODY PROCESS STATEMENT S 43601400 L RA,MCCODLNK GET # FIRST INSTRUCTION A 43601420 USING MCOPQUAD,RA NOTE ONE/OP PTR A 43601430 CLI MCQS1FLG,$BSERR01 WAS IT IN ERROR A 43601440 BNE *+8 SKIP AROUND RESET IF O.K. A 43601460 LA R1,=AL1($MC1SKIP,$MC1RET) FAKE NO MORE ACTION A 43601462 NI AVMTAG00,255-AVMOPGO TURN OFF AIF/AGO FLAG (AVMOPGO) S 43601480 TM 0(R1),$MC1SKIP IS SKIP BIT ON ? (SKIP MXINST) S 43601500 BO MC1RSTLO IF YES, SKIP CALL TO MXINST S 43601520 L RC,MC1PTSAV LOAD @ OF MXPNTSAV S 43601540 USING MXPNTSAV,RC SET UP ANOTHER USING Z 43601545 MVC MXPNCRCD(4),MCCODLNK LOAD @ OF UST INSTR A 43601560 DROP RZ,RC,RA A 43601570 XSNAP LABEL='BEFORE CALL TO MXINST' A 43601571 XCALL MXINST CALL TO INTERPRET ONE-OPS S 43601580 L RD,AVGEN1CD A 43601582 L RE,AVADDHIH A 43601584 XSNAP LABEL='AFTER MXINST',STORAGE=(*0(RD),*4(RD),*0(RE),*4(REX43601586 )) A 43601587 * WIPE OUT ONE-OPS AND RETURN IF DONE S 43601600 MC1RSTLO EQU * S 43601620 MVC AVADDLOW(4),MC1LOPTR RESTORE AVADDLOW S 43601640 * IF ORIGINAL STATEMENT NOT ALREADY PRINTED, GET IT A 43601643 * BACK FROM HIGH AREA AND SAVE IT VIA UTPUT1 A 43601645 TM AVPRINT1,AVPRSAVE ALREADY IN SAVE MODE A 43601647 BZ MC1ALPRT NO, SO PRINTED STMT ALREADY A 43601650 $CALL INCARD GET STMT BACK A 43601653 OI RSBFLAG,$RSBNP## SHOW NO MORE PROCESSING A 43601655 $CALL UTPUT1 HAVE IT SAVED A 43601657 MC1ALPRT TM 0(R1),$MC1RET IS RETURN BIT ON ? S 43601660 BO MC1RTN0 BRANCH IF YES S 43601680 * PROCESS AIF, AGO AND ANYTHING ELSE NEEDING ACTION S 43601700 SR R2,R2 CLEAR R2 FOR INDEX S 43601720 IC R2,1(R1) LOAD JUMP CODE FROM CONTROL TABLE S 43601740 B *+4(R2) BRANCH ON INDEX S 43601760 B MC1AGO BRANCH TO PROCESS AGO S 43601780 TM AVMTAG00,AVMOPGO WAS AIF SUCCESSFUL ? S 43601800 BNO MC1RTN0 NOT SUCCESSFUL SO RETURN S 43601820 * AGO OR SUCCESSFUL AIF -- CHECK FOR ILLEGAL BACKWARD REFERENCES 43601840 MC1AGO EQU * S 43601860 LA RA,AVMSYMBL LOAD @ OF SEQ SYMBOL S 43601880 SR RB,RB CLEAR RB FOR LENGTH-1 IF SYMBOL S 43601920 IC RB,AVMSYMLN LOAD LENGTH-1 S 43601940 STC RB,MC1CLC1+1 STORE LENGTH IN CLC INSTR S 43601960 LA RB,1(RB) ADD 1 TO GET LENGTH S 43601980 LR RZ,RB COPY LENGTH FOR LATER S 43602000 $CALL SYFIND LOOK UP SEQ SYMBOL S 43602020 B *+4(RB) BRANCH ON RETURNED INDEX S 43602040 B MC1SEQDF BRANCH IF PREVIOUSLY DEFINED S 43602060 * SEQ SYMBOL NOT PREVIOUSLY DEFINED --> S 43602080 * READ CARDS UNTIL SEQ SYMBOL OR END-OF-FILE FOUND S 43602100 MC1READ EQU * S 43602120 $CALL INCARD READ NEXT SOURCE CARD S 43602140 TM AVTAGS2,$INEND2 END-OF-FILE ? S 43602160 BO MC1EOF BRANCH IF YES S 43602180 CLI RSBLOPC,C'.' IS THIS A SEQ SYMBOL? S 43602220 BNE MC1READ IF NOT, READ NEXT CARD S 43602240 LA RA,RSBSOURC @ 1ST BYTE OF CARD S 43602260 $SETRT (' ',4) STOP TRT ON BLANK S 43602280 TRT 1(8,RA),AWTZTAB SCAN FOR BLANK S 43602300 $SETRT (' ',0) REZERO TABLE S 43602320 BZ MC1READ INVALID SEQ SYM -- IGNORE S 43602340 LR RB,R1 @ OF BLANK S 43602360 SR RB,RA GET LENGTH S 43602380 CR RB,RZ IS IT = ONE WE WANT ? S 43602400 BNE MC1AGOSY NO, BUT SHOW DEFINED S 43602420 MC1CLC1 CLC AVMSYMBL($),0(RA) COMPARE SYMBOLS S 43602440 BE MC1RTN4 SEQ SYM FOUND -- RETURN S 43602460 MC1AGOSY $CALL SYENT1 ENTER SEQ SYM IN TABLE S 43602480 * IF WANTED, COULD SEE IF PREVIOUSLY DEFINED - WE IGNORE IT S 43602500 B MC1READ GO FOR NEXT CARD S 43602520 * SEQUENCE SYMBOL PREVIOUSLY DEFINED --> S 43602540 * (AS242 -- BACKWARDS AIF/AGO IN OPEN CODE) S 43602560 MC1SEQDF EQU * S 43602580 MVC AVRSBLOC(MC1MSEQU),MC1MSSG MOVE ERROR MSG INTO S#43602600 RSBLOCK (AS242) S 43602620 B MC1RTN4 RETURN A 43602640 * END-OF-FILE ENCOUNTERED BEFORE SEQ SYMBOL FOUND --> S 43602660 * (AS241 - SEQUENCE SYMBOL NOT FOUND) S 43602680 MC1EOF EQU * S 43602700 MVC AVRSBLOC(MC1MSEQ2),MC1MSSG2 MOVE ERROR MSG INTO RSB S 43602720 * RETURN SHOWING NEXT SOURCE ALREADY IN RSBLOCK S 43602740 MC1RTN4 EQU * S 43602760 LA RB,4 SET RETURN CODE S 43602780 B MACRO1FN RETURN S 43602800 * RETURN SHOWING NEXT SOURCE NOT IN RSBLOCK S 43602880 MC1RTN0 EQU * S 43602900 SR RB,RB CLEAR FLAG REGISTER S 43602920 B MACRO1FN BRANCH TO RETURN S 43602940 * S 43602960 * OVERFLOW EXIT -- HALT ASSEMBLY S 43602980 * S 43603000 MC1OVRFL EQU * S 43603020 OI AVTAGS2,AJOASTOP STOP 2ND PASS PROCESSING S 43603040 $CALL MOSTOP GO TO MOSTOP TO QUIT S 43603060 * S 43603080 * MACRO1 DC/DS/DUMMYS FOR OPEN CODE S 43603100 MC1MOVZR MVC 0($,RB),AWZEROS DUMMY INSTR S 43603120 MC1LOPTR DC F'0' WORD TO SAVE CURRENT AVADDLOW S 43603140 MC1PTSAV DC F'0' WORD TO SAVE PTR TO MXPNTSAV S 43603160 MC1MSSG DC AL1(MC1MSEQU,$RSBNPNN+$RSBMERR,1,0) A 43603180 DC C'242 BACKWARDS AIF/AGO ILLEGAL' S 43603200 MC1MSEQU EQU *-MC1MSSG S 43603220 MC1MSSG2 DC AL1(MC1MSEQ2,$RSBNPNN+$RSBMERR,1,0) A 43603240 DC C'241 SEQUENCE SYMBOL NOT FOUND' S 43603260 MC1MSEQ2 EQU *-MC1MSSG2 S 43603280 MC1OPNCD DC X'08',CL8'OPEN-CDE' S 43603300 EJECT S 43603320 * MACRO1 CONTROL TABLE FOR OPEN CODE CONDITIONAL ASSEMBLY S 43603340 * S 43603360 * THE FIRST BYTE CONTAINS FLAG BITS; S 43603380 * BYTE 2 CONTAINS JUMP CODES S 43603400 SPACE 2 S 43603420 MC1CONTB EQU * S 43603440 DC AL1($MC1RET,0) NON-MACRO STMT S 43603460 DC AL1($MC1ERR,0) MACRO S 43603480 DC AL1($MC1DCL,0) GBLA S 43603500 DC AL1($MC1DCL,0) GBLB S 43603520 DC AL1($MC1DCL,0) GBLC S 43603540 DC AL1($MC1DCL,0) LCLA S 43603560 DC AL1($MC1DCL,0) LCLB S 43603580 DC AL1($MC1DCL,0) LCLC S 43603600 DC AL1($MC1RET,0) ACTR S 43603620 DC AL1($MC1RET,0) SETA S 43603640 DC AL1($MC1RET,0) SETB S 43603660 DC AL1($MC1RET,0) SETC S 43603680 DC AL1(0,4) AIF S 43603700 DC AL1($MC1SKIP,0) AGO S 43603720 DC AL1($MC1SKIP+$MC1RET,0) ANOP S 43603740 DC AL1($MC1RET,0) MNOTE S 43603760 DC AL1($MC1ERR,0) MEXIT S 43603780 DC AL1($MC1ERR,0) MEND S 43603800 DS 0H ALIGN IF NECESSARY S 43603820 EJECT S 43603840 MC1NORM EQU * S 43603860 .MAC1B ANOP S 43603880 L RA,AVMFLD2 GET @ OF OPCODE S 43605000 MACR1LAB LA RB,$ERSTMNA SET CODE / USE WHATEVER @ IN RA S 43610000 MACR1TAG $CALL ERRTAG SET FLAG 43615000 LA RB,8 SET PROPER RETURN CODE 43620000 B MACRO1FN 43625000 * ERROR ROUTINE CALLED WHEN POSITIONAL PARAM FOUND AFTER S 43680100 * KEYWORD PARAM S 43680200 *************** POSSIBLE CHANGES WITH ASM H OR VS *************** S 43680300 * S 43680400 MACR1R03 EQU * 43685000 LA RB,$ERVSYNT SE T SYNTAX ERROR FLAG 43690000 B MACR1TG1 FLAG STMT 43695000 MCOVRPR L RE,AVMOVRFL GET @ OF OVERFLOW ROUTINE 43730000 BR RE BRANCH THERE 43735000 SPACE 4 43740000 * GENERAL ROUTINE TO FLAG INCORRECT PARAM FIELDS S 43740100 * S 43740200 MACR1TG1 EQU * 43745000 $CALL ERRTAG FLAG STMT 43750000 SPACE 2 43755000 * CHECK FOR END OF PROTOTYPE AND CALL ROUTINE TO PROCESS S 43755100 * BODY OF MACRO (MCBODY) S 43755200 * S 43755300 MACRO1RT EQU * 43760000 LA RB,$OUCOMM 43765000 $CALL OUTPT2 43770000 CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 43775000 BNE MACRO1RU PROCEED IF NOT 43780000 BAL RET,MACRORD ELSE GET NEXT STMT 43785000 OI RSBFLAG,$RSBNPNN SET NO ACTION FLAG 43790000 B MACRO1RT AND PRINT LINES 43795000 MACRO1RU EQU * 43800000 LR RC,RX 43805000 SR RB,RB 43810000 TM AVTAGS2,$INEND2 END OF FILE? 43815000 BO MACRO1FN RETURN IF YES 43820000 $CALL MCBODY PROCESS BODY OF DEFINIETION 43825000 MACRO1FN EQU * 43830000 AIF (&$DEBUG).MACROFN SKIP OVER DEBUG CODE IF NOT NEEDED J 43833000 L R1,AVMBSPIE 43835000 $SPIE ,,ACTION=(RS,(1)) TURN OFF SPIE 43840000 L R1,AVADDLOW GET @ OF START OF DYNAMIC AREA 43850000 XSNAP LABEL='DYNAMIC AREA',STORAGE=(*0(RX),*0(R1),*AVADDLOW,*AX43855000 VWXEND),IF=(AVMSNBY1,O,$MSNP02,TM) 43860000 .MACROFN ANOP 43865000 $RETURN RGS=(R14-R6) 43870000 AIF (&$DEBUG).MACQQ01 SKIP IF NO DEBUG 43875000 USING MCBSPIEP,R15 43880000 MCBSPIEP EQU * 43885000 L RC,AVMACLIB GET PONTR TO LOW ENDOF LOW CORE 43890000 L RD,AVADDLOW GET HIGH END OFLOW CORE 43895000 XSNAP LABEL='*** INTERRUPT IN MACRO DEFINITION PHASE ***', #43900000 STORAGE=(*0(R1),*16(R1),*0(RC),*0(RD),*AVADDLOW,*AVWXEND#43905000 ) 43910000 DC H'1' FORCE INTERRUPT 43915000 DROP R15 43920000 .MACQQ01 ANOP 43925000 DROP RAT,RW,RX,RY,R13 A 43930000 LTORG 43935000 MACSVAR# EQU 3 ACTUAL # SYSTEM VARIABLES J 43937000 * SYSTEM VARIABLES - VALUES FOR MCPAR- NLN,NAM,TYP. J 43937050 MACSVAR1 DC AL1(7),CL8'&&SYSECT ',C'S' J 43937100 MACSVAR2 DC AL1(7),CL8'&&SYSNDX ',C'S' J 43937200 MACSVAR3 DC AL1(8),CL8'&&SYSLIST',C'S' J 43937300 TITLE '*** MACSCN - MACRO STATEMENT SCAN ***' 43940000 **--> CSECT: MACSCN SCANS MACRO INSTRUCTION STATEMENT. IDENTIFIES * 43945000 *. LABEL, OPCODE, OPERAND AND COMMENT (IF ANY) FIELDS. * 43950000 *. LOCATION OF EACH FIELD STORED IN AVMFLD_. LENGTH OF EACH * 43955000 *. FIELD STORED IN AVMFLDL_. TYPE OF EACH FIELD PLACED IN * 43960000 *. AVMFLDT_. FIELDS ARE SET TO ZERO IF NOT PRESENT. * 43965000 *. AVMFLDT1 CONTAINS '&' IF VARIABLE SYMBOL AND '.' IF SEQUENCE* 43970000 *. SYMBOL ELSE ZERO. AVMFLDT2 CONTAINS 'I' IF OPCODE IS * 43975000 *. SUSPECTED MACRO INSTRUCTION, 'M' IF MACRO OPCODE (AIF, * 43980000 *. AGO, SETA, ETC), 'O' IF OPCODE IS REGULAR ASSEMBLER OR * 43985000 *. MACHINE INSTRUCION AND X'00' IF ANYTHING ELSE. * 43990000 *. SCANS NON STND CONTINUATION FILDS AND PLACES VALUES IN * 43995000 *. AVMFLD5 THRU AVMFLD8 * 44000000 *. * 44005000 *. ENTRY CONDITIONS * 44010000 *. RA = @ OF FIRST CAHARACTER OF STATEMENT * 44015000 *. EXIT CONDITIONS * 44020000 *. RA = SAME AS ENTRY CONDITIONS * 44025000 *. RB = 4 IF COMMENT STATEMENT, 8 IF MACRO COMMENT, ELSE ZERO * 44030000 *. RC = @ OF OPCODTB ENTRY IF OPCODE = M OR O * 44035000 *. * 44040000 *. USES MACROS: $CALL, $SAVE, $RETURN, $SETRT * 44045000 *. USES DSECTS: AVWXTABL, OPCODTB * 44050000 *. CALLS ERRTAG,MCATRM,OPFIND S 44055000 *. NAMES: MAC----- OR MC------ S 44060000 *. BASE REGS: R13,RAT,RX,RC S* 44060200 *. WORK REGS: R1,R2,RA,RB,RW,RZ S* 44060300 *.********************************************************************* 44065000 SPACE 2 44070000 * * * * * REGISTER USAGE IN MACSCN * * * * * * * * * * * * * * * * * S 44070100 * R0 = SAVE REGISTER FOR RETURN @ IN MACSCSTR *2ND MINIMAL USED* J* 44070200 * R1 = TRT USAGE; ADDRESS REGISTER (HI-ORDER BYTE = 0). J* 44070300 * R2 = BYTE REGISTER (HI-ORDER 3 BYTES = 0); TRT USAGE. J* 44070400 * RW = PARENTHESES LEVEL COUNT IN SECTION MACSCSTR J* 44070500 * RX = @ RSBLOCK BEGIN SCANNED J* 44070600 * RY = 1 FOR SCANNING USAGE (BXH, ETC) J* 44070700 * RZ = SAVE REG FOR OPCODTB PTR * MINIMAL-USED REGISTER J* 44070800 * RA = SCAN POINTER J* 44070900 * RB = RETURN CODE USAGE J* 44071000 * RC,RD,RE = PARAMETER REGISTERS FOR EXTERNAL ROUTINES. J* 44071100 * R13 = SAVE AREA PTR; BASE REGISTER J* 44071200 * R13= BASE REGISTER, SAVE AREA PTR. J* 44071300 * RET,REP= USUAL LINKAGE, INCLUDING INTERNAL LINKAGE J* 44071400 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * S 44071500 EJECT S 44071600 MACSCN CSECT 44075000 $SAVE RGS=(R14-R6),SA=*,BR=13 44080000 USING AVWXTABL,RAT SET MAIN CONTROL TABLE USING 44085000 XSNAP LABEL='***MACSCN ENTERED***',IF=(AVMSNBY1,O,$MSNP03,TM) 44090000 MVC AVMFLD1($LAVMFLD),AWZEROS CLEAR FIELD POINTERS 44095000 SR RB,RB 44100000 LM R1,R2,AWZEROS CLEAR R1 AND R2 FOR TRT INST 44105000 ST RA,AVMTSCNP SAVE SCAN POINTER TEMPORARILY 44110000 * 44115000 LA RY,1 SET UP USEFUL VALUE FOR SCANNING J 44118600 * CHECK FOR PRESENCE OF COMMENT STATEMENT 44120000 * 44125000 CLI 0(RA),C'*' REGULAR COMMENT? 44130000 BNE MCMNT01 IF NOT, JUMP 44135000 LA RB,4 ELSE SET COMMENT STMNT FLAG 44140000 B MCSCNRT AND RETURN 44145000 MCMNT01 CLC 0(2,RA),=C'.*' MACRO COMMENT? 44150000 BNE MACLABSC IF NOT, JUMP AND START SCAN 44155000 LA RB,8 ELSE SET MACRO COMMENT FLAG 44160000 B MCSCNRT AND RETURN 44165000 * 44170000 * SET UP TRT TABLE TO SCAN FOR DELIMITERS 44175000 * 44180000 MACLABSC $SETRT (' ',4,'(',8,')',12,'''',16) 44185000 SPACE 2 44190000 * START SCAN FOR LABEL -- DETERMINE TYPE (VAR,SEQ OR NORMAL) S 44195000 * AND PROCESS ACCORDINGLY S 44195100 * S 44195200 CLI 0(RA),C' ' LABEL PRESENT? 44200000 BE MACOPCSC IF BLANK, JUMP AND SCAN OPCODE 44205000 ST RA,AVMFLD1 ELSE SAVE LABEL @ 44210000 CLI 0(RA),C'&&' VAR SYMBOL? 44215000 BE MACSCN02 IF YES, SCAN REST OF SYMBOL 44220000 CLI 0(RA),C'.' SEQ SYMBOL? 44225000 BE MACSCN02 IF YES, JUMP AND SCAN REST OF SYMBOL 44230000 SPACE 2 44235000 MACSCN01 BAL RET,MACSCSTR BRANCH AND SCAN STRING 44240000 B MACSCN03 44245000 SPACE 2 44250000 * SCAN VAR OR SEQ SYMBOL -- SETS AVMFLDT1 TO PROPER TYPE S 44250100 * S 44250200 MACSCN02 CLI 1(RA),C'0' FIRST CHAR IS A LETTER? 44255000 BNL MACSCN01 NOT ORD. SYMBOL IF NOT 44260000 TRT 1(8,RA),AWTSYMT SCAN SYMBOL 44265000 BZ MACSCN01 NOT SYMBOL, 9+ CHARS, RESUME SCAN 44270000 CLI 0(R1),C' ' DELIM = BLANK? 44275000 BNE MACSCN01 NO SYMBOL IF NOT 44280000 MVC AVMFLDT1(1),0(RA) SAVE TYPE 44285000 LR RA,R1 UPDATE SCAN POINTER 44290000 SPACE 2 44295000 * COMPUTE AND STORE CHARACTER LENGTH S 44295100 * S 44295200 MACSCN03 S RA,AVMFLD1 GET LENGTH OF FIELD 44300000 STC RA,AVMFLDL1 SAVE LENGTH 44305000 A RA,AVMFLD1 RESTORE SCAN POINTER 44310000 * 44315000 * SCAN FOR START OF OPCODE 44320000 * 44325000 MACOPCSC BAL RET,MACSCBLN SCAN FOR NON BLANK 44330000 ST RA,AVMFLD2 SAVE @ OF OPCODE 44335000 USING OPCODTB,RC ESTAB BASE FOR OPCODE ENTRY 44340000 $CALL OPFIND LEGAL OPCODE? 44345000 LTR RB,RB YES IF RB = 0 44350000 BNZ MACSCN04 IF NOT TREAT AS STRING 44355000 LR RZ,RC COPY OPCODTB @ TEMPORARILY 44360000 IC R2,OPCTYPE GET TYPE J 44365000 SRL R2,6 REMOVE ALL BUT 1ST 2 BITS J 44370000 IC R2,MACSTAB1(R2) GET TYPE: 'O' OR 'M' OF OPCODE J 44375000 STC R2,AVMFLDT2 SAVE THE TYPE VALUE FOR LATER USE J 44380000 B MACSCN06 44385000 MACSTAB1 DC AL1(C'O',C'O',C'M',C'O') OPCODE TYPE TABLES J 44386000 ORG *+0*($IA+$IS+$IM+$IB) REFER TO TYPES FOR XREF J 44387000 SPACE 2 44390000 MACSCN04 CLI 0(RA),C'0' FIRST CHAR < 0? 44425000 BNL MACSCN07 NO SYMBOL IF NOT 44430000 TRT 0(9,RA),AWTSYMT SCAN SYMBOL 44435000 BZ MACSCN07 9+ CHARS IF ZERO 44440000 CLI 0(R1),C' ' DELIM = BLANK? 44445000 BNE MACSCN07 NO SYMBOL IF NOT 44450000 MVI AVMFLDT2,C'I' SET MACRO INSTRUCTION FLAG 44455000 LR RA,R1 MOVE SCAN POINTER 44460000 B MACSCN06 BRANCH TO GET LENGTH 44465000 SPACE 2 44470000 MACSCN07 BAL RET,MACSCSTR SCAN OPCODE STRING 44475000 MACSCN06 S RA,AVMFLD2 GET LENGTH OF OPCODE 44480000 STC RA,AVMFLDL2 SAVE LENGTH 44485000 A RA,AVMFLD2 RESTORE SCAN POINTER 44490000 * 44495000 * NEXT SECTION FINDS AND SCANS OPERAND FIELD 44500000 * 44505000 L RX,AVRSBPT POINT TO RSBLOCK 44510000 USING RSBLOCK,RX SET USING ON RSBLOCK 44515000 BAL RET,MACSCOPR SCAN OPRND FIELD 44520000 MVC AVMFLD3(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44525000 BAL RET,MACSCHEK CHECK FOR NON STND CONT CARD 44530000 BAL RET,MACSCMMT SCAN COMMENT FIELD 44535000 MVC AVMFLD4(5),MACSCNFD MOVE DATE TO FIELD PNTRS 44540000 BAL RET,MACSCOPR SCAN NEXT OPRND(IF PRESENT) 44545000 MVC AVMFLD5(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44550000 BAL RET,MACSCHEK CHECK FOR 1 MORE NON STND CARD 44555000 BAL RET,MACSCMMT SCAN COMMENT 44560000 MVC AVMFLD6(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44565000 BAL RET,MACSCOPR SCAN 3RD OPRND(IF ANY) 44570000 MVC AVMFLD7(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44575000 L RB,AVSOLAST SET EOR @ FOR LAST COMMENT 44580000 BCTR RB,0 DECR FOR TRUE LENGTH 44585000 BAL RET,MACSCMMT SCAN COMMENT 44590000 MVC AVMFLD8(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44595000 B MCSCNFT AND FINI 44600000 SPACE 2 44605000 **--> INSUB: MACSCOPR FIND AND SCAN OPERAND + + + + + + + + + ++S 44605100 *+ THIS ROUTINE FINDS, SCANS, GETS ADDR AND LENGTH OF THE +S 44605150 *+ OPERAND FIELD +S 44605200 *+ +S 44605250 *+ EXIT CONDS: ADDR & LENGTH ARE PLACED IN APPROPRIATE +S 44605350 *+ PLACES IN TABLE. +S 44605400 *+ +S 44605450 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44605500 SPACE 2 S 44610000 MACSCOPR EQU * 44615000 ST RET,MACSCSAV SAVE RETURN @ 44620000 BAL RET,MACSCBLN SCAN FOR NONBLANK 44625000 ST RA,MACSCNFD SAVE @ OF OPRND 44630000 BAL RET,MACSCSTR SCAN OPRND 44635000 S RA,MACSCNFD SUBTRACT START @ 44640000 STC RA,MACSCNFL SAVE LENGTH 44645000 A RA,MACSCNFD RESTORE POINTER 44650000 L RET,MACSCSAV RESTORE RETURN @ 44655000 BR RET AND RETURN 44660000 SPACE 2 44665000 **--> INSUB: MACSCMMT SCAN COMMENT FIELD + + + + + + + + + + + +S 44670000 *+ THIS ROUTINE SCANS FOR NON-BLANK, CHECKS FOR CARD +S 44670100 *+ OVERRUN. IF OK, SAVES @ AND LENGTH OF FIELD. +S 44670200 *+ +S 44670300 *+ EXIT CONDS: ADDR & LENGTH ARE PLACED IN APPROPRIATE +S 44670400 *+ PLACES IN TABLE. +S 44670500 *+ +S 44670600 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44670700 SPACE 2 S 44670800 MACSCMMT EQU * 44675000 ST RET,MACSCSAV SAVE RETURN @ 44680000 MVC MACSCNFD(6),AWZEROS ZERO POINTER STORAGE 44685000 BAL RET,MACSCBLN SCAN FOR NON BLANK 44690000 CR RA,RB COMPARE WITH END OF RECORD 44695000 BNL MACSCMRT RETURN IF IN NEXT CARD IMAGE 44700000 ST RA,MACSCNFD ELSE SAVE @ 44705000 SR RB,RA GET LENGTH 44710000 STC RB,MACSCNFL SAVE LENGTH 44715000 AR RA,RB BUMP SCN PNTR TO BLNK BEYOND CMMT 44720000 MACSCMRT EQU * 44725000 L RET,MACSCSAV GERT RETRUN @ 44730000 BR RET AND RETURN 44735000 MACSCSAV DS F STORAGE FOR RETURN @ 44740000 MACSCNFD DS F TEMP STRORAE FOR LOCATION PNTR 44745000 MACSCNFL DS C TEMP STROAGE FOR FIELD LENGTH 44750000 MACSCNTY DS C TEMP STRGE FOR FIELD TYPE 44755000 SPACE 2 44760000 **--> INSUB: MACSCHEK CHECK FOR NON-STD COND CARD + + + + + + +S 44765000 *+ CHECKS FOR MACRO PROTOTYPE CONTINUATION CARDS (UP TO 3) +S 44765100 *+ +S 44765200 *+ EXIT CONDS: RB = PTR SET TO: +S 44765300 *+ 1. LAST CHAR ON ORIGINAL CARD (NOT CONTINUATION) +S 44765400 *+ 2. 1ST BYTE ON 2ND OR 3RD CARD (NON-STD CONT) +S 44765500 *+ +S 44765600 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44765700 SPACE 2 S 44765800 MACSCHEK EQU * 44770000 L RB,AVSOLAST GET EOR @ 44775000 BCTR RB,0 DECR TO BLANK PAST LAST CHAR 44780000 BCTR RA,0 DECR SCAN POINTER 44785000 CLI 0(RA),C',' STOP ON ','? 44790000 LA RA,1(RA) RESTORE SCAN POINTER 44795000 BCR NE,RET NOT NON-STND IF NO COMMA 44800000 CLI AVMFLDT2,C'I' POSSIBLE MACRO CALL? 44805000 BCR NE,RET ALSO RETURN IF NOT 44810000 LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 44815000 CR RA,RB COMPARE WITH SCAN POINTER 44820000 BCR NH,RET RETURN IF NOT HIGH 44825000 LA RB,RSOLC(RB) ELSE BYMP RB TO 3RD CARD 44830000 CR RA,RB COMPARE SCAN PONTR AGAIN 44835000 BCR NH,RET RETURN IF NOT HIGH 44840000 L RB,AVSOLAST ELSE LOAD EOR @ 44845000 BCTR RB,RET DECREM TO 1ST BLANK, BRANCH ALWAYS J 44850000 DROP RX 44860000 SPACE 2 44865000 **--> INSUB: MACSCBLN SCAN FOR NON-BLANK CHAR + + + + + + + + +S 44865100 *+ SCANS FOR NON-BLANK CHAR WITHOUT CARD OVERRUN +S 44865200 *+ +S 44865300 *+ ENTRY COND: RA = @ WHERE SCAN TO BEGIN +S 44865400 *+ EXIT COND: RA = @ OF 1ST NON-BLANK OR +S 44865500 *+ @ OF END OF RECORD +S 44865600 *+ +S 44865700 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44865800 SPACE 2 S 44865900 MACSCBLN EQU * SCAN FOR NON-BLANK S 44870000 MACBLN01 CLI 0(RA),C' ' BLANK? 44875000 BNE MACBLN02 IF NOT, NON BLANK FOUND 44880000 BXH RA,RY,MACBLN01 ELSE TRY AGAIN J 44885000 MACBLN02 C RA,AVSOLAST END OF RECORD? 44890000 BNL MCSCNFT IF YES, SCAN FINI, RETURN 44895000 BR RET ELSE RESUME STMNT SCAN 44900000 EJECT S 44905000 **--> INSUB: MACSCSTR SCAN ARBITRARY STRING + + + + + + + + + +S 44910000 *+ THIS SECTION IS A ROUTINE TO SCAN AN ARBITRARY +S 44915000 *+ STRING AND RETURN THE LENGTH. SCAN PTR IS LEFT +S 44915100 *+ AT BLANK FOLLOWING STRING. +S 44915200 *+ +S 44915300 *+ ENTRY COND: RA = @ OF BEGINNING OF STRING +S 44915400 *+ +S 44915500 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44915600 SPACE 2 S 44920000 MACSCSTR EQU * 44925000 LR R0,RET COPYRETURN @ 44930000 SR RW,RW CLEAR RW FOR PAREN COUNT 44935000 NI AVMBYTE1,X'FF'-$MINQUOT CLEAR QUOTE FLAG 44945000 SPACE 2 44950000 MACSTRT EQU * 44955000 TRT 0(200,RA),AWTZTAB SCAN STRING 44960000 B *(R2) BRANCH INTO TABLE FOR ROUTINE 44965000 B MCSCBLNK 44970000 B MCSCLPAR 44975000 B MCSCRPAR 44980000 B MCSCQUOT 44985000 SPACE 2 44990000 MCSCBLNK TM AVMBYTE1,$MINQUOT INSIDE QUOTE? 44995000 BO MCSCBLOK IF YES, PROCEED 45000000 LTR RW,RW INSIDE PARENS? 45005000 BP MCSCBLOK IF YES, PROCEED 45010000 LR RA,R1 ELSE UPDATE SCAN POINTER 45015000 LR RET,R0 RESTORE RETURN @ 45020000 BR RET AND RETURN TO STMNT SCAN 45025000 SPACE 2 45040000 MCSCLPAR AR RW,RY = LA RW,1(RW) BUMP PAREN COUNTER J 45045000 B MCSCBLOK GO TO BUMP SCAN PTR & CONTINUE S 45050000 SPACE 2 45060000 MCSCRPAR EQU * 45065000 BCTR RW,0 45070000 MCSCBLOK LA RA,1(,R1) BUMP SCAN PTR TO NEXT CHAR S 45075000 B MACSTRT RESUME SCAN 45080000 SPACE 2 45085000 MCSCQUOT C R1,AVSOLAST END OF RECORD? 45090000 BNL MCSCQU01 BRANCH AND PROCESS ERROR IF YES 45095000 CLI 1(R1),C'''' TWO QUOTES? 45100000 BE MCSCQTWO IF YES, JUMP AND PROCEED 45105000 LR RA,R1 MOVE SCAN POINTER 45110000 TM AVMBYTE1,$MINQUOT ARE WE IN SIDE QUOTED STRING? 45115000 BO MCSCQTRT IF YES, DON'T LOOK FOR ATTRIBUTE 45120000 BCTR RA,0 DEC POINTER FOR ATTERM 45125000 TRT 0(1,RA),AWTSYMT IS PREV CHAR ALPHA? 45130000 BNZ MCSCNOAT IF NOT CAN'T BE ATTRIBUTE 45135000 $CALL MCATRM IS IT AN ATTRIBUTE? 45140000 LTR RB,RB ATTRIBUTE IF RB=0 45145000 BZ MACSTRT IF YES THEN RESUME SCAN 45150000 BP MCSCQTWO IF ATTRIB NOT IMPLEMENTED RESUME SCA 45155000 MCSCNOAT AR RA,RY = LA RA,1(RA) RESTORE POINTER J 45160000 TM AVMBYTE1,$MINQUOT ARE WE INSIDE QUOTES? 45165000 BO MCSCQTRT IF YES RESET TRT TABLE 45170000 $SETRT ('(',0,')',0,' ',0) ELSE TURN OFF TRT FOR QUOTE STRNG 45175000 B MCSCQUFT 45180000 MCSCQTRT $SETRT (' ',4,'(',8,')',12) RESET TRT FOR END OF QUOTE STRNG 45185000 MCSCQUFT XI AVMBYTE1,$MINQUOT FLIP QUOTE FLAG 45190000 BXH RA,RY,MACSTRT BUMP SCAN PTR, BRANCH ALWAYS J 45195000 MCSCQTWO LA RA,2(R1) BUMP SCAN POINTER PAST DOUBLE ' 45205000 B MACSTRT RESUME SCAN 45210000 SPACE 2 45215000 MCSCQU01 EQU * 45220000 NI AVMBYTE1,X'FF'-$MINQUOT TURN OFF QUOTE FLAG 45225000 BCTR R1,0 DEC R1 45230000 LR RA,R1 COPY R1 INTO SCAN POINTER 45235000 LA RB,$ERNODLM SET NO DELIM FLAG 45240000 $CALL ERRTAG FLAG STATEMENT 45245000 LA RB,8 INDICATE MACRO COMMENT 45250000 B MCSCNERR AND RETURN 45255000 SPACE 4 45260000 * RETURN SEQUENCE FOR MACSCN -- SETS RETURN CODES S 45260100 * AND RESETS TABLES, ETC. S 45260200 * S 45260300 MCSCNFT EQU * 45265000 SR RB,RB CLEAR RB FOR NORMAL RETURN 45270000 MCSCNERR EQU * 45275000 $SETRT (' ',0,'(',0,')',0,'''',0) CLEAR TRT TABLE 45280000 MCSCNRT EQU * 45285000 LR RC,RZ RESTORE OPCODTB @ TO RC FOR RETURN 45290000 L RA,AVMTSCNP RESTORE SCAN POINTER 45295000 XSNAP LABEL='***MACSCN EXITED***',IF=(AVMSNBY1,O,$MSNP03,TM), #45300000 STORAGE=(*AVMFLD1,*AVMBYTE5) 45305000 $RETURN RGS=(R14-R6) 45310000 DROP RAT,RC,R13 45315000 LTORG 45320000 TITLE '*** MCSCOP - STANDARD VALUE SCANNER ***' 45325000 **--> CSECT: MCSCOP THIS ROUTINE SCANS A MACRO INSTRUCTION * 45330000 *. OPERAND. THE OPERAND MUST CONFORM TO A STANDARD VALUE AS * 45335000 *. LAID DOWN IN SECTION 8 OF IBM GC28-2514 * 45340000 *. * 45345000 *. ENTRY CONDITIONS * 45350000 *. AVMBYTE1: FLAG $MSBLIST EXPECTED SET IF ALREADY INSIDE SUBLISS 45355000 *. * 45360000 *. EXIT CONDITIONS * 45365000 *. RA = DELIM PAST OPRND IF STND VALUE ELSE POINTS AT ERROR * 45370000 *. RB = 0 IF STANDARD VALUE ELSE $ER MESSAGE * 45375000 *. RC = LENGTH OF OPERAND IF OKAY * 45380000 *. RD = TYPE OF OPERAND. IN THIS CASE TYPE WILL BE ONE OF * 45385000 *. 'O' (NULL), 'N' (SELF-DEFINING TERM) OR 'U' (ALL OTHERS) * 45390000 *. CAN BE 'S' AFTER SCANNING (1ST SUBPOPERAND S 45391000 *. RE = VALUE OF SELF DEFINING TERM * 45395000 *. AVMBYTE1: FLAG $MINQUOT HAS INDETERMINATE VALUE. S 45396000 *. USES MACROS: $SAVE, $RETURN, $SETRT, $CALL * 45400000 *. USES DSECTS: AVWXTABL * 45405000 *. CALLS SDBCDX * 45410000 *. * 45415000 *.********************************************************************* 45420000 SPACE 4 45425000 * * * * * * * * * * REGISTER USAGE IN MCSCOP * * * * * * * * * * * * S 45427000 * R0 = TEMPORARY SAVE REGISTER FOR SCAN POINTER. S 45427100 * R1 = SCAN POINTER FROM TRT INSTRUCTIONS. S 45427200 * R2 = BYTE REGISTER, TRT USAGE. S 45427300 * RA = NORMAL SCAN POINTER. S 45428000 * RB = RETURN CODE REGISTER. S 45428100 * RC = RETURN LENGTH REGISTER. S 45428200 * RD = FLAG REGISTER FOR TYPE: 'U', 'N', 'O', OR 'S' . S 45428300 * RE = PARENTHESES NEST LEVEL COUNTER; SELF-DEF TERM VALUE RETURN. S 45428400 * R13= BASE REGISTER. S 45428500 * R14= INTERNAL LINK REGISTER. S 45428600 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * S 45428800 SPACE 2 S 45428900 MCSCOP CSECT 45430000 $SAVE RGS=(R14-R2),SA=*,BR=13 45435000 USING AVWXTABL,RAT 45440000 XSNAP LABEL='***MCSCOP ENTERED***',IF=(AVMSNBY1,O,$MSNP04,TM) 45445000 NI AVMBYTE1,X'FF'-$MINQUOT TURN OFF QUOTE FLAG 45450000 LA RD,C'U' SET UNDEFINED FLAG FOR STARTS 45455000 BAL R14,MCSET1 SET TRT TABLE FOR CORRECT SCANNING J 45460000 SR RE,RE USE RE AS PAREN COUNTER 45465000 SR R1,R1 A 45467000 SR R2,R2 CLEAR R2 FOR TRT USE 45470000 LR R0,RA COPY SCAN POINTER 45475000 TRT 0(1,RA),AWTDECT POSSIBLE SDTERM? 45480000 BZ MCOPSDTM DECIMAL TERM IF CC = 0 45485000 C R2,AWF4 IS IT B, C OR X? 45490000 BE MCOPSDTM POSSIBLE IF EQUAL TO 4 45495000 B MCOPSTRT SKIP AROUND SCAN POINTER BUMP FIRSTJ 45496000 MCOPSTRS LA RA,1(,R1) SET SCAN PTR 1 BEYOND LAST TRT END J 45498000 MCOPSTRT EQU * 45500000 TRT 0(200,RA),AWTZTAB START SCAN 45505000 B *(R2) JUMP TO TABLE OF BRANCHES 45510000 B MCOPQUOT 45515000 B MCOPLPAR 45520000 B MCOPRPAR 45525000 B MCOPEQUL 45530000 B MCOPAMPR 45535000 B MCOPSCFT 45540000 B MCOPBLNK 45545000 SPACE 2 45550000 MCOPQUOT EQU * COME HERE FOR ' A 45555000 CLI 1(R1),C'''' TWO QUOTES IN ROW? 45565000 BE MCOPQTWO IF YES, JUMP AN PROCESS 45570000 TM AVMBYTE1,$MINQUOT 45575000 BO MCOPINQU 45580000 LA R2,2 A 45585000 SR R1,R2 A 45590000 CLI 1(R1),C'L' A 45595000 BNE MCOPQU11 A 45600000 TRT 0(1,R1),AWTSYMT CHACK CHARACTER 45605000 BZ MCOPQU11 IF LETTER THEN IS NOT L' 45610000 TRT 3(1,R1),AWTSYMT CHAR AFTER L' = ALPHA? 45615000 BNZ MCOPQU11 IF NOT, JUMP OUT 45620000 CLI 3(R1),C'Z' CHAR GREATER THAN Z? 45625000 BH MCOPQU11 IF YES, CANT BE ALPAH 45630000 CLI 0(R1),C'&&' IS IT AN AMPERSAND? 45635000 BE MCOPQU11 IF YES, NOT L' 45640000 LA RA,3(R1) BUMP SCAN POINTER 45645000 B MCOPSTRT RESUME SCAN 45650000 SPACE 2 45655000 MCOPQTWO LA RA,2(R1) BUMP SCAN POINTER PAST '' 45660000 B MCOPSTRT 45665000 SPACE 2 45670000 MCOPQU11 AR R1,R2 RESTORE SCAN PTR TO ' FOUND A 45675000 * THE $SETRT MACRO IS USED TO CLEAR THE AWTZTAB TABLE FOR SCAN OF 45695000 * A QUOTED STRING 45700000 IC RB,AWTZTAB+C',' SAVE CURRENT COMMA STATUS ACRS ' J 45701000 BAL R14,MCSET2A SET FOR INSIDE QUOTED STRING -ZERO J 45705000 B MCOPQU02 45710000 * WHEN END OF QUOTED STRING HAS BEEN REACHED, AWTZTAB IS RESTORED 45715000 * SO THAT NORMAL SCAN CAN CONTINUE 45720000 MCOPINQU BAL R14,MCSET1A RESET, NO LONGER INSIDE QUOTED STRNJ 45725000 STC RB,AWTZTAB+C',' RESTORE ORIGINAL COMMA STATUS J 45729000 MCOPQU02 XI AVMBYTE1,$MINQUOT FLIP QUOTE FLAG 45730000 B MCOPSTRS GO BACK TO INCREMENT PTR AND SCAN J 45735000 SPACE 2 45745000 MCOPLPAR CR R1,R0 BEGINNING OF OPERAND? 45765000 BNE MCOPLP01 IF NOT, PROCEED 45770000 L RD,=C' S' ELSE SET SUBLIST FLAG 45775000 MCOPLP01 LA RE,1(RE) BUMP PAREN COUNTER 45780000 $SETRT (',',0) COMMAS OK INSIDE PARENS 45785000 B MCOPSTRS GO AND BUMP SCAN PTR BY 1 A 45795000 SPACE 2 45800000 MCOPRPAR BCT RE,MCOPRP01 DECR PAREN COUNTER 45805000 $SETRT (',',24) RESET TRT TABLE IF ZERO 45810000 B MCOPRP02 45815000 MCOPRP01 LTR RE,RE TEST PAREN COUNT 45820000 BNM MCOPRPFT IF NOT MINUS, OKAY 45825000 TM AVMBYTE1,$MSBLIST ARE WE IN SUBLIST 45830000 BO MCOPSCFT IF YES, OKAY. END OF SUBLIST 45835000 MCOPRER1 LA RB,$ERVSYNT SET SYNTAX ERROR 45840000 LR RA,R1 SET SCAN POINTER 45845000 B MCOPSCRT 45850000 MCOPRPFT EQU MCOPSTRS SAME AS PREVIOUS LABEL: BUMP PTR J 45855000 SPACE 2 45865000 MCOPRP02 C RD,=C' S' ARE WE IN SUBLIST? 45870000 BNE MCOPRPFT IF NOT, PROCEED 45875000 CLI 1(R1),C',' END OF OPERAND? 45880000 BE MCOPRPFT IF YES, PROCEED 45885000 CLI 1(R1),C' ' END OF OPERAND? 45890000 BE MCOPRPFT 45895000 LA RD,C'U' INSERT UNDEFINED FLAG 45900000 B MCOPRPFT CONTINUE SCAN 45905000 SPACE 4 45910000 MCOPEQUL CR R1,R0 AT START OF OPERAND? 45915000 BE MCOPEQ01 IF YES, OKAY 45920000 LTR RE,RE ELSE ARE WEIN PARENS? 45925000 BZ MCOPRER1 ERROR IF NOT 45930000 MCOPEQ01 EQU MCOPSTRS SAME AS PREVIOUS LABEL, SKIP THERE J 45935000 B MCOPSTRS BRANCH THERE, IF FLLA THRU HERE J 45940000 SPACE 4 45945000 MCOPAMPR CLI 1(R1),C'&&' TWO AMPERSANDS? 45950000 BE MCOPQTWO IF YES USE DOUBLE QUOTE CODE 45955000 CR R0,R1 BEGINNING OF OPERAND? 45960000 BE MCOPEQ01 IF YES USE = CODE 45965000 B MCOPRER1 ELSE ERROR, USE RPAR CODE 45970000 SPACE 2 45975000 MCOPSDTM EQU * 45980000 $CALL SDBCDX CALL SELF-DEFINING TERM ROUTINE 45985000 LTR RB,RB WAS IT SD TERM 45990000 BNZ MCOPSTRT JUMP IF NOT REALY SELF-DEF TERM JRM 45995000 CLI 0(RA),C',' NORMAL DELIM AFTER SDTERM? 46000000 BE MCOPSDT1 PROCEED IF YES 46005000 CLI 0(RA),C' ' DELIM = ' '? 46010000 BE MCOPSDT1 PROCEED IF YES 46015000 CLI 0(RA),C')' DELIM IS A ')'? 46020000 BNE MCOPSDT2 IF NOT, START SCAN OVER 46025000 TM AVMBYTE1,$MSBLIST SCANNING SUBLIST? 46030000 BO MCOPSDT1 RIGHT PAREN OKAY IF SO 46035000 MCOPSDT2 EQU * 46040000 LM RC,RD,AWZEROS CLEAR RC, RD AFTER SDDTERM 46045000 LR RA,R0 RESTORE SCAN POINTER TO RESUME SCAN 46050000 B MCOPSTRT 46055000 MCOPSDT1 EQU * 46060000 LR R1,RA MOVE SCAN POINTER INTO R1 46065000 LA RD,C'N' SET SELF DEF TERM FLG 46070000 LR RE,RC MOVE VALUE OF SDTERM INTO RE 46075000 B MCOPSCFT 46080000 SPACE 2 46085000 MCOPBLNK EQU * 46090000 LTR RE,RE ARE WE IN PARENS 46095000 BZ MCOPSCFT IF NOT, FINI 46100000 LA RB,$ERNODLM ELSE SET WRONG DELIM FLAG 46105000 B MCOPSCRT AND RETURN 46110000 SPACE 4 46115000 MCOPSCFT LR RA,R1 MOVE SCAN POINTER 46120000 LR RC,R1 COPPY POINTER 46125000 SR RB,RB CLEAR RB FOR FLAG USE 46130000 C RD,=C' S' SUBLIST? 46135000 BNE MCOPSCF1 SKIP IF NOT 46140000 TM AVMBYTE1,$MSBLIST IN SUBLIST FLAG ON? 46145000 BNO MCOPSCF1 SKIP IF NOT 46150000 LA RD,C'U' ELSE SET UNEFINED FLAG 46155000 MCOPSCF1 EQU * 46160000 SR RC,R0 GET LENGTH OF OPERAND 46165000 BNZ MCOPSCRT JUMP AROUND IN NOT ZERO 46170000 LA RD,C'O' ELSE SET NULL FLAG 46175000 MCOPSCRT BAL R14,MCSET2 RESET ALL VALUES CHANGED IN TRT TB J 46180000 XSNAP LABEL='***MCSCOP EXITED*** ',IF=(AVMSNBY1,O,$MSNP04,TM) 46185000 $RETURN RGS=(R14-R2) 46190000 SPACE 2 J 46191000 **--> INSUB: MCSET# MODIFY TRT TABLE AWTZTAB + + + + + + + + + + S 46191100 MCSET1 $SETRT ('''',4) SET TO CATCH ' , AND THEN OTHER CHARS J 46191300 MCSET1A $SETRT ('(',8,')',12,'=',16,'&&',20,',',24,' ',28) OTHER CHRSJ 46191400 BR R14 RETURN TO CALLER J 46191500 SPACE 1 J 46192000 MCSET2 $SETRT ('''',0) RESET ' TO 0, THEN OTHERS J 46192100 MCSET2A $SETRT ('(',0,')',0,'=',0,'&&',0,',',0,' ',0) RESET OTHERS J 46192200 BR R14 RETURN TO CALLER J 46192300 DROP RAT,R13 46195000 LTORG 46200000 TITLE '*** MACFND - SEARCHES DICTIONARIES FOR VARIABLE ***' 46205000 **--> CSECT: MACFND THIS ROUTINE IS GENERAL SEARCH PROCEDURE * 46210000 *. WHICH CAN SCAN THE MACRO LIBRARY, GLOBAL AND LOCAL * 46215000 *. DICTIONARIES AND THE SYMBOLIC PARAMETER LIST. THE CALLING * 46220000 *. ROUTINE DETERMINES WHICH LIBRARY BY PLACING THE APPROPRIATE * 46225000 *. POINTER IN RC. * 46230000 *. * 46235000 *. ENTRY CONDITIONS * 46240000 *. RC = @ OF FIRST ENTRY OF LIST TO BE SEARCHED * 46245000 *. * 46250000 *. EXIT CONDITIONS * 46255000 *. RB = 0 IF ENTRY IS FOUND * 46260000 *. = $ERUNDEF IF ENTRY IS NOT FOUND * 46265000 *. RC = @ OF ENTRY IF FOUND ELSE @ OF FINAL ENTRY IF NOT FOUND * 46270000 *. USES MACROS: $SAVE, $RETURN * 46275000 *. USES DSECTS: MACLIB, AVWXTABL * 46280000 *. * 46285000 *.REGISTER USAGE A 46285100 *.RC-MACLIB BASE REGISTER, LIST TO BE SEARCHED A 46285200 *.RAT- MAIN TABLE DSECT USING A 46285300 *.RB-RETURN REGISTER A 46285400 *. A 46285500 *. NAMES=MACFN___ A 46285600 *. A 46285700 *. * 46290000 *.********************************************************************* 46295000 SPACE 2 46300000 MACFND CSECT 46305000 $SAVE SA=NO 46310000 USING AVWXTABL,RAT 46315000 XSNAP LABEL='***MACFND ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP05X46320000 ,TM) 46325000 USING MACLIB,RC USE MACLIB AS REPRESENTATIVE DSECT 46330000 LTR RC,RC CHECK FOR NULL (MAYBE OPEN CDE) J 46331000 BZ MACFNDRU SKIP IF NULL LIST J 46332000 SR RB,RB 46335000 B MACFND02 JUMP TO COMPARE FIRST ENTRY 46340000 MACFND01 L RC,MCLIBNXT GET @ OF NEST ENTRY 46345000 MACFND02 CLC AVMSYMBL,MCLBNAM COMPARE NAME WITH GLOBAL SYMBOL 46350000 XSNAP LABEL='IN MACFND LOOP RC # LIB',STORAGE=(*0(RC),*30(RC)) 46350100 BE MACFNDRT IF EQUAL RETURN 46355000 CL RB,MCLIBNXT FINAL ENTRY? 46360000 BNE MACFND01 IF NOT, TRY AGAIN 46365000 MACFNDRU LA RB,$ERUNDEF SHOW UNDEFINED SYMBOL J 46370000 MACFNDRT EQU * 46375000 XSNAP LABEL='***MACFND EXITED***',IF=(AVMSNBY1,O,$MSNP05,TM) 46380000 $RETURN SA=NO 46385000 DROP RAT,RC,REP 46390000 LTORG 46395000 TITLE '***MCVSCN - VARIABLE SYMBOL SCANNER ***' 46400000 **--> CSECT: MCVSCN THIS ROUTINE SCANS A STRING AND CHECKS * 46405000 *. FOR A LEGAL VARIABLE SYMBOL. IF OKAY, SYMBOL IS MOVED INTO * 46410000 *. AVMSYMBL IN AVWXTABL WHERE IT WILL BE UTILIZED IN SEARCHES. * 46415000 *. * 46420000 *. ENTRY CONDITIONS * 46425000 *. RA = @ OF FIRST CHARACTER OF STRING * 46430000 *. * 46435000 *. EXIT CONDITIONS * 46440000 *. RA = @ OF DELIMITER PAST SYMBOL IF LEGAL * 46445000 *. = SAME AS ENTRY IF NOT VARIABLE SYMBOL * 46450000 *. RB = 0 IF OKAY, <0 IF NOT VARIABLE SYMBOL, * 46455000 *. = $ER MESSAGE IF ILLEGAL SYMBOL * 46460000 *. USES MACROS: $SAVE, $RETURN * 46465000 *. USES DSECTS: AVWXTABL * 46470000 *. * 46475000 *.REGISTER USAGE A 46475100 *.RAT- MAIN TABLE DSECT USING A 46475200 *.R1,R2 USED IN TRT'S A 46475300 *.RB- SET AS IN EXIT CONDITIONS ABOVE A 46475400 *. A 46475500 *.NAMES=MCVS____ A 46475600 *. A 46475700 *.********************************************************************* 46480000 SPACE 2 46485000 MCVSCN CSECT 46490000 $SAVE RGS=(R0-R2),SA=NO 46495000 USING AVWXTABL,RAT 46500000 XSNAP LABEL='***MCVSCN ENTERED***',T=NO,STORAGE=(*AVMSYMBL,*AVX46505000 MSYMBL+10),IF=(AVMSNBY1,O,$MSNP05,TM) 46510000 LM R1,R2,AWZEROS ZERO R1, R2, FOR TRT USE 46515000 LR R0,RA COPY SCAN POINTER 46520000 CLI 0(RA),C'&&' STARTS WITH '&'? 46525000 BNE MCVSCNOT IF NOT, NO VAR SYMBOL 46530000 CLI 1(RA),C'0' 2ND CHAR = ALAPHA? 46535000 BNL MCVSCNER IF NOT, ERROR 46540000 TRT 1(8,RA),AWTSYMT SCAN RMNDER OF SYMBOL 46545000 BZ MCVSCNER IF ZERO, 9+ CHARS LONG, ERROR 46550000 SR R1,R0 GET LENGTH OF SYMBOL 46555000 AR R0,R1 BUMP SCAN & 46560000 STC R1,AVMSYMLN SAVE LENGTH IN GLOBAL AREA 46565000 BCT R1,MCVSCN01 DECR FOR EX BUT FALL THROUGH IF ZER 46570000 B MCVSCNER ERROR IF LENGTH = 1 46575000 MCVSCN01 MVC AVMSYMBL,AWBLANK BLANK GLOBAL AREA 46580000 EX R1,MCVSMOVE MOVE SYMBOL INTO GLOBAL AREA 46585000 LR RA,R0 BUMP SCAN POINTER 46590000 SR RB,RB 46595000 B MCVSCNRT 46600000 MCVSCNOT L RB,AWFM4 SET NO SYMBOL FLAG 46605000 B MCVSCNRT 46610000 MCVSCNER LA RB,$ERINVSY SET INVALID SYMBOL FLAG 46615000 MCVSCNRT EQU * 46620000 XSNAP LABEL='***MCVSCN EXITED***',IF=(AVMSNBY1,O,$MSNP05,TM) 46625000 $RETURN RGS=(R0-R2),SA=NO 46630000 MCVSMOVE MVC AVMSYMBL(0),0(RA) DUMMY TO MOVE SYMBOL IN EX INST 46635000 DROP RAT,REP 46640000 LTORG 46645000 TITLE '***MCSYSR - DICTIONARY SEARCH ROUTINE***' 46650000 **--> CSECT: MCSYSR SCANS SUSPECTED VARIABLE SYMBOL FOR LEGALITY. * 46655000 *. IF VARIABLE SYMBOL THEN PLACES IN AVMSYMBL. THEN SEARCHES * 46660000 *. GLOBAL, LOCAL AND SYMBOLIC PARAMETER DICTIONARIES FOR SYMBOL* 46665000 *. * 46670000 *. ENTRY CONDITIONS * 46675000 *. RA = @ OF FIRST CHARACTER OF SYMBOL * 46680000 *. * 46685000 *. EXIT CONDITIONS * 46690000 *. RA = @ OF DELIMITER PAST VARIABLE SYMBOL IF OKAY * 46695000 *. = SAME AS ENTRY IF NOT VARIABLE SYMBOL OR IF NOT FOUND * 46700000 *. RB = $ERUNDEF IF SYMBOL IS NOT FOUND * 46705000 *. RB = 0 IF SYMBOL IS FOUND IN ONE OF THE DICTIONARIES * 46710000 *. = SET TO -4 IF RA DOES NOT POINT AT VARIABLE SYMBOL * 46715000 *. RC = POINTER TO SYMBOL ENTRY IF FOUND * 46720000 *. RD = $GLOBAL IF SYMBOL PRESENT IN GLOBAL DICTIONARY * 46725000 *. = $LOCAL IF SYMBOL FOUND IN LOCAL DICTIONARY * 46730000 *. = $SYMPAR IF SYMBOL IS SYMBOLIC PARAMETER * 46735000 *. = $SYSTEM IF SYMBOL IS SYTEM VARIABLE * 46740000 *. * 46745000 *. USES MACROS: $CALL, $SAVE, $RETURN * 46750000 *. USES DSECTS: MCGLBDCT, MACLIB,AVWXTABL * 46755000 *. CALLS MCVSCN, MACFND * 46760000 *. A 46760100 *.REGISTER USAGE *************** A 46760200 *.R13 -BASE REGISTER AND SAVEAREA POINTER A 46760300 *.RC- BASE REGISTER FOR GLOBAL DSECT A 46760400 *.RX- BASE REGISER FOR MACRO DICTIONARY A 46760500 *. A 46760600 *.NAMES=MCSY____ A 46760700 *. A 46760800 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 46765000 SPACE 2 46770000 MCSYSR CSECT 46775000 $SAVE RGS=(R14-R0),SA=*,BR=13 46780000 USING AVWXTABL,RAT SET MAIN TABLE USING 46785000 XSNAP LABEL='***MCSYSR ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP06X46790000 ,TM) 46795000 USING MCGLBDCT,RC USE GLOBAL DSCT AS DUMMY FOR SEARCH 46800000 USING MACLIB,RX RX POINTS TO CURRENT MACLIB ENTRY 46805000 LR R0,RA COPY SCAN POINTER 46810000 SR RD,RD CLEAR RD FOR RETURN CODE 46815000 $CALL MCVSCN SCAN SYMBOL 46820000 LTR RB,RB VAR SYMBOL? 46825000 BZ MCSY01 PROCEED IF YES 46830000 L RB,AWFM4 ELSE SET NO SYMBOL FLAG 46835000 B MCSYFT AND RETURN 46840000 SPACE 46845000 *.VARIABLE SYMBOL FOUND SEARCH PARAM DICTIONAY A 46845100 *. A 46845200 MCSY01 EQU * 46850000 L RC,MCPARPNT GET PNTR TO PARAM LIST 46855000 $CALL MACFND SCAN PARAM DICT. 46860000 LTR RB,RB SYMBOL F6UND? 46865000 BNZ MCSY02 IF NOT PROCEED WITH GLOBAL SEARCH 46870000 LA RD,$SYMPAR ELSE SET PARAMETER FLAG 46875000 CLI MCGLBTYP,C'S' CHECK IF SYSTEM VARIABLE 46880000 BNE MCSYFT RETURN IF NOT 46885000 LA RD,$SYSVAR ELSE SET SYSTEM FLAG 46890000 B MCSYFT AND RETURN 46895000 SPACE 46900000 *.NOT IN PARM DICTIONARY, SEARCH GLOBAL DICTIONARY A 46900100 *. A 46900200 MCSY02 EQU * 46905000 L RC,AVMGDICT GET PNTR TO GLOBAL DICTIONARY 46910000 $CALL MACFND SEARCH DICTIONARY 46915000 LTR RB,RB SYMBOL FOUND? 46920000 BNZ MCSY03 PROCEED WITH PARAM SEARCH IF NOT 46925000 CLC MCGLBDEF,AVMMACID GLOBAL DECLARED THIS DEFINITION? 46930000 BNE MCSY03 IF NOT, PROCEED AND SEARCH LOCAL DIC 46935000 LA RD,$GLOBAL SET GLOBAL TYPE FLAG 46940000 B MCSYFT AND RETURN 46945000 SPACE 46950000 *.NOW CHECK LOCAL DICTIONARY A 46950100 *. A 46950200 MCSY03 EQU * 46955000 LA RD,$LOCAL SET LOCAL FLAG 46960000 L RC,MCDDVPNT GET LOCAL DICT @ 46965000 $CALL MACFND SEARCH LOCAL DICTIONARY 46970000 LTR RB,RB SYMBOL FOUND? 46975000 BZ MCSYFT IF YES, RETURN 46980000 LR RA,R0 ELSE RESTORE SCAN POINTER FIRST 46985000 MCSYFT EQU * 46990000 XSNAP LABEL='***MCSYSR EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 46995000 $RETURN RGS=(R14-R0) 47000000 DROP RAT,RC,RX,R13 47005000 LTORG 47010000 TITLE '***MCDTRM - CONVERTS DECIMAL TO BINARY***' 47015000 **--> CSECT: MCDTRM DECIMAL CONSTANT CONVERSION. MCDTRM DECIDES * 47020000 *. SCAN POINTER IS POINTING AT LEGAL DECIAMAL TERM AND IF SO, * 47025000 *. CONVERTS TO BINARY FORM. HANDLES VALUES UP TO 2**31-1 * 47030000 *. * 47035000 *. ENTRY CONDITIONS * 47040000 *. RA = @ OF FIRST CHAR OF TERM * 47045000 *. * 47050000 *. EXIT CONDITIONS * 47055000 *. RA = @ OF DELIMITER BEYOND CONSTANT * 47060000 *. = SAME AS ENTRY IF ERROR * 47065000 *. RB = 0 IF CONSTANT WAS LEGAL * 47070000 *. = $ER MSSGE IF ILLEGAL TERM * 47075000 *. RC = VALUE OF CONSTANT, 0 TO 2**31-1 * 47080000 *. * 47085000 *. USES DSECTS: AVWXTABL * 47090000 *. USES MACROS: $SAVE, $RETURN * 47095000 *.REGISTER USAGE A 47095100 *.R12 -BASE REG A 47095200 *.RAT-MAIN TABLE DSECT USING A 47095300 *.RD- SCAN POINTER A 47095400 *. A 47095500 *.NAMES=MCD_____ A 47095600 *. A 47095700 *** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 47100000 SPACE 4 47105000 MCDTRM CSECT 47110000 $SAVE RGS=(R0-R2),SA=NO 47115000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 47120000 XSNAP LABEL='***MCDTRM ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP06X47125000 ,TM) 47130000 LR RD,RA COPY SCAN POINTER 47135000 SR R1,R1 USE IN TRT INST 47140000 TRT 0(11,RD),AWTDECT TRANSLATE WITH DEC TABLE 47145000 BZ MCDTRMR1 ERROR IF MORE THAN 10 DIGITS 47150000 BM MCDTRM01 < 10 DIGITS, PROCEED 47155000 CLC 0(10,RA),=C'2147483647' 10 DIGIT NUMBER WITHIN RANGE? 47160000 BH MCDTRMR1 ERROR IF GREATER 47165000 MCDTRM01 EQU * 47170000 LR RA,R1 UPDATE SCAN POINTER 47175000 SR R1,RD GET LENGTH 47180000 BZ MCDTRMR1 ILLEGAL IF ZERO LENGTH 47185000 BCTR R1,0 GET LENGTH-1 FOR EX INST 47190000 EX R1,MCDECPAK PACK CHARS 47195000 CVB RC,AVDWORK1 CONVERT THE NIMBER 47200000 SR RB,RB SHOW NO ERRORS 47205000 MCDTRMRT EQU * 47210000 XSNAP LABEL='***MCDTRM EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47215000 $RETURN RGS=(R0-R2),SA=NO 47220000 MCDTRMR1 LA RB,$ERSDINV SET ILLEGAL NUMBER FLAG 47225000 B MCDTRMRT AND RETURN 47230000 MCDECPAK PACK AVDWORK1(8),0(0,RD) PACK DEC CHARS 47235000 LTORG 47240000 DROP RAT 47245000 TITLE '***MCGTST - CHARSTRING STORE ROUTINE***' 47250000 **--> CSECT: MCGTST THIS ROUTINE TAKES A STRING AS DELINEATED BY * 47255000 *. BEGINNING AND END POINTERS, OBTAINS STORAGE DYNAMICALLY AND * 47260000 *. MOVES THE STING. IF INSIDE QUOTES DOUBLE QUOTES WILL BE * 47265000 *. CRUNCHED TO ONE QUOTE * 47270000 *. * 47275000 *. ENTRY CONDITIONS * 47280000 *. RA = @ OF FIRST CAHRACTER OF STRING * 47285000 *. RB = @ OF DELIMITER PAST STRING * 47290000 *. * 47295000 *. EXIT CONDITIONS * 47300000 *. RA = @ OF DELIMITER PAST STRING * 47305000 *. RC = @ OF STRING IN NEW STORAGE * 47310000 *. RD = LENGTH OF STRING * 47315000 *. * 47320000 *. USES MACROS: $SAVE, $RETURN, $ALLOCL * 47325000 *. USES DSECTS: AVWXTABL * 47330000 *. * 47335000 *. REGISTER USAGE A 47335100 *. RAT-MAIN TABLE USING A 47335200 *. RA,RB,RC,RD-AS IN ENTR/EXIT CONDITIONS A 47335300 *. RE,R1,R3-WORK REGISTERS A 47335600 *** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 47340000 SPACE 2 47345000 MCGTST CSECT 47350000 $SAVE RGS=(R0-R3),SA=NO 47355000 USING AVWXTABL,RAT 47360000 XSNAP LABEL='***MCGTST ENTERED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47365000 CR RA,RB NULL STRING? 47370000 BE MCGTSTF SKIP OUT IF NULL STRING S 47375000 LR RE,RB COPY END DELIM 47395000 SR RE,RA GET LENGTH 47400000 LR RD,RE COPY LENGTH 47405000 LA RE,3(RE) GET NEXT FULL WORD PLUS A 47410000 SRL RE,2 47415000 SLL RE,2 TRUNCATE TO FULL WORD 47420000 $ALLOCL RC,RE,MCGTOVR OBTAIN STORAGE FOR STRING 47425000 LR RE,RD COPY ORIGINAL LENGTH 47430000 BCTR RE,0 DECR FOR EX INST 47435000 EX RE,MCGTMV MOVE STRING INTO STORAGE 47440000 TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 47445000 BNO MCGTSTFT IF NOT, RETURN 47450000 LR R1,RC GET @ OF STIRNG START 47455000 LR R3,R1 47460000 AR R3,RE GET @ OF END OF STRING 47465000 BCTR R3,0 DECR TO SECOND LAST CHAR 47470000 LA R2,1 USE R2 AS INDEX 47475000 MCGTST02 EQU * 47480000 CLI 0(R1),C'''' QUOTE? 47485000 BCTR RE,0 REDUCE RMNDR COUNT 47490000 BE MCGTST03 SQUEEZE QUOTE IF YES 47495000 BXLE R1,R2,MCGTST02 ELSE BUMP INDEX AND RESUME SCAN 47500000 B MCGTSTFT ELSE RETURN IF SCAN FINISHED 47505000 MCGTST03 EQU * 47510000 EX RE,MCGTMVC A 47515000 MVI 1(R3),C' ' INSERT BLANK AT END OF SQUZD STRNG 47530000 BCTR R3,0 DECR END OF STRING POINTER 47535000 BCTR RE,0 DECR REMAINING LENGTH 47540000 BCTR RD,0 REDUCE OVERALL LENGTH 47545000 AR R1,R2 BUMP SCAN POINTER A 47550000 B MCGTST02 RESUME SCAN 47555000 MCGTMVC MVC 0($,R1),1(R1) SQUEEZE OUT QUOTE A 47555100 SPACE 2 47560000 MCGTSTF LM RC,RD,AWZEROS ZERO OUT- NULL STRING S 47564000 MCGTSTFT EQU * 47565000 LR RA,RB MOVE SCAN POINTER 47570000 XSNAP LABEL='***MCGTST EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47575000 $RETURN RGS=(R0-R3),SA=NO 47580000 SPACE 47585000 MCGTOVR L R15,AVMOVRFL GET @ OF OVERFLOW ROUTINE 47590000 BR REP BRANCH THERE 47595000 MCGTMV MVC 0($,RC),0(RA) MOVE STRING INTO STORAGE A 47600000 DROP RAT 47605000 LTORG 47610000 TITLE '*** MCATRM - ATTRIBUTE PROCESSOR ***' 47615000 **--> CSECT: MCATRM THIS ROUTINE SCANS A TERM AND DETERMINES * 47620000 *. WHETHER IT IS A VALID ATTRIBUTE, IE I', K', L', N', S' OR T'* 47625000 *. THE LENGTH (L'), SCALE (S') AND INTEGER (I') ATTRIBUTES ARE * 47630000 *. NOT IMPLEMENTED AND ARE SO FLAGGED. * 47635000 *. * 47640000 *. ENTRY CONDITIONS * 47645000 *. RA = @ OF FIRST CHAR OF TERM * 47650000 *. * 47655000 *. EXIT CONDITIONS * 47660000 *. RA = @ OF DELIM PAST QUOTE IF VALID ATTRIBUTE ELSE SAME AS * 47665000 *. ENTRY. * 47670000 *. RB = 0 IF ATTRIBUTE * 47675000 *. = -4 IF NOT ATTRIBUTE * 47680000 *. = $ERMESSAGE IF NOT IMPLEMENTED * 47685000 *. RC = TYPE OF ATTRIBUTE * 47690000 *. * 47695000 *. USES MACROS: $SAVE, $RETURN * 47700000 *. USES DSECTS: AVWXTABL * 47705000 *. * 47710000 *.********************************************************************* 47715000 SPACE 2 47720000 MCATRM CSECT 47725000 $SAVE RGS=(R14-R2),SA=NO 47730000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 47735000 XSNAP LABEL='***MCATRM ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP06X47740000 ,TM) 47745000 LM RB,RC,AWZEROS ZERO RB AND RC 47750000 * A 47755000 BCTR RA,0 DECR POINTER 47760000 TRT 0(1,RA),AWTSYMT TEST PREV CHAR 47765000 LA RA,1(RA) RESTORE POINTER 47770000 BZ MCATRMR1 NOT ATTRIBUTE IF PREV CHAR = ALPHA 47775000 LA RD,MCATTABL GET @ OF ATTRIBUTE TABLE 47780000 MCATRMSC CLC 0(2,RA),0(RD) COMPARE NEXT ENTRY 47785000 BL MCATRMR1 IF LOW, NOT FOUND, RETURN 47790000 BE MCATRMYS IF EQUAL, FOUND 47795000 LA RD,4(RD) ELSE BUMP TABLE POINTER 47800000 B MCATRMSC TRY AGAIN 47805000 SPACE 47810000 MCATRMYS IC RB,3(RD) SET PRESENCE FLAG 47815000 IC RC,2(RD) SET TYPE 47820000 CLI 3(RD),$ERNOIMP IMPLEMENTED? 47825000 BE MCATRMRT IF NOT, DON'T MOVE POINTER 47830000 LA RA,2(RA) BUMP POINTER 47835000 B MCATRMRT 47840000 MCATRMR1 EQU * 47845000 L RB,AWFM4 SET -4 FOR NO ATTIB 47850000 MCATRMRT EQU * 47855000 XSNAP LABEL='***MCATRM EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47860000 $RETURN RGS=(R14-R2),SA=NO 47865000 SPACE 2 47870000 MCATTABL DC C'I''',AL1($BSATI,$ERNOIMP),C'K''',AL1($BSATK,X'00') 47875000 DC C'L''',AL1($BSATL,$ERNOIMP),C'N''',AL1($BSATN,X'00') 47880000 DC C'S''',AL1($BSATS,$ERNOIMP),C'T''',AL1($BSATT,X'00') 47885000 DC X'FFFF' A 47890000 LTORG 47895000 DROP RAT,REP 47900000 TITLE '***MCBODY - PROCESSES BODY OF MACRO DEFINITION***' 47905000 **--> CSECT: MCBODY PROCESSES THE BODY OF MACRO DEFINITION. * 47910000 *. CALLED FORM MACRO1 AFTRR PROTOTYPE STATEMENT PROCESSED. * 47915000 *. INITIALIZES LOCAL DICTIONARY FOR CURRENT DEFINITION. * 47920000 *. PROCESSES EACH STATEMENT TILL MEND STATEMENT ENCOUNTERED. * 47925000 *. TERMINATES AND RETURNS AT THAT POINT * 47930000 *. * 47935000 *. IN OPEN-CODE MODE, ($MCOCFL1 ON IN MCLBFLG2), * 47935100 *. MCBODY ONLY PROCESSES STMT IN RSBLOCK * 47935200 *. IF AVPRSAVE IS SET IN AVPRINT1, IT CALL MXMVSR * 47935300 *. TO SAVE STMT IN HIGH AREA, ELSE IT PRINTS IT IMMEDIATELY * 47935400 *. ENTRY CONDITIONS * 47940000 *. RC = @ OF MACLIB ENTRY OF CURRENT MACRO DEFINITION * 47945000 *. * 47950000 *. USES MACROS: $SAVE,$RETURN,$CALL,$ALLOCL,$ALLOCH,$SCOF, * 47955000 *. $SETRT * 47960000 *. USES DSECTS: AVWXTABL,MACLIB,MCLCLDPV,OPCODTB,RSBLOCK,MCBSU,* 47965000 *. MCSEQ,MCGLBDCT,MCOPQUAD * 47970000 *. CALLS INCARD,ERRTAG,MACSCN,ERRLAB,MCVSCN,MACFND,SDDTRM, * 47975000 *. MCSYSR,MACLEX,MCGTST,OUTPT2,MCGNCD * 47980000 *. * 47985000 *. REGISTER USAGE ************************* A 47985100 *.R13- BASE REGISTER AND SAVEAREA POINTER A 47985200 *.RAT-MAIN TABLE DSECT USING A 47985300 *.RX- MACLIB DSECT USING A 47985500 *.RY- LOCAL DICTIONARY DSECT UING A 47985600 *.RZ-OPCODE TABLE DSECT USING A 47985700 *.RB,RE,RA- WORK REGISTERS A 47985800 *.R1,R2 USED IN TRT'S A 47985900 *.RET- RETURN REGISTER USED FOR INSUBS A 47985910 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 47990000 SPACE 2 47995000 MCBODY CSECT 48000000 $SAVE RGS=(R14-R6),SA=*,BR=13 48005000 USING AVWXTABL,RAT 48010000 XSNAP LABEL='***MCBODY ENTERED***',IF=(AVMSNBY1,O,$MSNP07,TM) 48015000 USING MACLIB,RX SET USING FOR MACRO LIBRARY ENTRY 48020000 LR RX,RC COPY @ OF MACLIB ENTRY 48025000 USING MCLCLDPV,RY SET USING FOR LOCAL DV ENTRY 48030000 USING OPCODTB,RZ SET USING FOR OPCODE TABLE ENTRY 48035000 NI AVMBYTE1,$MINDEF CLEAR AVMBYTE1 48040000 LM R1,R2,AWZEROS CLEAR R1 AND R2 48045000 MVC AVMCRINS,AWZEROS ZERO PTR TO 1ST ONE-OP J 48045500 AIF (NOT &$MACOPC).MCBODYA SKIP IF NOT OPEN CODE S 48046000 TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 48046100 BO MCBOD02 IF YES, SKIP DUMMY ENTRIES S 48046200 .MCBODYA ANOP S 48046300 LA RB,$LLCLDV GET LENGTH OF LOCAL DOPE VECTOR 48050000 SPACE 48060000 * THIS DUMMY ENTRY IN LOCAL DICT WILL BE USED FOR ACTR AND &SYSNDX 48065000 $ALLOCL RY,RB,MCBODOVR GET AREA FOR ENTRY 48070000 ST RY,MCDDVPNT SAVE @ IN MACLIB 48075000 MVC 0($LLCLDV,RY),AWZEROS CLEAR ENTRY 48080000 MVI MCLCLTYP,$ARITH SET TYPE EQUAL TO ARITH FOR LENGTH 48085000 MVI MCLCLDIM+1,1 SET DIMENSION TO 1 48090000 MVI MCLOCDLN+3,4 INIT LENGTH OF DICT TO 4 48095000 SPACE 48100000 * DUMMY ENTRY FOR SEQUENCE SYMBOL TABLE 48105000 USING MCSEQ,RE SET USING FOR SEQ SYMBOL ENTRY 48110000 LA RB,$LMCSEQ GET LENGTH OF ENTRY 48115000 $ALLOCH RE,RB,MCBODOVR OBTAIN AREA FOR ENTRY 48120000 ST RE,AVMSEQPT SAVE @ IN MAIN TABLE 48125000 MVC 0($LMCSEQ,RE),AWZEROS ZERO ENTRY 48130000 MVI MCSEQFLG,X'FF' SET DEFINED FLAG 48135000 DROP RE CLEAR USING 48140000 EJECT A 48145000 USING RSBLOCK,RW SET USING FOR SOURCE STMNT 48150000 MCBOD01 EQU * 48155000 AIF (NOT &$MACOPC).MCBODYB SKIP IF NOT OPEN CODE S 48156000 TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 48156100 BO MACBODRT RETURN IF YES S 48156200 .MCBODYB ANOP S 48156300 L RW,AVRSBPT GET @ OF SOURCE STMNT 48160000 $CALL INCARD READ NEXT STATEMNT 48165000 LTR RB,RB ERROR ON INPUT 48170000 BZ MCBOD02 JUMP ND PROCESS IF NOT 48175000 $CALL ERRTAG ELSE FLAG STMNT 48180000 TM AVTAGS2,$INEND2 END OF FILE? 48185000 BO MACBODRT RETURN IF YES 48190000 MCBOD02 EQU * 48195000 LA RA,RSBSOURC SET SCAN POINTER 48200000 ST RA,MCBDSRPT SAVE RSBSOURC @ FOR $SCOF USE 48205000 MVI AVMBYTE2,X'00' ZERO FLAG BYTE 2 48210000 MVI AVMBYTE4,X'00' CLEAR AVMBYTE4 48215000 $CALL MACSCN SCAN STMT 48220000 C RB,=F'8' MACRO COMMENT? 48225000 BE MCBODPR1 JUMP AND PRINT IF YES 48230000 LR RZ,RC COPY OPCODTB ENTRY @ INTO RZ 48235000 DROP RW DROP USING ON SOURCE IMAGE 48240000 USING MCBSU,RW SET UP USING ON BSU 48245000 L RW,AVMCHSTR SET BASE FOR BSU WORKAREA 48250000 MVC MCBSU(8),AWZEROS CLEAR FIRST BSU 48255000 CLI AVMFLDT2,C'M' MACRO OPCODE? 48260000 BE MCBODJMP IF YES, JUMP AND FIND WHICH OPCODE 48265000 CLI AVMFLDT2,C'I' INNER MACRO INSTRUCTION? 48270000 BNE MCBODSTR PROCESS MODEL STMT IF NOT S 48275000 AIF (NOT &$MACOPC).MCBODYE SKIP IF NOT OPEN CODE S 48280000 TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 48285000 BO MCBODSTQ PROCESS MODEL STMT (NO INNER MACS) A 48286000 .MCBODYE ANOP S 48287000 B MCBDINMC PROCESS INNER MACRO S 48290000 * THIS SECTION GETS THE TYPE OF OPERATION AND BRANCHES TO THE A 48290100 * CODE TO PROCESS IT A 48290200 MCBODBAS DS 0H 48295000 MCBODJMP EQU * 48300000 SR R2,R2 C3EAR R2 FOR INDEX ACTION 48305000 IC R2,OPCHEX GET OPCODE INDEX 48310000 LA R1,MCFLGTAB(R2) LOAD @ OF TABLE ENTRY S 48310500 MVC *+7(1),1(R1) MOVE MASK INTO NEXT TM INSTR S 48311000 * NOTE: THE NEXT INST IS MODIFIED BY THE PREVIOUS INST S 48311500 TM MCLBFLG2,$ TEST IF CARD OUT OF ORDER S 48312000 BO MACMACRO BRANCH IF CARD OUT OF ORDER S 48313000 OC MCLBFLG2(1),0(R1) SET CURRENT OPCODE FLAG S 48314000 LH R1,MACBINDX(R2) GET REL @ FROM TABLE 48315000 B MCBODBAS(R1) JUMP TO ROUTINE 48320000 SPACE 2 48325000 MACBINDX $AL2 MCBODBAS,(MACMACRO,MACGBLA,MACGBLB,MACGBLC,MACLCLA,MACLCX48330000 LB,MACLCLC,MACACTR,MACSETA,MACSETB,MACSETC,MACAIF,MACAGOX48335000 ,MACANOP,MACMNOTE,MACMEXIT,MACMEND),-2 48340000 EJECT S 48340100 * THIS MACRO FLAG TABLE IS USED TO EITHER SET OR TEST A FLAG S 48340200 * TO CHECK IF A MACRO OPCODE IS OUT OF ORDER. S 48340300 * ......THE FIRST BYTE OF EACH TWO BYTE ENTRY CONTAINS THE S 48340400 * FLAG TO BE SET INTO MCLBFLG2 WHEN THE OPCODE IS S 48340500 * ENCOUNTERED. THE SECOND BYTE IS USED TO TEST AGAINST S 48340600 * MCLBFLG2 TO SEE IF THE CURRENT OPCODE IS OUT OF ORDER. S 48340700 * S 48340800 * SET , TEST OPCODE S 48340900 * --- ---- ------ S 48341000 * S 48341050 MCFLGTAB EQU *-2 ORIGIN OF HALF-WORD TABLE A 48341075 DC AL1(0,$MGBLFLG) MACRO A 48341100 DC AL1(0,$MGBLFLG) GBLA S 48341200 DC AL1(0,$MGBLFLG) GBLB S 48341300 DC AL1(0,$MGBLFLG) GBLC S 48341400 DC AL1($MGBLFLG,$MLCLFLG) LCLA S 48341500 DC AL1($MGBLFLG,$MLCLFLG) LCLB S 48341600 DC AL1($MGBLFLG,$MLCLFLG) LCLC S 48341700 DC AL1($MACTFLG,$MACTFLG) ACTR S 48341800 DC AL1($MACTFLG,0) SETA S 48341900 DC AL1($MACTFLG,0) SETB S 48342000 DC AL1($MACTFLG,0) SETC S 48342100 DC AL1($MACTFLG,0) AIF S 48342200 DC AL1($MACTFLG,0) AGO S 48342300 DC AL1($MACTFLG,0) ANOP S 48342400 DC AL1($MACTFLG,0) MNOTE S 48342500 DC AL1($MACTFLG,0) MEXIT S 48342600 DC AL1($MACTFLG,0) MEND S 48342700 DROP RY CLEAR TEMP USING OF RY 48345000 SPACE 2 48350000 TITLE '***MCBODY - GBLX ROUTINES***' 48355000 USING MCGLBDCT,RY ESTAB USING FOR GLOBAL ENTRY 48360000 MACGBLA EQU * 48365000 MACGBLB EQU * 48370000 MACGBLC EQU * 48375000 BAL RET,MCB01 CHECK FOR LABEL & OPERAND J 48410000 MCGB04 EQU * 48455000 ST RA,AVMTSCNP COPY SCAN POINTER TEMPRORARILY 48460000 $CALL MCVSCN SCAN SYMBOL 48465000 LTR RB,RB VARIABLE SYMBOL? 48470000 BZ MCGB05 PROCESS IF OKAY 48475000 * AS 48480000 LA RB,$ERINVSY SET ERROR FLAG IF RB^=0 A 48485000 B MCBDPRER AND JUMP AN4 FLAG 48490000 * AT THIS POINT LEGAL SET SYMBOL A 48490100 MCGB05 EQU * 48495000 L RC,MCPARPNT GET PARAM LIST START @ 48500000 $CALL MACFND SCAN PARAM LIST 48505000 LTR RB,RB SYMBOL PRESENT 48510000 BZ MCGBMD ERROR IF YES-QUIT A 48515000 * LEGAL GLOBAL DECLARATION A 48540100 L RC,AVMGDICT GET GLOBAL DICT POINTER 48545000 $CALL MACFND SCAN GLOBAL DICT 48550000 LR RY,RC MOVE DICT ENTRY TO REGULAR BASE 48555000 LTR RB,RB SYMBOL PRESENT? 48560000 BNZ MCGB07 JUMP AND PROCESS IF NOT PRESENT 48565000 CLC MCGLBDEF,AVMMACID ELSE IS IT PREV DEFINED THIS DEF? 48570000 BE MCGBMD MULT DEF IF YES 48575000 CLC MCGLBTYP,AVMBYTE3 DO TYPES MATCH? 48580000 BNE MCGBMD IF NOT, THEN ERROR 48585000 LA RC,1 SET DIMENSION=1 FOR NO DIMEN A 48587000 CLI 0(RA),C'(' SYMBOL DIMENSIONED? 48590000 BNE MCGB08 IF NOT, PROCEED 48595000 BAL RET,MCB02 GET DIMENSION J 48600000 MCGB08 EQU * COME HERE TO CHECK SIZES= A 48650000 CH RC,MCGLBDIM DIMENSIONS M1TCH? 48655000 BE MCGB10 PROCEED IF YES 48660000 B MCGBMD AND JUMP AND FLAG MULT DEF ERROR 48670000 SPACE 48695000 MCGB07 EQU * 48700000 LA RC,1 SET DIMENSION TO 1 48705000 CLI 0(RA),C'(' DIMENSIONED? 48710000 BNE MCGB11 PROCEED WITH SINGLE DIM IF NOT 48715000 BAL RET,MCB02 GET DIMENSION J 48720000 BAL RET,MCB03 CHECK SIZE J 48725000 MCGB11 EQU * 48785000 LA RB,$LGLBENT GET LENGTH OF GLOBAL ENTRY 48790000 $ALLOCL RE,RB,MCBODOVR GET AREA FOR ENTRY 48795000 ST RE,MCGLBNXT SAVE POINTER IN PREV ENTRY 48800000 LR RY,RE MOVE BASE TO NEW ENTRY 48805000 MVC MCGLBNXT($LGLBENT),AWZEROS CLEAR NEW ENTRY 48810000 MVC MCGLBLEN(9),AVMSYMLN MOVE SYMABOL INTO ENTRY 48815000 MVC MCGLBTYP,AVMBYTE3 SAVE TYPE IN ENTRY 48820000 STH RC,MCGLBDIM SAVE DIMENSI6N IN ENTRY 48825000 SR RE,RE CLEAR RE 48830000 IC RE,AVMBYTE3 PLACE TYPE LENGTH IN RE 48835000 CLI AVMBYTE3,$CHAR WAS IT CHARACTER? 48840000 BE MCGB12 IF YES , PROCEED WITH LENGTH OF 12 48845000 LA RE,4 ELSE USE LNG OF 4 FOR BOOL & ARITH A 48850000 MCGB12 LH RD,MCGLBDIM GET DIMENSION OF ARRAY 48855000 SR R0,R0 CL1R R0 FOR USE IN LOOP 48860000 MCGB13 EQU * 48865000 $ALLOCL RB,RE,MCBODOVR GET AREA FOR ELEMENT 48870000 ST R0,0(RB) INITIALIZE TO ZERO 48875000 BCT RD,MCGB13 LOOP BACK IF NOT FINISHED 48880000 SPACE 2 48885000 MCGB10 EQU * 48890000 MVC MCGLBDEF,AVMMACID SAVE CURRENT DEF ID 48895000 CLI 0(RA),C' ' END OF OPRND LIST? 48900000 BE MCBODPR JUMP AND PRINT IF YES 48905000 CLI 0(RA),C',' PROPER DELIMITER? 48910000 BNE MCGBINVD INVALID DELIM-GO FLAG A 48915000 LA RA,1(RA) BUMP SCAN POINTER PAST ',' 48920000 B MCGB04 AND RESUME SCAN 48925000 DROP RY CLEAR RY USING AFTER GLOBAL USE 48930000 TITLE '***MCBODY - LCLX ROUTINES***' 48935000 USING MCLCLDPV,RY USE RY AS BASE FOR LOCAL ENTRIES 48940000 MACLCLA EQU * 48945000 MACLCLB EQU * 48950000 MACLCLC EQU * 48955000 BAL RET,MCB01 CHECK FOR LABEL & OPERAND J 48990000 MCLC04 EQU * 49035000 ST RA,AVMTSCNP COPY SCAN POINTER 49040000 $CALL MCVSCN SCAN FOR LEGAL VAR SYMBOL 49045000 LTR RB,RB OKAY? 49050000 BNZ MCBDPRER IF NOT, JUMP AND FLAG 49055000 LR R0,RA COPY NEW SCAN POINTER VALUE TEMP 49060000 L RA,AVMTSCNP GET ORIGINAL SCAN POINTER 49065000 $CALL MCSYSR SEARCH ALL DICTS FOR SYMBOL 49070000 LTR RB,RB PRESENT ALREADY? 49075000 BZ MCGBMD GO FLAG MULTIPLE DEFINITION A 49080000 LR RA,R0 RESTORE SCAN POINTER 49115000 LR RY,RC MOVE BASE TO USING REG RY 49120000 LA RB,$LLCLDV GET LENGTH OF LCAL DV 49125000 $ALLOCL RE,RB,MCBODOVR GET AREA FOR ENTRY 49130000 MVC 0($LLCLDV,RE),AWZEROS ZERO OUT ENTRY 49135000 ST RE,MCLOCNXT SAVE POINTER IN PREV ENTRY 49140000 LR RY,RE MOVE BASE TO NEW ENTRY 49180000 MVC MCLCLLEN(9),AVMSYMLN MOVE NAME INTO NEW ENTRY 49190000 MVC MCLCLTYP,AVMBYTE3 ESTABLISH TYPE OF SET SYMBOL ENTRY 49195000 MVC MCLCLDIM,AWH1 SET DIM = 1 FOR PRESENT 49200000 CLI 0(RA),C'(' DIMENSIONED? 49205000 BNE MCLCFT IF NOT, PROCEED 49210000 BAL RET,MCB02 GET DIMENSION J 49215000 SPACE 49240000 MCLC07 EQU * 49245000 BAL RET,MCB03 CHECK DIMENSION SIZE J 49250000 MCLC08 EQU * 49270000 STH RC,MCLCLDIM SET DIMENSION IN ENTRY 49275000 MCLCFT EQU * 49320000 LA R1,4 ASSUME LENGTH = 4 49365000 TM MCLCLTYP,$CHAR TEST FOR TYPE 49370000 BNO MCLC11 SKIP IF NOT CHAR 49375000 * ASSEMBLER G CAHRACTER DECL WILL CHANGE FOLLOWING. 49380000 LA R1,12 ELSE USE CHAR LENGTH OF ENTRY 49385000 MCLC11 EQU * 49390000 MH R1,MCLCLDIM GET TOTAL SIZE OF ARRAY 49395000 L RE,MCLOCDLN GET CURRENT OFFSET/LENGTH A 49398000 ST RE,MCLCLPNT STORE AS OFFSET TO THIS VAR A 49400000 AR R1,RE UPDATE TOTAL DICT LENGTH A 49402000 ST R1,MCLOCDLN SAVE LENGTH OF LOCAL DICT IN MACLIB 49405000 SPACE 1 A 49406000 CLI 0(RA),C' ' WAS THIS LAST ONE? A 49407000 BE MCBODPR YES QUIT AND PRINT A 49408000 CLI 0(RA),C',' OK DLM A 49409000 BNE MCGBINVD NO, ERROR KILL IT A 49410000 LA RA,1(,RA) BUMP SCAN PTR TO NEXT OPRND A 49411000 B MCLC04 RETURN FOR NEXT OPRND A 49412000 DROP RY DROP TEMP USING OF RY FOR LOCALS 49415000 EJECT A 49415100 **--> INSUB: MCB01 CHECK LCLX,BLX FOR LABEL, OPCODE + + + + + + J 49415110 *+ +A 49415120 *+ THIS IS CALLED TO CHECK FOR AN ERROR IN THE GBLX OR A 49415130 *+ GBLX INSTRUCTION. IF AN ERROR OCCURES WHEN A LABEL IS PRESENTA 49415140 *+ AND/OR THERE IS NO OPERANDS. A 49415150 *+ A 49415160 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 49415170 SPACE 2 A 49415180 MCB01 EQU * J 49415190 MVC AVMBYTE3,OPCMASK GET TYPE OF SET SYMBOL A 49415200 CLI AVMFLDL1,0 CHECK IF LABEL PRESENT(L^=0) A 49415210 BE MCB001 IF NOT PROCEED J 49415220 ST RET,MCB##SAV SAVE THE RETURN @ J 49415225 LA RB,$ERILLAB ELSE SET ERROR FLAG A 49415230 $CALL ERRLAB AND FLAG STMT A 49415240 L RET,MCB##SAV RESTORE RETURN @ J 49415245 MCB001 EQU * J 49415250 L RA,AVMFLD3 GET @ OPERAND; =0 IF NONE A 49415260 LTR RA,RA DID ONE EXISTS A 49415270 BCR NZ,RET YES-RET, NORMAL CASE A 49415280 B MCBDOPER NO-ERROR-MISSING OPERAND A 49415290 SPACE 5 A 49415300 **--> INSUB: MCB02 OBTAIN DIMENSION OF GBLX OR LCLX STMT + + + + J 49415310 *+ BUNPS POINTER GETS DIMENSION AND FLAGS ERROR IF NOT CONST QA 49415320 *+ RA= @ '(' ON ENTRY; @ BEYOND '(' ON EXIT IF GOOD A 49415322 *+ RC=VALUE OF SUBSCRIPT IF GOOD A 49415324 *+ + + + + + + + + + ++ + + + + + + + + + + + + + + + + + + + + + + +A 49415330 SPACE 5 A 49415340 MCB02 ST RET,MCB##SAV SAVE RETURN @ J 49415345 LA RA,1(RA) BUMP PTR PAST ) J 49415350 $CALL SDDTRM AND GET DIMENSION A 49415360 LTR RB,RB DIMENSION=CONSTANT? A 49415370 BNZ MCBDPRER FLAG ERROR IF NOT A 49415380 CLI 0(RA),C')' CURRENT ENDING DLM A 49415382 BNE MCGBINVD NO ERROR A 49415383 LA RA,1(,RA) YES BUMP BEYOND ) A 49415384 L RET,MCB##SAV RESTORE RETURN @ J 49415385 BR RET RETURN A 49415390 SPACE 5 A 49415400 **--> INSUB: MCB03: CHECK DIMENSION SIZE FOR GBLX,LCLX+ + + + + + + + J 49415410 *+ CHECKS TO MAKE SURE DIMENSION OF + A 49415420 *+ GBLX AND/OR LCLX IS WITHIN RANGE + A 49415430 *+ FLAGS ERROR IF NOTS WITHIN RANGE + A 49415440 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + A 49415450 SPACE 2 A 49415460 MCB03 C RC,=F'2500' DIMENSION WITHIN RANGE? J 49415470 BCR NH,RET RETURN IF NOT J 49415480 LA RB,$EREXGTA ELSE SET ERROR FLAG A 49415490 B MCBDPRER AND FLAG STMT A 49415500 TITLE '***MCBODY - SET INSTRUCTION ROUTINES***' 49420000 * A 49420100 * SETX SYMBOLS FOUND, SET FLAG FOR TYPE & CONTINUE SCAN OF EXPRESSION A 49420200 * A 49420300 MACSETA EQU * 49425000 MVI AVMBYTE3,$ARITH SET ARITH TYPE FLAG 49430000 B MACSET 49435000 MACSETB EQU * 49440000 MVI AVMBYTE3,$BOOL SET BOOLEAN FLAG 49445000 B MACSET 49450000 MACSETC EQU * 49455000 MVI AVMBYTE3,$CHAR SET CHARACTER TYPE FLAG 49460000 * A 49460100 * CKECK FOR LEGAL SETUP IE, NO OPERAND ERRORS, NO LABEL A 49460200 * ON STATEMENT, ERROR IF LOOKS LEGAL, GO ON ELSE FLAG ERROR A 49460300 * A 49460400 MACSET EQU * 49465000 BAL RET,MCB001 CHECK FOR OPERND,GET@ A 49475000 L RA,AVRSBPT GET SOURCE BLOCK ADDRESS 49490000 LA RA,4(RA) BUMP TO SOURCE STMNT 49495000 CLI AVMFLDL1,X'00' LABEL PRESENT? 49500000 BNE MCBDST03 PROCEED IF YES 49505000 LA RB,$ERNONAM SET MISSING LA&EL FLAG 49510000 B MCBDPRER JUMP AND FLAG ERROR 49515000 * GET THE BSU ADDRESS SET TYPE & IF NEITHER OF THE SET TYPES-ERROR A 49515100 * A 49515200 MCBDST03 EQU * 49520000 LR RC,RW SET POINTER TO BSU 49525000 $CALL MACLEX SCAN LABEL FIELD 49530000 LTR RB,RB ERROR? 49535000 BNZ MCBDPRER JUMP OUT IF YES 49540000 LR RW,RC RESTORE BSU POINTER 49545000 L RE,AVMCHSTR GET @ OF BSU WORKAREA 49550000 CLI AVMBYTE3,$BOOL IS SET A, B, OR C 49555000 BH MCSETCHR CHR IF HIGHER 49560000 BE MCSETBOL BOOLEAN IF EQUAL 49565000 OI AVMBYTE2,$MINARIT ELSE IS ARITHMETIC 49570000 MVI MCBSINDX,$BSETA SET BSU INDEX FOR SETA 49575000 CLI 1(RE),$BSTSYAG IS IT GLOBAL ARITH SET SYSMB? 49580000 BE MCBDST01 IF YES, OKAY 49585000 CLI 1(RE),$BSTSYAL ELSE IS IT LOACAL ARITH SET SYMBOL? 49590000 BE MCBDST01 IF YES, OKAY 49595000 B MCLMXDER ELSE FLAG ERROR 49600000 * A 49600100 * CHECKS THE FORMAT OF SETB-MAKE SURE ITS 0 OR 1, PARENS LEGAL A 49600200 * THEN CHECKS FOR GLOBAL OR LOCALS A 49600300 * A 49600400 MCSETBOL EQU * 49605000 L RA,AVMFLD3 GET OPERAND @ 49610000 CLI 0(RA),C'(' STARTS WITH LEFT PAREN? 49615000 BE MCSETB01 OKAY IF YES 49620000 CLI 0(RA),C'1' OPERAND = 1? 49625000 BE MCSETB01 OKAY IF YES 49630000 CLI 0(RA),C'0' OPERAND = 0? 49635000 BE MCSETB01 OKAY IF YES 49640000 LA RB,$ERINVF ELSE SET INVALID FIELD FLAG 49645000 B MCBDPRER JUMP AND FLAG STMTN 49650000 MCSETB01 EQU * 49655000 OI AVMBYTE2,$MINBOOL SET BOOLEAN FLAG 49660000 MVI MCBSINDX,$BSETB SET BSU INDEX 49665000 CLI 1(RE),$BSTSYBG IS IT BOOLEAN GLOBAL SET? 49670000 BE MCBDST01 OKAY IF YES 49675000 CLI 1(RE),$BSTSYBL ELSE IS IT BOOLEAN LOCAL SET? 49680000 BE MCBDST01 OKAY IF YEW 49685000 B MCLMXDER ELSE FLAG EROR 49690000 * A 49690100 * CHECK FOR LEGAL SETC SYMBOL A 49690200 * A 49690300 MCSETCHR EQU * 49695000 MVI MCBSINDX,$BSETC SET BSU INDEX 49700000 OI AVMBYTE2,$MINCHAR SET CHAR FLAG 49705000 CLI 1(RE),$BSTSYCG IS IT CHAR GLOBAL SET SYMBOL? 49710000 BE MCBDST01 OKAY IF YES 49715000 CLI 1(RE),$BSTSYCL ELSE IS IT CHAR LOCAL SET? 49720000 BNE MCLMXDER ERROR IF NOT 49725000 MCBDST01 EQU * 49730000 * A 49730100 * SETS HIERARCHY OF BSU, SETS FLAGA & MOVES ADRESS THEN SCANS A 49730200 * THE OPERAND, IF IN ERROR, FLAGS IT A 49730300 * A 49730400 MVI MCBSHIER,$MSETHR SET HEERARCHY 49735000 OI MCBSFLGS,$MOPRTR SET OPERATOR FLAG IN BSU 49740000 L RA,AVMFLD2 GET @ OF OPCODE 49745000 $SCOF RB,RA,MCBSOFST GET OPCODE @ INTO BSU 49750000 BAL RE,MCBDBMP BUMP BSU POINTER 49755000 LR RC,RW MOVE BSU POINTER TO RC 49760000 L RA,AVMFLD3 GET ADDRESS OF OPERAND 49765000 $CALL MACLEX SCAN OPERAND 49770000 LTR RB,RB ERROR 49775000 BNZ MCBDPRER FLAG STMNT IF YES 49780000 B MCBODPR JUMP TO FOOT 49785000 TITLE '***MCBODY - AGO,AIF, MNOTE ETC ROUTINES***' 49790000 * WHEN AN ACTR STATEMENT FOUND, SETS FLAG FOR NO MORE GLOBALS OR A 49790100 * LOCALS. SEES IF ACTR STMT OK, THEN CHECKS IF LABEL PRESENT(ERROR) A 49790200 * CHECKS FOR OPERANDS(ERROR IF NOT THERE) SETS INDEX(COUNTER) & SETS A 49790300 * UP THE BSU. A 49790400 * A 49790500 MACACTR EQU * 49795000 BAL RET,MCB01 CHECK OPRND @ EXISTENCE A 49840000 MVI MCBSFLGS,$MTERM+$BSAR SET BSU FLAGS 49880000 MVI MCBSINDX,$BSTSYAL SET LOCAL ARITH SET INDEX 49885000 MVC MCBSLOC,MCDDVPNT MOVE @ OF ACTR TO BSU 49890000 BAL RE,MCBDBMP BUMP BSU 49895000 L RD,MCBDSET CREATE BSU S 49900000 BAL RE,MCBDBMP0 BUMP BSU POINTER S 49905000 OI AVMBYTE2,$MINARIT SET ARITH EXPRESSION FLAG 49910000 LR RC,RW GET BSU POINTER 49915000 $CALL MACLEX SCAN EXPRESSION 49920000 LTR RB,RB ERROR? 49925000 BNZ MCBDPRER FLAG IF YES 49930000 LR RW,RC RESTORE BSU POINTER 49935000 B MCBODPR JUMP AND PRINT STMNT 49940000 SPACE 2 49945000 * AIF FOUND, CHECK FOR LEGAL SEQUENCE, NO LCLX OR GBLX, AND SYNTAX A 49945100 * MUST START WITH ( AND HAVE SEQ SYMB FOLLOWING, THEN SETS UP THE A 49945200 * BSU WITH THE ADDRESSES. A 49945300 * A 49945400 MACAIF EQU * 49950000 BAL RET,MCBDCHLB CHECK FOR LEGAL LABEL 49960000 BAL RET,MCB001 CHECK OPRND @ EXISTENCE A 49965000 CLI 0(RA),C'(' FIRST CHAR = '('? 49980000 BE MACAIF01 PROCEED IF YES 49985000 LA RB,$ERVSYNT SET SYNTAX FLAG 49990000 B MCBDPRER AND FLAG ERROR 49995000 MACAIF01 EQU * 50000000 OI AVMBYTE2,$MINPEXP+$MINBOOL SET FLGS FOR PAREN SCAN 50005000 LR RC,RW GET BSU POINTER 50010000 $CALL MACLEX SCAN OPERAND 50015000 LR RW,RC RESTORE BSU POINTER 50020000 LTR RB,RB ERROR? 50025000 BNZ MCBDPRER FLAG IF YES 50030000 CLI 0(RA),C'.' SEQ SYMBOL AFTER EXPRESSION? 50035000 BNE MCBDISER ERROR IF NOT 50040000 MVC MCBSFLGS(4),MCBDAIF A 50045000 L R2,AVMFLD2 GET OFFSET OF OPCODE 50055000 $SCOF R1,R2,MCBSOFST INSERT OFFSET IN BSU 50060000 BAL RE,MCBDBMP BUMP BSU 50070000 L RD,MCBDLABL GET FIRST HALF OF BSU A 50075000 * A 50080000 B MACAGO03 S 50085000 SPACE 2 50100000 * SAME THING WITH AGO, CKS SYNTAX, LEGAL SEQ, ETC AND SETS UP A 50100100 * THE BSU A 50100200 * A 50100300 MACAGO EQU * 50105000 BAL RET,MCBDCHLB CHECK FOR LEGAL CLABEL 50115000 BAL RET,MCB001 CHECK OPRND GET @ A 50120000 CLI 0(RA),C'.' POSSIBLE SEQ SYMBOL? 50135000 BE MACAGO02 PROCEED IF YES 50140000 LA RB,$ERINVSY ELSE SET BAD SYMBOL FLAG 50145000 B MCBDPRER AND FLAG STATEMNT 50150000 MACAGO02 EQU * 50155000 L RD,MCBDAGO CREATE BSU S 50160000 MACAGO03 ST RA,MCBSLOC SAVE @ OF LABEL S 50165000 B MCBODPR0 PRINT STATEMENT S 50170000 SPACE 2 50180000 MACANOP EQU * 50185000 MVI MCBSINDX,$BSANOP INSERT BSU ANOP INDEX 50190000 B MACAMM 50195000 MACMEXIT EQU * 50200000 MVI MCBSINDX,$BSMEXIT SET MEXIT BSU 50205000 B MACAMM 50210000 MACMEND EQU * 50215000 MVI MCBSINDX,$BSMEND SET MEND BSU INDEX 50220000 MACAMM EQU * 50225000 BAL RET,MCBDCHLB CHECK FOR LEGAL LABEL 50235000 MVI MCBSFLGS,$MOPRTR SET OPRTR FLAG 50240000 MVI MCBSHIER,$MPRNTHR SET PRINT HIERARCHY 50245000 L RA,AVMFLD2 GET OPCODE @ 50250000 $SCOF RB,RA,MCBSOFST PUT OFFSET IN BSU 50255000 BAL RE,MCBDBMP BUMP BSU POINTER A 50255100 B MCBODPR A 50260000 SPACE 2 50270000 * MNOTE STMT FOUND, CKS FOR VALID SYNTAX, CREATES BSU. SCANS STRING A 50270100 * FOR MESSAGE, ALSO CHECKING SYNTAX(INVALID DELIM ETC) CONCATS IFL A 50270200 * NECESSARY A 50270300 * A 50270400 MACMNOTE EQU * 50275000 BAL RET,MCBDCHLB CHECK FOR LABEL 50285000 CLI AVMFLDL3,X'00' OPRND PRESENT? 50290000 BE MCBDOPER ERROR IF NOT 50295000 BAL RET,MCBDPFLC CREATE PRINT BSU AND BUMP PTR F 50300000 MVC MCBSU(8),MCBDSTG1 COPY WHOLE BSU FROM TABLE J 50315000 BAL RE,MCBDBMP BUMP BSU POINTER 50320000 L RA,AVMFLD3 GET OPRND @ 50325000 BAL RET,MCBDPFLC CREATE PRINT BSU AND BUMP PTR F 50330000 CLI 0(RA),C'''' QUOTED STRING? 50335000 BNE MCMNOT01 50340000 MVC MCBSU(8),MCBDSTG2 COPY WHOLE BSU= '1,' BSU J 50355000 BAL RE,MCBDBMP 50360000 NI AVMBYTE2,255-($MTERM+$MOPRTR) TURN OFF PREV IND FLAG 50365000 OI AVMBYTE2,$MTERM SET TERM PREV FLAG 50370000 B MCMNOT04 50375000 MCMNOT01 EQU * 50380000 $SETRT (',',4,'''',8) SET TABLE FOR SCAN 50385000 SR RE,RE 50390000 IC RE,AVRSBLOC GET LENGTH-1 50395000 S RA,AVRSBPT GET OFFSET OF RA 50400000 SR RE,RA SUBTRACT OVERALL LENGTH 50405000 A RA,AVRSBPT RESTORE RA 50410000 EX RE,MCMNOTSC 50415000 $SETRT (',',0,'''',0) RESTORE TABLE 50420000 BNZ MCMNOT02 PROCEED IF SCAN STOPPED ON CHAR 50425000 MCMNOTER EQU * 50430000 LA RB,$ERNODLM ELSE SET BAD DELIM FLAG 50435000 B MCBDPRER AND FLAG STMT 50440000 MCMNOT02 EQU * 50445000 CLI 0(R1),C',' STOP ON COMMA? 50450000 BNE MCMNOTER ERROR IF NO 50455000 LA RB,1(R1) GET DELIM @ 50460000 SR RB,RA GET LENGTH IN RB 50465000 BAL RET,MCBDSCAN SCAN SEVERITY EXPRESSION 50470000 MCMNOT04 EQU * 50475000 CLI 0(RA),C'''' QUOTE? 50480000 BNE MCMNOTER ERROR IF NOT 50485000 BAL RET,MCBDCATI INSERT CAT OPRTR 50490000 OI AVMBYTE2,$MINCHAR SET CHAR STRING FALG 50495000 LR RC,RW GET BSU PNTR 50500000 $CALL MACLEX SCAN STRING 50505000 LR RW,RC BUMP BSU PNTR 50510000 LTR RB,RB ERROR 50515000 BNZ MCBDPRER FLAG IF YES 50520000 MVI AVMFLDT2,X'00' ZERO TYPE BYTE 50525000 L RD,MCBDPR2 CREATE BSU S 50535000 L RA,AVMFLD3 GET OPRND @ 50540000 CLI 0(RA),C'*' COMMNET? 50545000 BE MCBODPR0 SKIP IF YES S 50550000 L RD,MCBDPR3 MNOTE BSU A 50555000 B MCBODPR0 PRINT STATEMENT S 50565000 MCMNOTMS DC CL12'***MNOTE***' 50575000 MCMNOT1C DC C'1,' DEFAULT MNOTE SEVERITY J 50576000 MCMNOTSC TRT 0($,RA),AWTZTAB DUMMY FOR COMMA QUOTE SCAN 50580000 SPACE 2 50585000 MACMACRO EQU * 50590000 L RA,AVMFLD2 GET OPCODE @ IN RA 50595000 LA RB,$ERSTMNA SET STMNT NO GOOD FLAG 50600000 B MCBDPRER JUMP AND FLAG ERROR 50605000 TITLE '***MCBODY - STRING, INNER MACRO AND OPCODE ROUTINES***' 50610000 * CHECKS COMMENT, SETS PRINT BSU IF STMT SHOULD BE PRINTED AND/OR A 50610100 * DOESN'T PRINT SEQ SYMBOLS IN MACRO, OR MACRO COMMENTS. ALSO A 50610200 * MOVES OPCODE DATA IN IF PRESENT A 50610300 * A 50610400 MCBODSTQ EQU * A 50610500 MVI AVMFLDT2,0 OPEN CODE FAKE FOR MODEL STMT A 50610600 MCBODSTR EQU * 50615000 C RB,AWF4 COMMENT? 50620000 BE MCBODCOM ORDINARY COMMENT IF EQUAL 50625000 OI MCLBFLG2,$MACTFLG GLBL'S, ETC. NO LONGER OK S 50630000 MCBDSTIN EQU * 50635000 CLI AVMFLDT1,C'.' SEQ SYMBOL? 50640000 BE MCBDOPCD PROCESS OPCODE IF YES 50645000 L RA,AVMFLD1 ELSE GET PNTR TO LABEL FIELD 50650000 LTR RA,RA LABEL PRESENT 50655000 BZ MCBDOPCD PROCESS OPCODE IF NOT 50660000 BAL RET,MCBDPFLC CREATE PRINT BSU, NON COMMENT TYPE A 50665000 IC RB,AVMFLDL1 GET LENGTH OFLABEL FIELD 50670000 SR RC,RC SET TERMINAL CHAR INDICATOR S 50675000 BAL RET,MCBDSCAN SCAN LABEL FIELD 50680000 MCBDOPCD EQU * 50685000 CLI AVMFLDL2,X'00' OPCODE EXISTS? 50690000 BE MCBDSFIN FINI IF NOT 50695000 MVC MCBDFLDS(5),AVMFLD2 ELSE MOVE OPCODE FIELD DATA 50700000 SR RC,RC INDICATE VAR SYMBOLS PRESENT 50705000 BAL RET,MCBDSCFD SCAN OPCODE FIELD 50710000 * A 50710100 * SCANS OPERAND FIELD ALLOWING FOR NON-STANDARD CONTINUATIONS A 50710200 * THAT IS RUNNINF ACROSS UP TO 3 CARDS, BALS TO MCBDSCFD TO TEST FOR A 50710300 *THE DIFFERENT FIELDS. A 50710400 * A 50710500 MCBDOPRN EQU * 50715000 MVC MCBDFLDS(5),AVMFLD3 GET DATA FOR OPRND FILED 50720000 SR RC,RC CLEAR RC FOR VAR SYMBOLS 50725000 BAL RET,MCBDSCFD SCAN OPRND FILED 50730000 MVC MCBDFLDS(5),AVMFLD4 GET DATA FOR COMMENT FIELD 50735000 LA RC,4 INDICATE NO VAR SYMBOLS 50740000 BAL RET,MCBDSCFD SCAN COMMNET FIELD 50745000 CLI AVMFLDL5,0 2ND NON STND CARD? 50750000 BE MCBDSFIN FINI IF NOT 50755000 MVC MCBDFLDS(5),AVMFLD5 GET DATA ON 2ND CARD OPRND 50760000 SR RC,RC INCICATE VAR SYMBOLS 50765000 BAL RET,MCBDSCFD SCAN OPNRD ON 2ND CARD 50770000 MVC MCBDFLDS(5),AVMFLD6 GET DATA ON COMMNET FIELD( IF ANY) 50775000 LA RC,4 INDICATE NO VAR SYMBOLS 50780000 BAL RET,MCBDSCFD SCAN COMMNET FIELD 50785000 CLI AVMFLDL7,0 3RD NON STND CARD? 50790000 BE MCBDSFIN FINI IF NOT 50795000 MVC MCBDFLDS(5),AVMFLD7 GET DATA ON OPRND 50800000 SR RC,RC INDICATE VAR SYMBOLS 50805000 BAL RET,MCBDSCFD SCAN OPRND 50810000 LA RC,4 INDICATE NO VAR CYMBOLS 50815000 BAL RET,MCBDSCFD SCAN 3RD CARD COMMENT(IF ANY) 50820000 * A 50820100 * END OF STATEMENT TEST FOR POSSIBLE INNER MACRO CALL, PROCESS A 50820200 * ELSE, BUMP BSU POINTER, PRINT LINE, AND CONTINUE A 50820300 * A 50820400 MCBDSFIN EQU * 50825000 L RD,MCBDPR2 CREATE BSU A 50830000 CLI AVMFLDT2,C'I' INNER MACRO CALL 50835000 BNE MCBODPR0 SKIP OUT IF NOT INNER MACRO CALL A 50840000 L RD,MCBDINMA GET INNER MACRO BSU A 50860000 B MCBODPR0 PRINT STATEMENT S 50870000 SPACE 2 50880000 **--> INSUB:MCBDFLD CREATES A PRINT BSU+ + + + + + + + + + + + + + +A 50880100 *+ +A 50880200 *+ CALLED TO CREATE A BSU SO STMT WILL BE PRINTED. IT ALSO +A 50880300 *+ BUMPS THE BSU POINTER +A 50880400 *+ +A 50880500 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 50880600 SPACE 2 A 50880700 MCBDPFLC SR RC,RC ENTRY NON COMMENT TYPE PRINT BSU A 50884000 MCBDPFLD EQU * 50885000 LR RD,RA COMPUT OFFSET A 50890000 S RD,MCBDSRPT A 50895000 SLL RD,8 MOVE TO RIGHT BYTE A 50895050 AL RD,MCBPRBSU(RC) GET PRINT BSU OR PRINT/COMMENT BSU A 50895100 NI AVMBYTE2,255-($MTERM+$MOPRTR) TURN OFF PREV IND FLAG 50900000 OI AVMBYTE2,$MOPRTR SET PREV INDICATOR TO OPRTR 50905000 BAL RE,MCBDBMP0 BUMP BSU POINTER A 50910000 BR RET 50915000 SPACE 2 50920000 **--> INSUB:MCBDSCFN LOOKS FOR FIELDS + + + + + + + + + + + + + +A 50920100 *+ +A 50920200 *+ SCAN FIELDS IN STMT, CREATES BSU'S, IF ONE EXISTS. RETURNS S 50920300 *+ THE LENGTH AND ENDING ADDRESS. +A 50920400 *+ +A 50920500 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 50920600 SPACE 2 A 50920700 MCBDSCFD EQU * 50925000 ST RET,MCBDSAVE SAVE RETURN @ 50930000 L RA,MCBDFLD GET POINTER TO FIELD 50935000 LTR RA,RA FIELD EXISTS? 50940000 BZ MCBDSCFN FINI IF NOT 50945000 SR RB,RB CLEAR RB TO CARRY LENGTH 50950000 IC RB,MCBDFLDL GET LENGTH OF FIELD 50955000 BAL RET,MCBDPFLD CREATE BSU 50960000 BAL RET,MCBDSCAN SCAN FIELD 50965000 MCBDSCFN EQU * 50970000 L RET,MCBDSAVE RESTORE RETURN @ 50975000 BR RET AND RETURN 50980000 MCBDSAVE DS F CORE FOR RETURN @ 50985000 MCBDFLDS DS 0F TEMP STORAGE FOR FIELD INFO 50990000 MCBDFLD DS F POINTER TO FILED 50995000 MCBDFLDL DS C LENGTH OF FIELD 51000000 MCBDFLDT DS C TYPE OF FIELD 51005000 SPACE 2 51010000 * A 51010100 * PROCESSES INNER MACRO CALLS MOVES OPCODE IN FIELD, SEARCHES A 51010200 * FOR NAME IF LIBRARY, IF NOT THERE, MAKES NOTE OF REFERENCE FOR LATEA 51010300 * SEARCH OR POSSIBLE ERROR A 51010500 MCBDINMC EQU * 51015000 OI MCLBFLG2,$MACTFLG GLBL'S, ETC. NO LONGER OK S 51020000 SR R2,R2 CLEAR R2 FOR EX INST 51025000 L R1,AVMFLD2 GET OPCODE @ 51030000 IC R2,AVMFLDL2 GET LENGTH OF OPCODE 51035000 BCTR R2,0 DECR BY ONE FOR EX INST 51040000 MVC AVMSYMBL,AWBLANK CLEAR PREVIOUS NAME 51045000 EX R2,MCBDINM1 MOVE OPCODE TO AVMBL A 51050000 MVC AVMSYMLN,AVMFLDL2 MOEE LENGTH 51065000 USING MACLIB,RC 51070000 L RC,AVMACLIB GET @ OF MACLIB 51075000 $CALL MACFND SEARCH MACRO LIBRARY 51080000 LTR RB,RB SYMBOL FOUND? 51085000 BZ MCBDSTIN PROCESS IF YES IN STRING CODE 51090000 LA RE,$LMACLIB GET LENGTH OF MACLIB ENTRY 51095000 $ALLOCL RD,RE,MCBODOVR GET SPACE FOR ENTRY 51100000 ST RD,MCLIBNXT SAVE LINK IN PREV ENTRY 51105000 LR RC,RD MOVE BASE TO RC 51110000 MVC MACLIB($LMACLIB),AWZEROS ZERO NEW ENTRY 51115000 MVC MCLBNMLN(9),AVMSYMLN MOVE NAME INTO LIB ENTRY 51120000 B MCBDSTIN 51125000 MCBDINM1 MVC AVMSYMBL($),0(R1) DUMMY FOR EXECUTE INSTRUCTION A 51125100 DROP RC CLEAR USING 51130000 SPACE 2 51135000 MCBDSCAN EQU * 51140000 **--> INSUB:MCBDSCAN SCANS STATEMENTS IN A MOCOR DEFINITION + + + + +A 51140100 *+ +A 51140200 *+ SETS DIFFERENT TRT TABLES UP DEPENDING ON WHERE CALLED FORM +A 51140300 *+ IN ROUTINE +A 51140400 *+ CHECKS BSU LIST AS TO WHICH VARIABLES NEED CONCATINATION +A 51140500 *+ CREATES BSU & SETS FLAGS AS THE CONDITIONS WARRENT +A 51140600 *+ SCANS STRINGS AND PROCESSES EXPRESSIONS WITH & VARIABLES +A 51140700 *+ +A 51140800 *+ NOTE: WE ASSUME THAT A PERIOD SHOWS CONCATENATION ONLY IF +J 51140820 *& USED IMMEDIATELY AFTER A SET VAR/PARAMETER. +J 51140830 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51140900 SPACE 2 A 51140950 ST RET,MCBDSAV SAVE RETURN @ 51145000 LA RY,0(RB,RA) GET DELIM @ 51150000 LTR RC,RC LOOK FOR &'S? 51155000 BNZ MCBDSC01 SKIP IF NO 51160000 MCBDSC00 $SETRT ('&&',4) SET TO STOP ONLY ON & J 51165000 MCBDSC01 EQU * 51170000 LR R0,RA COPY SCAN POINTER 51175000 MCBDSC0A EQU * 51180000 XSNAP T=NO,STORAGE=(*AVRSBLOC,*AVRSBLOC+80,*0(RW),*8(RW)), S#51181000 LABEL=' MCBDSC0A ',IF=(AVTAGSM,O,AJOMACRH,TM) S 51182000 LR RB,RY GET FINAL @ IN RB 51185000 SR RB,RA GET LENGTH IN RB 51190000 LR R1,RY COPY DELIM @ IN R1 FOR TRT 51195000 SR R2,R2 CLEAR R2 51200000 IC R2,0(RA) GET 1ST CHAR 51205000 LA RE,AWTZTAB(R2) USE AS PNTR TO TRT TABLE 51210000 CLI 0(RE),X'04' '&', '.' OR BLANK? 51215000 BE MCBDSCMP '&&' IF EQUAL 51225000 MCBDSC02 EQU * FALL THRU MEANS NONTERMIANL 51230000 TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 51235000 BO MCBDSC03 PROCEED IF YES 51240000 BAL RET,MCBDCATI ELSE INSERT CAT OPRTR 51245000 MCBDSC03 EQU * 51250000 EX RB,MCBDTRSC SCAN STRING 51255000 CLC 0(2,R1),=C'&&&&' STOP ON DOUBLE &? 51260000 BNE MCBDSC04 51265000 LA RA,2(R1) BUMP PAST &'S 51270000 B MCBDSC0A AND RESUME SCAN 51275000 MCBDSC04 EQU * 51280000 LR RA,R0 ELSE GET START @ 51285000 LR RB,R1 MOVE DELIM@ TO RB 51290000 $CALL MCGTST MOVE STRING TO LOW CORE 51295000 OI MCBSFLGS,$MTERM+$BSCHAR SET BSU FLAGS 51300000 MVI MCBSINDX,$BSTRING SET BSU INDEX 51305000 STC RD,MCBSTRLN STORE LEN IN BSU 51310000 ST RC,MCBSLOC SAVE @ OF STING IN BSU 51315000 NI AVMBYTE2,255-($MTERM+$MOPRTR) TURN OFF PREV IND FLAG 51320000 OI AVMBYTE2,$MTERM SET PREV FLAG TO TERM 51325000 BAL RE,MCBDBMP BUMP BSU OINTER 51330000 CR RA,RY END OF STRING? 51335000 BNL MCBDSCFT JUMP TO FOOT IF YES 51340000 B MCBDSC01 ELSE RESUME SCAN 51345000 MCBDSCMP EQU * 51350000 CLI 1(RA),C'&&' TWO '&&'S? 51355000 BNE MCBDSCM1 CONTINUE IF NOT 51360000 LA RA,2(RA) BUMP SCN PNTR PAST &&'S 51365000 B MCBDSC0A AND RESUME SCAN 51370000 MCBDSCM1 EQU * 51375000 TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 51380000 BO MCBDSCM2 PROCEED IF YES 51385000 BAL RET,MCBDCATI ELSE INSERT CATEN OPRTR 51390000 MCBDSCM2 EQU * 51395000 OI AVMBYTE4,$MINSTRN SET IN STRING FLAG 51400000 LR RC,RW MOVE BSU PNTR TO RC 51405000 $SETRT ('&&',0) CLEAR TRT TABLE FOR MACLEX J 51410000 XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='MCBDSCAN -- BSU #51411000 BEFORE CALL TO MACLEX',IF=(AVTAGSM,O,AJOMACRH,TM) 51412000 $CALL MACLEX 51415000 LR RW,RC RESTORE BSU POINTER 51420000 LTR RB,RB ERROR? 51425000 BNZ MCBDPRER JUMP OUT IF YES 51430000 CR RA,RY SCAN FINI? 51435000 BNL MCBDSCFT JUMP OUT IF YES 51440000 * CHECK FOR . AFTER &VARIABLE - ONLY CASE IN WHICH . J 51445000 * IS NOT AN ORDINARY CHARACTER. J 51450000 CLI 0(RA),C'.' . AFTER &VARIABLE ? J 51455000 BNE MCBDSC00 NO, GO BACK FOR NEXT SCAN J 51460000 LA RA,1(,RA) YES, BUMP OVER = CONCATENATION J 51465000 B MCBDSC00 GO BACK FOR NEXT CHARACTER J 51470000 MCBDSCFT EQU * 51485000 $SETRT ('&&',0) MAKE SURE TRT TABLE CLEARED J 51490000 XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='MCBDSCAN -- BSU #51493000 BEFORE RETURN ',IF=(AVTAGSM,O,AJOMACRH,TM) 51494000 L RET,MCBDSAV RESTORE RETURN @ 51495000 BR RET AND RETURN 51500000 MCBDSAV DS F CORE FOR RETURN @ 51505000 MCBDTRSC TRT 0(0,RA),AWTZTAB DUMMY TO SCAN STRING 51510000 SPACE 2 51515000 * ORDINARY COMMENT, SET UP BSU AND CRETE CODE A 51515100 * A 51515200 MCBODCOM EQU * 51520000 L RD,MCBPRBSU CREATE BSU A 51525000 OI AVMBYTE2,$MOPRTR SET PREV FLAG TO OPERTR 51530000 BAL RE,MCBDBMP0 BUMP BSU POINTER A 51535000 SR RB,RB 51540000 IC RB,AVRSBLOC GET LENGTH-1 OF STMT 51545000 S RB,AWF3 DECR FOR STND PART 51550000 L RA,MCBDSRPT GET PNTR TO SOURCE 51555000 LA RC,4 INDICATE NO TERMINAL CHARS 51560000 BAL RET,MCBDSCAN SCAN COMMENT STMT 51565000 L RD,MCBDPR2 CREATE BSU A 51570000 BAL RE,MCBDBMP0 BUMP BSU POINTER A 51580000 B MCBODPRC JUMP AND GENRATE CODE 51585000 TITLE '***MCBODY - MEND, PRINT, ERROR ETC. ROUTINES***' 51590000 **--> INSUB:MCBDCATI CREATE CONCOT BSU+ + + + + + + + + + + + + + +A 51590100 *+ +A 51590200 *+ CONCATENATION OPERATION NEEDED. IN CASE OF VARIABLES THAT +A 51590300 *+ HAVE TO BE COMBINED (IE IN SETC STMT) +A 51590400 *+ +A 51590500 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51590600 SPACE 2 A 51590700 MCBDCATI EQU * ROUTINE TO INSERT CATEN OPRTR 51595000 L RD,MCBDCAT CREATE BSU A 51600000 NI AVMBYTE2,X'FF'-($MTERM+$MOPRTR) TURN OFF PREV BSU FLAG 51615000 OI AVMBYTE2,$MOPRTR SET PREV BSU FLAG 51620000 LR RE,R14 COPY RETURN @ TO MCBDBMP0 REG S 51625000 * *** FALL THRU INTO MCBDBMP0 -- MUST IMMEDIATELY FOLLOW *** S 51630000 SPACE 2 51635000 **--> INSUB: MCBDBMP BUMPS BSU POINTER + + + + + + + + + + + + +A 51640000 *+ +A 51645000 *+ CALLED WHENEVER BSU ADDED & NEED POINTER MOVED +A 51645100 *+ +A 51645200 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51645300 SPACE 2 A 51645400 MCBDBMP0 ST RD,MCBSU FILL IN BSU A 51645500 MCBDBMP EQU * 51650000 XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='BSU - MCBDBMP', #51651000 IF=(AVTAGSM,O,AJOMACRH,TM) 51652000 LA RW,8(RW) BUMP BSU POINTER 51655000 C RW,AVMCHLIM WORK AREA EXCEEDED? 51660000 BL MCBDBMP1 OK IF NOT 51665000 LA RB,$ERVTMTR ELSE SET TOO MANY TERMS FLAG 51670000 B MCBDPRER AND FLAG STATEMNT 51675000 MCBDBMP1 EQU * 51680000 MVC MCBSU(8),AWZEROS ZERO NEW BSU 51685000 BR RE AND RETURN 51690000 SPACE 2 51695000 * OVERFLOW CALL EXIR ROUTINE A 51695100 MCBODOVR EQU * 51700000 L REP,AVMOVRFL GET @ OF OVERFLOW ROUTINE 51705000 BR REP BRANCH THERE 51710000 SPACE 2 51715000 MCLMXDER EQU * 51720000 L RA,AVRSBPT GET SOURCE BLOCK @ 51725000 LA RA,RSB$L(RA) BUMP TO GET SOURCE STMT 51730000 LA RB,$ERILCNV SET ILLEGAL CONVERSION ERROR FLAG 51735000 B MCBDPRER 51740000 EJECT S 51745000 **--> INSUB:MCBDPR PRINT STATEMENTS + + + + + + + + + + + + + + +A 51745100 *+ +A 51745200 *+ CALLED EACH TIME STATEMENTS NEEDS TO BE PRINTED. TEST FOR SEQ +A 51745300 *+ SYMBOL, IF PRESENT TEST FOR ALREADY DEFINED, IF NOT ENTER INTO +A 51745400 *+ LIST OF SYMBOLS & THEN PRINT, CONTINUES ' READING' STMTS +A 51745500 *+ AND STOPS WHEN MEND FLAG SET. +A 51745600 *+ +A 51745700 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51745800 SPACE 2 A 51745900 MCBODPR0 BAL RE,MCBDBMP0 BUMP BSU POINTER A 51745950 MCBODPR EQU * 51750000 AIF (&$DEBUG).MCBODPR 51755000 L R1,AVMCHSTR GET @ OF BSU WORKAREA 51760000 XSNAP LABEL='***BSU''S***',STORAGE=(*0(R1),*170(R1)),IF=(AVMSNX51765000 BY1,O,$MSNP08,TM) 51770000 .MCBODPR ANOP 51775000 USING MCSEQ,RC SET USING FOR SEQ SYMBOL ENTRY 51780000 TM MCLBFLG2,$MLCLFLG DEFINITION TYPE STMT? S 51785000 BC 12,MCBODPR1 IF YES, JUMP AND PRINT 51790000 MCBODPRC EQU * 51795000 LR RC,RX COPY MACLIB POINTER 51800000 $CALL MCGNCD ELSE GENERATE CODE 51805000 AIF (NOT &$MACOPC).MCBODYC SKIP IF NOT OPEN CODE S 51806000 TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 51806100 BO MCBODPR1 IF YES, SKIP PROCESSING S 51806200 .MCBODYC ANOP S 51806300 CLI AVMFLDT1,C'.' SEQ SYMBOL PRESENT? 51810000 BNE MCBODPR1 JUMP AND PRINT IF NOT 51815000 SR RE,RE 51820000 IC RE,AVMFLDL1 GET LENGTH OF SYMBOL 51825000 BCTR RE,0 REDUCE FOR EX INSTRUCTION 51830000 L RA,AVMFLD1 GET @ OF SEQ LABEL 51835000 MVC AVMSYMBL,AWBLANK BLANK OUT COMMON AREA 51840000 EX RE,MCBDPR1 EX MOVE INSTRUCTION A 51845000 L RC,AVMSEQPT GET POINTER TO SEQ SYM ENTRIES 51860000 $CALL MACFND SEARCH SYMBOL DICT 51865000 LTR RB,RB PRESENT? 51870000 BZ MCBODPR2 JUMP IF YES 51875000 LA RB,$LMCSEQ ELSE GET LENGTH OF ENTRY 51880000 $ALLOCH R1,RB,MCBODOVR GET SPACE FOR ENTRY 51885000 ST R1,MCSEQNXT STORE POINTER IN PREV ENTRY 51890000 LR RC,R1 MOVE BASE TO NEW ENTRY 51895000 MVC MCSEQNAM,AVMSYMBL MOVE NAME INTO ENTRY 51900000 OI MCSEQFLG,X'FF' SET DEFINED FLAG 51905000 MVC MCSEQNXT,AWZEROS ZERO LINK POINTER 51910000 MVC MCSEQVAL,AVMCRINS MOVE INST @ INTO ENTRY 51915000 B MCBODPR1 JUMP AND PRINT 51920000 MCBODPR2 EQU * 51925000 CLI MCSEQFLG,X'FF' ALREADY DEFINED? 51930000 BNE MCBODPR3 JUMP AND PROCESS IF NOT 51935000 LA RB,$ERMULDF ELSE SET MULT DEF FLAG 51940000 $CALL ERRLAB AND FLAG STATEMENT 51945000 B MCBODPR1 PRINT STMNT 51950000 MCBODPR3 EQU * 51955000 L RE,MCSEQVAL GET @ OF INST 51960000 USING MCOPQUAD,RE SET USING FOR ONE OP ENTRY 51965000 MCBODPR4 EQU * 51970000 MVC MCARG2LC,AVMCRINS MOVE INST @ INTO ONE OP ENTRY 51975000 L RE,MCRESULT GET NEXT POINTER 51980000 LTR RE,RE POINTER PRESENT? 51985000 BNZ MCBODPR4 IF YES, UPDATE NEXT ENTRY IN LIST 51990000 MVI MCSEQFLG,X'FF' ELSE SET DEFINED FLAG IN ENTRY 51995000 MVC MCSEQVAL,AVMCRINS SET VALUE IN ENTRY 52000000 DROP RE 52005000 SPACE 52010000 MCBODPR1 EQU * 52015000 AIF (NOT &$MACOPC).MCBODYD SKIP IF NOT OPEN CODE S 52016000 TM AVPRINT1,AVPRSAVE LISTING CONTROL = SAVE ? S 52016100 BNO MCBODP1A BRANCH IF NOT S 52016200 SR RE,RE ZERO FOR BYTE REGS USE A 52016210 IC RE,AVRSBLOC GET LENGTH-1 A 52016220 SH RE,=AL2(RSB$L) DECREMENT LENGTH FOR MXMVSR A 52016230 STC RE,AVRSBLOC RESTORE IT A 52016240 $CALL MXMVSR SAVE STATEMENT A 52016300 B MACBODRT RETURN S 52016400 MCBODP1A EQU * S 52016500 .MCBODYD ANOP S 52016600 LA RB,$OUCOMM 52020000 $CALL OUTPT2 PRINT STATEEMNT 52025000 CLI OPCHEX,$MEND MEND STATEMENT? 52030000 BE MACMEND1 CLEAN UP IF YES 52035000 B MCBOD01 ELSE READ NEXT STMNT 52040000 DROP RC 52045000 SPACE 2 52050000 MCBDCHLB EQU * 52055000 ST RET,MCBDCHSV SAVE RETURN ADDRESS 52060000 CLI AVMFLDT1,C'.' SEQ SYMBOL? 52065000 BE MCBDCHFT OKAY IF YES 52070000 CLI AVMFLDL1,X'00' NO LABEL? 52075000 BE MCBDCHFT OKAY ALSO 52080000 LA RB,$ERILLAB ELSE SET BAD LABEL FLAG 52085000 $CALL ERRLAB AND FLAG STMT 52090000 MCBDCHFT EQU * 52095000 L RET,MCBDCHSV RESTORE RETURN @ 52100000 BR RET AND RETURN 52105000 MCBDCHSV DS F CORE FOR RETURN @ 52110000 MCBDPR1 MVC AVMSYMBL($),0(RA) DUMMY MOVE FOR LABEL A 52110100 SPACE 2 52115000 MCGBINVD LA RB,$ERINVDM INVALID DLM A 52116000 B MCBDPRER GO FLAG ERROR A 52116500 SPACE 1 A 52117000 MCGBMD L RA,AVMTSCNP GET @ OF 1ST CHAR OF VAR NAME A 52118000 LA RB,$ERMULDF SHOW MULTIPLR DEFN A 52118100 B MCBDPRER GO FLAG A 52118200 SPACE 1 A 52118300 MCBDOPER EQU * 52120000 LA RA,AVRSBLOC+RSB$L+20 GUESS AT OPRND ADDRESS A 52125000 LA RB,$ERNOOPR SET NO OPRND FLAG 52130000 SPACE 2 52140000 * S 52140100 * PRINTS AN APPROPRIATE MESSAGE & SETS ERR INDX IN BSU A 52140200 * A 52140300 MCBDPRER EQU * 52145000 L RW,AVMCHSTR SET BSU PNTR TO START OF WORK AREA 52150000 LR RD,RA COMPUT OFFSET A 52155000 S RD,AVRSBPT A 52170000 SLL RD,8 MOVE TO RIGHT BYTE A 52170050 AL RD,MCBDERR A 52170100 BAL RE,MCBDBMP0 BUMP BSU POINTER A 52175000 $CALL ERRTAG FLAG STMNT 52180000 B MCBODPR JUMP AND PRINT STATEMENT 52185000 SPACE 2 52190000 MCBDISER EQU * 52195000 LA RB,$ERINVSY SET INVALID SYMBOL FLAG 52200000 B MCBDPRER AND FLAG STATEMENT 52205000 SPACE 2 52210000 * A 52215000 * END OF ROUTINE, SET OP POINTERS TO ONE-OP ENTRIES PRINTS A 52220000 * OUT ERROR MESSAGES & DEBUG ADDRESS FOUND & STORED A 52225000 * A 52225100 MACMEND1 EQU * 52230000 USING MCOPQUAD,RE 52235000 USING MCSEQ,RC 52240000 L RC,AVMSEQPT GET @ OF SEQ SYM LIST 52245000 USING RSBLOCK,RZ NOTE USING FOR OUTPPUT RECORD 52250000 L RZ,AVRSBPT SET BASE FOR OUTPUT RECORD 52255000 MVC RSBLOCK(RSB$L+L'MCMNERMS),MCMNERMF SET FLAGS S 52255100 MACMEND2 EQU * 52260000 CLI MCSEQFLG,X'FF' SYMBOL DEFINED? 52265000 BNE MACMEND3 PROCESS IF NOT 52270000 MACMENDN EQU * 52275000 L RC,MCSEQNXT SET BASE TO NEXT ENTRY 52280000 LTR RC,RC LAST ENTRY? 52285000 BNZ MACMEND2 IF NOT, RESUME SEARCH 52290000 B MACMEND5 ELSE JUMP TO FOOT 52295000 MACMEND3 EQU * 52300000 L RE,MCSEQVAL GET @ OF ONE OP ENTRY 52305000 MACMEND4 EQU * 52310000 MVC RSBSOURC+L'MCMNERMS(6),AWEP6 PUT EDIT MASK IN OUTPUT 52345000 L R1,MCRESULT COPY LINK TO NXT SEQ ERROR TEMP 52350000 L RE,MCARG2LC MOVE BASE TO 1ST ONE-OP 52355000 ED RSBSOURC+L'MCMNERMS(6),MCQSTMNO EDIT STMT NBR TO FLD 52360000 MVI MCQS1FLG,$BSERR01 SET ERROR MSG OPCODE A 52370000 LA RB,$OUCOMM SET PRINT FLAG 52380000 LR R0,RC COPY RC TEMPORARILY 52385000 $CALL OUTPT2 PRINT ERROR MESSAGE 52390000 LR RC,R0 RESTORE RC 52395000 LTR RE,R1 SET BASE TO NEXT SEQ ERR ENTRY S 52400000 BNZ MACMEND4 PRINT NEXT MESSAGE IF NOYT 52410000 B MACMENDN RESUME SCAN OF SEQ SYMBOL DICT 52415000 MACMEND5 EQU * 52420000 LA RC,$LMCSEQ GET LENGTH OF SEQ ENTRY 52425000 L R1,AVADDHIH GET PNTR FOR DEBUG STMNT 52430000 A RC,AVMSEQPT ADD ORIGINAL POINTER 52435000 ST RC,AVADDHIH RELEASE STORAGE IN HIGH END 52440000 SPACE 2 52445000 MACBODRT EQU * 52450000 AIF (&$DEBUG).MACBODR 52455000 L R2,AVMSEQPT GET @ OF SEQ SYM TABLE FOR DEBUG 52460000 XSNAP LABEL='***MCBODY EXITED***',STORAGE=(*0(R1),*0(R2)),IF=(X52465000 AVMSNBY1,O,$MSNP07,TM) 52470000 .MACBODR ANOP 52475000 SR RB,RB CLEAR RB FOR RETURN 52480000 $RETURN RGS=(R14-R6) 52485000 MCBDSRPT DS F WORD FOR RSBSOURC @ 52490000 MCB##SAV DS F RETURN @ FROM MCB## ROUTINES J 52490100 MCBPRBSU DC AL1($MOPRTR,$BSPRINT,0,$MPRNTHR) PRINT BSU 52495000 MCBPRBSV DC AL1($MOPRTR+$MPRCOM,$BSPRINT,0,$MPRNTHR) COMMENT PRM A 52495001 * ***** BSU TABLE - FIRST FULLWORDS OF MANY BSU'S. ***** J 52495050 MCBDERR DC AL1($MOPRTR,$BSERR01,0,$MPRNTHR) A 52495100 MCBDSET DC AL1($MOPRTR,$BSETA,0,$MSETHR) A 52495200 MCBDAGO DC AL1($MOPRTR,$BSAGO,0,$MAGOHR) A 52495300 MCBDSTG1 DC AL1($MTERM+$BSCHAR,$BSTRING,0,11),A(MCMNOTMS) WHOLE BS J 52495400 MCBDSTG2 DC AL1($MTERM+$BSCHAR,$BSTRING,0,2),A(MCMNOT1C) WHOLE BSU J 52495500 MCBDPR2 DC AL1($MOPRTR,$BSMVSTM,0,$MPRNTHR) A 52495600 MCBDPR3 DC AL1($MOPRTR,$BSMVSTM+$BSMNTER,0,$MPRNTHR) A 52495650 MCBDAIF DC AL1($MOPRTR,$BSAIF,0,$MAIFHR) A 52495660 MCBDCAT DC AL1($MOPRTR,$BSCAT,0,$MCATHR) A 52495700 MCBDINMA DC AL1($MOPRTR,$BSINMAC,0,$MPRNTHR) INNER MACRO BSU A 52495750 MCBDLABL DC AL1($MTERM,$BSLABEL,0,0) A 52495760 MCMNERMF DC AL1(L'MCMNERMS+RSB$L+6,$RSBNPNN+$RSBMERR,1,0) A 52495800 MCMNERMS DC C'220 UNDEFINED SEQUENCE SYMBOL IN STATEMENT' 52500000 LTORG 52505000 DROP RAT,RW,RX,R13,RC,RZ,RE 52510000 TITLE '***MACLEX - LEXICAL SCAN OF EXPRESSIONS***' 52515000 **--> CSECT: MACLEX THIS PROCEDURE SCANS A MCRO STATEMENT AND * 52520000 *. CONVERTS IT INTO BSU'S. ALSO CHECKS FOR SUCH ERRORS AS TWO * 52525000 *. TERMS OR TWO OPERATORS IN A ROW. WHERE NECESSARY IT INSERTS* 52530000 *. CATENATION OPERATORS WHERE CATENATION IS IMPLICIT * 52535000 *. * 52540000 *. ENTRY CONDITIONS * 52545000 *. RA = @ OF FIRST CHARACTER OF EXPRESSION * 52550000 *. RC = @ ON NEXT AVAILABLE BSU IN WORKSPACE * 52555000 *. * 52560000 *. EXIT CONDITIONS * 52565000 *. RA = @ OF DELIM PAST EXPRESSION IF NO ERROR * 52570000 *. = @ OF ERROR IF ERROR PRESENT * 52575000 *. RB = 0 IF OKAY * 52580000 *. = $ERMSSGE IF ERROR * 52585000 *. RC = @ OF NEXT AVAILABLE SPACE FOR BSU * 52590000 *. * 52595000 *. CALLS MCGTST,MCDTRM,SDBCDX,MCSYSR,MCATRM,MCGTST * 52600000 *. USES DSECTS: AVWXTABL,MCBSU,MCPARENT,MCGLBDCT,MCLCLDPV * 52605000 *. USES MACROS: $SAVE,$RETURN,$ALLOCL,$SCOF,$SCPT,$CALL,$SETRT * 52610000 *. * 52615000 *. REGISTER USAGE A 52615100 *. WORK REGS: R0,R1,R2,RY,RZ,RB,RC,RE A 52615150 *. USED FOR TRT: R1,R2 A 52615200 *. RW-BASE REG FOR BSU A 52615250 *. R13 BASE REG FOR THIS CSECT A 52615300 *. RAT- BASE REGISTER FOR MAIN TABLE A 52615350 *. RX-UNUSED A 52615400 *. RD-? A 52615450 *. A 52615500 *** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 52620000 SPACE 2 52625000 MACLEX CSECT 52630000 $SAVE RGS=(R14-R6),SA=*,BR=13 52635000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 52640000 XSNAP LABEL='***MACLEX ENTERED***',T=NO,IF=(AVMSNBY2,O,$MSNP09X52645000 ,TM) 52650000 USING MCBSU,RW SET USING FOR BSU ENTRY 52655000 LR RY,RC COPY ADDR OF NEXT BSU A 52655100 S RY,=F'8' GET ADDR OF PRECIOUS POINTER A 52655200 MVC MCBSFLGP(4),0(RY) MOVE PREV BSU INTO WORK AREA A 52655300 SR RY,RY USE RY FOR PAREN COUNT 52660000 LR RW,RC GET @ OF SPACE FOR BSU 52665000 MVI AVMDWRK4,X'00' CLEAR PAREN INFO BYTE 52670000 MVC MCBSU(8),AWZEROS BLANK OUT ENTRY 52675000 NI AVMBYTE1,X'FF'-$MINQUOT CLEAR QUOTE FLAG 52680000 NI AVMBYTE2,X'FF'-$MTERM MAKE SURE TERM FLG IS OFF 52685000 OI AVMBYTE2,$MOPRTR SET OPERATOR FLAG FOR START 52690000 $SETRT ('''',26,'&&',28,'.',30) SET TRT TABLE FOR QUOTE SCAN 52695000 MVI AWTDECT+C'+',18 52700000 MVI AWTDECT+C'-',20 52705000 MVI AWTDECT+C'/',22 MODIFY AWTDECT TABLE FOR TEMPORARY 52710000 MVI AWTDECT+C')',24 USE IN LEXICAL SCAN. THIS SAVES 52715000 MVI AWTDECT+C'''',26 CREATING A NEW TABLE. 52720000 MVI AWTDECT+C'&&',28 52725000 MVI AWTDECT+C'.',30 52730000 B MCLXSTR0 JUMP TO LOOKUP CHAR ROUTINE A 52735000 MCLEXBAS DS 0H 52740000 SPACE 2 52745000 MACLINDX $AL2 MCLEXBAS,(MCLDIGIT,MCLEXERR,MCLSDTRM,MCLALPHA,MCLMULT,MCX52750000 LEQUAL,MCLXLPAR,MCLCOMMA,MCLBLANK,MCLPLUS,MCLMINUS,MCLDIX52755000 VID,MCLXRPAR,MCLQUOTE,MCLAMPRS,MCLPEROD) 52760000 SPACE 2 52765000 * TRT TABLE SET-UP, LOOK UP CHARACTER OF EXPRESSIO AND GO TO THE A 52765100 * ROUTINE TO PROCESS THE EXPRESSION. A 52765200 MCLXSTRS EQU * S 52765300 LA RA,1(R1) BUMP SCAN POINTER S 52765400 MCLXSTRT EQU * 52770000 MCLXSTR0 EQU * A 52770200 LR R0,RA COPY SCAN POINTER 52775000 MCLXSCAN EQU * 52780000 SR R1,R1 ZERO R1 FOR TRT USE 52785000 SR R2,R2 USE R2 IN TRT INST 52790000 TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 52795000 BO MCLX01 USE LIMITEE TRT IF YES 52800000 MCLX03 EQU * 52805000 TRT 0(1,RA),AWTDECT LOOKUP NEXT CHAR 52810000 B MCLX02 AND JUMP TO GET ROUTINE 52815000 MCLX01 EQU * 52820000 TM AVMBYTE2,$MINAPAR+$MDIMVAR PAREN EXPRESSSION EXPECTED? 52825000 BC 5,MCLX03 IF YES, USE REGULAR TRT 52830000 TRT 0(200,RA),AWTZTAB 52835000 MCLX02 EQU * 52840000 LH RE,MACLINDX(R2) GET HALFWORD OFFSET FROM TABLE 52845000 B MCLEXBAS(RE) ADD TO BASE AND JUMP TO ROUTINE 52850000 SPACE 2 52855000 * DIGIT FOUND, CHECK TO SEE IF PROPER CONST, CONVERT IT, SET UP A 52855100 * BSU WITH CONSTANT VALUE, DECREMENT # BSU COUNTER & PROCESS A 52855200 MCLDIGIT EQU * 52860000 TM AVMBYTE2,$MINARIT+$MINAPAR+$MINBOOL CONSTANT OKAY? 52865000 BZ MCLXSYER IF NOT, JUMP AND FLAG 52870000 $CALL MCDTRM CONVERT CONSTANT 52875000 LTR RB,RB OK? 52880000 BNZ MCLXERTN RETURN IF NOT 52885000 MVI MCBSINDX,$BSIMMA SET IMMED ARITH INDEX 52890000 OI MCBSFLGS,$BSAR INDICATE ARITH IN BSU 52895000 ST RC,MCBSVALU STORE VALUE IN BSU 52900000 S RC,AWF1 DECR BY 1 52905000 BH MCLXTRMF IF > 1 THEN FINI 52910000 OI MCBSFLGS,$BSBOOL ELSE FLAG AS BOOLEAN CONSTANT ALSO 52915000 B MCLXTRMF JUMP TO TERM FOOT 52920000 SPACE 2 52925000 * POSSIBLE SELF DEFINING TERM, CHECK NEXT CHAR, IF QUOTE, ALPHA, A 52925100 * ELSE CHECK FOR OK SDT.-SETS FLAGS ETC. A 52925200 MCLSDTRM EQU * 52930000 CLI 1(R1),C'''' NEXT CHAR = '? 52935000 BNE MCLALPHA PROCESS ALPHA IF NOT 52940000 $CALL SDBCDX CHECK FOR SELF DEFINING TERM 52945000 LTR RB,RB OKAY? 52950000 BM MCLALPHA MAY BE L', BRANCH A 52953000 BP MCLXERTN BAD SDTERM IF RB > 0 A 52955000 TM AVMBYTE2,$MINARIT+$MINAPAR+$MINBOOL IN OKAY EXPRESSION? 52960000 BZ MCLXSYER ERROR IF NOT 52965000 OI MCBSFLGS,$BSAR+$MTERM SET TYPE TO ARITH TERM 52970000 MVI MCBSINDX,$BSIMMA SET TO ARITH IMMED TYPE INDEX 52975000 ST RC,MCBSVALU STORE VALUE IN BSU 52980000 B MCLXTRMF JUMP TO TERM FOOT 52985000 SPACE 2 52990000 * ALPHA CHAR FOUND, CK ARITH EXPRESSION, PROCESS IF IS, NEXT A 52990100 * CK TYPE ATTR, ERROR IF NOT FIRST CHAR OF OPRND ALSO IF ( A 52990200 * SETS SYSLIST FLAG SEARCHES ATTRIBUTES IN DICTIONARY A 52990300 MCLALPHA EQU * 52995000 TM AVMBYTE2,$MINARIT+$MINBOOL+$MINAPAR IN ARITH EXPRES? 53000000 BM MCLALPH0 PROCEED IF YES 53005000 C R1,AVMFLD3 BEGINNING OF OPRND? 53010000 BNE MCLXSYER ERROR IF NOT 53015000 CLC 0(2,R1),=C'T''' T' ATTIBUTE? 53020000 BNE MCLXSYER ERROR IF NOT 53025000 MCLALPH0 EQU * 53030000 CLI 1(R1),C'''' NEXT CHAR = QUOTE? 53035000 BNE MCLRELOP IF NOT TEST FOR RELOP 53040000 $CALL MCATRM IS IT AN ATTRIBUTE? 53045000 LTR RB,RB 53050000 BM MCLXSYER IF NOT, SET SYNTAX EROR FLAG 53055000 BP MCLXERTN NOT IMPLEMENTED 53060000 STC RC,MCBSINDX STORE TYPE OF ATTRIB IN BSU 53065000 $CALL MCSYSR SEARCH DICTIONARIES 53070000 LTR RB,RB 53075000 BM MCLXISER INVALID SYMBOL IF MINAS 53080000 BP MCLXERTN NOT DEFINED IF RB > 0 53085000 LA RB,$SYMPAR LOAD SYMBOLIC PARAM FLAG 53090000 CR RD,RB IS IT SYM PAR? 53095000 BE MCLA01 IF YES PROCEED 53100000 USING MCPARENT,RC NOTE USING FOR ENTRY 53105000 LA RB,$SYSVAR NEXT CHECK FOR SYSTEM VARIABLE 53110000 CR RB,RD 53115000 BNE MCLXISER IF NOT, FLAG ERROR 53120000 CLI MCPARNLN,8 MUST BE &SYSLIST WITH LENGTH 8 53125000 BNE MCLXISER ERROR IF NOT 53130000 MVC MCBSVALU,AWFM1 INDICATE &SYSLIST WITH -1 53135000 * N'&SYSLIST CAN STAND ALONE SO CHECK FOR LEFT PAREN 53140000 CLI MCBSINDX,$BSATN ATTRIB = N'? 53145000 BNE MCLALPH2 PROCEED IF NOT 53150000 CLI 0(RA),C'(' NEXT CHAR = '('? 53155000 BNE MCLXTRMF PROCESS IF NOT 53160000 MCLALPH1 EQU * 53165000 MVI AVMDWRK4,$MINSYSL SET &SYSLIST FLAG IF PAREN 53170000 B MCLXTRMF 53175000 MCLALPH2 EQU * 53180000 CLI 0(RA),C'(' NEXT CHAR = LEFT PAREN? 53185000 BE MCLALPH1 T' OR K' REQUIRE PAREN 53190000 B MCL$ERI S 53195000 SPACE 53205000 * SYMBOLIC PARAMETER FOUND SET UP BSU, AND CHK LEGALITY A 53205100 MCLA01 EQU * 53210000 LH R2,MCPARNDX GET SYMBOLIC PARAM ID 53215000 ST R2,MCBSVALU STORE IN BSU 53220000 CLI 0(RA),C'(' NEXT CHAR IS '('? 53225000 BNE MCLXTRMF JUMP TO FOOT IF NOT 53230000 OI AVMBYTE2,$MDIMVAR ELSE SET DIM VAR FLAG 53235000 CLI MCBSINDX,$BSATN N' ATTRIB? 53240000 BNE MCLXTRMF OKAY IF NOT 53245000 MCL$ERI LA RB,$ERILAT SET BAD ATTRIB FLAG S 53250000 B MCLXERTN AND RETURN 53255000 SPACE 2 A 53255100 * RELATIONAL OPERATOR FOUND, IF ^BOOL ERROR, ELSE GET OPERAND LENGTHA 53255200 * AND LOOK UP IN TABLE FOR OPERATION WHEN LEGAL OPERATOR FOUND, A 53255300 * SET UP BSU A 53255400 MCLRELOP EQU * 53260000 TM AVMBYTE2,$MINBOOL IN BOOLEAN EXPRESSION? 53265000 BNO MCLXSYER IF NOT, REL OPCODE NOT ALLOWED 53270000 TRT 0(4,RA),AWTSYMT SCAN STRING FOR DELIM 53275000 BZ MCLXSYER ERROR IF > 3 CHARS 53280000 LR R2,R1 COPY DEIIM @ 53285000 SR R2,RA GET LENGTH OF STRING 53290000 BCT R2,MCLARL01 DECR FOR EX INST 53295000 B MCLXSYER ERROR IF ONE CHAR 53300000 MCLARL01 EQU * 53305000 LA RE,MCRLOPTB GET @ OF CONSTANT TABEL 53310000 MCLARL02 EQU * 53315000 EX R2,MCLACMPR COMPARE WITH NEXT ENTRY 53320000 BE MCLARL03 FOUND IF EQUAL 53325000 BL MCLXSYER NOT PRESENT IF < 53330000 LA RE,5(RE) BUMP TABLE POINTER 53335000 B MCLARL02 RESUME SEARCH OF TABEL 53340000 SPACE 53345000 MCLARL03 EQU * 53350000 MVC MCBSINDX,3(RE) SET INDEX 53355000 MVC MCBSHIER,4(RE) SET HIERARCHY IN BSU 53360000 LR RA,R1 BUMP SCAN POINTER 53365000 B MCLXOPRF JUMP TO OPRTR FOOT 53370000 SPACE 2 53375000 MCLACMPR CLC 0(0,RA),0(RE) COMPARE STRING WITH TABLE ENTRY 53380000 MCRLOPTB DC C'AND',AL1($BSAND,$MANDHR),C'EQ ',AL1($BSEQ,$MRELHR) 53385000 DC C'GE ',AL1($BSGE,$MRELHR),C'GT ',AL1($BSGT,$MRELHR) 53390000 DC C'LE ',AL1($BSLE,$MRELHR),C'LT ',AL1($BSLT,$MRELHR) 53395000 DC C'NE ',AL1($BSNE,$MRELHR),C'NOT',AL1($BSNOT,$MNOTHR) 53400000 DC C'OR ',AL1($BSOR,$MORHR),C'999' 53405000 DROP RC 53410000 SPACE 2 53415000 * NEXT BLOCKS WHEN +,-,/,OR * FOUND, SETS HIERARCHY AND SETS UP A 53415100 * THE BSU'S A 53415200 MCLMULT EQU * 53420000 MVI MCBSINDX,$BSMULT SET INDEX TYPE IN BSU 53425000 MCLMHIER EQU * 53430000 MVI MCBSHIER,$MMULTHR SET MULT/DIVID HIERARCHY 53435000 B MCLXARFT JUMP TO ARITH OPRTR FOOT 53440000 SPACE 2 53445000 MCLDIVID EQU * 53450000 MVI MCBSINDX,$BSDIV SET BSU INDEX FOR DIVIDE 53455000 B MCLMHIER JUMP AND SET HIERARCHY 53460000 SPACE 2 53465000 MCLPLUS EQU * 53470000 MVI MCBSINDX,$BSPLUS SET ADDITION INDIX IN BSU 53475000 MCLPHIER EQU * 53480000 MVI MCBSHIER,$MPLUSHR SET HIERARCHY OF OPRTR 53485000 B MCLXARFT JUMP TO ARITH FOOT 53490000 SPACE 2 53495000 MCLMINUS EQU * 53500000 MVI MCBSINDX,$BSMIN SET MINUS INDEX IN BSU 53505000 B MCLPHIER JUMP AND SET SAME HIERARCHY AS PLUS 53510000 SPACE 2 53515000 * CK IF ARITH EXPRESSION, ERROR IF NOT A 53515100 MCLXARFT EQU * 53520000 TM AVMBYTE2,$MINARIT+$MINAPAR+$MINBOOL IN ARITH EXPRESSION 53525000 BZ MCLXSYER ERROR IF NOT 53530000 LA RA,1(R1) BUMP SCAN POINTER 53535000 B MCLXOPRF JUMP TO OPERATOR FOOT 53540000 SPACE 2 53545000 SPACE 2 53555000 * LEFT PAREN FOUND CHECK IF NESTING LEVEL OK, , CHKS & BRANCHES TO A 53555100 * SEE IF 1)SUBSCRIPTED VAR,2)IN SUBSTRING,3)OR SYSLIST A 53555200 MCLXLPAR EQU * 53560000 LA RY,1(RY) BUMP PAREN COUNT 53565000 C RY,=F'6' CHECK NEXTING LEVEL 53570000 BL MCLXLP01 OKAY IF < 6 53575000 LA RB,$ERVPARN ELSE SET TOO MANY PAREN FLAG 53580000 B MCLXERTN AND RETURN 53585000 MCLXLP01 EQU * 53590000 LA RZ,AVMDWRK4(RY) USE RZ AS PNTR TO CURRENT PAREN 53595000 TM AVMDWRK4,$MINSYSL IS &SYSLIST FLAG ON? 53600000 BO MCLXSBSL IF YES MUST BE &SYSLIST PAREN 53605000 TM AVMBYTE2,$MDIMVAR PREV BSU = DIMEN VARIABLE? 53610000 BO MCLXSBSC IF YES, MUST BE SUBSCRIPT LP 53615000 BCTR R1,0 DECR POINTER 53620000 CLI 0(R1),C'''' PREV CHAR = QUOTE? 53625000 LA R1,1(R1) RESTORE POINTER BEFORE TEST 53630000 BE MCLXSBST IF YES MUST BE SUBSTRING LP 53635000 TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 53640000 BNO MCLXSYER ERROR IF NOT 53645000 MVI 0(RZ),X'00' CLEAR FIRST BYTE OF PAREN INFO 53650000 MVI MCBSINDX,$BSLPAR ELSE MUST BE LEFT PAREN 53655000 B MCLXPARF JUMP TO L PAREN FOOT 53660000 SPACE 53665000 * SUBSCRIPT CHECK A 53665100 MCLXSBSC EQU * 53670000 MVI 0(RZ),$MINSBSC IDENTIFY PAREN LEVEL 53675000 MVI MCBSINDX,$BSBSCRP SET BSU INDEX 53680000 OI AVMBYTE2,$MINAPAR INDICATE INSIDE ARITH PARENS 53685000 B MCLXPARF JUMP TO PAREN FOOT 53690000 SPACE 53695000 * SYSLIST CHECK A 53695100 MCLXSBSL EQU * 53700000 MVI 0(RZ),$MINSYSL SET PAREN ID TO SYSLIST 53705000 MVI MCBSINDX,$BSBSYL SET BSU INDEX ALSO 53710000 OI AVMBYTE2,$MINAPAR INDICATE INSIDE ARITH PARENS 53715000 CLI MCBSINDP,$BSATN IS IT THE N' A 53735000 BNE MCLXPARF PROCEED IF NOT 53740000 MVI 0(RZ),$MINSBSC ELSE SET FLAG TO STOP 2 SUBSCRIPTS 53745000 B MCLXPARF JUMP TO L PAREN FOOT 53750000 SPACE 53755000 * SUBSTRING CHECK A 53755100 MCLXSBST EQU * 53760000 MVI 0(RZ),$MINSBST INDICATE PAREN IS SUBSTRING START 53765000 MVI MCBSINDX,$BSBSTR SET BSU INDEX ALSO 53770000 OI AVMBYTE2,$MINAPAR ALSO INDICATE INSIDE ARITH PARENS 53775000 B MCLXPARF JUMP TO L PAREN FOOT 53780000 SPACE 53785000 * FOOT FOR LEFT PAREN A 53785100 MCLXPARF EQU * 53790000 LA RA,1(R1) BUMP SCAN POINTER PAST ( 53795000 MVI MCBSHIER,$MPARHR SET PAREN HIERARCHY 53800000 NI AVMBYTE2,X'FF'-$MDIMVAR TURN OFF DIMVAR FLAG 53805000 MVI AVMDWRK4,X'00' TURN OFF SYSLIST FLAG 53810000 B MCLXDLMF JUMP TO DELIM/OPRTR FOOT 53815000 SPACE 4 53820000 * RIGHT PAREN FOUND CHECKS FOR RIGHT NUMBER AF ARGUMENTS, SEES IF A 53820100 * CORRECT NESTING MOVES SUBSCIPTS INTO BSU, ALWAYS PROCESSED INFO A 53820200 * AND CHECKS FOR MATCHED PARENS(N'LPREN=N'RPAREN) A 53820300 * A 53820400 MCLXRPAR EQU * 53825000 LA RZ,AVMDWRK4(RY) GET @ CURRENT PAREN INFORMATION J 53830000 TM 0(RZ),$MINSBST IN SUBSTRING? 53840000 BNO MCLXRP01 PROCEED IF NOT 53845000 TM 0(RZ),$MINSBST+X'01' TWO ARGUMENTS? 53850000 BNO MCLCOMR1 S 53855000 MCLXRP01 EQU * 53870000 TM AVMBYTE2,$MTERM PREV BSU = TERM? 53875000 BO MCLXRP02 OKAY IF YES 53880000 CLI MCBSINDP,$BSRPAR MUST BE RIGHT RAREN A 53895000 BNE MCLXSYER ERROR IF NOT ) 53900000 MCLXRP02 EQU * 53905000 MVC MCBSLOC+3(1),0(RZ) MOVE NBR OF SUBSCRIPTS INTO BSU 53910000 S RY,AWF1 DECR PAREN COUNT 53915000 BP MCLXRP03 OKAY IF STILL POSITIVE 53920000 BM MCLXSYER ERROR IF NEGATIVE 53925000 NI AVMBYTE2,X'FF'-$MINAPAR TURN OFF ARITH EXPRESSION FLAG 53930000 TM AVMBYTE2,$MINPEXP END OF EXPRESSI6N? 53935000 BO MCLXRP04 IF YES RETURN 53940000 B MCLXRP06 RETURN IF PAREN COUNT IS ZERO 53945000 MCLXRP03 EQU * 53950000 BCTR RZ,0 DECR POINTER TO PAREN INFO 53955000 LR RE,RY COPY PAREN COUNT INTO RE 53960000 MCLXRP05 EQU * 53965000 TM 0(RZ),$MINSBST+$MINSBSC+$MINSYSL IN ARITH EXPRESSION? 53970000 BM MCLXRP06 IF YES RETURN 53975000 BCTR RZ,0 ELLE DECR POINTER AGAIN 53980000 BCT RE,MCLXRP05 DECR PAREN COUNT 53985000 NI AVMBYTE2,X'FF'-$MINAPAR TURN OFF ARITH FLAG IF ZERO 53990000 MCLXRP06 EQU * 53995000 MVI MCBSINDX,$BSRPAR SET RIGHT PAREN INDEX IN BSU 54000000 LA RA,1(RA) BUMP POINTER PAST PAREN 54005000 B MCLXDLMF 54010000 SPACE 54015000 MCLXRP04 EQU * 54020000 MVI MCBSINDX,$BSRPAR SET INDEX IN BSU 54025000 MVI MCBSHIER,$MPARHR SET HIERARCHY 54030000 OI MCBSFLGS,$MOPRTR SET OPRTR FLAG IN BSU 54035000 $SCOF RB,RA,MCBSOFST GET OFFSET IN BSU 54040000 LA RA,1(R1) BUMP SCAN POINTER 54045000 BAL RE,MCLXBMP BUMP BSU 54050000 NI AVMBYTE2,X'FF'-$MINPEXP TURN OFF PAREN EXPR FLAG 54055000 B MCLXFOOT RETURN 54060000 SPACE 2 54065000 * COMMA FOUND, CHECKS VALIDITY AND FLAGS ERRORS A 54065100 * A 54065200 MCLCOMMA EQU * 54070000 LTR RY,RY ARE WE IN PARENS? 54075000 BZ MCLXSYER ERROR IF NOT 54080000 LA RZ,AVMDWRK4(RY) GET PTR TO PAREN INFO A 54085000 TM 0(RZ),$MINSBST+$MINSYSL IN SUBSTR OR SYSLIST? 54095000 BM MCLCOM01 OKAY IF YES 54100000 MCLCOMR1 EQU * 54105000 LA RB,$ERINSBV ELSE SET WRONG NBR ARGS FLAG 54110000 B MCLXERTN AND RETURN 54115000 MCLCOM01 EQU * 54120000 TM 0(RZ),X'01' ONE ARG ALREADY PROCESSED? 54125000 BO MCLCOMR1 ERROR IF YES 54130000 OI 0(RZ),X'01' INDICATE ONE ARG PROCESSED 54135000 MVI MCBSINDX,$BSCOMMA SET BSU INDEX 54140000 MVI MCBSHIER,$MCOMMHR SET HIERARCHY 54145000 LA RA,1(R1) BUMP SCAN POINTER 54150000 B MCLXDLMF JUMP TO DILIM/OPRTR FOOT 54155000 SPACE 4 54160000 * AMPERSANDS FOUND, PROCESS IT. C HECKS FOR VARIABLES, FOR INSIDE A 54160100 * QUOTES, ADDS CONCATINATION OPERATOR WHEN NEEDED, SYBOL PARMS, ETC A 54160200 * ALSO SEARCHES DICTIONARIES AND PROCESS GLOBAL, LOCAL & SYMBOLIC A 54160300 * VARIABLES A 54160400 * A 54160500 MCLAMPRS EQU * 54165000 TM AVMBYTE2,$MINCHAR IN CHAR EXPRESSION? 54170000 BNO MCLAMP00 PROCEED IF NOT 54175000 TM AVMBYTE1,$MINQUOT SHOULD BE IN QUOTES 54180000 BO MCLAMP00 OKAY IF YES 54185000 TM AVMBYTE2,$MINAPAR IN SUBSCRIPT? 54190000 BO MCLAMP00 THIS EXCUSSES ALL 54195000 LA RB,$ERMISQU ELSE SETT MISSING QUOTES FLAG 54200000 B MCLXERTN AND RETURN 54205000 MCLAMP00 EQU * 54210000 TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 54215000 BNO MCLAMPR1 IF NOT, PROCEED 54220000 CLI 1(R1),C'&&' NEXT CAR = &? 54225000 BNE MCLAMP01 PROCEED IF NOT 54230000 LA RA,2(R1) ELSE BUMP SCAN POINTER PAST && 54235000 B MCLXSCAN AND RESUME SCAN 54240000 MCLAMP01 EQU * 54245000 CR R0,R1 STRING PRECEEDING &? 54250000 BE MCLAMPRT PROCESS VAR SYMB IF NOT 54255000 TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 54260000 BO MCLAMP02 PROCEED IF YES 54265000 BAL RET,MCLXCATI ELSE INSERT CAT OPRTR 54270000 MCLAMP02 EQU * 54275000 LR RB,R1 ELSSE COPY END OF STRING+1 54280000 LR RA,R0 GET START OF STRING 54285000 $CALL MCGTST GET STRING 54290000 STC RD,MCBSTRLN SAVE STRING LENGTH IN BSU 54295000 ST RC,MCBSLOC SAVE LOCATION IN BSU 54300000 MVI MCBSINDX,$BSTRING IDENTIFY BSU 54305000 OI MCBSFLGS,$MINQUOT+$MTERM+$MINCHAR SET FLAGS IN BSU 54310000 $SCOF RB,R0,MCBSOFST PUT OFFSET IN BSU 54315000 LR R0,RA BUMP START POINTER 54320000 BAL RE,MCLXBMP BUMP BSU 54325000 B MCLAMPR0 PROCEED A 54330000 MCLAMPRT EQU * 54340000 TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 54345000 BO MCLAMPR1 PROCEED IF YES 54350000 SPACE 2 54365000 MCLAMPR0 BAL RET,MCLXCATI INSERT CONCAT OPR A 54365100 MCLAMPR1 EQU * 54370000 TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 54375000 BNO MCLAMPR2 PROCEED IF NOT 54380000 OI MCBSFLGS,$MINQUOT ELSE SET QUOTR FLAG IN BSU 54385000 MCLAMPR2 EQU * 54390000 $CALL MCSYSR FIND SYMBOL IN DICTIONARIES 54395000 LTR RB,RB OKAY? 54400000 BP MCLXERTN UNDEFINED IF RB > 0 54405000 BM MCLXISER INVALID SYMBOL IF RB < 0 54410000 B *(RD) JUMP TO ROUTINE 54415000 B MCLAGLOB GLOBAL SYMBOL? 54420000 B MCLALOCL LOCAL SYMBOL? 54425000 B MCLASYPR SYMBOLIC PARAMETER? 54430000 USING MCPARENT,RC SET USING FOR PARAMETER 54435000 MCLASYSV EQU * SYTEM VARIABLE IF BRANCH HERE 54440000 CLI MCPARNLN,X'08' COMPARE LENGTH 54445000 BE MCLASYLS IF 8, MUST BE SYSLIST 54450000 CLI MCPARNAM+6,C'X' IS IT &SYSNDX 54455000 BE MCLASYDX PROCESS IF YES 54460000 MVI MCBSINDX,$BSYSECT MUST BE &SYSSECT 54465000 B MCLXTRMF 54470000 MCLASYLS EQU * 54475000 MVI MCBSINDX,$BSYSLST SET &SYSLST INDEX IN BSU 54480000 OI AVMDWRK4,$MINSYSL SET SYSLIST FLAG IN PAREN BYTE 54490000 B MCLAGSYL GO TO MAKE SURE ( THERE AND FLAG J 54495000 MCLASYDX EQU * 54500000 MVI MCBSINDX,$BSYSNDX SET &SYSNDX FLAG IN BSU 54505000 B MCLXTRMF 54510000 * SYMBOLIC PARAMETER FOUND A 54510100 MCLASYPR EQU * 54515000 MVI MCBSINDX,$BSYMPAR SET SYMBOLIC PARAM BSU INDEX 54520000 LH R2,MCPARNDX GET SYM PAR POSITION 54525000 ST R2,MCBSLOC STORE IN BSU 54530000 CLI 0(RA),C'(' NEXT CHAR = '('? 54535000 BNE MCLXTRMF PROCEED TO FOOT IF NOT 54540000 OI AVMBYTE2,$MDIMVAR ELSE SET DIM VARIABLE FLAG 54545000 B MCLXTRMF 54550000 DROP RC 54555000 SPACE 2 54560000 * GLOBAL SYMBOL FOUND A 54560100 USING MCGLBDCT,RC 54565000 MCLAGLOB EQU * 54570000 ST RC,MCBSLOC STORE ENTRY @ IN BSU 54575000 CLI MCGLBTYP,X'08' WHAT TYPE OF GLOBAL SYMBOL? 54580000 BH MCLASY01 54585000 BL MCLASY02 ARITH IF LOW 54590000 MVI MCBSINDX,$BSTSYBG MUST BE BOOL IF FALLS THROUGH 54595000 OI MCBSFLGS,$BSBOOL SET BOOLEAN FLAG 54600000 B MCLAGLFT 54605000 MCLASY01 EQU * 54610000 MVI MCBSINDX,$BSTSYCG SET CHAR BSU INDEX 54615000 OI MCBSFLGS,$BSCHAR SET CHAR FLAG 54620000 B MCLAGLFT 54625000 MCLASY02 EQU * 54630000 MVI MCBSINDX,$BSTSYAG SET ARITH BSU INDEX 54635000 OI MCBSFLGS,$BSAR SET ARITH FLAG 54640000 B MCLAGLFT 54645000 DROP RC 54650000 SPACE 2 54655000 * LOCAL SYMBOL FOUND A 54655100 USING MCLCLDPV,RC 54660000 MCLALOCL EQU * ROUTINE FOR LOCAL SYMBOLS 54665000 ST RC,MCBSLOC SAVE ENTRY @ IN BSU 54670000 CLI MCLCLTYP,X'08' WHAT TYPE LOCAL SYMBOL? 54675000 BH MCLASY03 CHAR IF HIGH 54680000 BL MCLASY04 ARITH IF LOW 54685000 MVI MCBSINDX,$BSTSYBL SET LOCAL INDEX IF FALLS THROUGH 54690000 OI MCBSFLGS,$BSBOOL SET BOOLEAN TYPE FLAG 54695000 B MCLAGLFT 54700000 MCLASY03 EQU * 54705000 MVI MCBSINDX,$BSTSYCL SET LOCAL CHAR SYMBOL INDEX 54710000 OI MCBSFLGS,$BSCHAR SET CHAT TYPE FLAG 54715000 B MCLAGLFT 54720000 MCLASY04 EQU * 54725000 MVI MCBSINDX,$BSTSYAL SET LOCAL ARTITH INDEX 54730000 OI MCBSFLGS,$BSAR SET ARITH TYPE FLAG 54735000 MCLAGLFT EQU * 54740000 CLC MCLCLDIM,AWH1 SET SYMBOL DIMENSIONED? 54745000 BE MCLASY06 IF NOT, JUMP 54750000 MCLAGSYL OI AVMBYTE2,$MDIMVAR SHOW DIMENSIONED J 54755000 CLI 0(RA),C'(' MUST BE LEFT PAREN 54760000 BE MCLXTRMF OK IF YES 54765000 MCLASY05 EQU * 54770000 LA RB,$ERSSDIM ELSE SET SUBSCRIPT ERROR FLAG 54775000 B MCLXERTN AND RETURN 54780000 MCLASY06 EQU * 54785000 CLI 0(RA),C'(' NEXT CHAR = (? 54790000 BNE MCLXTRMF OKAY IF NOT 54795000 TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 54800000 BO MCLXTRMF PAREN OKAY IF YES 54805000 B MCLASY05 ELSE FLAG BAD PAREN 54810000 DROP RC 54815000 SPACE 2 54820000 * PERIOD FOUND, LEGAL IF IN CHAR EXP & IF NOT, CONCATINATION OPERATOR A 54820100 * NEEDED AND BSU INSERTED A 54820200 MCLPEROD EQU * 54825000 TM AVMBYTE2,$MINCHAR IN CHAR EXPRESSION? 54830000 BNO MCLXSYER ERROR IF NOT 54835000 TM AVMBYTE1,$MINQUOT ARE WE IN QUOTES? 54840000 BNO MCLPER01 PROCEED IF NO 54845000 CR R0,R1 POINTER MOVED? 54850000 BE MCLPER02 PROCEED IF NOT 54855000 MCLPER00 EQU * 54860000 LA RA,1(R1) ELSE BUMP PNTR PAST '.' AND RESUME 54865000 B MCLXSCAN SCAN 54870000 MCLPER02 EQU * 54875000 CLI 1(R1),C'&&' POSSIBLE VAR SYMBOL? 54880000 BNE MCLPER0A PROCEED IF NOT 54885000 CLI 2(R1),C'&&' DOUBLE '&&'? 54890000 BNE MCLPER0B CAT OPRTR IF NOT 54895000 MCLPER0A EQU * 54900000 IC R2,1(R1) GET NEXT CHARACTER 54905000 LA R2,AWTSYMT(R2) USE AS POINTER INTO TABLE 54910000 CLI 0(R2),X'00' NEXT CHAR IS ALPHANUM? 54915000 BNE MCLPER00 TREAT PERIOD AS CHAR IF NOT 54920000 MCLPER0B EQU * 54925000 CLI MCBSINDP,$BSCAT PREV SYM= COCAT? A 54940000 BE MCLPER00 TREAT AS CHAR IF YES 54945000 MCLPER01 EQU * 54950000 $SCOF RB,R1,MCBSOFST GET OFFSET OF CAT OPRTR 54955000 BAL RET,MCLXCATI ELSE INSERT CAT OPRTR 54960000 B MCLXSTRS RESUME SCAN S 54970000 SPACE 4 54975000 * QUOTE FOUND, PROCESS FOR CHAR END, NULL STRING SYMBOL(DOUBLE QUOTES)A 54975100 * ALSO ERROR CHECKING DONE A 54975200 MCLQUOTE EQU * 54980000 C R1,AVSOLAST END OF RECORD? 54985000 BNL MCLQUER1 ERROR IF YES 54990000 TM AVMBYTE1,$MINQUOT ARE WE IN QUOTES? 54995000 BNO MCLQ02 IF NOT, SET FLAGS AND PROCEED 55000000 CLI 1(R1),C'''' DOUBLE QUOTE? 55005000 BNE MCLQTF IF NOT, GET STRING 55010000 LA RA,2(R1) ELSE BUMP POINTER AND RESUME SCAN 55015000 B MCLXSCAN 55020000 MCLQ01 EQU * 55025000 LR RB,R1 COPY END OF STRING + 1 55030000 LR RA,R0 COPY START OF STING 55035000 $CALL MCGTST GET STRING 55040000 ST RC,MCBSLOC SAVE LOCATION IN BSU 55045000 STC RD,MCBSTRLN SAVE STRING LENGTH IN BSU 55050000 MVI MCBSINDX,$BSTRING IDENT BSU 55055000 OI MCBSFLGS,$MINQUOT FLAG BSU AS IN QUOTE 55060000 LA RA,1(R1) BUMP SCAN POINTER PAST QUOTE 55065000 XI AVMBYTE1,$MINQUOT TURN QUOTE FLAG ON/OFF 55070000 B MCLXTRMF 55075000 MCLQ02 EQU * 55080000 TM AVMBYTE2,$MINARIT IN ARITH EXPRESSION? 55085000 BO MCLXISER ERROR IF YES 55090000 XI AVMBYTE1,$MINQUOT TURN ON QUOTE FLAG 55095000 B MCLXSTRS RESUME SCAN S 55105000 MCLQTF EQU * 55110000 CR R0,R1 STRING PRESENT? 55115000 BNE MCLQTF01 IF YES, PROCEED 55120000 BCTR R1,0 ELSE DECR POINTER 55125000 CLI 0(R1),C'''' PREV CHAR = QUOTE? 55130000 LA R1,1(R1) RESTORE POINTER BEFORE TEST 55135000 BE MCLQ01 IF YES, PROCESS NULL STRING 55140000 B MCLQ02 ELSE TURN OFF FLAG AND RESUME SCAN 55145000 MCLQTF01 EQU * 55150000 TM AVMBYTE2,$MTERM PREV BSU = TERM? 55155000 BNO MCLQ01 PROCEED IF NOT 55160000 BAL R14,MCLXCATI ELSE INSERT CATEN OPRTR 55165000 B MCLQ01 AND THEN PROCEED 55170000 SPACE 2 55175000 SPACE 55180000 MCLQUER1 EQU * 55185000 LR RA,R1 GET @ OF RECORD ENDING QUOTE 55190000 S RA,=F'2' DECR TO END OF OPERAND 55195000 B MCL$ERV S 55200000 SPACE 2 55210000 MCLBLANK EQU * 55215000 LTR RY,RY STILL IN PARENS? 55220000 BZ MCLXFOOT RETURN IF NOT 55225000 TM AVMBYTE2,$MINBOOL IN BOOLEAN EXPRESSION 55230000 BO MCLXSTRS OK IF YES, RESUME SCAN S 55235000 MCL$ERV LA RB,$ERVUNEX ELSE SET ERROR FLAG S 55240000 B MCLXERTN AND RETURN 55245000 SPACE 4 55260000 MCLXOPRF EQU * 55265000 TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 55270000 BNO MCLXDLMF OKAY IF NOT 55275000 CLI MCBSINDX,$BSNOT IS CURRENT SYMBOL = NOT ? S 55280000 BNE MCLXOPER ERROR IF NOT 55290000 CLI MCBSINDP,$BSLPAR IS IT LEFT PAREN A 55295000 BE MCLXOP01 OKAY IF YES 55300000 CLI MCBSINDP,$BSAND IS IT AN AND? A 55305000 BE MCLXOP01 OKAY IF YES 55310000 CLI MCBSINDP,$BSOR IT IS OR? A 55315000 MCLXOP01 EQU * 55320000 BE MCLXDLMF RESUME SCAN IF ONE OF (, AND OR 55330000 B MCLXSYER ELSE FLAG ERROR 55335000 MCLXOPER EQU * 55340000 CLI MCBSINDP,$BSRPAR PREV SYMBOL = RIGHT PAREN ? S 55345000 BE MCLXOP01 OKAY IF YES 55350000 B MCLXSYER ELSE FLAG ERROR 55355000 SPACE 4 55360000 MCLXTRMF EQU * 55365000 TM AVMBYTE2,$MTERM PREV BSU = TERM? 55370000 BO MCLXSYER ERROR IF YES 55375000 OI MCBSFLGS,$MTERM SET FLAG IN BSU 55380000 XI AVMBYTE2,$MOPRTR+$MTERM TURN ON TERM FLAG 55385000 B MCLXF09 JUMP TO FOOT 55390000 SPACE 4 55395000 MCLXDLMF EQU * 55400000 OI MCBSFLGS,$MOPRTR TURN ON OPRTR FLG IN BSU 55410000 NI AVMBYTE2,X'FF'-$MDIMVAR-$MTERM TERM,DIMVAR FLAGS A 55415000 OI AVMBYTE2,$MOPRTR TURN ON OPRTR FLAG 55420000 B MCLXF09 55425000 SPACE 4 55430000 **--> INSUB: MCLXCATI ROUTINE TO INSERT CONCATINATION + + + + + + +A 55435000 *+ A 55440000 *+ CALLED WHEN CONCATINATION OPERATION NEEDED, INSERTR BSU A 55440100 *+ A 55440200 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 55440300 SPACE 2 A 55440400 MCLXCATI EQU * 55445000 MVI MCBSINDX,$BSCAT SET CATEN INDEX 55450000 MVI MCBSHIER,$MCATHR SET HEERARCHY 55455000 TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 55460000 BNO MCLXCAT1 SKIP IF NOT 55465000 OI MCBSFLGS,$MINQUOT SET IN QUOTE FLAG IN BSU 55470000 MCLXCAT1 EQU * 55475000 OI MCBSFLGS,$MOPRTR SET OPRTR FLAG IN BSU 55480000 BAL RE,MCLXBMP BUMP BSU 55485000 NI AVMBYTE2,X'FF'-($MOPRTR+$MTERM) TURN OFF FLAGS 55490000 OI AVMBYTE2,$MOPRTR SET PREV SYMBOL = OPRTR FLAG 55495000 BR R14 RETURN 55500000 SPACE 4 55505000 **--> INSUB: MCLXBMP BUMP POINTER + + + + + + + + + + + + + + +S 55505100 *+ SAVE PREVIOUS BSU AND BUMP POINTER +S 55505200 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 55505300 SPACE 2 S 55505400 MCLXBMP EQU * 55510000 MVC MCBSFLGP(4),0(RW) MOVE PREV BSU INTO WRK AREA A 55510100 XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='BSU - MACLEXP', #55511000 IF=(AVTAGSM,O,AJOMACRH,TM) 55512000 LA RW,$LMCBSU(RW) BUMP BSI POINTER A 55515000 C RW,AVMCHLIM WORK AREA EXCEEDED? 55520000 BL MCLXBMP1 OK IF NOT 55525000 LA RB,$ERVTMTR ELSE FLAG TOO MANY TERMS 55530000 B MCLXERTN AND RETURN 55535000 MCLXBMP1 EQU * 55540000 MVC MCBSU(8),AWZEROS ZERO NEW BSU 55545000 BR RE AND RETURN 55550000 MCBSFLGP DS C PREVIOS A 55550100 MCBSINDP DS C BSU A 55550200 MCBSOFSP DS C WORK A 55550300 MCBSHIEP DS C AREA A 55550400 SPACE 2 55555000 MCLXF09 EQU * 55560000 $SCOF RB,R0,MCBSOFST GET OFFSET INTO BSU 55565000 BAL RE,MCLXBMP BUMP BSU 55570000 TM AVMBYTE4,$MINSTRN PROCESSING OUTSIDE VAR SYMBOL? 55575000 BNO MCLXSTRT IF NOT, RESUME SCAN 55580000 NI AVMBYTE4,X'FF'-$MINSTRN ELSE TURN OFF FLAG 55585000 CLI 0(RA),C'(' PAREN FOLLOWING? 55590000 BNE MCLXFOOT RETURN IF NOT 55595000 OI AVMBYTE2,$MINPEXP ELSE SET PARENS ONLY FLAG 55600000 B MCLXSTRT AND RESUME SCAN 55605000 SPACE 2 55610000 MCLXISER EQU * 55615000 LR RA,R0 RESTORE SCAN POINTER 55620000 LA RB,$ERINVSY SET INVALID SYMBOL FLAG 55625000 B MCLXERTN AND RETURN 55630000 SPACE 2 55635000 MCLEXERR EQU * 55640000 MCLXSYER EQU * 55645000 LR RA,R0 RESTORE SCAN POINTER 55650000 LA RB,$ERVSYNT SET SYNTAX ERROR FLAG 55655000 B MCLXERTN AND RETURN 55660000 SPACE 2 55665000 MCLXFOOT EQU * 55670000 SR RB,RB 55675000 TM AVMBYTE2,$MOPRTR LAST BSU = OPRTR? 55680000 BNO MCLXERTN RETURN NORMALLY IF NOT 55685000 CLI MCBSINDP,$BSRPAR IT IS RIGHT PAREN? A 55695000 BE MCLXERTN RETURN S 55710000 MCLXFTER EQU * 55715000 $SCPT RA,MCBSOFST GET POINTER TO ERROR 55720000 LA RB,$ERVSYNT SET ERROR FLAG 55725000 MCLXERTN EQU * 55730000 MCLEQUAL EQU MCLXERTN ERROR IF '==' TURNS UP S 55730100 $SETRT ('''',0,'&&',0,'.',0) RESTORE TRT TABLE 55735000 MVI AWTDECT+C'+',2 55740000 MVI AWTDECT+C'-',2 55745000 MVI AWTDECT+C'/',2 RESTORE AWTDEDT TABLE TO ORIGINAL 55750000 MVI AWTDECT+C')',2 CONDITIONS BEFORE RETURNING 55755000 MVI AWTDECT+C'''',2 55760000 MVI AWTDECT+C'&&',2 55765000 MVI AWTDECT+C'.',2 55770000 XSNAP LABEL='***MACLEX EXITED***',IF=(AVMSNBY2,O,$MSNP09,TM) 55775000 LR RC,RW SET BSU POINTER 55780000 $RETURN RGS=(R14-R6) 55785000 LTORG 55790000 DROP RAT,RW 55795000 TITLE '*** MCGNCD - GENERATE INTERNAL CODE FOR MACRO S' 55800000 **--> CSECT: MCGNCD CONVERTS STRING OF BSU'S TO INTERNAL CODE * 55805000 *. IN ONE-OP FORM. ONE-OPS ARE QUADRUPLES WITH OPRTR, TWO * 55810000 *. OPRNDS AND RESULT FIELD. ADDRESS OF CURRENT GENERATED INST* 55815000 *. IS IN AVMCRINS. GEERATED CODE IS POINTED TO BY MCCODLNK * 55820000 *. FIELD IN MACLIB. BSU STRING LOCATED IN AVMWRK1 * 55825000 *. * 55830000 *. ENTRY CONDITIONS * 55835000 *. RC = @ OF CURRENT MACLIB ENTRY * 55840000 *. * 55845000 *. USES MACROS: $CALL,$SAVE,$RETURN,$SCOF,$SCPT,$ALLOCL,$ALLOCH* 55850000 *. USES DSECTS: AVWXTABL,MCBSU,MCBSTRMS,MCBOPRST,MCOPQUAD, * 55855000 *. MACLIB,MCSEQ * 55860000 *. CALLS MACFND, ERRTAG, * 55865000 *. * 55870000 *. REGISTER USAGE: S 55870100 *. WORK REGS: R0,R1,RA,RB,RC,RE S 55870150 *. TRT BYTE REG: R2 S 55870200 *. RW - BASE REG FOR BSU S 55870250 *. RX - BASE REG FOR OPRND STACK S 55870300 *. RY - BASE REG FOR OPRTR STACK S 55870350 *. RZ - BASE REG FOR ONE-OP ENTRY S 55870400 *. RAT - BASE REG FOR MAIN TABLE S 55870450 *. R1 - BASE REG FOR MACLIB S 55870475 *. RD - UNUSED S 55870500 *. S 55870550 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 55875000 SPACE 2 55880000 MCGNCD CSECT 55885000 $SAVE RGS=(R14-R6),BR=13,SA=* 55890000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 55895000 XSNAP LABEL='***MCGNCD ENTERED***',IF=(AVMSNBY2,O,$MSNP10,TM) 55900000 USING MCBSU,RW NOTE USING FOR BSU INPUT STRING 55905000 USING MCBSTRMS,RX USING FOR OPRND STACK 55910000 USING MCBOPRST,RY USING FOR OPRTR STACK 55915000 USING MCOPQUAD,RZ USING FOR ONE-OP ENTRY 55920000 USING MACLIB,RC USING FOR MACLIB ENTRY 55925000 NI AVMBYTE4,X'FF'-($MCOMST+$MRPARST) CLEAR COMMA, RP FLAG 55930000 LA R0,$LMCBSU LENGTH OF BSU FOR BUMPING A 55935000 SR R2,R2 CLEAR BYTE REGISTER A 55940000 LA RB,$LMCOPL1 GET LENGTH OF PREFIX SECTION A 55940100 $ALLOCL RE,RB,MCGNCDOV GET SPACE FOR IT A 55940150 MVC 0($LMCOPL1,RE),AWZEROS CLEAR OUT ONE-OP PREFIX A 55940200 L RZ,AVMCRINS GET PREV INST @ 55945000 LTR RZ,RZ 1ST INSTRUCTION? 55950000 BNZ MCGNCD00 IF NOT, PROCEED 55955000 LA RZ,MCCODLNK FAKE POINTER AS 1ST ONE A 55960000 MCGNCD00 EQU * 55970000 ST RE,MCQUDNXT SAVE LINK IN PREV INSTRUCTION 55975000 * CREATE STACK OF ONE OPS A 55975100 MCGNCD01 EQU * 55980000 LR RZ,RE SET BASE TO NEW ENTRY 55985000 ST RZ,AVMCRINS SAVE CURRENT INST @ 55990000 ZAP MCQSTMNO,AVOULNCN STORE CURRENT PACKED DEC STMT NBR 56000000 L RW,AVMCHSTR GET @ OF BSU INPUT STRING 56005000 XSNAP LABEL='BEGIN MCGENCD',STORAGE=(*0(RW),*100(RW)), X56005100 IF=(AVTAGSM,O,AJOMACRH,TM) A 56005101 LA RX,AVMWRK2 USE AVMWRK2 FOR OPRND STACK 56010000 LA RY,AVMWRK1 USE QVMWRK1 FOR OPRTR STACK 56015000 MVC MCBSTRMS($LMCBSU),AWZEROS CLEAR OPRND STACK 56020000 MVC MCBOPRST($LMCBSU),AWZEROS CLEAR OPRTR STACK 56025000 SR RX,R0 DECR APRND PTR FOR STMT A 56035000 * POP BSU, SET PRIORITIES AND PUSH ON APPROPRIATE STACK A 56035200 MCGNCDSC EQU * 56040000 CLI MCBSINDX,X'00' END OF BSU'S? 56045000 BE MCGENCD IF YES , POP INSTRUCTIONS 56050000 TM AVMBYTE4,$MRPARST+$MCOMST PAREN OR COMMA FLAG ON? 56055000 BM MCGENCD IF YES, POP INSTRUCTION 56060000 TM MCBSFLGS,$MTERM TERM? 56065000 BNO MCGNCD02 IF NOT, PROCESS OPRTR 56070000 AR RX,R0 ELSE BUMP OPRND STACK PTR A 56075000 MVC MCBSFLG2($LMCBSU),MCBSU ELSE PUSH TERM ON OPRND STACK 56080000 B MCGNCD06 56085000 MCGNCD02 EQU * 56090000 CLI MCBSINDX,$BSCOMMA COMMA? 56095000 BNE MCGNCD03 TEST FOR PAREN IF NOT 56100000 OI AVMBYTE4,$MCOMST ELSE SET FLAG 56105000 B MCGNCD06 AND JUMP TO FOOT 56110000 MCGNCD03 EQU * 56115000 CLI MCBSINDX,$BSRPAR REGHT PAREN? 56120000 BNE MCGNCD04 PROCEED IF NOT 56125000 OI AVMBYTE4,$MRPARST ELSE SET FLAG 56130000 B MCGNCD06 AND JUMP TO FOOT 56135000 MCGNCD04 EQU * 56140000 CLI MCBSHIER,$MPARHR PAREN? 56145000 BNE MCGNCD05 PROCEED IF NOT 56150000 CLI MCBSINDX,$BSBSTR SUBSTRING? 56155000 BNE MCGNPUSH IF NOT, PUSH ONTO OPRTR STACK 56160000 CLI MCBSOPST,$BSCAT CAT OPRTR IN STACK? 56165000 BNE MCGNPUSH PUSH OPRTR IF NOT 56170000 TM MCBOPFL,$MINQUOT CAT OPRTR IN QUOTES? 56175000 BO MCGENCD POP OPRTR IF YES 56180000 MCGNPUSH EQU * 56185000 AR RY,R0 BUMP STACK POINTER A 56190000 MVC MCBOPRST($LMCBSU),MCBSU PUSH OPRTR ONTO STACK 56195000 B MCGNCD06 JUMP TO FOOT 56200000 MCGNCD05 EQU * 56205000 CLI MCBSINDX,$BSCAT CAT OPRTR? 56210000 BNE MCGNCD07 PROCESS NORMALLY IF NOT 56215000 TM MCBSFLGS,$MINQUOT CAT OPRTR IN QOTES? 56220000 BNO MCGNCD07 PROCESS NORMAL IF NOT 56225000 CLC MCBSHIER,MCBOPHR COMPARE HIERARCHIES 56230000 BNL MCGNPUSH H(OPRRTR) >=H(STACK) THEN PUSH 56235000 B MCGENCD ELSE POP OPRTR 56240000 MCGNCD07 EQU * 56245000 CLC MCBSHIER,MCBOPHR COMPARE HIERARCHIES 56250000 BH MCGNPUSH PUSH OPRTR ONLY IF HIGH 56255000 B MCGENCD ELSE POP OPRTR 56260000 MCGNCD06 EQU * 56265000 AR RW,R0 POP INPUT BSU STACK A 56270000 B MCGNCDSC AND RESUME SCAN OF INPUT 56275000 MCOPRBAS DS 0H 56280000 EJECT A 56280100 MCGENCD EQU * 56285000 NI AVMBYTE1,X'FF'-$MINQUOT TURN OFF QUOTE FLAG 56290000 TM MCBSFLG1,$MINQUOT FIRST TERM IN QUOTES? 56295000 BZ MCGENCD0 PROCEED IF NOT 56300000 OI AVMBYTE1,$MINQUOT ELSE SET QUOTE FLAG 56305000 MCGENCD0 EQU * 56310000 CLI MCBOPHR,$MPARHR LEFT PAREN? 56315000 BNE MCGENCD2 PROCEED IF NOT 56320000 TM AVMBYTE4,$MCOMST WORKING ON COMMA? 56325000 BNO MCGENCD1 PROCEED IF NOT 56330000 XI AVMBYTE4,$MCOMST ELLE TURN OFF COMMA FLAG 56335000 B MCGNCDSC AND RESUME SCAN 56340000 MCGENCD1 EQU * 56345000 NI AVMBYTE4,X'FF'-$MRPARST ELSE TURN OFF PAREN FLAG 56350000 CLI MCBSOPST,$BSLPAR ORDINARY LEFT PAREN? 56355000 BE MCGENRT IF YES POP OPRTR AND RESUME SCAN 56360000 * A 56360050 * ALLOCATE SPACE FOR ONE OP ENTRIES A 56360100 * HI RARCHY AND JUMP ON INDEX TO PROCESS A 56360200 * A 56360300 MCGENCD2 EQU * 56365000 CLI MCBSOPST,X'00' OPRTR STACK EMPTY? 56370000 BE MCGNCDRT RETURN IF YES 56375000 BAL RET,MCGNALLO ALLOCATE SP FOR 1 OP ENTRY S 56395000 IC R2,MCBOPHR GET HIERARCHY 56400000 LH R1,MCOPRNDX(R2) GET OFFSET 56405000 B MCOPRBAS(R1) JUMP TO ROUTINE 56410000 SPACE 56415000 MCOPRNDX $AL2 MCOPRBAS,(MCPARGEN,MCHRTW,MCORGEN,MCANDGEN,MCRELGEN,MCCAX56420000 TGEN,MCPLSGEN,MCMULGEN,MCNOTGEN) 56425000 SPACE 56430000 * PAREN BSU FOUND PUT ONE-OP ON STACK A 56430100 * A 56430200 MCPARGEN EQU * HIER = 0 ROUTINES 56435000 BAL RE,MCMVTRMS MOVE ARGS TO ONE-OP 56440000 CLI MCBOPRTR,$BSBSTR SUBSTRING PAFEN? 56445000 BE MCPARG0Q PROCEED IF NOT S 56450000 MCPARG02 EQU * 56465000 CLI MCARG1DX,$BSATT 1ST ARG IS T'? 56470000 BE MCPARG0Q TREAT AS QUOTED STRING IF YES 56475000 TM AVMBYTE1,$MINQUOT FIRST TERM INSIDE QUOTES? 56480000 BZ MCPARG03 PROCEED IF NOT 56485000 MCPARG0Q EQU * 56490000 OI MCBSFLG2,$MINQUOT SET QUOTE FLAG IN OPRND STACK 56495000 MCPARG03 EQU * 56500000 SR RW,R0 DECR PTR TO CHECK PREV ENTRY S 56510000 TM MCBSLOC+3,X'01' TWO ARG'S IN PARENS? 56515000 LA RW,$LMCBSU(RW) RESTORE POINTER 56520000 BNO MCGENRT PROCEED IF NOT 56525000 BAL RET,MCGNALLO ALLOCATE SP FOR 1 OP ENTRY S 56540000 MVC MCARG1DX,MCBSNDX1 MOVE IDENT OF ARG INTO ONE-OP 56545000 MVC MCARG1LC,MCBSLOC1 MOVE LOCATION OF OPRND INTO ONE-OP 56550000 CLI MCARG1DX,$BSTRING STRING TERM? 56555000 BNE MCPARG04 PROCEED IF NOT 56560000 MVC MCARG1LC(1),MCBLN1 MOVE LENGTH OF STRING INTO ONE-OP 56565000 MCPARG04 EQU * 56570000 MVC MCBSFLG1($LMCBSU),MCBSFLG2 PUSH DOWN OPRND STACK 56575000 B MCTWODEC DECR OPRND STACK 56580000 SPACE 56585000 * HEIR=2, PUT ONE-OP ON STACK A 56585100 * A 56585200 MCHRTW EQU * 56590000 MVC MCBOPRTR,MCBSOPST MOVE OPRTR FROM STACK TO ONE-OP 56595000 CLI MCBSOPST,$BSPRINT WHICH BSU OF HIER = 2? 56600000 BL MCTWOSET IF LOW, MUST BE SETX 56605000 BE MCTWOPRA IF EQUAL MUST BE PRINT A 56610000 CLI MCBSOPST,$BSINMAC ELSE IS IT INNER MACRO CALL? 56615000 BNL MCTWOPR INNER IF EQUAL, MVSTR IF HIGH 56620000 * NOTE: THESE JUST USE ONE-OP PREFIX BY THEMSELVES A 56625000 L RZ,AVMCRINS GET # PREFIX ONE-OP A 56630000 MVC MCQS1FLG,MCBSOPST COPY OPERATOR OVER A 56631000 B MCPREFIX GO TO PREFIX-ONLY EXIT A 56635000 MCTWOSET EQU * 56640000 BAL RE,MCMVTRMS MOVE OPRNDS INTO ONE-OP 56645000 B MCTWODEC 56650000 MCTWOPRA TM MCBOPFL,$MPRCOM WAS THIS SPECIAL PRINT COMMENT UP A 56654000 BZ *+8 NO, SKIP A 56654100 OI MCBOPRTR,$MPRCOM YES, MAKE PRINT OPRTR ODD, SO KNOW A 56654200 MCTWOPR EQU * 56655000 MVC MCARG2LC+3(1),MCBOPOF MOVE OFFSET INTO INTO ARG2LC 56660000 MVC MCARG1DX,MCBSNDX2 MOVE TYPE INTO ARG1DX 56665000 MVC MCARG1LC,MCBSLOC2 MOVE LOCATION OF STRING INTO ONE-OP 56670000 CLI MCBSNDX2,$BSTRING INDEX BSU IS CHAR STRING? 56675000 BNE MCTWODEC SKIP MOVE LEN IF NOT 56680000 MVC MCARG1LC(1),MCBLN2 MOVE LENGTH INTO LOC FIELD 56685000 B MCTWODEC DECR OPRND STACK 56690000 * A 56690100 * PLUS OR MULTIPLY BSU FOUND PUT ONE-OP ON STACK A 56690200 * A 56690300 MCPLSGEN EQU * 56695000 MCMULGEN EQU * 56700000 BAL RE,MCMVTRMS MOV& OPRNDS INTO ONE-OP 56705000 MVI MCBSFLG2,$MTERM+$BSAR IDENT OPRND STACK TOP AS ARITH TR 56710000 B MCGENRT JUMP TO FOOT 56715000 SPACE 56720000 * A 56720100 * AND | OR BSU FOUND, PUT ONE OP ONTO STACK A 56720200 * A 56720300 MCORGEN EQU * 56725000 MCANDGEN EQU * 56730000 TM MCBSFLG1,$BSBOOL 1ST OPRND = BOOL? 56735000 BNO MCMXDR1 ERROR IF NOT 56740000 TM MCBSFLG2,$BSBOOL 2ND OPRND = BOOL? 56745000 BNO MCMXDR1 ERROR IF NOT 56750000 BAL RE,MCMVTRMS MOVE OPRNSD INTO ONE-OP 56755000 MVI MCBSFLG2,$MTERM+$BSBOOL IDENTIFY AS BOOLEAN TERM 56760000 B MCGENRT JUMP TO FOOT 56765000 SPACE 56770000 * RELATIONAL OPERATOR FOUND PUT ONE-OP ONTO STACK A 56770100 * A 56770200 MCRELGEN EQU * 56775000 MVI AVMBYTE3,X'00' CLEAR AVMBYTE3 FOR FLAG USE 56780000 TM MCBSFLG1,$MINQUOT 1ST TERM IN QUOTES? 56785000 BO MCRELG02 56790000 TM MCBSFLG2,$MINQUOT 2ND TERM IN QUOTES? 56795000 BO MCRELG03 56800000 B MCRELG01 ELSE PROCEED 56805000 MCRELG02 EQU * 56810000 OI AVMBYTE3,$BSRLCHR SET CHAR RELTN FLAG 56815000 TM MCBSFLG2,$MINQUOT 2ND TERM IN QUOTES? 56820000 BO MCRELG01 OKAY IF YES 56825000 CLI MCBSNDX2,$BSATT ELSE IS IT T'? 56830000 BE MCRELG01 OKAY IF YES 56835000 B MCMXDR2 ELSE ERROR 56840000 MCRELG03 EQU * 56845000 OI AVMBYTE3,$BSRLCHR SET CHAR RELTN FLAG 56850000 CLI MCBSNDX1,$BSATT 1ST TERM = T'? 56855000 BNE MCMXDR2 ELSE ERROR S 56865000 MCRELG01 EQU * 56870000 BAL RE,MCMVTRMS MOVE TERMS INTO ONE-OP 56875000 OC MCBOPRTR,AVMBYTE3 SET CHR OR ARIT FLAG IN OPRTR 56880000 MVI MCBSFLG2,$MTERM+$BSBOOL IDENTIFY AS BOOLEAN TERM 56885000 B MCGENRT JUMP TO FOOT 56890000 SPACE 56895000 * CATENATION BSU FOUND PUT ONE-OP ON STACK A 56895100 * A 56895200 MCCATGEN EQU * 56900000 CLI AVMFLDT2,C'M' MACRO OPCODE? 56905000 BNE MCCATG01 JUMP PAST QUOTE TEST IF NOT 56910000 TM MCBSFLG1,$MTERM+$MINQUOT 1ST TERM IN QUOTES? 56915000 BNO MCMXDR1 ERROR IF NOT 56920000 TM MCBSFLG2,$MTERM+$MINQUOT 2ND TERM IN QUOTES? 56925000 BNO MCMXDR1 ERROR IF NOT 56930000 MCCATG01 EQU * 56935000 BAL RE,MCMVTRMS MOVE OPRNDS INTO ONE-OP 56940000 MVI MCBSFLG2,$MTERM+$BSCHAR+$MINQUOT IDENTIFY TEMP OPRND 56945000 B MCGENRT JUMP TO FOOT 56950000 SPACE 56955000 * 'NOT' BSU FOUND PUT IN OP-OP STACK A 56955100 * ALSO CHECK FOR AGO AND AIF, AND PROCESS IF FOUND A 56955200 * A 56955300 MCNOTGEN EQU * 56960000 CLI MCBSOPST,$BSAGO AGO OPRTR? 56965000 BH MCAIFGEN IF HIGH MUST BE AIF 56970000 BE MCAGOGEN IF EQUAL MUST BE AGO 56975000 TM MCBSFLG2,$MTERM+$BSBOOL BOOLEAN TERM? 56980000 BNO MCMXDR2 ERROR IF NOT 56985000 MVC MCARG1DX,MCBSNDX2 MOVE INDEX INTO ONE-OP 56990000 MVC MCBOPRTR,MCBSOPST MOVE OPRTR INTO ONE-OP 56995000 MVC MCARG1LC,MCBSLOC2 MOVE OPRND LOC INTO ONE-OP 57000000 ST RZ,MCBSLOC2 PUT @ OF ONE-OP IN OPRND STACK 57005000 MVI MCBSNDX2,$BSTEMP IDENTIFY STACK AS TEMP 57010000 B MCGENRT JUMP TO FOOT 57015000 SPACE 57020000 * AGO OR AIF FOUND, PUT ON OP ON STACK A 57020100 * A 57020200 MCAGOGEN EQU * 57025000 L RA,MCBOPVAL GET @ OF SEQ SYMBOL 57030000 BAL RE,MCSEQSCN JUMP TO SCAN SEQ SYM DICT 57035000 MVC MCBOPRTR,MCBSOPST MOVE OPRTR INTO ONE-OP 57040000 B MCGENRT JUMP TO FOOT 57045000 SPACE 57050000 MCAIFGEN EQU * 57055000 L RA,MCBSLOC2 GET ADDRESS OF SEQ SYMBOL 57060000 TM MCBSFLG1,$BSBOOL BOOLEAN TERM? 57070000 BNO MCMXDR1 ERROR IF NOT 57075000 BAL RE,MCSEQSCN SEQRCH SEQ SYMBOL DICT A 57078000 MVC MCARG1DX,MCBSNDX1 MOVE TERM ID TO ONE-OP 57080000 MVC MCARG1LC,MCBSLOC1 MOVE LOCATION OF TERM TO ONE-OP 57085000 MVC MCBOPRTR,MCBSOPST MOVE OPRTR INTO ONE-OP 57090000 MVC MCARG2DX,MCBSNDX2 MOVE BSU TERM OF ARG INTO ONE-OP 57095000 B MCTWODEC DECR OPRND STACK 57100000 EJECT S 57105000 **--> INSUB: MCSEQSCN ENTER SEQ SYMBOL IN DICT + + + + + + + + +S 57105100 *+ SCAN FOR ERRORS & PUT SEQ SYMBOL IN DICT +S 57105200 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 57105300 SPACE 2 S 57105400 MCSEQSCN EQU * ROUTINE TO ENTER SEQ SYMBOL IN DICT 57110000 DROP RC 57115000 USING MCSEQ,RC SET USING FOR SEQ SYM ENTRY 57120000 CLI 1(RA),C'0' FIRST CHAR IS LETTER? 57125000 BNL MCSEQR1 ERROR IF DIGIT 57130000 TRT 1(8,RA),AWTSYMT SCAN SYMBOL 57135000 BZ MCSEQR1 SYMBOL 8+ CHARS, TOO LONG 57140000 CLI 0(R1),C' ' DELIM = BLANK? 57145000 BNE MCSEQR1 ERROR IF NOT 57150000 SR R1,RA GET LENGTH 57155000 BCT R1,MCSEQS01 DECR LENGTH FOR EX INST 57160000 B MCSEQR1 BUT FALL THRU IF LENGHT = 1 57165000 MCSEQS01 EQU * 57170000 MVC AVMSYMBL,AWBLANK BLANK GLOBAL NAME AREA 57175000 STC R1,AVMSYMLN STORE LENGTH 57180000 EX R1,MCGMVC MOVE SYMBOL S 57185000 AIF (NOT &$MACOPC).MCGNCDA SKIP IF NOT OPEN CODE S 57186000 L R1,AVMACLIB LOAD @ OF MACLIB ENTRY S 57186020 USING MACLIB,R1 NOTE USING ON MACLIB S 57186040 TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 57186100 BCR O,RE IF YES, SKIP SEQ SYM MANAGEMENT S 57186200 DROP R1 S 57186250 .MCGNCDA ANOP S 57186300 L RC,AVMSEQPT GET SEQ SYM POINTER 57200000 LA R1,0(RE) SAVE RETURN @ TEMP S 57205000 $CALL MACFND SEARCH SEQ SYMBOL DICT 57210000 LR RE,R1 RESTORE RETURN @ S 57215000 LTR RB,RB SYMBOL PRESENT IN DECT? 57220000 BZ MCSEQS02 PROCEED IF YES 57225000 LA RB,$LMCSEQ ELSE GET LENGTH OF ENTRY 57230000 $ALLOCH R1,RB,MCGNCDOV GET SPACE FOR NEW ENTRY 57235000 ST R1,MCSEQNXT SAVE LINK IN PREV ENTRY 57240000 LR RC,R1 MOVE BASE TO NEW ENTRY 57245000 MVC MCSEQ($LMCSEQ),AWZEROS CLEAR NEW ENTRY 57250000 MVC MCSEQNAM,AVMSYMBL MOVE NEW NAME INTO ENTRY 57255000 MVC MCARG2LC,AVMCRINS STORE STMT @ IN ARG2 57260000 ST RZ,MCSEQVAL SAVE LINK TO INST 57265000 BR RE RETURN 57270000 MCGMVC MVC AVMSYMBL($),0(RA) DUMMY INSTR S 57270100 MCSEQS02 EQU * 57275000 CLI MCSEQFLG,X'FF' SYMBOL DEFINED? 57280000 BNE MCSEQS03 IF NOT, JUMP AND PROCESS 57285000 MVC MCARG2LC,MCSEQVAL ELSE PUT VALUE IN ONE-OP 57290000 BR RE AND RETURN 57295000 MCSEQS03 EQU * 57300000 LR R1,RZ COPY INST @ TEMPORARILY 57305000 L RZ,MCSEQVAL GET POINTER FROM ENTRY 57310000 MCSEQS04 EQU * 57315000 CLC MCRESULT,AWZEROS END OF CHAIN? 57320000 BE MCSEQS05 IF YES, ENTERLINK IN LAST ENTRY 57325000 L RZ,MCRESULT ELSE GET POINTER TO NEXT LINK 57330000 B MCSEQS04 AND TRY AGAIN 57335000 MCSEQS05 EQU * 57340000 ST R1,MCRESULT PUT CURRENT @ IN LAST LINK 57345000 LR RZ,R1 RESTORE BSE OF ONE-OP 57350000 MVC MCARG2LC,AVMCRINS STORE STMT @ IN ARG2 57355000 BR RE AND RETURN 57360000 DROP RC 57365000 SPACE 57370000 MCTWODEC EQU * 57375000 SR RX,R0 POP OPRND STACK S 57380000 MCGENRT EQU * 57390000 SR RY,R0 POP OPERATOR STACK S 57395000 B MCGNCDSC RESUME SCAN 57405000 SPACE 5 S 57410000 **--> INSUB: MCMVTRMS CREATE ONE BINARY ONE-OP + + + + + + + + +S 57410100 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 57410200 SPACE 2 S 57410300 MCMVTRMS EQU * ROUTINE TO CREATE ONE BINARY ONE OP 57415000 MVC MCARG1DX,MCBSNDX1 MOVE 1ST TERM ID INTO ONE OP 57420000 MVC MCARG2DX,MCBSNDX2 MOVE 2ND TERM ID INTO ONE OP 57425000 MVC MCARG1LC,MCBSLOC1 MOVE 1ST TERM LOCATION INTO ONE-OP 57430000 MVC MCARG2LC,MCBSLOC2 MOVE 2ND TERM LOCATION INTO ONE-OP 57435000 CLI MCBSNDX1,$BSTRING BSU IS A STRING? 57440000 BNE MCMVTRM1 JUMP IF NOT 57445000 MVC MCARG1LC(1),MCBLN1 MOVE STRING LENGTH INTO ONE OP 57450000 MCMVTRM1 EQU * 57455000 CLI MCBSNDX2,$BSTRING 2ND TERM IS STRING? 57460000 BNE MCMVTRM2 JUMP AROUND IF NOT 57465000 MVC MCARG2LC(1),MCBLN2 ELSE MOVE STRING LENGTH INTO ONE-OP 57470000 MCMVTRM2 EQU * 57475000 SR RX,R0 POP OPRND STACK S 57480000 MVI MCBSNDX2,$BSTEMP IDENTIFY OPRND STACK TOP AS TEMP 57490000 MVC MCBOPRTR,MCBSOPST MOVE OPRTR FROM STACK TO ONE-OP 57495000 ST RZ,MCBSLOC2 PUT TESULST LOCATION IN OPRND STACK 57500000 BR RE RETURN 57505000 SPACE 57510000 * THE FOLLOWING SECTIONS ARE EXIT ROUTINES S 57510100 * S 57510200 MCMXDR1 EQU * 57515000 LA RB,$ERVSYNT SETT ERROR TYPE 57520000 MCMXDFLG EQU * 57525000 $CALL ERRTAG FLAG STMNT 57535000 L RZ,AVMCRINS MOVE BASE TO 1ST ONE-OP 57540000 MVI MCQS1FLG,$BSERR01 SHOW ERRIR BSU A 57545000 MCPREFIX EQU * ENTER FOR PREFIX/ONLY(NEND,MEXIT,ETA 57550000 LA RZ,$LMCOPL1(,RZ) SHOW @ END OF PREFIX A 57555000 ST RZ,AVADDLOW RESTORE LOW STORAGE 57560000 B MCGNCDRT AND RETURN 57565000 SPACE 57570000 MCMXDR2 EQU * 57575000 LA RB,$ERMXDMD SET MIXED MODE ERROR 57580000 B MCMXDFLG JUMP AND FLAG STMNT 57585000 SPACE 57590000 MCSEQR1 EQU * 57595000 LA RB,$ERINVSY SET BAD SYMBOL FLAG 57600000 XSNAP LABEL='BAD SYBOL FLAGGED', X57601000 IF=(AVTAGSM,O,AJOMACRH,TM) A 57601001 B MCMXDFLG JUMP AND FLAG STMNT 57605000 SPACE 57610000 MCGNCDOV EQU * 57615000 L REP,AVMOVRFL 57620000 BR REP 57625000 SPACE 57630000 **--> INSUB: MCGNALLO ALLOCATE LOW CORE + + + + + + + + + + + +S 57630100 *+ +S 57630200 *+ ALLOCATES SPACE FOR OPERAND ENTRIES +S 57630300 *+ +S 57630400 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 57630500 SPACE 2 S 57630600 MCGNALLO EQU * S 57630650 LA RB,$LMCQUAD LOAD LENGTH OF AREA NEEDED S 57630700 $ALLOCL RZ,RB,MCGNCDOV GET AREA FOR ONE OP S 57630750 MVC 0($LMCQUAD,RZ),AWZEROS ZERO ENTRY S 57630800 BR RET RETURN S 57630850 SPACE 2 S 57630900 MCGNCDRT EQU * 57635000 XSNAP LABEL='MCGENCD EXITED', X57635100 IF=(AVTAGSM,O,AJOMACRH,TM) A 57635101 AIF (&$DEBUG).MCGNCDR 57640000 L R1,AVMCRINS GET @ OF ONE-OPS 57645000 XSNAP LABEL='***ONE-OP''S***',STORAGE=(*0(R1),*200(R1),*AVMWRK157650000 1,*AVMWRK1+64,*AVMWRK2,*AVMWRK2+64),IF=(AVMSNBY2,O,$MSNPX57655000 10,TM) 57660000 XSNAP LABEL='***MCGNCD EXITED ***',IF=(AVMSNBY2,O,$MSNP10,TM) 57665000 .MCGNCDR ANOP 57670000 $RETURN RGS=(R14-R6) 57675000 LTORG 57680000 DROP RAT,RW,RX,RY,RZ 57685000 TITLE 'MEXPND - MACRO EXPANSION' 57690000 **--> CSECT: MEXPND EXPANDS MACRO DEFINITION. RECURSIVE. ACQUIRES * 57695000 *. STORAGE FROM LOW DYNAMIC AREA FOR STANDARD SAVE AREA AND * 57700000 *. LOCAL VARIABLES. RELEASES STORAGE ON EXIT. PUTS GENERATED * 57705000 *. STATEMENTS IN HIGH STORAGE. AVGEN1CD POINTS TO FIRST BYTE * 57710000 *. AFTER FIRST STATEMENT. AVGEN1CD POINTS TO 1ST BYTE OF LAST * 57715000 *. STATEMENT GENERATED * 57720000 *. * 57725000 *. USES MACROS: $MALLOCL, $MALLOCH, $CALL, $SAVE, $RETURN, * 57730000 *. $AL2 * 57735000 *. USES DSECTS: MACLIB, MCGLBDCT, MCOPQUAD, MCPAROPR, MCPARSUB * 57740000 *. AVWXTABL, MXPNTSAV, MCPARENT, RSBLOCK * 57745000 *. CALLS ERRTAG, MCSCOP,MXMVSR,MACSCN,MACFND,MXMVSR,MXERRM, * 57750000 *. ERRTAG,MEXPND,DECTRM * 57755000 *. * 57760000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 57765000 SPACE 57770000 MEXPND CSECT 57775000 $SAVE RGS=(R14-R6),BR=13,SA=* A 57780000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 57785000 MVC MXADDLOW(4),AVADDLOW SAVE ADDR OF LOW STORAGE A 57790000 MVC AVMACNST,AWZEROS NEST LEVEL = 0 A 57795000 MVI AVMBYTE5,0 CLEAR CONT CARD INDICATOR 57845000 L RC,AVRSBPT SET BASE FOR SOURCE BLOCK 57860000 USING RSBLOCK,RC SET USING FOR SOURCE 57865000 CLI RSBNUM,3 WERE THERE ACTUALLY 3 CARDS IN STMTJ 57870000 BL MEXPND0A NO, SKIP CONTINUED-FURTHER TEST J 57875000 L RB,AVRSCPT POINT TO CONT BLOCK 57880000 USING RSCBLK,RB ESTAB USING ON CONT BLOCK 57885000 CLI RSCONSQ+2*RSC$LEN,C' ' MORE THAN TWO CARDS? 57890000 BE MEXPND0A PROCEED IF NOT 57895000 NI RSBFLAG,255-$REBX TURN OFF ERROR FLAG 57900000 MVI AVMBYTE5,$ERCONTX ELSE SET CONT CARD INDICATR 57905000 DROP RB,RC 57910000 MEXPND0A EQU * 57915000 OI AVRSBLOC+1,$RSBNP## TURN ON OUTER FLAG 57920000 L RB,AVADDHIH GET HIGH PNTR 57925000 LR RC,RB COPY INTO RC 57930000 STM RB,RC,AVGEN1CD MOVE INTO AVGEN1CD,AVGEN2CD 57935000 ST RB,MEXGN2OV SAVE ORIG VALUE, IN CASE OVERFLW JRM 57940000 LA RB,L'MXPOVRMS+RSB$L GET LENGTH OF MSSGE 57945000 $MALLOCH R1,RB GET STORAGE FOR ERROR MSSGE 57950000 ST R1,MEXGN2OV SAVE @, IN CASE OVERFLOW NPW JRM 57955000 MVC 0(L'MXPOVRMS+RSB$L,R1),MXPOVRMS MOVE ERROR MSSGE 57960000 LA RE,RSB$L GET LENGTH OF SNDRD PART OF RSBLOCK 57965000 IC RB,AVRSBLOC GET LENGTH-1 OF RSBLOCK 57970000 SR RB,RE DECR BY RSB$L 57975000 STC RB,AVRSBLOC RESTORE 57980000 MVC AVGEN1CD,AVGEN2CD DECR HIGH PNTR AWAY FROM MSSGE 57985000 EJECT S 57985100 MEXPND01 EQU * 57990000 * EVERY NEST LEVEL A 57995000 L RC,AVMACNST A 58000000 LA RC,1(,RC) INCREASE BY ONE A 58005000 C RC,AVMMNEST TEST FOR OVER A 58010000 BH MEXPMNES OVER THE LIMIT A 58015000 * FALLS THROUGH IF OK A 58020000 ST RC,AVMACNST STORE NEW LEVEL S 58024000 LR R1,RZ SAVE PREVIOUS @ MXPNTSAV S 58025000 $MALLOCL RZ,RB,LENG=$LMXPTSV GET SPACE FOR NEXT ONE S 58035000 USING MXPNTSAV,RZ A 58045000 ST R1,MXPNLINK STORE PREVIOUS RZ S 58050000 L RA,AVRSBPT LOAD SCAN POINTER S 58055000 LA RA,RSB$L(RA) GET @ OF SOURCE IMAGE S 58060000 SPACE 58065000 * NEXT SECTION CHECKS NAME FOR VALIDITY 58070000 SPACE 58075000 $CALL MACSCN SCAN SOURCE FOR FIELDS 58090000 L RA,AVMFLD2 GET OPCODE @ 58095000 CLI AVMFLDT2,X'00' UNIDENTIFIED OPCODE? 58100000 BE MEXPND03 ERROR IF YES 58105000 MVC AVMSYMBL,AWBLANK ELSE CLEAR GLOBAL NAME AREA 58110000 MVC AVMSYMLN,AVMFLDL2 MOVE LENGTH OF OPCODE 58115000 SR R1,R1 CLEAR R1 FOR EX 58120000 IC R1,AVMFLDL2 GET OPCODE LEN 58125000 BCTR R1,0 DECR FOR EX INST 58130000 EX R1,MXPNMVC MOVE OPCODE NAME TO GLOBAL DICT S 58135000 L RC,AVMACLIB GET MACLIB @ 58150000 $CALL MACFND SEARCH MACLIB 58155000 LTR RB,RB FOUND? 58160000 BZ MEXPND04 IF YES, PROCEED 58165000 MEXPND03 EQU * 58170000 LA RB,$ERIVOPC ELSE SET BAD OPCODE FLAG 58175000 B MXPNDERT AND RETURN 58180000 MEXPND04 EQU * 58185000 USING MACLIB,RW NOTE USING ON MACLIB 58190000 LR RW,RC SET MACLIB BASE 58195000 TM MCLBTAGS,AVMCLBDF PREVIOUSLY DEFINED MACRO? 58200000 BNO MEXPND03 ERROR IF NOT 58205000 ST RW,MXPNMCLB SAVE MACLIB PNTR IN LOCAL AREA 58210000 LH RA,MCPOPRNB GET NBR OF OPRNDS 58215000 LA RA,1(RA) BUMP FOR LABEL FIELD 58220000 LA RC,$LMPAROP GET LEN OF SYM PAR DICT ENTRY 58225000 MR RB,RA GET LEN REQ'D 58230000 $MALLOCL RY,RC GET CORE FOR SYM PAR DICTIONARY 58235000 ST RY,MXPNLSPT COPPY PNTR TO SYM PAR DICT 58240000 SPACE 58245000 * NEXT SECTION ZEROS SYM PAR DICTIONARY AND INITIALIZES ENTRIESTO TYPE 58250000 * 'O'. ALSO FINDS FIRST KEYWORD D.V. IF ANY. 58255000 SPACE 58260000 USING MCPARENT,RX SET USING FOR SYM PAR D.V. 58265000 USING MCPAROPR,RY SET USING FOR SYM PAR DICT ENTRIES 58270000 L RX,MCPARPNT SET BASE FOR D.V.'S 58275000 MVC MXPNKYPT(8),AWZEROS CLEAR KEYWORD PNTRS 58280000 NI AVMBYTE1,255-$MKEYOPR SHOW NO KEYWORDS YET S 58283000 MEXPND05 EQU * 58285000 CLI MCPARTYP,C'S' SYSTEM VAR? 58290000 BNE MEXPND06 IF NOT, PROCEED 58295000 L RX,MCPARNXT ELSE POINT TO NEXT ENTRY 58300000 B MEXPND05 AND TRY AGIAN 58305000 MEXPND06 EQU * 58310000 ST RX,MXPLSYPT SET PNTR TO SYM PAR D.V.'S 58315000 MEXPND07 EQU * 58320000 MVC MCPAROPR($LMPAROP),AWZEROS CLEAR NEXT ENTRY 58325000 MVI MCPAROTP,C'O' SET TYPE TO NULL 58330000 CLI MCPARTYP,C'K' KEYWORD? 58335000 BNE MEXPND08 JUMP TO FOOT IF NOT 58340000 TM AVMBYTE1,$MKEYOPR 1ST KEYWRD DV FOUND? 58345000 BO MEXPND08 JUMP TO FOOT IF YES 58350000 ST RY,MXPNKLPT SAVE @ OF 1ST KEYWRD DICT ENTRY 58355000 ST RX,MXPNKYPT SAVE @ OF 1ST KEYWRD D.V. 58360000 OI AVMBYTE1,$MKEYOPR TURN ON KEYWRD FOUND FLAG 58365000 MEXPND08 EQU * 58370000 L RX,MCPARNXT GET NEXT ENTRY PNTR 58375000 LTR RX,RX LAST ENTRY IN D.V.'S 58380000 BZ MXPLAB01 PROCESS LABEL IF YES 58385000 LA RY,$LMPAROP(RY) ELSE BUMP DICT POINTER 58390000 B MEXPND07 AND INITIALIZE NEXT ENTRY 58395000 SPACE 2 58400000 * NEXT SECTION PROCESS LABEL FIELD OF MACRO CALL 58405000 MXPLAB01 EQU * 58410000 NI AVMBYTE1,X'FF'-$MKEYOPR TURN OFF KEYWORD FLAG 58415000 L RX,MXPLSYPT SET BASE TO 1ST SYM PAR DV 58420000 L RY,MXPNLSPT POINT TO SYM PAR DICTIONARY 58425000 L RA,AVMFLD1 GET @ OF LABEL 58430000 CLI AVMFLDL1,X'00' LABEL PRESENT? 58435000 BE MXPOPR01 IF NOT, PROCESS OPRND FIELD 58440000 CLI MCPARNLN,X'00' LABEL OPRND DEFINED? 58445000 BNE MXPLAB03 PROCESS IF YES 58450000 LA RB,$ERILLAB ELSE SET ILLEGAL LABEL FLAG 58455000 $CALL ERRTAG FLAG STMNT 58460000 B MXPOPR01 PROCESS OPRND 58465000 MXPLAB03 EQU * 58470000 SR R2,R2 CLEAR R2 58475000 IC R2,AVMFLDL1 GET LABEL LENGTH 58480000 LA R2,3(,R2) BUMP FOR ROUND/4 JRM 58485000 SRL R2,2 DIVIDE BY 4 JRM 58490000 SLL R2,2 MULT BY 4, ROUNDED UP JRM 58495000 $MALLOCL RB,R2 GET STORAGE 58500000 IC R2,AVMFLDL1 GET LENGTH 58505000 STC R2,MCPAROLN SAVE LEN IN DICT ENTRY 58510000 BCTR R2,0 DECR FOR EX INST 58515000 EX R2,MXPNMVOP MOVE LABEL TO STORAGE 58520000 MVI MCPAROFL,X'FF' SET DEFINED FLAG 58525000 MVI MCPAROTP,C'U' SET TYPR TO UNDEFINED 58530000 ST RB,MCPAROPT STORE OPRND LOC IN DICTIONARY 58535000 SPACE 2 58540000 * START PROCESSING OPRND FIELD. IS THERE AN OPRND? 58545000 MXPOPR01 EQU * 58550000 MVC MXPNBOPS,AWZEROS INIT OPRND COUNT TO ZERO 58555000 CLC MCPARNXT,AWZEROS SYM PAR DV'S? 58560000 BE MXPNOPFN IF NOT, MOVE STMT TOHIG CORE 58565000 L RA,AVMFLD3 GET OPRND @ 58570000 LTR RA,RA OPRND PRESENT? 58575000 BNZ MXPOPR03 PROCESS IF YES 58580000 IC RA,AVMFLDL2 ELSE GET LEN OF OPCODE 58585000 A RA,AVMFLD2 ADD OPCODE @ TO SCAN POINTER 58590000 DROP RW DROP MACLIB USING 58595000 MXPOPR03 EQU * 58600000 ST RA,AVMTSCNP SAVE PNTR TEMP 58605000 TM AVMBYTE1,$MKEYOPR KEYWORD PROCESSED? 58610000 BO MXPOPK01 JUMP IF YES 58615000 LA RY,$LMPAROP(RY) ELSE BYMP DICT PNTR 58620000 L RX,MCPARNXT AND GET NEXT DV ENTRY 58625000 LTR RX,RX FINAL ENTRY? 58630000 BNZ MXPOPR04 PROCESS IF NOT 58635000 CLI 0(RA),C' ' OPRND PRESENT? 58640000 BE MXPNOPFN FINISHED IF NOT 58645000 LA RB,$ERILOPR ELSE SET NO OPRND ALLWD FLAG 58650000 $CALL ERRTAG FLAG STMT 58655000 B MXPNOPFN AND JUMP TO FOOT 58660000 MXPNMVOP MVC 0($,RB),0(RA) DUMMY TO MOVE OPRND TO STORAGE 58665000 MXPOPR04 EQU * 58670000 CLI MCPARTYP,C'K' SYM PAR DV = KEYWORD? 58675000 BE MXPOPK00 PROCESS KEYWORD S 58690000 MXPOPR05 EQU * 58695000 CLI 0(RA),C' ' OPRND PRESENT? 58700000 BE MXPOPR07 CLEAN UP KEY WORDS IF NOT 58705000 CLI 0(RA),C',' COMMA INIDICATES NULL 58710000 BE MXPOPR0C BUMP OPRND COUNT IF YES 58715000 BAL RET,MXPNOSY7 ORDINARY SYMBOL ? S 58725000 LTR RB,RB RB TELLS ALL 58730000 BNZ MXPOPR06 JUMP AND SCAN OPRND IF NOT 58735000 CLI 0(RC),C'=' KEYWORD ? 58740000 BNE MXPOPR06 PROCESS IF NOT 58745000 OI AVMBYTE1,$MKEYOPR SET KEYWORD FLAG 58750000 B MXPOPK02 PROCESS KEYWRD OPRND 58755000 MXPOPR06 EQU * 58760000 BAL RET,MXPOPSCN SCAN OPRND, SAVE IN DICT 58765000 MXPOPR0C EQU * 58770000 L R1,MXPNBOPS GET OPRND COUNT 58775000 LA R1,1(R1) BUMP BY 1 58780000 ST R1,MXPNBOPS RESTORE 58785000 B MXPOPRFT JUMP TO FOOT 58790000 MXPOPR07 EQU * 58795000 BCTR RA,0 DECR SCN PNTR TO CHECK FOR ',' 58800000 CLI 0(RA),C',' COMMA PRESENT 58805000 LA RA,1(RA) RESTORE SCAN POINTER 58810000 BNE MXPOPKFN IF NOT, JUMP AND CLEAN UP 58815000 L R1,MXPNBOPS ELSE GET N' COUNT 58820000 LA R1,1(R1) BUMP 58825000 ST R1,MXPNBOPS RESTORE 58830000 B MXPOPKFN AND JUMP TO CLEAN UP 58835000 SPACE 2 58840000 MXPOPK00 OI AVMBYTE1,$MKEYOPR SET KEYWORD FLAG S 58840100 MXPOPK01 EQU * PROCESS KEYWORD OPRNDS 58845000 CLI 0(RA),C' ' BLANK? 58850000 BE MXPOPKFN IF YES, FINISH KEYWORD PROTOTYEP 58855000 BAL RET,MXPNOSY7 ORDINARY SYMBOL ? S 58865000 LTR RB,RB RB TELLS ALL 58870000 BNZ MXPOPKFR ERROR IF NONZERO, JUMP OUT 58875000 CLI 0(RC),C'=' KEYWORD ID? 58880000 BNE MXPOPKFQ FLAG ERROR IF NOT '=' 58885000 MXPOPK02 EQU * 58890000 LA RC,1(RC) BUMP PAST '=' 58895000 ST RC,AVMTSCNP SAVE ADDRESS OF DELIM 58900000 MVC AVMSYMBL,AWBLANK CLEAR GLOBAL AREA 58905000 STC R1,AVMSYMLN SAVE LENGHT 58910000 BCTR R1,0 DECR FOR EX INST 58915000 MVI AVMSYMBL,C'&&' SET AMPERSAND IN GLOBAL FILED 58920000 EX R1,MXPNMVC2 A 58925000 L RC,MXPNKYPT GET @ OF FIRST KEYWORD DV 58940000 $CALL MACFND SEARCH SYM PAR LIST 58945000 LTR RB,RB SYMBOL FOUND? 58950000 BNZ MXPOPKFQ FLAG ERROR IF NOT FOUND 58955000 LR RX,RC MOVE BASE TO NEW ENTRY 58960000 MXPOPK03 EQU * 58965000 LA RY,$LMPAROP GET LENGTH OF ENTRY 58970000 MH RY,MCPARNDX MULT BY POSIT OF OPRND IN LIST 58975000 A RY,MXPNLSPT ADD BASE @ OF SYM PAR DICT 58980000 L RA,AVMTSCNP GET @ OF KEYWORD VALUE 58985000 CLI MCPAROFL,X'FF' PREVIOUSLY DEFINED? 58990000 BE MXPOPK06 SET ERROR FLAG IF SO 58995000 CLI 0(RA),C' ' OPRND PRESENT? 59000000 BE MXPOPK05 IF NOT, NULL OPRND 59005000 CLI 0(RA),C',' COMMA? 59010000 BE MXPOPK05 ALSO NULL IF YES 59015000 B MXPOPK04 ELSE PROCEED 59020000 MXPOPK06 EQU * 59025000 IC R1,AVMSYMLN GET LEN OF KEYWORD NAME 59030000 LA R1,1(R1) BUMP FOR '=' 59035000 SR RA,R1 RESTORE SCAN POINTER 59040000 B MXPOPKFQ JUMP AND FLAG ERROR 59045000 MXPOPK04 EQU * 59050000 BAL RET,MXPOPSCN SCAN OPRND AND SAVE IN TEMP STORGE 59055000 B MXPOPRFT JUMP TO FOOT 59060000 MXPOPK05 EQU * 59065000 MVI MCPAROFL,X'FF' NULL OPRND, SET DEFINED FLAG 59070000 B MXPOPRFT JUMP TO FOOT 59075000 SPACE 59080000 * NEXT ROUTINE CLEANS UP DEFAULTS FOR KEYWORD OPRNDS 59085000 MXPOPKFQ EQU * 59090000 LA RB,$ERUNDKW SET BAD KEYWORD FLAG 59095000 MXPOPKFR EQU * 59100000 $CALL ERRTAG FLAG STMT 59105000 MXPOPKFN EQU * 59110000 L RX,MXPNKYPT POINT AT 1ST SYM PARDV KEYWORD 59115000 LTR RX,RX PRESENT? 59120000 BZ MXPNOPFN FINISHED IF ZERO 59125000 L RY,MXPNKLPT POINT TO 1ST KEYWORD DICT ENTRY 59130000 MXPOPKF1 EQU * 59135000 CLI MCPAROFL,X'FF' DEFINED? 59140000 BE MXPOPKFB JUMP TO FOOT IF YES 59145000 BAL RET,MXPOPKPR ELSE LOOK AT PROTOTYPE 59150000 MXPOPKFB EQU * 59155000 L RX,MCPARNXT GET NEXT KEYWORD OPRND 59160000 LTR RX,RX FINAL OPRND? 59165000 BZ MXPNOPFN FINI IF YES 59170000 LA RY,$LMPAROP(RY) BUMP DICTIONARY POINTER 59175000 B MXPOPKF1 AND RESUME SCAN 59180000 EJECT S 59185000 **--> INSUB: MXPOPKPR + + + + + + + + + + + + + + + + + + + + + + + +S 59190000 *+ +S 59190500 *+ SCAN PROTOTYPE OPRND AND SAVE IN LOCAL DICTIONARY +S 59191000 *+ +S 59192000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59193000 SPACE 2 S 59194000 MXPOPKPR EQU * 59195000 ST RET,MXPKPRSV SAVE RETURN @ 59200000 MVC MCPAROTP,MCPRATYP COPY TYPE ATTRIB INTO DICTIONARY J 59202000 CLI MCPRATYP,C'O' NULL OPRND? 59205000 BE MXPPRKFT FINI IF YES 59210000 L RA,MCPROPRN GET POINTER TO PROTOTYP OPRND 59215000 MVI MCPARONB,1 ASSUME N' = 1 TEMPORARILY J 59220000 MVC MCPAROLN,MCPROPLN COPY LENGTH 59225000 MVC MCPAROPT,MCPROPRN COPY POINTER 59235000 MVI MCPAROFL,X'FF' SET DEFINED FLAG 59240000 CLI MCPAROTP,C'S' SUB LIST? 59245000 BNE MXPPRKFT FIISHED IF NOT 59250000 MVI MCPARONB,0 ZERO, SO WILL ACCUMULATE N' OK J 59252000 BAL RET,MXPNSBSC SCAN OPRND SUB LIST 59255000 MXPPRKFT EQU * 59260000 L RET,MXPKPRSV RESTORE RETURN @ 59265000 BR RET AND RETURN 59270000 MXPKPRSV DS F STORAGE FOR RETURN @ 59275000 EJECT S 59280000 **--> INSUB: MXPOPSCN + + + + + + + + + + + + + + + + + + + + + + + +S 59285000 *+ +S 59285500 *+ SCAN STD OPRND AND STORE IN LOW STORAGE +S 59286000 *+ +S 59287000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59288000 SPACE 2 S 59289000 MXPOPSCN EQU * 59290000 ST RET,MXPPSCSV SAVE RETURN @ 59295000 ST RA,AVMTSCNP SAVE SCAN POINTER 59300000 NI AVMBYTE1,X'FF'-$MSBLIST TURN OFF SUBLIST FLAG 59305000 $CALL MCSCOP SCAN OPRND 59310000 LTR RB,RB OKAY? 59315000 BNZ MXPOPKFR AND LEAVE OPRNDS 59320000 STC RC,MCPAROLN PUT OPRND LEN IN DICT 59325000 STC RD,MCPAROTP STORE TYPE 59330000 MVI MCPAROFL,X'FF' SET OPRND FLAG 59335000 LA RC,3+1(,RC) ROUND + 1 BYTE FOR DELIMITER AFTER J 59340000 SRL RC,2 TRUNCATE 59345000 SLL RC,2 BY SHIFITING 59350000 $MALLOCL RB,RC GET STORAGE 59355000 IC RC,MCPAROLN GET ORIGINAL LENGTH 59360000 * USE LENGTH RATHER THAN L-1: COPY DELIMITER AFTER ARG, J 59365000 * HELPS MEXPND SCAN RIGHT FOR &I SETA &ARG OPERATION. J 59365010 LR R0,RA COPY SCAN POINTER 59370000 L RA,AVMTSCNP GET ORIGINAL POINTER 59375000 ST R0,AVMTSCNP SAVE SCAN POINTER 59380000 EX RC,MXPNMVOP MOVE OPRND TO LOW STORAGE 59385000 ST RB,MCPAROPT SAVE OPRND @ IN DICTIONARY 59390000 CLI MCPAROTP,C'S' SUB LIST? 59395000 BE MXPOPSBS PROCESS SUBLIST IF YES 59400000 MVI MCPARONB,1 ELSE SET OPRND COUNT TO 1 59405000 B MXPOPSCF 59410000 MXPOPSBS EQU * 59415000 LR RA,RB SCAN PNTR TO OPRND 59420000 BAL RET,MXPNSBSC SCAN SUB OPRNDS 59425000 MXPOPSCF EQU * 59430000 L RA,AVMTSCNP RESTORE SCAN POINTER 59435000 L RET,MXPPSCSV RESTORE RETURN @ 59440000 BR RET AND RETURN 59445000 MXPPSCSV DS F STORAGE FOR RETURN @ 59450000 EJECT S 59455000 **--> INSUB: MXPNSBSC + + + + + + + + + + + + + + + + + + + + + + + +S 59460000 *+ +S 59461000 *+ SCAN OPRND SUBLIST, CREATE ENTRY IN DICTIONARY +S 59461500 *+ +S 59462000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59463000 SPACE 2 S 59464000 MXPNSBSC EQU * 59465000 ST RET,MXPNSBSV SAVE RETURN @ 59470000 USING MCPARSUB,RW NOTE USING ON SUBOPRND ENTRY 59475000 LA RA,1(RA) BUMP PAAST '(' 59480000 OI AVMBYTE1,$MSBLIST SET SUBLIST FLAG 59485000 MXPNSB01 EQU * 59490000 LA RB,$LMPARSB GET LENGTH OF SUB ENTRY 59495000 $MALLOCL RW,RB GET STORAGE 59500000 MVC 0($LMPARSB,RW),AWZEROS CLEAR ENTRY 59505000 ST RA,MCPARSPT SAVE POINTER TO SUB ENTRY STRNG 59510000 $CALL MCSCOP SCAN SUB OPRND 59515000 LTR RB,RB ERROR? 59520000 BZ MXPNSB02 PROCEED IF NOT 59525000 S RA,MCPAROPT GET OFFSET OF POINTER 59530000 LR RE,RA COPY TEMPORARILY 59535000 IC RA,MCPAROLN GET LENGTHOF OPRND 59540000 S RA,AVMTSCNP SUBTRACT CURRENT PNTR 59545000 LPR RA,RA GET POS VALUE 59550000 AR RA,RE ADD OFFSET OF ERROR 59555000 B MXPOPKFR FORGET ABOUT REST OF OPRNDS 59560000 MXPNSB02 EQU * 59565000 CLI MCPARONB,X'00' 1ST SUB OPRND? 59570000 BNE MXPNSB03 59575000 STC RD,MCPAROTP MAIN OP TYPE = 1ST SUB TYPE 59580000 ST RW,MCPRSBPT SAVE PNTR TO SUB ENTRIES 59585000 MXPNSB03 EQU * 59590000 STC RC,MCPARSLN SAVE LEN IN DV 59595000 STC RD,MCPARSTP SAVE TYPE 59600000 IC RD,MCPARONB GET SUB OPRND COUNT 59605000 LA RD,1(RD) BUMP BY ONE 59610000 STC RD,MCPARONB RESOTRE 59615000 CLI 0(RA),C')' END OF LIST? 59620000 LA RA,1(RA) BUMP PAST DELIM 59625000 BNE MXPNSB01 RESUME SCAN IF NO ')' 59630000 L RET,MXPNSBSV GET RETURN @ 59635000 BR RET AND RETURN 59640000 MXPNSBSV DS F SPACE FOR RETURN @ 59645000 DROP RW 59650000 EJECT S 59655000 **--> INSUB: MXPNOSYM DETERMINS IF STRING IS ORDINARY + + + + +S 59660000 *+ SYMBOL OF EITHER LENGTH 7 OR 8 (MAX) +S 59665000 *+ MXPNOSY7: SETS RB = 7 +S 59665100 *+ +S 59670000 *+ ENTRY CONDITIONS: +S 59675000 *+ RA = 1ST CHAR OF SYMBOL +S 59680000 *+ RB = ALLOWABLE LENGTH (7 OR 8) +S 59685000 *+ +S 59690000 *+ EXIT CONDITIONS: +S 59695000 *+ RA = SAME AS ENTRY +S 59700000 *+ RB = ERROR INDICATION (0 --> OK) +S 59705000 *+ RC = @ OF DELIM PAST SYMBOL +S 59710000 *+ R1 = LENGTH OF SYMBOL +S 59711000 *+ +S 59712000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59713000 SPACE 2 S 59715000 MXPNOSY7 LA RB,7 SET MAX LENGTH OF KEYWORD S 59715100 MXPNOSYM EQU * 59720000 CLI 0(RA),C'0' FIRST CHAR = DIGIT? 59725000 BNL MXPSYMR1 ERROR IF YES 59730000 EX RB,MXPNOSSC SCAN SYMBOL 59735000 BZ MXPSYMR2 ZERO MEANS TOO LONG 59740000 LR RC,R1 ELSE MOVE DELIM TO RC 59745000 SR R1,RA GET LENGTH IN R1 59750000 BZ MXPSYMR2 NO SYMBOL IF ZERO LENGTH 59755000 SR RB,RB CLAR RB FOR RETURN 59760000 BR RET 59765000 MXPSYMR1 EQU * 59770000 MXPSYMR2 EQU * 59785000 LA RB,$ERINVSY SET BAD SYMBOL FALG 59790000 BR RET AND RETURN 59795000 MXPNOSSC TRT 0($,RA),AWTSYMT DUMMY FOR SCAN 59800000 EJECT S 59805000 MXPOPRFT EQU * 59810000 CLI 0(RA),C' ' BLANK? 59815000 BE MXPOPR03 RESUME SCAN IF YES 59820000 LA RA,1(RA) ELSE BUMP PAST DELIM 59825000 CLI 0(RA),C' ' BLANK AFTER ','? 59830000 BNE MXPOPR03 RESUME SCAN IF NOT 59835000 SPACE 1 59840000 L RC,AVRSBPT SET BASE OF RSBLOCK 59845000 USING RSBLOCK,RC NOTE USING ON RSBLOCK 59850000 * POSSIBLE NON-STND CONT CARD 59855000 CLI RSBNUM,1 ONLY 1 CARD? 59860000 BE MXPOPR03 RESUME SCAN IF YES 59865000 LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 59870000 CR RA,RB POINTING AT WHICH CARD? 59875000 BNH MXPOPC#2 PROCESS 2ND CARD IF LOW 59880000 CLI RSBNUM,3 TWO CONT CARDS? 59885000 BNE MXPOPR03 RESUME SCAN IF NOT 59890000 LA RB,RSOLC(RB) POINT TO 1ST BYTE, 3RD CARD 59895000 CR RA,RB WHERE IS SCAN POINTER? 59900000 BH MXPOPC#3 CHECK FOR 4TH CARD 59905000 MXPOPC#2 EQU * 59910000 LR RA,RB MOVE SCAN POINTER TO CONT CARD 59915000 CLI 0(RA),C' ' CONT CARD IS NON BLANK? 59920000 BNE MXPOPR03 PROCEED IF YES 59925000 LA RB,$ERVILCH SET BAD CONT CARD ERROR FLAG 59930000 B MXPOPKFR AND JUMP TO FOOT 59935000 SPACE 2 59940000 MXPOPC#3 EQU * 59945000 CLI AVMBYTE5,$ERCONTX MORE THAN TREE CARDS? 59950000 BNE MXPOPR03 PROCEED WITH SCAN IF NOT 59955000 $CALL MXMVSR ELSE MOVE CARDS TO HIGH CORE 59960000 LTR RB,RB CORE EXCEEDED? 59965000 BNZ MXPNDOVR JUMP OUT IF YES 59970000 BAL RET,MXPNRDR ELSE READ CONT CARDS 59975000 L RC,AVRSBPT ESTAB BASE ON RSBLOCK 59985000 LA RA,RSBSOURC POINT TO STMT START 59990000 CLC 0(15,RA),AWBLANK COLS 1-15 BLANK? 59995000 BE MXPOPC#4 OKAY IF YES 60000000 LA RB,$ERCONT ELSE SET ERROR FLAG 60005000 $CALL ERRTAG AND FLAG STMT 60010000 MXPOPC#4 EQU * 60015000 LA RA,15(RA) POINT TO COL 16 60020000 B MXPOPR03 AND RESUME SCAN 60025000 EJECT S 60030000 **--> INSUB: MXPNRDR + + + + + + + + + + + + + + + + + + + + + + + +S 60035000 *+ +S 60035500 *+ CARD READER FOR ROUTINE MEXPND +S 60036000 *+ +S 60037000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 60038000 SPACE 2 S 60039000 MXPNRDR EQU * S 60039500 ST RET,MXPNRDSV SAVE RETURN @ 60040000 MVC MXPGENCD,AVGEN1CD COPY AVGEN1CD 60045000 MVC AVGEN1CD,AVGEN2CD MAKE PNTRS EQUAL FOR INCARD 60050000 $CALL INCARD READ NEXT STMT 60055000 OI AVRSBLOC+1,$RSBNPNN SET NO PROCESS FLAG S 60060000 SR RE,RE CLEAR RE 60065000 IC RE,AVRSBLOC GET LENG-1 OF STMT 60070000 LA RD,RSB$L GET LENGTH OF STND PART 60075000 SR RE,RD SUBTRACT FROM OVERALL LENGTH 60080000 STC RE,AVRSBLOC RESTORE REDUCED LENGTH 60085000 MVC AVGEN1CD,MXPGENCD RESTORE AVGEN1CD POINTER 60090000 STC RB,AVMBYTE5 SAVE ERROR FLAG 60095000 CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 60100000 BE MXPNRDRT PROCEED IF YES 60105000 LTR RB,RB ELSE TEST FOR ERROR 60110000 BZ MXPNRDRT PROCEED IF NONE 60115000 $CALL ERRTAG ELSE FLAG STMT 60120000 TM AVTAGS2,$INEND2 END OF FILE ERROR? 60125000 BO MXPNDERT JUMP OUT IF YES 60130000 MXPNRDRT EQU * 60135000 L RET,MXPNRDSV RESTORE RETURN @ 60140000 BR RET AND RETURN 60145000 MXPNRDSV DS F SPACE FOR RETURN @ 60150000 MXPGENCD DS F TEMP STORAGE FOR AVGEN1CD 60155000 EJECT S 60160000 * NORMAL EXIT CODE S 60160100 SPACE 1 S 60160200 MXPNOPFN EQU * 60165000 $CALL MXMVSR MOVE SOURCE TO HIGH AREA 60170000 CLI AVMBYTE5,$ERCONTX 4 CARDS? 60175000 BNE MXPNOPFP PROCEED IF NOT 60180000 BAL RET,MXPNRDR ELSE READ NEXT CARD 60185000 L RC,AVRSBPT SET BASE FOR RSBSOURC 60190000 OI RSBFLAG,$RSBNPNN SET NO ACTION FLAG 60195000 B MXPNOPFN AND PTINT CARDS 60200000 DROP RC 60205000 MXPNOPFP EQU * 60210000 CLC AVMACNST,AWF1 WAS THIS ACTUALLY OUTER MACRO CL JRM 60215000 BNE *+10 NO, SO SKIP RESET OF PTR JRM 60220000 MVC MEXGN2OV,AVGEN2CD THUS SAVE CURRENT PTR FOR OVRFL JRM 60225000 LTR RB,RB OVERFLOW? 60230000 BZ MXPNLOCD PROCEED IF NOT 60235000 SPACE 3 S 60235100 * OVERFLOW EXIT S 60235200 SPACE 1 S 60235300 MXPNDOVR EQU * 60240000 MVC AVGEN1CD,AVADDHIH SET PNTR TO OVRFLW MESSAGE 60245000 MVC AVGEN2CD,MEXGN2OV RESET OVERFLO PTR, SHOW @ EITHER OF #60250000 AS218 MESSAGE OR OF OUTER MACRO CALL. JRM 60255000 B MXNORML A 60260000 SPACE 1 A 60265000 SPACE 60270000 MEXGN2OV DC F'0' @ LAST STMT, IF OVERFL**MOVE*** JRM 60275000 MXPOVRMS DC C'218 STORAGE EXCEEDED BY FOLLOWING MACRO EXPANSION' 60280000 DC AL1(L'MXPOVRMS-1,$RSBNPNN+$RSBMERR,$,$) 60285000 SPACE 60290000 DS 0H A 60290050 MEXPMNES EQU * ERROR EXIT MNEST LIMIT A 60290100 LA RB,$EREXMAC A 60290200 L RA,AVRSBPT A 60290300 LA RA,RSB$L+10(RA) POINT TO OPCODE A 60290400 MXPNDERT DS 0H 60295000 $CALL ERRTAG 60305000 $CALL MXMVSR MOVE SOURCE TO HIGH AREA IF INNER 60310000 LTR RB,RB OVERFLOW? 60315000 BNZ MXPNDOVR JUMPP AND FLAG IF YES 60320000 * S 60321000 * NORMAL RETURN SEQUENCE FOR MEXPND S 60322000 * -- ALSO SET PTR TO RELEASE LOW STORAGE AREA S 60323000 * S 60324000 MXNORML EQU * NORMAL RETURN A 60325000 MVC AVADDLOW,MXADDLOW RESTOR PTR A 60325100 SR RB,RB SHOW NORMAL RETURN ALWAYS J 60325150 $RETURN RGS=(R14-R6) A 60325200 SPACE 4 60330000 * NEXT SECTION ALLOCATES AND INITIALIZES STORAGE FORLOCAL SET SYMBOL* 60335000 * DICTIONARY 60340000 MXPNLOCD EQU * 60345000 SPACE 60350000 AIF (&$DEBUG).MXPNLDB 60355000 L RA,MXPNLSPT GET PNTR TO SYM PAR DICT 60360000 L R1,AVGEN2CD GET PNTR TO HIGH AREA 60365000 L R2,AVADDHIH GET PNTR TO BEGINNING OF HIGH AREA 60370000 XSNAP LABEL='***SYM PAR DICT INITIALIZED***', X60375000 IF=(AVMSNBY2,O,$MSNP11,TM), X60380000 STORAGE=(*0(R1),*0(R2),*0(R13),*124(R13),*0(RA),*128(RA)X60385000 ) 60390000 .MXPNLDB ANOP 60395000 SPACE 60400000 AP AVMSYSDX,AWP1 BUMP SYSNDX COUNTER 60405000 ZAP MXPSYSDX,AVMSYSDX COPY INTO LOCAL AREA 60410000 L RW,MXPNMCLB GET POINTER TO MACLIB 60415000 USING MACLIB,RW SET USING 60420000 MVC MXPNCDPT,MCCODLNK SAVE PNTR TO CODE 60425000 L R1,MCLOCDLN GET LEN OF LOCAL DICTIONARY 60430000 $MALLOCL R2,R1 GET CORE FOR SET SYMBOL DICT 60435000 ST R2,MXPNLDBS SAVE BASE IN LOCAL AREA 60440000 * INITIALIZE DICTIONARY TO ZEROS 60445000 LR R0,R1 SAVE COMPLETE LENGTH FOR LATER J 60448000 BCTR R1,0 DECR COUNT 60450000 EX R1,MXPNMVZR CLEAR LENGTH MOD 256 60455000 SRA R1,8 SHIFT TO GET # 256 BYTE BLOCKS LEFT 60465000 BNP MXPNLOC2 SKIP IF NO MORE TO DO 60470000 N R0,AWFXFF GET LAST BYTE OF LENGTH J 60470100 AR R2,R0 GET @ FIRST BYTE TO ZERO J 60470200 SPACE 1 60475000 MVC 0(256,R2),AWZEROS CLEAR 256 BYTES AT A TIME 60480000 LA R2,256(,R2) INCREMENT TO NEXT 60485000 BCT R1,*-10 LOOP, CLEARING UNTIL DONE 60490000 SPACE 60495000 MXPNLOC2 EQU * 60500000 L R2,MXPNLDBS GET BASE OF SET SYMB LOCAL DICT 60505000 MVC 0(4,R2),AVMMACTR SET ACTR LIMIT 60510000 TM AVMBYTE4,$MGENSTP ARE MACROS KILLED ? S 60510100 BO MXNORML IF YES, RETURN S 60510200 MVC MXPNCRCD,MXPNCDPT SET PTR TO 1ST INSTR S 60515000 SPACE 2 S 60530100 * THIS NEXT SECTION OF CODE SETS CALLING S 60530110 * ARGUMENTS AND CALLS MXINST TO S 60530120 * INTERPRET DICTIONARY ONE-OPS AND S 60530130 * CREATE GENERATED CODE ----- S 60530140 * THEN USE RETURNED CODE TO BRANCH ON INDEX S 60530150 * FOR FURTHER PROCESSING S 60530160 SPACE 2 S 60530170 MXPNCALL EQU * S 60530195 LR RC,RZ SET CALLING CONVENTION S 60530200 XCALL MXINST CALL ROUTINE A 60530210 B *+4(RB) BRANCH ON RETURNED INDEX S 60530220 B MXPNDX0 RB=0 MEND,MEXIT A 60530230 B MEXPND01 RB=4 INNER MACRO CALL A 60530240 B MXNORML RB=8 KILL THIS NEST S 60530250 B MXKILMAC RB=12 KILL ALL MACROS S 60530260 B MXPNDOVR RB=16 STORAGE OVERFLOW S 60530270 SPACE 2 S 60530275 * SET FLAG TO KILL ALL MACROS S 60530280 * S 60530285 MXKILMAC EQU * KILL ALL MACROS A 60530300 OI AVMBYTE4,$MGENSTP LILL A 60530310 B MXNORML A 60530320 * S 60530330 * BACK UP NEST DEPTH COUNTER AND CALL MXINST S 60530340 * AGAIN IF NOT DONE WITH NEST S 60530350 * S 60530360 MXPNDX0 EQU * S 60530370 ST RZ,AVADDLOW STORE CURRENT RZ S 60530380 L R0,AVMACNST GET NEST LEVEL S 60530390 BCTR R0,0 DECR BY 1 S 60530400 ST R0,AVMACNST STORE NEW DEPTH LEVEL S 60530410 LTR R0,R0 LEVEL = 0 ? S 60530420 L RZ,MXPNLINK GET NEXT LINK S 60530430 BZ MXNORML NO MORE, RETURN S 60530440 L RE,MXPNCRCD GET @ OF LAST INSTR PROC (CALL) S 60530441 USING MCOPQUAD,RE NOTE ONE-OP PTR S 60530442 MVC MXPNCRCD,MCQUDNXT GET @ OF NEXT INSTR (AFTER CALL) S 60530443 DROP RE REMOVE USING S 60530444 B MXPNCALL CALL MXINST TO GENERATE CODE S 60530445 SPACE 2 S 60530450 * DEFINED CONSTANTS/STORAGE & DUMMY INSTRS S 60530460 MXADDLOW DS F FULL WORD TO SAVE AVADDLOW S 60530470 MXPNMVZR MVC 0($,R2),AWZEROS DUMMY INSTR S 60530480 MXPNMVC2 MVC AVMSYMBL+1($),0(RA) DUMMY INSTR S 60530490 MXPNMVC MVC AVMSYMBL($),0(RA) DUMMY INSTR S 60530500 LTORG S 60530510 DROP RW,RX,RY,RZ S 60530520 TITLE 'MXINST -- INTERPRETATION PHASE' S 60535000 **--> CSECT: MXINST EXECUTE INSTRUCTIONS IN MACRO DEF *S 60535100 *. ENTRY CONDITIONS: *S 60535200 *. RC = @ MXPNTSAV *S 60535300 *. EXIT CONDITIONS: *S 60535400 *. RB = 0 MEND OR MEXIT FOUND *S 60535500 *. 4 INNER MACRO CALL *S 60535600 *. 8 KILL THIS MACRO NEST *S 60535700 *. 12 KILL ALL MACROS *S 60535800 *. 16 STORAGE OVERFLOW *S 60535900 *. *S 60540000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **S 60540100 SPACE 2 S 60540200 MXINST CSECT A 60545000 $SAVE RGS=(R14-R6),BR=13,SA=* A 60550000 USING AVWXTABL,RAT NOTE MAIN TABLE USING S 60551000 USING MCOPQUAD,RW NOTE USING ON ONE-OP 60555000 MVC AVRSBLOC(RSB$L),AWZEROS ZERO STND PART OF RSBLOC 60560000 MVC AVRSBLOC+4($LMSRCMX),AWBLANK BLANK REMAINDER 60565000 LR RZ,RC A 60570000 USING MXPNTSAV,RZ A 60575000 L RW,MXPNCRCD A 60575050 XSNAP LABEL='MXINST INIT',STORAGE=(*MXPNTSAV,*MXPNLSPT+4,*AVADX60575100 DLOW,*AVWXEND),IF=(AVTAGSM,O,AJOMACRG,TM) S 60575200 $SPIE MXPNINJE,((8,9)),ACTION=CR,CE=MXPNZDIV PRODUCTION TYPE 60660000 ST R1,AVMXSPIE SAVE PREV INT BLOCK @ 60670000 B MXPNIN01 SKIP, BEGIN AT 1ST ONE-OP 60675000 SPACE 60680000 MXPNEXBS DS 0H ESTAB BASE FOR INDEX TABLE 60685000 MXPNINJE EQU * ENTER HERE TO FLAG ERROR AND GO ON 60690000 * TO NEXT ONE OP. EXPECTS RB = ERROR CODE. 60695000 BAL R1,MXINERRM GENERATE ERROR MESG A 60700000 SPACE 1 60705000 MXPNINJP EQU * COME HERE FOR EACH NON-BRANCH STMT 60710000 * AFTER VERY FIRST ONE. 60715000 L RW,MXPNCRCD RESTORE BASE TO 1ST ONE-OP 60720000 L RW,MCQUDNXT GET @ NEXT SEQUENTIAL INSTRUCTION 60725000 SPACE 1 60730000 MXPNINJQ EQU * COME HERE FOR AGO/GOOD AIF. RW= @ 60735000 AIF (NOT &$MACOPC).MXINSTA SKIP IF NOT OPEN CODE S 60746000 * ALLOW ONLY ONE STATEMENT DONE IF IN OPEN CODE S 60746500 L RX,MXPNMCLB LOAD @ OF MACLIB ENRTY A 60746600 USING MACLIB,RX NOTE USING ON MACLIB S 60746700 TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 60747000 BO MXMEND RETURN IF YES S 60747500 DROP RX S 60747600 .MXINSTA ANOP S 60748000 SPACE 60750000 AIF (&$DEBUG).MXPNNDB 60755000 L R1,MXPNCRCD GET @ OF CURRENT INST 60760000 L R2,AVMCHSTR GET POINTER TO CHAR WORK AREA 60765000 XSNAP LABEL='***INSTRUCTION EXECUTED***', X60770000 IF=(AVMSNBY2,O,$MSNP11,TM), X60775000 STORAGE=(*0(R1),*128(R1),*0(R2),*128(R2)) 60780000 .MXPNNDB ANOP 60785000 SPACE 60790000 L R1,AVMMSTMG GET GLOBAL LIMIT ON ISNTRUCTIONS 60795000 S R1,AWF1 DECR COUNT 60800000 ST R1,AVMMSTMG RESTORE 60805000 BNP MXMENDER GO TO FLAG ERROR AND STOP 60810000 SPACE 60815000 MXPNIN01 EQU * 60820000 MVC MXPCHRBF,AVMCHSTR INIT BUFFER POINTER 60825000 ST RW,MXPNCRCD UPDATE CURRENT INST POINTER 60830000 * EACH STMT CONSISTS OF ONE-OP PREFIX(PTR,STMT#,STC), A 60831000 * FOLLOWED BY 0-MORE REGULAR ONE-OPS(MXOPQUAD DSECT)L A 60832000 * FOR ANOP,MEND,MEXIT,$BSERR01(ERROR), THE OPERATOR A 60833000 * CODE IS IN PREFIX (MCQS1FLG). FOR OTHERS, IT =0 A 60834000 CLI MCQS1FLG,0 WAS IT NORMAL PREFIX WITH ONE-OPS A 60835000 BE MXPNIN03 YES SKIP SPECIAL CODE A 60836000 IC R2,MCQS1FLG GET OPERATOR TYPE A 60837000 B MXPNPREF GO TO PREFIX ONLY CODE A 60838000 MXPNIN03 SH RW,=AL2($LMCQUAD-$LMCOPL1) BACK UP,SO WILL BUMP RIGHT A 60839000 * FALL THRU, START DOING ONE-OPS A 60840000 EJECT 60845000 * NEXT SECTION PROCESSES A SINGLE ONE-OP 60850000 MXPNONJP EQU * 60855000 LA RW,$LMCQUAD(RW) BUMP PAST CURRENT ONE-OP 60860000 SR RA,RA CLEAR FOR INSERTS****************JRM 60865000 MVI AVMBYTE2,X'00' CLEAR FLAG BYTE FOR TYPE USE A 60870000 IC RA,MCARG1DX GET INDEX OF 1ST ARG 60875000 L RB,MCARG1LC GET LOC OF 1ST ARG 60880000 IC R2,MCBOPRTR GET OPCODE 60885000 MXPNPREF EQU * ENTER HERE FOR PREFIX ONLY ONES A 60887000 N R2,=X'0000007E' MASK OUT CHAR REL BIT, SPECIAL PRINA 60890000 LH R1,MXPNINDX(R2) GET OFFSET 60895000 XSNAP LABEL='MXPNONJP',STORAGE=(*0(RW),*16(RW)), X60895100 IF=(AVTAGSM,O,AJOMACRH,TM) 60895200 B MXPNEXBS(R1) JUMP TO ROUTINE 60900000 SPACE 60905000 MXPNINDX $AL2 MXPNEXBS,(MXFIN,MXPLUS,MXMIN,MXMULT,MXDIV,MXOR,MXAND,MXN#60910000 OT,MXNE,MXGE,MXLE,MXLT,MXEQ,MXGT,MXCAT,MXAGO,MXAIF,MXSET#60915000 A,MXSETB,MXSETC,MXINV,MXINV,MXSBSCRP,MXSBST,MXSYSL,MXINV#60920000 ,MXPRNT,MXMEXIT,MXMEND,MXANOP,MXERRMS,MXINMAC,MXMVSTMT) 60925000 SPACE 60930000 * ENTRY POINT FOR SPIE ACTION 60935000 MXPNZDIV EQU * 60940000 USING MXPNZDIV,REP 60945000 LA RB,$ER#ZDIV SET ERROR FLAG 60950000 BR RET RETURN NOW, RB SET 60955000 AIF (&$DEBUG).MACQQ04 SKIP IF NO DEBUG 60960000 ORG *-2 GET BACK OVER NON-DEBUG CODE 60965000 CLI 3(R1),8 FIXED POINT OVERFLOW? 60970000 BCR E,RET RETURN IF YES FOR MORE SPIE ACTION 60975000 CLI 3(R1),9 ZERO DIVIDE? 60980000 BCR E,RET RETURN IF YES FOR MORE SPIE ACTION 60985000 L RA,AVGEN2CD ELSE POINT TO LOW END OF HIGH CORE 60990000 L RB,AVADDHIH POINT TO HIGH END OF HIGH CORE 60995000 L RC,AVMACLIB POINT TO START OF LOW CORE 61000000 L RD,AVADDLOW POINT TO HIGH END OF LOW CORE 61005000 XSNAP LABEL='*** INTERRUPT IN MACRO EXPANSION ***', X61010000 STORAGE=(*0(R1),*20(R1),*0(RA),*0(RB),*0(RC),*0(RD),*AVA#61015000 DDLOW,*AVWXEND,*0(R13),*130(R13)) 61020000 DC X'00FF' FORCE INTERRUPT 61025000 .MACQQ04 ANOP 61030000 DROP REP 61035000 SPACE 61040000 * A 61040200 MXPLUS EQU * 61045000 MXMIN EQU * 61050000 * ARITHMETIC OPERATIONS HERE A 61050100 MXMULT EQU * 61055000 MXDIV EQU * 61060000 BAL RET,MXARITH CVRT 1ST ARG TO ARITH VLUE 61065000 ST RC,MXARG1 SAVE TEMPORRAILY 61070000 IC RA,MCARG2DX GET 2ND ARG TYPE 61075000 L RB,MCARG2LC GET LOCATION OF 2ND ARG 61080000 BAL RET,MXARITH GET ARITH VALUE 61085000 LR RD,RC COPY INTO RD 61090000 L RB,MXARG1 RELOAD 1ST ARGUMENT**************JRM 61095000 SRDA RB,32 MOVE OVER TO RC, WITH SIGN RIGHT 61100000 IC RA,MCBOPRTR GET OPCODE 61110000 EX 0,MXARITOP-2(RA) EXECUTE CORRECT OPERATION 61115000 ST RC,MCRESULT PUT RESULT IN ONE-OP 61120000 MVI MCRSLTYP,$BSIMMA SET TYPE 61125000 B MXPNONJP GET NEXT ONE-OP 61130000 SPACE 1 61135000 MXARITOP DS 0H TABLE OF INSTRS TO BE EXECUTED 61140000 AR RC,RD ADD 61145000 SR RC,RD SUBTRACT 61150000 MR RB,RD MULTIPLY 61155000 DR RB,RD DIVIDE 61160000 EJECT A 61165000 * LOGICAL OPERATORS A 61165100 * A 61165200 MXOR EQU * 61170000 MXAND EQU * 61175000 BAL RET,MXBOOL GET 1ST ARG VALUE 61180000 ST RC,MXARG1 SAVE TEMPORARILY 61185000 IC RA,MCARG2DX GET 2ND ARG TYPE 61190000 L RB,MCARG2LC GET 2ND ARG LOC'N 61195000 BAL RET,MXBOOL GET 2ND ARG VALUE 61200000 L RD,MXARG1 RESTORE 1ST ARG VALUE 61205000 CLI MCBOPRTR,$BSOR OR OPRND? 61210000 BE MXOR01 JUMP TO OR IF YES 61215000 NR RC,RD ELSE CARRY OUT AND OPERATION 61220000 B MXOR02 JUMP TO FOOT 61225000 MXOR01 EQU * 61230000 OR RC,RD CARRY OUT OR OPERATION 61235000 MXOR02 EQU * 61240000 ST RC,MCRESULT STORE RESULT IN ONE-OP 61245000 MVI MCRSLTYP,$BSIMMB SET TYPE 61250000 B MXPNONJP GET NEXT ONE-OP 61255000 SPACE 61260000 MXNOT EQU * 61265000 BAL RET,MXBOOL CONVERT TO BOOL VALUE 61270000 X RC,AWF1 DO EXCLUSINVE OPERATION 61275000 B MXOR02 SAVE RESULT IN ONE-OP 61280000 EJECT 61285000 MXNE EQU * 61290000 MXGE EQU * 61295000 MXLE EQU * 61300000 MXLT EQU * 61305000 MXEQ EQU * 61310000 MXGT EQU * 61315000 LA R1,$BSNE GET $BSNE VALUE IN R1 61320000 SRL R2,1 DIVIDE OPCADE BU 2 A 61325000 IC R2,MXRELOPS-($BSNE/2)(R2) A 61330000 STC R2,MXRELCH2+1 SAVE IT A 61335000 MVI MCRSLTYP,$BSIMMB SET RESULT TYPE 61345000 MVC MCRESULT,AWZEROS ASSUME FALSE FOR START 61350000 TM MCBOPRTR,$BSRLCHR CHAR RELATION? 61355000 BO MXRELCHR PROCESS CHAR REL IF YES 61360000 MXRELAR EQU * ELSE PROCESS ARITH RELATION 61365000 BAL RET,MXARITH GET 1ST VALUE 61370000 ST RC,MXARG1 STORE TEMP 61375000 IC RA,MCARG2DX GET ARG2 INDEX 61380000 L RB,MCARG2LC GET ARG2 LOCATION 61385000 BAL RET,MXARITH GET ARITH VALUE 61390000 L RB,MXARG1 GET 1ST ARG 61395000 CR RB,RC COMPARE OPRNDS 61405000 B MXRELCH2 FALL THROUGH MEANS FALSE A 61410000 MXRLATRU EQU * TARGET FOR TRUE CONDITION 61420000 MVI MCRESULT+3,X'01' SET RESULT TO TRUE 61425000 B MXPNONJP GET NEXT ONE-OP 61430000 MXRELCHR EQU * 61435000 BAL RET,MXCHAR GET ARG1 CHAR VLAUE 61440000 STM RB,RC,MXARG1LN SAVE LEN AND TYPE TEMP 61445000 IC RA,MCARG2DX GET ARG2 TYPE 61450000 * A 61454300 L RB,MCARG2LC GET ARG2 LOC 61455000 BAL RET,MXCHAR GET CHAR VALUE 61460000 LR RD,RB MOVE 2ND ARG LEN TO RD 61465000 LR RE,RC MOVE 2ND ARG LOC TO RE 61470000 LM RB,RC,MXARG1LN RESTORE LEN AND TYPE 61475000 CR RB,RD COMPARE LENGTHS 61485000 BNE MXRELCH2 UNEQUAL ==> COMPARE LENGHTS INSTD 61490000 LTR RB,RB ZERO LENGTH? 61495000 BZ MXRELCH2 IF YES USE LEN COMPARE 61500000 MXRELCH1 EQU * 61505000 BCTR RB,0 DECR LEN FOR EX INST 61510000 EX RB,MXCHCOMP COMPARE STRINGS 61515000 MXRELCH2 BC $,MXRLATRU A 61520000 B MXPNONJP FALL THRU MEANS FALSE 61525000 MXCHCOMP CLC 0($,RC),0(RE) DUMMY FOR CHAR COMPARE 61535000 MXRELOPS DC XL6'70B0D0408020' MASKS FOR DIFFERENT RELATIONS 61540000 EJECT 61545000 * A 61545100 * CONCATENATION PROCESSED A 61545200 MXCAT EQU * 61550000 MVI MCRSLTYP,$BSTRING SET TYPE TO CHAR 61555000 BAL RET,MXCHAR GET CHAR VALUE OF ARG1 61560000 STM RB,RC,MXARG1LN SAVE LEN & LOC TEMP 61565000 IC RA,MCARG2DX GET ARG2 INDEX 61570000 SPACE 1 A 61570100 L RB,MCARG2LC GET ARG2 LOC 61575000 BAL RET,MXCHAR GET CHAR VALUE OF ARG2 61580000 LM RD,RE,MXARG1LN GET ARGU VALUE 61585000 LR RA,RB GET LEN OF ARG2 61590000 AR RA,RD GET TOTAL LEN OF ARGS 61595000 LA R1,AVMWRK1 GET @ OF WORK AREA 61600000 S RD,AWF1 DECR LEN OF ARG1 FOR EX INST 61605000 BM MXCAT02 IF ZERO LEN, JUMP 61610000 EX RD,MXMVWRK1 MOVE ARGU TO WORKAREA 61615000 LA RD,1(RD) RESTORE ARG1 LEN 61620000 AR R1,RD BUMP WORKAREA POINTER 61625000 C RA,AWFXFF COMPARE TO MAX LENGTH 61630000 BNH MXCAT02 IF NOT HIGH, OKAY 61635000 LR RB,RA ELSE MOVE TOTAL TO RB 61640000 LA RA,255 GET MAXIMUM ALLOWED LENGTH 61645000 SR RB,RA GET ALLOWABLE REMADR IN RB 61650000 MXCAT02 EQU * 61655000 S RB,AWF1 DECR BY 1 FOR EX INST 61660000 BM MXCAT03 IF ZERO LEN ON ARG2, JUMP 61665000 LR RE,RC MOE PNTR TO FOR EX 61670000 EX RB,MXMVWRK1 ADD ARG2 TO STRING 61675000 MXCAT03 EQU * 61680000 LA RE,AVMWRK1 GET STRING @ IN RE 61685000 S RA,AWF1 DECR FOR EX INST 61690000 BM MXCAT04 IF ZERO JUMP 61695000 L R1,MXPCHRBF GET CURRENT @ OF STRING BUFFER 61700000 AR R1,RA GET FINAL @ 61705000 C R1,AVMCHLIM EXCEED BUFFER? 61710000 BH MXCAT05 IF HIGH, JUMP FOR ERROR 61715000 SR R1,RA RESTORE POINTER 61720000 EX RA,MXMVWRK1 MOVE TO BUFFER 61725000 ST R1,MCRESULT SAVE @ IN ONE-OP 61730000 MXCAT04 EQU * 61735000 LA RA,1(,RA) BUMP TO RESTORE CAT STRING LEN 61740000 STC RA,MCRESULT SAVE LEN IN ONE-OP 61745000 AR R1,RA GET FINAL DELIM @ 61750000 ST R1,MXPCHRBF STORE @ IN TABLE 61755000 B MXPNONJP GET NEXT ONE-OP 61760000 SPACE 61765000 MXMVWRK1 MVC 0($,R1),0(RE) MOVE ARG TO WORK AREA BUFFERER 61770000 SPACE 61775000 MXCAT05 EQU * 61780000 LA RB,$ER#EXBF SET EXCEEDED BUFFER FLAG 61785000 B MXPNINJE GO FLAG ERROR AND CONTINUE 61790000 EJECT 61795000 * A 61795100 * AGO AMD AIF CODE PROCESSED A 61795200 * A 61795300 MXAIF EQU * 61800000 BAL RET,MXBOOL GET BOOL VALUE 61805000 LTR RC,RC TRUE OR FLSE? 61810000 BZ MXPNINJP NO JUMP, CONTINUE SEQUENTAILLY 61815000 AIF (NOT &$MACOPC).MXINSTB SKIP IF NOT OPEN CODE S 61816000 OI AVMTAG00,AVMOPGO SHOW AIF WAS SUCCESSFUL S 61817000 .MXINSTB ANOP S 61818000 * FALL THRU, PROCESS LIKE AGO. 61820000 SPACE 61825000 MXAGO EQU * 61830000 L R1,MXPNLDBS GET SET SYMB DICT BASE(LOCAL) 61835000 L R0,0(R1) GET ACTR ALUE 61840000 BCT R0,MXAGO01 DECR COUNT 61845000 LA RB,$ER#ACTR SET ACTR ERROR FLAG IF FALL THRU 61850000 B MXINKIL1 GENERAL ERROR MSG & SET FLAG A 61855000 MXAGO01 EQU * 61860000 ST R0,0(R1) RESTORE DECREMENTED ACTR 61865000 L RW,MCARG2LC GET @ OF BRANCH INTO RW, WHERE EXPCT 61870000 B MXPNINJQ GO TO HAVE BRANCH DONE 61875000 SPACE 61880000 MXSETA EQU * 61885000 MXSETB EQU * 61890000 MXSETC EQU * 61895000 BAL RET,MXADDR GET @ OF TARGET 61900000 ST RC,MXARG1 SAVE TEMP 61905000 IC RA,MCARG2DX GET ARG2 INDEX 61910000 L RB,MCARG2LC GET 2ND RG LOC 61915000 CLI MCBOPRTR,$BSETB ARITH, BOOL OR CHAR? 61920000 BH MXSETC01 CHAR IF HIGH 61925000 BE MXSETB01 BOOL IF EQUAL 61930000 BAL RET,MXARITH ARITH IF FALL THRU 61935000 B MXSETB02 USE BOOL CODE TO STORE 61940000 SPACE 1 61945000 MXSETB01 EQU * 61950000 BAL RET,MXBOOL GET BOOL VALUE 61955000 MXSETB02 EQU * 61960000 L R1,MXARG1 GET TARGET @ 61965000 ST RC,0(R1) STORE RESULT 61970000 B MXPNINJP GET NEXT INST 61975000 SPACE 1 61980000 MXSETC01 EQU * 61985000 BAL RET,MXCHAR GET CHAR VALUE 61990000 L R1,MXARG1 GET TARGET @ 61995000 *************** POSSIBLE CHANGE WITH ASM H OR VS *********************S 61995100 C RB,=F'8' LEN > 8 62000000 BNH MXSETC02 PROCEED IF NOT 62005000 LA RB,8 ELSE SET LEN TO MAX 62010000 MXSETC02 EQU * 62015000 ST RB,0(R1) SAVE LENGTH 62020000 S RB,AWF1 DECR FOR EX 62025000 BM MXPNINJP IF ZERO, GET NEXT INST 62030000 EX RB,MXPMVSET MOVE STRING TO SET SYMBOL 62035000 B MXPNINJP GET NEXT INST 62040000 SPACE 62045000 MXPMVSET MVC 4($,R1),0(RC) DUMMY TO MOVE STRING 62050000 EJECT 62055000 * NEXT SECTION HANDLES SUBSCRIPTED SET SYMBOLS AND SYMBOLIC PRAMS 62060000 SPACE 62065000 MXSBSCRP EQU * 62070000 CLI MCARG1DX,$BSYMPAR SYMPAR, K' OR T'? 62075000 BNL MXSCRP01 JUMP AND PROCESS IF YES 62080000 BAL RET,MXADDR ELSE GET @ OF SET SYMBOL 62085000 LA R1,$BSATT GET $BSADDRA-2 62090000 SRL RE,1 DIVIDE $ARITH, ETC TO GET 2, 4 OR 6 62095000 AR R1,RE GET $BSADDRA, B ORC 62100000 STC R1,MCRSLTYP SAVE TYPE IN ONE-OP 62105000 ALR RE,RE RESTORE TYPE(4,8,12) 62110000 STM RC,RE,MXARG1LN SAVE @, LEN AND TYPE TEMP 62115000 MXSCRP01 EQU * 62120000 IC RA,MCARG2DX GET ARG2 INDEX 62125000 L RB,MCARG2LC GET ARG2 LOC 62130000 BAL RET,MXARITH GET ARITH VALUE 62135000 LTR RC,RC TEST VALUE OF INDEX 62140000 BP MXSCRP02 PROCEED IF > 0 62145000 MXSCRPDR EQU * 62150000 LA RB,$ER#DMER ELSE SET DIMENON ERROR FLAG 62155000 B MXPNINJE GO FLAG ERROR AND CONTINUE 62160000 MXSCRP02 EQU * 62165000 CLI MCARG1DX,$BSYMPAR SYM PAR, K' OR T'? 62170000 BNL MXSBSCSP JUMP IF YES 62175000 C RC,MXARG1 COMPARE WITH SET SYMB DIM 62180000 BH MXSCRPDR ERROR IF HIGH 62185000 BCTR RC,0 DECR TO GET OFFSET 62190000 CLI MCRSLTYP,$BSADDRB BOOL TYPE? 62195000 BNE MXSCRP03 SKIP IF NOT 62200000 MVI MXARG2+3,4 ELSE SET LEN TO 4 62205000 MXSCRP03 EQU * 62210000 MH RC,MXARG2+2 MULT TO GET OFFSET 62215000 A RC,MXARG1LN ADD BASE @ 62220000 ST RC,MCRESULT PUT RESULT IN ONE-OP 62225000 B MXPNONJP GET NEXT ONE-OP 62230000 SPACE 62235000 MXSBSCSP EQU * PROCESS SYMBOLIC PARAMETER SUBSCRIPT 62240000 MVI MCRSLTYP,$BSTRING SET TO CHAR FOR OPERNERS 62245000 MVC MCRESULT,AWZEROS INIT REULST TO ZERO 62250000 LA R1,$LMPAROP GET LEN OF SYM PAR DICT ENTRY 62255000 MH R1,MCARG1LC+2 MULST BY SYM PAR SUBSCRIPT 62260000 A R1,MXPNLSPT ADD SYM PAR BASE @ OF DICT 62265000 USING MCPAROPR,R1 SET USING FOR DICT ENTRY 62270000 SR RB,RB CLEAR RB FOROPRND COUNT 62275000 IC RB,MCPARONB GET NBR OF SUBOPRNDS 62280000 CR RB,RC COMPARE WITH SUBSCRIPT 62285000 BNL MXSCSP03 PROCEED IF WITHIN RANGE 62290000 MXSCSP00 EQU * 62295000 CLI MCARG1DX,$BSATK K' ATRIB? 62300000 BE MXSCSP01 K' IF EQUAL 62305000 BH MXSCSP02 T' IF HIGH 62310000 C RC,AWF1 1ST SUBSCRIPT WANTED? 62315000 BNE MXPNONJP FINI IF NOT 62320000 MVC MCRESULT+1(3),MCPAROPT+1 ELSE IS SYMPAR, COPY RESUL 62325000 MVC MCRESULT(1),MCPAROLN 62330000 B MXPNONJP SYM PAR IF FALL THRU, DEFAULT VALUE 62335000 MXSCSP01 EQU * PROCESS K' OUT OF RANGE 62340000 MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 62345000 C RC,AWF1 1ST SUBSCRIPT WANTED? 62350000 BNE MXPNONJP FINI IF NOT 62355000 MVC MCRESULT+3(1),MCPAROLN MOVE K' OF MAIN OPRND TO RESULT 62360000 B MXPNONJP AND GET NEXT ONE-OP 62365000 MXSCSP02 EQU * PROCESS T' OUT OF RANGE 62370000 C RC,AWF1 1ST SUBSCRIPT WANTED? 62375000 BNE MXSCSP21 USE NULL TYPE IF NOT 62380000 LA RA,MCPAROTP ELSE POINT AT OPRND TYPE 62385000 B MXSCSP22 62390000 MXSCSP21 EQU * 62395000 LA RA,=C'O' POINT AT NULL TYPE 62400000 MXSCSP22 EQU * 62405000 ST RA,MCRESULT STORE IN ONE-OP 62410000 MVI MCRESULT,1 ST LENGTH TO 1 62415000 B MXPNONJP GET NEXT ONE-OP 62420000 MXSCSP03 EQU * PRROCESS SUBSCRIPTS IN RANG 62425000 L R2,MCPRSBPT GET POINTER TO SUBLIST ENTRIES 62430000 LTR R2,R2 SUBLIST EXISTS? 62435000 BZ MXSCSP00 PROCESS AS OUT OF RANGE IF NOT 62440000 BCTR RC,0 DECR INDEX 62445000 SLL RC,3 MULT BY 8 TO GET OFFSET 62450000 AR R2,RC POINT TO SUBENTRY 62455000 USING MCPARSUB,R2 SET USING ON SUB ENTRY 62460000 CLI MCARG1DX,$BSATK K' ATTRIB? 62465000 BE MXSCSP04 YES IF EQUAL 62470000 BH MXSCSP05 T' IF HIGH 62475000 MVC MCRESULT+1(3),MCPARSPT+1 ELSE IS SYMPAR, COPY POINT 62480000 MVC MCRESULT(1),MCPARSLN GET LEN OF STRING 62485000 B MXPNONJP AND GET NEXT ONE-OP 62490000 MXSCSP04 EQU * PROCESS K' IN RANGE 62495000 MVC MCRESULT+3(1),MCPARSLN MOVE K' TO RESULT 62500000 MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 62505000 B MXPNONJP GET NEXT ONE-OP 62510000 MXSCSP05 EQU * PROCESS T' IN RANGE 62515000 LA RB,MCPARSTP GET @ OF TYPE 62520000 ST RB,MCRESULT PLACE IN RESULT 62525000 MVI MCRESULT,1 SET LEN TO 1 62530000 B MXPNONJP GET NEXT ONE-OP 62535000 DROP R1,R2 DROP USING ON MCPAROPR,MCPARSUB 62540000 SPACE 62545000 EJECT 62550000 * NEXT SECTION PROCESSES SUBSTRING ACTION 62555000 SPACE 62560000 MXSBST EQU * 62565000 MVI MCRSLTYP,$BSTRING INIT TYPE TO STRING 62570000 MVC MCRESULT,AWZEROS INIT LEN TO ZERO 62575000 BAL RET,MXARITH GET 1ST ARG VALUE 62580000 LTR RC,RC WAS 1ST EXP <= 0 62585000 BNP MXSBSTER ERROR IF INDEX <=0 62590000 ST RC,MXARG1 SAVE VALUE TEMP 62595000 IC RA,MCARG2DX GET ARG2 INDEX 62600000 L RB,MCARG2LC GET ARG2 LOC 62605000 BAL RET,MXARITH GET ARITH VALUE 62610000 LTR RC,RC WAS VALUE <= 0 62615000 BNP MXSBSTER ERROR IF SO 62620000 * **NOTE** MAY CHANGE THIS FOR G-LEVEL COMPATIBLE CODE 62625000 C RC,=F'8' LEN > 8? 62630000 BH MXSBSTER ERROR IF YES 62635000 ST RC,MXARG2 SAVE ARG2 TEMP 62640000 IC RA,MCARG1DX+$LMCQUAD GET TYPE OF OPRND 62645000 L RB,MCARG1LC+$LMCQUAD GET LOC OF OPERAND 62650000 BAL RET,MXCHAR CONVERT TO CHAR 62655000 C RB,MXARG1 LEN < STARTING CHAR? 62660000 BNL MXSBST01 OKAY IF NO LOW 62665000 L RC,MXARG1 ELSE PUT BAD VALUE IN RC 62670000 B MXSBSTER AND JUMP TO FLAG ERROR 62675000 MXSBST01 EQU * 62680000 LM RD,RE,MXARG1 GET START NBR AND LEN 62685000 AR RD,RC GET NEW START @ + 1 62690000 BCTR RD,0 DECR @ 62695000 ST RD,MCRESULT SAVE START @ OF SUBSTING 62700000 AR RC,RB GET PNTR TO END OF STRING + 1 62705000 AR RD,RE GET PNTR TO SUBSTR END PLUS 1 62710000 CR RC,RD SUBSTRING OKAY? 62715000 BNL MXSBST03 JUMP IF OKAY 62720000 S RC,MCRESULT ELSE GET LEN OF RMNDR OF STRING 62725000 STC RC,MCRESULT SAVE LEN OF SUBST 62730000 B MXSBSTFT JUMP TO FOOT 62735000 MXSBST03 EQU * 62740000 S RD,MCRESULT GET LENGTH OF SUBSTR 62745000 STC RD,MCRESULT SVE LEN OF SUBSTR IN ONE-OP 62750000 MXSBSTFT EQU * 62755000 LA RW,$LMCQUAD(RW) BUMP PNTR PAST DUMMY ONE-OP 62760000 B MXPNONJP GET NEXT ONE-OP 62765000 SPACE 1 62770000 MXSBSTER EQU * 62775000 LA RB,$ER#SBST SET SUBSTR ERROR FLAG 62780000 B MXPNINJE GO FLAG ERROR AND CONTINUE 62785000 EJECT 62790000 * NEXT SECTION PROCESSES SYSLIST SUBSCRIPTED VARIABLE 62795000 SPACE 62800000 MXSYSL EQU * 62805000 MVI MCRSLTYP,$BSTRING INIT TO CHAR TYPE 62810000 MVC MCRESULT,AWZEROS INIST RESULT TO ZERO 62815000 CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBSCRIPT? 62820000 BNE MXSYSL01 SINGLE ONE-OP IF NOT 62825000 BAL RET,MXARITH ELSE GET VALUE OF 1ST SUBSCRIPT 62830000 ST RC,MXARG1 STORE TEMP 62835000 MXSYSL01 EQU * 62840000 IC RA,MCARG2DX GET 2ND ARG 62845000 L RB,MCARG2LC GET LOC 62850000 BAL RET,MXARITH CONVERT TO ARITH 62855000 ST RC,MXARG2 SAVE TEMP(1ST SUB OF SINGLE) 62860000 CLI MCBOPRTR+$LMCQUAD,X'00' 2 OPRNDS 62865000 BNE MXSYSL02 JUMP IF NOT 62870000 L RC,MXARG1 ELSE RESTORE 1ST ARG VALUE A 62875000 MXSYSL02 EQU * 62880000 LTR RC,RC VALUE > 0 62885000 BNL MXSYSL03 IF >= 0, OKAY 62890000 MXSYSLR1 EQU * 62895000 LA RB,$ER#SYSL SET SYSLIST DIM ERROR 62900000 B MXPNINJE GO FLAG ERROR AND CONTINUE 62905000 MXSYSL03 EQU * 62910000 C RC,MXPNBOPS COMPARE WITH NBR OF POSIT OPRNDS 62915000 BH MXSYSLHI JUMP IF HIGH 62920000 * PROCESS &SYSLIST(A), N', K', T' WITHIN RANGE 62925000 LA RB,$LMPAROP GET LEN OF SY PAR DICT ENTRY 62930000 MR RB,RB MULT BY SUBSCRIPT TO GET OFFSET 62935000 A RC,MXPNLSPT ADD BASE @ OF SYM PAR DICT 62940000 USING MCPAROPR,RC SET USING FOR DICT ENTRY 62945000 CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBSCRIPT? 62950000 BE MXSYLDBL PROCESS IF YES 62955000 CLI MCARG1DX,$BSYSLST &SYSLIST? 62960000 BNE MXSYSL04 IF NOT MUST BE ATTRIB 62965000 MVC MCRESULT+1(3),MCPAROPT+1 MOVE OPRND PNTR TO ONE-OP 62970000 MVC MCRESULT(1),MCPAROLN MOVE LENGTH OF OPNRD TO ONE-OP 62975000 B MXPNONJP GET NEXT OPCODE 62980000 MXSYSL04 EQU * 62985000 SR R1,R1 62990000 CLI MCARG1DX,$BSATN WHICH ATTRIB? 62995000 BH MXSYSLTP T' IF HIGH 63000000 BE MXSYSLNP N' IF EQUAL 63005000 MVC MCRESULT+3(1),MCPAROLN K' IF FALL THRU 63010000 MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63015000 B MXPNONJP GET NEXT ONE-OP 63020000 MXSYSLNP EQU * 63025000 MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63030000 MVC MCRESULT+3(1),MCPARONB GET NBR OF SUB OPRNDS 63035000 CLI MCPARONB,X'00' ZERO SUBOPRNDS? 63040000 BNE MXPNONJP IF > 0, GET NEXT ONE-OP 63045000 CLI MCPAROTP,C'O' NULL OPRND? 63050000 BE MXPNONJP IF YES, GET NEXT ONE-OP 63055000 MVI MCRESULT+3,1 ELSE SET NBR TO 1 63060000 B MXPNONJP AND GET NEXT ONE-OP 63065000 MXSYSLTP EQU * PROCESS T' IN RANGE 63070000 LA R1,MCPAROTP GET @ OF TYPE 63075000 ST R1,MCRESULT STORE RESULT IN ONE-OP 63080000 MVI MCRESULT,1 SET LEN=1 63085000 B MXPNONJP GET NEXT ONE-OP 63090000 MXSYLDBL EQU * PROCESS DOUBLE SUBSCRIPTE 63095000 L R1,MXARG2 GET 2ND VALUE 63100000 LTR R1,R1 POSITIVE? 63105000 BH MXSYLDB1 OKAY IF YES 63110000 LR RC,R1 ELSE MOVE BAD VALUE TO RC 63115000 LA RW,$LMCQUAD(RW) BUMP ONE-OP PNTR PAST DUMMY 63120000 B MXSYSLR1 JUMP TO FLAG ERROR 63125000 MXSYLDB1 EQU * 63130000 SR RE,RE 63135000 IC RE,MCPARONB GET SUBOPRND COUNT 63140000 CR R1,RE SUBS > NBR SUBOPRNDS? 63145000 BNH MXSYLDB2 PROCEED IFLOW 63150000 CLI MCARG1DX+$LMCQUAD,$BSYSLST $BSYSLIST? 63155000 BE MXSYSDFT JUMP TO FOOT IF YES 63160000 MVI MCRSLTYP,$BSIMMA SET TYPE = ARITH 63165000 CLI MCARG1DX+$LMCQUAD,$BSATK K'&SYSLIST? 63170000 BE MXSYSDFT FINI IF YES 63175000 MVI MCRSLTYP,$BSTRING ELSE SET TYPE TO CHAR 63180000 LA R1,=C'O' ELSE GET @ OF NULL TYPE 63185000 B MXSYLDB5 SKIP TO SAVE @, SET LEN=1 63190000 MXSYLDB2 EQU * PROCESS &SYSLIST(A,B) IN RANGE 63195000 L RC,MCPRSBPT GET @ OF SUBOPRNDS 63200000 USING MCPARSUB,RC SET USING FOR SUB E TRY 63205000 BCTR R1,0 DECR INDEX FOR MULT 63210000 SLL R1,3 MULT BY 8 FOR OFFSET 63215000 AR RC,R1 MOVE BASE TO RIGHT ENTRY 63220000 CLI MCARG1DX+$LMCQUAD,$BSYSLST &SYSLIST? 63225000 BNE MXSYSDB3 IF NOT, PROCESS T' OR K' 63230000 MVC MCRESULT,MCPARSPT ELSE MOVE @ OF SUBOPRND TO ONE-OP 63235000 MVC MCRESULT(1),MCPARSLN MOVE LEN TO ONE-OP 63240000 B MXSYSDFT JUMP TO FOOT 63245000 MXSYSDB3 EQU * PROCESS K'&SYSLIST OR T'&SYSLIST 63250000 CLI MCARG1DX+$LMCQUAD,$BSATT T'&SYSLIST? 63255000 BE MXSYLDB4 JUMP IF YES 63260000 MVC MCRESULT+3(1),MCPARSLN ELSE MUST BE K'&SYSLIST 63265000 MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63270000 B MXSYSDFT JUMP TO FOOT 63275000 MXSYLDB4 EQU * 63280000 LA R1,MCPARSTP GET @ OF TYPE 63285000 MXSYLDB5 ST R1,MCRESULT STORE IN ONE-OP 63290000 MVI MCRESULT,1 SET LEN TO 1 63295000 * FALL THRU INTO MXSYSDFT 63300000 MXSYSDFT EQU * 63305000 LA RW,$LMCQUAD(RW) BUMP PNTR PAST DUMMT ONE-OP 63310000 B MXPNONJP GET NEXT ONE-OP 63315000 DROP RC 63320000 SPACE 63325000 * PROCESS &SYSLIST(A), T' OR K' WHERE A > NBR OPRNDS 63330000 SPACE 63335000 MXSYSLHI EQU * 63340000 CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBS? 63345000 BE MXSYSLHD PROCESS IF YES 63350000 CLI MCARG1DX,$BSYSLST $&SYSLIST? 63355000 BE MXPNONJP GET NEXT ONE OP IF YES 63360000 CLI MCARG1DX,$BSATN N'? 63365000 BNH MXSYSLHK K' OR N' IF LOW OR EQUAL 63370000 B MXSYSLHT T' IF HIGH 63375000 MXSYSLHD EQU * PROCESS DUBLE SUBSCRIPT 63380000 CLI MCARG1DX+$LMCQUAD,$BSYSLST &SYSLIST? 63385000 BE MXSYSDFT FINI IF YES 63390000 CLI MCARG1DX+$LMCQUAD,$BSATN N'? 63395000 BH MXSYSLHT ELSE IS T'&SYSLIST 63400000 * FALL THRU ==> K', IF LOW 63405000 MXSYSLHK EQU * 63410000 MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63415000 MXSYSTSD EQU * 63420000 CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBS? 63425000 BE MXSYSDFT FINI IF YES, JUMP TO DOUBLE FOOT 63430000 B MXPNONJP ELSE GET NEXT ONE-OP 63435000 MXSYSLHT EQU * 63440000 LA R1,=C'O' GET @ OF NULL TYPE 63445000 ST R1,MCRESULT STORE @ IN ONE-OP 63450000 MVI MCRESULT,1 SET LEN TO 1 63455000 B MXSYSTSD TEST FOR DOUBLE SUBS 63460000 EJECT 63465000 * SECTION TO ADD CHARS TO OUTPUT A 63465100 * A 63465200 MXPRNT EQU * 63470000 USING RSBLOCK,RY NOTE USING ON SOURCE 63475000 L RY,AVRSBPT SET BASE ON SOURCE 63480000 BAL RET,MXCHAR CONVERT ARG TO STRING 63485000 LA RA,RSBSOURC SET SCAN POINTER 63490000 LA RE,$LMSRCMX(RA) SET UPPER LIMIT POINTER 63495000 A RA,MCARG2LC ADD OFFSET 63500000 CLI RSBLENG,X'00' 1ST MOVE? 63505000 BE MXPRNT01 63510000 SR R1,R1 63515000 IC R1,RSBLENG GET PREV LEN-1 63520000 LA R1,RSB$L+1(R1,RY) POINT TO AVAILABLE BYTE 63525000 CR RA,R1 COMPARE WITH TARGET 63530000 * FOLLOWING CHECKS SPECIAL CASE OF OPRND MEETING COMMENT A 63535000 BH MXPRNT01 OKAY IF NEXT PTR > OLD END A 63540000 BL MXPRNT00 IF LOW, MUST INCREM BEYOND ANYWAY A 63545000 TM MCBOPRTR,$MPRCOM IF EQUAL, CHECK FOR SPECIAL COMPR A 63550000 BZ MXPRNT01 NOT COMMENT,CONCAT IF COM,MOVE OVERA 63555000 MXPRNT00 LA RA,1(,R1) SKIP BLANK B A 63560000 MXPRNT01 EQU * 63565000 S RB,AWF1 DECR RB 63570000 BM MXPNONJP IF NULL, GET NEXT ONE-OP 63575000 LA R2,0(RA,RB) POINT TO FINAL BYTE 63580000 CR R2,RE EXCEED LIMIT? 63585000 BNH MXPRNT02 PROCEED IF OKAY 63590000 LA RB,$ERMEXST ELSE SET ERROR FLAG 63595000 $CALL ERRTAG FLAG STMT 63600000 B MXPNONJP GET NEXT ONE-OP 63605000 MXPRNT02 EQU * 63610000 EX RB,MXPMVSRC MOVE STRING TO SOURCE BLOCK 63615000 LA RA,RSBSOURC GET START @ 63620000 SR R2,RA GET LEN-1 IN R2 63625000 STC R2,RSBLENG STORE LEN-1 63630000 B MXPNONJP GET NEXT ONE-OP 63635000 MXPMVSRC MVC 0($,RA),0(RC) DUMMY TO MOVE STRING 63640000 DROP RY 63645000 EJECT 63650000 SPACE 2 63655000 * INNER MACRO CALL A 63655100 * A 63655200 MXINMAC EQU * 63660000 USING RSBLOCK,RY NOTE USING 63665000 L RY,AVRSBPT SET BASE 63670000 SR R1,R1 USE R1 FOR LENGTH 63675000 IC R1,RSBLENG GET LENGTH IN R1 63680000 LA R1,RSB$L+1(RY,R1) POINT TO NEXT AVAILABLE BYTE 63685000 MVC 0(4,R1),=C' '' ' MOVE END OF RECORD INDICATROR 63690000 LA R1,1(R1) BUMP R1 63695000 ST R1,AVSOLAST SAVE END OF RECORD @ 63700000 MVI RSBNUM,1 SET NBR CARDS TO 1 63705000 LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 63710000 CR R1,RB COMPARE WITH AVSOLAST 63715000 BL MXINMAC1 AVSOLAST LOW, ONE CARD 63720000 MVI RSBNUM,2 SET COUNT TO 2 CARDS 63725000 LA RB,RSOLC(RB) BUMP RB TO 1ST BYTE, 3RD CARD 63730000 CR R1,RB COMPARE WITH AVSOLAST 63735000 BL MXINMAC1 IF LOW, 2 CARDS 63740000 MVI RSBNUM,3 ELSE IS 3 CARDS 63745000 MXINMAC1 EQU * 63750000 OI RSBFLAG,$RSBGENR+$RSBNPNN SET GEN & NO ACTION FLAGS 63755000 TM RSBFLAG,$REBX ERROR BLOCK EXISTS? 63760000 BNO MXINCALL A 63765000 SPACE 4 63795000 MXMVSTMT EQU * 63800000 USING RSBLOCK,RY 63805000 L RY,AVRSBPT SET BASE 63810000 OI RSBFLAG,$RSBGENR SET GEN FLAG 63815000 TM MCBOPRTR,$BSMNTER MNOTE ERROR? 63820000 BNO MXMVSTMU SKIP IF NOT 63825000 OI RSBFLAG,$RSBMERR SET ERROR FLAG 63830000 MXMVSTMU EQU * 63835000 $CALL MXMVSR MOVE SOURCE TO HIGH 63840000 LTR RB,RB OVERFLOW? 63845000 BNZ MXEXECOV FLAG IF YES 63850000 B MXPNINJP GET NEXT INST 63855000 MXERRMS EQU * 63865000 LA RB,$ER#PRVR SHOW PREVIOUS ERROR S 63870000 DROP RY S 63871100 BAL R1,MXINERRM CALL ERROR FLAG ROUTINE S 63875000 B MXPNINJP ELSE GET NEXT INST 63925000 SPACE 63935000 MXANOP EQU MXPNINJP NO CODE NEEDED, GO FOR NEXT 63940000 MXFIN EQU MXPNINJP NO CODE NEEDED, GO FOR NEXT 63945000 EJECT S 63950000 * *** ERROR EXITS: TERMINATE PROCESSING ***** 63955000 MXINV EQU * 63960000 LA RB,$ER#SYER SET SYSTEM ERR FLAG 63965000 B MXMENDEC STOP PROCESSING AND RETURN 63970000 MXMENDER LA RB,$ER#MXST SET EXCEED STMTS FLAG 63975000 MXMENDEC EQU * CALL MXERRM AND QUIT-TYPE EXIT LABEL 63980000 BAL R1,MXINERRM GENERATE ERROR MESSAGE A 63985000 MXENDEF LA RB,12 RB SET TO KILL MACROS A 63990000 B MXINRTN RETURN A 63990100 * FALL THRU, HANDLE AS MEND OR MEXIT. 63995000 SPACE 64000000 MXMEND EQU * 64005000 MXMEXIT EQU * 64010000 SR RB,RB RB SET FOR MEND OR MEXIT S 64015000 MXINRTN EQU * A 64015100 L R1,AVMXSPIE RELOAD R1 FROM SPIE PTR A 64015110 LM RC,RD,AVGEN1CD A 64015151 XSNAP LABEL='AT MXINST RET',STORAGE=(*0(RD),*0(RC),*AVADDLOW,*X64015152 AVWXEND),IF=(AVTAGSM,O,AJOMACRH,TM) 64015153 $SPIE ,,,ACTION=(RS,(1)) A 64020000 $RETURN RGS=(R14-R6) A 64125000 SPACE 64140000 MXARG1LN DS F TEMP STORAGE FOR ARG1 LENGTH 64145000 MXARG1 DS F TEMP STORAGE FOR ARG1 64150000 MXARG2 DS F TEMP STORAGE FOR ARG2 64155000 * S 64170005 * SET RB TO RETURN CONDITION S 64170010 * S 64170020 MXINKIL1 EQU * S 64170030 BAL R1,MXINERRM CALL ERR MSG ROUTINE S 64170040 LA RB,8 SET KILL MACRO NEST FLAG S 64170050 B MXINRTN NORMAL RETURN S 64170060 MXINCALL EQU * A 64170070 LA RB,4 SET RETURN CODE A 64170080 B MXINRTN RETURN A 64170090 LTORG S 64170092 DS 0H FORCE ALIGNMENT S 64170093 EJECT A 64170095 **--> INSUB: MXINERRM CALLS MXERRM TO HANDLE ERROR MESSAGES + +S 64170100 *+ +S 64170200 *+ ENTRY CONDITIONS: +S 64170300 *+ RB = ERROR CODE +S 64170400 *+ RC = VALUE IF ANY +S 64170500 *+ RD = LENGTH +S 64170600 *+ R1 = LINK REG +S 64170700 *+ +S 64170800 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 64170900 SPACE 2 S 64170950 MXINERRM EQU * S 64171000 LR RE,RZ COPY @ OF MXPNTSAV A 64171050 $CALL MXERRM CALL ERROR ROUTINE S 64171100 LTR RB,RB TEST RB FOR OVERFLOW S 64171200 BCR Z,R1 RETURN ON NOT OVERFLOW S 64171300 * SET RB TO OVERFLOW VALUE AND RETURN S 64171400 MXEXECOV EQU * S 64171500 LA RB,16 SET OVERFLOW FLAG S 64171600 B MXINRTN NORMAL RETURN S 64171700 SPACE 5 S 64171800 **--> INSUB: MXARITH MXARITH PRODUCES ARITH ONE-OP A 64175000 *+ MXBOOL PRODUCES BOOLEAN ONE-OP A 64175100 *+ MXCHAR PRODUCES CHAR ONE-OP A 64175200 * TYPE. * 64180000 * * 64185000 * ENTRY CONDITIONS * 64190000 * RA = TYPE OF OPRND * 64195000 * RB = @ OF OPRND (OR VALUE IF IMMEDIATE TYPE) * 64200000 * * 64205000 * EXIT CONDITIONS * 64210000 *+ RA=BYTE REG A 64210100 *+ R1=WIPED OUT A 64210200 *+ RE=WIPED OUT A 64210300 * RB = LENGTH OF CHAR STRING IF CHAR VALUE * 64215000 * RC = VALUE IF ARITH OR BOOL, @ OF STRING IF CHAR * 64220000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 64225000 SPACE 64230000 MXARITH DS 0F 64235000 OI AVMBYTE2,$MINARIT SET ARITH FLAG 64240000 B MXSCCV 64245000 MXBOOL EQU * 64250000 OI AVMBYTE2,$MINBOOL SET BOOL REQ'D FLAG 64255000 B MXSCCV 64260000 MXCHAR EQU * 64265000 OI AVMBYTE2,$MINCHAR SET CHAR REQ'D FLAG 64270000 MXCONVBS DS 0H BASE FOR JUMP TABLE 64280000 MXSCCV EQU * 64285000 ST RET,MXSCCVSV SAVE RETURN @ 64290000 SPACE 64295000 MXCONJMP EQU * 64300000 N RA,AWFXFF MASK OUT ALL EXCEPT INDEX 64305000 LH R1,MXCONNDX(RA) GET OFFSET OF ROUTINE 64310000 XSNAP LABEL='***MXARITH ENTERED***', X64320000 IF=(AVMSNBY2,O,$MSNP12,TM) 64325000 B MXCONVBS(R1) JUMP TO ROUTINE 64330000 SPACE 64335000 MXCONNDX $AL2 MXCONVBS,(MXCNGLA,MXCNGLB,MXCNGLC,MXCNLCA,MXCNLCB,MXCNLC#64340000 C,MXCNSYPR,MXCNIMMA,MXCNIMMB,MXCNIMMC,MXCNSYSX,MXCNUND,M#64345000 XCNCSCT,MXCNUND,MXCNTEMP,MXCNUND,MXCNUND,MXCNATTK, #64350000 MXCNUND,MXCNATTN,MXCNUND,MXCNATTT,MXCNADDA,MXCNADDB, #64355000 MXCNADDC),-2 64360000 SPACE 64365000 * PROCESS GLOBALS A 64365100 * A 64365200 USING MCGLBDCT,RB NOTE USING FOR GLOBAL SET SYMB DV 64370000 MXCNGLA EQU * 64375000 L RC,MCGBAVAL GET ARITH VALUE 64385000 B MXCONV0A 64390000 SPACE 64395000 MXCNGLB EQU * 64400000 L RC,MCGBAVAL GET BOOL VALUE 64410000 B MXCONV0B 64415000 MXCNGLC EQU * 64420000 LA RC,MCGBCVAL GET @ OF CHAR VALUE 64430000 L RB,MCGBCLEN GET LENGTH OFSTRING 64435000 B MXCONV0C 64440000 EJECT 64445000 MXCNLCA EQU * 64450000 MXCNLCB EQU * 64455000 MXCNLCC EQU * 64460000 L RC,MGLCLPNT GET OFFSET 64470000 A RC,MXPNLDBS ADD BASE @ OF LOCAL SET SYM DICT 64475000 CLI MCGLBTYP,$BOOL WHAT TYPE A 64480000 BH MXCNLCA1 CHAR IF HIGH 64485000 L RC,0(RC) ELSE GET ARITH OR BOOL VALUE 64490000 BL MXCONV0A ARITH IF LOW 64495000 B MXCONV0B ELSE IS BOOL 64500000 MXCNLCA1 EQU * 64505000 L RB,0(RC) GET LEN OF CHAR 64510000 LA RC,4(RC) BUMP POINTER TO STRING 64515000 B MXCONV0C 64520000 DROP RB DROP USING ON SET SYMB DV 64525000 SPACE 64530000 MXCNSYPR EQU * 64535000 USING MCPAROPR,RE NOTE USING ON SYM PAR DICT ENTRY 64540000 LA RE,$LMPAROP GET LEN OF ENTRY 64550000 MR RD,RB CALCULATE OFFSET 64555000 A RE,MXPNLSPT ADD SYM PAR DICT BASE 64560000 L RC,MCPAROPT GET POINTER TO STRING 64565000 IC RB,MCPAROLN GET LEN OF STRING 64570000 TM AVMBYTE2,$MINCHAR+$MINBOOL A 64575000 BNZ MXCONV0C S 64580000 CLI MCPAROTP,C'N' FALL THRU MEANS ARITH REQ'D 64595000 BE MXCNSYP1 IF SELF DEF TERM, OK 64600000 MXCNSYER EQU * 64605000 LR RD,RB ELSE MOVE LEN TO RD 64610000 LA RB,$ER#CVCA SET CONVERSION ERROR 64615000 B MXPNINJE GO FLAG ERROR AND CONTINUE 64620000 MXCNSYP1 EQU * 64625000 LR RA,RC MOVE POINTER TO RA 64630000 $CALL SDBCDX CHECK FOR SELF DEF TERM 64635000 LTR RB,RB OKAY? 64640000 BZ MXCONRTN RETURN IF YES 64645000 SR RB,RB ELSE CLEAR RB 64650000 IC RB,MCPAROLN INSERT STRING LENGTH 64655000 L RC,MCPAROPT POINT TO STRING 64660000 B MXCNSYER AND FLAG ERROR 64665000 SPACE 64670000 MXCNIMMA EQU * 64675000 LR RC,RB MOVE VALUE TO RC 64685000 B MXCONV0A CONVERT IF NECESSARY 64690000 MXCNIMMB EQU * 64695000 LR RC,RB MOVE IMM VALUE TO RC 64705000 B MXCONV0B CONVERT IF NECESSARY 64710000 MXCNIMMC EQU * 64715000 SRDL RB,24 MOVE @ TO RC, LEAVE LEN IN RB 64725000 SRL RC,8 FINISH SHIFT IN RC 64730000 B MXCONV0C CONVERT IF NECESSARY 64735000 * A 64735100 * PROCESS SYSNDX A 64735200 MXCNSYSX EQU * GET SYSYNX VALUE 64740000 TM AVMBYTE2,$MINCHAR CHAR REQ'D? 64745000 BO MXCNSX01 PROCESS CHAR IF YES 64750000 ZAP AVDWORK1,MXPSYSDX MOVE SYSNDX TO DOUBLE WORD 64755000 CVB RC,AVDWORK1 CONVERT TO BINARY 64760000 TM AVMBYTE2,$MINBOOL BOOL REQ'D? 64765000 BNO MXCONRTN RETURN IF NOT 64770000 MXCNSX03 EQU * 64775000 LA RB,$ER#CVAB SET ARITH - BOOL ERROR 64780000 B MXCONVAR A 64785000 EJECT 64790000 * A 64790100 * CONVERT SYSNDX TO CHAR A 64790200 * A 64790300 MXCNSX01 EQU * 64795000 L RE,MXPCHRBF GET POINTER TO WORK AREA 64800000 LA RE,4(RE) BUMP TO TEST END 64805000 C RE,AVMCHLIM TEST AGAINST LIMIT 64810000 BNH MXCNSX02 PROCEED IF OKAY 64815000 LA RB,$ER#EXBF SET ERROR FLAG 64820000 B MXPNINJE GO FLAG ERROR AND CONTINUE 64825000 MXCNSX02 EQU * 64830000 LA RB,4 PUT USEFUL VALUE IN RB 64835000 SR RE,RB RESTORE THE POINTER 64840000 UNPK 0(4,RE),MXPSYSDX UNPACK &SYSNDX 64845000 OI 3(RE),X'F0' CHANGE LAST ZONE TO F 64850000 LR RC,RE POINT RC AT STRING 64855000 AR RE,RB BUMP RE TO END OF BUFFER 64860000 ST RE,MXPCHRBF RESOTRE BUFFER POINTER 64865000 B MXCONRTN AND RETURN 64870000 SPACE 64875000 MXCNCSCT EQU * 64880000 LA RC,AVSYSECT GET @ OF CSECT NAME 64885000 TRT 0(9,RC),AWTSYMT SCAN NAME FOR LENGTH 64890000 SR R1,RC GET LENGTH 64895000 LR RB,R1 MOVE LENGTH TO RB 64900000 TM AVMBYTE2,$MINCHAR CHAR REQ'D? 64905000 BO MXCONRTN RETURN IF YES 64910000 B MXCONCAR A 64915000 SPACE 64930000 MXCNTEMP EQU * 64935000 USING MCOPQUAD,RB SET USING ON ONE-OP 64940000 IC RA,MCRSLTYP GET INDEX 64945000 L RB,MCRESULT GET LOCATION 64950000 B MXCONJMP EVALUATE 64955000 DROP RB 64960000 EJECT 64965000 MXCNATTK EQU * 64970000 MXCNATTN EQU * 64975000 LTR RB,RB &SYSLIST? 64985000 BNL MXCNAT01 NO IF NOT LOW 64990000 L RC,MXPNBOPS ELSE GET NBR OF OPRNDS 64995000 B MXCONV0A AND CONVERT IF NECESSARY 65000000 MXCNATTT EQU * 65005000 MXCNAT01 EQU * 65015000 TM AVMBYTE2,$MINBOOL BOOLEAN VALUE REQUIRED J 65020000 BZ MXCNAT02 IF NOT OKAY 65025000 LA RB,$ER#ATER ELSE SET ATTRIB USE ERR 65030000 B MXPNINJE GO FLAG ERROR AND CONTINUE 65035000 MXCNAT02 EQU * 65040000 USING MCPAROPR,RE SET USING ON SYM PAR DICT ENTRY 65045000 SR RC,RC 65050000 LA RE,$LMPAROP GET LENGTH OF ENTRY 65055000 MR RD,RB GET OFFSET 65060000 A RE,MXPNLSPT ADD SYM PAR DICT BASE 65065000 LA R1,$BSATN GET N' INDEX 65070000 CR RA,R1 COMPARE WITH OPRND INDEX 65075000 BH MXCNATTP T' IF HIGH 65080000 BE MXCNATNP N' IF EQUAL 65085000 IC RC,MCPAROLN K' IF FALL THRU 65090000 B MXCONV0A RETRN 65095000 MXCNATNP EQU * 65100000 IC RC,MCPARONB GET N' 65105000 B MXCONV0A JUMP TO CONVERT 65110000 MXCNATTP EQU * 65115000 LA RB,1 GET LENGTH OF TYPE 65120000 LA RC,MCPAROTP GET POINTER TO TYPE 65125000 B MXCONV0C CONVERT IF NECESSARY 65130000 DROP RE 65135000 SPACE 65140000 MXCNADDA EQU * 65145000 L RC,0(RB) GET ARITH VALUE 65155000 B MXCONV0A CONVERT IF NECESSARY 65160000 MXCNADDB EQU * 65165000 L RC,0(RB) GET VALUE 65175000 B MXCONV0B CONVERT IF NECESSARY 65180000 MXCNADDC EQU * 65185000 LA RC,4(RB) GET @ OF STRING 65195000 L RB,0(RB) GET LENGTH OF STRING 65200000 B MXCONV0C CONVERT IF NECESSARY 65205000 SPACE 65210000 MXCNUND EQU * 65215000 LA RB,$ER#SYER SET SYSTEM ERROR FALG 65220000 B MXPNINJE GO FLAG ERROR AND CONTINUE 65225000 EJECT 65230000 * A 65230100 * CONVERT TO ARITH A 65230200 * A 65230300 MXCONV0A EQU * 65235000 TM AVMBYTE2,$MINARIT ARITH REQ'D? 65240000 BO MXCONRTN RETURN IF YES 65245000 B MXCONVAR ELSE CONVERT 65250000 * A 65250100 * CONVERT TO BOOLEAN A 65250200 * A 65250300 MXCONV0B EQU * 65255000 TM AVMBYTE2,$MINBOOL+$MINARIT ARITH OR BOOL REQ'D? 65260000 BM MXCONRTN RETURN IF YES 65265000 B MXCONVBL ELSE CONVERT 65270000 * A 65270100 * CONVERT TO CHAR A 65270200 * A 65270300 MXCONV0C EQU * 65275000 TM AVMBYTE2,$MINCHAR CHAR REQ'D? 65280000 BO MXCONRTN RETURN IF YES 65285000 B MXCONVCH ELSE CONVERT 65290000 MXCONVAR EQU * 65295000 TM AVMBYTE2,$MINCHAR CHAR REQ'D? 65300000 BO MXCONVAC CONVERT IF YES 65305000 C RC,AWF1 BOOL VALUE? 65310000 BE MXCONRTN RETURN IF YES 65315000 LTR RC,RC ZERO VALUE? 65320000 BE MXCONRTN OKAY IF YES 65325000 MXCONVAB LA RB,$ER#CVAB ELSE SET ERROR FLAG A 65330000 B MXPNINJE GO FLAG ERROR AND CONTINUE 65335000 MXCONVAC EQU * 65340000 LPR RC,RC GET POS VALUE 65345000 CVD RC,AVDWORK1 CONVERT TO PACKED DEC 65350000 LA RB,12 GET MAX LENGTH OF DEC NUMBER+1 65355000 $MALLOCL RE,RB,OVRFL=MXEXECOV GET STORAGE FOR NBR 65360000 MVC 0(12,RE),MXCEP12 MOVE EDIT MASK FOR MAX NBR 65365000 LA R1,11(RE) POINT TO LAST CHAR 65370000 LA RB,1(R1) GET @ OF DELIM IN RB 65375000 EDMK 0(12,RE),AVDWORK1+2 EDIT DEC FIELD 65380000 LR RC,R1 MOVE POINTER TO RC 65385000 SR RB,R1 PUT LENGTHIN RB 65390000 B MXCONRTN AND RETURN 65395000 EJECT 65400000 MXCONVBL EQU * 65405000 * A 65405100 * CONVERT BOOLEAN --> CHAR A 65405200 * A 65405300 LA RB,1 SET LEN TO 1 65410000 LA RC,MXCONBLT(RC) GET @ OF '0' OR '1' AS APPROPRIATE 65415000 B MXCONRTN AND RETURN 65420000 MXCONBLT DC C'01' CONVERT BOOLEAN TO CHARACTER 65425000 SPACE 65430000 MXCONVCH EQU * 65435000 TM AVMBYTE2,$MINBOOL BOOL REQ'D? 65440000 BO MXCONVCB CONVERT IF YES 65445000 * A 65445100 * CONVERT CHAR --> ARITH A 65445200 * A 65445300 MXCONVCA EQU * CONVERT TO ARITH 65450000 SR R2,R2 65455000 SR R1,R1 65460000 LTR RB,RB TEST LENGTH OF CHAR 65465000 BNZ MXCONCA1 PROCEED IF NONZERO 65470000 MXCONCAR EQU * PROCESS ZERO STRING 65475000 LR RD,RB MOVE LENGTH TO RD 65480000 LA RB,$ER#CVCA SET CONVERSION ERROR FLAG 65485000 B MXPNINJE GO FLAG ERROR AND CONTINUE 65490000 MXCONCA1 EQU * CONVERT TO ARITH 65495000 TRT 0(1,RC),AWTDECT POSSIBLE SELF DEF TERM? 65500000 BNZ MXCONCA4 CKECK FOR C,B OR X IF NOT 65505000 C RB,AWF10 TEST LENGTH 65510000 BH MXCONCAR ERROR IF > 10 65515000 BL MXCONCA2 IF < 10, OKAY 65520000 CLC 0(10,RC),=C'2147483647' ELSE COMPARE AGAINST LIMIT 65525000 BH MXCONCAR ERROR IF HIGH 65530000 MXCONCA2 EQU * 65535000 BCTR RB,0 DECR LEN FOR TRT 65540000 EX RB,MXPSCDEC SCAN FOR DEC NBRS 65545000 BZ MXCONCA3 OKAY IF ALL DEC 65550000 LA RB,1(RB) ELSE RESTORE RB 65555000 B MXCONCAR AND FLAG ERROR 65560000 MXCONCA3 EQU * 65565000 EX RB,MXPMVDEC MOVE DEC STRING TO WORK AREA PACKED 65570000 CVB RC,AVDWORK1 CONVERT TO BIN 65575000 B MXCONRTN AND RETURN 65580000 MXCONCA4 EQU * 65585000 C R2,AWF4 B, C OR X? 65590000 BNE MXCONCAR ERROR IF NOT 65595000 LR R1,RB SAVE LENGTH 65600000 LR RA,RC MOVE POINTER TO RA 65605000 $CALL SDBCDX CHECK FOR SELF DEF AND CONVERT 65610000 LTR RB,RB OKAY? 65615000 BZ MXCONRTN RETURN IF OKAY 65620000 LR RB,R1 RESTORE LENGTH TO RB 65625000 LR RC,RA PUT POINTER IN RC 65630000 B MXCONCAR AND FLAG ERROR 65635000 SPACE 65640000 MXPMVDEC PACK AVDWORK1,0($,RC) DUMMY TO PACK STRING 65645000 MXPSCDEC TRT 0($,RC),AWTDECT DUMMY TO SCAN FOR DEC CHARS 65650000 SPACE 10 S 65655000 MXCONVCB EQU * CONVERT CHAR TO BOOL 65660000 C RB,AWF1 LEN = 1? 65665000 BE MXCONCB1 OKAY IF 1 65670000 MXCONCBR EQU * ELSE IS ERROR 65675000 LR RD,RB MOVE LEN TO RD 65680000 LA RB,$ER#CVCB SET CHAR->BOOL ERROR 65685000 B MXPNINJE GO FLAG ERROR AND CONTINUE 65690000 MXCONCB1 EQU * 65695000 CLI 0(RC),C'1' CHAR = 1? 65700000 BNE MXCONCB2 PROCEED IF NOT 1 65705000 LA RC,1 SET BOOL VALUE 65710000 B MXCONRTN AND RETURN 65715000 MXCONCB2 EQU * 65720000 CLI 0(RC),C'0' DID CHAR = '0' (ZERO) J 65725000 BNE MXCONCBR ERROR IF NOT 65730000 SR RC,RC SET FALSE BOOL FALUE 65735000 * A 65735300 MXCONRTN EQU * 65740000 XSNAP LABEL='***MXARITH EXITED***', X65745000 IF=(AVMSNBY2,O,$MSNP12,TM) 65750000 SR RA,RA ZERO RA FOR BYTE USE A 65750100 L RET,MXSCCVSV RESTORE RETURN @ 65755000 BR RET AND RETURN 65760000 MXSCCVSV DS F SPACE FOR RETURN ADDRESS 65765000 MXCEP12 DC X'402020202020202020202120' 12 BYTE DEC MASK 65770000 LTORG 65775000 TITLE ' MXINST-INTERNAL ROUTINES' A 65785000 **--> INSUB: MXADDR THIS ROUTINE ACCEPTS A ONE-OP + + + + + + +S 65786000 *+ OPRND AND RETURNS THE @ OF THE SYMBOL. OPRND MUST BE +S 65790000 *+ A SET SYMBOL OR TEMP VALUE POINTING TO AN ADDRESS. +S 65795000 *+ +S 65800000 *+ ENTRY CONDITIONS: S 65805000 *+ RA = INDEX OF OPRND +S 65810000 *+ RB = @ OF OPRND +S 65815000 *+ +S 65820000 *+ EXIT CONDITIONS: +S 65825000 *+ RC = @ OF VALUE +S 65830000 *+ RD = DIMENSION OF SET SYMBOL +S 65835000 *+ RE = TYPE OF SYMBOL (IE - $ARIT, $BOOL OR $CHAR) +S 65840000 *+ +S 65845000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 65850000 SPACE 65855000 MXADDR DS 0F ENTRY PT FOR INTERNAL SUB 65860000 XSNAP LABEL='***MXADDR ENTERED***', X65875000 IF=(AVMSNBY2,O,$MSNP12,TM) 65880000 USING MCGLBDCT,RB NOT USING ON SET SYMB DV 65885000 SR RE,RE 65890000 SR RD,RD 65895000 LA R1,$BSYMPAR GET SYM PAR BSU VALUE 65900000 CR RA,R1 COMPRE WITH OPNRD 65905000 BNL MXADDR01 NOT SET SYM IF NOT LOW 65910000 SRL R1,1 DIVIDE SYM PAR BSU BY 2 65915000 CR RA,R1 COMPARE WITH OPRND 65920000 BNL MXADDRLC SET SYM LOCAL IF NOT LOW 65925000 LA RC,MCGBAVAL GET @ OF VALUE 65930000 LH RD,MCGLBDIM GET DIMENSION 65935000 IC RE,MCGLBTYP GET TYPE IN RE 65940000 B MXADDRET JUMP TO FOOT 65945000 MXADDRLC EQU * TREAT LOCAL SET SYMBOLS 65950000 LH RD,MCGLBDIM GET DIMENSION 65955000 IC RE,MCGLBTYP GET TYPE 65960000 L RC,MGLCLPNT GET OFFSET 65965000 A RC,MXPNLDBS ADD BASE @ OF SET SYM DICT 65970000 B MXADDRET JUMP TO FOOT 65975000 MXADDR01 EQU * 65980000 USING MCOPQUAD,RB NOTE USING ON ONE-OP 65985000 LA R1,$BSTEMP GET TEMP BSU 65990000 CR R1,RA MUST BE $BSTEMP 65995000 BNE MXADDRR1 ERROR IF NOT 66000000 L RC,MCRESULT GET @ OF DESIRED VALUE 66005000 CLI MCRSLTYP,$BSADDRA COMPARE WITH ARITH @ 66010000 BL MXADDRR1 ERROR IF LOW 66015000 BE MXADDR02 66020000 CLI MCRSLTYP,$BSADDRC CHECKFOR CHAR @ 66025000 BH MXADDRR1 ERROR IF HIGH 66030000 BE MXADDR03 ARITH IF EQUAL 66035000 LA RE,$BOOL FALL THRU MEANS BOOLEAN 66040000 B MXADDRET JUMP TO FOOT 66045000 MXADDR02 EQU * 66050000 LA RE,$ARITH SET ARITH TYPE 66055000 B MXADDRET JUMP TO FOOT 66060000 MXADDR03 EQU * 66065000 LA RE,$CHAR SET CHAR TYPE 66070000 B MXADDRET JUMP TO FOOT 66075000 MXADDRR1 EQU * 66080000 LA RB,$ER#SYER SET SYSTEM ERROR 66085000 B MXPNINJE GO FLAG ERROR AND CONTINUE 66090000 MXADDRET EQU * 66095000 XSNAP LABEL='*** MXADDR EXITED ***', #66100000 IF=(AVMSNBY2,O,$MSNP12,TM) 66105000 BR RET AND RETURN 66110000 LTORG 66115000 DROP RB,RZ,RAT S 66120000 TITLE '***MXERRM GENERATES ERROR MSSGS IN MEXPND***' 66125000 **--> CSECT: MXERRM CALLED DURING MACRO GENERATION TO GENERATE * 66130000 *. ERROR MESSAGES NOT HANDLED BY ERRTAG * 66135000 *. * 66140000 *. ENTRY CONDITIONS * 66145000 *. RA-SCAN PTR A 66145100 *. RB = ERROR TYPE * 66150000 *. RC = OPERAND VALUE OR LOCATION * 66155000 *. RD = LENGTH OF STRING IF CHAR VALUE * 66160000 *. RE-@ MXPNTSACV A 66160100 *. * 66165000 *. EXIT CONDITIONS A 66165100 *. RB=0 ==> OK A 66165200 *. RB=4 ==> STORAGE OVERFLOW CAUSED MESSAGE SELECTED IS PLACED A 66165300 *. IN RSBLOCK, THEN MOVED OUT TO HIGH AREA BY MXMVSR A 66165400 *. A 66165500 *. USES MACROS: $CALL, $AL2, $SAVE, $RETURN * 66170000 *. CALLS MXMVSR * 66175000 *. USES DSECTS: RSBLOCK, MXPNTSAV, MCOPQUAD, AVWXTABL * 66180000 *. * 66185000 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 66190000 SPACE 66195000 MXERRM CSECT 66200000 $SAVE RGS=(R14-R6),BR=R13,SA=* 66205000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 66210000 XSNAP LABEL='***MXERRM ENTERED***',T=NO, X66215000 IF=(AVMSNBY2,O,$MSNP13,TM) 66220000 USING RSBLOCK,RW NOTE USING FOR SOURCE BLOCK 66225000 L RW,AVRSBPT SET BASE FOR SOURCE 66230000 USING MXPNTSAV,RE MACRO BLOCK A 66235000 L RY,MXPNCRCD CURRENT INSTRUCTION A 66240000 USING MCOPQUAD,RY NOTE USING S 66240100 MVC RSBLOCK(RSB$L),=AL1(0,$RSBNPNN+$RSBMERR,1,0) S 66245000 LA R1,MXMSSGS ADDRESS OF MESSAGES A 66250000 AH R1,MXERRPTR(RB) @ SPECIFIC MSG A 66255000 USING MSGBLOCK,R1 A 66260000 SR R2,R2 CLEAR R2 A 66265000 IC R2,MSGLENM1 GET LENGTH-1 OF MSG & NUMBER A 66270000 EX R2,MXERRMVC MOVE IT IN A 66275000 * 1ST PART (MSG) NOW DONE A 66280000 * NOW FILL IN STM NUMBER, OTHER DATA A 66285000 * R2 WILL BE ACCUMUALTION OF L-1 A 66290000 LA RA,RSBSOURC+1(R2) @ NEXT BYTE A 66295000 MVC 0(MXERRS$L,RA),MXERRSTN STMT NUMBER EDIT PATTERN A 66300000 ED L'MXERRSTN(6,RA),MCQSTMNO A 66305000 L RY,MXPNMCLB GET MACRO PTR A 66310000 USING MACLIB,RY A 66315000 MVC MXERRS$L(L'MCLBNAM,RA),MCLBNAM A 66320000 LA RB,MXMSSGS(RB) ADD @ BEGINNING OF TABLE 66325000 LA R2,MXERRS$L+L'MCLBNAM(R2) BUMP L-1 A 66330000 DROP RE,RY A 66330050 LA RA,RSBSOURC+1(R2) BUMP PTR FOR MSG OUTPUT A 66330100 * MSGFLAG = 0 MSG # S 66330110 * 4 NUMERICAL S 66330200 * 8 CHAR VALUE S 66330300 * S 66330400 CLI MSGFLAG,X'04' COMPARE VALUE S 66335000 BL MXERFOOT IF LOW, DONE. 66340000 MVC 0(3,RA),=C'-->' MOVE POINTER TO RSBSOURC 66345000 LA RA,3(RA) BUMP SCAN POINTER 66350000 LA R2,3(R2) BUMP LEN-1 66355000 BH MXERRM0C CHAR STRING IF HIGH 66360000 SPACE 66365000 MXERRM0A EQU * FALL THRU FOR ARITH TYPR 66370000 LA R1,AVMWRK1+11 POINT TO END OF EDIT MASK 66375000 LA RE,1(R1) POINT RE TO DELIMMPAST MASK 66380000 CVD RC,AVDWORK1 CONVERT VALUE TO PACKED DEC 66385000 MVC AVMWRK1(12),MXEEP12 MOVE EDIT MASK TO WORK AREA 66390000 EDMK AVMWRK1(12),AVDWORK1+2 EDIT AND MARK VALUE 66395000 SR RE,R1 GET LENGTH OF STRING 66400000 BCTR R1,0 DECR POINTER TO SIGN POSIT 66405000 EX RE,MXMVSTRN MOVE CHAR VALUE TO OUTPUT 66410000 LTR RC,RC NEG VALUE? 66415000 BNL MXERRMA1 SKIP IF NOT 66420000 MVI 1(RA),C'-' ELSE INSERT MINUS SIGN 66425000 MXERRMA1 EQU * 66430000 LA R2,2(RE,R2) BUMP LENGTH 66435000 B MXERFOOT JUMP TO FOOT 66440000 MXERRM0C EQU * 66445000 LR R1,RC MOVE @ OF STRING TO R1 66455000 LA RE,RSOL1-2 A 66460000 SR RE,R2 SUBTRACT CURRENT L-1 A 66465000 CR RD,RE VALUE LEN OK? 66475000 BNH MXERRMC1 PROCEED IF OKAY 66480000 LR RD,RE ELSE SUB OKAY LENGTH 66485000 MXERRMC1 EQU * 66490000 LA R2,1(RD,R2) GET TOTAL L-1 A 66495000 LTR RD,RD NULL STRING? 66500000 BZ MXERFOOT FINI IF YES 66505000 EX RD,MXMVSTRN MOVE STRING TO OUTPUP 66515000 * FALL THRU INTO MXERFOOT. 66520000 MXERFOOT EQU * 66525000 STC R2,RSBLENG PUT LEN-1 IN OUTPUT 66530000 $CALL MXMVSR MOVE STMT TO HIGH AREA 66535000 SPACE 66565000 XSNAP LABEL='***MXERRM EXITED***',T=NO, X66570000 IF=(AVMSNBY2,O,$MSNP13,TM) 66575000 SPACE 66580000 $RETURN RGS=(R14-R6) 66585000 SPACE 66590000 MXERRMVC MVC RSBSOURC($),MSGNMBR A 66590100 MXMVSTRN MVC 1($,RA),0(R1) DUMMY TO MOVE STRING 66595000 MXEEP12 DC X'402020202020202020202120' 12 BYTE DEC MASK 66600000 MXMSSGS EQU * 66605000 MXACTRMS $MSG 221,' ACTR COUNTER EXCEEDED' A 66610000 MXDMSNMS $MSG 222,' INVALID SYM PAR OR SET SYMBL SUBSCRIPT',FLAG=4 A 66615000 MXSBSTMS $MSG 223,' SUBSTRING EXPRESSION OUT OF RANGE',FLAG=4 A 66620000 MXCVCAMS $MSG 224,' INVALID CONVERSION, CHAR TO ARITH',FLAG=8 A 66625000 MXCVABMS $MSG 225,' INVALID CONVERSION, ARITH TO BOOLEAN',FLAG=4 A 66630000 MXCVCBMS $MSG 226,' INVALID CONVERSION, CHAR TO BOOLEAN',FLAG=8 A 66635000 MXATTRMS $MSG 227,' ILLEGAL ATTRIBUTE LIST' A 66640000 MXSYSLMS $MSG 228,' &&SYSLIST SUBSCRIPT OUT OF RANGE',FLAG=4 A 66645000 MXSYERMS $MSG 229,' ASSIST CANNOT EXPAND--SIMPLIFY STMT OR USE "."' 66650000 MXERBFM $MSG 230,' INTERNAL CHAR BUFFER EXCEEDED' A 66655000 MXEXSTMS $MSG 231,' MSTMG LIMIT EXCEEDED' A 66660000 MXZDIVMS $MSG 232,' ZERO DIVIDE OR FIXED POINT OVERFLOW' A 66665000 MXPRVR $MSG 217,' STMT NOT PROCESSED: PREVIOUS ERROR' A 66665100 MXERRSTN DC C': STMT/MACRO',X'402020202120',C'/' S 66670000 MXERRS$L EQU *-MXERRSTN A 66670100 MXERRPTR $AL2 MXMSSGS,(MXACTRMS,MXDMSNMS,MXSBSTMS,MXCVCAMS,MXCVABMS,MXX66670200 CVCBMS,MXATTRMS,MXSYSLMS,MXSYERMS,MXERBFM,MXEXSTMS,MXZDIX66670400 VMS,MXPRVR),-2 A 66670500 LTORG 66675000 DROP RAT,RW A 66680000 TITLE '***MXMVSR - MOVES GENERATED STMT TO HIGH CORE***' 66685000 **--> CSECT: MXMVSR MOVES GENERATED STMT FROM RSBLOCK TO HIGH FREE * 66690000 *. AREA. AVGEN2CD POINTS TO BEGINNING OF STMT * 66695000 *. * 66700000 *. EXIT CONDITIONS * 66705000 *. RB = ZERO IF OKAY ELSE 4 IF OVERFLOW * 66710000 *. * 66715000 *. USES MACROS: $SAVE, $RETURN, $MALLOCH * 66720000 *. USES DSECTS RSBLOCK,REBLK,AVGEN1CD,AVGEN2CD A 66725000 *. * 66730000 *. REGISTER USAGES A 66730100 *. RAT-MAIN TABLE USING A 66730200 *. RW-SOURCE BLK USING A 66730300 *. RX-ERROR BLK USING A 66730400 *. R1,RB-BYTE REGISTERS A 66730500 *. RA-WORK REGISTER A 66730600 *. A 66730700 *.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 66735000 SPACE 66740000 MXMVSR CSECT 66745000 $SAVE RGS=(R14-R4),SA=NO A 66750000 USING AVWXTABL,RAT NOTE MAIN TABLE USING 66755000 XSNAP LABEL='***MXMVSR ENTERED***',T=NO, X66760000 IF=(AVMSNBY2,O,$MSNP13,TM) 66765000 USING RSBLOCK,RW NOTE SOURCE USING 66770000 L RW,AVRSBPT SET BASE FOR RSBLOCK 66775000 USING REBLK,RX SET USING FOR ERROR BLOCK 66780000 LA RX,AVREBLK SET BASE FOR ERROR BLOCK 66785000 SR R1,R1 66790000 SR RB,RB 66795000 TM RSBFLAG,$REBX EROOR BLOCK EXISTS? 66805000 BZ MXMVSR01 JUMP AROUND IF NO 66810000 IC RB,REBLN GET LEN-1 OF ERR BLOCK 66815000 STC RB,RSBNUM PUT ERR BLOCK LEN IN RSB 66820000 * REBLN IS ACTUAL LENGTH OF PART OF REBLK TO BE MOVED, 66825000 * SINCE IT IS L-1 OF WHOLE THING (COUNTING REBLN) 66830000 MXMVSR01 EQU * 66835000 IC R1,RSBLENG GET LEN-1 OF STMT 66840000 LA RB,RSB$L+1(RB,R1) GET TOTAL LENGTH FOR ENTIRE SECT 66845000 $MALLOCH RA,RB,OVRFL=MXMVOVR GET STORAGE FOR STMT 66850000 TM RSBFLAG,$REBX ERROR BLOCK? 66855000 BZ MXMVSR02 SKIP IF NO 66860000 IC RB,REBLN GET LEN-1 OF ERR BLOCK 66865000 BCTR RB,0 GET LENGTH-1 OF PART TO BE MOVED 66870000 LA RX,1(RX) BUMP REBLK PTR TO PART BEING MOVED 66875000 EX RB,MXMVSRCE MOVE ERRBLOCK TO HIGH STORAGE 66880000 LA RA,1(RA,RB) GET ACTUAL LENGTH MOVED 66885000 MXMVSR02 EQU * 66890000 LA RX,RSBSOURC PUT @ OF SOURCE IN RX FOR EX INST 66895000 EX R1,MXMVSRCE MOVE STMT TO HIGH CORE 66900000 AR RA,R1 BUMP PTR TO LAST CHAR A 66905000 MVC 1(RSB$L,RA),RSBLOCK MOVE FLAG BYTE ETC A 66910000 SR RB,RB CLEAR RB FOR RETURN 66915000 MXMVRTN EQU * 66920000 MVC RSBLOCK(RSB$L),AWZEROS ZERO STANDARD PART OF RSBLOCK 66925000 MVC RSBSOURC($LMSRCMX),AWBLANK BLANK REMAINDER OF RECORD 66930000 SPACE 66935000 AIF (&$DEBUG).MACQQ09 SKIP IF NO DEBUG 66940000 L R1,AVGEN2CD GET POINTER TO NEW STMT 66945000 XSNAP LABEL='***MXMVSR EXITED***',STORAGE=(*0(R1),*128(R1)), X66950000 IF=(AVMSNBY2,O,$MSNP13,TM) 66955000 .MACQQ09 ANOP 66960000 SPACE 66965000 $RETURN RGS=(R14-R4),SA=NO A 66970000 SPACE 66975000 MXMVOVR EQU * 66980000 LA RB,4 SET OVERFLOW FLAG 66985000 B MXMVRTN RETURN 66990000 MXMVSRCE MVC 0($,RA),0(RX) DUMMY TO MOVE STIRNG TO HIGH 66995000 LTORG 67000000 DROP RAT,RW,RX,REP 67005000 .MAXXXX ANOP 67010000