**** OAKLAND UNIVERSITY **** WRITER : NASER ABBASI **** COURSE : CSE535 **** FUNCTION : SNOBOL PROGRAM TO TRANSLATE SUBSET OF PLI TO **** PASCAL (TURBO) **** **** discussion: **** the main problem faced in communications between procedures **** as pli allowes descriptors while pascal donot **** my solution to this is as followes: **** an argument list of pointers to descriptor structure is used **** this array is of size 10 ( 10 ptr's) descriptor structure is **** shown below in the pascal code AT THE END OF THE FILE **** each descriptor in turn points to linked list of the actual data **** befor calling a procedure i build argument by argumnet in the **** descriptor loading the value of the variable to be passed into **** global and then calling load descriptor function that refernce **** this and other gloabl informations **** for passing an array a for loop will load all the items in **** the linked list. please see the pascal run time functions **** **** in snobol i have BST table to keep track of lexical level **** information such as name of block and outer block index **** also in snobol there is the symbol table with global id **** counter that is added for every entry **** this table contains information such as name,type,lexical **** level, block number and structure type and lower and upper **** bounds information if this is an array **** also there is an argument table that is build when parsing **** like "dcl a(x,x,x..)" this table is looked at when i enter **** the block to decide if the object referenced is local or **** an argument, if argument i generate pascal code to **** to reference this via the descriptor and the argument number **** **** FINAL STATUS: **** i have here about all of the code to transkate an example **** such as number 9 but i cant't get snobol to compile it all **** after i adde the part to translate some parts of the BODY **** statments, befor i added this i correctly was translating **** my own test program like this one : PROG : PROC; DCL (I,J) FIXED; DCL (A,B,C,D) (3,4) FLOAT; PROG1 : PROC(A,B) DCL (I,J,A) FIXED; DCL (F,G) (1,2,3) CHAR(20) VAR; DCL (F,G) CHAR(20); PROG2 : PROC; DCL (I,J) (1,2,3) BIT(30) ; DCL I (1,2,3) BIT; DCL I (1,2,3) CHAR(30) VAR; PROG3 : PROC; PUT SKIP LIST (' IAM IN PROG3 '); PROG4 : PROC ; PUT SKIP LIST (' IAM IN PROG4'); END PTOG4; END PROG3; PUT SKIP LIST (' IAM IN PROG2'); END PROG2; PUT SKIP LIST (' IAM IN PROG1 '); PUT SKIP LIST (i, length(j)); PUT SKIP LIST (I, J, A(I,J) , B(I,J)); END PROG; *** but i dont have the pascal listing to show you since it was overwritten *** by subseguent runs *** i have corectly translated *** all the combinations of DCL's and the put skip list's and mult *** level nesting befor i was unable to get to compile again *** after i added in the EXEC body code this happened. *** &STLIMIT = 20000 DEFINE('EMIT(PASCAL_LINE)') DEFINE('DEBUG(DEBUG_LINE)') ******** GLOBAL DATA AND PATTERN DEFINITIONS ************ ** NOTE: ** ALL GLOBAL VARIABLES HAS 'G_' AS THE FIRST 2 LETTERS ** ALL PATTERNS VARIABLES HAS 'P_' AS FIRST 2 LETTERS YES = 1 NO = 0 LETTERS = 'QWERTYUIOPASDFGHJKLZXCVBNM1234567890_' NUMBERS = '1234567890' ** TYPE VARITIES G_BIT_TYPE = 1 G_INT_TYPE = 2 G_CHA_TYPE = 3 G_FLT_TYPE = 4 G_BOO_TYPE = 5 G_CHAR_ARRAY = 6 G_CHAR_STRING = 7 G_BIT_ARRAY = 8 ** STRUVTURE VARITIES G_ATOMIC = 0 G_VECOTR_TYPE = 1 G_2D_TYPE = 2 G_3D_TYPE = 3 G_BST = TABLE() DATA('G_BSTE(OUTER_BLOCK,NAME,LEX_LEVEL,NUM_ARGS)') DATA('G_ARGE(ARG1,ARG2,ARG3,ARG4,ARG5,' + 'ARG6,ARG7,ARG8,ARG9,ARG10)') G_ID_COUNT = 0 G_ARGT = TABLE() G_ARG_RESOLVED = YES G_ISSUED_ISSUED = NO G_ISSUED_LABEL = NO ** counter to go up to g_argn G_ARG_COUNTER = 0 G_RUN_TIME_DONE = NO G_GOT_MAIN_LINE = NO G_BEGIN_DONE = NO ** curent block counter G_CB = 0 ** last block counter G_LB = 0 DATA('G_SYME(OBJ_NAME,ARG_OBJECT,ARG_POS,' + 'OBJ_DATA_TYPE,LEX_LEVEL,BLOCK_NUM,' + 'STRUCT_TYPE,UB1,LB1,UB2,LB2,UB3,LB3)') G_SYM = TABLE() G_ID_COUNT = 0 DEFINE('ARG_MANAGER(NAME)') DEFINE('PROCESS_L_ENTITY(LHS_LINE)IDENT,ARG_POS') DEFINE('PROCESS_R_ENTITY(RHS_LINE)AUX1,ARG_POS,IDENT') DEFINE('PROCESS_RET_PART(RET_PART_LINE)PROC_NAME,IDENT1,AUX1') DEFINE('INIT()') INIT() :F(ERROR_EXIT) DEBUG(' AFTER INIT') DEBUG('BEFOR CALLING PROCESS') DEFINE('PROCESS()PLI') PROCESS() :F(ERROR_EXIT) DEBUG('AFTER PROCESS') DEFINE('CLEAN_UP()') CLEAN_UP() :(END) ERROR_EXIT DEBUG('ERROR HAS OCCURED') :(END) ******************************************************* CLEAN_UP OPEN('PLI.PLI',7,4) OPEN('PAS.PAS',8,4) :(RETURN) ********************************************************** INIT OPEN('PLI.PLI',7,1) OPEN('PAS.PAS',8,2) OUTPUT('OUT',8) INPUT('IN',7) :(RETURN) *********************************************************** PROCESS DEBUG('ENTERING PEOCESS') DEFINE('TRY_PROC(PROC_LINE)V1,V2,V3,GARGN,P_PROC_1' + ',P_PROC_2,P_MAIN_1,P_MAIN,AUX,P1') DEFINE('TRY_DCL(DCL_LINE)V1,FF,TRAIL,TTYPE,P_FIX1_2,FIX1' + ',FIX2,FIX3,NAME,TYPE_IS,CHAR_FLAVOR' + ',P_FIX1_1,' + 'P_FIX1_3,P_FIX2,P_FIX3_1,P_FIX3_2,' + 'P_FIX3_3,P_FIX4,ARG_POSITION,SIZE,' + 'TYPE_ID') DEFINE('TRY_EXEC(EXEC_LINE)') DEFINE('TRY_END(END_LINE)') DEFINE('CHECK_BEGIN_ISSUED()') ** variables PLI = ' ' MORE PLI = IN :F(RETURN) DEBUG('PROCESS: READ FROM PLI = ' PLI) PLI BREAK(';') . PLI :F(MORE) PLI = REPLACE(PLI,'qwertyuiopasdfghjklzxcvbnm', + 'QWERTYUIOPASDFGHJKLZXCVBNM') DEBUG('PROCESS: NOW PLI = ' PLI) TRY_PROC(PLI) :S(MORE) TRY_DCL(PLI) :S(MORE) TRY_EXEC(PLI) :S(MORE) DEBUG(' LOOP CB=' G_CB) DEBUG(' LOOP LB=' G_LB) DEBUG(' LOOP OUTRE BOLCK=' OUTER_BLOCK(G_BST) ) TRY_END(PLI) :S(MORE)F(FRETURN) ***************************************************************** CHECK_BEGIN_ISSUED DEBUG('CHECK_BEGIN_ISSUED : ENTER') EQ(G_BEGIN_DONE,YES) :S(RETURN) DEBUG('CHECK_BEGIN_ISSUED DID NOT DO BEGIN YET') OUT = ' Begin ' G_BEGIN_DONE = YES :(RETURN) ***************************************************************** TRY_PROC ** this matchs p: proc P_MAIN = (BREAK(LETTERS) SPAN(LETTERS) . V1 BREAK(':') SPAN(':') + BREAK(LETTERS) ('PROC' ! 'PROCEDURE')) ** This matchs p: proc(a,b..) P_PROC_1 = BREAK(LETTERS) SPAN(LETTERS) . V1 BREAK(':') ':' + BREAK(LETTERS) ('PROC' ! 'PROCEDURE') + BREAK('(') '(' ARB . V2 ')' ** this matchs p: proc(a,b...) returns (x) P_PROC_2 = BREAK(LETTERS) SPAN(LETTERS) . V1 BREAK(':') ':' + BREAK(LETTERS) ('PROC' ! 'PROCEDURE') + BREAK('(') '(' ARB . V2 ')' BREAK(LETTERS) 'RETURNS' + BREAK('(') '(' BREAK(LETTERS) SPAN(LETTERS) . V3 ')' ** match p: proc returns (x) P_MAIN_1 = BREAK(LETTERS) SPAN(LETTERS) . V1 BREAK(':') ':' + BREAK(LETTERS) ('PROC' ! 'PROCEDURE') + BREAK(LETTERS) 'RETURNS' BREAK('(') '(' + BREAK(LETTERS) SPAN(LETTERS) . V2 ')' AUX = '' GARGN = 0 DEFINE('PROLOG(PROC_NAME)') DEFINE('CHECK_RUN_TIME()') ** arg supervisor will load the arguments into table entry indexed ** by value of current block number so later can be readilly accsssed DEFINE('BUILD_ARG_SUPERVISOR(P1,P2,P3)') DEBUG('TRY_PROC: ENTRING PROC_LINE=' PROC_LINE) PROC_LINE P_PROC_2 :F(TRY_PROC_B1) DEBUG('TRY_PROC: MATCHED P_PROC_2 NAME = ' V1) CHECK_RUN_TIME() PROLOG(V1) G_CB = G_LB OUT = ' ' AUX = 'Function ' V1 V3 'FLOAT' :F(TRY_PROC_A1) AUX = AUX ' :' 'Real;' DEBUG('TRY_PROC: MATCHED REAL FUNC AUX=' AUX) OUT = AUX :(TRY_PROC_LOOP1) TRY_PROC_A1 V3 'CHAR' ! 'CHARACTER' :F(TRY_PROC_A2) AUX = AUX ' :' 'Char;' DEBUG('TRY_PROC: MATCHED CHAR FUNC AUX=' AUX) OUT = AUX :(TRY_PROC_LOOP1) TRY_PROC_A2 V3 'FIXED' :F(TRY_PROC_A3) AUX = AUX ' :' 'Integer;' DEBUG('TRY_PROC: MATCHED FIXED FUNC AUX=' AUX) OUT = AUX :(TRY_PROC_LOOP1) TRY_PROC_A3 V3 'BIT' :F(FRETURN) AUX = AUX ' :' 'Boolean;' DEBUG('TRY_PROC: MATCHED FIXED FUNC AUX=' AUX) OUT = AUX TRY_PROC_LOOP1 DEBUG('TRY_PROC: GETTING NEW ENTRY FOR ARG TABLE ARGN=' GARGN) G_ARGT = G_ARGE() TRY_PROC_LOOP1_1 V2 BREAK(LETTERS) SPAN(LETTERS) . P1 = :F(TRY_P1_1) GARGN = GARGN + 1 NUM_ARGS(G_BST) = GARGN DEBUG('TRY_PROC: LOOP TO COLLECT ARGS ARGN=' GARGN 'CB=' G_CB) DEBUG('TRY_PROC: IN LOOP P1=' P1) DEBUG('TRY_PROC LOOP1_1: BEFOR CALLING SUPER GARGN=' GARGN) BUILD_ARG_SUPERVISOR(GARGN,G_CB,P1) :(TRY_PROC_LOOP1_1) TRY_P1_1 NUM_ARGS(G_BST) = GARGN :(RETURN) TRY_PROC_B1 PROC_LINE P_PROC_1 :F(TRY_PROC_C1) DEBUG('TRY_PROC: MATCHED P_PROC_1 NAME = ' V1) CHECK_RUN_TIME() PROLOG(V1) G_CB = G_LB OUT = ' ' AUX = 'Procedure ' V1 ';' OUT = AUX TRY_PROC_LOOP2 G_ARGT = G_ARGE() TRY_PROC_LOOP2_1 DEBUG('TRY_PROC: IN MATCHED PROC_1 V2=' V2) V2 BREAK(LETTERS) SPAN(LETTERS) . P1 = :F(TRY_P_2_1) GARGN = GARGN + 1 DEBUG('TRY_PROC: IN MATCH PROC_1 LOOP GARGN=' GARGN) DEBUG('TRY_PROC: IN MATCH PROC_1 LOOP P1=' P1) NUM_ARGS(G_BST) = GARGN DEBUG('TRY_PROC: BEFOR CALLING SUPER GARGN=' GARGN) BUILD_ARG_SUPERVISOR(GARGN,G_CB,P1) :(TRY_PROC_LOOP1_1) TRY_P_2_1 NUM_ARGS(G_BST) = GARGN :(RETURN) TRY_PROC_C1 PROC_LINE P_MAIN_1 :F(TRY_PROC_C2) DEBUG('TRY_PROC: MATCHED P_MAIN_1 V2=' V2) CHECK_RUN_TIME() DEBUG('TRY PROC: MATCHED P_MAIN_1 V1==' V1) PROLOG(V1) G_CB = G_LB DEBUG('TRY_PROC: MATCH P_MAIN_1 V1 ==' V1) AUX = 'Function ' V1 NUM_ARGS(G_BST) = 0 DEBUG('TRY_PROC: MATCH P_MAIN_1 AUX ==' AUX) V2 'FLOAT' :F(TRY_PROC_CC1) AUX = AUX ' :' 'Real;' DEBUG('TRY_PROC: MATCHED REAL FUNC AUX=' AUX) OUT = AUX :(RETURN) TRY_PROC_CC1 V2 'CHAR' ! 'CHARACTER' = :F(TRY_PROC_CC2) AUX = AUX ' :' 'Char;' DEBUG('TRY_PROC: MATCHED CHAR FUNC AUX=' AUX) OUT = AUX :(RETURN) TRY_PROC_CC2 V3 'FIXED' :F(TRY_PROC_CC3) AUX = AUX ' :' 'Integer;' DEBUG('TRY_PROC: MATCHED FIXED FUNC AUX=' AUX) OUT = AUX :(RETURN) TRY_PROC_CC3 V3 'BIT' :F(FRETURN) AUX = AUX ' :' 'Boolean;' DEBUG('TRY_PROC: MATCHED BOLEAN FUN AUX=' AUX) OUT = AUX :(RETURN) TRY_PROC_C2 PROC_LINE P_MAIN :F(FRETURN) DEBUG('TRY_PROC: MATCHED P_MAIN') EQ(G_GOT_MAIN_LINE,YES) :S(NOT_MAIN) DEBUG('TRY_PROC: ITS MAIN LINE NAME' V1) PROLOG(V1) G_CB = G_LB NUM_ARGS(G_BST) = 0 OUT = 'Program ' V1 ';' OUT = ' ' V1 = DEFINE('EMIT_PASCAL_GLOBAL_TYPES()') EMIT_PASCAL_GLOBAL_TYPES() G_GOT_MAIN_LINE = YES :(RETURN) NOT_MAIN DEBUG('TRY_PROC: ITS NOT MAIN LINE NAME =' V1) PROLOG() G_CB = G_LB CHECK_RUN_TIME() OUT = 'Procedure ' V1 ';' V1 = NUM_ARGS(G_BST) = 0 :(RETURN) ************************************************************* BUILD_ARG_SUPERVISOR DEBUG('SUPER: ENTER P1=' P1 'P2=' P2 'P3=' P3) ** P1 = GARGN , P2 = G_CB , P3 = THE ARGUMENT EQ(P1,1) :F(B2) ARG1(G_ARGT) = P3 :(RETURN) B2 EQ(P1,2) :F(B3) ARG2(G_ARGT) = P3 :(RETURN) B3 EQ(P1,3) :F(B4) ARG3(G_ARGT) = P3 :(RETURN) B4 EQ(P1,4) :F(B5) ARG4(G_ARGT) = P3 :(RETURN) B5 EQ(P1,5) :F(B6) ARG5(G_ARGT) = P3 :(RETURN) B6 EQ(P1,6) :F(B7) ARG6(G_ARGT) = P3 :(RETURN) B7 EQ(P1,7) :F(B8) ARG7(G_ARGT) = P3 :(RETURN) B8 EQ(P1,8) :F(B9) ARG8(G_ARGT) = P3 :(RETURN) B9 EQ(P1,9) :F(B10) ARG9(G_ARGT) = P3 :(RETURN) B10 EQ(P1,10) :F(FRETURN) ARG10(G_ARGT) = P3 :(RETURN) ********************************************************************** PROLOG DEBUG('PROLOG') G_LB = G_LB + 1 G_BST = G_BSTE() NAME(G_BST) = PROC_NAME OUTER_BLOCK(G_BST) = G_CB EQ(G_RUN_TIME_DONE,YES) :S(PROLOG1) LEX_LEVEL(G_BST) = 0 :(RETURN) PROLOG1 LEX_LEVEL(G_BST) = 1 + + LEX_LEVEL(G_BST)>) :(RETURN) **************************************************************** EPILOG DEBUG('EPILOG: ENTER') G_VAR_ISSUED = NO G_LABEL_ISSUED = NO G_CB = OUTER_BLOCK(G_BST) :(RETURN) ********************************************************************* CHECK_RUN_TIME EQ(G_RUN_TIME_DONE,NO) :F(RETURN) DEFINE('EMIT_PASCAL_RUN_TIME()') EMIT_PASCAL_RUN_TIME() G_RUN_TIME_DONE = YES :(RETURN) **************************************************************** ARG_MANAGER DEBUG('ARG_MANAGER : ENTER') ARG_MANAGER_COUNTER = 0 ** the dcl is local and not argumnet if main line or ** the num of args in BST for this activation is 0 DEBUG('ARG_MANAGER: NUMBER OF ARGS =' NUM_ARGS(G_BST)) DEBUG('ARG MANAGER: THE CB=' G_CB) EQ(NUM_ARGS(G_BST),0) :S(NOT_ARG) DEBUG('ARG_MANAGER: FOUND NUM ARG NOT BE ZERO') ** The following func returns the name of the argument ** p1 = arguemnt number in g_argt table indexed by ** current block number DEFINE('GET_ME_ARG(P1)') ** if this activation had an arguemnt list then check to ** see if this is for that or for a local variable ** by sequential search of the g_argt table ARG_MANAGER_LOOP GT(ARG_MANAGER_COUNTER,NUM_ARGS(G_BST)) :S(NOT_ARG) ARG_MANAGER_COUNTER = ARG_MANAGER_COUNTER + 1 DEBUG('ARG_MANAGER: IN LOOP COUNTER=' ARG_MANAGER_COUNTER) IDENT(NAME,GET_ME_ARG(ARG_MANAGER_COUNTER)) :S(ARG) :(ARG_MANAGER_LOOP) NOT_ARG DEBUG('ARG_MANAGER: NOT AN ARGUMNET') ARG_MANAGER = 0 :(RETURN) ARG ARG_MANAGER = ARG_MANAGER_COUNTER :(RETURN) ***************************************************************** GET_ME_ARG DEBUG('GET_ME_ARG: ENTER P1=' P1 ) ** P1 = ARGUMENT NUMBER IN THE ARGUMENT TABLE EQ(P1,1) :F(B2A) GET_ME_ARG = ARG1(G_ARGT) :(RETURN) B2A EQ(P1,2) :F(B3A) GET_ME_ARG = ARG2(G_ARGT) :(RETURN) B3A EQ(P1,3) :F(B4A) GET_ME_ARG = ARG3(G_ARGT) :(RETURN) B4A EQ(P1,4) :F(B5A) GET_ME_ARG = ARG4(G_ARGT) :(RETURN) B5A EQ(P1,5) :F(B6A) GET_ME_ARG = ARG5(G_ARGT) :(RETURN) B6A EQ(P1,6) :F(B7A) GET_ME_ARG = ARG6(G_ARGT) :(RETURN) B7A EQ(P1,7) :F(B8A) GET_ME_ARG = ARG7(G_ARGT) :(RETURN) B8A EQ(P1,8) :F(B9A) GET_ME_ARG = ARG8(G_ARGT) :(RETURN) B9A EQ(P1,9) :F(B10A) GET_ME_ARG = ARG9(G_ARGT) :(RETURN) B10A EQ(P1,10) :F(FRETURN) GET_ME_ARG = ARG10(G_ARGT) :(RETURN) ********************************************************************** TRY_DCL : DEBUG('TRY_DCL JUST ENTERED DCL_LINE=' DCL_LINE) FF = (('FIXED' ! 'FLOAT' ! 'CHAR' ! 'CHARACTER' + ! 'BIT' + ) . TTYPE REM . TRAIL + ) ** match 'dcl (a,b..) (X) fixed' P_FIX1_1 = BREAK(LETTERS) ('DCL' ! 'DECLARE') BREAK('(') '(' + BREAK(LETTERS) ARB . V1 ')' BREAK('(') '(' + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX1) + ! (BREAK('*') SPAN('*') . FIX1) + ) BREAK(')') ')' BREAK(LETTERS) FF ** match 'dcl (a,b..) (X,X) fixed' P_FIX1_2 = BREAK(LETTERS) ('DCL' ! 'DECLARE') BREAK('(') '(' + BREAK(LETTERS) ARB . V1 ')' BREAK('(') '(' + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX1) + ! (BREAK('*') SPAN('*') . FIX1) + ) + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX2) + ! (BREAK('*') SPAN('*') . FIX2) + ) + BREAK(')') ')' BREAK(LETTERS) FF ** MATCH 'DCL (A,B,..) (X,X,X) FIXED' P_FIX1_3 = BREAK(LETTERS) ('DCL' ! 'DECLARE') BREAK('(') '(' + BREAK(LETTERS) ARB . V1 ')' BREAK('(') '(' + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX1) + ! (BREAK('*') SPAN('*') . FIX1) ) + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX2) + ! (BREAK('*') SPAN('*') . FIX2 ) ) + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX3) + ! (BREAK('*') SPAN('*') . FIX3) ) + BREAK(')') ')' BREAK(LETTERS) FF ** match 'dcl (a,b,..) fixed' P_FIX2 = BREAK(LETTERS) ('DCL' ! 'DECLARE') BREAK('(') '(' + ARB . V1 ')' BREAK(LETTERS) + FF ** match 'dcl A (X) fixed' P_FIX3_1 = BREAK(LETTERS) ('DCL' ! 'DECLARE') + BREAK(LETTERS) SPAN(LETTERS) . V1 BREAK('(') '(' + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX1) + ! (BREAK('*') SPAN('*') . FIX1) + ) BREAK(')') ')' BREAK(LETTERS) + FF ** match 'dcl A (X,X) fixed' P_FIX3_2 = BREAK(LETTERS) ('DCL' ! 'DECLARE') + BREAK(LETTERS) SPAN(LETTERS) . V1 BREAK('(') '(' + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX1) + ! (BREAK('*') '*' . FIX1) ) + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX2) + ! (BREAK('*') '*' . FIX2) + ) BREAK(')') ')' BREAK(LETTERS) FF ** MATCH 'DCL A (X,X,X) FIXED' P_FIX3_3 = BREAK(LETTERS) ('DCL' ! 'DECLARE') + BREAK(LETTERS) SPAN(LETTERS) . V1 BREAK('(') '(' + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX1) + ! (BREAK('*') '*' . FIX1) ) + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX2) + ! (BREAK('*') '*' . FIX2) ) + ( (BREAK(NUMBERS) SPAN(NUMBERS) . FIX3) + ! (BREAK('*') '*' . FIX3) + ) BREAK(')') ')' BREAK(LETTERS) FF ** match 'dcl a fixed' P_FIX4 = BREAK(LETTERS) ('DCL' ! 'DECLARE') BREAK(LETTERS) + SPAN(LETTERS) . V1 BREAK(LETTERS) FF ** symt manager inserts ident and its attributes in global ** symbol table indicating if an argument also so that when ** ident encoutered in exec section I know how to handle ** it. if not local and not argumnet then I'll seach the ** symbol table for it in the block one level higher utill ** found ** ARGUMETS ARE: ** obj_name,arg(flag y/n),arg_pos,data type,lex_level ** block_num, struct_type, ub1,lb1,ub2,lb2,ub3,lb3 ** DEFINE('SYM_TABLE_MANAGER(P1,P2,P3,P4,P5,P6' + ',P7,P8,P9,P10,P11,P12,P13)') ** arg manager takes name and returns position in arg list ** check if variable is from arg list if in arg list add to symbol ** table but with flag indicating it is an argument ang it ** position else add to sym tanble with rest of atttributes TRY_FIX1_3 DEBUG('TRY_DCL: ABOUT TO TRY FOR FIX1_3') DCL_LINE P_FIX1_3 :F(TRY_FIX1_2) TRY_FIX1_3_LOOP1 DEBUG('TRY_DCL: MATCHED P_FIX1_3 IN LOOP') V1 BREAK(LETTERS) SPAN(LETTERS) . NAME = :F(RETURN) DEBUG('TRY_DCL: MATCHED P_FIX1_3 NAME=' NAME) IDENT(TTYPE,'FIXED') :F(F1_3) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F1_3_CONT) F1_3 IDENT(TTYPE,'FLOAT') :F(F1_31) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F1_3_CONT) F1_31 IDENT(TTYPE,'CHAR') :F(F1_112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F1_3_CONT_CHAR) F1_112 IDENT(TTYPE,'CHARACTER') :F(F1_112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F1_3_CONT_CHAR) F1_112_ IDENT(TTYPE,'BIT') :F(FRETURN) TYPE_ID = G_BIT_TYPE TYPE_IS = 'Boolean' F1_3_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F1_3_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_TYPE) :F(F1_3_) TYPE_ID = G_BIT_ARRAY :(F1_3_CONT) F1_3_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F1_3_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F1_3_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX1_A3__) OUT = 'Label 10; ' G_ISSUED_LABEL = YES NOT_ARG_FIX1_A3__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX1_A3___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX1_A3___ ARG_POSITION = ARG_MANAGER(NAME) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX1_A3) DEBUG('TRY_DCL: MATCHED P_FIX1_3: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(NAME + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_3D_TYPE + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(TRY_FIX1_3_LOOP1) NOT_ARG_FIX1_A3 DEBUG('TRY_DCL: MATCHED P_FIX1_3 LOCAL VARIABLE') DEBUG('TRY_DCL: MATCHED P_FIX1_3 SIZE OF ARRAY SIZE=' FIX1) DEBUG('BEFOR PROBLEM TYPE_ID=' TYPE_ID 'GS=' G_CHAR_STRING) EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG_FIX1_A33) OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of String[' SIZE '];' :(NOT_ARG_FIX1_A3333) NOT_ARG_FIX1_A33 EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG_FIX1_A333) OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of Array [1..' SIZE '] Of Char;' :(NOT_ARG_FIX1_A3333) NOT_ARG_FIX1_A333 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG_FIX1_A333_) OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of Array [1..' SIZE '] Of Boolean;' :(NOT_ARG_FIX1_A3333) NOT_ARG_FIX1_A333_ OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of ' TYPE_IS ';' NOT_ARG_FIX1_A3333 SYM_TABLE_MANAGER(NAME + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_3D_TYPE + ,FIX1 + ,1 + ,FIX2 + ,1 + ,FIX3 + ,1 + ) :(TRY_FIX1_3_LOOP1) ****** TRY_FIX1_2 DEBUG('TRY_DCL: ABOUT TO TRY FOR FIX1_2') DCL_LINE P_FIX1_2 :F(TRY_FIX1_1) TRY_FIX1_2_LOOP1 DEBUG('TRY_DCL: MATCHED P_FIX1_2 IN LOOP') V1 BREAK(LETTERS) SPAN(LETTERS) . NAME = :F(RETURN) DEBUG('TRY_DCL: MATCHED P_FIX1_2 NAME=' NAME) IDENT(TTYPE,'FIXED') :F(F1_2) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F1_2_CONT) F1_2 IDENT(TTYPE,'FLOAT') :F(F1_21) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F1_2_CONT) F1_21 IDENT(TTYPE,'CHAR') :F(F1__112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F1__3_CONT_CHAR) F1__112 IDENT(TTYPE,'CHARACTER') :F(F1__112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F1__3_CONT_CHAR) F1__112_ IDENT(TTYPE,'BIT') :F(FRETURN) TYPE_ID = G_BIT_TYPE TYPE_IS = 'Boolean' F1__3_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F1_2_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_TYPE) :F(F1__3_CONT_CHAR_) TYPE_ID = G_BIT_ARRAY :(F1_2_CONT) F1__3_CONT_CHAR_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F1_2_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F1_2_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX1_A2__) OUT = 'Label 10:' G_ISSUED_LABEL = YES NOT_ARG_FIX1_A2__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX1_A2___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX1_A2___ ARG_POSITION = ARG_MANAGER(NAME) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX1_A2) DEBUG('TRY_DCL: MATCHED P_FIX1_2: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(NAME + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_2D_TYPE + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(TRY_FIX1_2_LOOP1) NOT_ARG_FIX1_A2 DEBUG('TRY_DCL: MATCHED P_FIX1_2 LOCAL VARIABLE') DEBUG('TRY_DCL: MATCHED P_FIX1_2 SIZE OF ARRAY SIZE=' FIX1) EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG_FIX1_A22) OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 ']' OF ' String' + '[' SIZE '];' :(NOT_ARG_FIX1_A2222) NOT_ARG_FIX1_A22 EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG_FIX1_A222) OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 '] Of Array[1..' + SIZE '] Of Char;' :(NOT_ARG_FIX1_A2222) NOT_ARG_FIX1_A222 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG_FIX1_A22_) OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 '] Of Array[1..' + SIZE '] Of Boolean;' :(NOT_ARG_FIX1_A2222) NOT_ARG_FIX1_A22_ OUT = NAME ': Array[1..' FIX1 ',1..' FIX2 '] Of ' TYPE_IS ';' NOT_ARG_FIX1_A2222 SYM_TABLE_MANAGER(NAME + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_2D_TYPE + ,FIX1 + ,1 + ,FIX2 + ,1 + ,0 + ,0 + ) :(TRY_FIX1_2_LOOP1) ******** TRY_FIX1_1 DEBUG('TRY_DCL: ABOUT TO MATCH FOR FIX1_1') DCL_LINE P_FIX1_1 :F(TRY_FIX3_3) STRUCT_IS = 'Array' TRY_FIX1_1_LOOP1 DEBUG('TRY_DCL: MATCHED P_FIX1_1 IN LOOP') V1 BREAK(LETTERS) SPAN(LETTERS) . NAME = :F(RETURN) DEBUG('TRY_DCL: MATCHED P_FIX1_1 NAME=' NAME) IDENT(TTYPE,'FIXED') :F(F1) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F1_CONT) F1 IDENT(TTYPE,'FLOAT') :F(F11) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F1_CONT) F11 IDENT(TTYPE,'CHAR') :F(F112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F1_CONT_CHAR) F112 IDENT(TTYPE,'CHARACTER') :F(F112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F1_CONT_CHAR) F112_ IDENT(TTYPE,'BIT') :F(FRETURN) TYPE_ID = G_BIT_TYPE TYPE_IS = 'Boolean' F1_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F1_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_TYPE) :F(F1_CONT_CHAR_) TYPE_ID = G_BIT_ARRAY :(F1_CONT) F1_CONT_CHAR_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F1_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F1_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX1_A1__) OUT = 'Label 10;' G_ISSUED_LABEL = YES NOT_ARG_FIX1_A1__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX1_A1___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX1_A1___ ARG_POSITION = ARG_MANAGER(NAME) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX1_A1) DEBUG('TRY_DCL: MATCHED P_FIX1_1: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(NAME + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_VECTOR_TYPE + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(TRY_FIX1_1_LOOP1) NOT_ARG_FIX1_A1 DEBUG('TRY_DCL: MATCHED P_FIX1_1 LOCAL VARIABLE') DEBUG('TRY_DCL TYPE ID=' TYPE_ID 'G_CHAR_STRING=' G_CHAR_STRING) EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG_FIX1_A11) DEBUG('TRY_DCL: EQ SUCCEEDED AS SHOULD I WILL OUTPUT') OUT = NAME ': Array[1..' FIX1 ']' 'Of ' 'String[' SIZE '];' DEBUG('TRY_DCL: AFTER OUTPUT IT SHOULD WORKED') :(NOT_ARG_FIX1_A1111) NOT_ARG_FIX1_A11 DEBUG('TRY DCL: IAM CHECKING FOR CHAR ARRAY TYPE') EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG_FIX1_A111) DEBUG('TRY DCL: CHAR ARRAY TYPE SUCCESSD') OUT = NAME ': Array[1..' FIX1 ']' ' Of ' 'Array[1..' SIZE ']' + ' Of Char;' :(NOT_ARG_FIX1_A1111) NOT_ARG_FIX1_A111 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG_FIX1_A111_) OUT = NAME ': Array[1..' FIX1 ']' ' Of ' 'Array[1..' SIZE ']' + ' Of Boolean;' :(NOT_ARG_FIX1_A1111) NOT_ARG_FIX1_A111_ OUT = NAME ': Array[1..' FIX1 '] Of ' TYPE_IS ';' NOT_ARG_FIX1_A1111 SYM_TABLE_MANAGER(NAME + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_VECTOR_TYPE + ,FIX1 + ,1 + ,0 + ,0 + ,0 + ,0 + ) :(TRY_FIX1_1_LOOP1) ****** TRY_FIX2 DEBUG('TRTY DCL: MATCH FOR P_FIX2') DCL_LINE P_FIX2 :F(FRETURN) TRY_FIX2_LOOP1 DEBUG('TRY_DCL: MATCHED P_FIX2 IN LOOP') V1 BREAK(LETTERS) SPAN(LETTERS) . NAME = :F(RETURN) DEBUG('TRY_DCL: MATCHED P_FIX2 NAME=' NAME) IDENT(TTYPE,'FIXED') :F(F2_1) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F2_1_CONT) F2_1 IDENT(TTYPE,'FLOAT') :F(F2_11) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F2_1_CONT) F2_11 IDENT(TTYPE,'CHAR') :F(F2_112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F21_CONT_CHAR) F2_112 IDENT(TTYPE,'CHARACTER') :F(F2_112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F21_CONT_112) F2_112_ IDENT(TTYPE,'BIT') :F(FRETURN) TYPE_ID = G_BIT_TYPE F21_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F1_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_TYPE) :F(F21_CONT_CHAR_) TYPE_ID = G_BIT_ARRAY :(F2_1_CONT) F21_CONT_CHAR_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F2_1_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F2_1_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX2__) OUT = 'Label 10;' G_ISSUED_LABEL = YES NOT_ARG_FIX2__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX2___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX2___ ARG_POSITION = ARG_MANAGER(NAME) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX2) DEBUG('TRY_DCL: MATCHED P_FIX2: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(NAME + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_ATOMIC + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(TRY_FIX2_LOOP1) NOT_ARG_FIX2 DEBUG('TRY_DCL: MATCHED P_FIX2 LOCAL VARIABLE') EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG_FIX2_22) OUT = NAME ' : String[' SIZE '];' :(NOT_ARG_FIX2_2222) NOT_ARG_FIX2_22 EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG_FIX2_222) OUT = NAME ' : Array[1..' SIZE '] Of Char;' :(NOT_ARG_FIX2_2222) NOT_ARG_FIX2_222 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG_FIX2_222_) OUT = NAME ' : Array[1..' SIZE '] Of Boolean;' :(NOT_ARG_FIX2_2222) NOT_ARG_FIX2_222_ OUT = NAME ' :' TYPE_IS ';' NOT_ARG_FIX2_2222 SYM_TABLE_MANAGER(NAME + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_ATOMIC + ,1 + ,1 + ,0 + ,0 + ,0 + ,0 + ) :(TRY_FIX2_LOOP1) ******* TRY_FIX3_3 DEBUG('TRY_DCL : MATCH FOR P_FIX3_3') DCL_LINE P_FIX3_3 :F(TRY_FIX3_2) DEBUG('TRY_DCL: MATCHED P_FIX3_3 IN LOOP') IDENT(TTYPE,'FIXED') :F(F3_3) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F3_31_CONT) F3_3 IDENT(TTYPE,'FLOAT') :F(F3_31) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F3_31_CONT) F3_31 IDENT(TTYPE,'CHAR') :F(F3_112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F31_CONT_CHAR) F3_112 IDENT(TTYPE,'CHARACTER') :F(F3_112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F31_CONT_CHAR) F3_112_ IDENT(TTYPE,'BIT') ;F(FRETURN) TYPE_ID = G_BIT_TYPE TYPE_IS = 'Boolean' F31_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F3_31_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_TYPE) :F(F31_CONT_CHAR_) TYPE_ID = G_BIT_ARRAY :(F3_31_CONT) F3_31_CONT_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F3_31_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F3_31_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX3_A3__) OUT = 'Label 10;' G_ISSUED_LABEL = YES NOT_ARG_FIX3_A3__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX3_A3___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX3_A3___ ARG_POSITION = ARG_MANAGER(V1) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX1_A3) DEBUG('TRY_DCL: MATCHED P_FIX3_3: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(V1 + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_3D_TYPE + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(RETURN) NOT_ARG_FIX3_A3 DEBUG('TRY_DCL: MATCHED P_FIX3_3 LOCAL VARIABLE') EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG3_FIX3_A33) OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of String[' SIZE '];' :(NOT_ARG3_FIX3_A3333) NOT_ARG3_FIX3_A33 EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG3_FIX3_A333) OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of Array [1..' SIZE '] Of Char;' :(NOT_ARG3_FIX3_A3333) NOT_ARG3_FIX3_A333 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG_FIX3_A333_) OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of Array [1..' SIZE '] Of Boolean;' :(NOT_ARG3_FIX3_A3333) NOT_ARG_FIX3_A333_ OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 ',1..' FIX3 ']' + ' Of ' TYPE_IS ';' NOT_ARG3_FIX3_A3333 SYM_TABLE_MANAGER(V1 + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_3D_TYPE + ,FIX1 + ,1 + ,FIX2 + ,1 + ,FIX3 + ,1 + ) :(RETURN) ***** TRY_FIX3_2 DEBUG('TRY DCL: MATCH FOR P_FIX3_2') DCL_LINE P_FIX3_2 :F(TRY_FIX3_1) DEBUG('TRY_DCL: MATCHED P_FIX3_2 IN LOOP') IDENT(TTYPE,'FIXED') :F(F3_21) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F3_21_CONT) F3_21 IDENT(TTYPE,'FLOAT') :F(F3_22) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F3_21_CONT) F3_22 IDENT(TTYPE,'CHAR') :F(F33_112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F331_CONT_CHAR) F33_112 IDENT(TTYPE,'CHARACTER') :F(F33_112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F331_CONT_CHAR) F33_112_ IDENT(TTYPE,'BIT') F(FRETURN) TYPE_ID = G_BIT_TYPE TYPE_ID = 'Boolean' F331_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F3_21_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_TYPE) :F(F331_CONT_CHAR_) TYPE_ID = G_BIT_ARRAY :(F3_21_CONT) F331_CONT_CHAR_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F3_21_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F3_21_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX3_A2__) OUT = 'Label 10;' G_ISSUED_LABEL = YES NOT_ARG_FIX3_A2__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX3_A2___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX3_A2___ ARG_POSITION = ARG_MANAGER(V1) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX3_A2) DEBUG('TRY_DCL: MATCHED P_FIX3_2: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(V1 + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_2D_TYPE + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(RETURN) NOT_ARG_FIX3_A2 DEBUG('TRY_DCL: MATCHED P_FIX3_2 LOCAL VARIABLE') EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG2_FIX1_A22) OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 ']' OF ' String' + '[' SIZE '];' :(NOT_ARG2_FIX1_A2222) NOT_ARG2_FIX1_A22 EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG2_FIX1_A222) OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 '] Of Array[1..' + SIZE '] Of Char;' :(NOT_ARG2_FIX1_A2222) NOT_ARG2_FIX1_A222 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG2_FIX1_A222_) OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 '] Of Array[1..' + SIZE '] Of Boolean;' :(NOT_ARG2_FIX1_A2222) NOT_ARG2_FIX1_A222_ OUT = V1 ': Array[1..' FIX1 ',1..' FIX2 '] Of ' TYPE_IS ';' NOT_ARG2_FIX1_A2222 SYM_TABLE_MANAGER(V1 + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_2D_TYPE + ,FIX1 + ,1 + ,FIX2 + ,1 + ,0 + ,0 + ) :(RETURN) ****** TRY_FIX3_1 DEBUG('TRY_DCL : MATCH FOR P_FIX3_1') DCL_LINE P_FIX3_1 :F(TRY_FIX4) DEBUG('TRY_DCL: MATCHED P_FIX3_1 IN LOOP') IDENT(TTYPE,'FIXED') :F(F3_11) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F3_11_CONT) F3_11 IDENT(TTYPE,'FLOAT') :F(F3_12) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F3_11_CONT) F3_12 IDENT(TTYPE,'CHAR') :F(F333_112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F3331_CONT_CHAR) F333_112 IDENT(TTYPE,'CHARACTER') :F(F333_112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F331_CONT_CHAR) F333_112_ IDENT(TTYPE,'BIT') :F(FRETURN) TYPE_ID = G_BIT_TYPE TYPE_IS = 'Boolean' F3331_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F3_11_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_TYPE) :F(F3331_CONT_CHAR_) TYPE_ID = G_BIT_ARRAY :(F3_11_CONT) F3331_CONT_CHAR_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F3_11_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F3_11_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX3_A1__) OUT = 'Label 10;' G_ISSUED_LABEL = YES NOT_ARG_FIX3_A1__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX3_A1___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX3_A1___ ARG_POSITION = ARG_MANAGER(V1) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX1_A1) DEBUG('TRY_DCL: MATCHED P_FIX3_1: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(V1 + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_VECTOR_TYPE + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(RETURN) NOT_ARG_FIX3_A1 DEBUG('TRY_DCL: MATCHED P_FIX3_1 LOCAL VARIABLE NAME=' V1) EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG31_FIX1_A11) DEBUG('TRY_DCL: EQ SUCCEEDED AS SHOULD I WILL OUTPUT') OUT = V1 ': Array[1..' FIX1 ']' 'Of ' 'String[' SIZE '];' DEBUG('TRY_DCL: AFTER OUTPUT IT SHOULD WORKED') :(NOT_ARG31_FIX1_A1111) NOT_ARG31_FIX1_A11 DEBUG('TRY DCL: IAM CHECKING FOR CHAR ARRAY TYPE') EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG31_FIX1_A111) DEBUG('TRY DCL: CHAR ARRAY TYPE SUCCESSD') OUT = V1 ': Array[1..' FIX1 ']' ' Of ' 'Array[1..' SIZE ']' + ' Of Char;' :(NOT_ARG31_FIX1_A1111) NOT_ARG31_FIX1_A111 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG31_FIX1_A11_) OUT = V1 ': Array[1..' FIX1 ']' ' Of ' 'Array[1..' SIZE ']' + ' Of Boolean;' :(NOT_ARG31_FIX1_A1111) NOT_ARG31_FIX1_A11_ OUT = V1 ': Array[1..' FIX1 '] Of ' TYPE_IS ';' NOT_ARG31_FIX1_A1111 SYM_TABLE_MANAGER(V1 + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_VECTOR_TYPE + ,FIX1 + ,1 + ,0 + ,0 + ,0 + ,0 + ) :(RETURN) ****** TRY_FIX4 DEBUG('TRY_DCL : MATCH FOR P_FIX4') DCL_LINE P_FIX4 :F(TRY_FIX2) DEBUG('TRY_DCL: MATCHED P_FIX4 IN LOOP') IDENT(TTYPE,'FIXED') :F(F4) TYPE_ID = G_INT_TYPE TYPE_IS = 'Integer' :(F4_CONT) F4 IDENT(TTYPE,'FLOAT') :F(F4_1) TYPE_ID = G_FLT_TYPE TYPE_IS = 'Real' :(F4_CONT) F4_1 IDENT(TTYPE,'CHAR') :F(F4333_112) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F43331_CONT_CHAR) F4333_112 IDENT(TTYPE,'CHARACTER') :F(F4333_112_) TYPE_ID = G_CHA_TYPE TYPE_IS = 'Char' :(F43331_CONT_CHAR) F4333_112_ IDENT(TTYPE,'BIT') :F(FRETURN) TYPE_ID = G_BIT_TYPE TYPE_IS = 'Boolean' F43331_CONT_CHAR DEBUG('TRY_DCL: IN CONT CHAR TRAIL=' TRAIL) TRAIL BREAK('(') '(' BREAK(NUMBERS) SPAN(NUMBERS) . SIZE + ')' REM . CHAR_FLAVOR :F(F4_CONT) DEBUG('TRY_DCL: CHAR FLAVOR = ' CHAR_FLAVOR) EQ(TYPE_ID,G_BIT_ARRAY) :F(F43331_CONT_CHAR_) TYPE_ID = G_BIT_ARRAY :(F4_CONT) F43331_CONT_CHAR_ TYPE_ID = G_CHAR_ARRAY CHAR_FLAVOR BREAK(LETTERS) ('VAR' ! 'VARYING') :F(F4_CONT) STRUCT_IS = 'String' TYPE_ID = G_CHAR_STRING DEBUG('TRY_DCL: ITS A STRING') F4_CONT EQ(G_ISSUED_LABEL,YES) :S(NOT_ARG_FIX4__) OUT = 'Label 10;' G_ISSUED_LABEL = YES NOT_ARG_FIX4__ EQ(G_ISSUED_VAR,YES) :S(NOT_ARG_FIX4___) OUT = 'Var' G_ISSUED_VAR = YES NOT_ARG_FIX4___ ARG_POSITION = ARG_MANAGER(V1) EQ(ARG_POSITION,0) :S(NOT_ARG_FIX4) DEBUG('TRY_DCL: MATCHED P_FIX4: THIS AN ARG') ** if an arg this size allready in descriptor SYM_TABLE_MANAGER(V1 + ,YES + ,ARG_POSITION + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,0 + ,G_ATOMIC + ,0 + ,0 + ,0 + ,0 + ,0 + ,0 + ) :(RETURN) NOT_ARG_FIX4 DEBUG('TRY_DCL: MATCHED P_FIX4 LOCAL VARIABLE') EQ(TYPE_ID,G_CHAR_STRING) :F(NOT_ARG_FIX4_11) OUT = V1 ': String[' SIZE '];' :(NOT_ARG_FIX4_1111) NOT_ARG_FIX4_11 EQ(TYPE_ID,G_CHAR_ARRAY) :F(NOT_ARG_FIX4_111) OUT = V1 ': Array[1..' SIZE '] Of Char;' :(NOT_ARG_FIX4_1111) NOT_ARG_FIX4_111 EQ(TYPE_ID,G_BIT_ARRAY) :F(NOT_ARG_FIX4_111_) OUT = V1 ': Array[1..' SIZE '] Of Boolean;' :(NOT_ARG_FIX4_1111) NOT_ARG_FIX4_111_ OUT = V1 ': ' TYPE_IS ';' NOT_ARG_FIX4_1111 SYM_TABLE_MANAGER(V1 + ,NO + ,0 + ,TYPE_ID + ,LEX_LEVEL(G_BST) + ,G_CB + ,G_ATOMIC + ,1 + ,1 + ,0 + ,0 + ,0 + ,0 + ) :(RETURN) *************************************************************** SYM_TABLE_MANAGER DEBUG('SYM TABLE MANAGER: ENTER') G_ID_COUNT = G_ID_COUNT + 1 DEBUG('SYM MANAGER: G_ID_COUNT=' G_ID_COUNT ) G_SYM = G_SYME() DEBUG('SYM MANAGER: BEFOR LOADING OBJ NAME P1=' P1) OBJ_NAME(G_SYM) = P1 DEBUG('SYM MGR: ARG OBJ P2=' P2) ARG_OBJECT(G_SYM) = P2 DEBUG('SYM MGR: ARG POS P3=' P3) ARG_POS(G_SYM) = P3 DEBUG('SYM MGR: OBJ DATA TYPE P4=' P4) OBJ_DATA_TYPE(G_SYM) = P4 DEBUG('SYM MGR: LEX LEVEL P5 = ' P5) LEX_LEVEL(G_SYM) = P5 DEBUG('SYM MGR: BLOCK NUM P6=' P6) BLOCK_NUM(G_SYM) = P6 DEBUG('SYM MGR: STRUCT TYPE P7=' P7) STRUCT_TYPE(G_SYM) = P7 DEBUG('SYM MGR: UB1= P8 = ' P8) UB1(G_SYM) = P8 DEBUG('SYM MGR: LB1 P9 = ' P9) LB1(G_SYM) = P9 DEBUG('SYM MGR UB2 P10 =' P10) UB2(G_SYM) = P10 DEBUG('SYM MGR LB2= P11=' P11) LB2(G_SYM) = P11 DEBUG('SYM MGR: UB3 P12=' P12) UB3(G_SYM) = P12 DEBUG('SYM MGR: LB3 P13=' P13) LB3(G_SYM) = P13 :(RETURN) ******************************************************************* ******************************************************************* TRY_EXEC ** INPUT TO THIS FUNCTION IS EXEC_LINE FROM PROCESS FUNCTION ** DEBUG('TRY EXEC: ABOUT TO CHECK IF WRITEN PAS RUN TIME') EQ(G_RUN_TIME_DONE,NO) :F(TRY_EXEC_L1) DEBUG('TRY_EXEC: FOUND IAM IN MAIN LINE TO DO PAS RUN') DEFINE('EMIT_PASCAL_RUN_TIME()') EMIT_PASCAL_RUN_TIME() G_RUN_TIME_DONE = YES TRY_EXEC_L1 CHECK_BEGIN_ISSUED() DEFINE('TRY_IF(IF_LINE)AUX,BOOL_PART,EXPR_PART,LHS,' + 'BOOL_OP,RHS,RET_PART,OP') DEFINE('TRY_DOWHILE(DOWHILE_LINE)') DEFINE('TRY_PUT(PUT_LINE)AUX,P,LHS1,' + 'RHS1,OP,LIST1_,LIST,LIT,FIRST_ELE,IDENT1,' + 'CELL1') DEFINE('TRY_CALL(CALL_LINE)') DEFINE('TRY_DO(DO_LINE)') DEFINE('TRY_END_DO(ENDDO_LINE)') DEFINE('TRY_ASSIGNMENT(ASSIGN_LINE)AUX,LHS,RHS,IDENT1,' + 'DIM,ARRAY_NAME,STR1,STR2,STR,START_POS,' + 'LEFTOVER,HOW_LONG,ID1,OP1,ID2,TEMPO,NAME1,' + 'NAME2,NUM,ARR_NAME,INDEX1,VAL') DEBUG('TRY EXEC : ABOUT TO CHECK FOR IF LINE') EXEC_LINE BREAK(LETTERS) 'IF' :F(TRY_EXEC_1) TRY_IF(EXEC_LINE) :F(FRETURN)S(RETURN) TRY_EXEC_1 DEBUG('BEFOR THE STRANG AREA EXEC_LINE=' EXEC_LINE) DEBUG('TRY EXEC : ABOUT TO CHECK FOR PUT') EXEC_LINE BREAK(LETTERS) 'PUT' :F(TRY_EXEC_2) DEBUG('TRY EXEC : PUT WORKING') TRY_PUT(EXEC_LINE) :F(FRETURN)S(RETURN) TRY_EXEC_2 DEBUG('TRY EXEC : ABOUT OT CHECK FOR DO WHIL') DEBUG('BEFOR THE STRANG AREA EXEC_LINE=' EXEC_LINE) EXEC_LINE BREAK(LETTERS) 'DO' BREAK(LETTERS) 'WHILE' :F(TRY_EXEC_3) DEBUG('TRY EXEC DOWHIL SUCCESSD') TRY_DOWHILE(EXEC_LINE) :F(FRETURN)S(RETURN) TRY_EXEC_3 DEBUG('TRY EXEC ABOUT OT MATCH FOR CALL') EXEC_LINE BREAK(LETTERS) 'CALL' :F(TRY_EXEC_4) TRY_CALL(EXEC_LINE) :F(FRETURN)S(RETURN) TRY_EXEC_4 EXEC_LINE BREAK(LETTERS) 'DO' :F(TRY_EXEC_5) TRY_DO(EXEC_LINE) :F(FRETURN)S(RETURN) TRY_EXEC_5 EXEC_LINE BREAK(LETTERS) 'END' :F(TRY_EXEC_6) TRY_END_DO(EXEC_LINE) :F(FRETURN)S(RETURN) TRY_EXEC_6 EXEC_LINE ARB '=' :F(FRETURN) TRY_ASSIGNMENT(EXEC_LINE) :F(FRETURN)S(RETURN) ************************************************************ TRY_IF ** INPUT TO THIS FUNCTION IS IF STATMENT AUX = ' ' BOOL_OP = ( '=' ! '^=' ! '<' ! '>' ) DEBUG('TRY_IF: ENTER') IF_LINE BREAK(LETTERS) 'IF' BREAK(LETTERS) ARB . BOOL_PART + 'THEN' BREAK(LETTERS) REM . EXPR_PART :F(FRETURN) DEBUG('TRY_IF BOOL PART = ' BOOL_PART) DEBUG('TRY_IF: EXPT PART = ' EXPR_PART) AUX = ' IF ' BOOL_PART ARB . LHS BOOL_OP . OP + BREAK(LETTERS) REM . RHS AUX = AUX ' ' PROCESS_L_ENTITY(LHS) IDENT(OP,'=') :F(IF_1) AUX = AUX ' = ' :(IF_RHS) IF_1 IDENT(OP,'<') :F(IF_2) AUX = AUX ' < ' :(F_RHS) IF_2 IDENT(OP,'>') :(IF_3) AUX = AUX ' > ' :(F_RHS) IF_3 IDENT(OP,'^=') :F(FRETURN) AUX = AUX '<>' IF_RHS DEBUG('TRY IF: IN IF_RHS AUX=' AUX) AUX = AUX ' ' PROCESS_R_ENTITY(RHS) OUT = AUX AUX = ' ' AUX = AUX ' Then ' DEBUG('TRY_IF: BEFOR CHECKING FOR RETURNS ') EXPR_PART BREAK(LETTERS) 'RETURN' REM . RET_PART :F(IF_4) AUX = AUX ' ' PROCESS_RET_PART(RET_PART) OUT = AUX AUX = ' ' DEBUG('TRY_IF: AFTER RETURN FROM PROCESS RET PART') DEBUG('TRY IF AUX = ' AUX) OUT = AUX :(RETURN) IF_4 DEBUG('TRY_IF: RETURN NOT FOUND LOOK FOR DO') EXPR_PART BREAK(LETTERS) 'DO' :F(IF_5) AUX = AUX ' Begin' OUT = AUX :(RETURN) IF_5 OUT = AUX :(RETURN) ******************************************************** PROCESS_L_ENTITY DEBUG(' PROCESS_L ENTITY : ENTER') LHS_LINE BREAK(LETTERS) SPAN(LETTERS) . IDENT DEBUG('PROCESS L ENTITY IDENT= ' IDENT) ARG_POS = ARG_MANAGER(IDENT) DEBUG('PROC L ENTITY PROG POS=' ARG_POS) EQ(ARG_POS,0) :S(NOT_ARG_1) PROCESS_L_ENTITY = 'LhsCodeGenerator(' ARG_POS ')' :(RETURN) NOT_ARG_1 PROCESS_L_ENTITY = IDENT :(RETURN) *************************************************************** PROCESS_R_ENTITY AUX1 = ' ' RHS_LINE BREAK(LETTERS) 'LENGTH' '(' ARB . IDENT ')' :F(R_ENT_1) ARG_POS = ARG_MANAGER(IDENT) DEBUG('PROCES R ENTITY: FOUND IT A LENGTH') DEBUG(' PROC R ENTITY AND THE POS= ' ARG_POS) EQ(ARG_POS,0) :S(R_ENT_2) AUX1 = AUX1 ' GlobalArgList.Desriptors[' ARG_POS ']^' + '.NumberOfCells' DEBUG('PROC R ENTITY AUX1=' AUX1) PROCESS_R_ENTITY = AUX1 :(RETURN) R_ENT_2 AUX1 = AUX1 ' Length(' IDENT ')' PROCESS_R_ENTITY = AUX1 :(RETURN) R_ENT_1 :(RETURN) ************************************************************** PROCESS_RET_PART DEBUG('PROCESS_RET_PART : ENTER') DEBUG('PROC RET PART = ' RET_PART_LINE) ** AUX = AUX PROCESS_RET_PART(RET_PART) RET_PART_LINE BREAK('(') '(' ARB . IDENT1 ')' PROC_NAME = NAME(G_BST) DEBUG('ON PROC RET PART THE PROC NAME=' PROC_NAME) AUX1 = 'Begin ' PROC_NAME ':= ' IDENT1 "'0'B" :F(FF_1) AUX1 = AUX1 ' False; Goto 10 End;' PROCESS_RET_PART = AUX1 :(RETURN) FF_1 IDENT1 "'1'B" :F(FF_2) AUX1 = AUX1 ' True ; Goto 10 End;' PROCESS_RET_PART = AUX1 :(RETURN) FF_2 PROCESS_RET_PART = 'Begin ' PROC_NAME ':= ' IDENT ' GoTo 10; End' :(RETURN) ************************************************************* TRY_DOWHILE :(FRETURN) ************************************************************* TRY_PUT DEBUG('PUT SKIP : ENTERED') PUT_LINE BREAK(LETTERS) 'PUT' BREAK(LETTERS) 'SKIP' + BREAK(LETTERS) 'LIST' BREAK('(') '(' + REM . LIST :F(TRY_PUT1) DEBUG('PUT SKIP: LIST = ' LIST) AUX = 'WRITELN(' FIRST_ELE = YES LOOP11 LIST (ARB . P) ',' = :F(LOOP11_) LOOP1 DEBUG('TRY PUT P=' P) P "'" ARB . LIT "'" :F(TRY_NOT_LIT) DEBUG('TRY PUT: LIT=' LIT) EQ(FIRST_ELE,YES) :F(JUMPO_OVER) FIRST_ELE = NO AUX = AUX "'" LIT "'" ',' :(LOOP11) JUMPO_OVER AUX = AUX "'" LIT "'" ',' :(LOOP11) TRY_NOT_LIT DEBUG('TRY PUT IT WAS NOT LITERAL') P BREAK(LETTERS) ARB . LHS1 SPAN('=^=><=<>=') . OP + REM . RHS1 :F(TRY_ARRAY) EQ(FIRST_ELE,YES) :F(JUMPO_OVER11) FIRST_ELE = NO AUX = AUX 'PUTBOOL(' LHS1 ',' RHS1 ',' "'" OP "'" ')' ' ,' :(LOOP11) JUMPO_OVER11 AUX = AUX 'PUTBOOL(' LHS1 ',' RHS1 ',' "'" OP "'" ')' ' ,' :(LOOP11) TRY_ARRAY DEBUG('TRY PUT: ABOUT TO CHECK FOR ARRAY') P BREAK(LETTERS) ARB . IDENT1 '(' ARB . LIST1_ ')' :F(TRY_IDENT) LIST1_ BREAK('*') :S(TRY_IDENT_CROSS) EQ(FIRST_ELE,YES) :F(JUMPO_OVER111) FIRST_ELE = NO AUX = AUX IDENT1 '(' LIST1_ ')' ' ,' :(LOOP11) JUMPO_OVER111 AUX = AUX IDENT1 '(' LIST1_ ')' ' ,' :(LOOP11) TRY_IDENT_CROSS FIRST_ELE = NO :(FRETURN) TRY_IDENT EQ(FIRST_ELE,YES) :F(JUMPO_OVER1111) FIRST_ELE = NO AUX = AUX P ',' :(LOOP11) JUMPO_OVER1111 AUX = AUX P ',' :(LOOP11) LOOP11_ DEBUG('TRY PUT : ITS ONE ELEMENT ') LIST "'" ARB . CELL1 "'" :F(LOOP___1) DEBUG('TRY PUT: IT IS A LITERAL CELL1=' CELL1) AUX = AUX "'" CELL1 "'" ')' OUT = AUX ';' :(RETURN) LOOP___1 DEBUG('TRY PUT: IT WAS NOT LITERAL') LIST BREAK(LETTERS) ARB . LHS1 ('=' ! '^=' ! '>' ! '<' ! '=<' + ! '>=') . OP REM . RHS1 :F(TRY_ARRAY1) DEBUG('TRY PUT LHS1=' LHS1 'RHS1=' RHS1 'OP=' OP) AUX = AUX 'PUTBOOL(' LHS1 ',' RHS1 ',' "'" OP "'" ')' OUT = AUX ';' :(RETURN) TRY_ARRAY1 LIST BREAK(LETTERS) . IDENT1 '(' ARB . LIST1_ ')' :F(TRY_IDENT1) LIST1_ BREAK('*') :S(TRY_IDENT_CROSS1) AUX = AUX IDENT1 '(' LIST1_ ')' OUT = AUX ';' :(RETURN) TRY_IDENT_CROSS1 OUT = AUX :(RETURN) TRY_IDENT1 AUX = AUX LIST OUT = AUX ';' :(RETURN) TRY_PUT1 PUT_LINE BREAK(LETTERS) 'PUT' BREAK(LETTERS) 'SKIP' :F(FRETURN) AUX = ' ' AUX = 'Write;' OUT = AUX :(RETURN) *************************************************************** TRY_CALL :(FRETURN) ************************************************************* TRY_DO :(FRETURN) ************************************************************* TRY_END_DO :(FRETURN) *********************************************************** GET_CODE_FOR_GENERIC_IDENT_L_FLAVOR ARG_POS = ARG_MANAGER(ID_LOOK) EQ(ARG_POS,0) :S(NOT_ARG_IN_FLAVOR) GET_CODE_FOR_GENERIC_IDENT_L_FLAVOR = 'ReferenceCodeGenerator' + '(' ARG_POS ');' :(RETURN) NOT_ARG_IN_FLAVOR GET_CODE_FOR_GENERIC_IDENT_L_FLAVOR = ID_LOOK :(RETURN) ************************************************************ GET_HBOUND_ON_IDENT_DIM DEFINE('SYMBOL_TABLE_LOOKUP_HBOUND(MYNAME,DIM)CC') ARG_POS = ARG_MMANAGER(ANAME) EQ(ARG_POS,0) :S(NOT_ARG_IN_HBOUND) GET_HBOUND_ON_IDENT_DIM = 'GlobalArgList.Descriptors[' + ARG_POS ']^UB[' ADIM ']' :(RETURN) NOT_ARG_IN_HBOUND ** if not an argumnet look the lbound and hbound ** from the symbol table indexed by current block number ** since local variable search from right dimension also EQ(ADIM,1) :F(TRY_DIM2) GET_HBOUND_ON_IDENT_DIM = SYMBOL_TABLE_LOOKUP_HBOUND(ANAME,1) :(RETURN) TRY_DIM2 EQ(ADIM,2) :F(TRY_DIM3) GET_HBOUND_ON_IDENT_DIM = SYMBOL_TABLE_LOOKUP_HBOUND(ANAME,2) :(RETURN) TRY_DIM3 GET_HBOUND_ON_IDENT_DIM = SYMBOL_TABLE_LOOKUP_HBOUND(ANAME,3) :(RETURN) ****************************************************************** GET_LBOUND_ON_IDENT_DIM DEFINE('SYMBOL_TABLE_LOOKUP_LBOUND(MYNAME,DIM)CC') ARG_POS = ARG_MMANAGER(ANAME) EQ(ARG_POS,0) :S(NOT_ARG_IN_LBOUND) GET_HBOUND_ON_IDENT_DIM = 'GlobalArgList.Descriptors[' + ARG_POS ']^LB[' ADIM ']' :(RETURN) NOT_ARG_IN_LBOUND ** if not an argumnet look the lbound and hbound ** from the symbol table indexed by current block number ** since local variable search from right dimension also EQ(ADIM,1) :F(TRY_DIM2_) GET_LBOUND_ON_IDENT_DIM = SYMBOL_TABLE_LOOKUP_LBOUND(ANAME,1) :(RETURN) TRY_DIM2_ EQ(ADIM,2) :F(TRY_DIM3_) GET_LBOUND_ON_IDENT_DIM = SYMBOL_TABLE_LOOKUP_LBOUND(ANAME,2) :(RETURN) TRY_DIM3_ GET_LBOUND_ON_IDENT_DIM = SYMBOL_TABLE_LOOKUP_LBOUND(ANAME,3) :(RETURN) *************************************************************** SYMBOL_TABLE_LOOKUP_LBOUND CC = 0 LOOP_LBOUND1 CC = CC + 1 IDENT(OBJ_NAME(G_SYM),MYNAME) :S(CHECK_BLOCK_ALSO) + F(LOOP_LBOUND1) CHECK_BLOCK_ALSO EQ(BLOCK_NUMBER(G_SYM),G_CB) :F(LOOP_LBOUND1) EQ(DIM,3) :F(TRY_IT_FOR_2) SYMBOL_TABLE_LOOKUP_LBOUND = LB3(G_SYM) :(RETURN) TRY_IT_FOR_2 EQ(DIM,2) :F(TRY_IT_FOR_1) SYMBOL_TABLE_LOOKUP_LBOUND = LB2(G_SYM) :(RETURN) TRY_IT_FOR_1 SYMBOL_TABLE_LOOKUP_LBOUND = LB1(G_SYM) :(RETURN) *************************************************** SYMBOL_TABLE_LOOKUP_HBOUND CC = 0 LOOP_HBOUND1 CC = CC + 1 IDENT(OBJ_NAME(G_SYM),MYNAME) :S(CHECK_BLOCK_ALSO_) GT(CC,G_ID_COUNT) :S(FRETURN)F(LOOP_HBOUND1) CHECK_BLOCK_ALSO_ EQ(BLOCK_NUMBER(G_SYM),G_CB) :F(LOOP_HBOUND1) EQ(DIM,3) :F(TRY_IT_FOR_2_) SYMBOL_TABLE_LOOKUP_HBOUND = HB3(G_SYM) :(RETURN) TRY_IT_FOR_2_ EQ(DIM,2) :F(TRY_IT_FOR_1_) SYMBOL_TABLE_LOOKUP_HBOUND = HB2(G_SYM) :(RETURN) TRY_IT_FOR_1_ SYMBOL_TABLE_LOOKUP_HBOUND = HB1(G_SYM) :(RETURN) ********************************************************* TRY_ASSIGNMENT DEBUG('TRY ASSIG : ENTER') DEFINE('GET_CODE_FOR_GENERIC_IDENT_L_FLAVOR(ID_LOOK)ARG_POS') DEFINE('GET_HBOUND_ON_IDENT_DIM(ANAME,ADIM)ARG_POS') DEFINE('GET_LBOUND_ON_IDENT_DIM(ANAME,ADIM)ARG_POS') AUX = ' ' ASSIGN_LINE ARB . LHS '=' REM . RHS :F(FRETURN) LHS BREAK(LETTERS) SPAN(LETTERS) . IDENT1 AUX =AUX GET_CODE_FOR_GENERIC_IDENT_L_FLAVOR(IDENT1) :F(FRETURN) AUX = AUX '=' DEBUG('TRY ASSIG : AFTER DOIN LHS') RHS BREAK(LETTERS) 'HBOUNND' BREAK('(') '(' ARB . ARRAY_NAME + BREAK(',') ',' BREAK(NUMBERS) . DIM BREAK(')') ')' :F(TRY_ASSIGN_LBOUND) ** find first if ident is local if so the hbound and lbound ** i have in the symbol table if not local but an argument ** i will get the data from the descriptor at run time by ** generating pascal code ARG_POS = ARG_MANAGER(ARRAY_NAME) EQ(ARG_POS,0) :S(TRY_ASSIGN_NOT_ARG__) AUX = AUX 'GlobalArgList.Descriptors[' ARG_POS ']^.UB[' DIM ']' OUT = AUX ';' :(RETURN) TRY_ASSIGN_NOT_ARG__ AUX = AUX GET_HBOUND_ON_IDENT_DIM(ARRAY_NAME,DIM) OUT = AUX ';' :(RETURN) **** TRY_ASSIGN_LBOUND RHS BREAK(LETTERS) 'LBOUNND' BREAK('(') '(' ARB . ARRAY_NAME + BREAK(',') ',' BREAK(NUMBERS) . DIM BREAK(')') ')' :F(TRY_ASSIGN_BIT_VALUE) ARG_POS = ARG_MANAGER(ARRAY_NAME) EQ(ARG_POS,0) :S(TRY_ASSIGN_NOT_ARG) AUX = AUX 'GlobalArgList.Descriptors[' ARG_POS ']^.LB[' DIM ']' OUT = AUX ';' :(RETURN) TRY_ASSIGN_NOT_ARG AUX = AUX GET_LBOUND_ON_IDENT_DIM(ARRAY_NAME,DIM) OUT = AUX ';' :(RETURN) **** TRY_ASSIGN_BIT_VALUE RHS BREAK("'") "'0'B" :F(TRY_ASSIGN_BIT_POS) AUX = AUX ' False;' OUT = AUX :(RETURN) *** RHS BREAK("'") "'1'B" :F(TRY_ASSIGN_STRING_CONT) AUX = AUX ' True;' OUT = AUX :(RETURN) **** TRY_ASSIGN_STRING_CONT RHS BREAK("'") "'" ARB . STR1 "'" BREAK('|') '||' BREAK("'") + "'" ARB . STR2 "'" :F(TRY_ONE_STRING) AUX = AUX "'" STR1 "'" ' + ' "'" STR2 "'" OUT = AUX ';' :(RETURN) ***** TRY_ONE_STRING RHS BREAK("'") ARB . STR "'" :F(TRY_SUBSTR) AUX = AUX "'" STR "'" ';' ***** TRY_SUBSTR RHS BREAK(LETTERS) 'SUBSTR' BREAK('(') '(' BREAK(LETTERS) + . ARRAY_NAME BREAK(',') ',' ARB . START_POS + BREAK(',') ',' BREAK(NUMBERS) . HOW_LONG ')' REM . LEFTOVER :F(TRY_LOGICAL_AND) ** first resolve the pos since they could be non local also START_POS BREAK(LETTERS) . ID1 SPAN('+/*-') . OP1 BREAK(LETTERS) + REM . ID2 :F(TRY_ONE_IDENT_ON_STRT) IDENT(OP1,'+') :F(TRY_OTHER_OPTIONS) ARG_POS = ARG_MANAGER(ID1) EQ(ARG_POS,0) :S(FIRST_IS_LOCAL) TEMPO = 'GlobalArgList.Descriptors[' ARG_POS ']^.First^.f2' TEMP = TEMP '+' :(TRY_FOR_SECOND) FIRST_IS_LOCAL TEMPO = ID1 '+' TRY_FOR_SECOND ARG_POS = ARG_MANAGER(ID2) EQ(ARG_POS,0) :S(SECOND_IS_LOCAL) TEMPO = TEMPO 'GlobalArgList.Descriptors[' + ARG_POS ']^.First^.f2' :(GOT_ALL) SECOND_IS_LOCAL TEMPO = TEMPO ID2 GOT_ALL ARG_POS = ARG_MANAGER(ARRAY_NAME) EQ(ARG_POS,0) :S(NOT_ARG_IN_SUB) AUX = AUX 'SubStr(GlobalArgList.Descriptors[' ARG_POS '],' OUT = AUX AUX = TEMPO ',' HOW_LONG ');' OUT = AUX :(RETURN) ***** TRY_LOGICAL_AND RHS BREAK(LETTERS) . NAME1 BREAK('&') BREAK(LETTERS) + SPAN(LETTERS) . NAME2 :F(TRY_LOGICAL_OR) AUX = AUX NAME1 ' And ' NAME2 OUT = AUX ';' :(RETURN) *** TRY_LOGICAL_OR RHS BREAK(LETTERS) . NAME1 BREAK('|') BREAK(LETTERS) + SPAN(LETTERS) . NAME2 :F(TRY_IDENT_ADD_NUM) AUX = AUX NAME1 ' Or ' NAME2 OUT = AUX ';' :(RETURN) ***** TRY_IDENT_ADD_NUM RHS BREAK(LETTERS) . NAME1 BREAK('+') BREAK(NUMBERS) + SPAN(NUMBERS) . NUM :F(TRY_ID_ADD_ARRAY_ELE) AUX = AUX NAME1 ' + ' NUM OUT = AUX ';' :(RETURN) *** TRY_ID_ADD_ARRAY_ELE RHS BREAK(LETTERS) . ID1 BREAK('+') BREAK(LETTERS) . ARR_NAME + BREAK('(') '(' ARB . INDEX1 ')' :F(TRY_ID_ADD_ID) AUX = AUX ID1 ' +' ARR_NAME '(' INDEX1 ')' OUT = AUX ';' :(RETURN) *** TRY_ID_ADD_ID RHS BREAK(LETTERS) ARB . ID1 BREAK('+') REM . ID2 :F(TRY_ID_SUB_ID) AUX = AUX ID1 ' + ' ID2 OUT = AUX ';' :(RETURN) ** RHS BREAK(LETTERS) ARB . ID1 BREAK('-') REM . ID2 :F(TRY_ID_DIV_ID) AUX = AUX ID1 ' - ' ID2 OUT = AUX ';' :(RETURN) ** TRY_ID_DIV_ID RHS BREAK(LETTERS) ARB . ID1 BREAK('/') REM . ID2 :F(TRY_ID_MUL_ID) AUX = AUX ID1 ' Div ' ID2 OUT = AUX ';' :(RETURN) *** TRY_ID_MUL_ID RHS BREAK(LETTERS) ARB . ID1 BREAK('*') REM . ID2 :F(TRY_ID_EXP_ID) AUX = AUX ID1 ' * ' ID2 OUT = AUX ';' :(RETURN) ** TRY_ID_EXP_ID RHS BREAK(LETTERS) ARB . ID1 BREAK('*') '*' '*' REM . ID2 :F(TRY_JUST_ID) AUX = AUX 'Power(' ID1 ',' ID2 ')' OUT = AUX ';' :(RETURN) *** TRY_JUST_ID RHS BREAK(LETTERS) SPAN(LETTERS) . IDENT1 :F(TRY_JUST_NUM) AUX = AUX IDENT1 OUT = AUX ';' :(RETURN) ****** TRY_JUST_NUM RHS BREAK(NUMBERS) REM . VAL :(RETURN) AUX = AUX VAL OUT = AUX ';' :(RETURN) ********************************************************* TRY_END P_END = BREAK(LETTERS) 'END' END_LINE P_END = :F(FRETURN) DEFINE('CHECK_BEGIN_ISSUED()') CHECK_BEGIN_ISSUED() OUT = ' 10 : ' OUT = ' End ;' DEFINE('EPILOG()') EPILOG() ** flip begin flag off for next procedure G_BEGIN_DONE = NO :(RETURN) ****************************************************************** EMIT_PASCAL_GLOBAL_TYPES OUT = ' { $I TYPE.PAS }' :(RETURN) ************************************************************* EMIT_PASCAL_RUN_TIME OUT = ' { $I RUNTIME.PAS }' :(RETURN) *********************************************** DEBUG OUTPUT = DEBUG_LINE :(RETURN) END ** TYPE.PAS Const MaxDim=3; MaxArgs = 10; Type Natural = 1..32767; NumberOfArgType = 1..MaxArgs; DataIdType = (CharId,integerId,realId,booleanId); StructureIdType= (Vector,TwoDimArray,ThreeDimArray,Primitive); UpperRangType = Array[1..maxDim] of Natural; LowerRangType = UpperRangType; NumberOfCellLimit = 1..32676; ArgPosition = 1..MaxArgs; DimLimit = 1..MaxDim; DataTypeType = ^DataCelllType; DataCellType = Record f1 :char; f2 :integer; f3 :real; f4 :boolean; next :DataPtrType end; DescripPtrType = ^Descriptor; Descriptor = Record AtomicId : DataIdType; StructureId : StructureIdType; Dim : DimLimit; UB : UpperRangType; LB : LowerRangType; First : DataPtrType; Last : DataPtrType; NumberOfCells : NumberOfCellLimit End; ArglistType = Record NumberOfArg :NumberOfArgType; descriptors :Array[1..maxArgs] of DescripPtrType End; StringType1 = String[100]; VAR GlobalArgList : ArgListType; GlobalUpperRang : UpperRangType; GlobalLowerRang : LowerRangType; GlobalArgNumber : ArgPosition; GlobalDim : DimLimit; GlobalStructureId : StructureIdType; GlobalAtomicId : DataIdType; GlobalChar : char; GlobalInteger : integer; GlobalReal : Real; GlobalBoolean : Boolean; Counter1,Counter2,Counter3 : Natural; *** RUNTIME.PAS (*************************************************) Function ListIndex (ArgNumber :ArgPosition ;DescriptorPtr :DescriptorPtrType ;Index1,Index2,Index3 : Integer ): Natural; (* This function finds the position in the Linked List of the element specified by the subsripts Index1,Index2,Index3 How many of theses are used is found from the descriptor DIM field *) Var i : integer; RowSize : integer; ColSize : integer; Begin Case DescriptorPtr^Dim of 1: ListIndex := Index1; 2: Begin RowSize:= DescriptorPtr^UB[1]-DescriptorPtr^LB[1]+1; ListIndex:= ((index1-1)*rowSize)+index2 End; 3: Begin RowSize:= DescriptorPtr^UB[1]-DescriptorPtr^LB[1]+1; ColSize:= DescriptorPtr^UB[2]-DescriptorPtr^LB[2]+1; ListIndex := ( (Index1-1)*rowSize +(Index2-1)*ColSize +Index3 End End End; (********************************************************) Procedure GetArrayElement (DescriptorPtr :DescriptorPtrType ;Index : Natural ); Var i : integer; Ptr: DataPtrType; Begin Ptr := DescriptorPtr^First; FOR i:=1 to (index-1) do Ptr := ptr^next; Case DescriptorPtr^AtomicId of CharId : GlobalChar := ptr^f1; IntegerId: GlobalInteger := ptr^f2; RealId : GlobalReal := ptr^f3; BooleanId: GlobalBoolean := ptr^f4 End End; (*******************************************************) Procedure InitDescriptor; Var i : integer; Begin New(GlobalArgList.Descriptors[GlobalArgNumber]); With GlobalArgList.descriptors[GlobalArgNumber]^ do Begin AtomicId := GlobalAtomicId; StructurId := GlobalStructurId; Dim := GlobalDim; FOR i := 1 to GlobalDim do Begin UB[i]:= GlobalUpperRang[i]; LB[i]:= GlobalLowerRang[i] End; New(first); Last := first; Last^next := NIL End End; (*****************************************************) Procedure LoadDescriptor; Begin With GlobalArgList.Descriptors[GlobalArgNumber]^ do Begin Case GlobalAtomicId of CharId : Last^.f1 := GlobalChar; IntegerId : Last^.f2 := GlobalInteger; RealId : Last^.f3 := GlobalReal; BooleanId : Last^.f4 := GlobalBoolean End End; New(Last^next); Last := Last^next; Last^Next := NIL End; (***************************************************) Procedure InitGlobals; Var i:integer; Begin GlobalInteger := 0; GlobalReal := 0.0; GlobalChar := GlobalBoolean := False; For i:= 1 to MaxDim do Begin GlobalUpperRang[i] := 1; GlobalLowerRang[i] := 1 End End; (**************************************************) Procedure UnloadDescriptor; Begin With GlobalArgList.Descriptors[GlobalArgNumber]^ do Begin Case AtomicId of CharId : GlobalChar := Last^.f1; IntegerId: GlobalInteger := Last^.f2; RealId : GlobalReal := Last^.f3; BooleanId: GlobalBoolean := Last^.f4 End End; Last := Last^next End; (******************************************************) Function NumberOfCells : Integer; Var i: integer; Begin NumberOfCells := ((GlobalUpperRang[1]-GlobalLowerRang[1])+1) *((GlobalUpperRang[2]-GlobalLowerRang[2])+1) *((GlobalUpperRang[3]-GlobalLowerRang[3])+1) End; (***********************************************************) Function ReferenceCodeGenerator( ArgPosition : Integer) : StringType1; Var str : stringtype1; Type_str : string[2]; begin With GlobalArgList.Descriptors[argposition]^ do Begin Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of Case AtomicId of End; (***********************************************************) Procedure DisposeDescriptor; Var i : integer; Ptr: DataPtrType; Begin For i:= 1 to GlobalArgNumber do Begin With GlobalArgList.descriptors[i]^ do Begin Last:= First; While Last <> NIL do Begin ptr := Last^next; Dispose(last); Last := Ptr End End Dispose(GlobalArgList.Descriptors[i]) End; (*************************************************)