/* ALP -- ASSEMBLY LANGUAGE PREPROCESSOR -- VERSION 6.19 -- 04/02/88 */00001000 (SUBRG): /* CHECK SUBSCRIPTS */ /*RAF-3*/ 00001500 ALP: 00002000 PROCEDURE OPTIONS(MAIN) REORDER; 00003000 /*RAF-24*/ 00003100 DECLARE PLIXOPT CHAR(32) VARYING STATIC EXTERNAL /*RAF-24*/ 00003200 INIT('ISASIZE(70K)'); /*RAF-40*/ /*RAF-24*/ 00003300 /*RAF-24*/ 00003400 DEFAULT RANGE(*) ALIGNED; /*RAF-46*/ 00003500 /*RAF-46*/ 00003600 /* 00004000 INTERNAL PROCEDURES: 00005000 ALP (MAIN CONTROL PROGRAM) 00006000 STMNT 00007000 GROUP 00008000 CEND,CIF,CCASE,CWHILE,CDO,CFOR,CFOREVER,CGOTO,CEXIT,CNEXT, 00009000 CUSE,CASMIF,CMACRO,CBAL,CPCASE,ALCSTMT 00010000 PRED,GB 00011000 WLABEL,WFLUSH 00012000 GENSYM 00013000 00014000 INPUT (INPUT SCANNING PROCEDURES) 00015000 RWORD,ROPANDS 00016000 RCHECK,RCHAR 00017000 SKIP,INC,ALPHANUM 00018000 00019000 ERROR,OUTPUT 00020000 00021000 INPUT/OUTPUT CONVENTIONS: 00022000 00023000 INPUT FILE: 00024000 SYSIN -- CARDS IN ALP LANGUAGE 00025000 00026000 OUTPUT FILES: 00027000 SYSOUT -- CARD IMAGES FOR BAL ASSEMBLER 00028000 SYSPRINT -- INPUT IMAGES AND MESSAGES 00029000 SYSTERM -- MESSAGE DATA SET 00030000 */ 00031000 1 00032000 %DECLARE (#TRUE,#FALSE,#DUMMY) CHARACTER; 00033000 %#TRUE='''1''B'; 00034000 %#FALSE='''0''B'; 00035000 %#DUMMY='''0''B'; 00036000 %DECLARE (@OUTER_PREDICATE,@INNER_PREDICATE) CHARACTER; 00037000 %@OUTER_PREDICATE='''1''B'; 00038000 %@INNER_PREDICATE='''0''B'; 00039000 %DECLARE (@USE_NEGATED,@USE_TRUTH) CHARACTER; 00040000 %@USE_NEGATED='''1''B'; 00041000 %@USE_TRUTH='''0''B'; 00042000 %DECLARE (@B,@BR) CHARACTER; 00043000 %@B='''0''B'; 00044000 %@BR='''1''B'; 00045000 00046000 %DECLARE CALLINC CHARACTER; 00047000 %CALLINC = ' DO; ' 00048000 || ' IF COL>72 THEN CALL INC; ' 00049000 || ' COL = COL+1; ' 00050000 || ' IF COL=73 THEN ' 00051000 || ' CHAR= '' '';' 00052000 || ' ELSE ' 00053000 || ' CHAR=SUBSTR(CARDIN,COL,1); ' 00054000 || ' END '; 00055000 /*RAF-41*/ 00055100 % ALPHANUM: PROCEDURE(CHAR) RETURNS(CHARACTER); /*RAF-41*/ 00055200 DECLARE CHAR CHARACTER; /*RAF-41*/ 00055300 RETURN('(('||CHAR||')>=''A'' | ('||CHAR||')=''$'' | '|| /*RAF-41*/ 00055400 '('||CHAR||')=''#'' | ('||CHAR||')=''@'')'); /*RAF-41*/ 00055500 % END ALPHANUM; /*RAF-41*/ 00055600 % ACTIVATE ALPHANUM; /*RAF-41*/ 00055700 00056000 %GEN: PROCEDURE(OPERATION,OPERANDS) RETURNS(CHARACTER); 00057000 DECLARE (OPERATION,OPERANDS) CHARACTER; 00058000 DECLARE STRING CHARACTER; 00059000 STRING='DO; '; 00060000 IF OPERATION ^= '''''' THEN 00061000 STRING = STRING||'C_OPERATION = '||OPERATION||';'; 00062000 IF OPERANDS ^= '''''' THEN 00063000 STRING = STRING||' GEN_OPERANDS('||OPERANDS||');'; /*RAF-11*/ 00064000 ELSE STRING = STRING||' CALL WFLUSH;'; /*RAF-11*/ 00064500 RETURN(STRING||' END '); /*RAF-11*/ 00065000 %END GEN; 00066000 %ACTIVATE GEN; 00067000 00068000 %GEN_OPERANDS: PROCEDURE(OPERANDS) RETURNS(CHARACTER); /*RAF-11*/ 00069000 DECLARE OPERANDS CHARACTER; /*RAF-11*/ 00070000 RETURN(' DO; ' /*RAF-11*/ 00071000 || ' OP_SAVE = '||OPERANDS||';' /*RAF-11*/ 00072000 || ' C_OPERANDS = OP_SAVE;' /*RAF-11*/ 00073000 || ' DO OP_COUNT=53 TO LENGTH(OP_SAVE) BY 56;' /*RAF-11*/ 00074000 || ' C_CONTINUE = ''*'';' /*RAF-11*/ 00075000 || ' CALL WFLUSH;' /*RAF-11*/ 00076000 || ' C_DATA = '''';' /*RAF-11*/ 00077000 || ' C_CONT_OPERANDS = SUBSTR(OP_SAVE,OP_COUNT);' /*RAF-11*/ 00078000 || ' END;' /*RAF-11*/ 00079000 || ' CALL WFLUSH;' /*RAF-11*/ 00080000 || ' END'); /*RAF-11*/ 00081000 /*RAF-11*/ 00082000 /*RAF-11*/ 00083000 /*RAF-11*/ 00084000 /*RAF-11*/ 00085000 %END GEN_OPERANDS; 00086000 %ACTIVATE GEN_OPERANDS; 00087000 1 00088000 /* "ALP" "INPUT" INTERFACE */ 00089000 DECLARE 00090000 INAL FIXED BIN INIT(2), 00091000 ENDFLG BIT(1) INIT(#FALSE), ENDMARK CHAR(8) STATIC, 00092000 SYSIN FILE RECORD INPUT, 00093000 CHAR CHAR(1) INIT(' ') , /* ALWAYS CONTAINS THE CHARACTER 00094000 POINTED TO BY THE INPUT POINTER */ 00095000 WORD CHAR(8) VARYING, WORDAL BIT(1), /* SET BY RWORD*/ 00096000 OPANDS CHAR(2000) VARYING, /* SET BY ROPANDS */ /*RAF-44*/ 00097000 CARDIN CHAR(80) UNALIGNED, /* INPUT BUFFER*/ /*RAF-46*/ 00098000 CIN_DATA CHAR(72) POS(1) DEF CARDIN UNALIGNED, /*RAF-46*/ 00099000 CIN_ID CHAR(8) POS(73) DEF CARDIN UNALIGNED, /*RAF-46*/ 00100000 CIN_2COLS CHAR(2) POS(1) DEF CARDIN UNAL, /*RAF-46*/ /*RAF-9*/ 00100500 COL FIXED BIN INIT(80); /* INPUT COLUMN WITHIN CARDIN */ 00101000 00102000 /* "ALP" "OUTPUT" INTERFACE" */ 00103000 DECLARE 00104000 SYSPRINT FILE PRINT ENV(FB,RECSIZE(133)), /*RAF-19*/ 00105000 SYSTERM FILE OUTPUT ENV(FB,RECSIZE(121),BLKSIZE(121)), 00106000 SYSOUT FILE RECORD OUTPUT ENV(FB,RECSIZE(80),TOTAL),/*RAF-19*/ 00107000 CARDOUT CHAR(80) INIT(' ') UNAL, /*OUTPUT BUFFER*/ /*RAF-46*/ 00108000 C_LABEL CHAR(8) POS(1) DEF CARDOUT UNALIGNED, /*RAF-46*/ 00109000 COL_1 CHAR(1) POS(1) DEF CARDOUT UNALIGNED, /*RAF-46*/ 00110000 C_DATA CHAR(72) POS(1) DEF CARDOUT UNALIGNED, /*RAF-46*/ 00111000 COUT_ID CHAR(8) POS(73) DEF CARDOUT UNALIGNED, /*RAF-46*/ 00112000 C_OPERATION CHAR(8) POS(10) DEF CARDOUT UNALIGNED, /*RAF-46*/ 00113000 C_OPERANDS CHAR(52) POS(20) DEF CARDOUT UNALIGNED, /*RAF-46*/ 00114000 C_CONTINUE CHAR(1) POS(72) DEF CARDOUT UNALIGNED, /*RAF-46*/ 00115000 C_CONT_OPERANDS CHAR(56) POS(16) DEF CARDOUT UNAL, /*RAF-46*/ 00116000 OP_COUNT FIXED BIN, /*RAF-11*/ 00116100 OP_SAVE CHAR(2000) VARYING, /*RAF-44*/ /*RAF-11*/ 00116200 GENNUM FIXED DEC(5) INIT(10000) STATIC; 00117000 00118000 DECLARE 00119000 ERRCNT FIXED BIN INIT(0), 00120000 (BRANCH_LAST,IN_MACRO,SUBTITL,LABEL_WRITTEN) BIT(1) INIT(#FALSE), 00121000 NESTLEV FIXED BIN INIT(0),NESTID(75) CHAR(8), 00122000 DOLEV FIXED BIN INIT(0), 00123000 (EXID(75),DOID(75),DOLABEL(75)) CHAR(8) VARYING, 00124000 ASMDOLEV FIXED BIN INIT(0), /*RAF-9*/ 00124100 (ASMEXID(75),ASMDOID(75),ASMDOLABEL(75)) /*RAF-9*/ 00124200 CHAR(8) VARYING, /*RAF-9*/ 00124300 PREDLABLEV FIXED BIN INIT(0), /*RAF-6*/ 00125000 PREDLABSTK(100,2) CHAR(14) VARYING, /*RAF-49*/ /*RAF-6*/ 00125500 PREDBTYPE(50) CHAR(1), /*RAF-6*/ 00126000 SYMLEV FIXED BIN INIT(0),SYMSTK(3000) CHAR(8) VARYING,/*RAF-38*/ 00127000 LABLEV FIXED BIN INIT(0),LABSTK(50) CHAR(8) VARYING,/*RAF-42*/ 00128000 EQVLEV FIXED BIN INIT(0), /*RAF-37*/ 00129000 EQVSTK(100,2) CHAR(10) VARYING; /*RAF-37*/ 00129500 00130000 DECLARE 00131000 DTE CHAR(6),TIM CHAR(9),TIME_STAMP CHAR(20), 00132000 PAGECNT FIXED BIN INIT(0), 00133000 DECKNAME CHAR(8) INIT(' '), 00134000 TITLE CHAR(72) INIT( 00135000 'A L P : A S S E M B L E R P R E P R O C E S S O R .' 00136000 ), 00137000 SUBTITLE CHAR(72) INIT(' '); 00138000 0 00139000 /* "ALP" RETURN CODE */ 00140000 DECLARE 00141000 RETCODE FIXED BINARY(31) INIT(0); 00142000 1 00143000 DECLARE 00144000 PREDICATES (18,2) CHAR(8) STATIC INIT( 00145000 'OPENP' , 'NZ' , /* TM */ 00146000 'TM' , 'NZ', /* ANY SELECTED BIT ON */ 00147000 'TS' , 'NZ', 00148000 'TF' , 'NZ', 00149000 'TRT' , 'NZ', 00150000 'RM' , 'M' , /* REGISTER TESTS */ 00151000 'RZ' , 'Z' , 00152000 'RP' , 'P' , 00153000 'RMZ' , 'NP', 00154000 'RMP' , 'NZ', 00155000 'RZP' , 'NM', 00156000 'RNM' , 'NM', 00157000 'RNZ' , 'NZ', 00158000 'RNP' , 'NP', 00159000 'RNMZ' , 'P' , 00160000 'RNMP' , 'Z' , 00161000 'RNZP' , 'M' , 00162000 '***' , 'E'), /* DEFAULT: TRUTH IS EQUAL */ 00163000 00164000 1 CCTAB STATIC, 00165000 2 IVAL(19) INIT((3)0, (5)8, (4)4, (4)2, (3)1), 00166000 2 LET CHAR(19) INIT(' N^ 0=EZ 1LM 2PH 3O'), 00167000 00168000 OPTAB (16) CHAR(10) STATIC INIT( 00169000 'BC 0,', 00170000 'BO', 00171000 'BH', 00172000 'BC 3,', 00173000 'BL', 00174000 'BC 5,', 00175000 'BC 6,', 00176000 'BNE', 00177000 'BE', 00178000 'BC 9,', 00179000 'BC 10,', 00180000 'BNL', 00181000 'BC 12,', 00182000 'BNH', 00183000 'BNO', 00184000 'BC 15,' ); 00185000 1 00186000 ON ENDFILE(SYSIN) GO TO MAIN_END ; 00187000 00188000 OPEN FILE(SYSPRINT) LINESIZE(132); /*RAF-19*/ 00188500 ON ENDPAGE(SYSPRINT) 00189000 BEGIN; 00190000 PAGECNT = PAGECNT+1; 00191000 PUT PAGE FILE(SYSPRINT) 00192000 EDIT(DECKNAME,TITLE,TIME_STAMP,'PAGE ',PAGECNT,SUBTITLE) 00193000 (A(8),A(72),X(9),A(20),X(3),A(5),P'ZZ9',SKIP,X(8),A(72)); 00194000 PUT SKIP(2) FILE(SYSPRINT); 00195000 SUBTITL = #FALSE; 00196000 END; 00197000 00198000 OPEN FILE(SYSTERM); PUT SKIP FILE(SYSTERM); CLOSE FILE(SYSTERM); 00199000 OPEN FILE(SYSOUT); /*RAF-19*/ 00200000 00201000 DTE = DATE() ; TIM = TIME() ; 00202000 TIME_STAMP = SUBSTR(DTE,3,2)||'/'|| 00203000 SUBSTR(DTE,5,2)||'/'|| 00204000 SUBSTR(DTE,1,2)||' '|| 00205000 SUBSTR(TIM,1,2)||':'|| 00206000 SUBSTR(TIM,3,2)||':'|| 00207000 SUBSTR(TIM,5,2) ; 00208000 00209000 PUT SKIP FILE(SYSTERM) EDIT('*ALP*',TIME_STAMP) (A,X(2),A); 00210000 SIGNAL ENDPAGE(SYSPRINT); 00211000 1 00212000 MAIN_LOOP: 00213000 DO WHILE(#TRUE); /* MAIN PROGRAM LOOP*/ 00214000 CALL STMNT ; 00215000 IF ^RCHAR(';') THEN 00216000 CALL ERROR ('MA10: MISSING SEMICOLON INSERTED.') ; 00217000 CALL EQVFLUSH(#FALSE,1); 00218000 END MAIN_LOOP ; 00219000 00220000 MAIN_END : 00221000 CALL EQVFLUSH(#TRUE,1); 00222000 IF ^ENDFLG THEN 00223000 CALL ERROR('MAIN: MISSING "END" AT END OF PROGRAM.'); 00224000 WORD = 'END'; 00225000 COL = 1; 00226000 SUBSTR(CARDIN,1,1),CHAR = ';'; 00227000 CALL ALCSTMT; 00228000 IF NESTLEV^=0 THEN 00229000 DO; 00230000 CALL OUTPUT(' '); 00231000 CALL OUTPUT('MISSING "END"/">" FOR "BEGIN"/"<" AT:'); 00232000 DO NESTLEV = NESTLEV TO 1 BY -1; 00233000 CALL OUTPUT(NESTID(NESTLEV)); 00234000 END; 00235000 RETCODE=8; 00236000 END; 00237000 CALL OUTPUT(' '); 00238000 IF ERRCNT = 0 THEN 00239000 CALL OUTPUT('NO ALP STATEMENTS FLAGGED.'); 00240000 ELSE 00241000 IF ERRCNT = 1 THEN 00242000 CALL OUTPUT('1 ALP STATEMENT FLAGGED.'); 00243000 ELSE 00244000 CALL OUTPUT(ERRCNT||' ALP STATEMENTS FLAGGED.'); 00245000 CALL OUTPUT(' '); 00246000 CLOSE FILE(SYSTERM),FILE(SYSPRINT),FILE(SYSOUT),FILE(SYSIN); 00247000 CALL PLIRETC(RETCODE); 00248000 RETURN ; 00249000 1 00250000 STMNT: /* PROCESS ONE STATEMENT (SIMPLE OR COMPOUND) */ 00251000 PROCEDURE RECURSIVE ; 00252000 DCL 00253000 SAVID CHAR(8); 00254000 00255000 ST: 00256000 CALL RLABEL ; 00257000 IF ENDFLG THEN 00258000 DO; 00259000 CALL ERROR('ST10: EXTRANEOUS OR LABELED "END" AT ' 00260000 ||ENDMARK||' IGNORED.'); 00261000 ENDFLG = #FALSE; 00262000 END; 00263000 IF WORD = ';' THEN 00264000 RETURN; 00265000 SAVID = CIN_ID; 00266000 IF ^WORDAL THEN 00267000 IF WORD = '<' THEN 00268000 DO; 00269000 CALL GROUP(#FALSE,SAVID); 00270000 RETURN; 00271000 END; 00272000 ELSE 00273000 DO; 00274000 CALL ERROR('ST15: "'||WORD||'" OUT OF CONTEXT, IGNORED.');00275000 GO TO ST; 00276000 END; 00277000 00278000 /* WORD IS A SYMBOL */ 00279000 IF WORD = 'BEGIN' THEN 00280000 DO; 00281000 CALL GROUP(#TRUE,SAVID); 00282000 RETURN; 00283000 END; 00284000 ELSE 00285000 IF RCHAR(':') THEN 00286000 DO; 00287000 CALL WLABEL(WORD); 00288000 GO TO ST; 00289000 END; 00290000 1 00291000 /* IDENTIFY ALP INSTRUCTIONS */ 00292000 IF WORD = 'IF' THEN 00293000 CALL CIF ; 00294000 ELSE 00295000 IF WORD = 'CASE' THEN 00296000 CALL CCASE ; 00297000 ELSE 00298000 IF WORD = 'WHILE' THEN 00299000 CALL CWHILE(#FALSE) ; 00300000 ELSE 00301000 IF WORD = 'UNTIL' THEN 00302000 CALL CWHILE(#TRUE); 00303000 ELSE 00304000 IF WORD = 'DO' THEN 00305000 CALL CDO; 00306000 ELSE 00307000 IF WORD = 'FOR' THEN 00308000 CALL CFOR; 00309000 ELSE 00310000 IF WORD = 'FOREVER' THEN 00311000 CALL CFOREVER; 00312000 ELSE 00313000 IF WORD = 'GOTO' THEN 00314000 CALL CGOTO(#FALSE); 00315000 ELSE 00316000 IF WORD = 'RGOTO' THEN 00317000 CALL CGOTO(#TRUE); 00318000 ELSE 00319000 IF WORD = 'EXIT' THEN 00320000 CALL CEXIT; 00321000 ELSE 00322000 IF WORD = 'USE' THEN 00323000 CALL CUSE; 00324000 ELSE 00325000 IF WORD = 'BAL' THEN 00326000 DO; 00327000 IF RCHAR(';') THEN 00328000 CALL CBAL; 00329000 ELSE 00330000 CALL ALCSTMT; 00331000 END; 00332000 ELSE IF WORD = 'COMMENT' THEN /*RAF-10*/ 00332100 DO; /*RAF-10*/ 00332200 IF RCHAR(';') THEN /*RAF-10*/ 00332300 CALL CCOMMENT; /*RAF-10*/ 00332400 ELSE /*RAF-10*/ 00332500 CALL ALCSTMT; /*RAF-10*/ 00332600 END; /*RAF-10*/ 00332700 ELSE IF WORD='DATA' THEN /*RAF-36*/ 00332800 CALL CDATA; /*RAF-36*/ 00332900 ELSE 00333000 IF WORD = 'END' THEN 00334000 CALL CEND(SAVID); 00335000 ELSE 00336000 IF WORD = 'NEXT' THEN 00337000 CALL CNEXT; 00338000 ELSE 00339000 IF WORD='ASM' THEN /*RAF-9*/ 00339100 CALL CASM; /*RAF-9*/ 00339200 ELSE /*RAF-9*/ 00339300 IF WORD = 'ASMIF' THEN 00340000 CALL CASMIF; 00341000 ELSE 00342000 IF WORD = 'MACRO' THEN 00343000 CALL CMACRO; 00344000 ELSE 00345000 IF WORD = 'SELECT' THEN 00346000 CALL CSELECT; 00347000 1 00348000 ELSE 00349000 IF WORD='THEN' 00350000 | WORD='ELSE' 00351000 | WORD='MEND' /*RAF-8*/ 00352000 | WORD='ENDMACRO' /*RAF-8*/ 00352500 | WORD='ENDSEL' 00353000 | WORD='ENDCASE' THEN 00354000 DO; 00355000 CALL ERROR('ST25: INVALID "'||WORD||'" IGNORED.');00356000 GOTO ST; 00357000 END; 00358000 ELSE 00359000 CALL ALCSTMT; 00360000 RETURN ; 00361000 END STMNT ; 00362000 - 00363000 /* PROCESS STATEMENT "GROUP" */ 00364000 GROUP: 00365000 PROCEDURE(BEGTYPE,CARDID) RECURSIVE ; 00366000 DECLARE 00367000 BEGTYPE BIT(1), 00368000 CARDID CHAR(8); 00369000 00370000 NESTLEV=NESTLEV+1; 00371000 NESTID(NESTLEV)=CARDID; 00372000 GRLOOP: 00373000 DO WHILE(#TRUE) ; 00374000 IF ^BEGTYPE THEN DO; /*RAF-7*/ 00375000 IF RCHAR('>') THEN GO TO GROUT; /*RAF-7*/ 00375500 END; /*RAF-7*/ 00376000 ELSE IF RCHECK('END') THEN GO TO GROUT; /*RAF-7*/ 00376500 CALL STMNT ; 00377000 IF ENDFLG THEN /*RAF-7*/ 00377100 DO; /*RAF-7*/ 00377200 CALL ERROR('GR11: EXTRANEOUS OR LABELED "END"' /*RAF-7*/ 00377300 ||' AT '||ENDMARK||' IGNORED.'); /*RAF-7*/ 00377400 ENDFLG = #FALSE; /*RAF-7*/ 00377500 END; /*RAF-7*/ 00377600 IF ^BEGTYPE THEN DO; /*RAF-7*/ 00378000 IF RCHAR('>') THEN GO TO GROUT; /*RAF-7*/ 00378500 END; /*RAF-7*/ 00379000 ELSE IF RCHECK('END') THEN GO TO GROUT; /*RAF-7*/ 00379500 IF ^RCHAR (';') THEN 00380000 CALL ERROR('GR10: MISSING SEMICOLON INSERTED.'); 00381000 END GRLOOP; 00382000 GROUT: 00383000 NESTLEV=NESTLEV-1; 00384000 IF NESTLEV=0 THEN PREDLABLEV=0; /*RAF-6*/ 00384500 RETURN; 00385000 END GROUP ; 00386000 1 00387000 /* END */ 00388000 00389000 CEND: 00390000 PROCEDURE(ENDID); 00391000 DCL 00392000 ENDID CHAR(8); 00393000 00394000 ENDFLG = #TRUE; 00395000 ENDMARK = ENDID; 00396000 RETURN; 00397000 END CEND; 00398000 1 00399000 /* IF THEN | 00400000 IF THEN ELSE */ 00401000 00402000 CIF: 00403000 PROCEDURE RECURSIVE ; 00404000 DECLARE 00405000 (THENPART,ELSEPART,SKIPLABEL) CHAR(8) VARYING; 00406000 00407000 THENPART = ''; 00408000 ELSEPART = GENSYM; 00409000 CALL PREDICATE(THENPART,ELSEPART,@OUTER_PREDICATE, 00410000 #DUMMY,@USE_TRUTH,#DUMMY,@B); 00411000 IF ^RCHECK('THEN') THEN 00412000 CALL ERROR('CIF: "THEN" INSERTED AFTER "'||WORD||'".'); 00413000 CALL STMNT; /* THEN CLAUSE */ 00414000 IF RCHECK('ELSE') THEN 00415000 DO ; /* ELSE CLAUSE */ 00416000 SKIPLABEL = GENSYM; 00417000 GEN('B',SKIPLABEL); 00418000 CALL WLABEL(ELSEPART) ; 00419000 CALL STMNT; /* ELSE CLAUSE */ 00420000 CALL WLABEL(SKIPLABEL) ; 00421000 END; 00422000 ELSE /* NO ELSE CLAUSE */ 00423000 CALL WLABEL(ELSEPART); 00424000 RETURN; 00425000 END CIF ; 00426000 1 00427000 /* CASE MAX ; 00428000 00429000 ENDCASE */ 00430000 00431000 CCASE: 00432000 PROCEDURE RECURSIVE; 00433000 DECLARE 00434000 (REGID,CLABELB,CLABELI,CLABELE,TLABEL) CHAR(8) VARYING, 00435000 ELSEPART CHAR(8) VARYING INIT(''), /*RAF-32*/ 00435100 MINCASE CHAR(80) VARYING INIT('(0)'), /*RAF-32*/ 00435200 MAXCASE CHAR(80) VARYING INIT(''), /*RAF-32*/ 00435300 (CLOW,CHIGH) CHAR(80) VARYING, /*RAF-32*/ 00436000 (EMSG1 CHAR(72) INIT( /*RAF-32*/ 00437000 '* ERROR IF CASE RANGE NOT A MULTIPLE OF FOUR:'), /*RAF-32*/ 00438000 EMSG2 CHAR(72) INIT( /*RAF-32*/ 00439000 '* ERROR IF ORDER OF "THRU" CASES IS INVALID:'), 00440000 EMSG3 CHAR(72) INIT('* ERROR IF CASE OUT OF RANGE:'), /*RAF-32*/ 00441000 EMSG4 CHAR(72) INIT('* ERROR IF CASE NOT A MULTIPLE OF FOUR:'), 00442000 EMSG5 CHAR(72) INIT( /*RAF-32*/ 00442100 '* ERROR IF CASE RANGE NOT GREATER THAN ZERO:') /*RAF-32*/ 00442200 ) STATIC; 00443000 00444000 CALL ROPANDS(#TRUE); /*RAF-32*/ 00445000 IF OPANDS='' THEN /*RAF-32*/ 00446000 DO; 00447000 CALL ERROR('CCASE: NO REGISTER ID FOR CASE STATEMENT.'); 00448000 OPANDS='0'; /*RAF-32*/ /*RAF-8*/ 00449000 END; 00450000 REGID = OPANDS; /*RAF-32*/ 00451000 /* IF ^RCHECK('MAX') THEN */ /*RAF-32*/ /* 00452000 CALL ERROR('CCASE: "MAX" INSERTED AFTER "'||REGID||'".'); 00453000 CALL RWORD; 00454000 IF ^WORDAL THEN 00455000 DO; 00456000 CALL ERROR('CCASE: MISSING MAXIMUM CASE INDICATION.'); 00457000 RETURN; 00458000 END; */ /*RAF-32*/ 00459000 DO WHILE('1'B); /*RAF-32*/ 00459020 IF RCHECK('MAX') THEN DO; /*RAF-32*/ 00459040 CALL ROPANDS(#TRUE); /*RAF-32*/ 00459060 MAXCASE='('||OPANDS||')'; /*RAF-32*/ 00459080 END; /*RAF-32*/ 00459100 ELSE IF RCHECK('MIN') THEN DO; /*RAF-32*/ 00459120 CALL ROPANDS(#TRUE); /*RAF-32*/ 00459140 MINCASE='('||OPANDS||')'; /*RAF-32*/ 00459160 END; /*RAF-32*/ 00459180 ELSE IF RCHECK('CHECK') THEN DO; /*RAF-32*/ 00459200 ELSEPART=GENSYM; /*RAF-32*/ 00459220 END; /*RAF-32*/ 00459240 ELSE DO; /*RAF-32*/ 00459260 IF ^RCHAR(';') THEN /*RAF-32*/ 00459280 CALL ERROR('CCASE: MISSING SEMICOLON INSERTED'); /*RAF-32*/ 00459300 GO TO CASEBODY; /*RAF-32*/ 00459320 END; /*RAF-32*/ 00459340 END; /*RAF-32*/ 00459360 CASEBODY: /*RAF-32*/ 00459380 IF MAXCASE='' THEN DO; /*RAF-32*/ 00459400 CALL ERROR('CCASE: MAX MUST BE SPECIFIED'); /*RAF-32*/ 00459420 MAXCASE=MINCASE; /*RAF-32*/ 00459440 END; /*RAF-32*/ 00459460 CLABELE = ''; /*RAF-32*/ 00460000 DOLEV = DOLEV+1; 00461000 EXID(DOLEV) = ''; /*RAF-8*/ 00462000 DOID(DOLEV) = GENSYM; /*RAF-15*/ 00463000 DOLABEL(DOLEV) = CURLAB; 00464000 /* MAXCASE = WORD; */ /*RAF-32*/ /* 00465000 DO WHILE(^RCHAR(';')); 00466000 CALL RWORD; 00467000 MAXCASE = MAXCASE||WORD; 00468000 END; 00469000 MAXCASE='('||MAXCASE||')'; */ /*RAF-32*/ 00470000 CLABELB = GENSYM; 00471000 CALL WLABEL(DOID(DOLEV)); /*RAF-15*/ 00471500 IF ELSEPART^='' THEN DO; /*RAF-32*/ 00471520 GEN('C',REGID||',=A'||MAXCASE); /*RAF-32*/ 00471540 GEN('BH',ELSEPART); /*RAF-32*/ 00471560 IF MINCASE='(0)' THEN DO; /*RAF-32*/ 00471580 GEN('LTR',REGID||','||REGID); /*RAF-32*/ 00471600 GEN('BM',ELSEPART); /*RAF-32*/ 00471620 END; /*RAF-32*/ 00471640 ELSE DO; /*RAF-32*/ 00471660 GEN('C',REGID||',=A'||MINCASE); /*RAF-32*/ 00471680 GEN('BL',ELSEPART); /*RAF-32*/ 00471700 END; /*RAF-32*/ 00471720 END; /*RAF-32*/ 00471740 GEN('B',CLABELB||'-'||MINCASE||'('||REGID||')'); /*RAF-32*/ 00472000 C_DATA=EMSG1; 00473000 CALL WFLUSH; 00474000 GEN('DS','0CL(1+('||MAXCASE||'-'||MINCASE||')/4*4-'|| /*RAF-32*/ 00475000 MAXCASE||'+'||MINCASE||')'); /*RAF-32*/ 00475100 C_DATA=EMSG5; /*RAF-32*/ 00475200 CALL WFLUSH; /*RAF-32*/ 00475300 GEN('DS','0CL('||MAXCASE||'-'||MINCASE||')'); /*RAF-32*/ 00475400 CALL WLABEL(CLABELB); 00476000 IF ELSEPART='' THEN DO; /*RAF-32*/ 00476500 GEN('DC','(('||MAXCASE||'-'||MINCASE||')/4+1)'|| /*RAF-32*/ 00477000 'H''0,0'''); /*RAF-32*/ 00477100 END; /*RAF-32*/ 00477200 ELSE DO; /*RAF-32*/ 00477300 GEN('DC','(('||MAXCASE||'-'||MINCASE||')/4+1)'|| /*RAF-32*/ 00477400 'S(X''7F0''(4),'||ELSEPART||')'); /*RAF-32*/ 00477500 END; /*RAF-32*/ 00477600 1 00478000 NESTLEV = NESTLEV+1; 00479000 NESTID(NESTLEV) = CIN_ID; 00480000 /* CALL RWORD; */ /*RAF-32*/ 00481000 DO WHILE(^RCHECK('ENDCASE')); /*RAF-32*/ 00482000 IF CLABELE='' /*RAF-32*/ 00482100 THEN CLABELE=GENSYM; /*RAF-32*/ 00482200 ELSE GEN('B',CLABELE); /*RAF-32*/ 00482300 TLABEL = GENSYM; 00483000 CLABELI = GENSYM; 00484000 CALL WLABEL(TLABEL); 00485000 GEN('DS','0H'); 00486000 DO WHILE('1'B); /*RAF-32*/ 00487000 /* CLOW,CHIGH = ''; */ /*RAF-32*/ /* 00488000 DO WHILE(WORD^='THRU' & WORD^=',' & WORD^=':' & WORD^=';'); 00489000 CLOW = CLOW||WORD; 00490000 CALL RWORD; 00491000 END; 00492000 CLOW='('||CLOW||')'; */ /*RAF-32*/ 00493000 CALL ROPANDS(#TRUE); /*RAF-32*/ 00493100 CLOW='('||OPANDS||')'; /*RAF-32*/ 00493200 CHIGH=''; /*RAF-32*/ 00493300 IF RCHECK('THRU') THEN /*RAF-32*/ 00494000 DO ; 00495000 /* CALL RWORD ; */ /*RAF-32*/ /* 00496000 DO 00497000 WHILE(WORD ^= ',' & WORD ^= ':' & WORD ^= ';'); 00498000 CHIGH = CHIGH||WORD; 00499000 CALL RWORD ; 00500000 END; */ /*RAF-32*/ 00501000 CALL ROPANDS(#TRUE); /*RAF-32*/ 00501100 CHIGH='('||OPANDS||')'; /*RAF-32*/ 00501200 END ; 00502000 /* IF CHIGH^='' THEN */ /*RAF-32*/ 00503000 /* CHIGH='('||CHIGH||')'; */ /*RAF-32*/ 00504000 IF RCHAR(';') THEN /*RAF-32*/ 00505000 DO; 00506000 CALL ERROR('CCASE: '|| 00507000 'MISSING CASE LABEL, CASE IGNORED.'); 00508000 GO TO NOCASE; /*RAF-32*/ 00509000 END; 00510000 1 00511000 ELSE 00512000 DO; 00513000 C_DATA=EMSG3; 00514000 CALL WFLUSH; 00515000 GEN('DS','0CL(1+'||MAXCASE||'-'||CLOW||'),' /*RAF-5*/ 00516000 ||'0CL(1+'||CLOW||'-'||MINCASE||')'); /*RAF-32,RAF-5*/ 00516100 C_DATA=EMSG4; 00517000 CALL WFLUSH; 00518000 GEN('DS','0CL(1+('||CLOW||'-'||MINCASE|| /*RAF-32*/ 00519000 ')/4*4-'||CLOW||'+'||MINCASE||')'); /*RAF-32*/ 00519100 IF CHIGH^='' THEN 00520000 DO; 00521000 C_DATA=EMSG2; 00522000 CALL WFLUSH; 00523000 GEN('DS','0CL(1+'||CHIGH||'-'||CLOW||')'); 00524000 C_DATA=EMSG3; 00525000 CALL WFLUSH; 00526000 GEN('DS','0CL(1+'||MAXCASE||'-'||CHIGH||')'); 00527000 C_DATA=EMSG4; 00528000 CALL WFLUSH; 00529000 GEN('DS','0CL(1+('||CHIGH||'-'||MINCASE /*RAF-32*/ 00530000 ||')/4*4-'||CHIGH||'+'||MINCASE||')'); /*RAF-32*/ 00530100 END; 00531000 GEN('ORG',CLABELB||'+'||CLOW||'-'||MINCASE); /*RAF-32*/ 00532000 IF CHIGH = '' THEN 00533000 DO; 00534000 C_OPERATION = 'B'; 00535000 C_OPERANDS = CLABELI; 00536000 END; 00537000 ELSE 00538000 DO; 00539000 C_OPERATION = 'DC'; 00540000 C_OPERANDS = '(('||CHIGH||'-'||CLOW|| 00541000 ')/4+1)S(X''7F0''(4),'||CLABELI||')'; 00542000 END; 00543000 CALL WFLUSH; 00544000 IF ^RCHAR(',') THEN /*RAF-32*/ 00545000 GO TO END_CASE_LIST; /*RAF-32*/ 00546000 END; 00547000 END; 00548000 END_CASE_LIST: /*RAF-32*/ 00548500 IF ^RCHAR(':') THEN /*RAF-32*/ 00548600 CALL ERROR('CCASE: MISSING COLON INSERTED'); /*RAF-32*/ 00548700 GEN('ORG',TLABEL); 00549000 IF ^RCHAR(';') THEN 00550000 DO; 00551000 CALL WLABEL(CLABELI); 00552000 BRANCH_LAST=#TRUE; /*RAF-32*/ 00552500 CALL STMNT; 00553000 IF ^RCHAR(';') THEN 00554000 CALL ERROR('CA10: MISSING SEMICOLON INSERTED.') ; 00555000 /* CALL RWORD; */ /*RAF-32*/ 00556000 /* IF WORD ^= 'ENDCASE' THEN */ /*RAF-32*/ 00557000 /* GEN('B',CLABELE); */ /*RAF-32*/ 00558000 END; 00559000 ELSE 00560000 DO; 00561000 CALL EQVADD((CLABELI),(CLABELE)); 00562000 /* CALL RWORD; */ /*RAF-32*/ 00563000 END; 00564000 NOCASE: /*RAF-32*/ 00564500 END ; 00565000 1 00566000 NESTLEV = NESTLEV-1; /*RAF-34*/ 00566020 00566030 IF ELSEPART='' THEN DO; /*RAF-32*/ 00566050 IF RCHECK('ELSE') THEN DO; /*RAF-32*/ 00566100 CALL ERROR('CCASE: CHECK REQUIRED WITH ELSE'); /*RAF-32*/ 00566150 CALL STMNT; /*RAF-32*/ 00566200 END; /*RAF-32*/ 00566250 END; /*RAF-32*/ 00566300 ELSE DO; /*RAF-32*/ 00566350 GEN('B',CLABELE); /*RAF-32*/ 00566400 CALL WLABEL(ELSEPART); /*RAF-32*/ 00566450 IF RCHECK('ELSE') /*RAF-32*/ 00566500 THEN CALL STMNT; /*RAF-32*/ 00566550 ELSE GEN('DC','H''0'''); /*RAF-32*/ 00566600 END; /*RAF-32*/ 00566650 /*RAF-32*/ 00566700 /* IF DOID(DOLEV)^='' THEN */ /*RAF-15*/ 00567000 /* CALL EQVADD((DOID(DOLEV)),(CLABELB||'-4')); */ /*RAF-15*/ 00568000 CALL WLABEL(CLABELE); 00569000 TLABEL = EXID(DOLEV); /*RAF-8*/ 00569500 DOLEV = DOLEV-1; 00570000 /* NESTLEV = NESTLEV-1; */ /*RAF-34*/ 00571000 IF NESTLEV=0 THEN PREDLABLEV=0; /*RAF-6*/ 00571500 IF RCHECK('THEN') THEN CALL STMNT; /*RAF-8*/ 00571600 CALL CWLABEL(TLABEL); /*RAF-9*/ 00571700 RETURN; 00572000 END CCASE; 00573000 1 00574000 /* WHILE DO | UNTIL DO */ 00575000 00576000 CWHILE: 00577000 PROCEDURE(UWB) RECURSIVE ; 00578000 DCL 00579000 UWB BIT(1), /* #FALSE => WHILE */ 00580000 (TOP,BODY,FAILURE,DO_LABEL,THENPART) CHAR(8) VARYING; 00581000 00582000 DO_LABEL = CURLAB; 00583000 CALL SWLABEL(TOP); 00584000 FAILURE = GENSYM; 00585000 BODY = ''; 00586000 CALL PREDICATE(BODY,FAILURE,@OUTER_PREDICATE,#DUMMY,UWB,#DUMMY, 00587000 @B); 00588000 IF ^RCHECK('DO') THEN 00589000 CALL ERROR('CWHILE/UNTIL: "DO" INSERTED AFTER "'||WORD||'".'); 00590000 DOLEV = DOLEV+1; 00591000 EXID(DOLEV) = ''; 00592000 DOLABEL(DOLEV) = DO_LABEL; 00593000 DOID(DOLEV) = TOP; 00594000 CALL STMNT; 00595000 GEN('B',TOP); 00596000 CALL WLABEL(FAILURE); 00597000 THENPART = EXID(DOLEV); 00598000 DOLEV = DOLEV-1; 00599000 IF RCHECK('THEN') THEN 00600000 CALL STMNT; 00601000 CALL CWLABEL(THENPART); 00602000 RETURN; 00603000 END CWHILE ; 00604000 1 00605000 /* DO UNTIL/WHILE | FOR | FOREVER */ 00606000 00607000 CDO: 00608000 PROCEDURE RECURSIVE; 00609000 DCL 00610000 FEVER BIT(1) INIT(#FALSE), 00611000 ELEV FIXED BIN, /*RAF-37*/ 00611500 (BODY,PREDFAIL,THENPART) CHAR(8) VARYING, /*RAF-13*/ /*RAF-8*/ 00612000 REG CHAR(64) VARYING; /*RAF-13*/ 00612500 00613000 CALL SWLABEL(BODY); 00614000 PREDFAIL = ''; 00615000 DOLEV = DOLEV+1; 00616000 EXID(DOLEV),DOID(DOLEV) = ''; 00617000 DOLABEL(DOLEV) = CURLAB; 00618000 CALL STMNT; 00619000 IF RCHECK('UNTIL') THEN 00620000 DO; 00621000 CALL CWLABEL(DOID(DOLEV)); 00622000 CALL PREDICATE(PREDFAIL,BODY,@OUTER_PREDICATE,#DUMMY, 00623000 @USE_TRUTH,#DUMMY,@B); 00624000 END; 00625000 ELSE 00626000 IF RCHECK('WHILE') THEN 00627000 DO; 00628000 CALL CWLABEL(DOID(DOLEV)); 00629000 CALL PREDICATE(PREDFAIL,BODY,@OUTER_PREDICATE,#DUMMY, 00630000 @USE_NEGATED,#DUMMY,@B); 00631000 END; 00632000 ELSE 00633000 IF RCHECK('FOR') THEN 00634000 DO; 00635000 CALL CWLABEL(DOID(DOLEV)); 00636000 CALL ROPANDS(#TRUE); /*RAF-13*/ 00637000 IF OPANDS^='' THEN /*RAF-13*/ 00638000 REG=OPANDS; /*RAF-13*/ 00639000 ELSE 00640000 DO; 00641000 REG='0'; 00642000 CALL ERROR('CDO: MISSING "FOR" REGISTER.'); 00643000 END; 00644000 GEN('BCT',REG||','||BODY); 00645000 END; 00646000 ELSE 00647000 IF RCHECK('FOREVER') THEN 00648000 DO; 00649000 FEVER = #TRUE; 00650000 CALL CWLABEL(DOID(DOLEV)); 00651000 GEN('B',BODY); 00652000 END; 00653000 ELSE 00654000 IF DOID(DOLEV) ^= '' THEN DO; /*RAF-37*/ 00655000 ELEV = EQVLEV+1; /*RAF-37*/ 00655500 CALL EQVADD((DOID(DOLEV)),(BODY)); 00656000 CALL EQVFLUSH(#FALSE,ELEV); /*RAF-37*/ 00656100 END; /*RAF-37*/ 00656200 1 00657000 THENPART = EXID(DOLEV); /*RAF-8*/ 00657100 DOLEV = DOLEV-1; /*RAF-8*/ 00657200 IF RCHECK('THEN') THEN 00658000 DO; 00659000 IF FEVER THEN 00660000 CALL ERROR('CDO: INAPPROPRIATE "THEN" IGNORED.'); 00661000 CALL STMNT; 00662000 END; 00663000 CALL CWLABEL(THENPART); /*RAF-8*/ 00664000 /* DOLEV = DOLEV-1; */ /*RAF-8*/ 00665000 RETURN; 00666000 END CDO; 00667000 1 00668000 /* UTILITY PROCEDURE FOR LOOP CONSTRUCTS */ 00669000 CURLAB: PROCEDURE RETURNS(CHAR(8) VARYING); 00670000 DCL CLABEL CHAR(8) VARYING, 00671000 I FIXED BIN; 00672000 00673000 IF C_LABEL = ' ' 00674000 | ((SUBSTR(C_LABEL,1,1)<'A' | SUBSTR(C_LABEL,1,1)>'Z') /*RAF-30*/ 00675000 & SUBSTR(C_LABEL,1,1)^='&') THEN /*RAF-30*/ 00676000 DO; 00677000 DO I=LABLEV TO 1 BY -1 00678000 WHILE(SUBSTR(LABSTK(I),1,1)<'A' 00679000 | SUBSTR(LABSTK(I),1,1)>'Z'); 00680000 END; 00681000 IF I>0 THEN 00682000 CLABEL = LABSTK(I); 00683000 ELSE 00684000 CLABEL = ''; 00685000 END; 00686000 ELSE 00687000 CLABEL = C_LABEL; 00688000 RETURN(CLABEL); 00689000 END CURLAB; 00690000 1 00691000 /* FOR DO */ 00692000 00693000 CFOR: 00694000 PROCEDURE RECURSIVE; 00695000 DCL 00696000 (GEN1,GEN2,GEN3) CHAR(8) VARYING, /*RAF-13*/ 00697000 REG CHAR(64) VARYING; /*RAF-13*/ 00697500 00698000 GEN3 = CURLAB; 00699000 GEN1 = GENSYM; 00700000 GEN2 = GENSYM; 00701000 DOLEV = DOLEV+1; 00702000 EXID(DOLEV),DOID(DOLEV) = ''; 00703000 DOLABEL(DOLEV) = GEN3; 00704000 CALL ROPANDS(#TRUE); /*RAF-13*/ 00705000 IF OPANDS^='' THEN /*RAF-13*/ 00706000 REG = OPANDS; /*RAF-13*/ 00707000 ELSE 00708000 DO; 00709000 REG = '0'; 00710000 CALL ERROR('CFOR: MISSING "FOR" REGISTER.'); 00711000 END; 00712000 GEN('LTR',REG||','||REG); 00713000 GEN('BNP',GEN2); 00714000 CALL WLABEL(GEN1); 00715000 IF ^RCHECK('DO') THEN 00716000 CALL ERROR('CFOR: "DO" INSERTED AFTER "'||REG||'".'); 00717000 CALL STMNT; 00718000 CALL CWLABEL(DOID(DOLEV)); 00719000 GEN('BCT',REG||','||GEN1); 00720000 CALL WLABEL(GEN2); 00721000 GEN3 = EXID(DOLEV); 00722000 DOLEV = DOLEV-1; 00723000 IF RCHECK('THEN') THEN 00724000 CALL STMNT; 00725000 CALL CWLABEL(GEN3); 00726000 RETURN; 00727000 END CFOR; 00728000 1 00729000 /* FOREVER DO */ 00730000 00731000 CFOREVER: 00732000 PROCEDURE RECURSIVE ; 00733000 DCL 00734000 (GEN1,GEN2) CHAR(8) VARYING; 00735000 00736000 GEN1 = CURLAB; 00737000 CALL SWLABEL(GEN2) ; 00738000 DOLEV = DOLEV+1; 00739000 EXID(DOLEV),DOID(DOLEV) = ''; 00740000 DOLABEL(DOLEV) = GEN1; 00741000 IF ^RCHECK('DO') THEN 00742000 CALL ERROR('CFOREVER: "DO" ASSUMED AFTER "FOREVER".'); 00743000 CALL STMNT ; 00744000 CALL CWLABEL(DOID(DOLEV)); 00745000 GEN('B',GEN2); 00746000 CALL CWLABEL(EXID(DOLEV)); 00747000 DOLEV = DOLEV-1; 00748000 IF RCHECK('THEN') THEN 00749000 CALL ERROR('CFOREVER: INAPPROPRIATE "THEN" IGNORED.'); 00750000 RETURN; 00751000 END CFOREVER ; 00752000 1 00753000 /* GOTO