% IGGMPROC: 01000000 MACRO KEYS(PNAME,TYPE,CALLED); 02000000 DCL IGGGVCCT CHAR EXT ; /*CONTROL VARIABLE */ 03000000 DCL IGGFPINT CHAR EXT; /* INT PROC GLOBAL SW @ZA29164*/ 03020037 DCL IGGBASE2 CHAR EXT; /* BASE REGISTER @ZA95164*/ 03050037 DCL PROCNAME CHAR ; /* PROCEDURE NAME */ 04000000 DCL (CBSW,NUSW,IESW) CHAR ; /*PROCESSING CONTROL SW. */ 05000000 DCL (TITLEC,TITLET) CHAR ; /*TITLE WORK VAR. */ 06000000 DCL BEGLABEL CHAR; /* LABEL VARIABLE @ZA29164*/ 06050037 DCL SFIDNAMELOVAR CHAR; 07000000 DCL (BLANKS,ASTERICS) CHAR; /*COMMENT VARIABLES @Y30SSPJ*/ 07050037 DCL (RX5,RX6,RX7,RX8,RX9,RX10)CHAR;/* REG VAR @ZA95164*/ 07052037 IF IGGBASE2^='5' THEN /* IS 2ND BASE REG 5? @ZA95164*/ 07054037 RX5 = 'R5,'; /* NO @ZA95164*/ 07056037 ELSE; /* @ZA95164*/ 07058037 IF IGGBASE2^='6' THEN /* IS 2ND BASE REG 6? @ZA95164*/ 07060037 RX6 = 'R6,'; /* NO @ZA95164*/ 07062037 ELSE; /* @ZA95164*/ 07064037 IF IGGBASE2^='7' THEN /* IS 2ND BASE REG 7? @ZA95164*/ 07066037 RX7 = 'R7,'; /* NO @ZA95164*/ 07068037 ELSE; /* @ZA95164*/ 07070037 IF IGGBASE2^='8' THEN /* IS 2ND BASE REG 8? @ZA95164*/ 07072037 RX8 = 'R8,'; /* NO @ZA95164*/ 07074037 ELSE; /* @ZA95164*/ 07076037 IF IGGBASE2^='9' THEN /* IS 2ND BASE REG 9? @ZA95164*/ 07078037 RX9 = 'R9,'; /* NO @ZA95164*/ 07080037 ELSE; /* @ZA95164*/ 07082037 IF IGGBASE2^='10' THEN /* IS 2ND BASE REG 10? @ZA95164*/ 07084037 RX10 = 'R10'; /* NO @ZA95164*/ 07086037 ELSE /* @ZA95164*/ 07088037 RX9 = 'R9'; /* YES @ZA95164*/ 07090037 BLANKS = REPEAT(' ',65); /* SET 66 BLANKS @Y30SSPJ*/ 07100037 ASTERICS = REPEAT('*',65); /* SET 66 ASTERICS @Y30SSPJ*/ 07150037 CBSW = '2' ; /*PRESET TO IND. OUTER PROC */ 08000000 PROCNAME = PNAME(1) ; /*SET PROC NAME VAR */ 09000000 IF CALLED(1) = '' /*IF NOT SPEC */ 10000000 THEN IESW = 'INT' ; /*SUPPLY DEFAULT */ 11000000 ELSE IESW = CALLED(1) ; 12000000 IF TYPE(1) = '' /*IF NOT SPEC. */ 13000000 THEN NUSW = 'NES' ; /*SUPPLY DEFAULT */ 14000000 ELSE NUSW = TYPE(1) ; 15000000 TITLEC = IESW || 'ERNALLY' ; /*INITIALIZE TITLE VARS. */ 16000000 IF NUSW = 'NES' 17000000 THEN TITLET = NUSW || 'TED' ; 18000000 ELSE TITLET = NUSW || 'ESTED' ; 19000000 IF IGGGVCCT = '' THEN /*1ST TIME INVOKED @Y30SSPJ*/ 19050037 DO; /* YES-FIRST TIME @Y30SSPJ*/ 19100037 ANS ( COMMENT(ASTERICS) ) COL(2); /*@Y30SSPJ*/ 19150037 ANS ( COMMENT(BLANKS) ) COL(2); /*@Y30SSPJ*/ 19200037 ANS ('/') COL(2); /*@Y30SSPJ*/ 19250037 ANS ('*') COL(3); /*@Y30SSPJ*/ 19300037 ANS ('PROCNAME - PROCEDURE TITLEC CALLED TITLET') 19350037 RESCAN COL(12); /*@Y30SSDW*/ 19400037 ANS ('*') COL(70); /*@Y30SSPJ*/ 19450037 ANS ('/') COL(71); /*@Y30SSPJ*/ 19500037 ANS ( COMMENT(BLANKS) ) COL(2); /*@Y30SSPJ*/ 19550037 ANS ( COMMENT(ASTERICS) ) COL(2); /*@Y30SSPJ*/ 19600037 GOTO PO ; /*GO BUILD OUTER PROC @Y30SSPJ*/ 19650037 END; /*@Y30SSPJ*/ 19700037 SFIDNAMELOVAR = 'CL8' || QUOTE(PROCNAME); 22000000 IF IGGGVCCT ^= '1' THEN /*NOT 1ST PROC */ 23000000 DO; 24000000 ANS ('CALL EXIT;') SKIP COL(12); 25000037 ANS ('/* RETURN TO CALLER */') COL(41); 26000000 END; 27000000 ELSE 28000000 DO; 28050000 ANS ('GEN(USING @MAINENT,@15);') SKIP COL(12); 28100037 ANS ('/* INDICATE AVAILABLE BASE REG */') 28110037 COL(37); /* @Y30SSDW*/ 28120037 ANS ('GEN REFS(CCATEMPS) (USING @DATD-(CCATEMPS-IGGCCA),R11);') 28150000 SKIP COL(12); 28200000 IF IESW='INT' THEN /* INTERNAL PROCEDURE @ZA29164*/ 28210037 IGGFPINT='1'; /* SET GLOBAL SWITCH @ZA29164*/ 28220037 ELSE; /* NO @ZA29164*/ 28230037 END; 28250000 ANS ('GEN(DS 0F);') SKIP COL(12); 29000037 ANS ('/* FULLWORD BOUNDARY ALIGNMENT */') 29050037 COL(37); /* @Y30SSDW*/ 29100037 ANS ('GEN(DC SFIDNAMELOVAR);') SKIP COL(12); 30000037 ANS ('/* NAME OF FOLLOWING PROCEDURE */') 31000037 COL(37); /* @Y30SSDW*/ 31050037 IF IGGGVCCT = '3' THEN /*INNER PROC (NOT 1ST) */ 32000000 DO; 33000000 ANS ('END;') SKIP COL(12); 34000000 ANS ('/* END OF INNER PROCEDURE */') COL(41); 35000037 END; 36000000 CBSW = '3' ; /*INDICATE INNER PROC */ 37000000 ANS ('@EJECT ASSEMBLE;') SKIP COL(2) ; /*@ZA95164*/ 38000037 ANS ( COMMENT(ASTERICS) ) COL(2); /*@Y30SSPJ*/ 39050037 ANS ( COMMENT(BLANKS) ) COL(2); /*@Y30SSPJ*/ 39100037 ANS ('/') COL(2); /*@Y30SSPJ*/ 39150037 ANS ('*') COL(3); /*@Y30SSPJ*/ 39200037 ANS ('PROCNAME - PROCEDURE TITLEC CALLED TITLET') 39250037 RESCAN COL(12); /*@Y30SSDW*/ 39300037 ANS ('*') COL(70); /*@Y30SSPJ*/ 39350037 ANS ('/') COL(71); /*@Y30SSPJ*/ 39400037 ANS ( COMMENT(BLANKS) ) COL(2); /*@Y30SSPJ*/ 39450037 ANS ( COMMENT(ASTERICS) ) COL(2); /*@Y30SSPJ*/ 39500037 ANS (PROCNAME || ':') SKIP RESCAN COL(2); 40000000 ANS ('PROC OPTIONS(NOSAVEAREA,NOSAVE);') COL(12); 41000000 ANS ('/* SPECIFY PROCEDURE OPTIONS */') COL(37);/*@Y30SSDW*/ 41050037 IF IESW = 'EXT' THEN 42000000 DO; 42050000 ANS ('GEN(ENTRY PROCNAME );') SKIP RESCAN COL(12); 43000000 ANS ('/* IDENTIFY ENTRY-POINT SYMBOL */') 43010037 COL(37); /*@Y30SSDW*/ 43020037 END; 43050000 IF IGGGVCCT = '1' THEN 44000000 DO; /* @Y30SSDW*/ 44050037 ANS ('GEN(DROP @15);') SKIP COL(12); /* @Y30SSDW*/ 45000037 ANS ('/* DROP AVAILABLE BASE REGISTER */') 45050037 COL(37); /* @Y30SSDW*/ 45100037 END; /* @Y30SSDW*/ 45150037 GOTO PP; 46000000 PO: ANS (PROCNAME || ':') SKIP COL(2); 47000000 ANS ('PROC OPTIONS') COL(12); 48000000 ANS ('(REENTRANT,NOSAVEAREA,NOSAVE,NOCODEREG,NODATAREG, 49000000 ID);') SKIP COL(18); 50000000 IGGGVCCT = '1'; /*IND. OUTER PROC DEFINED */ 51000000 ANS ('DECLARE IGGSEGBR REG(12) PTR(31) RSTD;') SKIP COL(12); 52000037 ANS ('/* MODULE BASE REGISTER */') COL(41); 53000000 IF IGGBASE2 ^= '' THEN /* BASE REG 2 SPECIFIED? @ZA95164*/ 53006037 DO; /* YES @ZA95164*/ 53011037 ANS('DECLARE IGGSEGB2 REG('||IGGBASE2||')PTR(31)RSTD;') 53016037 SKIP COL(12); /* GEN 2ND BASE DECLARE @ZA95164*/ 53021037 ANS('/* BASE 2 REGISTER */') COL(41); /*@ZA95164*/ 53026037 END; /* @ZA95164*/ 53031037 ELSE; /* @ZA95164*/ 53036037 PP: ANS ('Z' || MACINDEX(2:4) || ':') SKIP COL(2); /*@Y30SSPJ*/ 53050037 ANS ('/* LABEL FOR PROCEDURE TRACKING */') 53100037 COL(37); /* @Y30SSDW*/ 53150037 ANS ('Z' || MACINDEX(2:4) || PROCNAME(5:LENGTH(PROCNAME)) 65000000 || ':') SKIP COL(2); 66000000 ANS ('/* LABEL FOR PROCEDURE TRACKING */') 66100037 COL(37); /* @Y30SSDW*/ 66150037 ANS ('RFY ('||RX5||RX6||RX7||RX8||RX9||RX10||') UNRSTD;') 67000037 SKIP COL(12); /* @ZA95164*/ 67010037 ANS ( '/* PL/S COMPILER WORK REGISTERS */') 67050037 COL(37); /* @Y30SSDW*/ 67100037 ANS ('RFY (R2,R3,R4) RSTD;') SKIP COL(12); 68000000 ANS ('/* RESTRICT LOCAL WORK REGISTERS */') 68050037 COL(37); /* @Y30SSDW*/ 68150037 IF NUSW = 'NES' THEN /*TYPE = NESTED */ 69000000 DO; 70000000 ANS ('GEN(STM 12,14,12(13));') SKIP COL(12); 71000000 ANS ('/* SAVE REGISTERS OF CALLER */') COL(41); 72000037 ANS ('GEN(LA 13,12(13));') SKIP COL(12); 73000000 ANS ('/* POINT TO NEXT SAVE AREA */') COL(41); 74000000 END; 75000000 IF IESW = 'EXT' THEN /*EXTERNALLY CALLED */ 76000000 DO; 77000000 ANS ('GEN(BALR 12,0);') SKIP COL(12); 78000000 ANS ('/* ESTABLISH ADDRESSABILITY */') COL(41); 79000000 END; 80000000 IF IGGGVCCT = '1' THEN /*FIRST PROC */ 81000000 IF IESW = 'EXT' THEN /*EXTERNALLY CALLED @ZA95164*/ 81050037 DO; 82000000 ANS ('IGGSEGST: GEN(DS 0H);') SKIP COL(2); 83000000 ANS ('/* HALFWORD BOUNDARY ALIGNMENT */') 83050037 COL(37); /* @Y30SSDW*/ 83100037 ANS ('GEN(USING *,12);') SKIP COL(12); 84000000 ANS ('/* INDICATE AVAILABLE BASE REG */') 84050037 COL(37); /* @Y30SSDW*/ 84100037 IF IGGBASE2 ^= '' THEN/*BASE REG 2 SPECIFIED? @ZA95164*/ 84150037 DO; /* YES @ZA95164*/ 84200037 ANS ('GEN(USING *+4095,'||IGGBASE2||');') 84250037 SKIP COL(12); /*GEN USING FOR 2ND BASE @ZA95164*/ 84300037 ANS('/* INDICATE AVAILABLE BASE REGS */') COL(37); 84350037 ANS('GEN(LA '||IGGBASE2||',4095(0,12));') COL(37); 84400037 ANS('/* LOAD BAS 2 REG */') COL(37);/* @ZA95164*/ 84450037 END; /* @ZA95164*/ 84500037 ELSE; /* @ZA95164*/ 84550037 PQ: IGGGVCCT = CBSW ; /*IND. OUTER OR INNER PROC */ 84600037 RETURN; 84650037 END; 84700037 ELSE /* INTERNALLY CALLED @ZA95164*/ 84750037 GOTO PQ; /* ALL FINISHED @ZA95164*/ 84800037 IF IESW = 'EXT' THEN /*EXTERNALLY CALLED */ 84850037 DO; /* YES @ZA29164*/ 84870037 IF IGGFPINT='1' THEN /* FIRST PROC INTERNAL @ZA29164*/ 84900037 BEGLABEL='@MAINENT'; /* SET LABEL @ZA29164*/ 84910037 ELSE /* FIRST PROC EXTERNAL @ZA29164*/ 84920037 BEGLABEL='IGGSEGST'; /* SET LABEL @ZA29164*/ 84930037 IF IGGBASE2 = '' THEN /*EXTERNALLY CALLED? @ZA95164*/ 84940037 DO; /* NO, ONLY 1 BASE REG @ZA95164*/ 84950037 ANS ('GEN(LA 15,*-'||BEGLABEL||'(0,0));') 84960037 SKIP COL(12); /* @ZA95164*/ 85050037 ANS ('/* COMPUTE MODULE BASE */') 85100037 COL(41); /* @ZA95164*/ 85150037 ANS ('GEN(SR 12,15);') SKIP COL(12); /*@ZA95164*/ 85200037 ANS ('/* SET BASE TO MODULE BASE */') 85250037 COL(41); /* @ZA95164*/ 85300037 END; /*@ZA95164*/ 85350037 ELSE /* YES,BASE 2 REG SPEC @ZA95164*/ 85400037 DO; /* @ZA95164*/ 85450037 ANS ('GEN(USING *,12);') SKIP COL(12);/* @ZA95164*/ 85500037 ANS ('/* INDICATE AVAILABLE BASE REG */') 85550037 COL(37); /* @ZA95164*/ 85600037 ANS('GEN(B *+6);') SKIP COL(12); /* @ZA95164*/ 85650037 ANS('/* BRANCH AROUND CONSTANT */')COL(37); /*@ZA95164*/ 85700037 ANS('GEN(DC AL2(*-'||BEGLABEL||'-4));') /* @ZA95164*/ 85750037 COL(12); /* @ZA29164*/ 85760037 ANS('/* OFFSET TO MODULE BASE 1*/')COL(37);/*@ZA95164*/ 85800037 ANS('GEN(SH 12,*-2);') COL(12); /*@ZA95164*/ 85850037 ANS('/* COMPUTE MODULE BASE 1 */')COL(37);/*@ZA95164*/ 85900037 ANS('GEN(LA '||IGGBASE2||',4095(0,12));') 85950037 COL(12); /* @ZA95164*/ 86000037 ANS('/* LOAD BASE 2 REG WITH 4095 */')COL(37);/*@ZA95164*/ 86050037 ANS('GEN(USING '||BEGLABEL||',12);') SKIP /*@ZA95164*/ 86100037 COL(12); /* @ZA29164*/ 86130037 ANS('/* INDICATE AVAILABLE BASE REG1 */') 86160037 COL(41); /* @ZA95164*/ 86190037 ANS('GEN(USING '||BEGLABEL||'+4095,'||IGGBASE2||');') 86220037 SKIP COL(12); /* @ZA95164*/ 86300037 ANS('/* INDICATE AVAILABLE BASE REG2 */') 86350037 COL(37); /* @ZA95164*/ 86400037 END; /* @ZA95164*/ 86450037 IGGGVCCT = '3' ; /*IND. NOT 1ST INNER PROC */ 86500037 END; /* @ZA29164*/ 86550037 % END ; 86600037