diff --git a/doc/c/amops.txt b/doc/c/amops.txt new file mode 100644 index 00000000..ebd3fdf4 Binary files /dev/null and b/doc/c/amops.txt differ diff --git a/doc/c/cc.pat b/doc/c/cc.pat new file mode 100644 index 00000000..26481df4 --- /dev/null +++ b/doc/c/cc.pat @@ -0,0 +1,27 @@ +CC patches to be made to export version: + +c22.c: add an external decl of "int *top()" + +c31.c: in main, change the argument to atoi from argv[8] to argv[7] + +c32.c: in txpr2, in the statement handling n_colon: + add "else type = p1->otype" + change chktyp to chktype + in chktype, add an initial test for null pointer + change free to e_free + +c33.c: change cg_floag to cg_float + +c34.c: change alloc to e_alloc and free to e_free + +c94.c: change ATOI so that it works given a string containing more + than one minus sign and does "the right thing" with the + smallest negative number + +FILES WHICH WERE NOT SENT: + +manfst.insert +nodeln.insert +nodeop.insert +gmnfst.insert + \ No newline at end of file diff --git a/doc/c/ccdoc.txt b/doc/c/ccdoc.txt new file mode 100644 index 00000000..7b77a2cc Binary files /dev/null and b/doc/c/ccdoc.txt differ diff --git a/doc/c/ccmake.hel b/doc/c/ccmake.hel new file mode 100644 index 00000000..4133fc27 Binary files /dev/null and b/doc/c/ccmake.hel differ diff --git a/doc/c/cdiffs.txt b/doc/c/cdiffs.txt new file mode 100644 index 00000000..ead206b7 Binary files /dev/null and b/doc/c/cdiffs.txt differ diff --git a/doc/c/cmac.txt b/doc/c/cmac.txt new file mode 100644 index 00000000..eb37ef94 Binary files /dev/null and b/doc/c/cmac.txt differ diff --git a/doc/c/keymac.txt b/doc/c/keymac.txt new file mode 100644 index 00000000..16cc5d5c Binary files /dev/null and b/doc/c/keymac.txt differ diff --git a/doc/c/phase.arg b/doc/c/phase.arg new file mode 100644 index 00000000..d0746b82 Binary files /dev/null and b/doc/c/phase.arg differ diff --git a/doc/c/recipe.cma b/doc/c/recipe.cma new file mode 100644 index 00000000..5ed559e7 --- /dev/null +++ b/doc/c/recipe.cma @@ -0,0 +1,97 @@ +.fo 0 25vg +.fo 2 25vgi +.sr list_left_margin 0 +.sr list_right_margin 0 +.so r/r.macros +.tr @ +Instructions for transport to PDP10 via CMAC macros. +.sp 2 +.fi +The following files are provided: +.ilist 4 0 +1. The source of two versions of the C compiler, one that produces +CMAC code and one that produces MIDAS PDP10 code. +.next +2. The source of GT, the program that processes machine +descriptions and produces compiler tables. +.next +3. Two test programs. +.next +4. The compiled CMAC code for the CMAC version of the compiler +and the test program TESTC. +.next +5. A set of MIDAS macro definitions that implement the CMAC +macros on the PDP-10 and a small support package that allows the +TESTC program to run on the ITS operating system. +.next +6. The source of a simple control routine that calls the +compiler phases. This program is provided primarily to show the algorithm. +.next +7. Some of the basic support routines for the ITS PDP-10 implementation. +.next +8. Some documentation. All recipients should first obtain MAC +TR-149 (A Portable Compiler for the Language C -- the major documentation +of the compiler, although slightly obsolete) and Bell Laboratories +Computing Science Technical Report No. 31 (The C Programming Language +-- defines C and a "standard" portable I/O library, which is somewhat +different than the one I use). +.end_list +.ne 10 +The following procedure is used to construct a compiler on a PDP10: +.ilist 4 0 +1. Modify the provided macro definitions (cmac.insert) and the +support routines (cmac.supprt) for your assembler and operating system. +.next +2. Test the macro definitions and the support routines by +assembling and running the test program TESTC. +.next +3. Implement the small set of I/O routines used by the compiler +(described in ccdoc.text). It is best to keep these as simple as +possible (i.e. don't buffer), as the run-time implementation given for +the CMAC macros is much different than the PDP10 implementation, +so you will have to rewrite them for the PDP10 implementation +eventually. +.next +4. Assemble the CMAC code of the CMAC version of the compiler. +Load the phases together with the I/O routines. Devise some way +of calling the compiler phases in the right sequence and with the +right parameters (use cc.c as guidance). It is not necessary +that this be done by a program. +.next +5. You now have (hopefully) a running C compiler that produces +CMAC object code. Try it out on the test program TESTC and compare +the output with the CMAC file provided. +.next +6. The next step is to construct a compiler that produces PDP-10 +code directly. You may wish to bring up the provided PDP-10 version +to see what the output looks like. Assuming that this output is +not satisfactory, decide how it must be changed and make the +appropriate changes to the machine description (pdp10.gt) and the +macro file (c42-10.c). Note that I separate the output into +4 object segments. This kludgery can be ignored; it is necessary only +to support optional things like "compiling" UUOs into PUSHJs and +stack tracing. +.next +7. Compile the GT program using your CMAC compiler. +Assemble and load the GT program and use it to process your new +machine description. Break up the output file into new compiler +source files (use install.teco or the existing files for guidance). +Using your CMAC compiler, compile these new files and assemble them. +Then, load up the new compiler. +.next +8. Test this new compiler on the test program, to see if it +produces reasonable output. +.next +9. Now you must re-implement the I/O stuff for the PDP-10 +implementation. You should use the provided support stuff as +guidance, but note that it is far, far more fancy than necessary +and you don't have to even understand all of it. It is best to +start simple (still no buffering); wait until it works before you +try to speed things up and add extra features. You will need +the UUO handler, however (in uuoh.midas). +.next +10. After implementing the I/O stuff for the PDP-10 implementation, +try out the TESTC program. If that works, compile and test the +compiler, itself. +.end_list + \ No newline at end of file diff --git a/doc/c/recipe.txt b/doc/c/recipe.txt new file mode 100644 index 00000000..1222fa0e Binary files /dev/null and b/doc/c/recipe.txt differ diff --git a/src/c/c.gra b/src/c/c.gra new file mode 100644 index 00000000..a67ea65e --- /dev/null +++ b/src/c/c.gra @@ -0,0 +1,397 @@ + + # C GRAMMAR # + # 28 May 1978 # + # Alan Snyder # + + +# 26 acceptable conflicts: + + 2 S/R conflicts for (parsing) ambiguity between + declarators and function_declarators + 1 S/R conflict for the C ELSE ambiguity + 4 R/R conflicts for the (parsing) problem with regard + to integer constants as initial_values + 12 R/R conflicts for the (parsing) problem with regard + to identifiers in function calls + 1 R/R conflict for the (parsing) problem with regard + to identifiers in goto statements + 4 R/R conflicts and 1 S/R conflict for TYPEDEFs + 1 S/R conflict for ambiguous cast types + (int ()) = (int x()) not (int (x)) + + Approximate description: + + 18 S/R ( shift 37 reduce 141 + 50 S/R ( shift 37 reduce 71 + 81 S/R ( shift 37 reduce 71 +113 R/R ( reduce 141 reduce 140 +113 R/R ( reduce 159 reduce 140 +113 R/R * reduce 159 reduce 141 +113 S/R : shift 199 reduce 141 +183 R/R , reduce 203 reduce 24 +183 R/R } reduce 203 reduce 24 +204 R/R ( reduce 159 reduce 140 +206 R/R ( reduce 148 reduce 139 +207 R/R ( reduce 147 reduce 139 +208 R/R ( reduce 145 reduce 139 +209 R/R ( reduce 144 reduce 139 +210 R/R ( reduce 146 reduce 139 +211 R/R ( reduce 149 reduce 139 +212 R/R ( reduce 150 reduce 139 +215 R/R ( reduce 159 reduce 140 +215 R/R ; reduce 159 reduce 138 +225 R/R ( reduce 151 reduce 139 +228 R/R ( reduce 159 reduce 140 +284 R/R , reduce 203 reduce 25 +284 R/R } reduce 203 reduce 25 +291 S/R ) shift 339 reduce 165 +343 R/R ( reduce 153 reduce 139 +360 S/R ELSE shift 369 reduce 94 + +# + + # terminal symbols # + +';' '}' '{' ']' '[' ')' '(' ':' +',' '.' '?' '~' '!' '&' '|' '^' +'%' '/' '*' '-' '+' '=' '<' '>' +'++' '--' '==' '!=' '<=' '>=' '<<' '>>' +'->' '=op' '&&' '||' 'c' +INT CHAR FLOAT DOUBLE STRUCT AUTO STATIC +EXTERN RETURN GOTO IF ELSE SWITCH +BREAK CONTINUE WHILE DO FOR DEFAULT CASE +ENTRY REGISTER SIZEOF LONG SHORT UNSIGNED TYPEDEF 'l' +'m' 'n' 'o' 'p' 'q' 'r' 's' +identifier integer floatcon string + + # precedence information # + +\< ',' +\> '=' '=op' +\> '?' ':' +\< '||' +\< '&&' +\< '|' +\< '^' +\< '&' +\< '==' '!=' +\< '<' '>' '<=' '>=' +\< '<<' '>>' +\< '+' '-' +\< '*' '/' '%' +\> '!' '~' +\> '++' '--' SIZEOF +\< '[' '(' '.' '->' + +\\ + + # external definitions # + +program: + program external_definition + | + +external_definition: + declaration + | function_definition + +function_definition: + function_specification function_body {afdef(#1,#2);} + +function_specification: + decl_specifiers function_declarator {val=afdcl(1);} + | function_declarator {val=afdcl(0);} + +function_body: + formal_declarations compound_statement {val=#2;} + +formal_declarations: + formal_decl_list {afpdcl();} + | {afpdcl();} + +compound_statement: + begin declaration_list statement_list end {val=#3;} + | begin statement_list end {val=#2;} + +init_declarator_list: + init_declarator + | init_declarator_list ',' init_declarator + +init_declarator: + $declarator initializer {aidecl();} + | declarator {aidecl();} + | function_declarator {adeclr(maktyp());} + +initializer: + initial_value + | '{' initial_value_expression_list '}' + | '{' initial_value_expression_list ',' '}' + +initial_value_expression_list: + initial_value_expression + | initial_value_expression_list ',' initial_value_expression + +initial_value: + integer {inz(i_int,#1);} + | '-' integer {inz(i_int,-#2);} + | floatcon {inz(i_float,#1);} + | '-' floatcon {inz(i_negfloat,#2);} + | identifier {inz(i_idn,#1);} + | '&' identifier {inz(i_idn,#2);} + | string {inz(i_string,#1);} + +initial_value_expression: + constant {inz(i_int,#1);} + | initial_value + + # declarations # + +declaration_list: + declaration + | declaration_list declaration + +declaration: + decl_specifiers init_declarator_list ';' + | literal_type_specifier ';' + +decl_specifiers: + type_specifier {attrib(-1,#1);} + | sc_specifier type_specifier {attrib(#1,#2);} + | type_specifier sc_specifier {attrib(#2,#1);} + +type_specifier: + type_identifier + | literal_type_specifier + +literal_type_specifier: + INT {val=TINT;} + | CHAR {val=TCHAR;} + | FLOAT {val=TFLOAT;} + | DOUBLE {val=TDOUBLE;} + | LONG {val=TINT;} + | LONG INT {val=TINT;} + | SHORT {val=TINT;} + | SHORT INT {val=TINT;} + | LONG FLOAT {val=TDOUBLE;} + | UNSIGNED {val=TINT;} + | UNSIGNED INT {val=TINT;} + | struct '{' type_decl_list '}' {val=astruct(NULL,#3);} + | struct $identifier '{' type_decl_list '}' {val=astruct(#2,#4);} + | struct identifier {val=aostruct(#2);} + +sc_specifier: + AUTO {val=c_auto;} + | STATIC {val=c_static;} + | EXTERN {val=c_extern;} + | REGISTER {val=c_auto;} + | TYPEDEF {val=c_typedef;} + +declarator_list: + declarator + | declarator_list ',' declarator + +declarator: + dclr {val=adeclr(maktyp());} + | identifier ':' constant {val=adeclr(afield(#1,#3));} + | ':' constant {val=adeclr(afield(-1,#2));} + +$declarator: + dclr {aiinz(adeclr(maktyp()));} + +dclr: + '*' dclr {val=adclr(#2,MPTR);} + | dclr '(' ')' {val=adclr(#1,MFUNC);} + | dclr '[' ']' {val=adclr(#1,MARRAY,1);} + | dclr '[' constant ']' {val=adclr(#1,MARRAY,#3);} + | identifier {val=adclr(0,0);} + | '(' dclr ')' {val=#2;} + +function_declarator: + '*' function_declarator {val=adclr(#2,MPTR);} + | function_declarator '(' ')' {val=adclr(#1,MFUNC);} + | function_declarator '[' ']' {val=adclr(#1,MARRAY,1);} + | function_declarator '[' constant ']' {val=adclr(#1,MARRAY,#3);} + | identifier '(' ')' {val=adclr(adclr(0,0),MFUNC); + parml=0;} + | identifier '(' parameter_list ')' {val=adclr(adclr(0,0),MFUNC); + parml=#3;} + | '(' function_declarator ')' {val=#2;} + +parameter_list: + identifier {val=push(#1);} + | parameter_list ',' identifier {push(#3);} + +formal_decl_list: + formal_declaration + | formal_decl_list formal_declaration + +formal_declaration: + type_declaration + | REGISTER type_declaration + +type_decl_list: + type_declaration + | type_decl_list type_declaration + +type_declaration: + $type_specifier declarator_list ';' {in_type_def=0; + val=#2;} + +$type_specifier: + type_specifier {in_type_def=1; + attrib(-1,#1);} + + # statements # + +statement_list: + statement + | statement_list statement {val=astmtl(#1,#2);} + +statement: + expression ';' {val=aexprstmt(#1);} + | compound_statement + | IF '(' expression ')' statement {val=aif(#3,#5,0);} + | IF '(' expression ')' statement ELSE statement {val=aif(#3,#5,#7);} + | while '(' expression ')' statement {val=awhile(#3,#5);} + | for '(' .expression ';' .expression ';' .expression ')' statement + {val=afor(#3,#5,#7,#9);} + | do statement WHILE '(' expression ')' ';' {val=ado(#2,#5);} + | switch '(' expression ')' statement {val=aswitch(#3,#5);} + | CASE constant ':' statement {val=acase(#2,#4);} + | DEFAULT ':' statement {val=adefault(#3);} + | BREAK ';' {val=abreak();} + | CONTINUE ';' {val=acontinue();} + | RETURN ';' {val=areturn(0);} + | RETURN expression ';' {val=areturn(#2);} + | GOTO lexpression ';' {val=agoto(#2);} + | identifier ':' statement {val=alabel(#1,#3);} + | ENTRY identifier ':' statement {val=aentry(#2,#4);} + | ';' {val=anull();} + + + # expressions # + +.expression: + expression + | {val=0;} + +expression_list: + expression \= '=' + | expression_list ',' expression {val=aelist(#1,#3);} + +expression: + expression '*' expression {val=node(n_times,#1,#3);} + | expression '/' expression {val=node(n_div,#1,#3);} + | expression '%' expression {val=node(n_mod,#1,#3);} + | expression '+' expression {val=node(n_plus,#1,#3);} + | expression '-' expression {val=node(n_minus,#1,#3);} + | expression '<<' expression {val=node(n_ls,#1,#3);} + | expression '>>' expression {val=node(n_rs,#1,#3);} + | expression '<' expression {val=node(n_lt,#1,#3);} + | expression '>' expression {val=node(n_gt,#1,#3);} + | expression '<=' expression {val=node(n_le,#1,#3);} + | expression '>=' expression {val=node(n_ge,#1,#3);} + | expression '==' expression {val=node(n_eq,#1,#3);} + | expression '!=' expression {val=node(n_ne,#1,#3);} + | expression '&' expression {val=node(n_band,#1,#3);} + | expression '^' expression {val=node(n_bxor,#1,#3);} + | expression '|' expression {val=node(n_bior,#1,#3);} + | expression '&&' expression {val=node(n_tv_and,#1,#3);} + | expression '||' expression {val=node(n_tv_or,#1,#3);} + | expression '?' expression ':' expression + {val=node(n_qmark,#1,node(n_colon,#3,#5));} + | expression '=' expression {val=node(n_assign,#1,#3);} + | expression '=op' expression {val=node(n_ars+#2,#1,#3);} + | expression ',' expression {val=node(n_comma,#1,#3);} + | term + +# the following productions are ordered very carefully so that the + desired thing is done in the case of a R/R conflict # + +lexpression: + expression + | identifier {val=aidn(alidn(#1));} + +fterm: + term + | identifier {val=aidn(afidn(#1));} + +type_identifier: + identifier {val=atidn(#1);} + +term: + term '++' {val=node(n_inca,#1);} + | term '--' {val=node(n_deca,#1);} + | '*' term {val=node(n_star,#2);} + | '&' term {val=node(n_addr,#2);} + | '-' term {val=node(n_uminus,#2);} + | '!' term {val=node(n_tvnot,#2);} + | '~' term {val=node(n_bnot,#2);} + | '++' term {val=node(n_incb,#2);} + | '--' term {val=node(n_decb,#2);} + | SIZEOF term {val=node(n_sizeof,#2);} + | SIZEOF '(' cast_type ')' \= SIZEOF + {val=node(n_int,1);} # hack # + | '(' cast_type ')' term \= '++' + {val=#4;} # hack # + | term '[' expression ']' {val=asubscript(#1,#3);} + | fterm '(' expression_list ')' {val=acall(#1,#3);} + | fterm '(' ')' {val=acall(#1,0);} + | term '.' identifier {val=adot(#1,#3);} + | term '->' identifier {val=aptr(#1,#3);} + | identifier {val=aidn(aeidn(#1));} + | integer {val=node(n_int,#1);} + | floatcon {val=node(n_float,#1);} + | string {val=node(n_string,#1);} + | '(' expression ')' {val=#2;} + +cast_type: literal_type_specifier null_decl + +null_decl: # empty # + | '(' ')' + | '(' null_decl ')' '(' ')' + | '*' null_decl + | null_decl '[' ']' + | null_decl '[' constant ']' + | '(' null_decl ')' + +while: WHILE {apshw();} +do: DO {apshd();} +for: FOR {apshf();} +switch: SWITCH {apshs();} +struct: STRUCT {strlev++;} +$identifier: identifier {val=astridn(#1);} +begin: '{' {abegin();} +end: '}' {aend();} + +constant: + constant '*' constant {val=#1*#3;} + | constant '/' constant {val=#1/#3;} + | constant '%' constant {val=#1%#3;} + | constant '+' constant {val=#1+#3;} + | constant '-' constant {val=#1-#3;} + | constant '<<' constant {val=#1<<#3;} + | constant '>>' constant {val=#1>>#3;} + | constant '<' constant {val=#1<#3;} + | constant '>' constant {val=#1>#3;} + | constant '<=' constant {val=#1<=#3;} + | constant '>=' constant {val=#1>=#3;} + | constant '==' constant {val=#1==#3;} + | constant '!=' constant {val=#1!=#3;} + | constant '&' constant {val=#1} + | constant '^' constant {val=#1^#3;} + | constant '|' constant {val=#1|#3;} + | constant '&&' constant {val=#1&} + | constant '||' constant {val=#1||#3;} + | constant '?' constant ':' constant + {val=(#1?#3:#5);} + | c_term + +c_term: + '-' c_term {val= -#2;} + | '!' c_term {val= !#2;} + | '~' c_term {val= ~#2;} + | integer + | '(' constant ')' {val=#2;} + + \ No newline at end of file diff --git a/src/c/c.stinkr b/src/c/c.stinkr new file mode 100644 index 00000000..1afb09b4 Binary files /dev/null and b/src/c/c.stinkr differ diff --git a/src/c/c1.c b/src/c/c1.c new file mode 100644 index 00000000..b3f66470 --- /dev/null +++ b/src/c/c1.c @@ -0,0 +1,1425 @@ +# include "cc.h" + +/* + + C COMPILER + Phase L: Lexical Analyzer + + Copyright (c) 1976, 1977, 1978 by Alan Snyder + +*/ + + +/********************************************************************** + + VARIABLES + +**********************************************************************/ + +/* character type array + + _LETTER - letter or _ (identifier or keyword) + _DIGIT - digit (constant or identifier) + _QUOTE - quote mark (character string) + _MCOP - possible beginning of multiple-character operator + _EOL - newline + _BLANK - blank, tab, vertical tab, form feed, cr + _INVALID - invalid character + _SQUOTE - apostrophe (character constant) + _PERIOD - period (operator or beginning of float constant) + _ESCAPE - (the escape character) + _CONTROL - compiler control line indicator + + 50+ - single-character operator, typ[c]=token.tag+50 */ + +int typ[] { +_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID, +_INVALID,_BLANK,_EOL,_BLANK,_BLANK,_BLANK,_INVALID,_INVALID, +_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID, +_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID,_INVALID, +_BLANK,_MCOP,_QUOTE,_CONTROL,_INVALID,69,_MCOP,_SQUOTE, +59,58,71,_MCOP,61,_MCOP,_PERIOD,_MCOP, +_DIGIT,_DIGIT,_DIGIT,_DIGIT,_DIGIT,_DIGIT,_DIGIT,_DIGIT, +_DIGIT,_DIGIT,60,53,_MCOP,_MCOP,_MCOP,63, +_INVALID,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER, +_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER, +_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER, +_LETTER,_LETTER,_LETTER,57,_ESCAPE,56,68,_LETTER, +_INVALID,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER, +_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER, +_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER,_LETTER, +_LETTER,_LETTER,_LETTER,55,_MCOP,54,64,_INVALID }; + +/* translation table */ + +int trt[] { +000,001,002,003,004,005,006,007,010,' ','\n',' ',' ',' ',016,017, +020,021,022,023,024,025,026,027,030,031,032,033,034,035,036,037, +' ','!','"','#','$','%','&','\'','(',')','*','+',',','-','.','/', +'0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?', +0100,'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O', +'P','Q','R','S','T','U','V','W','X','Y','Z','[','\\',']','^','_', +0140, + +# ifdef BOTHCASE + 'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o', +'p','q','r','s','t','u','v','w','x','y','z', +# endif + +# ifndef BOTHCASE + 'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O', +'P','Q','R','S','T','U','V','W','X','Y','Z', +# endif + '{','|','}','~',0177 }; + +/* two-character operator tables */ + +char *op2s[] { + "++", "--", "==", "!=", "<=", ">=", "<<", ">>", "->", "&&", + "||", "/*", "=+", "=-", "=*", "=/", "=%", "=&", "=^", "=|", 0}; +int op2v[] { + 27, 28, 29, 30, 31, 32, 33, 34, 35, 37, + 38, 0, 102, 103, 104, 105, 106, 107, 108, 109}; +char op1c[] { + '=', '+', '-', '!', '<', '>', '&', '|', '/', 0}; +int op1v[] { + 24, 23, 22, 15, 25, 26, 16, 17, 20}; + +/* keyword table */ + +char *keys[] { + "int", + "char", + "float", + "double", + "struct", + "auto", + "static", + "extern", + "return", + "goto", + "if", + "else", + "switch", + "break", + "continue", + "while", + "do", + "for", + "default", + "case", + "entry", + "register", + "sizeof", + "long", + "short", + "unsigned", + "typedef", + 0}; + + +/********************************************************************** + + HASH TABLE + +**********************************************************************/ + +# define h_idn 0 /* identifier */ +# define h_key 1 /* keyword */ +# define h_man 2 /* manifest constant */ +# define h_mac 3 /* macro */ +# define h_arg 4 /* macro argument */ + +# define hentry struct _hentry +hentry + {char *hnp; /* pointer to string in cstore */ + int hclass; /* class (idn, key, man, mac, arg) */ + int hval;}; /* value: + key: token TAG + man: index in MCDEF of def + mac: index in MCDEF of def + arg: argument number + */ + +hentry hshtab[hshsize]; /* the hash table */ +int hshused 0; /* number of entries used */ +hentry *lookup(), *lookx(); + +/********************************************************************** + + TOKEN Input Control Blocks (for macro processing) + +**********************************************************************/ + +# define ticb struct _ticb +ticb + {int titype; /* type of current token source */ + int *tiptr; /* ptr to position within def */ + ticb *tinext; /* ptr to next ICB on stack or free */ + int tiargc; /* number of arguments */ + int tiap[maxargs]; /* ptrs to args */ + int tiab[margbsz]; /* args */ + }; + +ticb *cticb; /* the current token ICB (0 if none) */ +ticb *fticb; /* pointer to chain of free token ICBs */ +ticb *ti_get(); + +# define ti_mac 0 /* read from macro def */ +# define ti_man 1 /* read from manfst const or macro arg */ + +/********************************************************************** + + INPUT Control Blocks (for multiple input files) + +**********************************************************************/ + +struct _icb { + int fileno, /* file descriptor */ + lineno, /* line number */ + eof, /* end-of-file flag */ + nlflag; /* new-line flag */ + }; + +# define icb struct _icb + +icb icbs[maxicb]; /* the input stack */ +int icblev; /* index of current ICB */ + +int i_file, /* top-level ICB for efficiency */ + i_line 1, + i_eof FALSE, + i_nlflag TRUE; + +/********************************************************************** + + CSTORE - character store: holds keywords, identifiers, + and floating-point literals in source form + +**********************************************************************/ + +char cstore[cssiz], + *cwp, /* points to beginning of working area */ + *cp, /* points to first unused character */ + *ecstore; /* points to last char in cstore */ + +/********************************************************************** + + communication between lexical routines + +**********************************************************************/ + +# ifndef MERGE_LP + +int lextag, /* token.tag */ + lexindex, /* token.index */ + lexline 1; /* token.line */ + +# endif +# ifdef MERGE_LP + +extern int lextag, lexindex, lexline; + +# endif + +int stloc 0, /* string location counter */ + ccard 0, /* indicates currently processing + compiler control line */ + mcdflv 0, /* depth of macro definition processing */ + cc, /* current untranslated input char */ + tt, /* current translated input char */ + ttype, /* type of current translated input char */ + truncate, /* indicates that cstore is full */ + lexcount 0; /* number of characters in lookahead buffer */ + +char lexbuff[5]; /* lookahead buffer */ + +/* FILES */ + +int f_source, /* source file */ + f_string; /* string output file */ + +char *fn_source, + *fn_cstore, + *fn_string; + +# ifndef MERGE_LP + +int f_token, /* token output file */ + f_error -1; /* error output file */ + +char *fn_token, + *fn_error; + +# endif + +/* asgnop table, used to recognize =op's */ + +int asgnop[] + {7,9,8,6,5,4,3,2,51,51,51,51,51,51,51,51,51,1,0}; + +/* compiler control line table */ + +cclent ccltab [maxccl]; /* holds names and routines for CCLs */ +int nccl 0; /* number of CCLs defined */ +int jendif; /* various special identifiers */ +int jend; +int jifdef; +int jifndef; + +/* manifest constants */ + +int mcdef[mcdsz], /* storage of manifest constant definitions */ + *cmcdp {mcdef}, /* pointer to next free word in mcdef */ + +/* rename control line */ + + sw_flag; /* flag to inhibit writing of string + constants on the string file */ + +/********************************************************************** + + MAIN - Lexical Phase Main Routine + + Receives file names as arguments. + Opens TOKEN, STRING, and source files. + Calls LXINIT to perform initialization. + + Copies tokens onto TOKEN file, inserting "line number" + tokens as appropriate. + +**********************************************************************/ + +# ifndef MERGE_LP + +main (argc, argv) int argc; char *argv[]; + + {int oldline; + + if (argc < 7) + {cprint ("Phase L called with too few arguments.\n"); + cexit (100); + } + + fn_source = argv[2]; + fn_token = argv[3]; + fn_cstore = argv[4]; + fn_error = argv[5]; + fn_string = argv[6]; + + f_token = xopen (fn_token, MWRITE, BINARY); + + lxinit(); + oldline = 0; + do + {gettok(); + if (lexline != oldline) + {puti (TLINENO, f_token); + puti (lexline, f_token); + oldline = lexline; + } + puti (lextag, f_token); + puti (lexindex, f_token); + } + while (lextag != TEOF); + cleanup (0); + } + +# endif + +/********************************************************************** + + GETTOK - GET NEXT TOKEN + + Set variables LEXTAG, LEXINDEX, LEXLINE. + This level implements Compiler Control Lines. + +**********************************************************************/ + +gettok() + + {int i, line; + + while (TRUE) + + {tokget (FALSE); + if (lextag == TCONTROL) /* it's a CCL */ + {line = lexline; + tokget (TRUE); + if (lextag==LEXEOF) continue; + else + {if (lextag == TIDN) + {if (lexindex == jend && mcdflv>0) + {cskip (); + lextag = LEXEOF; + return; + } + for (i=0;ihclass; + if (sense ^ (c != h_man && c != h_mac)) ifskip (); + } + else errlex (1020); + } + +/********************************************************************** + + IFSKIP - skip body of #IF, #IFDEF, or #IFNDEF + +**********************************************************************/ + +ifskip () + + {int if_level, line; + + if_level = 1; + line = lexline; + cskip (); + do + {tokget (TRUE); + if (lextag == TCONTROL) + {tokget (TRUE); + if (lextag == 50) if_level++; + else if (lextag==TIDN) + {if (lexindex==jifdef || + lexindex==jifndef) if_level++; + else if (lexindex==jendif) + {if (--if_level==0) + {cskip (); + break; + } + } + } + cskip (); + } + } + while (lextag != TEOF); + if (lextag==TEOF) error (1011, line); + } + +/********************************************************************** + + DEFCCL - Handle DEFINE Compiler Control Line + +**********************************************************************/ + +defccl () + + {int k; + hentry *hp; + + tokget (TRUE); /* identifier being defined */ + if (lextag != TIDN) errlex (1012); + else + {if (lexcount>0 && trt[lexbuff[lexcount-1]]=='(') + defmac (TRUE); + else + {hp = lookx (); + k = cmcdp-mcdef; + do + {tokget (FALSE); + deftok(); + } + while (lextag != LEXEOF); + --cmcdp; /* 2nd word of EOF not needed */ + sethn (hp, h_man, k); + } + } + } + +/********************************************************************** + + UNDCCL - Handle UNDEFINE Compiler Control Line + +**********************************************************************/ + +undccl () + + {tokget (TRUE); /* identifier being undefined */ + if (lextag != TIDN) errlex (1030); + else sethn (lookx (), h_idn, lexindex); + } + +/********************************************************************** + + INCCCL - Handle INCLUDE Compiler Control Line + +**********************************************************************/ + +incccl () + + {int ifile; + + sw_flag=TRUE; + cp = cwp; + tokget (FALSE); /* read file name */ + if (lextag!=TSTRING) errlex (1014); + else + {tokget (FALSE); + if (lextag!=LEXEOF) errlex (1014); + else if ((ifile = xopen (cwp,MREAD,TEXT)) >= 0) + in_push (ifile); + } + sw_flag = FALSE; + } + +/********************************************************************** + + RENCCL - Handle RENAME Compiler Control Line + +**********************************************************************/ + +renccl () + + {int k; + hentry *hp; + + sw_flag=TRUE; + tokget (TRUE); + if (lextag==TIDN) + {hp = lookx (); + k = cmcdp-mcdef; + *cwp++ = ' '; /* prefix string with blank */ + tokget (FALSE); + if (lextag == TSTRING) + {lextag=TIDN; + lexindex=lookup(--cwp)->hnp-cstore; + deftok(); + tokget (FALSE); + if (lextag==LEXEOF) + {deftok(); + sethn (hp, h_man, k); + sw_flag=FALSE; + return; + } + } + } + errlex (1010); + sw_flag=FALSE; + } + +/********************************************************************** + + MACCCL - Handle MACRO Compiler Control Line + +**********************************************************************/ + +macccl () + + {tokget (TRUE); + if (lextag == TIDN) defmac (FALSE); + else errlex (2037); + } + +/********************************************************************** + + DEFMAC - Define Macro (Flag => #define form) + +**********************************************************************/ + +defmac (flag) + + {int argc; /* number of formal arguments */ + hentry *argv[maxargs]; /* offset of hash table entries for args */ + int oclass[maxargs]; /* old HCLASS of formal parameters */ + int oval[maxargs]; /* old HVAL of formal parameters */ + int win, line, i, k; + hentry *hp, *fp; + + ++mcdflv; + argc = 0; + win = FALSE; + line = lexline; + hp = lookx (); + k = cmcdp-mcdef; + tokget (TRUE); /* should be '(' */ + if (lextag == 9) /* ( */ + {tokget (TRUE); /* should be formal param or ')' */ + while (lextag == TIDN) + {fp = lookx (); + if (argc>=maxargs) errlex (4014); + argv[argc] = fp; + oclass[argc] = fp->hclass; + oval[argc] = fp->hval; + sethn (fp, h_arg, argc++); + tokget (TRUE); /* should be ',' or ')' */ + if (lextag != 11) /* , */ break; + tokget (TRUE); + } + if (lextag == 8) /* ) */ + {if (!flag) cskip (); + do {gettok (); + if (lextag==TEOF) error (4015, line); + deftok (); + } + while (lextag != LEXEOF); + --cmcdp; + sethn (hp, h_mac, k); + win = TRUE; + } + } + --mcdflv; + for (i=0;ititype) { + + case ti_man: lextag = *cticb->tiptr++; + lexindex = *cticb->tiptr++; + if (lexindex==UNDEF) lexindex=lexline; + if (lextag) return; + ti_pop (); + continue; + + case ti_mac: lextag = *cticb->tiptr++; + lexindex = *cticb->tiptr++; + if (lextag == TMARG) + {if (lexindex >= cticb->tiargc) + errlex (1017); + else in_mc (cticb->tiap[lexindex]); + continue; + } + if (lexindex==UNDEF) lexindex=lexline; + if (lextag) return; + ti_pop (); + continue; + } + if (!lgetc()) break; + truncate = FALSE; + cp = cwp; /* working string */ + switch (ttype) { + case _LETTER: if (name (quote)) continue; + return; + case _PERIOD: move (tt); + if (ttype != _DIGIT) + {lextag = 12; /* . */ + lexindex = lexline; + pback (cc); + return; + } + number (TRUE); + return; + case _DIGIT: number (FALSE); + return; + case _QUOTE: string (); + return; + case _MCOP: mcop (quote); + return; + case _EOL: if (ccard) + {ccard=FALSE; + lextag=LEXEOF; + return; + } + if (icblev==0) lexline = i_line; + case _BLANK: continue; + case _ESCAPE: /* fall through to error message */ + case _INVALID: errlex (1000); + continue; + case _SQUOTE: charcon (); + return; + case _CONTROL: if (ccard) {errlex (1000); continue;} + ccard = TRUE; + lextag = TCONTROL; + lexindex = 0; + return; + default: /* single character operator */ + lextag = ttype - 50; + lexindex = lexline; + return; + } + } + lextag = TEOF; + lexindex = lexline; + } + +/********************************************************************** + + NAME - read name + +**********************************************************************/ + +int name (quote) + + {hentry *hp; + + do move (tt); while (_NAME); + if (truncate) errlex (4001); + + *cp = 0; + hp = lookup (cwp); + pback (cc); + + /* what kind of identifier is it? */ + + switch (hp->hclass) { + case h_key: lextag = hp->hval; + lexindex = lexline; + return (0); + case h_man: if (!quote) + {in_mc (mcdef+hp->hval); + return (1); + } + case h_mac: if (!quote) + {exmacro (hp->hval); + return (1); + } + case h_arg: if (!quote) + {lextag = TMARG; + lexindex = hp->hval; + return (0); + } + case h_idn: lextag = TIDN; + lexindex = hp->hnp - cstore; + } + return (0); + } + +/********************************************************************** + + NUMBER - read float or int constant + +**********************************************************************/ + +number (floatflag) + + {int sum, c; + + lextag = TINTCON; + move (tt); + if (!floatflag && (tt=='X' || tt=='x') && cwp[0]=='0') + {sum = 0; + while (lgetc ()) + {if (tt>='0' && tt<='9') + sum = (sum<<4) | (tt - '0'); + else if (tt>='A' && tt<='F') + sum = (sum<<4) | (tt - ('A' - 10)); + else if (tt>='a' && tt<='f') + sum = (sum<<4) | (tt - ('a' - 10)); + else break; + } + if (tt != 'L' && tt != 'l') pback (cc); + lexindex = sum; + return; + } + + while (ttype == _DIGIT) move (tt); + if (!floatflag && tt=='.') + {floatflag=TRUE; + move (tt); + while (ttype == _DIGIT) move (tt); + } + if (tt=='E' || tt=='e') + {floatflag=TRUE; + move (tt); + if (tt=='+' || tt=='-') move (tt); + while (ttype == _DIGIT) move (tt); + } + *cp++ = '\0'; + if ((tt != 'L' && tt != 'l') || floatflag) pback (cc); + if (floatflag) + {lexindex = cwp - cstore; + cwp = cp; + lextag = TFLOATC; + } + else /* integer */ + {cp = cwp; + sum = 0; + if (*cp=='0') /* octal */ + while (c = *cp++) sum = (sum<<3) | ((c-'0') & 017); + else while (c = *cp++) sum = (sum*10) + ((c-'0') & 017); + lexindex = sum; + } + if (truncate) errlex (4001); + return; + } + +/********************************************************************** + + STRING - read string constant + + Move characters until quote, end-of-file, or unescaped + newline. + +**********************************************************************/ + +string () + + {lexindex = stloc; + lgetc(); + while (tt!='"' && tt!='\0' && tt!='\n') + {if (ttype == _ESCAPE) + {if (lgetc()=='\n') + {i_nlflag=FALSE; + lgetc(); + continue; + } + cc = escape (); + } + if (cc=='\0') {swrite('$'); swrite('0');} + else if (cc=='$') {swrite('$'); swrite('$');} + else swrite (cc); + lgetc (); + } + if (tt!='"') errlex (2001); + else lgetc(); /* skip quotation mark */ + if (truncate) errlex (4001); + lextag = TSTRING; + swrite ('\0'); + pback (cc); + } + +/********************************************************************** + + CHARCON - read character constant + +**********************************************************************/ + +charcon () + + {int c, len; + + lgetc (); /* skip ' */ + c = len = 0; + while (tt!='\n' && tt!='\0' && tt!='\'') + {if (ttype == _ESCAPE) + {if (lgetc()=='\n') + {lgetc();continue;} + cc = escape (); + } + c = cc; + lgetc (); + ++len; + } + if (tt!='\'') errlex (1003); + else if (len>1) errlex (1002); + lextag = TINTCON; + lexindex = c; + } + +/********************************************************************** + + MCOP - read possible multi-character operator + +**********************************************************************/ + +mcop (quote) + + {int c1, c2; + char *s, **ss; + + if (tt=='=') /* might be 3-character operator */ + {lgetc (); + if (tt=='<' || tt=='>') + {c1 = cc; + c2 = tt; + lgetc (); + if (tt == c2) + return (setop (tt=='<'?101:100,quote)); + pback (cc); + pback (c1); + return (setop (24, quote)); + } + c2 = '='; + } + else + {c2 = tt; + lgetc (); + } + ss = op2s; + while (s = *ss++) if (s[0]==c2 && s[1]==tt) + return (setop (op2v[ss-op2s-1], quote)); + pback (cc); + s = op1c; + while (c1 = *s++) if (c1==c2) + return (setop (op1v[s-op1c-1], quote)); + errlex (6043, c2); + } + +/********************************************************************** + + EXMACRO - Expand Macro Call + + Parameter is index of macro def in MCDEF. + Collect arguments, set up TICB. + +**********************************************************************/ + +exmacro (i) + + {int argc, level, *ap, *ep, macline; + ticb *p; + + macline = lexline; /* line number of macro call */ + p = ti_get (); /* TICB for macro expansion */ + ap = p->tiab; /* where args will go */ + ep = ap + (margbsz-3); /* end of storage area for args */ + p->titype = ti_mac; + p->tiptr = &mcdef[i]; + argc = 0; + gettok (); /* should be ( */ + if (lextag == 9) + {gettok (); + while (lextag != 8 && lextag != TEOF) /* get args */ + {level = 0; + if (argc >= maxargs) error (4014, macline); + p->tiap[argc++] = ap; + while (TRUE) + {switch (lextag) { + + case TEOF: goto arg_done; + case 9: ++level; break; + case 11: if (level <= 0) + {gettok (); + goto arg_done; + } + break; + case 8: if (--level < 0) goto arg_done; + break; + } + if (ap >= ep) error (4016, macline); + *ap++ = lextag; + if (lextagtiargc = argc; + ti_push (p); + } + +/********************************************************************** + + TI - Token Input Control Block Operations + + ti_init () initialize + p = ti_get () allocate token ICB + ti_push (p) push token ICB onto input stack + ti_pop () pop top token ICB + in_mc (p) create and push manifest constant ICB + +**********************************************************************/ + +ti_init () + + {static ticb xticb[maxdepth]; + ticb *p, *q; + + /* set up free chain */ + + p = &xticb[maxdepth-1]; + p->tinext = NULL; + for (q=p; q>xticb; ) + (--q)->tinext = p--; + fticb = q; + cticb = 0; + } + +ticb *ti_get () + + {ticb *p; + + if (!fticb) errlex (4018); + p = fticb; + fticb = p->tinext; + p->tinext = NULL; + return (p); + } + +ti_push (p) ticb *p; + + {p->tinext = cticb; + cticb = p; + } + +ti_pop () + + {ticb *p; + + if (cticb) + {p = cticb->tinext; + cticb->tinext = fticb; + fticb = cticb; + cticb = p; + } + } + +in_mc (q) int *q; + + {ticb *p; + + p = ti_get (); + p->titype = ti_man; + p->tiptr = q; + ti_push (p); + } + +/********************************************************************** + + DEFTOK - append the current token to the manifest + constant definition list + +**********************************************************************/ + +deftok() + + {if(cmcdp>= &mcdef[mcdsz-1]) + errlex (4004); + *cmcdp++ = lextag; + if (lextag='0' && tt<='7') + {n = 0; + count = 3; + do + {n = (n<<3) | (tt-'0'); + lgetc (); + } while (tt>='0' && tt<='7' && --count>0); + pback (cc); + return (n); + } + + switch (tt) { + case '\'': return ('\''); + case '"': return ('"'); + case 'n': + case 'N': return ('\n'); + case 'r': + case 'R': return ('\r'); + case 't': + case 'T': return ('\t'); + case 'b': + case 'B': return ('\b'); + case 'v': + case 'V': return (013); + case 'p': + case 'P': return (014); + default: errlex (1004); + return (' '); + } + } + +/********************************************************************** + + LGETC - LEXICAL PHASE CHARACTER INPUT ROUTINE + + set CC to next input character + set TT to translation of CC + set TTYPE to type of TT + return TT + + Handles included files. + Provides a lookahead facility. + Keeps track of line numbers. + +**********************************************************************/ + +int lgetc() + + {if (lexcount > 0) tt = trt[cc=lexbuff[--lexcount]]; + else if (i_eof) tt = trt[cc=LEXEOF]; + else + {cc = cgetc (i_file); + if (!cc) + if (icblev>0) /* restore state */ + {cclose (i_file); + in_pop(); + return (lgetc ()); + } + else + {i_eof = TRUE; + cc = LEXEOF; + } + + if ((tt = trt[cc]) == '\n') + {++i_line; + i_nlflag = TRUE; + } + else i_nlflag = FALSE; + } + + ttype = typ[tt]; + return (tt); + } + +/********************************************************************** + + PBACK - Push character back into input stream + +**********************************************************************/ + +pback(c) char c; + + {lexbuff[lexcount++] = c;} + +/********************************************************************** + + IN_PUSH - Push new input file onto stack + +**********************************************************************/ + +in_push (f) int f; + + {register icb *p; + + if (icblev >= maxicb) errlex (4019); + p = &icbs[icblev++]; + p->fileno = i_file; + p->lineno = i_line; + p->nlflag = i_nlflag; + p->eof = i_eof; + i_file = f; + i_line = 1; + i_nlflag = TRUE; + i_eof = FALSE; + } + +/********************************************************************** + + IN_POP - Pop current input file from stack. + +**********************************************************************/ + +in_pop () + + {register icb *p; + + p = &icbs[--icblev]; + i_file = p->fileno; + i_line = p->lineno; + i_nlflag = p->nlflag; + i_eof = p->eof; + } + +/********************************************************************** + + SETOP - set lextag and lexindex for operator + +**********************************************************************/ + +int setop (i, quote) + + {int l; + + if (i>=100) /* =op */ + {lextag = TEQOP; + lexindex = i-100; + return (0); + } + if (i==0) /* comment */ + {l = lexline; + while (lgetc ()) + while (tt=='*') + if (lgetc () == '/') + return (tokget (quote)); + error (1001, l); + return (tokget (quote)); + } + lextag = i; + lexindex = lexline; + return (0); + } + +/********************************************************************** + + KEYWORD - enter a keyword in the hash table + +**********************************************************************/ + +keyword (s, tag) char *s; int tag; + + {fixname (s); + sethn (lookup (s), h_key, tag); + } + +/********************************************************************** + + LXINIT - initialization for the lexical phase + +**********************************************************************/ + +lxinit () + + {int i; + char *s, **ss; + + f_string = xopen (fn_string, MWRITE, BINARY); + f_source = xopen (fn_source, MREAD, TEXT); + + cwp = cp = cstore; + ecstore = &cstore[cssiz-1]; + i_file = f_source; + ti_init (); + + i = 40; + ss = keys; + while (s = *ss++) keyword (s, i++); + + def_ccl ("include", incccl); + def_ccl ("define", defccl); + def_ccl ("undefine", undccl); + def_ccl ("rename", renccl); + jifdef = def_ccl ("ifdef", ifdccl); + jifndef = def_ccl ("ifndef", ifnccl); + jendif = def_ccl ("endif", endccl); + def_ccl ("macro", macccl); + jend = def_ccl ("end", endccl); + } + +/********************************************************************** + + DEF_CCL - Define Compiler Control Line Name and Handler + +**********************************************************************/ + +int def_ccl (ccl_name, handler) char *ccl_name; int (*handler)(); + + {int i; + + fixname (ccl_name); + if (nccl >= maxccl) error (6042, 0); + i = ccltab[nccl].cname = lookup(ccl_name)->hnp - cstore; + ccltab[nccl].cproc = handler; + ++nccl; + return (i); + } + +/********************************************************************** + + FIXNAME - Fix Literal Name + +**********************************************************************/ + +fixname (p) + char *p; + + { +# ifndef BOTHCASE + register char c; + while (c = *p) *p++ = trt[c]; +# endif + return; + } + +/********************************************************************** + + LOOKUP - lookup or enter a symbol in the hash table + +**********************************************************************/ + +hentry *lookup (np) char *np; + + {int i, u, h; + char *p, *ep; + hentry *hp; + + h = i = 0; + p = np; + while (u = *p++) {i =+ (u << h); if (++h == 8) h = 0;} + if (i<0) i = -i; + i =% hshsize; + + /* search entries until found or empty */ + + while (ep = hshtab[i].hnp) + if (stcmp(np,ep)) return (&hshtab[i]); + else if (++i>=hshsize) i=0; + + /* not found, so enter */ + + if (++hshused >= hshsize) errlex (4000); + + hp = &hshtab[i]; + hp->hnp = cwp; + hp->hclass = h_idn; + + if (np == cwp) cwp = p; /* name already in place */ + else while (*cwp++ = *np++); /* move name */ + + return (hp); + } + +/********************************************************************** + + LOOKX - lookup current identifier + +**********************************************************************/ + +hentry *lookx () + {return (lookup (&cstore[lexindex]));} + +/********************************************************************** + + SETHN - Set Hash Table Entry + +**********************************************************************/ + +sethn (hp, class, val) + hentry *hp; + + {hp->hclass = class; + hp->hval = val; + } + +/********************************************************************** + + MOVE - move a character into the character buffer + and advance the input + +**********************************************************************/ + +int move (c) char c; + + {if (cp=2000); + } + +# endif + +/********************************************************************** + + WCSTORE - Write CSTORE onto intermediate file + +**********************************************************************/ + +wcstore () + + {extern char *fn_cstore, cstore[]; + char *p; + int f; + + f = xopen (fn_cstore, MWRITE, BINARY); + p = cstore; + + while (p < cwp) cputc (*p++, f); + cclose (f); + } + +/********************************************************************** + + ERRLEX - Announce error, line number from lexline + +**********************************************************************/ + +errlex (errno, a1, a2, a3, a4) {error (errno, lexline, a1, a2, a3, a4);} + \ No newline at end of file diff --git a/src/c/c2.h b/src/c/c2.h new file mode 100644 index 00000000..4080f55b --- /dev/null +++ b/src/c/c2.h @@ -0,0 +1,49 @@ +/* + + C COMPILER + Phase P: Parser + Insert File + + Copyright (c) 1977 by Alan Snyder + +*/ + +/* types */ + +struct _dentry /* dictionary entry */ + {int name; /* the identifier, struct types stored +cssiz */ + type dtype; /* data type */ + int offset; /* addressing info */ + int class; /* storage class */ + }; + +# define dentry struct _dentry + +/* machine description tables */ + +extern int tsize[], talign[], calign[], tpoint[], ntype, + nac, sv_area_sz; + +/* variables */ + +extern dentry *dbegin, *dgdp, *dldp, *dend; +extern int lineno; + +/* functions */ + +int *top(), *get_top(), *push(), *setsp(); +dentry *find(), *define(); + +/* special type values */ + +extern type TCHAR; +extern type TINT; +extern type TFLOAT; +extern type TDOUBLE; +extern type TLONG; +extern type TUNSIGNED; +extern type TUNDEF; +extern type TPCHAR; +extern type TACHAR; +extern type TFINT; + \ No newline at end of file diff --git a/src/c/c21.c b/src/c/c21.c new file mode 100644 index 00000000..582840b7 --- /dev/null +++ b/src/c/c21.c @@ -0,0 +1,332 @@ +# include "cc.h" +# include "c2.h" + +/* + + C COMPILER + Phase P: Parser + Section 1: Parser and Control + + Copyright (c) 1976, 1977 by Alan Snyder + +*/ + +/********************************************************************** + + CONTROL VARIABLES + +**********************************************************************/ + +int f_node, /* tree output file */ + f_error -1, /* error message file */ + f_mac, /* macro output file */ + f_symtab, /* symbol table output file */ + lc_node 1, /* node location counter */ + sflag, /* indicates to write symbol table */ + nodeno 1; + +char *fn_typtab, + *fn_node, + *fn_error, + *fn_mac, + *fn_hmac, + *fn_symtab; + +# ifndef MERGE_LP + +int f_token; /* token input file */ +char *fn_token; + +# endif + +# ifdef MERGE_LP + +extern int f_source, /* source file */ + f_string; /* string file */ + +extern char *fn_source, /* source file name */ + *fn_string, /* string file name */ + *fn_cstore; /* cstore file name */ + +# endif + +char nodelen [] { +# include "cnlen.h" + }; + +/********************************************************************** + + MAIN - PARSER MAIN ROUTINE + +**********************************************************************/ + +# ifdef MERGE_LP +# define MAXN 11 +# endif +# ifndef MERGE_LP +# define MAXN 9 +# endif + +main (argc, argv) int argc; char *argv[]; + + {if (argc < MAXN) + {cprint ("Phase P called with too few arguments.\n"); + cexit (100); + } + + poptions (argv[1]); + setfiles (argv); + +# ifdef MERGE_LP + + lxinit (); + +# endif + + if (argc > MAXN) rtdata (argv[MAXN]); + pinit (); + parse (); + cleanup (0); + } + +/********************************************************************** + + POPTIONS - Process Debugging Options + +**********************************************************************/ + +poptions (s) + char *s; + + {int c; + extern int debug, edebug, tflag, xflag; + + while (c = *s++) switch (c) { + case 'd': debug = TRUE; break; + case 'e': edebug = TRUE; break; + case 's': sflag = TRUE; break; + case 't': tflag = TRUE; break; + case 'x': xflag = TRUE; break; + } + } + +/********************************************************************** + + SETFILES - Set File Names + +**********************************************************************/ + +setfiles (argv) + char *argv[]; + + { + +# ifndef MERGE_LP + + fn_token = argv[2]; + fn_node = argv[3]; + fn_typtab = argv[4]; + fn_error = argv[5]; + fn_mac = argv[6]; + fn_hmac = argv[7]; + fn_symtab = argv[8]; + +# endif + +# ifdef MERGE_LP + + fn_source = argv[2]; + fn_node = argv[3]; + fn_typtab = argv[4]; + fn_error = argv[5]; + fn_mac = argv[6]; + fn_cstore = argv[7]; + fn_string = argv[8]; + fn_hmac = argv[9]; + fn_symtab = argv[10]; + +# endif + + } + +/********************************************************************** + + RTDATA - Read Target Machine Data File + +**********************************************************************/ + +rtdata (fn_tdata) + char *fn_tdata; + + {int f; + + f = xopen (fn_tdata, MREAD, BINARY); + tsize[TTCHAR] = geti (f); + tsize[TTINT] = geti (f); + tsize[TTFLOAT] = geti (f); + tsize[TTDOUBLE] = geti (f); + talign[TTCHAR] = geti (f); + talign[TTINT] = geti (f); + talign[TTFLOAT] = geti (f); + talign[TTDOUBLE] = geti (f); + calign[0] = geti (f); + calign[1] = geti (f); + calign[2] = geti (f); + calign[3] = geti (f); + cclose (f); + } + +/********************************************************************** + + CLEANUP - PARSER CLEANUP ROUTINE + +**********************************************************************/ + +cleanup (rcode) + + {extern int maxerr; + static int level; + + if (++level == 1) + { + +# ifdef MERGE_LP + + cclose (f_string); + cclose (f_source); + wcstore (); + +# endif + +# ifndef MERGE_LP + + cclose (f_token); + +# endif + + node (1); + cclose (f_node); + sdef (); + chkdict (dbegin, dgdp); + wtyptab (); + if (sflag) + {wsymtab (); + cclose (f_symtab); + } + } + cexit (rcode?rcode:maxerr>=2000); + } + +/********************************************************************** + + ERRX - Report error (lineno accessed via external variable) + +**********************************************************************/ + +errx (errno, a1, a2, a3, a4) + + {error (errno, lineno, a1, a2, a3, a4); + } + +/********************************************************************** + + PINIT - PARSER INIT ROUTINE + +**********************************************************************/ + +pinit () + + { + +# ifndef MERGE_LP + + f_token = xopen (fn_token, MREAD, BINARY); + +# endif + + f_node = xopen (fn_node, MWRITE, BINARY); + f_mac = xopen (fn_mac, MWRITE, TEXT); + if (sflag) f_symtab = xopen (fn_symtab, MWRITE, BINARY); + ainit (); + } + +/********************************************************************** + + GETTOK - Get Token Routine (When LP not merged) + +**********************************************************************/ + +# ifndef MERGE_LP + +int lxeof FALSE; + +gettok () + + {extern int lextag, lexindex, lexline; + + while (TRUE) + {if (lxeof) lextag = TEOF; + else + {lextag = geti (f_token); + lexindex = geti (f_token); + if (lextag == TLINENO) + {lexline = lexindex; + continue; + } + if (lextag <= TEOF) lxeof = TRUE; + } + return; + } + } + +# endif + +/********************************************************************** + + PTOKEN - Simple Token Print Routine for Parser Option + +**********************************************************************/ + +ptoken (tp, f) token *tp; + + {cprint (f, "%4d %6d", tp->tag, tp->index);} + +/********************************************************************** + + NODE - PARSER NODE OUTPUT ROUTINE + +**********************************************************************/ + +node (op, p1, p2, p3, p4, p5, p6) + + {int *p, j, k; + + p = &op; + k = j = nodelen[op]; + while (--k >= 0) puti (*p++, f_node); + k = lc_node; + lc_node =+ j; + return (k); + } + +/********************************************************************** + + PARSER ERROR MESSAGE ROUTINES + +**********************************************************************/ + +synerr (line) {error (2007, line);} +giveup (line) {error (4012, line);} +stkovf (line) {error (4003, line);} +delmsg (line) {error (2012, line);} +skpmsg (line) {error (2013, line);} + +qprint (q) {error (2008, -1, q);} +tprint (tp) token *tp; {error (2011, -1, tp->tag, tp->index);} +pcursor () {error (2010, -1);} + +stkunf (line) {error (6033, line);} +tkbovf (line) {error (6008, line);} +badtwp (line) {error (6032, line);} +badtok (line, i) {error (6000, line, i);} + \ No newline at end of file diff --git a/src/c/c22.c b/src/c/c22.c new file mode 100644 index 00000000..5bf25f8a --- /dev/null +++ b/src/c/c22.c @@ -0,0 +1,308 @@ +# include "cc.h" +# include "c2.h" + +/* + + C COMPILER + Phase P: Parser + Section 2: Statement Processing and Action Routine Support + + Copyright (c) 1977 by Alan Snyder + +*/ + +/********************************************************************** + + VARIABLES + +**********************************************************************/ + +int ciln 0; /* current internal label number */ +extern int line, cblock; + +/********************************************************************** + + GROUP STACK + +**********************************************************************/ + +# define gentry struct _gentry +struct _gentry {int gtype, gchain, giln;}; + +# define GNULL 0 +# define GSWITCH 1 +# define GFOR 2 +# define GDO 3 +# define GWHILE 4 + +gentry gstack[GSSIZE]; +gentry *cgsp, *egsp; + +gpush (gtype, niln) + + {if (++cgsp >= egsp) errx (4002); + cgsp->gtype = gtype; + cgsp->giln = ciln; + cgsp->gchain = 0; + ciln =+ niln; + } + +gentry *findswitch () + + {gentry *gp; + + for (gp=cgsp; gp->gtype>GSWITCH; --gp); + if (gp>gstack) return (gp); + return (NULL); + } + +/********************************************************************** + + STACK ROUTINES FOR ACTIONS + +**********************************************************************/ + +int stack[pssize]; +int *stakp stack; +int *estkp; + +int *push (i) + + {if (++stakp >= estkp) errx (4007); + *stakp = i; + return (stakp); + } + +pop () + + {int i; + i = *stakp--; + if (stakp < stack) errx (6002); + return (i); + } + +int *setsp (nsp) int *nsp; /* set stack pointer */ + + {if (nsp < stack || nsp >= estkp) errx (6010); + return (stakp = nsp); + } + +int *top () /* get stack pointer */ + + {return (stakp);} + +int *get_top (nsp) int *nsp; /* get list from top of stack */ + + {int *ot; + + ot = top (); + setsp (nsp-1); + return (ot); + } + +/********************************************************************** + + ACTION ROUTINES + +**********************************************************************/ + +ainit () + + {ciln = 0; + cgsp = gstack; + egsp = cgsp + GSSIZE; + cgsp->gtype = GNULL; + estkp = stack + pssize; + dinit (); + } + +astmtl (stmtl, stmt) + + {return (node (n_stmtl, stmtl, stmt));} + +aexprstmt (expr) + + {return (node (n_exprs, line, expr));} + +aif (test, if_part, else_part) + + {return (node (n_if, line, test, if_part, else_part));} + +awhile (expr, stmt) + + {int l; + + l = (cgsp--)->giln; + return (astmtl ( + ailabel (l+1, + aif (expr, astmtl (stmt, abranch (l+1)), 0)), + ailabel (l, 0))); + } + +apshw () {gpush (GWHILE, 2);} + +ado (stmt, expr) + + {int l; + + l = (cgsp--)->giln; + return (astmtl ( + ailabel (l+2, stmt), + astmtl ( + ailabel (l+1, aif (expr, abranch (l+2), 0)), + ailabel (l, 0)))); + } + +apshd () {gpush (GDO, 3);} + + +afor (e1, e2, e3, stmt) + + {int l, tnode; + + l = (cgsp--)->giln; + tnode = astmtl ( + stmt, + astmtl ( + ailabel (l+1, (e3 ? aexprstmt (e3) : NULL)), + abranch (l+2))); + if (e2) tnode = aif (e2, tnode, 0); + tnode = astmtl ( + ailabel (l+2, tnode), + ailabel (l, 0)); + if (e1) tnode = astmtl (aexprstmt (e1), tnode); + return (tnode); + } + +apshf () {gpush (GFOR, 3);} + +aswitch (expr, stmt) + + {int l, c; + + c = cgsp->gchain; + l = (cgsp--)->giln; + + return (astmtl ( + node (n_switch, line, expr, stmt, c), + ailabel (l, 0))); + } + +apshs () {gpush (GSWITCH, 1);} + +abreak () + + {if (cgsp==gstack) + {error (2002, line); + return (NULL); + } + return (abranch (cgsp->giln)); + } + +acontinue () + + {gentry *gp; + + for (gp = cgsp; gp>gstack; --gp) + if (gp->gtype > GSWITCH) /* not a switch */ + return (abranch (gp->giln+1)); + error (2003, line); + return (NULL); + } + +areturn (expr) + + {return (node (n_return, line, expr));} + +agoto (expr) + + {return (node (n_goto, line, astar (expr)));} + +alabel (idn, stmt) + + {dentry *dp; + + dp = define (cblock, idn, c_label, TINT, UNDEF); + if (dp->offset == UNDEF) dp->offset = ciln++; + return (ailabel (dp->offset, stmt)); + } + +ailabel (iln, stmt) + + {return (node (n_label, iln, stmt));} + +abranch (iln) + + {return (node (n_branch, iln));} + +acase (c, stmt) + + {gentry *gp; + + if (gp = findswitch ()) + {gp->gchain = node (n_case, gp->gchain, c, ciln); + return (ailabel (ciln++, stmt)); + } + error (2004, line); + return (stmt); + } + +adefault (stmt) + + {gentry *gp; + + if (gp = findswitch ()) + {gp->gchain = node (n_def, gp->gchain, ciln); + return (ailabel (ciln++, stmt)); + } + error (2005, line); + return (stmt); + } + +anull () + + {return (NULL);} + +aelist (elist, expr) + + {return (node (n_elist, elist, expr));} + +asubscript (e1, e2) + + {return (astar (node (n_plus, e1, e2)));} + +acall (func, args) + + {return (node (n_call, func, args));} + +adot (expr, idn) + + {return (node (n_dot, expr, idn));} + +aptr (expr, idn) + + {return (adot (astar (expr), idn));} + +astar (expr) + + {return (node (n_star, expr));} + +aidn (dp) + dentry *dp; + + {int class; + + switch (class = dp->class) { + case c_ulabel: class=c_label; break; + case c_extern: class=c_extdef; break; + case c_uauto: class=c_auto; break; + case c_typedef: errx (2042, TIDN, dp->name); class=c_auto; break; + } + return (node (n_idn, tp2o (dp->dtype), class, dp->offset)); + } + +aentry (idn, stmt) + + {return (stmt);} /* not implemented */ + + \ No newline at end of file diff --git a/src/c/c23.c b/src/c/c23.c new file mode 100644 index 00000000..c52614f8 --- /dev/null +++ b/src/c/c23.c @@ -0,0 +1,1147 @@ +# include "cc.h" +# include "c2.h" + +/* + + C COMPILER + Phase P: Parser + Section 3: Declaration and Function Processing + + Copyright (c) 1977 by Alan Snyder + +*/ + +/********************************************************************** + + ROUTINE DECLARATIONS + +**********************************************************************/ + +dentry *astridn(), *alidn(), *aeidn(), *afidn(), *afdcl(); +dentry *dmerge(); +int *adeclr(); +type maktyp(); +type astruct(); +type aostruct(); +type afield(); +type atidn(); +type mkstruct(); +type mkdummy(); + +/********************************************************************** + + EXTERNAL VARIABLES + +**********************************************************************/ + +extern int *pv, f_node, f_mac, f_symtab, lc_node, nodeno, + ciln, sflag; + +/********************************************************************** + + DECLARATION PROCESSING VARIABLES + +**********************************************************************/ + +int cblock 0, /* current block, 0 = external */ + nblock 0, /* number of blocks */ + class UNDEF, /* current storage class */ + tclass, /* storage class after defaults */ + mtype, /* current type modifier */ + cidn, /* current identifier */ + cdim, /* current number of dimensions */ + dims[MAXDIMS], /* current dimensions */ + *dimp, /* pointer to current entry in dims */ + strlev 0, /* structure definition level */ + in_type_def 0, /* flag indicates processing of type- + declarations (parameter declarations and + structure member definitions) */ + *parml, /* pointer to list of parameter names */ + nstatic 0, /* static variable counter */ + autoloc, /* location counter for auto variables */ + framesize, /* maximum allocated size of stack frame */ + flineno, /* line number for function definition */ + fnarg, /* number of arguments to current function */ + objmode UNDEF; /* object mode (pure, impure, data, pdata) */ + +type btype; /* basic type of declaration statement */ +type TUNSPEC UNDEF; /* unspecified type */ + +dentry **fparms; /* list of parm definitions on stack */ + + /* Initialization Processing */ + +int initc, /* counter of initializers */ + allow[6], /* allowable initialization classes */ + ipc, /* pointer class for variable being initialized */ + initflag; /* initialization flag */ +type ivtype; /* type of variable being initialized */ +type ietype; /* element type of variable being initialized */ +dentry *idp; /* dictionary pointer of variable */ + +/* DICTIONARY */ + +dentry dict [stsize], + + *dbegin {dict}, /* first entry */ + *dgdp {dict}, /* entry following global defs */ + *dldp, /* first entry in local defs */ + *dend; /* following last entry */ + +/********************************************************************** + + DINIT - Initialize Declaration Processing Variables + +**********************************************************************/ + +dinit () + + {dldp = dend = dict+stsize; + typinit (); + } + +/********************************************************************** + + AFDCL - process function declaration + + Begin processing of function defintion. This routine is + called immediately after the function declaration (the type + specification for the function and the list of parameter + names) has been recognized. + + Define the function name in the global definition dictionary. + Enter preliminary definitions for the parameters in the + local definition dictionary. + + Parameters: + FLAG - 1 ==> type explicitly specified + + External variables used: + BTYPE - the basic type of the function + MTYPE - the type modifier of the function + CIDN - the function name + PARML - points to a list of identifiers (the formal + parameters) on the stack. PARML is 0 if + there are no formal parameters + + Replace the list of identifiers on the stack with a list of + pointers to the dictionary definitions of the formal + parameters. Set FPARMS to point to that list. Return the + dictionary pointer of the function. + +**********************************************************************/ + +dentry *afdcl (flag) + + {int *sp, idn, *ot; + type t; + dentry *fdp; + + flineno = lineno; + if (!flag) + {class = c_extdef; + btype = TINT; + } + t = maktyp (); + if (class != c_extdef) errcidn (1019); + if (!parml) parml = top ()+1; /* null parameter list */ + + /* define function name in global dictionary */ + + fdp = define (0, cidn, c_extdef, t, cidn); + cblock = ++nblock; + framesize = autoloc = sv_area_sz; + if (sflag) puti (cidn, f_symtab); + + /* define parameters in local dictionary */ + + fparms = sp = parml; + fnarg = 0; + ot = top (); + while (sp <= ot) + {idn = *sp; + *sp++ = define (cblock, idn, c_param, TUNSPEC, UNDEF); + ++fnarg; + } + + return (fdp); + } + +/********************************************************************** + + AFPDCL - Process Function Parameter Declarations + + This routine is called after the declarations of formal + parameters have been processed. The list of formal + parameter definitions (accessed via FPARMS) is removed + from the stack. Offsets are computed for the parameters. + +**********************************************************************/ + +afpdcl () + + {dentry *dp, **pp, **ot; + int ploc; + type t; + + pp = fparms; + ot = get_top (pp); + ploc = 0; + while (pp <= ot) + {dp = *pp++; + if (dp->dtype == TUNSPEC) dp->dtype = TINT; + t = dp->dtype; + ploc = align (ploc, t->align); + dp->offset = ploc; + ploc =+ t->size; + } + } + +/********************************************************************** + + AFDEF - Terminate Processing of Function Definition + + This routine is called after the end of the function + definition has been reached. FDP is a pointer to the + dictionary definition of the function. N is the node + offset of the function body. + +**********************************************************************/ + +afdef (fdp, n) dentry *fdp; int n; + + {node (n_prog, fdp->name, tp2o (fdp->dtype), n, framesize, fnarg); + chkdict (dldp, dend); + if (sflag) + {wdict (dldp, dend); /* write parameter defs */ + puti (UNDEF, f_symtab); + } + dldp = dend; /* delete parameter defs */ + cblock = 0; + } + +/********************************************************************** + + ATTRIB - process decl-specifiers + + Check for valid CLASS and determine default CLASS or TYPE if + possible. + +**********************************************************************/ + +attrib (pclass, pbtype) int pclass, pbtype; + + /* check CLASS */ + + {if (strlev>0) class = c_mos; + else if (in_type_def) class = c_param; + else if (cblock==0) switch (pclass) { /* global declaration */ + case UNDEF: class = c_extdef; /* default */ + break; + case c_typedef: + case c_extern: + case c_static: class = pclass; + break; + case c_auto: errx (1018); + class = c_extdef; + break; + default: errx (6009); + } + else class = pclass; + + /* check TYPE */ + + if (pbtype == UNDEF) btype = TINT; /* default */ + else btype = pbtype; + } + +/********************************************************************** + + ASTRUCT - Define a Structure Type + + DP is the dictionary pointer of the type name, or NULL if + the structure type is unnamed. + FP is a pointer to a list of field definitions. + Return the appropriate structure type. + +**********************************************************************/ + +type astruct (dp, fp) dentry *dp; field *fp; + + {int nfields; + field *efp; + + --strlev; + efp = (get_top (fp) + 1); /* get definition list */ + nfields = efp - fp; /* number of members */ + if (dp != NULL) /* named structure type */ + {fixdummy (dp->dtype, nfields, fp); + return (dp->dtype); + } + return (mkstruct (nfields, fp)); + } + +/********************************************************************** + + AOSTRUCT - Return type given structure type name. + +**********************************************************************/ + +type aostruct (name) + + {dentry *dp; + type t; + + --strlev; + dp = find (name + cssiz); + if (dp) return (dp->dtype); + t = mkdummy (name); + define (cblock, name + cssiz, c_ustruct, t, 0); + return (t); + } + +/********************************************************************** + + ASTRIDN - Define Structure Type Name + + Create a dictionary definition for a named structure type + about to be defined. + +**********************************************************************/ + +dentry *astridn (name) + + {dentry *dp; + + dp = find (name+cssiz); + if (dp) + {if (dp->class == c_ustruct) + {dp->class = c_struct; + return (dp); + } + errx (2018, TIDN, name); + return (NULL); + } + return (define (cblock, name+cssiz, c_struct, mkdummy (name), 0)); + } + +/********************************************************************** + + ADECLR - process declarator + + Process the declarator using the following external variables: + + CLASS - the storage class (may be UNDEF) + CIDN - the identifier number + STRLEV - indicates whether member of structure + + Check for illegally specified CLASS, and determine the default + CLASS if necessary. If we are defining a structure field, + then push a field definition on the stack and return a pointer + to it. Otherwise, enter the definition of the declarator in + the dictionary. + Assign a static variable number to static variables. + Set IDP to point to the dictionary entry of the variable, for + use by the initialization routines. Set INITC to UNDEF so that + variables without initialization can be recognized by AIDECLR. + +**********************************************************************/ + +int *adeclr (t) + type t; + + {int *ip, o; + dentry *dp; + + if (strlev) + {ip = push (cidn); + push (t); + push (UNDEF); + return (ip); + } + dp = NULL; + if (class == UNDEF) + tclass = ((t->tag==TTFUNC) ? c_extern : c_auto); + else tclass = class; + if (t->tag==TTFUNC && tclass!=c_param && tclass!=c_typedef) + {if (tclass != c_extern && tclass != c_extdef) + errcidn (1021); + tclass = c_extern; + } + if (tclass==c_param) + {if (!(dp = find (cidn))) /* not a parameter */ + {errcidn (1027); + tclass = c_auto; + } + else if (dp->class==c_param) /* parameter entry located */ + {if (t == TCHAR) t = TINT; + else if (t == TFLOAT) t = TDOUBLE; + else if (t->tag==TTARRAY) + t = mkptr (t->val); + else if (t->tag==TTFUNC || t->tag==TTSTRUCT) + {errcidn (2036); + t = mkptr (t); + } + if (dp->dtype != TUNSPEC) errcidn (2016); + else dp->dtype = t; + } + } + switch (tclass) { + case c_static: o = ++nstatic; break; + case c_extdef: + case c_extern: o = cidn; break; + case c_auto: tclass = c_uauto; + o = autoloc = align (autoloc, t->align); + autoloc =+ t->size; + break; + default: o = UNDEF; + } + if (!dp) dp = define (cblock, cidn, tclass, t, o); + idp = dp; /* for processing initializers */ + ivtype = idp->dtype; + initc = UNDEF; + return (0); + } + +/********************************************************************** + + ADCLR - construct declarator + + MTYP is the current type modifier, NEWTYP is the new type + modifier, DIM is the array dimension, ARRAYFLAG indicates that + all type modifiers so far have been "array of". The current + type modifier is stored in external variable MTYPE. + +**********************************************************************/ + +int adclr (mtyp, newtyp, dim) int mtyp, newtyp, dim; + + {if (mtyp==0 && newtyp==0) /* new declarator */ + {cidn = pv[1]; + cdim = 0; + dimp = dims; + return (mtype = newtyp); + } + if (mtyp == UNDEF) return (UNDEF); /* previous error */ + mtyp = mtyp << 2 | newtyp; + if (newtyp==MARRAY) + {if (cdim>=MAXDIMS) + {errcidn (2015); + return (mtype = UNDEF); + } + if (dim<=0) + {errcidn (1031); + dim=1; + } + *dimp++ = dim; + ++cdim; + } + + return (mtype = mtyp); + } + +/********************************************************************** + + MAKTYP - check for invalid types and correct + + Combine type modifier MTYPE and basic type BTYPE. + +**********************************************************************/ + +type maktyp () + + {register int i; + type t; + + if (mtype == UNDEF) return (TUNDEF); /* previous error */ + if (mtype<<1<0 || mtype<<2<0) + {errcidn (2014); + return (TUNDEF); + } + t = btype; + while (i = (mtype&03)) + {switch (i) { + case MPTR: t = mkptr (t); break; + case MFUNC: t = mkfunc (t); break; + case MARRAY: t = mkarray (t, *--dimp); break; + } + mtype =>> 2; + } + return (t); + } + +/********************************************************************** + + AFIELD - Construct declarator for bit field definition. + (Currently implemented as INT.) This routine performs + the functions of ADCLR and MAKTYP. + +**********************************************************************/ + +type afield (idn, width) + + {cidn = idn; + cdim = 0; + if (!strlev) errcidn (1032); + if (width<0) errcidn (1033); + switch (btype->tag) { + case TTCHAR: /* return (mkcfield (width)); */ + break; + case TTINT: /* return (mkifield (width)); */ + break; + default: errcidn (1034); + } + return (TINT); + } + +/********************************************************************** + + AIINZ - Initialize for the processing of initializers. + + Determine what types of initializers are valid for this + variable and set the array ALLOW accordingly. Also determine + whether or not initialization of this variable is allowed at + all. Output symbol defining macros. + + This routine is called after ADECLR is called for the + variable and immediately before the first initializer is + processed. + +**********************************************************************/ + +aiinz () + + {int i; + + initflag = FALSE; + for (i=0;i<6;i++) allow[i]=FALSE; + ietype = remarr (ivtype); /* remove arrays */ + + /* determine valid initializer types */ + + switch (ietype->tag) { + case TTCHAR: + case TTINT: allow[i_int] = TRUE; break; + case TTFLOAT: + case TTDOUBLE: allow[i_float] = TRUE; + allow[i_negfloat] = TRUE; + break; + case TTSTRUCT: allow[i_string] = TRUE; + allow[i_int] = TRUE; + allow[i_idn] = TRUE; + ipc = tpoint[TTINT]; + break; + case TTPTR: allow[i_int] = TRUE; + allow[i_idn] = TRUE; + ipc = ctype (ietype) - ct_p0; + if (ietype==TPCHAR) allow[i_string] = TRUE; + } + + /* check CLASS */ + + switch (tclass) { + case c_extdef: data; + malign (ivtype->align); + mequ (cidn); + break; + case c_static: data; + malign (ivtype->align); + mstatic (idp->offset); + break; + case c_uauto: + case c_auto: errcidn (1024); + initflag = TRUE; + break; + default: errcidn (1026); + initflag = TRUE; + } + initc = 0; + } + +/********************************************************************** + + INZ - process initializer + + Process initializer and increment INITC. Determine whether + the initializer is of a valid type. + Output the initializer onto the MAC file. INITFLAG is used + to prohibit certain multiple error messages. + +**********************************************************************/ + +inz (i_type, index) int i_type, index; + + {dentry *dp; + int cls; + + if (initflag) return; /* previous error */ + if (!allow[i_type]) + {errcidn (1022); + return; + } + ++initc; + switch (i_type) { + +case i_int: if (ietype==TCHAR) mchar (index); + else mint (index); + return; + +case i_idn: dp = afidn (index); + switch (cls = dp->class) { + case c_extern: cls = c_extdef; + case c_extdef: + case c_static: madcon (ipc, -cls, dp->offset); + break; + default: mint (0); + errx (2038, TIDN, index); + } + return; + +case i_string: mstrcon (index); + return; + +case i_float: if (ietype==TFLOAT) mfloat (index); + else mdouble (index); + return; + +case i_negfloat: + if (ietype==TFLOAT) mnfloat (index); + else mndouble (index); + return; + } + errx (6041); + } + +/********************************************************************** + + AIDECL - Finish processing for a variable which may + have been initialized. If it was initialized, determine + the actual size of the variable and output any zero space + needed. If it was not initialized and was an external + definition or a static variable, allocate storage for it. + Check for multiple initializers to a non-structured variable. + +**********************************************************************/ + +aidecl () + + {int esize, isize, dsize, dcount, i, nelem, aesize; + type etype; + + dsize = ivtype->size; + if (initc == UNDEF) /* not initialized */ + {if (tclass == c_extdef) + {impure; + malign (ivtype->align); + mequ (cidn); + mzero (dsize); + } + if (tclass==c_static) + {impure; + malign (ivtype->align); + mstatic (idp->offset); + mzero (dsize); + } + } + else + {if (ietype->tag==TTSTRUCT) /* finish structure hack */ + {esize = ietype->size; /* structure size */ + isize = initc * tsize[TTINT]; /* initialzed size */ + if (i = isize % esize) + {i = esize - i; + mzero (i); /* fill out structure */ + isize =+ i; + } + initc = isize / esize; /* number of structure values */ + } + if (ivtype->tag == TTARRAY) + /* initializers may increase size of array */ + {esize = ietype->size; + dcount = nelem = dsize/esize; + if (initc > nelem) + {nelem = initc; + etype = ivtype->val; + aesize = etype->size; + ivtype = idp->dtype = mkarray (etype, + (nelem*esize+(aesize-1))/aesize); + dcount = ivtype->size/esize; + } + } + else + {if (initc>1) errcidn (1023); + esize = dsize; + dcount = 1; + } + if (initc < dcount) mzero (esize*(dcount-initc)); + } + } + +/********************************************************************** + + BLOCK STRUCTURE ROUTINES + +**********************************************************************/ + +abegin () + + {push (dldp); + push (autoloc); + } + +aend () + + {int n; + dentry *dp, *odp; + + if (autoloc > framesize) framesize = autoloc; + n = pop (); + if (n >= sv_area_sz && n <= autoloc) autoloc = n; + dp = pop (); + if (dp >= dldp && dp <= dend) + {odp = dldp; + dldp = dp; + chkdict (odp, dldp); /* obscure ILHACK interaction */ + if (sflag) wdict (odp, dldp); + } + } + +/********************************************************************** + + IDENTIFIER LOOKUP ROUTINES + +**********************************************************************/ + +dentry *aeidn (name) + + {dentry *dp; + + dp = define (cblock, name, UNDEF, TUNDEF, UNDEF); + if (dp->class == UNDEF) + {errx (2027, TIDN, name); + dp->class = c_auto; + } + else if (dp->class == c_uauto) dp->class = c_auto; + return (dp); + } + +dentry *afidn (name) + + {dentry *dp; + + dp = define (0, name, UNDEF, TUNSPEC, name); + if (dp->class == UNDEF) + {dp->class = c_extern; + dp->dtype = TFINT; + } + else if (dp->class == c_uauto) dp->class = c_auto; + return (dp); + } + +dentry *alidn (name) + + {dentry *dp; + + dp = define (cblock, name, c_ulabel, TINT, UNDEF); + if (dp->offset == UNDEF) dp->offset = ciln++; + return (dp); + } + +type atidn (name) + + {dentry *dp; + + dp = find (name); + if (!dp || dp->class != c_typedef) + {errx (2041, TIDN, name); + return (TUNDEF); + } + return (dp->dtype); + } + +/********************************************************************** + + MACRO OUTPUT ROUTINES + +**********************************************************************/ + +mhead() {mprint ("%hd()\n");} +mentry(n) {mprint ("%en(%i(*))\n", n);} +extrn(n) {mprint ("%ex(%i(*))\n", n);} +mstatic (n) {mprint ("%st(*)\n", n);} +mequ (n) {mprint ("%eq(%i(*))\n", n);} +mzero (i) {mprint ("%z(*)\n", i);} +malign (ac) {if (ac>0) mprint ("%al*()\n", ac);} +mint (i) {mprint ("%in(*)\n", i);} +mstrcon (i) {mprint ("%sc(*)\n", i);} +madcon (n,b,o) {mprint ("%ad*(0,*,*)\n", n, b, o);} +mchar (i) {mprint ("%c(*)\n", i);} +mfloat (i) {mprint ("%f(*)\n", i);} +mnfloat (i) {mprint ("%nf(*)\n", i);} +mdouble (i) {mprint ("%d(*)\n", i);} +mndouble (i) {mprint ("%nd(*)\n", i);} +mimpure () {mprint ("%im()\n"); objmode=o_impure;} +mpure () {mprint ("%pu()\n"); objmode=o_pure;} +mdata () {mprint ("%da()\n"); objmode=o_data;} + +/********************************************************************** + + SDEF - Define external references and global names + +**********************************************************************/ + +sdef () + + {dentry *dp; + extern char *fn_hmac; + + cclose (f_mac); + f_mac = xopen (fn_hmac, MWRITE, TEXT); + mhead (); + +/* DEFINE ENTRY POINTS */ + + pure; + for (dp=dbegin; dpclass==c_extdef) mentry (dp->name); + +/* DEFINE EXTERNAL REFERENCES */ + + for (dp=dbegin; dpclass==c_extern) extrn (dp->name); + + cclose (f_mac); + } + +/********************************************************************** + + SYMBOL TABLE FORMAT + + The symbol table consists of two parts: a dictionary (DICT) + and a type table (TYPTAB). + + The dictionary is an array of dictionary entries (DENTRY). + The fields of a DENTRY are: + + name - index of identifier + class - storge class + dtype - data type + offset - basis for addressing the item: + parameters: offset in parameter list + automatic: offset in stack frame + static: static variable number + external: 0 + labels: corresponding internal label number + +**********************************************************************/ + +/********************************************************************** + + DEFINE - Create or modify a dictionary entry. + +**********************************************************************/ + +dentry *define (block, name, xclass, dtype, offset) + type dtype; + + {dentry *dp; + + if (dp = find (name)) /* if old entry exists */ + return (dmerge (dp, xclass, dtype, offset)); + if (block==0 || xclass==c_extern) + dp = dgdp++; + else dp = --dldp; + if (dldp < dgdp) errx (4005); + dp->name = name; /* copy entry */ + dp->class = xclass; + dp->dtype = dtype; + dp->offset = offset; + return (dp); + } + +/********************************************************************** + + DMERGE - Merge new definition with old one. + +**********************************************************************/ + +dentry *dmerge (dp, xclass, dtype, offset) + dentry *dp; + type dtype; + + {type t; + int c; + + if (xclass == UNDEF) return (dp); + c = dp->class; + t = dp->dtype; + if (xclass==c_extdef && c==c_extern || + xclass==c_label && c==c_ulabel) + {c = xclass; + xclass = dp->class; + dp->class = c; + t = dtype; + dtype = dp->dtype; + dp->dtype = t; + } + if (xclass==c_extern && (c==c_extdef || c==c_extern) || + xclass==c_ulabel && (c==c_label || c==c_ulabel)) + {if (dtype == TUNSPEC) return (dp); + if (t == dtype) return (dp); + if (t->tag == TTARRAY && dtype->tag == TTARRAY && + t->val == dtype->val) return (dp); + } + errx (2016, TIDN, dp->name); + return (dp); + } + +/********************************************************************** + + FIND - Find the dictionary entry for a identifier + +**********************************************************************/ + +dentry *find (name) + + {dentry *p; + + p = dldp; + while (pname == name) return (p); else ++p; + p = dgdp; + while (--p >= dbegin) if (p->name == name) return (p); + return (NULL); + } + +/********************************************************************** + + CHKDICT - Check dictionary bounded by P1 and P2 for undefined + things. + +**********************************************************************/ + +chkdict (p1, p2) dentry *p1, *p2; + + {type t; + int ilhack; + + ilhack = (p2 == dldp && p1 != dbegin); + while (--p2 >= p1) + {t = p2->dtype; + if (t->tag == TTDUMMY) + {errx (2024, TIDN, t->val); + t = p2->dtype = TUNDEF; + } + if (p2->class == c_ulabel) + {if (ilhack) dswap (p2, --dldp); + else + {errx (2017, TIDN, p2->name); + p2->class = c_label; + } + } + else if (p2->class == c_uauto) + {error (1006, flineno, TIDN, p2->name); + p2->class = c_auto; + } + } + } + +dswap (p1, p2) dentry *p1, *p2; + + {if (p1 != p2) + {swap (&p1->name, &p2->name); + swap (&p1->class, &p2->class); + swap (&p1->dtype, &p2->dtype); + swap (&p1->offset, &p2->offset); + } + } + +swap (p1, p2) int *p1, *p2; + + {int t; + t = *p1; + *p1 = *p2; + *p2 = t; + } + +/********************************************************************** + + WSYMTAB - Write Global Symbol Table + +**********************************************************************/ + +wsymtab () + + {puti (UNDEF, f_symtab); + wdict (dbegin, dgdp); + puti (UNDEF, f_symtab); + } + +/********************************************************************** + + WDICT - Write dictionary bounded by P1 and P2. + +**********************************************************************/ + +wdict (p1, p2) dentry *p1, *p2; + + {while (p1 < p2) + {puti (p1->name, f_symtab); + puti (tp2o (p1->dtype), f_symtab); + puti (p1->offset, f_symtab); + puti (p1->class, f_symtab); + ++p1; + } + } + +dp2o (p) dentry *p; + + {if (p==NULL) return (UNDEF); + if (p=dend) errx (6035); + if (p >= dgdp) return (010000 + (dend - p)); + return (p-dbegin); + } + +/********************************************************************** + + WTYPTAB - Write Type Table + +**********************************************************************/ + +wtyptab () + + {extern int typtab[], *ctypp, *crecp, *etypp, typform[]; + extern char *fn_typtab; + register int *p, fmt; + register field *fp; + int f; + + f = xopen (fn_typtab, MWRITE, BINARY); + puti (ctypp-typtab, f); + p = typtab; + while (p < ctypp) + {fmt = typform[p[0]]; + puti (*p++, f); + puti (*p++, f); + puti (*p++, f); + switch (fmt) { + case 1: puti (*p++, f); break; + case 2: puti (tp2o (*p++), f); break; + case 3: puti (tp2o (*p++), f); + puti (*p++, f); + break; + case 4: puti (rp2o (*p++), f); break; + } + } + puti (etypp-crecp, f); + p = crecp; + while (p < etypp) + {fp = p; + puti (fp->name, f); + if (fp->name == UNDEF) ++p; + else + {puti (tp2o (fp->dtype), f); + puti (fp->offset, f); + p = fp+1; + } + } + cclose (f); + } + +int tp2o (t) type t; + + {extern int typtab[], *ctypp; + int *tt; + + tt = t; + if (tt < typtab || tt >= ctypp) errx (6005); + return (tt - typtab); + } + +int rp2o (p) int *p; + + {extern int *crecp, *etypp; + + if (p < crecp || p >= etypp) errx (6037); + return (etypp - p); + } + +/********************************************************************** + + Type Operations Used Only In Phase P + +**********************************************************************/ + +type mkstruct (n, v) + int n; + field v[]; + + {type t; + t = mkdummy (0); + fixdummy (t, n, v); + return (t); + } + +type mkdummy (name) + + {type t; + t = typxh (TTDUMMY); + typxh (UNDEF); + typxh (1); + typxh (name); + return (t); + } + +fixdummy (t, n, fp) + type t; + int n; + field *fp; + + {field *p; + + recxl (UNDEF); /* UNDEF name marks end of list */ + fp =+ n; + while (--n >= 0) + {--fp; + recxl (fp->offset); + recxl (fp->dtype); + p = recxl (fp->name); + } + t->tag = TTSTRUCT; + t->val = p; + fixstr (t); + } + +fixstr (t) type t; + + {int salign, offset; + register field *fp; + register type ft; + + t->size = -2; /* to catch recursive definition */ + fp = t->val; /* field list */ + salign = 0; + while (fp->name != UNDEF) /* determine alignment */ + {fp->dtype = ft = fixtype (fp->dtype); + if (ft->align > salign) salign = ft->align; + ++fp; + } + t->align = salign; + fp = t->val; + offset = 0; + while (fp->name != UNDEF) /* determine offsets */ + {ft = fp->dtype; + offset = align (offset, ft->align); + fp->offset = offset; + offset =+ ft->size; + ++fp; + } + t->size = align (offset, t->align); + } + +/********************************************************************** + + ERRCIDN - announce error for current identifier + +**********************************************************************/ + +errcidn (errno) {errx (errno, TIDN, cidn);} + \ No newline at end of file diff --git a/src/c/c24.c b/src/c/c24.c new file mode 100644 index 00000000..f1b1a20b --- /dev/null +++ b/src/c/c24.c @@ -0,0 +1,912 @@ +# include "cc.h" +# include "c2.h" + +/* + + C Compiler + Phase P: Parser + Section 4: Parsing Tables + + Copyright (c) 1977 by Alan Snyder + +*/ + +extern int mtype, btype, in_type_def, strlev, *parml; +extern int val, line, *pv, *pl; + +ar6 () + {afdef(pv[1],pv[2]);} + +ar7 () + {val=afdcl(1);} + +ar8 () + {val=afdcl(0);} + +ar9 () + {val=pv[2];} + +ar10 () + {afpdcl();} + +ar11 () + {afpdcl();} + +ar12 () + {val=pv[3];} + +ar13 () + {val=pv[2];} + +ar16 () + {aidecl();} + +ar17 () + {aidecl();} + +ar18 () + {adeclr(maktyp());} + +ar24 () + {inz(i_int,pv[1]);} + +ar25 () + {inz(i_int,-pv[2]);} + +ar26 () + {inz(i_float,pv[1]);} + +ar27 () + {inz(i_negfloat,pv[2]);} + +ar28 () + {inz(i_idn,pv[1]);} + +ar29 () + {inz(i_idn,pv[2]);} + +ar30 () + {inz(i_string,pv[1]);} + +ar31 () + {inz(i_int,pv[1]);} + +ar37 () + {attrib(-1,pv[1]);} + +ar38 () + {attrib(pv[1],pv[2]);} + +ar39 () + {attrib(pv[2],pv[1]);} + +ar42 () + {val=TINT;} + +ar43 () + {val=TCHAR;} + +ar44 () + {val=TFLOAT;} + +ar45 () + {val=TDOUBLE;} + +ar46 () + {val=TINT;} + +ar47 () + {val=TINT;} + +ar48 () + {val=TINT;} + +ar49 () + {val=TINT;} + +ar50 () + {val=TDOUBLE;} + +ar51 () + {val=TINT;} + +ar52 () + {val=TINT;} + +ar53 () + {val=astruct(NULL,pv[3]);} + +ar54 () + {val=astruct(pv[2],pv[4]);} + +ar55 () + {val=aostruct(pv[2]);} + +ar56 () + {val=c_auto;} + +ar57 () + {val=c_static;} + +ar58 () + {val=c_extern;} + +ar59 () + {val=c_auto;} + +ar60 () + {val=c_typedef;} + +ar63 () + {val=adeclr(maktyp());} + +ar64 () + {val=adeclr(afield(pv[1],pv[3]));} + +ar65 () + {val=adeclr(afield(-1,pv[2]));} + +ar66 () + {aiinz(adeclr(maktyp()));} + +ar67 () + {val=adclr(pv[2],MPTR);} + +ar68 () + {val=adclr(pv[1],MFUNC);} + +ar69 () + {val=adclr(pv[1],MARRAY,1);} + +ar70 () + {val=adclr(pv[1],MARRAY,pv[3]);} + +ar71 () + {val=adclr(0,0);} + +ar72 () + {val=pv[2];} + +ar73 () + {val=adclr(pv[2],MPTR);} + +ar74 () + {val=adclr(pv[1],MFUNC);} + +ar75 () + {val=adclr(pv[1],MARRAY,1);} + +ar76 () + {val=adclr(pv[1],MARRAY,pv[3]);} + +ar77 () + {val=adclr(adclr(0,0),MFUNC); + parml=0;} + +ar78 () + {val=adclr(adclr(0,0),MFUNC); + parml=pv[3];} + +ar79 () + {val=pv[2];} + +ar80 () + {val=push(pv[1]);} + +ar81 () + {push(pv[3]);} + +ar88 () + {in_type_def=0; + val=pv[2];} + +ar89 () + {in_type_def=1; + attrib(-1,pv[1]);} + +ar91 () + {val=astmtl(pv[1],pv[2]);} + +ar92 () + {val=aexprstmt(pv[1]);} + +ar94 () + {val=aif(pv[3],pv[5],0);} + +ar95 () + {val=aif(pv[3],pv[5],pv[7]);} + +ar96 () + {val=awhile(pv[3],pv[5]);} + +ar97 () + {val=afor(pv[3],pv[5],pv[7],pv[9]);} + +ar98 () + {val=ado(pv[2],pv[5]);} + +ar99 () + {val=aswitch(pv[3],pv[5]);} + +ar100 () + {val=acase(pv[2],pv[4]);} + +ar101 () + {val=adefault(pv[3]);} + +ar102 () + {val=abreak();} + +ar103 () + {val=acontinue();} + +ar104 () + {val=areturn(0);} + +ar105 () + {val=areturn(pv[2]);} + +ar106 () + {val=agoto(pv[2]);} + +ar107 () + {val=alabel(pv[1],pv[3]);} + +ar108 () + {val=aentry(pv[2],pv[4]);} + +ar109 () + {val=anull();} + +ar111 () + {val=0;} + +ar113 () + {val=aelist(pv[1],pv[3]);} + +ar114 () + {val=node(n_times,pv[1],pv[3]);} + +ar115 () + {val=node(n_div,pv[1],pv[3]);} + +ar116 () + {val=node(n_mod,pv[1],pv[3]);} + +ar117 () + {val=node(n_plus,pv[1],pv[3]);} + +ar118 () + {val=node(n_minus,pv[1],pv[3]);} + +ar119 () + {val=node(n_ls,pv[1],pv[3]);} + +ar120 () + {val=node(n_rs,pv[1],pv[3]);} + +ar121 () + {val=node(n_lt,pv[1],pv[3]);} + +ar122 () + {val=node(n_gt,pv[1],pv[3]);} + +ar123 () + {val=node(n_le,pv[1],pv[3]);} + +ar124 () + {val=node(n_ge,pv[1],pv[3]);} + +ar125 () + {val=node(n_eq,pv[1],pv[3]);} + +ar126 () + {val=node(n_ne,pv[1],pv[3]);} + +ar127 () + {val=node(n_band,pv[1],pv[3]);} + +ar128 () + {val=node(n_bxor,pv[1],pv[3]);} + +ar129 () + {val=node(n_bior,pv[1],pv[3]);} + +ar130 () + {val=node(n_tv_and,pv[1],pv[3]);} + +ar131 () + {val=node(n_tv_or,pv[1],pv[3]);} + +ar132 () + {val=node(n_qmark,pv[1],node(n_colon,pv[3],pv[5]));} + +ar133 () + {val=node(n_assign,pv[1],pv[3]);} + +ar134 () + {val=node(n_ars+pv[2],pv[1],pv[3]);} + +ar135 () + {val=node(n_comma,pv[1],pv[3]);} + +ar138 () + {val=aidn(alidn(pv[1]));} + +ar140 () + {val=aidn(afidn(pv[1]));} + +ar141 () + {val=atidn(pv[1]);} + +ar142 () + {val=node(n_inca,pv[1]);} + +ar143 () + {val=node(n_deca,pv[1]);} + +ar144 () + {val=node(n_star,pv[2]);} + +ar145 () + {val=node(n_addr,pv[2]);} + +ar146 () + {val=node(n_uminus,pv[2]);} + +ar147 () + {val=node(n_tvnot,pv[2]);} + +ar148 () + {val=node(n_bnot,pv[2]);} + +ar149 () + {val=node(n_incb,pv[2]);} + +ar150 () + {val=node(n_decb,pv[2]);} + +ar151 () + {val=node(n_sizeof,pv[2]);} + +ar152 () + {val=node(n_int,1);} + +ar153 () + {val=pv[4];} + +ar154 () + {val=asubscript(pv[1],pv[3]);} + +ar155 () + {val=acall(pv[1],pv[3]);} + +ar156 () + {val=acall(pv[1],0);} + +ar157 () + {val=adot(pv[1],pv[3]);} + +ar158 () + {val=aptr(pv[1],pv[3]);} + +ar159 () + {val=aidn(aeidn(pv[1]));} + +ar160 () + {val=node(n_int,pv[1]);} + +ar161 () + {val=node(n_float,pv[1]);} + +ar162 () + {val=node(n_string,pv[1]);} + +ar163 () + {val=pv[2];} + +ar172 () + {apshw();} + +ar173 () + {apshd();} + +ar174 () + {apshf();} + +ar175 () + {apshs();} + +ar176 () + {strlev++;} + +ar177 () + {val=astridn(pv[1]);} + +ar178 () + {abegin();} + +ar179 () + {aend();} + +ar180 () + {val=pv[1]*pv[3];} + +ar181 () + {val=pv[1]/pv[3];} + +ar182 () + {val=pv[1]%pv[3];} + +ar183 () + {val=pv[1]+pv[3];} + +ar184 () + {val=pv[1]-pv[3];} + +ar185 () + {val=pv[1]<>pv[3];} + +ar187 () + {val=pv[1]pv[3];} + +ar189 () + {val=pv[1]<=pv[3];} + +ar190 () + {val=pv[1]>=pv[3];} + +ar191 () + {val=pv[1]==pv[3];} + +ar192 () + {val=pv[1]!=pv[3];} + +ar193 () + {val=pv[1]&pv[3];} + +ar194 () + {val=pv[1]^pv[3];} + +ar195 () + {val=pv[1]|pv[3];} + +ar196 () + {val=pv[1]&&pv[3];} + +ar197 () + {val=pv[1]||pv[3];} + +ar198 () + {val=(pv[1]?pv[3]:pv[5]);} + +ar200 () + {val= -pv[2];} + +ar201 () + {val= !pv[2];} + +ar202 () + {val= ~pv[2];} + +ar204 () + {val=pv[2];} + +int (*act[])() { + 0, 0, 0, 0, 0, 0, ar6, ar7, ar8, ar9, + ar10, ar11, ar12, ar13, 0, 0, ar16, ar17, ar18, 0, + 0, 0, 0, 0, ar24, ar25, ar26, ar27, ar28, ar29, + ar30, ar31, 0, 0, 0, 0, 0, ar37, ar38, ar39, + 0, 0, ar42, ar43, ar44, ar45, ar46, ar47, ar48, ar49, + ar50, ar51, ar52, ar53, ar54, ar55, ar56, ar57, ar58, ar59, + ar60, 0, 0, ar63, ar64, ar65, ar66, ar67, ar68, ar69, + ar70, ar71, ar72, ar73, ar74, ar75, ar76, ar77, ar78, ar79, + ar80, ar81, 0, 0, 0, 0, 0, 0, ar88, ar89, + 0, ar91, ar92, 0, ar94, ar95, ar96, ar97, ar98, ar99, + ar100, ar101, ar102, ar103, ar104, ar105, ar106, ar107, ar108, ar109, + 0, ar111, 0, ar113, ar114, ar115, ar116, ar117, ar118, ar119, + ar120, ar121, ar122, ar123, ar124, ar125, ar126, ar127, ar128, ar129, + ar130, ar131, ar132, ar133, ar134, ar135, 0, 0, ar138, 0, + ar140, ar141, ar142, ar143, ar144, ar145, ar146, ar147, ar148, ar149, + ar150, ar151, ar152, ar153, ar154, ar155, ar156, ar157, ar158, ar159, + ar160, ar161, ar162, ar163, 0, 0, 0, 0, 0, 0, + 0, 0, ar172, ar173, ar174, ar175, ar176, ar177, ar178, ar179, + ar180, ar181, ar182, ar183, ar184, ar185, ar186, ar187, ar188, ar189, + ar190, ar191, ar192, ar193, ar194, ar195, ar196, ar197, ar198, 0, + ar200, ar201, ar202, 0, ar204, -1}; + + + +int r1[] { + 0, 1, 2, 2, 3, 3, 4, 5, 5, 6, + 7, 7, 8, 8, 9, 9, 10, 10, 10, 11, + 11, 11, 12, 12, 13, 13, 13, 13, 13, 13, + 13, 14, 14, 15, 15, 16, 16, 17, 17, 17, + 18, 18, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 20, 20, 20, 20, + 20, 21, 21, 22, 22, 22, 23, 24, 24, 24, + 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, + 26, 26, 27, 27, 28, 28, 29, 29, 30, 31, + 32, 32, 33, 33, 33, 33, 33, 33, 33, 33, + 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, + 34, 34, 35, 35, 36, 36, 36, 36, 36, 36, + 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, + 36, 36, 36, 36, 36, 36, 36, 37, 37, 38, + 38, 39, 40, 40, 40, 40, 40, 40, 40, 40, + 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, + 40, 40, 40, 40, 41, 42, 42, 42, 42, 42, + 42, 42, 43, 44, 45, 46, 47, 48, 49, 50, + 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, + 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, + 52, 52, 52, 52, 52, -1}; + +int r2[] { + 0, 2, 2, 0, 1, 1, 2, 2, 1, 2, + 1, 0, 4, 3, 1, 3, 2, 1, 1, 1, + 3, 4, 1, 3, 1, 2, 1, 2, 1, 2, + 1, 1, 1, 1, 2, 3, 2, 1, 2, 2, + 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, + 2, 1, 2, 4, 5, 2, 1, 1, 1, 1, + 1, 1, 3, 1, 3, 2, 1, 2, 3, 3, + 4, 1, 3, 2, 3, 3, 4, 3, 4, 3, + 1, 3, 1, 2, 1, 2, 1, 2, 3, 1, + 1, 2, 2, 1, 5, 7, 5, 9, 7, 5, + 4, 3, 2, 2, 2, 3, 3, 3, 4, 1, + 1, 0, 1, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 5, 3, 3, 3, 1, 1, 1, 1, + 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 4, 4, 4, 4, 3, 3, 3, 1, + 1, 1, 1, 3, 2, 0, 2, 5, 2, 3, + 4, 3, 1, 1, 1, 1, 1, 1, 1, 1, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 5, 1, + 2, 2, 2, 1, 3, -1}; + +int g[] { + 0, 0, 2, 0, 19, 0, 20, 0, 21, 0, + 40, 0, 41, 41, 72, 0, 142, 0, 53, 92, + 180, 0, 54, 0, 101, 0, 184, 56, 102, 0, + 185, 286, 338, 0, 186, 0, 114, 73, 115, 114, + 201, 0, 22, 2, 23, 0, 116, 2, 24, 26, + 60, 73, 24, 114, 24, 0, 42, 2, 25, 73, + 25, 114, 25, 118, 202, 224, 202, 0, 43, 24, + 58, 0, 26, 0, 78, 47, 79, 153, 263, 0, + 55, 0, 56, 47, 80, 48, 82, 49, 83, 75, + 82, 76, 83, 153, 80, 0, 57, 2, 27, 4, + 32, 23, 51, 49, 32, 92, 181, 116, 181, 0, + 31, 0, 69, 0, 44, 44, 74, 0, 45, 110, + 197, 0, 108, 38, 70, 63, 109, 108, 196, 110, + 109, 197, 196, 0, 46, 0, 47, 114, 200, 0, + 143, 143, 229, 149, 260, 199, 289, 200, 229, 221, + 299, 300, 345, 301, 346, 344, 360, 352, 363, 355, + 366, 369, 373, 376, 377, 0, 144, 354, 365, 371, + 375, 0, 333, 0, 325, 118, 205, 126, 214, 127, + 216, 218, 298, 224, 205, 231, 303, 232, 304, 233, + 305, 234, 306, 235, 307, 236, 308, 237, 309, 238, + 310, 239, 311, 240, 312, 241, 313, 242, 314, 243, + 315, 244, 316, 245, 317, 246, 318, 247, 319, 248, + 320, 249, 321, 250, 322, 251, 323, 252, 324, 253, + 326, 256, 328, 259, 331, 261, 334, 262, 335, 348, + 361, 349, 362, 353, 364, 354, 334, 371, 334, 0, + 145, 0, 217, 0, 146, 0, 28, 119, 206, 120, + 207, 121, 208, 122, 209, 123, 210, 124, 211, 125, + 212, 138, 225, 294, 343, 347, 343, 0, 147, 224, + 302, 0, 203, 291, 340, 292, 341, 0, 293, 0, + 148, 0, 149, 0, 150, 0, 151, 0, 29, 0, + 65, 0, 73, 200, 290, 0, 227, 52, 90, 62, + 107, 84, 156, 85, 157, 104, 193, 136, 222, 161, + 265, 162, 266, 163, 267, 164, 268, 165, 269, 166, + 270, 167, 271, 168, 272, 169, 273, 170, 274, 171, + 275, 172, 276, 173, 277, 174, 278, 175, 279, 176, + 280, 177, 281, 178, 282, 179, 283, 336, 356, 342, + 359, 0, 187, 86, 158, 87, 159, 88, 160, 182, + 160, 0, 91, -1}; + +int pg[] { + 0, 0, 1, 3, 5, 7, 9, 11, 13, 17, + 19, 23, 25, 27, 31, 35, 37, 43, 47, 57, + 69, 73, 75, 81, 83, 97, 111, 113, 115, 119, + 123, 135, 137, 141, 167, 173, 175, 251, 253, 255, + 257, 279, 283, 289, 291, 293, 295, 297, 299, 301, + 303, 307, 363, -1}; + +int nbpw {16}; + +int nwpbt {5}; + +int a[] { + 0, 0, 0, 117, 195, 71, 106, 62, 66, 118, + 52, 92, 257, 179, 119, 120, 121, 176, 175, 163, + 162, 122, 123, 164, 250, 168, 169, 124, 125, 172, + 173, 170, 171, 166, 167, 258, 251, 177, 178, 0, + 5, 6, 7, 8, 9, 10, 11, 12, 126, 127, + 128, 369, 129, 130, 131, 132, 133, 134, 135, 136, + 137, 13, 138, 14, 15, 16, 17, 0, 0, 0, + 0, 0, 0, 0, 0, 113, 139, 140, 141, 12291, + 20481, 0, 0, 65280, 40960, 7, 4097, 16384, 4105, 8195, + 4117, 8196, 4171, 8210, 0, 4105, 8195, 4117, 8196, 4171, + 8222, 0, 12330, 12331, 12332, 12333, 12464, 12344, 12345, 12346, + 12347, 4136, 8225, 4138, 8226, 12334, 4136, 8227, 12336, 4136, + 8228, 12339, 12348, 4105, 8229, 12429, 12290, 12293, 20481, 0, + 0, 7936, 32768, 3, 4157, 8230, 4171, 8231, 12299, 12292, + 4105, 8240, 4106, 8244, 4117, 8241, 4171, 8242, 0, 20481, + 0, 0, 57344, 8192, 4, 12325, 4099, 8251, 12329, 20481, + 0, 0, 7936, 32768, 3, 4171, 8231, 0, 4103, 8254, + 4105, 8253, 12296, 12328, 4101, 8255, 4171, 8256, 0, 4105, + 8229, 0, 4103, 8254, 4104, 8258, 4105, 8253, 0, 4103, + 8254, 4105, 8253, 12361, 12335, 12338, 12337, 12340, 4104, 8259, + 4171, 8260, 0, 20481, 0, 0, 7936, 32768, 3, 4171, + 8231, 0, 12429, 12294, 4101, 8263, 0, 12377, 12329, 20481, + 0, 0, 7936, 32768, 3, 4157, 8230, 4171, 8231, 12298, + 12370, 12372, 4105, 8267, 4106, 8244, 4117, 8268, 4171, 8269, + 0, 4105, 8240, 4117, 8241, 4171, 8273, 0, 4105, 8240, + 4117, 8241, 4171, 8273, 0, 4105, 8229, 4106, 8276, 12359, + 4099, 12306, 4103, 8254, 4105, 8253, 4107, 12306, 12295, 4105, + 8277, 4110, 8278, 4111, 8279, 4118, 8280, 4172, 8281, 0, + 4099, 8285, 4107, 8284, 0, 12302, 12305, 4101, 8286, 4112, + 8287, 4118, 8288, 4171, 8289, 4172, 8290, 4173, 8291, 4174, + 8292, 0, 4099, 12351, 4103, 8296, 4105, 8295, 4107, 12351, + 12354, 12327, 12324, 12326, 4104, 8297, 0, 4102, 8298, 4105, + 8277, 4110, 8278, 4111, 8279, 4118, 8280, 4172, 8281, 0, + 20481, 0, 0, 7936, 32768, 3, 4171, 8231, 0, 4101, + 12465, 12343, 4101, 8302, 0, 12367, 12365, 12368, 4104, 8303, + 4107, 8304, 0, 12373, 12466, 12297, 20481, 49704, 6241, 65280, + 65527, 30727, 0, 12371, 4105, 8267, 4117, 8268, 4171, 8344, + 0, 4106, 8276, 12359, 4099, 8346, 4107, 8345, 0, 12349, + 4103, 8296, 4105, 8295, 12351, 4105, 8229, 12359, 4103, 8296, + 4104, 8347, 4105, 8295, 0, 4103, 8296, 4105, 8295, 12355, + 4105, 8277, 4110, 8278, 4111, 8279, 4118, 8280, 4172, 8281, + 0, 12491, 20481, 8192, 59038, 103, 0, 0, 4112, 8366, + 4117, 8353, 4118, 8357, 12353, 12487, 4105, 8240, 4106, 8244, + 4117, 8241, 4171, 8242, 0, 12323, 4105, 8277, 4110, 8278, + 4111, 8279, 4112, 8287, 4118, 8374, 4171, 8289, 4172, 8375, + 4173, 8291, 4174, 8292, 0, 4171, 8380, 0, 4172, 8381, + 4173, 8382, 0, 12316, 12312, 12314, 12318, 12304, 12307, 4104, + 8383, 0, 4102, 8384, 4105, 8277, 4110, 8278, 4111, 8279, + 4118, 8280, 4172, 8281, 0, 12362, 12363, 20481, 8192, 59038, + 103, 0, 0, 4102, 8386, 4112, 8366, 4117, 8353, 4118, + 8357, 0, 20481, 16, 0, 7936, 32768, 3, 4171, 8231, + 0, 12374, 12366, 4171, 8390, 0, 4105, 12428, 4106, 8391, + 4117, 12429, 4141, 12429, 4142, 12429, 4143, 12429, 4157, 12429, + 4162, 12429, 4171, 12429, 12447, 20481, 49704, 6241, 65280, 65527, + 30727, 0, 12321, 4105, 8240, 4106, 8244, 4117, 8241, 4171, + 8242, 0, 12397, 20481, 49664, 6241, 7936, 49152, 28675, 4171, + 8396, 0, 20481, 49664, 6241, 0, 16384, 28672, 4171, 8396, + 0, 20481, 49664, 6241, 0, 16384, 28672, 4099, 8405, 4171, + 8396, 0, 20481, 49664, 6241, 0, 16384, 28672, 4171, 8407, + 0, 4105, 8410, 0, 12463, 4099, 8411, 0, 4099, 8412, + 0, 12460, 12461, 12462, 4106, 8413, 0, 4171, 8415, 0, + 20481, 49152, 6241, 0, 16384, 28672, 4105, 8416, 4171, 8396, + 0, 12448, 12449, 12450, 12381, 20481, 49704, 6241, 0, 24567, + 28672, 4100, 8418, 4171, 8420, 0, 12378, 4099, 8422, 4107, + 8444, 4109, 8441, 4112, 8436, 4113, 8438, 4114, 8437, 4115, + 8425, 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4120, + 8442, 4121, 8430, 4122, 8431, 4125, 8434, 4126, 8435, 4127, + 8432, 4128, 8433, 4129, 8428, 4130, 8429, 4132, 8443, 4133, + 8439, 4134, 8440, 0, 4105, 8445, 0, 4103, 8448, 4105, + 12427, 4108, 8449, 4123, 8446, 4124, 8447, 4131, 8450, 12424, + 4105, 8451, 0, 20481, 49704, 6241, 0, 24567, 28672, 4171, + 8420, 0, 4105, 8453, 0, 4105, 8454, 0, 12359, 4105, + 8267, 4106, 8244, 4117, 8268, 4171, 8269, 0, 12376, 12360, + 20481, 8192, 59038, 103, 0, 0, 4112, 8366, 4117, 8353, + 4118, 8357, 12352, 20481, 8192, 59038, 103, 0, 0, 4104, + 8456, 4112, 8366, 4117, 8353, 4118, 8357, 0, 12490, 12489, + 12488, 12303, 4103, 8254, 4105, 8253, 12306, 4105, 8277, 4110, + 8278, 4111, 8279, 4118, 8280, 4172, 8476, 4173, 8382, 0, + 4100, 12312, 4107, 12312, 12491, 4100, 8477, 4107, 8478, 0, + 12320, 12310, 20481, 8192, 59038, 103, 0, 0, 4112, 8366, + 4117, 8353, 4118, 8357, 12319, 12317, 12313, 12315, 12356, 12357, + 20481, 8192, 59038, 103, 0, 0, 4102, 8479, 4112, 8366, + 4117, 8353, 4118, 8357, 0, 12364, 12341, 12375, 20481, 0, + 0, 7936, 32768, 3, 4100, 8480, 4171, 8231, 0, 12369, + 20481, 49704, 6241, 0, 24567, 28672, 4100, 8418, 4171, 8420, + 0, 12322, 4105, 8483, 4117, 8484, 12453, 4104, 8486, 0, + 4105, 12428, 12447, 4104, 8487, 4107, 8444, 4109, 8441, 4112, + 8436, 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, 4117, + 8423, 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, 4122, + 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, + 8428, 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, 0, + 4103, 8448, 4105, 12427, 4108, 8449, 4123, 8446, 4124, 8447, + 4131, 8450, 12436, 4103, 8448, 4105, 12427, 4108, 8449, 4123, + 8446, 4124, 8447, 4131, 8450, 12435, 4103, 8448, 4105, 12427, + 4108, 8449, 4123, 8446, 4124, 8447, 4131, 8450, 12433, 4103, + 8448, 4105, 12427, 4108, 8449, 4123, 8446, 4124, 8447, 4131, + 8450, 12432, 4103, 8448, 4105, 12427, 4108, 8449, 4123, 8446, + 4124, 8447, 4131, 8450, 12434, 4103, 8448, 4105, 12427, 4108, + 8449, 4123, 8446, 4124, 8447, 4131, 8450, 12437, 4103, 8448, + 4105, 12427, 4108, 8449, 4123, 8446, 4124, 8447, 4131, 8450, + 12438, 12392, 4099, 8488, 4107, 8444, 4109, 8441, 4112, 8436, + 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, 4117, 8423, + 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, 4122, 8431, + 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, 8428, + 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, 0, 4099, + 12426, 4105, 12428, 12447, 4107, 8444, 4109, 8441, 4112, 8436, + 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, 4117, 8423, + 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, 4122, 8431, + 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, 8428, + 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, 12425, 4099, + 8489, 0, 20481, 49664, 6241, 0, 16384, 28672, 4171, 8396, + 0, 12390, 12391, 20481, 8192, 59038, 103, 0, 0, 4106, + 8492, 4112, 8366, 4117, 8353, 4118, 8357, 0, 4106, 8493, + 0, 20481, 49664, 6241, 7936, 49152, 28675, 4171, 8396, 0, + 4103, 8448, 4105, 12427, 4108, 8449, 4123, 8446, 4124, 8447, + 4131, 8450, 12439, 12467, 12301, 4105, 12428, 4106, 8391, 12447, + 12379, 12380, 20481, 49664, 6241, 0, 16384, 28672, 4104, 8519, + 4171, 8396, 0, 12430, 12431, 4171, 8521, 0, 4171, 8522, + 0, 4151, 8524, 0, 20481, 49664, 6241, 0, 16384, 28672, + 4171, 8396, 12399, 12350, 12492, 12468, 12469, 12470, 4115, 8355, + 4116, 8354, 4117, 8353, 12471, 4115, 8355, 4116, 8354, 4117, + 8353, 12472, 20481, 0, 152, 0, 0, 0, 4117, 8353, + 4118, 8357, 12473, 20481, 0, 152, 0, 0, 0, 4117, + 8353, 4118, 8357, 12474, 20481, 0, 152, 6, 0, 0, + 4117, 8353, 4118, 8357, 12475, 20481, 0, 152, 6, 0, + 0, 4117, 8353, 4118, 8357, 12476, 20481, 0, 152, 6, + 0, 0, 4117, 8353, 4118, 8357, 12477, 20481, 0, 152, + 6, 0, 0, 4117, 8353, 4118, 8357, 12478, 20481, 0, + 34456, 7, 0, 0, 4117, 8353, 4118, 8357, 12479, 20481, + 0, 34456, 7, 0, 0, 4117, 8353, 4118, 8357, 12480, + 20481, 0, 59032, 7, 0, 0, 4117, 8353, 4118, 8357, + 12481, 20481, 0, 59032, 7, 0, 0, 4112, 8366, 4117, + 8353, 4118, 8357, 12482, 20481, 0, 59036, 7, 0, 0, + 4112, 8366, 4117, 8353, 4118, 8357, 12483, 20481, 0, 59038, + 7, 0, 0, 4112, 8366, 4117, 8353, 4118, 8357, 12484, + 20481, 0, 59038, 39, 0, 0, 4112, 8366, 4117, 8353, + 4118, 8357, 12485, 20481, 8192, 59038, 103, 0, 0, 4106, + 8528, 4112, 8366, 4117, 8353, 4118, 8357, 0, 4100, 12313, + 4107, 12313, 12491, 12308, 4100, 8529, 4105, 8277, 4110, 8278, + 4111, 8279, 4112, 8287, 4118, 8374, 4171, 8289, 4172, 8375, + 4173, 8291, 4174, 8292, 0, 12358, 12342, 12395, 12300, 4104, + 8531, 4105, 8483, 4117, 8484, 12453, 4105, 8483, 4117, 8484, + 12453, 4103, 8534, 12452, 12451, 12393, 12394, 4104, 8536, 4107, + 8444, 4109, 8441, 4112, 8436, 4113, 8438, 4114, 8437, 4115, + 8425, 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4120, + 8442, 4121, 8430, 4122, 8431, 4125, 8434, 4126, 8435, 4127, + 8432, 4128, 8433, 4129, 8428, 4130, 8429, 4132, 8443, 4133, + 8439, 4134, 8440, 0, 12389, 4104, 8539, 0, 12402, 12403, + 12404, 4115, 8425, 4116, 8424, 4117, 8423, 12405, 4115, 8425, + 4116, 8424, 4117, 8423, 12406, 4115, 8425, 4116, 8424, 4117, + 8423, 4118, 8427, 4119, 8426, 12407, 4115, 8425, 4116, 8424, + 4117, 8423, 4118, 8427, 4119, 8426, 12408, 4115, 8425, 4116, + 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4129, 8428, 4130, + 8429, 12409, 4115, 8425, 4116, 8424, 4117, 8423, 4118, 8427, + 4119, 8426, 4129, 8428, 4130, 8429, 12410, 4115, 8425, 4116, + 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4129, 8428, 4130, + 8429, 12411, 4115, 8425, 4116, 8424, 4117, 8423, 4118, 8427, + 4119, 8426, 4129, 8428, 4130, 8429, 12412, 4115, 8425, 4116, + 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4121, 8430, 4122, + 8431, 4127, 8432, 4128, 8433, 4129, 8428, 4130, 8429, 12413, + 4115, 8425, 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, + 4121, 8430, 4122, 8431, 4127, 8432, 4128, 8433, 4129, 8428, + 4130, 8429, 12414, 4115, 8425, 4116, 8424, 4117, 8423, 4118, + 8427, 4119, 8426, 4121, 8430, 4122, 8431, 4125, 8434, 4126, + 8435, 4127, 8432, 4128, 8433, 4129, 8428, 4130, 8429, 12415, + 4112, 8436, 4115, 8425, 4116, 8424, 4117, 8423, 4118, 8427, + 4119, 8426, 4121, 8430, 4122, 8431, 4125, 8434, 4126, 8435, + 4127, 8432, 4128, 8433, 4129, 8428, 4130, 8429, 12416, 4112, + 8436, 4114, 8437, 4115, 8425, 4116, 8424, 4117, 8423, 4118, + 8427, 4119, 8426, 4121, 8430, 4122, 8431, 4125, 8434, 4126, + 8435, 4127, 8432, 4128, 8433, 4129, 8428, 4130, 8429, 12417, + 4112, 8436, 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, + 4117, 8423, 4118, 8427, 4119, 8426, 4121, 8430, 4122, 8431, + 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, 8428, + 4130, 8429, 12418, 4112, 8436, 4113, 8438, 4114, 8437, 4115, + 8425, 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4121, + 8430, 4122, 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, + 8433, 4129, 8428, 4130, 8429, 4133, 8439, 12419, 4106, 8540, + 4107, 8444, 4109, 8441, 4112, 8436, 4113, 8438, 4114, 8437, + 4115, 8425, 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, + 4120, 8442, 4121, 8430, 4122, 8431, 4125, 8434, 4126, 8435, + 4127, 8432, 4128, 8433, 4129, 8428, 4130, 8429, 4132, 8443, + 4133, 8439, 4134, 8440, 0, 4109, 8441, 4112, 8436, 4113, + 8438, 4114, 8437, 4115, 8425, 4116, 8424, 4117, 8423, 4118, + 8427, 4119, 8426, 4120, 8442, 4121, 8430, 4122, 8431, 4125, + 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, 8428, 4130, + 8429, 4132, 8443, 4133, 8439, 4134, 8440, 12421, 4109, 8441, + 4112, 8436, 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, + 4117, 8423, 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, + 4122, 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, + 4129, 8428, 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, + 12422, 4109, 8441, 4112, 8436, 4113, 8438, 4114, 8437, 4115, + 8425, 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4120, + 8442, 4121, 8430, 4122, 8431, 4125, 8434, 4126, 8435, 4127, + 8432, 4128, 8433, 4129, 8428, 4130, 8429, 4132, 8443, 4133, + 8439, 4134, 8440, 12423, 4104, 8542, 4107, 8541, 0, 4109, + 8441, 4112, 8436, 4113, 8438, 4114, 8437, 4115, 8425, 4116, + 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4120, 8442, 4121, + 8430, 4122, 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, + 8433, 4129, 8428, 4130, 8429, 4132, 8443, 4133, 8439, 4134, + 8440, 12400, 12444, 4102, 8543, 4107, 8444, 4109, 8441, 4112, + 8436, 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, 4117, + 8423, 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, 4122, + 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, + 8428, 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, 0, + 12445, 12446, 4104, 8544, 4107, 8444, 4109, 8441, 4112, 8436, + 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, 4117, 8423, + 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, 4122, 8431, + 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, 8428, + 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, 0, 4105, + 8545, 0, 4099, 8546, 0, 4107, 8444, 4109, 8441, 4112, + 8436, 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, 4117, + 8423, 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, 4122, + 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, 4129, + 8428, 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, 12398, + 4104, 8547, 4107, 8444, 4109, 8441, 4112, 8436, 4113, 8438, + 4114, 8437, 4115, 8425, 4116, 8424, 4117, 8423, 4118, 8427, + 4119, 8426, 4120, 8442, 4121, 8430, 4122, 8431, 4125, 8434, + 4126, 8435, 4127, 8432, 4128, 8433, 4129, 8428, 4130, 8429, + 4132, 8443, 4133, 8439, 4134, 8440, 0, 12309, 12311, 12454, + 4103, 8534, 4104, 8549, 0, 4103, 8534, 12456, 4102, 8550, + 4105, 8277, 4110, 8278, 4111, 8279, 4118, 8280, 4172, 8281, + 0, 4103, 8448, 4105, 12427, 4108, 8449, 4123, 8446, 4124, + 8447, 4131, 8450, 12441, 12388, 12396, 20481, 512, 6144, 0, + 16384, 28672, 4171, 8396, 12440, 12443, 12442, 20481, 49664, 6241, + 0, 16384, 28672, 4171, 8396, 12399, 20481, 8192, 59038, 103, + 0, 0, 4112, 8366, 4117, 8353, 4118, 8357, 12486, 4105, + 8559, 12459, 12457, 20481, 8192, 59038, 103, 0, 0, 4102, + 8560, 4112, 8366, 4117, 8353, 4118, 8357, 0, 4147, 8561, + 12382, 4109, 8441, 4112, 8436, 4113, 8438, 4114, 8437, 4115, + 8425, 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4121, + 8430, 4122, 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, + 8433, 4129, 8428, 4130, 8429, 4133, 8439, 4134, 8440, 12420, + 4109, 8441, 4112, 8436, 4113, 8438, 4114, 8437, 4115, 8425, + 4116, 8424, 4117, 8423, 4118, 8427, 4119, 8426, 4120, 8442, + 4121, 8430, 4122, 8431, 4125, 8434, 4126, 8435, 4127, 8432, + 4128, 8433, 4129, 8428, 4130, 8429, 4132, 8443, 4133, 8439, + 4134, 8440, 12401, 12384, 4104, 8562, 4107, 8444, 4109, 8441, + 4112, 8436, 4113, 8438, 4114, 8437, 4115, 8425, 4116, 8424, + 4117, 8423, 4118, 8427, 4119, 8426, 4120, 8442, 4121, 8430, + 4122, 8431, 4125, 8434, 4126, 8435, 4127, 8432, 4128, 8433, + 4129, 8428, 4130, 8429, 4132, 8443, 4133, 8439, 4134, 8440, + 0, 4099, 8563, 0, 12387, 4104, 8564, 0, 12458, 4099, + 8566, 0, 20481, 49664, 6241, 0, 16384, 28672, 4171, 8396, + 12399, 12455, 12383, 12386, 4104, 8568, 0, 12385, -1}; + +int pa[] { + 0, 79, 80, 95, 95, 102, 103, 104, 105, 106, + 107, 108, 109, 110, 111, 116, 119, 122, 123, 126, + 127, 128, 139, 140, 149, 156, 159, 168, 173, 174, + 179, 182, 189, 194, 195, 196, 197, 198, 203, 212, + 213, 214, 217, 218, 219, 230, 231, 232, 241, 248, + 255, 260, 269, 280, 285, 286, 287, 302, 311, 312, + 313, 314, 317, 330, 339, 342, 345, 346, 347, 348, + 353, 354, 355, 356, 363, 364, 364, 371, 374, 379, + 380, 385, 388, 395, 269, 269, 400, 400, 400, 411, + 412, 425, 426, 435, 436, 455, 458, 463, 464, 465, + 466, 467, 468, 469, 472, 485, 486, 487, 502, 511, + 330, 512, 513, 516, 535, 542, 543, 552, 553, 562, + 562, 562, 562, 562, 562, 562, 571, 582, 591, 594, + 595, 598, 601, 602, 603, 604, 269, 607, 610, 621, + 622, 623, 624, 625, 636, 637, 684, 687, 700, 703, + 712, 715, 718, 719, 728, 729, 730, 743, 758, 759, + 760, 269, 269, 269, 269, 269, 269, 269, 269, 269, + 269, 269, 269, 269, 269, 269, 269, 269, 269, 269, + 761, 762, 767, 780, 785, 790, 791, 792, 805, 806, + 807, 808, 809, 810, 825, 826, 827, 828, 839, 703, + 840, 851, 852, 857, 860, 863, 910, 923, 936, 949, + 962, 975, 988, 1001, 1002, 1049, 1054, 1099, 1102, 1111, + 1112, 703, 1113, 1128, 1131, 1140, 1153, 1154, 1155, 1160, + 1161, 1102, 1102, 1102, 1102, 1102, 1102, 1102, 1102, 1102, + 1102, 1102, 1102, 1102, 1102, 1102, 1102, 1102, 1102, 1102, + 1102, 1102, 1102, 1162, 1173, 1174, 1102, 1175, 1178, 1102, + 1181, 1184, 1102, 1193, 1194, 1195, 1196, 1197, 1198, 1205, + 1212, 1223, 1234, 1245, 1256, 1267, 1278, 1289, 1300, 1311, + 1324, 1337, 1350, 1363, 1378, 1383, 1384, 1405, 1406, 1407, + 1408, 1409, 1416, 1421, 562, 1424, 1425, 1426, 1427, 1474, + 703, 703, 1475, 1478, 1479, 1480, 1481, 1488, 1495, 1506, + 1517, 1532, 1547, 1562, 1577, 1600, 1623, 1650, 1679, 1710, + 1743, 1778, 1825, 1868, 1911, 1954, 1959, 2002, 2003, 2050, + 2051, 2052, 2099, 2102, 2105, 2150, 269, 2197, 2198, 2199, + 2200, 2205, 2208, 2221, 703, 2234, 2235, 2236, 1102, 1102, + 2245, 2246, 703, 1102, 2247, 703, 2256, 2269, 2272, 2273, + 2288, 2291, 2330, 2373, 2374, 2421, 2424, 2425, 2428, 703, + 2429, 2432, 2441, 2442, 2443, 2444, 703, 2447, -1}; + + + \ No newline at end of file diff --git a/src/c/c25.c b/src/c/c25.c index 7ad1df2d..325d576e 100644 --- a/src/c/c25.c +++ b/src/c/c25.c @@ -1,19 +1,15 @@ +# /* - PARSING ROUTINE (for use with CC & OYACC) + C COMPILER + Phase P: Parser + Section 5: Parsing Routine - Requires the following: - - the tables produced by YACC - GETTOK - a lexical routine - PTOKEN - a token printing routine - a set of error message routines (one such set is - contained in the file YERROR >) - Returns TRUE if a fatal syntax error occured. + Copyright (c) 1977 by Alan Snyder */ -struct _token { int type, index, line; }; +struct _token { int tag, index, line; }; # define token struct _token token *dmperr(),*lex(),*tok(),*ctok(),*yreset(); @@ -21,128 +17,85 @@ token *dmperr(),*lex(),*tok(),*ctok(),*yreset(); # define tbsize 30 # define FALSE 0 # define TRUE 1 +extern int cout; +int lextag; +int lexindex; +int lexline; +int debug FALSE; +int edebug FALSE; +int xflag FALSE; +int tflag FALSE; +int val; +int line; +int *pv; +int *pl; +int lineno; -extern int cout; - -/* GLOBAL VARIABLES USED TO RECEIVE INFO FROM GETTOK */ - -int lextag; /* indicates which terminal symbol read */ -int lexindex; /* used as translation element */ -int lexline; /* line-number of line which token appears on */ - -/* GLOBAL VARIABLES WHICH MAY BE SET TO INDICATE OPTIONS */ - -int debug FALSE; /* nonzero => print debugging info */ -int edebug FALSE; /* nonzero => print error recovery info */ -int xflag FALSE; /* nonzero => do not call action routines */ -int tflag FALSE; /* nonzero => print tokens as read */ - -/* GLOBAL VARIABLES REFERENCED BY ACTION ROUTINES */ - -int val; /* set to indicate translation element of LHS */ -int line; /* set to indicate line number of LHS */ -int *pv; /* used to reference translations of RHS */ -int *pl; /* used to reference line numbers of RHS */ -int lineno; /* used to reference lineno of current token */ - -/* INTERNAL STATIC VARIABLES */ - -static int *ps; /* parser stack pointer - states */ -static int s[pssize]; /* parser stack - states */ -static int v[pssize]; /* parser stack - translation elements */ -static int l[pssize]; /* parser stack - line numbers */ -static int *sps; /* save stack pointer - states*/ -static int *spv; /* save stack pointer - translation elements */ -static int *spl; /* save stack pointer - line numbers */ -static int ss[pssize]; /* save stack - states */ -static int sv[pssize]; /* save stack - translation elements */ -static int sl[pssize]; /* save stack - line numbers */ -static int must 7; /* number of tokens which must shift - correctly before error recovery is - considered successful */ -static int errcount 0; /* number of tokens left until successful */ -static int tskip; /* number of tokens skipped */ -static int spop; /* number of states popped */ -static int errmode 0; /* error recovery mode */ -static int tabmod FALSE; /* indicates index tables have been optimized */ - -/********************************************************************** - - PARSE - THE PARSER ITSELF - -**********************************************************************/ - +static int *ps; +static int s[pssize]; +static int v[pssize]; +static int l[pssize]; +static int *sps; +static int *spv; +static int *spl; +static int ss[pssize]; +static int sv[pssize]; +static int sl[pssize]; +static int must 7; +static int errcount 0; +static int tskip; +static int spop; +static int errmode 0; +static int tabmod FALSE; parse() - {extern int (*act[])(), g[], pg[], r1[], r2[], a[], pa[], nwpbt; int ac, op, n, state, *ap, *gp, control, i, r, tlimit, slimit, *p, *ip, o, (*fp)(), t, errn; token *ct, *tp; - ps = &s[0]; pv = &v[0]; pl = &l[0]; - state = 1; *ps = 1; *pv = 0; *pl = 0; - ct = lex(); - if (!tabmod) - - { /* precompute index tables into action - and goto arrays */ - + { ip = pa; while ((o = *++ip) != -1) *ip = &a[o]; ip = pg; while ((o = *++ip) != -1) *ip = &g[o]; tabmod = TRUE; } - while (TRUE) {ap = pa[state]; - if (debug) - cprint("executing state %d, token=%d\n",state, ct->type); - + cprint("executing state %d, token=%d\n",state, ct->tag); while (TRUE) - {ac = *ap++; op = ac>>12; n = ac&07777; - switch (op) { - - case 1: /* SKIP ON TEST */ - - if (ct->type!=n) ++ap; + case 1: + if (ct->tag!=n) ++ap; continue; - - case 2: /* SHIFT INPUT SYMBOL */ - + case 2: state = n; - shift: val = ct->index; line = ct->line; ct = lex(); - if (errcount) {--errcount; - if (errcount==0) /* successful recovery */ - {ct = dmperr(); /* list recovery actions */ + if (errcount==0) + {ct = dmperr(ct); control = 0; break; } } - - control=1; /* stack new state */ + control=1; break; - - case 3: /* MAKE A REDUCTION */ - + case 3: if (debug) cprint ("reduce %d\n",n); r = r2[n]; ps =- r; @@ -164,94 +117,52 @@ shift: val = ct->index; gp=+2; } state = *++gp; - control = 1; /* stack new state */ + control = 1; break; - - case 5: /* SHIFT ON MASK */ - - t = ct->type; - if (ap[t>>4] & (1<<(t&017))) /* bit on */ + case 5: + t = ct->tag; + if (ap[t>>4] & (1<<(t&017))) {state = *(a+n+t-1); goto shift; } - - ap =+ nwpbt; /* skip over bit array */ + ap =+ nwpbt; continue; - - case 4: /* ACCEPT INPUT */ - + case 4: if (errmode) - {ct = dmperr(); + {ct = dmperr(ct); control = 0; break; } return (FALSE); - - case 0: /* SYNTAX ERROR */ - -/* The error recovery method used is to try skipping input symbols - and popping states off the stack in all possible combinations, - subject to a limitation on the number of symbols which may be - skipped. If a combination can be found which allows parsing - to continue for at least 7 more symbols, then the recovery is - considered a success. If no such combination can be found, the - parser gives up. - - In running through the possible recovery actions, skipping - input symbols is given priority over popping states, since - popping states tends to confuse the action routines, while - skipping symbols can not have any harmful effects on the - action routines. - - While searching for a successful combination of states and - symbols, the action routines are not called. When a successful - combination is found, the appropriate error messages are - written, the action routines are turned back on, and the parser - is reset at the point where the corrections have just been made. - - */ - + case 0: switch (errmode) { - - case 0: /* NEW ERROR */ - + case 0: if (edebug) cprint("errmode=0:st=%d,nst=%d,tok=%d\n", - state,ps-s,ct->type); - - synerr (ct->line); /* report syntax error */ - + state,ps-s,ct->tag); + synerr (ct->line); p=s; while (p<=ps) qprint (*p++); pcursor (); - - tkeem(); /* enter error mode to save tokens */ + tkeem(); for (i=0;i<5;++i) {tp = tok(i); - if (tp->type==1) break; + if (tp->tag==1) break; tprint (tp); } - - save(); /* save parser stack */ + save(); errcount = must; errmode = 1; - xflag =| 2; /* turn off action routnes */ - - /* set up limits for recovery search */ - + xflag =| 2; tlimit = tbsize - must - 2; slimit = ps-s; - tskip = 0; spop = 0; errn = 1; - - case 1: /* try next recovery attempt */ - + case 1: restore(); yreset(); - if ((++tskip & 1) == 0) --spop; - if (spop<0 || ct->type==1 || tskip>tlimit) + if (spop<0 || ct->tag==1 || tskip>tlimit) {spop = errn++; tskip = 0; } @@ -260,31 +171,28 @@ shift: val = ct->index; control = -spop; break; } - giveup (ct->line); /* give up */ + giveup (ct->line); return (TRUE); } - if (edebug) cprint ("spop=%d,tskip=%d,token=%d\n", - spop,tskip,ct->type); + spop,tskip,ct->tag); break; } - if (control>0) {if (debug) cprint ("stack st=%d val=%d\n",state,val); *++ps = state; *++pv = val; *++pl = line; - if (ps-s>=pssize) /* stack overflow */ + if (ps-s>=pssize) {stkovf (ct->line); return (TRUE); } } - else if (control<0) {pv =+ control; ps =+ control; pl =+ control; - if (psline); return (TRUE); } @@ -294,29 +202,18 @@ shift: val = ct->index; } } } - -/********************************************************************** - - DMPERR - PRINT ERROR RECOVERY ACTION TAKEN - RESET PARSER TO RESTART WITH ACTION ROUTINES - RETURN PTR TO NEW CURRENT TOKEN - -**********************************************************************/ - -token *dmperr() - +token *dmperr(ct) + token *ct; {int i; token *tp; - extern token *ct; - yreset(); restore(); - if (spop>0) delmsg (ct->line); /* print DELETED: */ + if (spop>0) delmsg (ct->line); for (i=1;i<=spop;++i) - qprint (ps[-spop+i]); /* print symbol associated with state */ + qprint (ps[-spop+i]); if (tskip>0) skpmsg (ct->line); for(i=0;i= twp) - - /* If true, it is neccessary to read in another token. - If in normal mode, place the token in the first - element of the buffer. - */ - - {if (tokmode==0) ct=twp=tokbuf; + {if (++tct >= twp) + {if (tokmode==0) tct=twp=tokbuf; else - {if (twp>=tokbuf+tbsize) tkbovf (ct->line); - if (ct>twp) badtwp (ct->line); + {if (twp>=tokbuf+tbsize) tkbovf (tct->line); + if (tct>twp) badtwp (tct->line); } - rtoken (twp++); /* read token into next slot */ + rtoken (twp++); } - if (tflag && !tokmode) - {ptoken (ct, cout); - cputc (' ', cout); + {ptoken (tct, cout); + cputc ('\n', cout); } - lineno = ct->line; - return (ct); /* return ptr to token read */ + lineno = tct->line; + return (tct); } - token *tok(i) - {token *p; - - p = ct + i; - if (p=tokbuf+tbsize) badtok (ct->line, i); + p = tct + i; + if (p=tokbuf+tbsize) + badtok (tct->line, i); while (p>=twp) rtoken (twp++); return (p); } - token *ctok(i) - - {return (ct = tok(i));} - + {return (tct = tok(i));} token *yreset() - - {return (ct = tokbuf);} - + {return (tct = tokbuf);} tkeem() - {int i,j; token *tp1, *tp2; - tokmode = 1; - j = i = twp - ct; /* number of valid tokens in buf */ + j = i = twp - tct; if (i>0) {tp1 = tokbuf-1; - tp2 = ct-1; + tp2 = tct-1; while (i--) - {(++tp1)->type = (++tp2)->type; + {(++tp1)->tag = (++tp2)->tag; tp1->index = tp2->index; tp1->line = tp2->line; } } - ct = tokbuf; - twp = ct + j; + tct = tokbuf; + twp = tct + j; } - tklem() - {tokmode = 0;} - - -/********************************************************************** - - RTOKEN - PARSER READ TOKEN ROUTINE - -**********************************************************************/ - rtoken(p) token *p; - { gettok(); - p->type = lextag; + p->tag = lextag; p->index = lexindex; p->line = lexline; } -/********************************************************************** - - PARSER ERROR MESSAGE ROUTINES - - synerr - announce syntax error - delmsg - print "DELETED:" message - skpmsg - print "SKIPPED:" message - - qprint - print symbol corresponding to parser state - tprint - print token - pcursor - print cursor symbol - - *** fatal errors *** - - giveup - announce failure of recovery attempt - stkovf - parser stack overflow - - *** internal fatal errors *** - - stkunf - parser stack underflow - tkbovf - token buffer overflow - badtwp - inconsistent token pointers - badtok - bad token reference - - ***** - - The routines are contained in the file YERROR.C so that - one may easily substitute other routines for them. - -*/ diff --git a/src/c/c2610.mid b/src/c/c2610.mid new file mode 100644 index 00000000..b16849d9 Binary files /dev/null and b/src/c/c2610.mid differ diff --git a/src/c/c3.h b/src/c/c3.h new file mode 100644 index 00000000..e1e5917a --- /dev/null +++ b/src/c/c3.h @@ -0,0 +1,102 @@ +/* + + C COMPILER + Phase C: Code Generator + Insert File + + Copyright (c) 1977 by Alan Snyder + +*/ + +/* types */ + +struct _dref {int drbase, droffset;}; +struct _loc {int flag, word;}; +struct _oploc {struct _loc xloc [3]; int clobber;}; + +struct _enode { + int op; + type etype; + struct _dref edref; + char lvalue, degree, saved; + struct _enode *ep1, *ep2; + }; + +struct _econst { + int op; + type etype; + struct _dref edref; + char lvalue, degree, saved; + int eval; + }; + +struct _eidn { + int op; + type etype; + struct _dref edref; + char lvalue, degree, saved; + int eclass, eoffset; + }; + +# define dref struct _dref +# define loc struct _loc +# define oploc struct _oploc +# define enode struct _enode +# define econst struct _econst +# define eidn struct _eidn + +/* machine description tables */ + +extern oploc xoploc[]; +extern int tsize[], talign[], calign[], retreg[], tpoint[], + spoint[], trdt[], prdt[], conf[], rtopp[], rtopl[], + mactab[], opreg[], opmem[], (*off_ok[])(), ntype, + nmem, nac, npc, nreg, flt_hack; + +/* code generator variables defined in C31 */ + +extern enode acore[], *acorp; + +extern int lc_node, flc_node, *core, *corep, cbn, nfunc, lineno, + exprlev, ttxlev, cur_op, temploc, autoloc, aquote, + framesize, objmode, f_error, argops, + f_mac, f_node, fidn, ntw[], eof_node, aflag, ciln, + int_size, opdope[], adope[], allreg[], allmem[], + anywhere[]; + +extern char *fn_error, *fn_node, *fn_typtab, *options, + *fn_mac, type_node[], nodelen[], opbop[]; + +extern type ftype; + +/* functions */ + +enode *cgassign(), *cgcall(), *cgcomma(), *cgexpr(), *cgfloat(), + *cgidn(), *cgindirect(), *cgint(), *cglseq(), *cgmove(), + *cgop(), *cgqmark(), *cgstring(), *conv(), *convd(), + *convert(), *convx(), *e_alloc(), *intcon(), *jumpval(), + *mkenode(), *mmove(), *opt(), *taddr(), *telist(), *tfarg(), + *texpr(), *tpadd(), *tpcomp(), *tpsub(), *tptrop(), *ttexpr(), + *txidn(), *txinc(), *txpr2(), *txpr3(); + +int *elist(), *ro2p(); + +oploc *choose(); + +type mkarray(); +type mkptr(); +type to2p(); + +/* special type values */ + +extern type TCHAR; +extern type TINT; +extern type TFLOAT; +extern type TDOUBLE; +extern type TLONG; +extern type TUNSIGNED; +extern type TUNDEF; +extern type TPCHAR; +extern type TACHAR; +extern type TFINT; + \ No newline at end of file diff --git a/src/c/c31.c b/src/c/c31.c new file mode 100644 index 00000000..230a1fd2 --- /dev/null +++ b/src/c/c31.c @@ -0,0 +1,463 @@ +# include "cc.h" +# include "c3.h" + +/* + + C COMPILER + Phase C: Code Generator + Section 1: Control, Storage Allocation, and Statements + + Copyright (c) 1977 by Alan Snyder + +*/ + +type ftype; /* type of current function */ + +enode acore[acoresz], /* core for enode tree and switch table*/ + *acorp {acore}; + +int lc_node 1, /* node file location counter */ + flc_node, /* lc_node at beginning of current function, + used to relocate tree to start of core */ + *core, /* points to array which holds the tree + for each function */ + *corep, /* pointer to next free location in core */ + cbn 0, /* current block number */ + nfunc 0, /* current number of functions */ + lineno 1, /* line number of current statement */ + exprlev 0, /* expression interpretation level */ + ttxlev 0, /* expression code generation level */ + cur_op, /* current node op, for error messages */ + temploc 0, /* temporary location counter */ + autoloc 0, /* automatic variables location counter */ + framesize 0, /* current maximum stack frame size */ + int_size, /* size of integer */ + argops, /* 1 => .arg ops are defined */ + objmode -1, /* object mode (pure, impure, data, pdata) */ + f_error -1, + f_mac -1, + f_node -1, + fidn -1, + ntw[] /* indicates which words of a node + are pointers, according to type_node */ + {000,002,006,016,003,001,007,004}, + eof_node 0, /* indicates end-of-file of node file */ + aflag 0, /* flag indicates tracing */ + aquote 0, /* exprlev at which don't cvt array to ptr */ + ciln 5000; /* current input label number */ + +char *fn_error, + *fn_mac, + *fn_node, + *fn_typtab, + *options, + type_node[] /* used to index ntw according to node-op */ + + {0,0,0,0,0,0,4,4,5,5, + 5,5,5,5,5,5,5,4,4,4, + 4,4,4,4,4,4,4,4,4,4, + 4,4,4,4,4,4,4,4,4,4, + 4,4,4,4,4,4,5,4,4,5, + 0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0, + 3,1,0,1,4,3,5,5,1,7, + 1,4,0,0}, + nodelen[] /* length in words of node given op */ + + { +# include "cnlen.h" + }, + opbop[] { + 0, 0, e_idn, e_int, e_float, + e_string, e_call, e_qmark, 0, 0, + 0, 0, 0, 0, 0, + e_bnot, e_not, e_band, e_bor, e_xor, + e_mod, e_divi, e_muli, e_subi, e_addi, + 0, 0, 0, 0, 0, + 0, 0, e_ls, e_rs, e_rs, + e_ls, e_addi, e_subi, e_muli, e_divi, + e_mod, e_band, e_xor, e_bor, e_and, + e_or, 0, e_colon, e_comma, 0 + }; + +int allreg[2] {l_reg,-1}; /* dummy loc indicating all registers ok */ +int allmem[2] {l_mem,-1}; /* dummy loc indicating all memory ok */ +int anywhere[2] {l_any,0}; /* dummy loc indicating anywhere ok */ +int swloc[2] {l_reg,0}; /* dummy loc for switch arg */ + +/********************************************************************** + + MAIN ROUTINE + +**********************************************************************/ + +# define MAXN 6 + +main (argc,argv) int argc; char *argv[]; + + {int c, i, core_size; + char *cp; + + if (argc < MAXN) + {cprint ("Phase C called with too few arguments.\n"); + cexit (100); + } + + int_size = tsize[TTINT]; + argops = !undfop (e_argi); + + /* initialize swloc */ + + i = rtopp[e_sw]; + if (i >= 0) + {i = rtopl[i]; + if (i >= 0) + {swloc[0]=xoploc[i].xloc[0].flag; + swloc[1]=xoploc[i].xloc[0].word; + } + } + + cp = argv[1]; + while (c = *cp++) switch (c) { + case 'a': aflag=TRUE; break; + } + + options=argv[1]; + fn_error=argv[2]; + fn_node=argv[3]; + fn_typtab=argv[4]; + fn_mac=argv[5]; + + core_size = coresz; + if (argc>MAXN) if ((i=atoi(argv[MAXN]))>1000) core_size=i; + + core = getvec (core_size); + reg_init (); + + rtyptab (); + typcinit (); + + f_mac = xopen (fn_mac, MAPPEND, TEXT); + pure; + s_alloc (); + + f_node = xopen (fn_node, MREAD, BINARY); + while (!eof_node) + {flc_node = lc_node; + corep = core; + cbn++; + + while (read_node() != n_prog) + {if (eof_node) break; + if (corep >= core + (core_size - 6)) + errx (4013); + } + + if (!eof_node) + {fhead (corep[-5], corep[-4], corep[-1]); + framesize = autoloc = corep[-2]; + stmt (corep[-3]); + framesize = align (framesize, nac-1); + mepilog (); + ftail (); + } + } + endcard (); + cclose (f_mac); + cleanup (0); + } + +/********************************************************************** + + CLEANUP - Code Generator Cleanup Routine + +**********************************************************************/ + +cleanup (rcode) + + {extern int maxerr; + cexit (rcode?rcode:maxerr>=2000); + } + +/********************************************************************** + + ERRX - Report error (lineno accessed via external variable) + +**********************************************************************/ + +errx (errno, a1, a2, a3, a4) + {error (errno, lineno, a1, a2, a3, a4);} + +/********************************************************************** + + CODE GENERATOR: STORAGE ALLOCATION ROUTINES + + fhead + ftail + gettemp + ttemp + s_alloc + sdef + +*/ + +/********************************************************************** + + FHEAD - function head + + Define function name (FIDN) and type (FTYPE) and emit prolog. + +**********************************************************************/ + +fhead (name, o, narg) int name, o, narg; + + {++nfunc; + ftype = to2p (o); + fidn = name; + pure; + mprolog (nfunc, fidn, narg); + } + +/********************************************************************** + + FTAIL - Termination Processing for Function. + +**********************************************************************/ + +ftail() + + {;} + +/********************************************************************** + + GETTEMP - Allocate a temporary location on the stack + for an expression. Return its offset from the + beginning of the stack frame. + +**********************************************************************/ + +int gettemp (ep) enode *ep; + + {return (ttemp (ep->etype, 1));} + +/********************************************************************** + + TTEMP - allocate a temporary for N objects of type T + +**********************************************************************/ + +int ttemp (t, n) + type t; + + {int lc; + + lc = temploc = align (temploc, t->align); + temploc =+ n*t->size; + if (temploc > framesize) framesize = temploc; + return (lc); + } + +/********************************************************************** + + S_ALLOC - Allocate storage for string constants + +**********************************************************************/ + +s_alloc () + + {pdata; + string (); + } + +/********************************************************************** + + CODE GENERATOR: HIGHER LEVEL CODE GENERATION ROUTINES + + stmt + astmt + cgswitch + expr + +*/ + +/********************************************************************** + + STMT - PROCESS A STATEMENT + + This routine looks for statement lists and calls ASTMT when it + finds a "real" statement. This method saves stack space while + descending the syntax tree. + +**********************************************************************/ + +stmt (p) int *p; + + {if (p[0]==n_stmtl) {stmt(p[1]); stmt(p[2]);} + else astmt(p); + } + +/********************************************************************** + + ASTMT - Process statement + +**********************************************************************/ + +astmt (p) int *p; + + {int el, fl, op, l1, *p1; + enode *ep; + econst *ecp; + + while (TRUE) + + {if (!p) return; + cur_op = op = p[0]; + switch (op) { + +case n_switch: ln (p); + l1 = ciln++; + cgswitch (p[2], p[4], l1); + stmt (p[3]); + ilabel (l1); + return; + +case n_if: ln (p); + if (!(ep = opt (texpr (p[2])))) return; + if (ep->op == e_int) + if ((ecp=ep)->eval) stmt (p[3]); + else stmt (p[4]); + else + {p1 = p[3]; /* then stmt */ + if (p1[0]==n_branch) + {jumpn (ep, p1[1]); + if (p[4]) stmt (p[4]); + } + else + {jumpz (ep, fl=el=ciln++); + stmt (p[3]); + if (p[4]) + {jump (fl=ciln++); + ilabel (el); + stmt (p[4]); + } + ilabel (fl); + } + } + return; + +case n_goto: ln (p); + if (!(ep = texpr (p[2]))) return; + if (ep->etype==TINT) jumpe (ep); + else errx (2009); + return; + +case n_branch: jump (p[1]); + return; + +case n_label: ilabel (p[1]); + p = p[2]; + continue; + +case n_stmtl: stmt (p[1]); + stmt (p[2]); + return; + +case n_return: ln (p); + if (p[2]) ep = convert (texpr(p[2]), ftype->val); + else ep = NULL; + creturn (ep); + return; + +case n_exprs: ln (p); + expr (texpr (p[2]), anywhere); + return; + } + } + } + +/********************************************************************** + + CGSWITCH - Generate SWITCH operation for expression + NP, case list LP, and label L1 following body + of SWITCH statement. + +**********************************************************************/ + +cgswitch (np, lp, l1) int *np, *lp, l1; + + {enode *ep; + int l, n, lo, hi, range, *p, *swtab, *et, *q, i, *csp, b, o; + + ep = texpr (np); + cur_op = n_switch; + ep = expr (conv (ep, 03), swloc); + if (!ep) return; + b = ep->edref.drbase; + o = ep->edref.droffset; + l = -1; /* default internal label */ + n = 0; + csp = swtab = acore; + et = acore + acoresz; + p = lp; + while (p) + {switch (p[0]) { + + case n_case: i = p[2]; + for (q=swtab;q=et) errx (4010); + *csp++ = i; + *csp++ = p[3]; + if (n++ == 0) {lo = i; hi = i;} + else if (i < lo) lo = i; + else if (i > hi) hi = i; + } + break; + + case n_def: if (l>=0) errx (2021); + else l = p[2]; + break; + + default: errx (6003, p[0]); + } + + p = p[1]; + } + + if (l<0) l = l1; + if (n==0) {jump (l); return;} + range = hi - lo + 1; + + if (range <= 3*n && swtab+range < et) + {csp = swtab+range; + for (q=swtab;q=swtab;q =- 2) mint (q[0]); + for (q=csp-2;q>=swtab;q =- 2) mlabcon (q[1]); + melswitch (b, o, n, l); + } + } + +/********************************************************************** + + EXPR - Optimize and Generate Code For Expression + +**********************************************************************/ + +expr (ep, xp) enode *ep; + + {return (ttexpr (opt (ep), xp));} + \ No newline at end of file diff --git a/src/c/c32.c b/src/c/c32.c new file mode 100644 index 00000000..84a72f2d --- /dev/null +++ b/src/c/c32.c @@ -0,0 +1,1001 @@ +# include "cc.h" +# include "c3.h" + +/* + + C COMPILER + Phase C: Code Generator + Section 2: Semantic Interpretation and Optimization + + Copyright (c) 1977 by Alan Snyder + +*/ + +/********************************************************************** + + CODE GENERATOR: SEMANTIC INTERPRETATION ROUTINES + + chktype + fudge + esize + pointer + ectype + pctype + conv + conv4 + convert + convx + convd + texpr + txpr2 + txpr3 + tptrop + tpsub + tpadd + tpcomp + txinc + taddr + telist + tfarg + +*/ + +/********************************************************************** + + CHKTYPE - Check type of enode. If the enode is not of a valid + type, then issue an error message and return TRUE. + + M - integer indicating the valid types: + If M is negative, the enode must be an lvalue. + If M is zero, the enode is checked only to see if it + is an lvalue. The valid types are indicated by the + low-order bits of the absolute value of M: + + bit 0 - integer + bit 1 - character + bit 2 - float + bit 3 - double + bit 4 - pointer + +**********************************************************************/ + +int chktype (ep, m) enode *ep; int m; + + {type t; + + if (!ep) return (FALSE); + t = ep->etype; + if (m <= 0) + {m = -m; + if (!ep->lvalue) + {errx (2023, cur_op); + return (TRUE); + } + if (m==0) return (FALSE); + } + + if (t == TUNDEF) return (TRUE); + if ((t==TINT) && (m&001) || + (t==TCHAR) && (m&002) || + (t==TFLOAT) && (m&004) || + (t==TDOUBLE) && (m&010) || + (m&020) && (pointer(ep))) return (FALSE); + + errx (2022, cur_op); + return (TRUE); + } + +/********************************************************************** + + FUDGE - determine constant used in pointer arithmetic + +**********************************************************************/ + +int fudge (ep) enode *ep; + + {type t; + + t = ep->etype; + if (t->tag != TTPTR) errx (6026); + return (t->val->size); + } + +/********************************************************************** + + ESIZE - return the size of an expression + +**********************************************************************/ + +int esize (ep) enode *ep; + + {return (ep->etype->size);} + +/********************************************************************** + + POINTER - is the given expression subtree a pointer + +**********************************************************************/ + +int pointer (p1) enode *p1; + + {return (p1 && p1->etype->tag == TTPTR);} + +/********************************************************************** + + ECTYPE - return CTYPE of an expression + +**********************************************************************/ + +int ectype (ep) enode *ep; + + {return (ctype (ep->etype));} + +/********************************************************************** + + PCTYPE - return POINTER TYPE of expression + +**********************************************************************/ + +int pctype (ep) enode *ep; + + {return (ectype (ep) - ct_p0);} + +/********************************************************************** + + CONV - check for certain types + + convert CHAR -> INT + convert FLOAT -> DOUBLE + convert POINTER -> INT + + return pointer to enode + +**********************************************************************/ + +enode *conv (p1, m) enode *p1; int m; + + {type t; + + if (!p1) return (NULL); + if (chktype (p1, m)) return (NULL); + t = p1->etype; + if (t==TCHAR || pointer (p1)) p1=convert (p1, TINT); + else if (t==TFLOAT) p1=convert (p1, TDOUBLE); + return (p1); + } + +/********************************************************************** + + CONV4 - Convert Two Expressions As Appropriate For Arithmetic + Operators: Check for CHAR, INT, FLOAT, or DOUBLE. + Convert to INT or DOUBLE as appropriate (expressions + passed by reference). Return 0 if result is INT, + 1 if result is DOUBLE, -1 if error. + +**********************************************************************/ + +int conv4 (epp1, epp2) enode **epp1,**epp2; + + {type t1; + type t2; + + if (chktype (*epp1, 017) | chktype (*epp2, 017)) + return (-1); /* note: NOT || */ + t1 = (*epp1)->etype; + t2 = (*epp2)->etype; + if (t1==TFLOAT || t1==TDOUBLE || t2==TFLOAT || t2==TDOUBLE) + {*epp1 = convert (*epp1, TDOUBLE); + *epp2 = convert (*epp2, TDOUBLE); + return (1); + } + else + {*epp1 = convert (*epp1, TINT); + *epp2 = convert (*epp2, TINT); + return (0); + } + } + +/********************************************************************** + + CONVERT - convert expression (EP) to given type (T) + +**********************************************************************/ + +enode *convert (ep, t) enode *ep; type t; + {return (convd (ep, ctype (t), t));} + +/********************************************************************** + + CONVX - Convert expression to a given CTYPE. + (Type field will be set to TUNDEF.) + +**********************************************************************/ + +enode *convx (ep, ct) enode *ep; + {return (convd (ep, ct, TUNDEF));} + +/********************************************************************** + + CONVD - Real Conversion Routine + +**********************************************************************/ + +# define _BAD 0177 /* illegal conversion */ +# define _SAME 0176 /* identity conversion */ +# define _STR 0175 /* structure : structure */ + +char cvt[10][10] { + _BAD,_BAD,_BAD,_BAD,_BAD,_BAD,_BAD,_BAD,_BAD,_BAD, + _BAD,_STR,_BAD,_BAD,_BAD,_BAD,_BAD,_BAD,_BAD,_BAD, + _BAD,_BAD,_SAME,0040,0041,0042,_BAD,_BAD,_BAD,_BAD, + _BAD,_BAD,0043,_SAME,0044,0045,0046,0047,0050,0051, + _BAD,_BAD,0052,0053,_SAME,0054,_BAD,_BAD,_BAD,_BAD, + _BAD,_BAD,0055,0056,0057,_SAME,_BAD,_BAD,_BAD,_BAD, + _BAD,_BAD,_BAD,0060,_BAD,_BAD,_SAME,0061,0062,0063, + _BAD,_BAD,_BAD,0064,_BAD,_BAD,0065,_SAME,0066,0067, + _BAD,_BAD,_BAD,0070,_BAD,_BAD,0071,0072,_SAME,0073, + _BAD,_BAD,_BAD,0074,_BAD,_BAD,0075,0076,0077,_SAME}; + +enode *convd (ep, ct, t) enode *ep; type t; + + {int op; + switch (op = cvt[ectype (ep)][ct]) { + case _BAD: errx (2026, cur_op); + return (NULL); + case _SAME: + case _STR: return (ep); + } + return (mkenode (op, t, 0, ep, NULL)); + } + +/********************************************************************** + + TEXPR - Translate expression from syntax tree form + to expanded form with AMOPs. + +**********************************************************************/ + + /* definition of OPDOPE fields */ + +# define NSUBTREE 0003 /* number of subtrees */ +# define UNARY 1 +# define BINARY 2 +# define LVFLAG 0004 /* indicates to check for left lvalue */ +# define CVMODE 0030 /* indicates some default conversions */ +# define BITSTRING 010 /* check for int or char */ +# define INTEGER 010 /* check for int or char */ +# define ARITH 020 /* do arithmetic conversions */ +# define LOGICAL 030 /* check for fundamental or ptr */ +# define PTFLAG 0040 /* indicates special action on pointer */ +# define OPFLAG 0100 /* indicates to set OP */ +# define EQOP 0200 /* indicates op is an =OP */ +# define SWFLAG 0400 /* indicates to execute main switch */ + +int opdope [] { /* info on some node ops */ + + 0, + 0, + /* idn */ SWFLAG + OPFLAG, + /* int */ SWFLAG + OPFLAG, + /* float */ SWFLAG + OPFLAG, + /* string */ SWFLAG + OPFLAG, + /* call */ SWFLAG + OPFLAG, + /* ? */ SWFLAG + OPFLAG + BINARY, + /* ++x */ SWFLAG + UNARY, + /* x++ */ SWFLAG + UNARY, + /* --x */ SWFLAG + UNARY, + /* x-- */ SWFLAG + UNARY, + /* *p */ SWFLAG + UNARY, + /* &x */ SWFLAG + LVFLAG + UNARY, + /* -x */ SWFLAG + UNARY, + /* ~x */ SWFLAG + OPFLAG + UNARY, + /* !x */ OPFLAG + LOGICAL + UNARY, + /* x & y */ OPFLAG + BITSTRING + BINARY, + /* x | y */ OPFLAG + BITSTRING + BINARY, + /* x ^ y */ OPFLAG + BITSTRING + BINARY, + /* x % y */ OPFLAG + INTEGER + BINARY, + /* x / y */ OPFLAG + ARITH + BINARY, + /* x * y */ OPFLAG + ARITH + BINARY, + /* x - y */ OPFLAG + PTFLAG + ARITH + BINARY, + /* x + y */ OPFLAG + PTFLAG + ARITH + BINARY, + /* x = y */ SWFLAG + LVFLAG + BINARY, + /* x == y */ SWFLAG + PTFLAG + ARITH + BINARY, + /* x != y */ SWFLAG + PTFLAG + ARITH + BINARY, + /* x < y */ SWFLAG + PTFLAG + ARITH + BINARY, + /* x > y */ SWFLAG + PTFLAG + ARITH + BINARY, + /* x <= y */ SWFLAG + PTFLAG + ARITH + BINARY, + /* x >= y */ SWFLAG + PTFLAG + ARITH + BINARY, + /* x << y */ OPFLAG + BITSTRING + BINARY, + /* x >> y */ OPFLAG + BITSTRING + BINARY, + /* x =>> y */ EQOP + OPFLAG + LVFLAG + BITSTRING + BINARY, + /* x =<< y */ EQOP + OPFLAG + LVFLAG + BITSTRING + BINARY, + /* x =+ y */ EQOP + OPFLAG + PTFLAG + LVFLAG + ARITH + BINARY, + /* x =- y */ EQOP + OPFLAG + PTFLAG + LVFLAG + ARITH + BINARY, + /* x =* y */ EQOP + OPFLAG + LVFLAG + ARITH + BINARY, + /* x =/ y */ EQOP + OPFLAG + LVFLAG + ARITH + BINARY, + /* x =% y */ EQOP + OPFLAG + LVFLAG + INTEGER + BINARY, + /* x =& y */ EQOP + OPFLAG + LVFLAG + BITSTRING + BINARY, + /* x =^ y */ EQOP + OPFLAG + LVFLAG + BITSTRING + BINARY, + /* x =| y */ EQOP + OPFLAG + LVFLAG + BITSTRING + BINARY, + /* x && y */ OPFLAG + LOGICAL + BINARY, + /* x || y */ OPFLAG + LOGICAL + BINARY, + /* x . y */ SWFLAG + UNARY, + /* x : y */ SWFLAG + OPFLAG + BINARY, + /* x , y */ SWFLAG + OPFLAG + BINARY, + /* sizeof x */ SWFLAG + }; + +enode *texpr (np) int *np; + + {enode *p1, *p2; + int errflag; + + if (!exprlev) e_free(); + ++exprlev; + + p1 = p2 = NULL; + errflag = FALSE; + switch (opdope[np[0]] & NSUBTREE) { + case BINARY: if (!(p2 = texpr (np[2]))) errflag = TRUE; + case UNARY: if (!(p1 = texpr (np[1]))) errflag = TRUE; + } + if (!errflag) p1 = txpr2 (np, p1, p2); + else p1 = NULL; + --exprlev; + return (p1); + } + +enode *txpr2 (np, p1, p2) int *np; enode *p1, *p2; + + {enode *ep; + type t; + +# ifndef SCRIMP + + if (aflag) cprint ("%2d TXPR2 %o[%d,%o,%o]\n", + exprlev, np, np[0], p1, p2); + +# endif + + ep = txpr3 (np, p1, p2); + if (ep && exprlev != aquote && (t=ep->etype)->tag==TTARRAY) + {ep->etype = t = t->val; + ep = taddr (ep); + ep->etype = mkptr (t); + } + +# ifndef SCRIMP + + if (aflag) + {if (ep) cprint ("%2d TXPR2 RETURNS %o [%o,%o,%o]\n", + exprlev, ep, ep->op, ep->ep1, ep->ep2); + else cprint ("%2d TXPR2 RETURNS 0\n", exprlev); + } + +# endif + + return (ep); + } + +enode *txpr3 (np, p1, p2) int *np; enode *p1, *p2; + + {field *fp; + type t; + int i, j, lvalue, op, eval, dope, cop, *ip; + + dope = opdope[cop=np[0]]; + eval = lvalue = 0; + t = TINT; + cur_op = cop; + + if (dope & LVFLAG) + {if (chktype (p1, 0)) return (NULL); + op = 1; + } + else op = 0; + + if ((dope & PTFLAG) && (pointer(p1) || pointer(p2))) + return (tptrop (cop, p1, p2)); + + switch (dope & CVMODE) { + case BITSTRING: p1 = conv (p1, 003); + p2 = conv (p2, 003); + if (!p1 || !p2) return (NULL); + break; + case ARITH: switch (conv4 (&p1, &p2)) { + case 1: t = TDOUBLE; op =+ 2; break; + case -1: return (NULL); + } + break; + case LOGICAL: if (chktype (p1, 037) | chktype (p2, 037)) + return (NULL); /* note: NOT || */ + } + if (dope & OPFLAG) op =+ opbop[cop]; + if (dope & EQOP) + {if (!p1->lvalue || undfop (op)) + +/* lvalue==0 indicates an =op to a character or a float - + p1 is a conversion operator + + convert to an assignment a = a op b with the + subtree "a" pointed to by both operators + +*/ + + {p2 = mkenode (op-1, t, lvalue, p1, p2); + if (!p1->lvalue) p1 = p1->ep1; /* the lvalue */ + p1->lvalue = 2; /* special marker indicating this node + is a direct descendant of two nodes */ + goto case_assign; /* make assignment */ + } + } + + if (dope & SWFLAG) switch (cop) { + +case n_incb: +case n_inca: +case n_decb: +case n_deca: return (txinc (cop, p1, 1)); + +case n_star: +case_star: if (chktype (p1, 020)) return (NULL); + if (p1->op >= e_a0 && p1->op <= e_a3) return (p1->ep1); + t = p1->etype->val; + op = e_ind; + lvalue = 1; + break; + +case n_addr: return (taddr (p1)); + +case n_uminus: if (!(p1 = conv (p1, 017))) return (NULL); + if ((t=p1->etype) == TINT) op = e_iminus; + else op = e_dminus; + break; + +case n_bnot: if (!(p1 = conv (p1, 003))) return (NULL); + op = e_bnot; + break; + +case n_assign: +case_assign: if (!(p2 = convert (p2, t = p1->etype))) return (NULL); + op = e_assign; + break; + +case n_idn: return (txidn (np+1)); + +case n_int: t = TINT; + eval = np[1]; + p1 = eval; + break; + +case n_float: t = TDOUBLE; + eval = np[1]; + p1 = eval; + break; + +case n_string: t = TACHAR; + eval = np[1]; + p1 = eval; + break; + +case n_eq: +case n_ne: +case n_lt: +case n_gt: +case n_le: +case n_ge: op = (t==TDOUBLE ? e_eqd : e_eqi) + cop - n_eq; + t = TINT; + break; + +case n_call: ip = np[1]; /* the function being called */ + if (!(p1 = texpr (ip))) return (NULL); + if (ip[0] == n_idn && p1->op != e_idn) /* undo coercion */ + {p1 = p1->ep1; + if (!p1) return (NULL); + } + if (p1->etype->tag != TTFUNC) + {errx (2028); + return (NULL); + } + p2 = telist (np[2]); /* the arguments */ + t = p1->etype->val; /* the return type */ + break; + +case n_dot: /* + * Structure Reference + * + * Get structure type and search for the named + * field. + * + */ + + if (p1->etype->tag != TTSTRUCT) + {errx (2030); + return (NULL); + } + j = np[2]; /* field name */ + fp = p1->etype->val; + while (fp->name != UNDEF) + if (fp->name == j) break; + else ++fp; + if (fp->name != j) /* field not found */ + {errx (2029, TIDN, j); + return (NULL); + } + t = fp->dtype; + i = fp->offset; + p1 = taddr (p1); + t = mkptr (t); + j = ctype (t); + p1 = convx (p1, j); + p1->etype = t; + j =- ct_p0; + p1 = mkenode (e_add0+j, t, 0, p1, intcon(i/spoint[j])); + goto case_star; + +case n_qmark: if (chktype (p1, 037)) return (NULL); + +case n_comma: t = p2->etype; /* fall through */ + break; + +case n_colon: if (p1->etype != p2->etype) + {if (p1->etype->tag <= TTDOUBLE && + p2->etype->tag <= TTDOUBLE) + {switch (conv4 (&p1, &p2)) { + case 1: t = TDOUBLE; break; + case -1: return (NULL); + default: t = TINT; + } + } + else + {errx (2031); + return (NULL); + } + } + else t = p1->etype; + break; + +case n_sizeof: i = aquote; + aquote = exprlev + 1; + p1 = texpr (np[1]); + aquote = i; + if (!p1) return (NULL); + return (intcon (esize (p1))); + +default: errx (2035, cop); + return (NULL); + } + + return (mkenode (op, t, lvalue, p1, p2)); + } + +/********************************************************************** + + TPTROP - Translate pointer operation + +**********************************************************************/ + +enode *tptrop (cop, p1, p2) + enode *p1, *p2; + + {switch (cop) { + case n_minus: return (tpsub (p1, p2)); + case n_aminus: return (tpadd (e_sub0, TRUE, p1, p2)); + case n_plus: if (pointer(p2)) + return (tpadd (e_add0, FALSE, p2, p1)); + return (tpadd (e_add0, FALSE, p1, p2)); + case n_aplus: return (tpadd (e_add0, TRUE, p1, p2)); + case n_eq: + case n_ne: + case n_lt: + case n_gt: + case n_le: + case n_ge: return (tpcomp (p1, p2, cop-n_eq)); + } + } + +/********************************************************************** + + TPSUB - Translate pointer subtraction + +**********************************************************************/ + +enode *tpsub (p1, p2) + enode *p1, *p2; + + {int i; + + if (pointer (p1) && pointer (p2)) + {if (p1->etype != p2->etype) errx (2025); + i = fudge (p1); + p1 = convert (p1, TPCHAR); + p2 = convert (p2, TPCHAR); + p1 = mkenode (e_p0sub, TINT, 0, p1, p2); + p2 = intcon (i); + return (mkenode (e_divi, TINT, 0, p1, p2)); + } + if (pointer(p2)) + {errx (2034); + return (NULL); + } + return (tpadd (e_sub0, FALSE, p1, p2)); + } + +/********************************************************************** + + TPADD - Translate pointer addition/subtraction with integer + +**********************************************************************/ + +enode *tpadd (op, assign, p1, p2) + enode *p1, *p2; + + {type t; + int j; + enode *ep; + + t = p1->etype; + j = pctype (p1); + if (!(p2 = conv (p2, 003))) return (NULL); + ep = mkenode (e_muli, TINT, 0, p2, intcon (fudge(p1)/spoint[j])); + ep = mkenode (op+j, t, 0, p1, ep); + if (assign) + {p1 = ep->ep1; + p1->lvalue = 2; + ep = mkenode (e_assign, t, 0, p1, ep); + } + return (ep); + } + +/********************************************************************** + + TPCOMP - Construct Pointer Comparison + +**********************************************************************/ + +enode *tpcomp (p1, p2, cc) enode *p1, *p2; + + {int op, j; + enode *ep; + econst *ecp; + + if (pointer (p1) && pointer (p2)) + {j = min (pctype (p1), pctype (p2)); + op = e_eqp0 + cc + 6*j; + while (undfop(op) && j>0) {--j; op =- 6;} + j =+ ct_p0; + p1 = convx (p1, j); + p2 = convx (p2, j); + return (mkenode (op, TINT, 0, p1, p2)); + } + + if (pointer (p2)) {ep=p1;p1=p2;p2=ep;} + + p2 = opt(p2); + if (ccop==e_int && (ecp=p2)->eval==0) + {op = e_jz0 + 4*cc + pctype (p1); + if (!undfop (op)) return (mkenode (op, TINT, 0, p1, NULL)); + return (mkenode (e_eqi+cc, TINT, 0, + convx (p1, ct_int), intcon (0))); + } + + errx (2032); + return (intcon (0)); + } + +/********************************************************************** + + TXIDN - Translate IDN node + +**********************************************************************/ + +enode *txidn (p) + struct {int itype, iclass, ioffset;} *p; + + {type t; + enode *ep; + + t = to2p (p->itype); + ep = mkenode (e_idn, t, 1, p->iclass, p->ioffset); + if (t->tag==TTFUNC || p->iclass==c_label) + ep = mkenode (e_a0+tpoint[TTINT], mkptr (t), 0, ep, NULL); + else if (flt_hack && t==TDOUBLE && p->iclass==c_param) + {ep->etype = mkptr (t); + ep->lvalue = 0; + ep = mkenode (e_ind, t, 1, ep, NULL); + } + return (ep); + } + +/********************************************************************** + + TXINC - Translate increment/decrement + +**********************************************************************/ + +enode *txinc (cop, p1, n) + enode *p1; + + {int op, bop, j; + type t; + enode *p2; + + p2 = NULL; + bop = op = cop - n_incb; + if (chktype (p1, -037)) return (NULL); + t = p1->etype; + switch (t->tag) { + case TTCHAR: op =+ e_incbc; break; + case TTINT: op =+ e_incbi; break; + case TTFLOAT: op =+ e_incbf; break; + case TTDOUBLE: op =+ e_incbd; break; + default: j = pctype (p1); + op =+ e_incb0 + (j<<2); + p2 = intcon (fudge(p1)/spoint[j]); + } + if (undfop (op)) + {switch (bop) { + case 0: /* prefix */ + case 2: op = (bop==0 ? n_aplus : n_aminus); + return (txpr3 (&op, p1, intcon (1))); + case 1: /* postfix */ + case 3: op = (bop==1 ? n_aplus : n_aminus); + p2 = txpr2 (&op, p1, intcon (1)); + ++p1->lvalue; + op = e_lseq; + break; + } + } + return (mkenode (op, t, 0, p1, p2)); + } + +/********************************************************************** + + TADDR - Construct Address of Expression + +**********************************************************************/ + +enode *taddr (ep) enode *ep; + + {int op; + type t; + + if (!ep) return (NULL); + op = ep->op; + + if (op==e_ind) ep = ep->ep1; + else + {if (ep->lvalue==0) ep->lvalue=1; + t = mkptr (ep->etype); + op = e_a0 + ctype (t) - ct_p0; + ep = mkenode (op, t, 0, ep, NULL); + } + return (ep); + } + +/********************************************************************** + + TELIST - translate an expression_list subtree + + Translate the expressions in an expression list. Use the + ELIST node structure to hold the translated expressions. + Mark such nodes with -1 to distinguish from ENODEs. + +**********************************************************************/ + +enode *telist (np) + int *np; + + {enode *ep; + int count, *onp; + + if (!np) return (NULL); + if (np[0] != n_elist) return (tfarg (np)); + ep = np; + count = 1; + do + {np[0] = -1; /* mark */ + np[2] = tfarg (np[2]); + onp = np; + np = np[1]; + ++count; + } while (np && np[0] == n_elist); + onp[1] = tfarg (np); + + if (count > maxfarg) {errx (2039); return (NULL);} + return (ep); + } + +/********************************************************************** + + TFARG - translate a function argument + +**********************************************************************/ + +enode *tfarg (np) + int *np; + + {enode *ep; + int op; + + if (!(ep = texpr (np))) return (NULL); + cur_op = n_call; /* for error messages */ + if (ep->etype == TCHAR) ep = convert (ep, TINT); + else if (ep->etype == TFLOAT) ep = convert (ep, TDOUBLE); + if (chktype (ep, 031)) return (NULL); + if (!argops) return (ep); + switch (ep->etype->tag) { + case TTINT: op = e_argi; break; + case TTDOUBLE: if (flt_hack) return (ep); + op = e_argd; break; + case TTPTR: op = e_arg0 + pctype (ep); break; + } + return (mkenode (op, ep->etype, 0, ep, NULL)); + } + +/********************************************************************** + + CODE GENERATOR: OPTIMIZATION ROUTINES + + opt + +*/ + +/********************************************************************** + + OPT - Optimize Expression + + Evaluate Integer Constant Expressions + Commute Where Desirable + Simplify Operations by 0 or 1 + Rearrange Multiple Additions to a Pointer + +**********************************************************************/ + +# define COMMUTATIVE 1 +# define ZEROIDENTITY 2 +# define ZEROFLUSH 4 +# define ONEIDENTITY 010 + +int adope [] { /* info on some AMOPs */ + + /* +i */ COMMUTATIVE + ZEROIDENTITY, + /* =+i */ ZEROIDENTITY, + /* +d */ COMMUTATIVE, + /* =+d */ 0, + /* -i */ ZEROIDENTITY, + /* =-i */ ZEROIDENTITY, + /* -d */ 0, + /* =-d */ 0, + /* *i */ COMMUTATIVE + ZEROFLUSH + ONEIDENTITY, + /* =*i */ ZEROFLUSH + ONEIDENTITY, + /* *d */ COMMUTATIVE, + /* =*d */ 0, + /* /i */ ONEIDENTITY, + /* =/i */ ONEIDENTITY, + /* /d */ 0, + /* =/d */ 0, + /* % */ 0, + /* =% */ 0, + /* << */ ZEROIDENTITY, + /* =<< */ ZEROIDENTITY, + /* >> */ ZEROIDENTITY, + /* =>> */ ZEROIDENTITY, + /* & */ COMMUTATIVE + ZEROFLUSH, + /* =& */ 0, + /* ^ */ COMMUTATIVE + ZEROIDENTITY, + /* =^ */ ZEROIDENTITY, + /* | */ COMMUTATIVE + ZEROIDENTITY, + /* =| */ ZEROIDENTITY, + /* && */ 0, + /* || */ 0, + /* -p0p0 */ 0, + /* = */ 0, + /* .argi */ 0, + /* .argd */ 0, + /* .arg0 */ 0, + /* .arg1 */ 0, + /* .arg2 */ 0, + /* .arg3 */ 0, + /* +p0 */ ZEROIDENTITY, + /* +p1 */ ZEROIDENTITY, + /* +p2 */ ZEROIDENTITY, + /* +p3 */ ZEROIDENTITY, + /* -p0 */ ZEROIDENTITY, + /* -p1 */ ZEROIDENTITY, + /* -p2 */ ZEROIDENTITY, + /* -p3 */ ZEROIDENTITY + }; + +enode *opt (ep) enode *ep; + + {int op, dope, c1, c2, v1, v2, v; + enode *p1, *p2, *p; + econst *ecp; + + if (!ep) return (ep); + switch (op = ep->op) { + case e_call: + case e_idn: + case e_int: + case e_float: + case e_string: return (ep); + } + if (!(p1 = ep->ep1)) return (ep); + p1 = ep->ep1 = opt (p1); + p2 = ep->ep2 = opt (ep->ep2); + if (c1 = (p1->op == e_int)) v1 = (ecp=p1)->eval; + if (c2 = (p2 && p2->op == e_int)) v2 = (ecp=p2)->eval; + +# define y goto yes; + + /* evaluate unary operations on integer constants */ + + if (op<=e_not && c1) switch (op) { + case e_iminus: v = -v1; y + case e_bnot: v = ~v1; y + case e_not: v = !v1; y + } + + else if (op>=e_addi && op<=e_sub3 && p2) + {dope = adope[op-e_addi]; + + /* evaluate binary operations on integer constants */ + + if (c1 && c2) switch (op) { + case e_addi: v = v1+v2; y + case e_subi: v = v1-v2; y + case e_muli: v = v1*v2; y + case e_divi: v = v1/v2; y + case e_mod: v = v1%v2; y + case e_ls: v = v1<>v2; y + case e_band: v = v1&v2; y + case e_xor: v = v1^v2; y + case e_bor: v = v1|v2; y + case e_and: v = v1&&v2; y + case e_or: v = v1||v2; y + } + + /* commute where suitable */ + + else + {if ((dope & COMMUTATIVE) + && (c1 || p2->degree > p1->degree)) + {p = p1; ep->ep1 = p1 = p2; ep->ep2 = p2 = p; + v = c1; c1 = c2; c2 = v; + v = v1; v1 = v2; v2 = v; + } + + /* hack operations by 0 */ + + if (c2) + if (v2==0) + {if (dope & ZEROIDENTITY) + return (p1); + if (dope & ZEROFLUSH) + return (p2); + } + + /* hack operations by 1 */ + + else if (v2==1) + if (dope & ONEIDENTITY) + return (p1); + + /* rearrange pointer additions */ + + if (op>=e_add0 && op<=e_sub3 && p1->op==op) + {p = p1->ep1; + p1->op = e_addi; + p1->etype = TINT; + p1->ep1 = p2; + ep->ep2 = opt (p1); + ep->ep1 = p; + } + } + } + return (ep); +yes: return (intcon (v)); + } + \ No newline at end of file diff --git a/src/c/c33.c b/src/c/c33.c new file mode 100644 index 00000000..c817683b --- /dev/null +++ b/src/c/c33.c @@ -0,0 +1,1335 @@ +# include "cc.h" +# include "c3.h" + +/* + + C COMPILER + Phase C: Code Generator + Section 3: Expression Code Generation + + Copyright (c) 1977 by Alan Snyder + +*/ + +/********************************************************************** + + CODE GENERATOR: LOWER-LEVEL CODE GENERATION ROUTINES + + ttexpr + cgexpr + jumpval + cgidn + cgint + cgfloat + cgstring + cgindirect + cgassign + cgcall + cgqmark + cglseq + cgop + cgmove + cg_elist + cg_farg + choose + score + scorop + eresult + jumpz + jumpn + creturn + jumpe + expr2 + +*/ + +/********************************************************************** + + TTEXPR - Generate code to evaluate expression EP into an + acceptable location as specified by LP. + +**********************************************************************/ + +enode *ttexpr (ep, lp) enode *ep; loc *lp; + + {loc l; + + if (!ep) return (NULL); + if (ttxlev++ == 0) {rflush (); temploc = autoloc;} + +# ifndef SCRIMP + + if (aflag) + {if (ttxlev==1) prtree (ep); + cprint ("%2d TTEXPR %o TO ", ttxlev, ep); + prloc (lp); + cprint ("\n"); + } + +# endif + + l.flag = lp->flag; /* copy loc for modification */ + l.word = lp->word; + fixloc (ep, &l); /* remove impossible cases */ + if (l.flag==l_reg && l.word==0) errx (6001); + ep = cgexpr (ep, &l); /* any location possible */ + if (ep) ep = cgmove (ep, &l); /* move to desired location */ + +# ifndef SCRIMP + + if (aflag) + {cprint ("%2d TTEXPR RETURNS ", ttxlev); + if (ep) + {cprint ("(%d,%d)\n", ep->edref.drbase, ep->edref.droffset); + cprint (" ep=%o,p1=%o,p2=%o\n", ep, ep->ep1, ep->ep2); + } + else cprint ("0\n"); + } + +# endif + + --ttxlev; + return (ep); + } + +/********************************************************************** + + CGEXPR - Generate code to evaluate expression EP. + Result is placed wherever convenient; preferred + locations are specified by LP. This routine + checks for special cases. + +**********************************************************************/ + +enode *cgexpr (ep, lp) enode *ep; loc *lp; + + {if (!ep) return (NULL); + if (ep->lvalue > 0 && ep->edref.drbase<0) + {restore (ep); + return (ep); + } + if (jumpop (ep->op)) + if (lp->flag == l_label) return (cgop (ep, lp)); + else return (jumpval (ep,lp)); + + switch (ep->op) { +case e_idn: return (cgidn (ep)); +case e_int: return (cgint (ep)); +case e_float: return (cgfloat (ep)); +case e_string: return (cgstring (ep)); +case e_call: return (cgcall (ep)); +case e_qmark: return (cgqmark (ep, lp)); +case e_assign: return (cgassign (ep, lp)); +case e_ind: return (cgindirect (ep, lp)); +case e_lseq: return (cglseq (ep, lp)); +case e_comma: return (cgcomma (ep, lp)); + } + + return (cgop (ep,lp)); + } + +/********************************************************************** + + JUMPVAL - Generate code to obtain a value from a jump + operation. + +**********************************************************************/ + +enode *jumpval (ep, lp) enode *ep; loc *lp; + + {int r, i, j; + loc l; + + jumpz (ep, i=ciln++); + r = trdt[TTINT]; + r = (lp->flag == l_reg ? getreg (lp->word, r) : freereg (r)); + l.flag = l_reg; + l.word = 1<edref.drbase = -(ep->eclass); + ep->edref.droffset = ep->eoffset; + return (ep); + } + +/********************************************************************** + + CGINT - Generate Code for Integer Constant + +**********************************************************************/ + +enode *cgint (ep) econst *ep; + + {ep->edref.drbase = -c_integer; + ep->edref.droffset = ep->eval; + return (ep); + } + +/********************************************************************** + + CGFLOAT - Generate Code for Float Constant + +**********************************************************************/ + +enode *cgfloat (ep) econst *ep; + + {ep->edref.drbase = -c_float; + ep->edref.droffset = ep->eval; + return (ep); + } + +/********************************************************************** + + CGSTRING - Generate Code for String Constant + +**********************************************************************/ + +enode *cgstring (ep) econst *ep; + + {ep->edref.drbase = -c_string; + ep->edref.droffset = ep->eval; + return (ep); + } + +/********************************************************************** + + CGINDIRECT - Generate Code for Indirection Operator + +**********************************************************************/ + +enode *cgindirect (ep, lp) enode *ep; loc *lp; + + {loc l; + enode *p1; + econst *ecp; + int op, off; + + l.flag = l_reg; + l.word = (lp->flag == l_mem ? lp->word >> c_indirect : -1); + + if (p1 = ep->ep1) + {op = p1->op; + if (op >= e_add0 && op <= e_add3) + {if ((ecp=p1->ep2)->op==e_int && + (*off_ok[op-e_add0])(off=ecp->eval)) + p1 = p1->ep1; + else off=0; + } + else off=0; + if (p1) + {p1 = ttexpr (p1, &l); + ep->edref.drbase = -(c_indirect + p1->edref.drbase); + ep->edref.droffset = off; + ep->ep1 = p1; + return (ep); + } + } + return (NULL); + } + +/********************************************************************** + + CGASSIGN - Generate Code For Assignment + +**********************************************************************/ + +enode *cgassign (ep, lp) enode *ep; loc *lp; + + {enode *p1, *p2; + int r; + + if (lp->flag != l_reg) lp = allreg; + if (expr2 (ep, allmem, lp)) + {p1 = ep->ep1; + p2 = ep->ep2; + r = p2->edref.drbase; + p2 = mmove (p2, p1->edref.drbase, p1->edref.droffset, TRUE); + if (p2) + {eclear (p1); + reserve (r, ep); + return (ep); + } + } + return (NULL); + } + +/********************************************************************** + + CGCALL - Generate Code for Function Call Operation + +**********************************************************************/ + +enode *cgcall (ep) enode *ep; + + {int narg, o, r; + enode *p1; + + narg = cg_elist (ep->ep2, &o); + rsave (); + if (p1 = ttexpr (ep->ep1, allmem)) + {eclear (p1); + fcall (narg,o,p1->edref.drbase,p1->edref.droffset); + r = retreg[ectype(ep)]; + if (r<0) errx (6029); + reserve (r, ep); + return (ep); + } + return (NULL); + } + +/********************************************************************** + + CGQMARK - Generate Code for Conditional Expression + +**********************************************************************/ + +enode *cgqmark (ep, lp) enode *ep; loc *lp; + + {int l1, l2, r; + enode *p2, *p; + loc l; + + l1 = ciln++; + l2 = ciln++; + p2 = ep->ep2; + jumpz (ep->ep1, l1); + l.flag = l_reg; + l.word = (lp->flag == l_reg ? lp->word : -1); + p = ttexpr (p2->ep1, &l); + if (p) + {eclear (p); + jump (l2); + ilabel (l1); + r = p->edref.drbase; + l.word = 1<ep2, &l); + if (p) + {eclear (p); + ilabel (l2); + reserve (r, ep); + return (ep); + } + } + return (NULL); + } + +/********************************************************************** + + CGLSEQ - Generate code for left-sequence operator. This + operator computes and saves the value of its left operand, + then computes the value of its right operand, then returns + the value which it computed for its left operand. It is + used in the implementation of postfix increment and decrement + operators, when not defined in the machine description. + +**********************************************************************/ + +enode *cglseq (ep, lp) enode *ep; loc *lp; + + {enode *p1, *p2; + + if (lp->flag!=l_reg) lp = allreg; + p1 = ep->ep1; + p2 = ep->ep2; + p1 = ttexpr (p1, lp); + p2 = ttexpr (p2, anywhere); + if (p2) eclear (p2); + return (p1); + } + +/********************************************************************** + + CGCOMMA - Generate code for comma operator. This operator + evaluates its left operand, then evaluates and returns its + right operand. + +**********************************************************************/ + +enode *cgcomma (ep, lp) enode *ep; loc *lp; + + {enode *p1; + p1 = ttexpr (ep->ep1, anywhere); + if (p1) eclear (p1); + return (ttexpr (ep->ep2, lp)); + } + +/********************************************************************** + + CGOP - Code Generator for Operations not special-cased + by CGEXPR. + +**********************************************************************/ + +enode *cgop (ep, lp) enode *ep; loc *lp; + + {loc l, *lp1, *lp2; + enode *p1, *p2; + oploc *po; + int rflag, w, r, base, offset; + + /* choose an OPLOC */ + + if (!(po=choose (ep, lp, &l))) return (NULL); + rflag = po->xloc[2].flag; + + /* determine locations for operands */ + + lp1 = (rflag==3 ? &l : &po->xloc[0]); + lp2 = (rflag==4 ? &l : &po->xloc[1]); + + /* generate code to evaluate operands */ + + if (!expr2 (ep, lp1, lp2)) return (NULL); + p1 = ep->ep1; + p2 = ep->ep2; + + /* mark operand registers unused */ + + eclear (p1); + eclear (p2); + + /* save clobbered registers */ + + if (w = po->clobber) for (r=0;rflag == l_label) + {base = -c_label; + offset = lp->word; + } + else if (rflag==3) + {base = p1->edref.drbase; + offset = p1->edref.droffset; + } + else if (rflag==4) + {base = p2->edref.drbase; + offset = p2->edref.droffset; + } + else if (l.flag == l_reg) /* choose a register */ + {mark (p1); + mark (p2); + base = getreg (l.word, po->xloc[2].word); + offset = 0; + unmark (p1); + unmark (p2); + } + else if (l.flag == l_mem) /* choose a memory location ? */ + errx (6007); + + /* emit operation */ + + if (p2) emitop (2,ep->op,base,offset,p1->edref.drbase,p1->edref.droffset, + p2->edref.drbase,p2->edref.droffset); + else emitop (1,ep->op,base,offset,p1->edref.drbase,p1->edref.droffset); + + /* record location of result */ + + if (base>=0) reserve (base, ep); + else + {ep->edref.drbase = base; + ep->edref.droffset = offset; + ep->saved = 0177; + } + + return (ep); + } + +/********************************************************************** + + CGMOVE - Generate code to move value to a desired + location. + + This routine will load a register, move between registers, + and/or store in a temporary. + +**********************************************************************/ + +enode *cgmove (ep, lp) enode *ep; loc *lp; + + {int base, w; + loc tl; + + base = ep->edref.drbase; + w = lp->word; + + switch (lp->flag) { + +case l_label: if (base != -c_label) errx (6038); + break; + +case l_any: break; + +case l_reg: if (base<0 || !bget1 (w, base)) + {eclear (ep); + base = freereg (w); + ep = mmove (ep, base, 0, FALSE); + reserve (base, ep); + } + break; + +case l_mem: if (base>=0) /* in a register */ + {if (bget1 (w, c_temp)) + ep = mmove (ep, -c_temp, gettemp (ep), TRUE); + else errx (6012); + } + else if (!bget1 (w, -base)) + {if (bget1 (w, -c_temp)) + {tl.flag = l_reg; + tl.word = tregs (ep); + ep = cgmove (ep, &tl); + ep = cgmove (ep, lp); + } + else errx (6038); + } + break; + +default: errx (6039, lp->flag, w); + } + + return (ep); + } + +/********************************************************************** + + CG_ELIST - compute function arguments given by an expression_list + subtree (see ELIST). Return the number of arguments. Set + *LCP to the offset of the first argument in the stack frame, + or to 0 if .ARG ops are being used. + +**********************************************************************/ + +int cg_elist (ep, lcp) + enode *ep; + int *lcp; + + {int n, *ip, o; + enode *argv[maxfarg], **argp, **eargp; + + eargp = argp = &argv[maxfarg]; + ip = ep; + while (ip && ip[0] < 0) + {*--argp = ip[2]; + ip = ip[1]; + } + if (ip) *--argp = ip; + + n = eargp - argp; + if (!argops) *lcp = o = ttemp (TINT, n); /* stack space for args */ + else *lcp = o = 0; + while (argp < eargp) + {cg_farg (*argp++, o); + o =+ int_size; + } + return (n); + } + +/********************************************************************** + + CG_FARG - generate code for a single function argument + (into stack frame offset LC, if not using .ARG ops) + +**********************************************************************/ + +cg_farg (ep, lc) + enode *ep; + int lc; + + {if (!ep) return; + ep = opt (ep); + if (flt_hack && ep->etype == TDOUBLE) + {if (!(ep = ttexpr (ep, allreg))) return; + ep = mmove (ep, -c_temp, gettemp (ep), TRUE); + if (!ep) return; + if (ep->lvalue > 1) errx (6046); + ep->op = e_idn; /* make fake idn */ + ep->lvalue = 2; /* so won't be recomputed */ + ep = taddr (ep); + if (argops) + ep = mkenode (e_arg0 + tpoint[TTDOUBLE], + ep->etype, 0, ep, NULL); + } + if (!(ep = ttexpr (ep, argops ? anywhere : allreg))) return; + if (!argops) ep = mmove (ep, -c_temp, lc, TRUE); + else eclear (ep); + } + +/********************************************************************** + + CHOOSE - Return an OPLOC for expression EP with preferred + result locations specified by LP. Set the LOC + pointed to by RP to a LOC describing the possible + locations of the result, which will be derived + from LP and the OPLOC LOC for the result, first + operand, or second operand. + +**********************************************************************/ + +oploc *choose (ep, lp, rp) enode *ep; loc *lp, *rp; + + {oploc *po, *maxp; + loc *p; + int i, j, s, maxs, op, *l; + + op = ep->op; + i = rtopp[op]; + if (i>=0) + {l = &rtopl[i]; + maxs = -500; /* filter out incompatible OPLOCs */ + maxp = NULL; + while ((j = *l++) >= 0) + {po = &xoploc[j]; + s = score (po, ep, lp); + if (s>maxs) {maxs = s; maxp = po;} + } + if (maxp) /* found one */ + {s = maxp->xloc[2].flag; + p = &maxp->xloc[s==3 ? 0 : s==4 ? 1 : 2]; + rp->flag = p->flag; + rp->word = p->word; + if (lp->flag == rp->flag && (s = rp->word & lp->word)) + rp->word = s; + return (maxp); + } + errx (6031, op); + } + errx (1029, op); + return (NULL); + } + +/********************************************************************** + + SCORE - Determine the suitability of an OPLOC for a given + expression EP and preferred result locations, specified + by LP. + +**********************************************************************/ + +int score (po, ep, lp) oploc *po; enode *ep; loc *lp; + + {int w, s, f, rf, rw, lw; + + s = ((w = po->clobber) ? -10*nbusy (w) : 0); + f = po->xloc[2].flag; + if (f==3) + {rf = po->xloc[0].flag; + rw = po->xloc[0].word; + } + else if (f==4) + {rf = po->xloc[1].flag; + rw = po->xloc[1].word; + } + else + {rf = f; + rw = po->xloc[2].word; + } + lw = lp->word; + + switch (lp->flag) { + +case l_label: if (rf!=l_mem || !bget1 (rw, c_label)) s = -1000; + break; + +case l_reg: if (rf==l_reg) + {if (w = lw & rw) + if (nfree (w)==0 && nfree (lw)>0) s =- 10; + else; + else s =- (nfree (rw)>0 ? 4 : 14); + } + else s =- 5; + break; + +case l_mem: if (rf==l_reg) + {if (!bget1 (lw, c_temp)) s = -1000; + else s =- (nfree (rw)>0 ? 5 : 15); + } + else if ((rw & lw) != rw) s = -1000; + break; + } + + if (s > -1000) + {if (ep->ep1) s =+ scorop (ep->ep1, f, &po->xloc[0]); + if (ep->ep2) s =+ scorop (ep->ep2, f, &po->xloc[1]); + } + +# ifndef SCRIMP + + if (aflag) cprint ("SCORE IS %d\n", s); + +# endif + + return (s); + } + +/********************************************************************** + + SCOROP - Determine suitability of operands. + +**********************************************************************/ + +int scorop (ep, f, lp) enode *ep; loc *lp; + + {int lf, lw, wreg, wmem, s; + + lf = lp->flag; + lw = lp->word; + eresult (ep, &wreg, &wmem); + s = 0; + if (lf == l_reg) + {if (f<3 && nfree (lw)==0) s =- 10; + if (wreg) + if ((wreg & lw) == 0) s =- 4; + else; + else s =- 5; + } + else if (lf == l_mem) + {if ((lw & (1<op; + switch (op) { + +case e_ind: *p1 = 0; + *p2 = tregs (ep->ep1) << c_indirect; + return; + +case e_assign: +case e_qmark: *p1 = tregs (ep); + *p2 = 0; + return; + +case e_call: *p1 = 1 << retreg[ectype(ep)]; + *p2 = 0; + return; + +case e_idn: eip = ep; + *p1 = 0; + *p2 = 1 << ((c = eip->eclass) == c_extern ? c_extdef : c); + return; + } + + *p1 = opreg[op]; + *p2 = opmem[op]; + } + +/********************************************************************** + + JUMPZ - Emit Jump on Zero + +**********************************************************************/ + +jumpz (ep, iln) enode *ep; int iln; + + {int op, l, n[1], i; + econst *ecp; + + if (!ep) return; + op = ep->op; + + if (condop (op)) + {i = invcond (op); + if (rtopp[i]<0) /* inverse op not implemented */ + {jumpn (ep, l=ciln++); + jump (iln); + ilabel (l); + } + else + {ep->op = i; + jumpn (ep, iln); + ep->op = op; + } + return; + } + + switch (op) { + +case e_not: jumpn (ep->ep1, iln); + return; + +case e_and: jumpz (ep->ep1, iln); + jumpz (ep->ep2, iln); + return; + +case e_or: jumpn (ep->ep1, l=ciln++); + jumpz (ep->ep2, iln); + ilabel (l); + return; + +case e_int: if ((ecp=ep)->eval==0) jump (iln); + return; + } + + n[0] = n_eq; + jumpn (txpr2 (n, ep, intcon (0)), iln); + } + +/********************************************************************** + + JUMPN - Emit jump on non-zero + +**********************************************************************/ + +jumpn (ep, iln) enode *ep; int iln; + + {int op, l, n[1]; + loc x; + econst *ecp; + + if (!ep) return; + op = ep->op; + + if (condop (op)) + {x.flag = l_label; + x.word = iln; + ttexpr (ep, &x); + return; + } + + switch (op) { + +case e_not: jumpz (ep->ep1, iln); + return; + +case e_and: jumpz (ep->ep1, l=ciln++); + jumpn (ep->ep2, iln); + ilabel (l); + return; + +case e_or: jumpn (ep->ep1, iln); + jumpn (ep->ep2, iln); + return; + +case e_int: if ((ecp=ep)->eval) jump (iln); + return; + } + + n[0] = n_ne; + jumpn (txpr2 (n, ep, intcon (0)), iln); + } + +/********************************************************************** + + CRETURN - return statment + +**********************************************************************/ + +creturn (ep) enode *ep; + + {loc l; + int r; + + if (ep) + {r=retreg[ectype(ep)]; + if (r<0) errx (6030); + l.flag = 1; + l.word = 1<edref.drbase, ep->edref.droffset); + } + +/********************************************************************** + + EXPR2 - evaluate two subexpressions given sets of + desired locations for the results + + Evaluate the more complicated expression first; make sure + that the results do not require the same register. + +**********************************************************************/ + +expr2 (ep, lp1, lp2) enode *ep; loc *lp1, *lp2; + + {enode **epp1, **epp2; + loc *dlp, loc1, loc2, *l1, *l2; + int f1, f2, w1, w2, s1, s2, f, b; + + if (!ep->ep2) + if (ep->ep1) + return (ep->ep1 = ttexpr (ep->ep1, lp1)); + else return (0); + if (ep->ep2->degree > ep->ep1->degree && ep->ep1->lvalue<2) + {epp1= &(ep->ep2); + epp2= &(ep->ep1); + dlp=lp1; lp1=lp2; lp2=dlp; + } + else + {epp1 = &(ep->ep1); + epp2 = &(ep->ep2); + } + + loc1.flag = lp1->flag; + loc1.word = lp1->word; + loc2.flag = lp2->flag; + loc2.word = lp2->word; + l1 = &loc1; + l2 = &loc2; + fixloc (*epp1, l1); + fixloc (*epp2, l2); + f1=l1->flag; + f2=l2->flag; + w1=l1->word; + w2=l2->word; + + if (f1 == l_mem) + {s1=w1 & ((1<> c_indirect; + } + if (f2 == l_mem) + {s2 = w2 & ((1<>c_indirect; + } + if (onebit (w2)) w1 =& ~w2; + + if (f1 == l_mem) w1 = (w1<word = w1; + f = (*epp1) = ttexpr (*epp1, l1); + + if ((b = (*epp1)->edref.drbase) >= 0) w2 =& ~(1<word = w2; + if (f) f = (*epp2 = ttexpr (*epp2, l2)); + restore (*epp1); + return (f); + } + +/********************************************************************** + + CODE GENERATOR: REGISTER MANAGEMENT ROUTINES + + clear + eclear + freereg + getreg + mark + nbusy + nfree + reserve + restore + rflush + rsave + save + save1 + unmark + +*/ + +struct _ureg + {int ucode; /* status code: + 0 free + -1 directly contains an expression + n>0 n conflicting regs are busy + */ + int marked; /* marked flag: non-zero => marked */ + enode *rep; /* points to expression contained in reg */ + }; +# define ureg struct _ureg + +ureg regtab[maxreg]; /* table of register status */ +ureg *eregtab; /* points past end of table */ + +/********************************************************************** + + REG_INIT - initialize register status variables + +**********************************************************************/ + +reg_init () + {eregtab = ®tab[nreg]; + } + +/********************************************************************** + + CLEAR - clear register R, directly containing an expression + decrement UCODE of conflicting registers + +**********************************************************************/ + +clear (r) int r; + + {int i, w; + ureg *p; + +# ifndef SCRIMP + + if (aflag) cprint ("CLEAR(%d)\n", r); + +# endif + + p = ®tab[r]; + if (p->ucode >= 0) errx (6019, r); + p->ucode = 0; + p->rep = NULL; + if (w = conf[r]) for (i=0;iedref.drbase; + if (ep->saved == 0177) + {if (i>=0) clear (i); + else if (i <= -c_indirect) + if (ep->lvalue>0 && --ep->lvalue==0) + eclear (ep->ep1); + } + } + +/********************************************************************** + + FREEREG - Find an unused register specified by the word W; if + none, select any specified register and save it. + +**********************************************************************/ + +int freereg (w) int w; + + {int i, j, k; + + if (!w) errx (6013); + j = k = -1; + + for (i=0; i> 1; + } + if (j == -1) j = k; + save (j); + return (j); + } + +/********************************************************************** + + GETREG - Get a register, make it available for use. + + Priority: + + 1. free register from W1 + 2. busy register from W1 + 3. free register from W2 + 4. busy register from W2 + 5. marked register from W1 + +**********************************************************************/ + +int getreg (w1, w2) + + {int r, m, bw1, fw2, bw2, mkd, c, marked; + + if (!w1) errx (6040); + bw1 = fw2 = bw2 = mkd = -1; + m = 1; + for (r=0; r= 0) {save (bw1); return (bw1);} + if (fw2 >= 0) return (fw2); + if (bw2 >= 0) {save (bw2); return (bw2);} + return (mkd); + } + +/********************************************************************** + + MARK - If the expression EP is referenced indirect through + a register, mark that register as not to be used. + +**********************************************************************/ + +int mark (ep) enode *ep; + + {int r; + + if (ep && (r = ep->edref.drbase) <= -c_indirect) + {r = -r - c_indirect; + +# ifndef SCRIMP + + if (aflag) cprint ("MARK(%d)\n", r); + +# endif + + if (regtab[r].marked) errx (6044, r); + ++regtab[r].marked; + return (1); + } + return (0); + } + +/********************************************************************** + + NBUSY - Return number of busy registers in set W + +**********************************************************************/ + +int nbusy (w) + + {int s; + ureg *p; + + s = 0; + p = regtab; + while (pucode) ++s; + ++p; + w =>> 1; + } + return (s); + } + +/********************************************************************** + + NFREE - Return number of free registers in set W + +**********************************************************************/ + +int nfree (w) + + {int s; + ureg *p; + + s = 0; + p = regtab; + while (pucode==0) ++s; + ++p; + w =>> 1; + } + return (s); + } + +/********************************************************************** + + RESERVE - reserve a register for a given expression + +**********************************************************************/ + +reserve (r, ep) int r; enode *ep; + + {int i, w; + ureg *p; + +# ifndef SCRIMP + + if (aflag) cprint ("RESERVE(%d,%o)\n", r, ep); + +# endif + + p = ®tab[r]; + if (p->ucode) errx (6017, r); + if (w = conf[r]) for (i=0;iucode = -1; /* directly contains an expression */ + p->rep = ep; + ep->edref.drbase = r; + ep->edref.droffset = 0; + ep->saved = 0177; + } + +/********************************************************************** + + RESTORE - restore saved expression to original location + + Return TRUE if a restoration takes place. + +**********************************************************************/ + +int restore (ep) enode *ep; + + {int r; + +# ifndef SCRIMP + + if (aflag) cprint ("RESTORE(%o)\n", ep); + +# endif + + if (!ep) return (FALSE); + if ((r = ep->saved) == 0177) + {if (ep->edref.drbase <= -c_indirect) + return (restore (ep->ep1)); + return (FALSE); + } + save (r); + ep = mmove (ep, r, 0, TRUE); + if (!ep) return (FALSE); + reserve (r, ep); + return (TRUE); + } + +/********************************************************************** + + RFLUSH - Flush All Registers + +**********************************************************************/ + +rflush () + + {ureg *p; + for (p=regtab; pucode = 0; + } + +/********************************************************************** + + RSAVE - Save All Registers + +**********************************************************************/ + +rsave () + + {int r; + for (r=0; r0) + if (w = conf[r]) + for (i=0; i= 0) errx (6022, r); + ep = regtab[r].rep; + if (ep) + {o = gettemp (ep); + ep = mmove (ep, -c_temp, o, TRUE); + if (ep) ep->saved = r; + } + else regtab[r].ucode = 0; + } + +/********************************************************************** + + UNMARK - unMARK a register previously MARKed + +**********************************************************************/ + +int unmark (ep) enode *ep; + + {int r; + + if (ep && (r = ep->edref.drbase) <= -c_indirect) + {r = -r - c_indirect; + +# ifndef SCRIMP + + if (aflag) cprint ("UNMARK(%d)\n", r); + +# endif + + if (regtab[r].marked == 0) errx (6045, r); + --regtab[r].marked; + return (1); + } + return (0); + } + \ No newline at end of file diff --git a/src/c/c34.c b/src/c/c34.c new file mode 100644 index 00000000..d055d130 --- /dev/null +++ b/src/c/c34.c @@ -0,0 +1,537 @@ +# include "cc.h" +# include "c3.h" + +/* + + C COMPILER + Phase C: Code Generator + Section 4: Macro Emitting Routines and Auxiliary Routines + + Copyright (c) 1977 by Alan Snyder + +*/ + +/********************************************************************** + + ABSTRACT MACHINE INSTRUCTION EMITTING ROUTINES + +**********************************************************************/ + +ilabel(i) {mprint ("%l(*)\n", i);} +jump(i) {mgoto (-c_label, i);} +string() {mprint ("%sr()\n");} +mprolog(n, i, na) {mprint ("%p(*,*,*)\n", n, i, na);} +mepilog() {mprint ("%ep(*,*)\n", nfunc, framesize);} +mgoto(b, o) {mprint ("%go(0,*,*)\n", b, o);} +fcall(n, p, b, o) {mprint ("%ca(*,*,0,*,*)\n", n, p, b, o);} +mreturn() {mprint ("%rt(*)\n", nfunc);} +mtswitch(b, o, l, h, d) {mprint ("%ts(*,*,*,*,*,*)\n", l, -c_label, d, b, o, h);} +mlswitch(b, o, n, d) {mprint ("%ls(*,*,*,*,*)\n", n, -c_label, d, b, o);} +metswitch(b,o,l,h,d) {mprint ("%ets(*,*,*,*,*,*)\n", l, -c_label, d, b, o, h);} +melswitch(b,o,n,d) {mprint ("%els(*,*,*,*,*)\n", n, -c_label, d, b, o);} +endcard() {mprint ("%end()\n");} +mint(i) {mprint ("%in(*)\n", i);} +mlabcon(i) {mprint ("%lc(*)\n", i);} +mpure() {mprint ("%pu()\n");objmode=o_pure;} +mpdata() {mprint ("%pd()\n");objmode=o_pdata;} + +ln (p) int *p; + + {if (p[1] != lineno) + {lineno = p[1]; + mprint ("%ln(*)\n", lineno); + } + } + +/********************************************************************** + + EMITOP - emit operation given + + OP - run-time operator + RB - result base + RO - result offset + B1 - base of operand 1 (optional) + O1 - offset of operand 1 (optional) + B2 - base of operand 2 (optional) + O2 - offset of operand 2 (optional) + +**********************************************************************/ + +emitop (nopr, op, rb, ro, b1, o1, b2, o2) + int op, rb, ro, b1, o1, b2, o2; + + {int i; + + if ((i = mactab[op]) < 0) errx (1028, op); + else + {cputc ('%', f_mac); + mprd (i); + cputc ('(', f_mac); + mprd (op); + cputc (',', f_mac); + mprd (rb); + cputc (',', f_mac); + mprd (ro); + cputc (',', f_mac); + mprd (b1); + cputc (',', f_mac); + mprd (o1); + if (nopr>1) + {cputc (',', f_mac); + mprd (b2); + cputc (',', f_mac); + mprd (o2); + } + cputc (')', f_mac); + cputc ('\n', f_mac); + } + } + +/********************************************************************** + + MMOVE - emit macro to accomplish a MOVE + +**********************************************************************/ + +enode *mmove (ep,db,dof,clear_old) enode *ep; + + {int ct,op; + + ct = ectype (ep); + if (ct == ct_bad) return (NULL); + if (ct == ct_struct) + {errx (2033); + return (NULL); + } + if (ct < ct_char || ct > ct_p3) errx (6024, ct); + + op = e_movec + ct - ct_char; + emitop (1, op, db, dof, ep->edref.drbase, ep->edref.droffset); + if (clear_old) eclear (ep); + if (ep->lvalue > 0) ep = mkenode (op, ep->etype, 0, ep, NULL); + ep->edref.drbase = db; + ep->edref.droffset = dof; + ep->saved = 0177; + return (ep); + } + +/********************************************************************** + + CODE GENERATOR: AUXILIARY ROUTINES + + e_alloc + bget1 + e_free + intcon + condop + jumpop + invcond + mkenode + tregs + read_node + onebit + fixloc + undfop + + max + min + rtyptab + to2p + ro2p + prloc + prtree + +*/ + +/********************************************************************** + + E_ALLOC - allocate an ENODE + +**********************************************************************/ + +enode *e_alloc () + + {if (acorp >= acore+(acoresz-1)) errx (4011); + return (acorp++); + } + +/********************************************************************** + + BGET1 - bit get + +**********************************************************************/ + +int bget1 (w, n) int w, n; + + {return ((w>>n) & 1);} + +/********************************************************************** + + E_FREE - free all ENODEs + +**********************************************************************/ + +e_free () + + {extern enode acore[], *acorp; + + acorp = acore; + } + +/********************************************************************** + + INTCON - create an integer constant expression node + +**********************************************************************/ + +enode *intcon (i) + + {return (mkenode (e_int, TINT, 0, i, NULL));} + +/********************************************************************** + + CONDOP - Is AMOP a conditional? + +**********************************************************************/ + +int condop (op) + + {return (op>=e_eqi && op<=e_gep3 || op>=e_jz0 && op<=e_jn3);} + +/********************************************************************** + + JUMPOP - Is AMOP a jump operation? + +**********************************************************************/ + +int jumpop (op) + + {return (condop(op) || op==e_not || op==e_and || op==e_or);} + +/********************************************************************** + + INVCOND - Return inverse of conditional AMOP + +**********************************************************************/ + +int invtab [] { + 1, 0, 5, 4, 3, 2, + 7, 6, 11, 10, 9, 8, + 13, 12, 17, 16, 15, 14, + 19, 18, 23, 22, 21, 20, + 25, 24, 29, 28, 27, 26, + 31, 30, 35, 34, 33, 32}; + +int invcond (op) + + {if (op>=e_eqi) return (e_eqi + invtab[op-e_eqi]); + if (op>=e_jn0) return (op-4); + return (op+4); + } + +/********************************************************************** + + MKENODE - create a new expression node, determine its degree + +**********************************************************************/ + +enode *mkenode (op, etype, lvalue, ep1, ep2) + + int op, lvalue; + type etype; + enode *ep1, *ep2; + + {enode *ep; + ep = e_alloc (); + ep->op = op; + ep->etype = etype; + ep->lvalue = lvalue; + ep->ep1 = ep1; + ep->ep2 = ep2; + ep->degree = 1; + switch (op) { + case e_int: + case e_float: + case e_string: + case e_idn: break; + + default: if (!ep1) break; + if (!ep2) ep->degree = ep1->degree; + else if (ep1->degree==ep2->degree) + ep->degree = ep1->degree+1; + else ep->degree = max (ep1->degree, ep2->degree); + } + ep->edref.drbase = ep->edref.droffset = 0; + ep->saved = 0177; + return (ep); + } + +/********************************************************************** + + TREGS - find registers which can hold a given type + of expression (indicated by 1 bits in the returned word) + +**********************************************************************/ + +int tregs (ep) enode *ep; + + {int ct; + ct = ectype (ep); + if (ct >= ct_p0) return (prdt[ct-ct_p0]); + if (ct >= ct_char) return (trdt[ct-ct_char]); + return (0); + } + +/********************************************************************** + + READ_NODE - Read Node From Node File + +**********************************************************************/ + +read_node () + + {int op, i, j, n; + + op = geti (f_node); + if (op<1 || op>n_elist) error (6027, -2, op, lc_node); + *corep++ = op; + i = nodelen[op]; + lc_node =+ i; + j = ntw[type_node[op]]; + + /* read in remaining words of node, + converting offsets to pointers according + to the low-order bits of ntw[] */ + + while (--i > 0) + {n = geti (f_node); + if (j&1 && n) n = core+(n-flc_node); + *corep++ = n; + j =>> 1; + } + + if (op <= 1) eof_node = 1; + return (op); + } + +/********************************************************************** + + ONEBIT - Return TRUE if word has only 1 bit on. + + (Notice the efficiency of this routine. Handling of + high order bit assumes two's complement representation.) + +**********************************************************************/ + +int onebit (w) + + {int f; + + if (w==0) return (FALSE); + if (w<0) return (-w < 0); + + f = FALSE; + + do + if (w & 1) if (f) return (FALSE); else f=TRUE; + while (w =>> 1); + + return (TRUE); + } + +/********************************************************************** + + FIXLOC - modify a LOC for an expression + by removing those possibilities + which can never occur, due to the + type of the expression, unless that + would remove all possibilities + +**********************************************************************/ + +fixloc (ep, lp) enode *ep; loc *lp; + + {int i; + + if (lp->flag == l_mem && ep->op==e_ind) + lp->word =& (tregs(ep->ep1)<flag==l_reg) + {i = lp->word & tregs(ep); + if (i) lp->word = i; + } + } + +/********************************************************************** + + UNDFOP - is abstract machine operator undefined? + +**********************************************************************/ + +int undfop (op) {return (rtopp[op]<0);} + +int max (a, b) + + {return (a>b ? a : b);} + +int min (a, b) + + {return (aname = geti (f); + if (fp->name == UNDEF) ++p; + else + {fp->dtype = to2p (geti (f)); + fp->offset = geti (f); + p = fp+1; + } + } + cclose (f); + } + +type to2p (i) int i; + + {extern int typtab[], *etypp; + + if (i < 0 || i >= TTSIZE) errx (6006); + return (typtab + i); + } + +int *ro2p (i) int i; + + {extern int *etypp; + + if (i < 0 || i >= TTSIZE) errx (6047); + return (etypp - i); + } + +fixstr () {errx (6015);} +errcidn () {errx (6020);} + +# ifndef SCRIMP + +/********************************************************************** + + PRLOC - Print a LOC (for debugging) + +**********************************************************************/ + +prloc (lp) loc *lp; + + {int w; + + w = lp->word; + switch (lp->flag) { + +case l_label: cprint ("LABEL %d", w); + break; + +case l_reg: if (w == -1) cprint ("ANY REGISTER"); + else cprint ("REGISTERS %o", w); + break; + +case l_mem: if (w == -1) cprint ("ANY MEMORY"); + else cprint ("MEMORY %o", w); + break; + +case l_any: cprint ("ANYWHERE"); + break; + +default: cprint ("BAD LOC [%d,%d]", lp->flag, w); + } + } + +/********************************************************************** + + PRTREE - print an enode tree (for debugging) + +**********************************************************************/ + +prtree (ep) enode *ep; + + {static int prlev; + int i, op; + econst *ecp; + eidn *eip; + extern int cout; + + if (!ep) return; + if ((i = ++prlev) == 1) cputc ('\n', cout); + while (--i >= 0) cputc (' ', cout); + cprint ("%o ", ep); + ecp = eip = ep; + switch (op = ep->op) { + case e_int: cprint ("int %d\n", ecp->eval); + break; + case e_float: cprint ("float %d\n", ecp->eval); + break; + case e_string: cprint ("string %d\n", ecp->eval); + break; + case e_idn: cprint ("idn class=%d, offset=%d, type=", + eip->eclass, eip->eoffset); + typrint (eip->etype, cout); + cprint ("\n"); + break; + case e_call: cprint ("[call %o %o] type=", + ep->ep1, ep->ep2); + typrint (ep->etype, cout); + cprint ("\n"); + prtree (ep->ep1); + prelist (ep->ep2); + break; + default: cprint ("[%o %o %o] type=", + op, ep->ep1, ep->ep2); + typrint (ep->etype, cout); + cprint ("\n"); + prtree (ep->ep1); + prtree (ep->ep2); + } + if (--prlev == 0) cputc ('\n', cout); + } + +prelist (np) + int *np; + + {if (np[0] != -1) prtree (np); + else + {prelist (np[1]); + prelist (np[2]); + } + } + +# endif + \ No newline at end of file diff --git a/src/c/c3510.mid b/src/c/c3510.mid new file mode 100644 index 00000000..7a5b4871 Binary files /dev/null and b/src/c/c3510.mid differ diff --git a/src/c/c41.c b/src/c/c41.c new file mode 100644 index 00000000..1359bba4 --- /dev/null +++ b/src/c/c41.c @@ -0,0 +1,593 @@ +# include "cc.h" + +/* + + C COMPILER + Phase M: Macro Expansion + Section 1: Target-Machine-Independent Code + + Copyright (c) 1977 by Alan Snyder + +*/ + +extern int macdef[],mdeflist[],nmacdef[],nnmacs,mdflsz,nmacros; +extern char *mcstore,*nmacname[]; +extern int nfn; +extern char *fn[],*(*ff[])(); + +/* types */ + +# define icb struct _icb +icb {int (*mgetc)(); /* get character routine */ + int *locp; /* pointer to OPLOC description */ + int base[3]; /* REF bases of operands, result */ + int argc; /* number of macro args */ + char *cp; /* pointer to current string */ + char *argv[10]; /* pointer to macro args */ + char argbuff[100]; /* buffer for args */ + icb *next; /* chain of ICBs */ + }; + +/* for efficiency, the MGETC, LOCP, and CP fields of the + current ICB are maintained in the following variables */ + +int (*mgetc)(); +int *locp; +char *cp; + +extern int rfile(), rstring(), rquote(), rmacro(), reof(); + +# define hentry struct _hentry +hentry {char *hname; + int hflag; + char (*hf)(); + }; + +icb *cicb, + *ficb; + +int mflag, + mfile, + f_error -1, + f_output -1; + +char *fn_mac, + *fn_hmac, /* header macros */ + *fn_string, + *fn_cstore, + *fn_error, + *fn_output, + cstore[cssiz]; + +/* functions */ + +icb *icb_get(); +hentry *mlook(); + +/********************************************************************** + + Macro Processor: Main Routine + +**********************************************************************/ + +main (argc, argv) + int argc; + char *argv[]; + + {mcontrol (argc, argv); + cleanup (0); + } + +mcontrol (argc, argv) + int argc; + char *argv[]; + + {int i; + + msetup (argc, argv); + for (i=0;i= '0') /* arg ref */ + {c =- '0'; + if (c < cicb->argc && (s=((cicb->argv)[c]))) + icb_stack (icb_get (rquote, 0, s)); + return; + } + + /* must be %NAME call */ + + argc = 2; + switch (c) { /* which one ? */ + + case 'R': /* RESULT LOCATION */ + + n = 1; + break; + + case 'F': /* FIRST OPERAND LOCATION */ + + n = 3; + break; + + case 'S': /* SECOND OPERAND LOCATION */ + + n = 5; + break; + + case 'O': /* OPERATION NAME */ + + argc = 1; + n = 0; + break; + + default: /* bad abbreviation */ + + return; + } + + argv = &(cicb->argv[n]); + s = aname (argc, argv); + if (s && *s) /* something returned */ + {p = icb_get (rstring, argc, s); + p->argv[0] = argv[0]; + p->argv[1] = argv[1]; + icb_stack (p); + } + } + +/********************************************************************** + + EMACRO - expand macro invocation + +**********************************************************************/ + +emacro () + + {register int c; + register char *q1; + register icb *p; + int i, argc, m; + char name[16], **argv, *s, *q2, *(*f)(); + icb *micb; + hentry *hp; + + micb = cicb; + + /* collect macro name into NAME buffer */ + + q1 = name; + q2 = name+15; + while ((c = (*mgetc)()) != '(' || cicb!=micb) + if (q1='0') m = atoi(name); + else if ((hp=mlook(name))->hname) + if (hp->hflag == -1) f = hp->hf; /* C Routine */ + else m=nmacdef[hp->hflag]; + if (f) p = icb_get (rstring, 0, NULL); + else p = icb_get (rmacro, 0, NULL); + + /* collect arguments into ARGBUFF buffer */ + + s = p->argbuff; + argv = p->argv; + c = mget(); + if (!(c==')' && micb==cicb)) + {*argv = s; + while (c) + {if (micb==cicb && (c==',' || c==')')) + {*s++ = '\0'; + *++argv = s; + if (c==')') break; + } + else *s++ = c & 0377; + c = mget(); + } + } + + argc = argv - (p->argv); + +# ifndef SCRIMP + + if (mflag) + {cprint ("EXPANDING %%%s(", name); + for (i=0;iargv[i]); + if (i!=argc-1) cprint (","); + } + cprint (")\n"); + } + +# endif + + p->argc = argc; + if (f) /* C routine macro */ + {s = (*(hp->hf))(argc,p->argv); + if (s && *s) + {p->cp = s; + icb_stack(p); + return; + } + } + + if (m>0 && m<=nmacros) /* machine description macro */ + {p->locp= &mdeflist[macdef[m]]; + if (argc>3) p->base[0] = atoi(p->argv[3]); + if (argc>5) p->base[1] = atoi(p->argv[5]); + if (argc>1) p->base[2] = atoi(p->argv[1]); + icb_stack(p); + return; + } + icb_free (p); + } + +/********************************************************************** + + RFILE - get character from file + +**********************************************************************/ + +int rfile () + + {register int c; + + if (c = cgetc (mfile)) return (c); + icb_unstack (); + return ((*mgetc)()); + } + +/********************************************************************** + + RSTRING - get character from string + +**********************************************************************/ + +int rstring () + + {register int c; + + if (c = *cp++) return (c); + icb_unstack (); + return ((*mgetc)()); + } + +/********************************************************************** + + RQUOTE - get character from quoted string + +**********************************************************************/ + +int rquote () + + {register int c; + + if (c = *cp++) return (c | 0400); + icb_unstack (); + return ((*mgetc)()); + } + +/********************************************************************** + + RMACRO - get character from machine description macro + +**********************************************************************/ + +int rmacro () + + {register int c, i, *ip; + int base, *basep; + +new_cp: if (cp && (c = *cp++)) return (c); + for (;;) + {ip = locp; + if ((i = ip[0]) < 0) + {icb_unstack (); + return ((*mgetc)()); + } + if (i==3) /* unconditional string */ + {locp =+ 2; + cp = &mcstore[ip[1]]; + goto new_cp; + } + locp =+ 7; /* string with condition prefix */ + basep = cicb->base; + for (i=0;i<3;++i) + {base = *basep++; + switch (*ip++) { + case 0: ++ip; continue; + case 1: if (base >= 0 && ((*ip++ >> base) & 1)) + continue; + else break; + case 2: if (base < 0 && ((*ip++ >> -base) & 1)) + continue; + else break; + } + break; + } + if (i==3) /* all tests succeeded */ + {cp = &mcstore[*ip]; + goto new_cp; + } + } + } + +/********************************************************************** + + REOF - get character at end of file + +**********************************************************************/ + +int reof () + + {return (0);} + +/********************************************************************** + + INPUT CONTROL BLOCK ROUTINES + + ICB_GET - Allocate Input Control Block + ICB_INIT - Initialize Input Control Block Pool + ICB_STACK - Push an Input Control Block onto the ICB Stack + ICB_UNSTACK - Pop off the top ICB and discard + ICB_FREE - Discard an Input Control Block + ICB_PRINT - Print an Input Control Block (for debugging) + +**********************************************************************/ + +icb_init() + + {static icb xicb[icb_size]; + icb *p,*q; + + /* set up free chain */ + + p = &xicb[icb_size-1]; + p->next = NULL; + for (q=p;q>xicb;) (--q)->next = p--; + ficb = q; + } + +icb *icb_get (new_mgetc, new_argc, new_cp) + int (*new_mgetc)(); + char *new_cp; + + {icb *p; + + /* remove first element of free chain */ + + if (!ficb) error (6004, -1); + p = ficb; + ficb = p->next; + p->next = NULL; + p->mgetc = new_mgetc; + p->argc = new_argc; + p->cp = new_cp; + p->locp = NULL; + return (p); + } + +icb_stack (p) icb *p; + + { + +# ifndef SCRIMP + + if (mflag) icb_print(p); + +# endif + + if (cicb) /* Current CP and LOCP must be saved. + MGETC is assumed not to change, thus + any change must be made to both + the variable and the ICB field. */ + + {cicb->cp = cp; + cicb->locp = locp; + } + p->next = cicb; + cicb = p; + mgetc = p->mgetc; + locp = p->locp; + cp = p->cp; + } + +icb_unstack() + + {icb *p; + +# ifndef SCRIMP + + if (mflag) cprint ("POPPING ICB\n"); + +# endif + + /* if throwing away FILE input, close FILE first */ + + if (mgetc == rfile) cclose (mfile); + p = cicb->next; + cicb->next = ficb; + ficb = cicb; + cicb = p; + + /* restore MTYPE, LOCP, and CP */ + + if (p) + {mgetc = p->mgetc; + locp = p->locp; + cp = p->cp; + } + else mgetc = reof; + } + +icb_free(p) icb *p; + + {p->next = ficb; + ficb = p; + } + +# ifndef SCRIMP + +icb_print(p) icb *p; + + {int (*f)(); + + f = p->mgetc; + cprint ("PUSHING "); + if (f == rfile) cprint ("FILE"); + else if (f == rstring) cprint ("STRING \"%s\"", p->cp); + else if (f == rquote) cprint ("QUOTED STRING \"%s\"", p->cp); + else if (f == rmacro) + {cprint ("MACRO, LOCP=%o, ", p->locp); + cprint ("BASE=(%d,%d,%d)", p->base[0], p->base[1], + p->base[2]); + } + else cprint ("UNKNOWN ICB, MGETC=%o", f); + cprint ("\n"); + } + +# endif + +/********************************************************************** + + HASH TABLE ROUTINES + +**********************************************************************/ + +hentry hshtab[mhsize]; + +hentry *mlook(np) char *np; + + {register int i, u; + register char *p; + + i=0; p=np; + while (u = *p++) i =+ u; + i = (i<<2) & mhmask; + + while (p=hshtab[i].hname) + if (stcmp(p,np)) break; + else i = ++i & mhmask; + + return (&hshtab[i]); + } + +enter (s, hflag, hf) char *s,(*hf)(); int hflag; + + {hentry *hp; + + if (!(hp=mlook(s))->hname) + {hp->hname = s; + hp->hflag = hflag; + hp->hf = hf; + } + } + +/********************************************************************** + + CLEANUP - Macro Phase Cleanup Routine + +**********************************************************************/ + +cleanup (rcode) + + {cexit (rcode); + } + diff --git a/src/c/c4220.mid b/src/c/c4220.mid new file mode 100644 index 00000000..410e46c7 Binary files /dev/null and b/src/c/c4220.mid differ diff --git a/src/c/c4320.mid b/src/c/c4320.mid new file mode 100644 index 00000000..81f49745 Binary files /dev/null and b/src/c/c4320.mid differ diff --git a/src/c/c8.c b/src/c/c8.c new file mode 100644 index 00000000..0d7e506c --- /dev/null +++ b/src/c/c8.c @@ -0,0 +1,345 @@ +# include "cc.h" + +/* + + C Compiler + Phase S: Symbol Table Dumper + + Copyright (c) 1977 by Alan Snyder + + uses c93.c c95.c + +*/ + +/* special type values */ + +extern type TCHAR; +extern type TINT; +extern type TFLOAT; +extern type TDOUBLE; +extern type TLONG; +extern type TUNSIGNED; +extern type TUNDEF; +extern type TPCHAR; +extern type TACHAR; +extern type TFINT; + +/* dictionary */ + +struct _dentry /* dictionary entry */ + {int name; /* the identifier, struct types stored +cssiz */ + type dtype; /* data type */ + int offset; /* addressing info */ + int class; /* storage class */ + }; + +# define dentry struct _dentry + +type typscan(); +type to2p(); +int *ro2p(); + +int debug; + +char cstore[cssiz]; +char *fn_cstore; /* cstore file name */ +char *fn_symtab; +char *fn_typtab; + +/* DICTIONARY */ + +dentry dict [stsize], + *dbegin {dict}, /* first entry */ + *dgdp {dict}, /* entry following defs */ + *dend; /* following last entry */ + +/* special type values */ + +type TCHAR; +type TINT; +type TFLOAT; +type TDOUBLE; +type TLONG; +type TUNSIGNED; +type TUNDEF; +type TPCHAR; +type TACHAR; +type TFINT; + +/* type table */ + +int typtab[TTSIZE]; +int *ctypp, *crecp, *etypp; + +main (argc, argv) + char *argv[]; + + {extern int cout; + int fout; + + --argc; + ++argv; + + if (argc > 0) fn_cstore = argv[0]; + else fn_cstore = "0.cs"; + if (argc > 1) fn_typtab = argv[1]; + else fn_typtab = "0.ty"; + if (argc > 2) fn_symtab = argv[2]; + else fn_symtab = "0.sy"; + if (argc > 3) fout = copen (argv[3], 'w'); + else fout = -1; + if (fout == -1) fout = cout; + if (argc < 4) debug = TRUE; + rcstore (); + rtyptab (); + typcinit (); + psymtab (fout); + if (debug) ptypes (fout); + cclose (fout); + } + +psymtab (fout) + + {int name, f; + + dend = dbegin + stsize; + f = xopen (fn_symtab, MREAD, BINARY); + do + {name = geti (f); + rdict (f); + pdict (name, fout); + } + while (name != UNDEF); + cclose (f); + } + +pdict (name, fout) + + {dentry *dp, *p1, *p2; + int incr; + + if (name == UNDEF) + {cprint (fout, "\n --- GLOBAL SYMBOL TABLE --- \n"); + p1 = dbegin; + p2 = dgdp; + incr = 1; + } + else + {cprint (fout, "\n --- LOCAL SYMBOL TABLE FOR FUNCTION "); + pridn (name, fout); + cprint (fout, " --- \n"); + p1 = dgdp-1; + p2 = dbegin-1; + incr = -1; + } + + dp = p1; + while (dp != p2) + {if (debug || dp->name < cssiz) + {cprint (fout, "\t"); + pridn (dp->name, fout); + cprint (fout, ": "); + prclass (dp->class, fout); + cprint (fout, " "); + typrint (dp->dtype, fout); + if (debug) cprint (fout, " %d", dp->offset); + cprint (fout, "\n"); + } + dp =+ incr; + } + } + +ptypes (fout) + + {int *p; + extern int typtab[], *ctypp; + + cprint (fout, "\n --- TYPE TABLE --- \n"); + p = typtab; + while (p < ctypp) + {cprint (fout, "%5d: tag=%2d sz=%4d al=%2d ", + p, p[0], p[1], p[2]); + typrint (p, fout); + cprint (fout, "\n"); + p = typscan (p); + } + } + +pridn (name, f) + + {if (name>=cssiz) {name =- cssiz; cprint (f, ".");} + if (name < cssiz) prs (&cstore[name], f); + } + +prclass (class, f) + + {char *s; + + switch (class) { +case c_register: s = "register"; break; +case c_auto: s = "auto"; break; +case c_extdef: s = "extdef"; break; +case c_static: s = "static"; break; +case c_param: s = "parameter"; break; +case c_label: s = "label"; break; +case c_extern: s = "extern"; break; +case c_struct: s = "struct type ="; break; +case c_typedef: s = "type ="; break; +case c_ustruct: s = "undefined struct type"; break; +case c_ulabel: s = "undefined label"; break; +default: s = "class[%d]"; + } + cprint (f, s, class); + } + +int typnval[] {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 1, 1}; +int typform[] {0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 2, 3, 4, 1}; + +typcinit () {;} + +typedesc *typscan (p) + typedesc *p; + + {return (&(p->val) + typnval[p->tag]);} + +typrint (t, f) + type t; + + {switch (t->tag) { + case TTCHAR: cprint (f, "char"); return; + case TTINT: cprint (f, "int"); return; + case TTFLOAT: cprint (f, "float"); return; + case TTDOUBLE: cprint (f, "double"); return; + case TTLONG: cprint (f, "long"); return; + case TTUNSIGNED: cprint (f, "unsigned"); return; + case TTCFIELD: cprint (f, "char[%d]", t->val); return; + case TTIFIELD: cprint (f, "int[%d]", t->val); return; + case TTUNDEF: cprint (f, "undefined"); return; + case TTPTR: cprint (f, "*"); typrint (t->val, f); + return; + case TTFUNC: cprint (f, "()"); typrint (t->val, f); + return; + case TTARRAY: cprint (f, "[%d]", t->nelem); + typrint (t->val, f); return; + case TTSTRUCT: prstruct (t, f); break; + default: cprint (f, "?"); + } + } + +prstruct (t, f) + type t; + + {register field *fp; + static int level; + + ++level; + if (level > 1) cprint (f, "struct#%d", t); + else + {fp = t->val; + cprint (f, "{"); + while (fp->name != UNDEF) + {pridn (fp->name, f); + cprint (f, ":"); + typrint (fp->dtype, f); + if ((++fp)->name != UNDEF) cprint (f, ","); + } + cprint (f, "}"); + } + --level; + } + +/********************************************************************** + + RDICT - Read Dictionary + + Read Dictionary from file F. + +**********************************************************************/ + +rdict (f) + + {int name; + + dgdp = dbegin; + while (TRUE) + {name = geti (f); + if (name == UNDEF || ceof (f)) return; + if (dgdp >= dend) errx (4005); + dgdp->name = name; + dgdp->dtype = to2p (geti (f)); + dgdp->offset = geti (f); + dgdp->class = geti (f); + ++dgdp; + } + } + +/********************************************************************** + + RTYPTAB - Read Type Table + +**********************************************************************/ + +rtyptab () + + {extern int typtab[], *ctypp, *crecp, *etypp, typform[]; + register int *p, fmt; + register field *fp; + int f; + + f = xopen (fn_typtab, MREAD, BINARY); + etypp = typtab + TTSIZE; + ctypp = typtab + geti (f); + p = typtab; + while (p < ctypp) + {fmt = typform[*p++ = geti (f)]; + *p++ = geti (f); + *p++ = geti (f); + switch (fmt) { + case 1: *p++ = geti (f); break; + case 2: *p++ = to2p (geti (f)); break; + case 3: *p++ = to2p (geti (f)); + *p++ = geti (f); + break; + case 4: *p++ = ro2p (geti (f)); break; + } + } + crecp = etypp - geti (f); + p = crecp; + while (p < etypp) + {fp = p; + fp->name = geti (f); + if (fp->name == UNDEF) ++p; + else + {fp->dtype = to2p (geti (f)); + fp->offset = geti (f); + p = fp+1; + } + } + cclose (f); + } + +type to2p (i) int i; + + {extern int typtab[], *ctypp; + + if (i < 0 || i >= TTSIZE) errx (6006); + return (typtab + i); + } + +int *ro2p (i) int i; + + {extern int *etypp; + + if (i < 0 || i >= TTSIZE) errx (6047); + return (etypp - i); + } + +errx (n) + {cprint ("Table format error %d\n", n); + if (n>=4000) cexit(-1); + } + +char *fn_error; +int f_error; +cleanup () {cexit (0);} + \ No newline at end of file diff --git a/src/c/c91.c b/src/c/c91.c new file mode 100644 index 00000000..f9867edb --- /dev/null +++ b/src/c/c91.c @@ -0,0 +1,478 @@ +# include "cc.h" + +/* + + C Compiler + Routines common to phases P and C + + Copyright (c) 1977 by Alan Snyder + + ctype + remarr + mprint + mprd + align + +*/ + +/********************************************************************** + + CTYPE - convert type to CTYPE + +**********************************************************************/ + +int ctype (t) type t; + + {extern int tpoint[], talign[], ntype; + extern type TINT; + extern type remarr(); + int ac, tag; + + if (t->tag == TTFUNC) t = t->val; + switch (t->tag) { + +case TTCHAR: return (ct_char); +case TTINT: return (ct_int); +case TTFLOAT: return (ct_float); +case TTDOUBLE: return (ct_double); +case TTSTRUCT: return (ct_struct); +case TTPTR: t = remarr (t->val); + switch (t->tag) { + case TTCHAR: + case TTFLOAT: + case TTDOUBLE: break; + case TTSTRUCT: ac = t->align; + for (tag=0;tagtag]); + } + return (ct_bad); + } + +/********************************************************************** + + REMARR - remove "array of ..." modifiers from type + +**********************************************************************/ + +type remarr (t) type t; + + {while (t->tag == TTARRAY) t = t->val; + return (t); + } + +/********************************************************************** + + MPRINT - Macro Printing Routine + +**********************************************************************/ + +mprint (s,x1,x2,x3,x4,x5,x6,x7) char *s; + + {int *p; /* argument pointer */ + int c; /* current character */ + extern int f_mac; + + p = &x1; + while (c = *s++) + {if (c == '*') mprd (*p++); + else cputc (c, f_mac); + } + } + +/********************************************************************** + + MPRD - Print Decimal Integer + +**********************************************************************/ + +mprd (i) + + {extern int f_mac; + int b[30], *p, a; + + if (i < 0) + {i = -i; + if (i < 0) + {mprint (SMALLEST); + return; + } + cputc ('-', f_mac); + } + + p = b; + while (a = i/10) + {*p++ = i%10 + '0'; + i = a; + } + + cputc (i + '0', f_mac); + while (p > b) cputc (*--p, f_mac); + } + +/********************************************************************** + + ALIGN - align integer according to alignment class + +**********************************************************************/ + +int align (i, ac) + + {int r, a; + extern int calign[]; + + a = calign[ac]; + if (r = (i % a)) return (i + (a - r)); + return (i); + } + +/********************************************************************** + + TYPES + + Representation: + + A type is represented by a pointer to a descriptor, + stored in TYPTAB. There are a fixed number + of classes of types, distinguished by a tag value. + The descriptor also contains the size and the alignment + class of objects of the type. The format of the remainder + of the descriptor is dependent upon the tag: + + fields: the size in bits + pointers: the pointed-to type + functions: the returned type + arrays: the element type, the number of elements + structs: a pointer to a sequence of field definitions, + terminated by an UNDEF name + dummy structs: the name of the structure type + others: nothing + + Types not involving structures are uniquely represented. + The notion of equality of types is complex where recursive + structure definitions are involved; luckily, the concept + is unnecessary in C. The structure field lists are + allocated from the end of TYPTAB. + + Operations: + + typinit () initialize type data base + typcinit () initialize type constants + mkptr (T) => T make pointer type + mkfunc (T) => T make function type + mkarray (T, N) => T make array type + mkcfield (N) => T make char field type + mkifield (N) => T make int field type + typrint (T, f) print description of type + + In c22: + + mkstruct (n, F[n]) => T make structure type + mkdummy (name) => T make dummy structure type + fixdummy (T, n, F[n]) complete structure definition + wtyptab (f) write type table + tp2o (T) => I cvt type to integer offset + + In c34: + + rtyptab (f) read type table + to2p (I) => T cvt offset to type pointer + + Internal Operations: + + mktype (tag, V[]) => T make type from tag and + extra values + typequal (tag, V[], T) => B compare type descriptors + typscan (T) => T return "next" type descriptor + typadd (tag, V[]) => T add non-struct type to table + typxh (w) => T append word to type table + recxl (w) => *I append word to field list + fixtype (T) => T compute size and alignment + fixbtype (T, tag) compute for basic type + fixstr (T) compute for structure type + prstruct (T, f) print structure type + +**********************************************************************/ + +extern int tsize[], talign[]; + +/********************************************************************** + + Format tables: + + NVAL - number of extra descriptor values for each tag + FORM - format number describing format of extra values: + 0 - no extra values + 1 - integer + 2 - type + 3 - type, integer + 4 - fieldlist + +**********************************************************************/ + +int typnval[] {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 1, 1}; +int typform[] {0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 2, 3, 4, 1}; + +/* special type values */ + +type TCHAR; +type TINT; +type TFLOAT; +type TDOUBLE; +type TLONG; +type TUNSIGNED; +type TUNDEF; +type TPCHAR; +type TACHAR; +type TFINT; + +/* type table */ + +int typtab[TTSIZE]; +int *ctypp, *crecp, *etypp; + +/********************************************************************** + + OPERATIONS + +**********************************************************************/ + +type mkptr(); +type mkfunc(); +type mkarray(); +type mktype(); +type typscan(); +type typadd(); +type typxh(); +type fixtype(); + +typinit () + + {ctypp = typtab; + crecp = etypp = typtab+TTSIZE; + typcinit (); + } + +typcinit () + + {TCHAR = mktype (TTCHAR); + TINT = mktype (TTINT); + TFLOAT = mktype (TTFLOAT); + TDOUBLE = mktype (TTDOUBLE); + TLONG = mktype (TTLONG); + TUNSIGNED = mktype (TTUNSIGNED); + TUNDEF = mktype (TTUNDEF); + TPCHAR = mkptr (TCHAR); + TACHAR = mkarray (TCHAR, 1); + TFINT = mkfunc (TINT); + } + +type mkptr (t) type t; + {return (mktype (TTPTR, &t));} + +type mkfunc (t) type t; + + {switch (t->tag) { + case TTCHAR: t = TINT; break; + case TTFLOAT: t = TDOUBLE; break; + case TTFUNC: + case TTARRAY: + case TTSTRUCT: + case TTDUMMY: errcidn (1004); + t = mkptr (t); + break; + } + return (mktype (TTFUNC, &t)); + } + +type mkarray (t, n) type t; + {return (mktype (TTARRAY, &t));} + +type mkcfield (n) + {return (mktype (TTCFIELD, &n));} + +type mkifield (n) + {return (mktype (TTIFIELD, &n));} + +type mktype (tag, v) + int v[]; + + {register typedesc *p; /* pointer to current type in table */ + + p = typtab; + while (p < ctypp) + {if (typequal (tag, v, p)) return (p); + p = typscan (p); + } + return (typadd (tag, v)); + } + +int typequal (tag, v, p) + int tag, v[]; + typedesc *p; + + {register int *pv; + + if (tag != p->tag) return (FALSE); + pv = &(p->val); + switch (typnval[tag]) { + case 2: if (v[1] != pv[1]) return (FALSE); + case 1: if (v[0] != pv[0]) return (FALSE); + default: return (TRUE); + } + } + +typedesc *typscan (p) + typedesc *p; + + {return (&(p->val) + typnval[p->tag]);} + +type typadd (tag, v) + int v[]; + + {register type t; /* the new type created */ + register int n; /* number of extra values */ + + t = typxh (tag); + typxh (-1); /* size not known yet */ + typxh (0); /* "default" alignment class */ + n = typnval[tag]; + while (--n>=0) typxh (*v++); + if (tag == TTFUNC) t->size = 0; /* avoid spurious errmsg */ + t = fixtype (t); + if (tag == TTFUNC) t->size = -1; + return (t); + } + +typedesc *typxh (w) + int w; + + {if (ctypp < crecp) + {*ctypp = w; + return (ctypp++); + } + errx (4006); + } + +int *recxl (w) + int w; + + {if (crecp > ctypp) + {*--crecp = w; + return (crecp); + } + errx (4006); + } + +type fixtype (t) type t; + + {register int tag; + register type et; + + if (t->size < 0) switch (tag = t->tag) { + +case TTCFIELD: fixbtype (t, TTCHAR); + break; + +case TTLONG: +case TTUNSIGNED: +case TTIFIELD: +case TTPTR: fixbtype (t, TTINT); + break; + +case TTCHAR: +case TTINT: +case TTFLOAT: +case TTDOUBLE: fixbtype (t, tag); + break; + +case TTUNDEF: t->size = 0; + t->align = 0; + break; + +case TTFUNC: errcidn (1005); + return (mkptr (t)); + +case TTARRAY: t->val = et = fixtype (t->val); + t->size = t->nelem*et->size; + t->align = et->align; + break; + +case TTDUMMY: errx (2040, TIDN, t->val); + return (mkptr (t)); + +case TTSTRUCT: if (t->size == -2) + {errcidn (2019); + return (mkptr (t)); + } + fixstr (t); + break; + +default: errx (6014); + } + return (t); + } + +fixbtype (t, tag) + type t; + + {t->size = tsize[tag]; + t->align = talign[tag]; + } + +# ifndef SCRIMP + +typrint (t, f) + type t; + + {switch (t->tag) { + case TTCHAR: cprint (f, "char"); return; + case TTINT: cprint (f, "int"); return; + case TTFLOAT: cprint (f, "float"); return; + case TTDOUBLE: cprint (f, "double"); return; + case TTLONG: cprint (f, "long"); return; + case TTUNSIGNED: cprint (f, "unsigned"); return; + case TTCFIELD: cprint (f, "char[%d]", t->val); return; + case TTIFIELD: cprint (f, "int[%d]", t->val); return; + case TTUNDEF: cprint (f, "undefined"); return; + case TTPTR: cprint (f, "*"); typrint (t->val, f); + return; + case TTFUNC: cprint (f, "()"); typrint (t->val, f); + return; + case TTARRAY: cprint (f, "[%d]", t->nelem); + typrint (t->val, f); return; + case TTSTRUCT: prstruct (t, f); break; + default: cprint (f, "?"); + } + } + +prstruct (t, f) + type t; + + {register field *fp; + static int level; + + ++level; + if (level > 1) cprint (f, "struct#%d", t); + else + {fp = t->val; + cprint (f, "{"); + while (fp->name != UNDEF) + {pridn (fp->name, f); + cprint (f, ":"); + typrint (fp->dtype, f); + if ((++fp)->name != UNDEF) cprint (f, ","); + } + cprint (f, "}"); + } + --level; + } + +pridn (i, f) {;} + +# endif + + \ No newline at end of file diff --git a/src/c/c92.c b/src/c/c92.c new file mode 100644 index 00000000..569866d2 --- /dev/null +++ b/src/c/c92.c @@ -0,0 +1,27 @@ +# include "cc.h" + +/* + + C Compiler + Routines common to phases L and M + + Copyright (c) 1977 by Alan Snyder + + stcmp + +*/ + + +/********************************************************************** + + STCMP - Compare Strings + +**********************************************************************/ + +int stcmp (s1, s2) char *s1, *s2; + + {register int u; + while ((u = *s1++) == *s2++) if (!u) return (TRUE); + return (FALSE); + } + diff --git a/src/c/c94.c b/src/c/c94.c new file mode 100644 index 00000000..0068ef26 --- /dev/null +++ b/src/c/c94.c @@ -0,0 +1,46 @@ +# include "cc.h" + +/* + + C Compiler + Routines common to phases C and M + + Copyright (c) 1977 by Alan Snyder + + atoi + +*/ + + +/********************************************************************** + + ATOI - convert string to integer + + This routine performs special hacks in case the number is --X, + where -X is the smallest negative number. The result in + this case will be off by one, but at least the sign and + approximate magnitude will be right. Hopefully, whatever + stupid user-written macro results in this condition is only + looking for relatively small integers. + +**********************************************************************/ + +int atoi (s) char s[]; + + {int i, sign, c; + + if (!s) return (0); + i = 0; + sign = 1; + while (*s == '-') {++s; sign = -sign;} + while ((c = *s++)>='0' && c<='9') i = i*10 + c-'0'; + if (i<0) + {i = -i; + if (i<0) + if (sign>0) return (-(i+1)); + else return (i); + } + return (sign*i); + } + + \ No newline at end of file diff --git a/src/c/c95.c b/src/c/c95.c new file mode 100644 index 00000000..03687751 --- /dev/null +++ b/src/c/c95.c @@ -0,0 +1,71 @@ +# include "cc.h" + +/* + + C Compiler + Routines common to phases L, P, C, M + + Copyright (c) 1977 by Alan Snyder + + error + xopen + +*/ + +/********************************************************************** + + ERROR - C Compiler Error Message Writer + + Append an error record on the error file, f_error. + If the error is a fatal error (error number >= 4000) + call the cleanup routine to exit. + +**********************************************************************/ + +int maxerr 0; + +error (errno, p1, p2, p3, p4, p5, p6) + + {extern int f_error; + extern char *fn_error; + int i, *ip; + + if (errno > maxerr) maxerr = errno; + if (f_error == -1) + f_error = xopen (fn_error, MAPPEND, BINARY); + ip = &errno; + for (i=0;i<7;i++) puti (*ip++, f_error); + if (errno >= 4000) cleanup (1); + } + + +/********************************************************************** + + XOPEN - Open File with Error Detection + + open file given + + file - name of file + mode - mode of file + opt - string of system-dependent options + + If unable to open print a message and exit. + Otherwise, return the file number. + +**********************************************************************/ + +int xopen (file, mode, opt) + char *file, *opt; + int mode; + + {int i; + + i = copen (file, mode, opt); + if (i == OPENLOSS) + {cprint ("Unable to open '%s'.\n", file); + cexit (100); + } + return (i); + } + + \ No newline at end of file diff --git a/src/c/cmac.ins b/src/c/cmac.ins new file mode 100644 index 00000000..28061006 --- /dev/null +++ b/src/c/cmac.ins @@ -0,0 +1,414 @@ +; +; PDP-10 ITS IMPLEMENTATION OF CMAC MACHINE +; +; ALAN SNYDER +; 17 APRIL 1977 +; + +; C EXTERNAL VARIABLE NAMES ARE PREFIXED WITH "Z" IN ORDER +; TO AVOID CONFLICTS WITH STANDARD SYMBOLS + +; STATIC VARIABLES ARE REFERENCED BY SYMBOLS OF THE FORM +; I1234. STRING LITERALS ARE REFERENCED BY SYMBOLS OF THE +; FORM S1234. INTERNAL LABELS ARE IMPLEMENTED USING SYMBOLS +; OF THE FORM L1234. + +RELOCATABLE +.MLLIT==1 + +A==1 ; "A" REGISTER +B==2 ; "B" REGISTER +T==3 ; SCRATCH REGISTER +L==14 ; STACK FRAME POINTER +M==15 ; PARAMETER LIST POINTER +P==17 ; STACK TOP POINTER + +RADIX 10. + +; STUFF FOR STATISTICS GATHERING + +%MOVE==0 ; COUNT OF MOVE INSTRUCTIONS +%OPR==0 ; COUNT OF OPERATE INSTRUCTIONS +%JUMP==0 ; COUNT OF CONDITIONAL JUMP INSTRUCTIONS +%CONT==0 ; COUNT OF CONTROL INSTRUCTIONS +%KEY==0 ; COUNT OF MISCELLANEOUS KEYWORD MACROS +%DATA==0 ; SIZE OF STATIC DATA AREA + +DEFINE INFORM A,B +IF2,[ PRINTX / A = B +/] + TERMIN + +; END OF STATISTICS STUFF + +DEFINE LAUTO R,OFFSET ; LOAD AUTO VARIABLE +%MOVE==%MOVE+1 + MOVE R,OFFSET(L) + TERMIN + +DEFINE LEXTRN R,NAME ; LOAD EXTERNAL VARIABLE +%MOVE==%MOVE+1 + MOVE R,Z!NAME + TERMIN + +DEFINE LSTAT R,N ; LOAD STATIC VARIABLE +%MOVE==%MOVE+1 + MOVE R,I!N + TERMIN + +DEFINE LLIT R,N ; LOAD INTEGER LITERAL +%MOVE==%MOVE+1 + MOVE R,[!N!] + TERMIN + +DEFINE LPARM R,N ; LOAD PARAMETER +%MOVE==%MOVE+1 + MOVE R,N(M) + TERMIN + +DEFINE LVPTR R1,R2 ; LOAD VIA POINTER +%MOVE==%MOVE+1 + MOVE R1,(R2) + TERMIN + +DEFINE LREG R1,R2 ; LOAD FROM REGISTER +%MOVE==%MOVE+1 + MOVE R1,R2 + TERMIN + +DEFINE STAUTO R,OFFSET ; STORE INTO AUTO VARIABLE +%MOVE==%MOVE+1 + MOVEM R,OFFSET(L) + TERMIN + +DEFINE STEXTN R,NAME ; STORE INTO EXTERNAL VARIABLE +%MOVE==%MOVE+1 + MOVEM R,Z!NAME + TERMIN + +DEFINE STSTAT R,N ; STORE INTO STATIC VARIABLE +%MOVE==%MOVE+1 + MOVEM R,I!N + TERMIN + +DEFINE STPARM R,N ; STORE INTO PARAMETER +%MOVE==%MOVE+1 + MOVEM R,N(M) + TERMIN + +DEFINE STVPTR R1,R2 ; STORE VIA POINTER +%MOVE==%MOVE+1 + MOVEM R1,(R2) + TERMIN + +DEFINE LAAUTO R,OFFSET ; LOAD ADDRESS OF AUTO VARIABLE +%MOVE==%MOVE+1 + MOVEI R,OFFSET(L) + TERMIN + +DEFINE LAEXTN R,NAME ; LOAD ADDRESS OF EXTERNAL VARIABLE +%MOVE==%MOVE+1 + MOVEI R,Z!NAME + TERMIN + +DEFINE LASTAT R,N ; LOAD ADDRESS OF STATIC VARIABLE +%MOVE==%MOVE+1 + MOVEI R,I!N + TERMIN + +DEFINE LAPARM R,N ; LOAD ADDRESS OF PARAMETER +%MOVE==%MOVE+1 + MOVEI R,N(M) + TERMIN + +DEFINE LASTRG R,N ; LOAD ADDRESS OF STRING LITERAL +%MOVE==%MOVE+1 + MOVEI R,S!N + TERMIN + +DEFINE CMINUS R ; ARITHMETIC MINUS +%OPR==%OPR+1 + MOVN R,R + TERMIN + +DEFINE CNOT R ; BITWISE NEGATION +%OPR==%OPR+1 + SETCA R, + TERMIN + +DEFINE CADD ; INTEGER ADDITION +%OPR==%OPR+1 + ADD A,B + TERMIN + +DEFINE CSUB ; INTEGER SUBSTRACTION +%OPR==%OPR+1 + SUB A,B + TERMIN + +DEFINE CMUL ; INTEGER MULTIPLICATION +%OPR==%OPR+1 + IMUL A,B + TERMIN + +DEFINE CDIV ; INTEGER DIVISION +%OPR==%OPR+1 + MOVE T,B + IDIV A,B + MOVE B,T + TERMIN + +DEFINE CMOD ; INTEGER REMAINDER +%OPR==%OPR+1 + MOVE T,B + IDIV A,B + MOVE A,B + MOVE B,T + TERMIN + +DEFINE CLS ; LEFT SHIFT +%OPR==%OPR+1 + LSH A,(B) + TERMIN + +DEFINE CRS ; RIGHT SHIFT +%OPR==%OPR+1 + MOVN T,B + LSH A,(T) + TERMIN + +DEFINE CAND ; BITWISE AND +%OPR==%OPR+1 + AND A,B + TERMIN + +DEFINE COR ; BITWISE OR +%OPR==%OPR+1 + IOR A,B + TERMIN + +DEFINE CXOR ; BITWISE XOR +%OPR==%OPR+1 + XOR A,B + TERMIN + +DEFINE PINC ; POINTER INCREMENT +%OPR==%OPR+1 + ADD A,B + TERMIN + +DEFINE PDEC ; POINTER DECREMENT +%OPR==%OPR+1 + SUB A,B + TERMIN + +DEFINE PSUB ; POINTER SUBTRACT +%OPR==%OPR+1 + SUB A,B + TERMIN + +DEFINE JNULL N ; JUMP IF NULL POINTER +%JUMP==%JUMP+1 + JUMPE A,L!N + TERMIN + +DEFINE JNNULL N ; JUMP IF NON-NULL POINTER +%JUMP==%JUMP+1 + JUMPN A,L!N + TERMIN + +DEFINE JEQ N ; JUMP IF EQUAL +%JUMP==%JUMP+1 + CAMN A,B + JRST L!N + TERMIN + +DEFINE JNE N ; JUMP IF NOT EQUAL +%JUMP==%JUMP+1 + CAME A,B + JRST L!N + TERMIN + +DEFINE JLT N ; JUMP IF LESS THAN +%JUMP==%JUMP+1 + CAMGE A,B + JRST L!N + TERMIN + +DEFINE JGT N ; JUMP IF GREATER THAN +%JUMP==%JUMP+1 + CAMLE A,B + JRST L!N + TERMIN + +DEFINE JLE N ; JUMP IF LESS THAN OR EQUAL +%JUMP==%JUMP+1 + CAMG A,B + JRST L!N + TERMIN + +DEFINE JGE N ; JUMP IF GREATER THAN OR EQUAL +%JUMP==%JUMP+1 + CAML A,B + JRST L!N + TERMIN + +DEFINE HEAD ; HEADER MACRO +%KEY==%KEY+1 + TERMIN + +DEFINE CEND ; END MACRO +%KEY==%KEY+1 + INFORM [TOTAL NO. OF INSTRUCTIONS]\%MOVE+%OPR+%JUMP+%CONT + INFORM [STATIC DATA AREA]\%DATA + INFORM [NO. OF MOVE INSTRUCTIONS]\%MOVE + INFORM [NO. OF OPERATE INSTRUCTIONS]\%OPR + INFORM [NO. OF CONDITIONAL JUMPS]\%JUMP + INFORM [NO. OF OTHER CONTROL INSTRUCTIONS]\%CONT + INFORM [NO. OF OTHER KEYWORD MACROS]\%KEY + END + TERMIN + +DEFINE CENTRY NAME ; DECLARE ENTRY NAME +%KEY==%KEY+1 + .GLOBAL Z!NAME + TERMIN + +DEFINE CEXTRN NAME ; DECLARE EXTERNAL NAME +%KEY==%KEY+1 + .GLOBAL Z!NAME + TERMIN + +DEFINE PURE ; BEGIN PURE STUFF +%KEY==%KEY+1 + TERMIN + +DEFINE IMPURE ; BEGIN IMPURE STUFF +%KEY==%KEY+1 + TERMIN + +DEFINE CEQU NAME ; DEFINE EXTERNAL SYMBOL +%KEY==%KEY+1 +Z!NAME: +TERMIN + +DEFINE LABDEF N ; DEFINE LABEL +%KEY==%KEY+1 +L!N: +TERMIN + +DEFINE STATIC N ; DEFINE STATIC VARIABLE +%KEY==%KEY+1 +I!N: +TERMIN + +DEFINE STRDEF N ; DEFINE STRING CONSTANT +%KEY==%KEY+1 +S!N: +TERMIN + +DEFINE LINNUM N ; LINE NUMBER MACRO +%KEY==%KEY+1 + TERMIN + +DEFINE ADCON NAME ; DEFINE ADDRESS CONSTANT +%KEY==%KEY+1 +%DATA==%DATA+1 + Z!NAME + TERMIN + +DEFINE SADCON N ; DEFINE STATIC ADDRESS CONSTANT +%KEY==%KEY+1 +%DATA==%DATA+1 + I!N + TERMIN + +DEFINE INTCON I ; DEFINE INTEGER CONSTANT +%KEY==%KEY+1 +%DATA==%DATA+1 + I + TERMIN + +DEFINE LABCON N ; DEFINE LABEL CONSTANT +%KEY==%KEY+1 +%DATA==%DATA+1 + L!N + TERMIN + +DEFINE STRCON N ; DEFINE STRING CONSTANT +%KEY==%KEY+1 +%DATA==%DATA+1 + S!N + TERMIN + +DEFINE CZERO N ; DEFINE BLOCK OF ZEROES +%KEY==%KEY+1 +%DATA==%DATA+N + BLOCK N + TERMIN + +DEFINE PROLOG FNO,FNAME ; DEFINE FUNCTION PROLOG +%CONT==%CONT+1 +Z!FNAME: + PUSH P,L + PUSH P,M + MOVE M,A + HRRZI L,-3(P) + ADDI P,FS!FNO-1 + TERMIN + +DEFINE EPILOG FNO,FSIZ ; DEFINE FUNCTION EPILOG +%CONT==%CONT+1 + JRST EPILG" ; USE AUX ROUTINE + FS!FNO==FSIZ ; MAKE SYMBOL FOR PROLOG + TERMIN + +DEFINE CCALL NARGS,ARGP,NAME ; CALL FUNCTION +%CONT==%CONT+1 + HRRZI A,ARGP(L) ; SET UP ARG PTR + HRLI A,-NARGS ; SET UP NARGS + PUSHJ P,Z!NAME ; DO THE CALL + TERMIN + +DEFINE CALREG NARGS,ARGP,REG ; CALL FUNCTION VIA POINTER +%CONT==%CONT+1 + MOVE T,REG + HRRZI A,ARGP(L) ; SET UP ARG PTR + HRLI A,-NARGS ; SET UP NARGS + PUSHJ P,(T) ; DO THE CALL + TERMIN + +DEFINE CRETRN ; RETURN +%CONT==%CONT+1 + JRST EPILG" + TERMIN + +DEFINE CGOTO N ; UNCONDITIONAL JUMP +%CONT==%CONT+1 + JRST L!N + TERMIN + +DEFINE LSWITCH N,DEFLT ; LIST SWITCH +%CONT==%CONT+1 + MOVE T,[-N,,.+5] + CAMN A,(T) + JRST @N(T) + AOBJN T,.-2 + JRST L!DEFLT + TERMIN + +DEFINE ELSWIT N,DEFLT + TERMIN + +DEFINE TSWITCH LO,HI,DEFLT ; TABLE SWITCH +%CONT==%CONT+1 + SUB A,[LO] + JUMPL A,L!DEFLT + CAILE A,HI-LO + JRST L!DEFLT + JRST @.+1(A) + TERMIN + +DEFINE ETSWIT LO,HI,DEFLT + TERMIN + \ No newline at end of file diff --git a/src/c/cnlen.h b/src/c/cnlen.h new file mode 100644 index 00000000..3969d3d5 --- /dev/null +++ b/src/c/cnlen.h @@ -0,0 +1,11 @@ + 1,1,4,2,2,2,3,3,2,2, + 2,2,2,2,2,2,2,3,3,3, + 3,3,3,3,3,3,3,3,3,3, + 3,3,3,3,3,3,3,3,3,3, + 3,3,3,3,3,3,3,3,3,2, + 1,1,1,1,1,1,1,1,1,1, + 1,1,1,1,1,1,1,1,1,1, + 1,1,1,1,1,1,1,1,1,1, + 5,3,2,3,3,5,4,3,3,6, + 3,3,1,1 + \ No newline at end of file diff --git a/src/c/expr2.gra b/src/c/expr2.gra new file mode 100644 index 00000000..a33a5283 --- /dev/null +++ b/src/c/expr2.gra @@ -0,0 +1,18 @@ +'+' '-' '*' '/' '(' ')' int + +\< '+' '-' +\< '*' '/' + +\\ + +s: e {printf (1, "%d\n",#1);} +e: e '+' e {val = #1 + #3;} + | e '-' e {val = #1 - #3;} + | e '*' e {val = #1 * #3;} + | e '/' e {val = #1 / #3;} + | p + +p: '-' p {val = - #2;} + | '(' e ')' {val = #2;} + | int + \ No newline at end of file diff --git a/src/c/instll.tec b/src/c/instll.tec new file mode 100644 index 00000000..6f208223 --- /dev/null +++ b/src/c/instll.tec @@ -0,0 +1,53 @@ +! TECO macro to install the output of GT into the + source of the C compiler -- start with GT output + in the buffer -- writes files c26.c, c35.c, and + c43.c ! + +[3 [4 [5 [6 + +j sint ntype 0l x5 +j sint nac 0l x6 +j sint sv_area_sz 0l ^fx6 +j schar mcstuff 0l .,zx2 z-.d hx3 +j sint spoint 0l z-.d +j sint tsize 0l -.d +j sint tpoint 0l .u4 +j sint retreg 0l .,q4k zj g5 g6 hx4 + +hk g3 + +ji +/* + + C COMPILER + Phase C: Code Generator + Section 5: Machine Description Tables + +*/ + + +eipwefc35 c +hk g2 +ji +/* + + C COMPILER + Phase M: Macro Expansion + Section 3: Machine Description Tables + +*/ + +eipwef c43 c +hk g4 +ji/* + + C COMPILER + Phase P: Parser + Section 6: Machine Description Tables + +*/ + +eipwef c26 c + +]6 ]5 ]4 ]3 + \ No newline at end of file diff --git a/src/c/lp.stinkr b/src/c/lp.stinkr new file mode 100644 index 00000000..6bf1b724 Binary files /dev/null and b/src/c/lp.stinkr differ diff --git a/src/c/m.stinkr b/src/c/m.stinkr new file mode 100644 index 00000000..05f09f10 Binary files /dev/null and b/src/c/m.stinkr differ diff --git a/src/c/tcc.c b/src/c/tcc.c new file mode 100644 index 00000000..60540a2b --- /dev/null +++ b/src/c/tcc.c @@ -0,0 +1,343 @@ +# include "cc.h" + +/* + + C Compiler + Test C Compiler Command Routine (for CMAC Versions) + + + Command format: + + cc {option ...} name1.c name2.c ... + + Options: + + d=xxx set compiler debugging argument to xxx + k= keep intermediate files around + s= produce listing of symbol table + + Meaningful debugging arguments: + + a debug code generator + d debug parser + e debug parser error recovery + m debug macro expander + + +*/ + +/* renamings to allow long names */ + +# define construct_output_file_names cnsofn +# define execute_phase execph +# define process_options proopt +# define process_equal_option proeq + +# define p_argc phsac +# define p_argv phsav + +# define argv_L avl +# define argv_LP avlp +# define argv_P avp +# define argv_C avc +# define argv_M avm +# define argv_E ave +# define argv_S avs + +/* intermediate file names */ + +# define fncs "0.cstore" +# define fner "0.error" +# define fnhm "0.hmac" +# define fnma "0.mac" +# define fnno "0.node" +# define fnst "0.string" +# define fnsy "0.symtab" +# define fnto "0.token" +# define fnty "0.typtab" + +/* options */ + +char debug[40]; +int kflag, sflag; + +/* phase information */ + +# define nphase 7 + +# define p_L 0 +# define p_LP 1 +# define p_P 2 +# define p_C 3 +# define p_M 4 +# define p_E 5 +# define p_S 6 + +char *p_name[] {"L", "LP", "P", "C", "M", "E", "S"}; +char *p_prog[] {"/dsk/c/_l-cm.tbin", + "/dsk/c/_lp-cm.tbin", + "/dsk/c/_p-cm.tbin", + "/dsk/c/_c-cm.tbin", + "/dsk/c/_m-cm.tbin", + "/dsk/c/_e-cm.tbin", + "/dsk/c/_s-cm.tbin"}; + +char *argv_L[] {debug, 0, fnto, fncs, fner, fnst}; +char *argv_LP[] {debug, 0, fnno, fnty, fner, fnma, fncs, fnst, fnhm, fnsy}; +char *argv_P[] {debug, fnto, fnno, fnty, fner, fnma, fnhm, fnsy}; +char *argv_C[] {debug, fner, fnno, fnty, fnma}; +char *argv_M[] {debug, 0, fncs, fner, fnma, fnst, fnhm}; +char *argv_E[] {debug, fner, fncs}; +char *argv_S[] {fncs, fnty, fnsy, 0}; + +char *p_argc[] {6, 10, 8, 5, 7, 3, 4}; +char **p_argv[] {argv_L, argv_LP, argv_P, argv_C, argv_M, + argv_E, argv_S}; + +# define file_name_size 30 + +/********************************************************************** + + DESCRIPTION OF EXTERNAL-DEFINED ROUTINES USED + + part of C compiler: + + perror - error message processor (if CALL_ERROR config) + cprint - formatted output (c96.c) + + standard C library: + + copen - open file for input/output + cclose - close file + + reasonably machine-independent: + + execv - execute program passing vector of args + (status returned through exccode) + delete - delete file + apfname - append new suffix to file name + +*/ + +/********************************************************************** + + THE MAIN PROGRAM + +**********************************************************************/ + +char *sconcat(); + +main (argc, argv) int argc; char *argv[]; + + {int snum, cc, f; + char *source; + char obj_name[file_name_size], sym_name[file_name_size]; + + --argc; + ++argv; + argc = process_options (argc, argv); + for (snum = 0; snum < argc; ++snum) + {source = argv[snum]; + + /* check that source file exists */ + + if ((f = copen (source, MREAD, TEXT)) == OPENLOSS) + {cprint ("Can't Find '%s'.\n", source); + continue; + } + cclose (f); + + cprint ("%s:\n", source); + + /* fix debug arg */ + + if (sflag) sconcat (debug, 2, debug, "s"); + + /* construct output file names from source file name */ + + construct_output_file_names (source, obj_name, sym_name); + + /* create empty ERROR file for phases to append to */ + + cclose (copen (fner, MWRITE, BINARY)); + + /* set the variable phase arguments */ + + argv_L[1] = source; + argv_LP[1] = source; + argv_M[1] = obj_name; + argv_S[3] = sym_name; + + /* now execute the phases */ + +# ifdef MERGE_LP + + cc = execute_phase (p_LP); + +# endif + +# ifndef MERGE_LP + + cc = execute_phase (p_L); + if (!cc) cc = execute_phase (p_P); + +# endif + + if (!cc) cc = execute_phase (p_C); + if (!cc) cc = execute_phase (p_M); + +# ifdef CALL_ERROR + + perror (fner, fncs); + +# endif + +# ifndef CALL_ERROR + + execute_phase (p_E); + +# endif + + if (sflag) execute_phase (p_S); + + if (!kflag) + {delete (fnto); + delete (fncs); + delete (fner); + delete (fnno); + delete (fnsy); + delete (fnma); + delete (fnhm); + delete (fnst); + delete (fnty); + } + } + } + +/********************************************************************** + + PROCESS_OPTIONS - Process options in command arguments + and remove options from argument list. + +**********************************************************************/ + +int process_options (argc, argv) + char *argv[]; + + {char *s, **ss, **dd; + int n, opt; + + kflag = sflag = FALSE; + dd = ss = argv; + n = 0; + while (--argc >= 0) + {s = *ss++; + if ((opt = s[0]) && s[1] == '=') + process_equal_option (opt, s+2); + else + {*dd++ = s; + ++n; + } + } + return (n); + } + +/********************************************************************** + + PROCESS_EQUAL_OPTION + +**********************************************************************/ + +process_equal_option (opt, s) + char *s; + + {char *r; + int c; + + switch (opt = lower (opt)) { + case 'd': r = debug; + while (c = *s++) *r++ = lower (c); + *r = 0; + return; + case 'k': kflag = TRUE; return; + case 's': sflag = TRUE; return; + default: cprint ("Unrecognized option: %c=%s\n", opt, s); + } + } + +/********************************************************************** + + CONSTRUCT_OUTPUT_FILE_NAME + + Construct output file names from source file name. + +**********************************************************************/ + +construct_output_file_names (source, obj_name, sym_name) + char *source, *obj_name, *sym_name; + + {apfname (obj_name, source, "MIDAS"); + apfname (sym_name, source, "SYMTAB"); + } + +/********************************************************************** + + EXECUTE PHASE + +**********************************************************************/ + +int execute_phase (n) int n; + + {extern int exccode; /* set by execv to phase return code */ + int c; + char *s; + + if (execv (p_prog[n], p_argc[n], p_argv[n])) + {cprint ("Unable to execute phase %s\n", p_name[n]); + return (-1); + } + s = p_name[n]; + while (c = *s++) cprint ("%c\n", c); + return (exccode); + } + +/********************************************************************** + + LOWER - Convert Character To Lower Case + +**********************************************************************/ + +int lower (c) + + {if (c >= 'A' && c <= 'Z') c =+ ('a' - 'A'); + return (c); + } + +/********************************************************************** + + SCONCAT - String Concatenate + + concatenate strings S1 ... Sn into buffer B + return B + +**********************************************************************/ + +char *sconcat (b, n, s1, s2, s3, s4, s5, s6, s7, s8) + char *b, *s1, *s2, *s3, *s4, *s5, *s6, *s7, *s8; + + {char **s, *p, *q; + int c; + + q = b; + s = &s1; + + while (--n >= 0) + {p = *s++; + while (c = *p++) *q++ = c; + } + + *q = 0; + return (b); + } + + \ No newline at end of file diff --git a/src/c/testc.c b/src/c/testc.c new file mode 100644 index 00000000..569926b5 --- /dev/null +++ b/src/c/testc.c @@ -0,0 +1,484 @@ +/* + + TESTC - Program to test C Compiler + + This program evokes all of the CMAC macros. + +*/ + +/********************************************************************** + + data for testing global data definition and initialization + +**********************************************************************/ + +int e1; +int e2 9; +int e3 {2*6}; +int e4[5] {0, 1, 2, 3, 4}; + +static int i1; +static int i2 -13; +static int i3 {4096}; +static int i4[5] {0, -1, -2, -3, -4}; + +char c1; +char c2 'a'; +char c3 {'b'}; +char c4[5] {'A', 'B', 'C', 'D', 'E'}; + +int *p1 {&i2}; +char *p2[2] {"foo", &c3}; +int *p3; + + +/********************************************************************** + + small functions for testing functions + +**********************************************************************/ + +int f1 (z) {return z+3;} +int f2 (x, y) {return x-y;} + +/********************************************************************** + + MAIN - control routine + +**********************************************************************/ + +main () + + {cprint ("C Testing Program.\n"); + tcond (); + tint (); + tincr (); + tbit (); + tclass (5, -9999); + tfunc (f1); + tswitch (); + cprint ("Done.\n"); + } + +error (i) + + {cprint ("*** Error No. %d ***\n", i);} + +/********************************************************************** + + TCOND - test conditionals and logical operations + +**********************************************************************/ + +tcond () + + {int i, j; + + cprint ("Testing Conditionals.\n"); + + if (0) error (10); + if (1) ; else error (20); + i = 0; + if (i) error (30); + if (i > 0) error (40); + if (i < 0) error (50); + if (i != 0) error (60); + if (i == 0) ; else error (70); + if (i <= 0) ; else error (80); + if (i >= 0) ; else error (90); + if (i > 0) i = 4; else i = 3; + if (i != 3) error (100); + if (i == 0) error (110); + if (i == 4) error (120); + i = 0; + j = 0; + if (i && j) error (130); + if (i || j) error (140); + if (!i) ; else error (150); + j = 1; + if (i && j) error (160); + if (i || j) ; else error (170); + if (!j) error (180); + i = 2; + if (i && j) ; else error (190); + if (i || j) ; else error (200); + if (!i) error (210); + } + +/********************************************************************** + + TINT - test integer arithmetic + +**********************************************************************/ + +tint () + + {int i, j, k; + int x0, x1, x2, x3, x4; + + cprint ("Testing Integer Arithmetic.\n"); + + x0=0;x1=1;x2=2;x3=3;x4=4; + if (x0 != 0) error (10); + if (x1 > 1) error (20); + if (x2 < 2) error (30); + if (x3 <= 3) ; else error (31); + if (x4 >= 4) ; else error (32); + if (x1 + x2 != x3) error (40); + if (x1 * x3 != x3) error (50); + if (x4 / x2 != x2) error (60); + if (x4 % x3 != x1) error (70); + i = 56; + j = -102; + k = 7; + if (i*j + i*k != i*(j+k)) error (80); + if (i*(k+3) + j*(k+3) != (i+j)*(k+3)) error (90); + j =+ i; + if (j != -46) error (100); + if ((j =+ i) != 10 || j != 10) error (110); + if (++j != 11 || j != 11) error (120); + if (j++ != 11 || j != 12) error (130); + if (--j != 11 || j != 11) error (140); + if (j-- != 11 || j != 10) error (150); + if (-j != k-17) error (160); + if ((j =* 2) != 20 || j != 20) error (170); + if ((j =- 13) != k || j != k) error (180); + if ((j =% 4) != 3 || j != 3) error (190); + if ((i =/ 14) != x4 || i != x4) error (200); + if (3 + 5 - 12 * 40 != -472) error (210); + if (-5 * 10 != -448/56 + 68%9 - 47) error (220); + if (k*1 != 0+k) error (230); + if (k/1 != k || k != k-0) error (240); + if (i*0) error (250); + } + +/********************************************************************** + + TFUNC - test function calling + +**********************************************************************/ + +tfunc (x) int (*x)(); + + {cprint ("Testing Function Calling.\n"); + + if ((*x)(4) != 7) error (10); + x = f2; + if ((*x)(7,2) != 5) error (20); + } + +/********************************************************************** + + TSWITCH - test switch statement + +**********************************************************************/ + +tswitch () + + {cprint ("Testing Switch Statements.\n"); + + tsw1 (0); + tsw1 (1); + tsw1 (2); + tsw1 (3); + tsw1 (4); + tsw1 (-2); + tsw1 (-5); + tsw1 (-10000); + tsw1 (4000); + tsw1 (15); + tsw2 (0); + tsw2 (1); + tsw2 (2); + tsw2 (3); + tsw2 (4); + tsw2 (-2); + tsw2 (-5); + tsw2 (-10000); + tsw2 (4000); + tsw2 (15); + } + +/********************************************************************** + + support routines for testing of switch statement + +**********************************************************************/ + +tsw1 (i) + + {switch (i) { + + error (10); + break; + error (20); +case 4: + if (i!=4) error (30); + break; + error (40); +case 2: + if (i!=2) error (50); +case 3: + if (i!=3 && i!=2) error (60); + break; + error (70); +case 0: + if (i!=0) error (80); + break; +case -2: + if (i != -2) error (90); + break; +default: + if (i == -2 || i == 0 || i == 2 || i == 3 || i == 4) + error (100); + } + } + +tsw2 (i) + + {int j; + + j = -9; + + switch (i) { + + error (200); + break; + error (210); +case -10000: + if (i != -10000) error (220); + break; + error (230); +case 3: + if (i != 3) error (240); + j = 3; +case -5: + if (i != -5 && i != 3) error (250); + if (i == 3 && j != 3) error (251); + break; +case 4000: + if (i != 4000) error (260); + j = 36; + break; +default: + if (i == -10000 || i == 3 || i == -5 || i == 4000) + error (270); + if (i == 1) j = 24; + } + + if (i == 3 && j != 3) error (280); + if (i == 4000 && j != 36) error (290); + if (i == 1 && j != 24) error (300); + } + +/********************************************************************** + + TINCR - test increment and decrement operations + +**********************************************************************/ + +tincr () + + {int i, *p, a[3]; + + cprint ("Testing Increment and Decrement Operations.\n"); + + i = 0; + if (i) error (4000); + ++i; + if (i != 1) error (4010); + ++i; + if (i != 2) error (4020); + i++; + if (i != 3) error (4030); + i++; + if (i != 4) error (4040); + i--; + if (i != 3) error (4050); + i = -10; + --i; + if (i != -11) error (4060); + ++i; + if (i != -10) error (4070); + if (--i != -11) error (4080); + if (i != -11) error (4090); + if (i-- != -11) error (4100); + if (i != -12) error (4110); + if (++i != -11) error (4120); + if (i != -11) error (4130); + if (i++ != -11) error (4140); + if (i != -10) error (4150); + + a[0] = 10; + a[1] = 11; + a[2] = 12; + + p = a+1; + if (*p != 11) error (4160); + if (*--p != 10) error (4170); + if (*p != 10) error (4180); + if (*p++ != 10) error (4190); + if (*p != 11) error (4200); + if (*++p != 12) error (4210); + if (*p != 12) error (4220); + if (*p-- != 12) error (4230); + if (*p != 11) error (4240); + } + +/********************************************************************** + + TBIT - test bit hacking operations + +**********************************************************************/ + +tbit () + + {int i, j; + + cprint ("Testing Bit Hacking Operations.\n"); + + i = 0; + j = -1; + if (~i != j) error (10); + if (~~i != i) error (20); + if (~j != i) error (30); + if (i & j) error (40); + if (i | i) error (50); + if (j ^ j) error (60); + i = 1; + if ((i << 1) != 2) error (70); + if ((i =<< 1) != 2 || i != 2) error (71); + i = 1; + if ((i << 8) != 0400) error (80); + if ((i =<< 8) != 0400 || i != 0400) error (81); + i = 0404; + if ((i >> 1) != 0202) error (90); + if ((i =>> 1) != 0202 || i != 0202) error (91); + i = 0404; + if ((i >> 2) != 0101) error (100); + if ((i >> 6) != 04) error (110); + i = 0404; + if ((i ^ 0703) != 0307) error (120); + if ((i =^ 0703) != 0307 || i != 0307) error (121); + i = 0404; + if ((i ^ 0707) != 0303) error (130); + if ((i =^ 0707) != 0303 || i != 0303) error (131); + i = 0404; + if ((i | 030) != 0434) error (140); + if ((i =| 030) != 0434 || i != 0434) error (141); + i = 0625; + if ((i & 0451) != 0401) error (150); + if ((i =& 0451) != 0401 || i != 0401) error (151); + } + +/********************************************************************** + + TCLASS - test different storage classes + +**********************************************************************/ + +tclass (x, y) int x, y; + + {int i, j; + static int k, l; + + cprint ("Testing Storage Classes.\n"); + + if (x != 5) error (5010); + if (y != -9999) error (5020); + if (k != 0) error (5030); + if (l != 0) error (5040); + i = 6; + j = 9; + x = i; + k = y; + if (i != 6) error (5050); + if (j != 9) error (5060); + if (x != 6) error (5070); + if (y != -9999) error (5080); + if (k != -9999) error (5090); + if (l != 0) error (5100); + if (e1 != 0) error (5110); + if (e2 != 9) error (5120); + if (e3 != 12) error (5130); + if (e4[0] != 0) error (5140); + if (e4[4] != 4) error (5150); + if (i1 != 0) error (5160); + if (i2 != -13) error (5170); + if (i3 != 4096) error (5180); + if (i4[1] != -1) error (5190); + if (i4[3] != -3) error (5200); + if (c1 != 0) error (5210); + if (c2 != 'a') error (5220); + if (c3 != 'b') error (5230); + if (c4[0] != 'A') error (5240); + if (c4[4] != 'E') error (5250); + if (p1 != &i2) error (5260); + if (p2[0][1] != 'o') error (5270); + if (p2[1] != &c3) error (5280); + e2 = i2; + i1 = e3; + if (e2 != -13) error (5290); + e2 = c1; + if (e2 != 0) error (5300); + if (i1 != 12) error (5310); + p1 = &x; + if (*p1 != 6) error (5320); + *p1 = 98; + p1 = &k; + if (*p1 != -9999) error (5330); + *p1 = 34; + if (x != 98) error (5340); + if (k != 34) error (5350); + if ((&c4[4] - &c4[1]) != 3) error (5360); + if ((&e4[2] - &e4[3]) != -1) error (5370); + if (p3) error (5380); + if (!p3); else error (5480); + p1 = &y; + if (*p1 != y) error (5490); + *p1 = 77; + if (y != 77) error (5500); + } + +/********************************************************************** + + output routines + +**********************************************************************/ + +cprint (fmt, x1, x2) char fmt[], x1[], x2[]; + + {int *argp, x, c; + char *s; + + argp = &x1; /* argument pointer */ + while (c = *fmt++) + {if (c != '%') putchar (c); + else + {x = *argp++; + switch (c = *fmt++) { + + case 'd': /* decimal */ + if (x<0) {x= -x; putchar ('-');} + cprd (x); + break; + + case 's': /* string */ + s = x; + while (c = *s++) putchar (c); + break; + + default: putchar (c); + argp--; + } + } + } + } + +cprd (n) + + {int a; + if (a=n/10) cprd (a); + putchar (n%10+'0'); + } + diff --git a/src/c/testc.sti b/src/c/testc.sti new file mode 100644 index 00000000..d325443a Binary files /dev/null and b/src/c/testc.sti differ diff --git a/src/c/yginst.tec b/src/c/yginst.tec new file mode 100644 index 00000000..41f2ce25 Binary files /dev/null and b/src/c/yginst.tec differ diff --git a/src/c/yinstl.tec b/src/c/yinstl.tec new file mode 100644 index 00000000..5d19ee5b Binary files /dev/null and b/src/c/yinstl.tec differ diff --git a/src/c/yparse.c b/src/c/yparse.c new file mode 100644 index 00000000..11bb9ea8 --- /dev/null +++ b/src/c/yparse.c @@ -0,0 +1,536 @@ +/* + + PARSING ROUTINE + + Requires the following: + + the tables produced by YACC + GETTOK - a lexical routine + PTOKEN - a token printing routine + a set of error message routines (one such set is + contained in the file YERROR >) + Returns TRUE if a fatal syntax error occured. + +*/ + +struct _token { int type, index, line; }; +# define token struct _token +token *dmperr(),*lex(),*tok(),*ctok(),*yreset(); + +# define pssize 200 +# define tbsize 30 +# define FALSE 0 +# define TRUE 1 + +extern int cout; + +/* GLOBAL VARIABLES USED TO RECEIVE INFO FROM GETTOK */ + +int lextype; /* indicates which terminal symbol read */ +int lexindex; /* used as translation element */ +int lexline; /* line-number of line which token appears on */ + +/* GLOBAL VARIABLES WHICH MAY BE SET TO INDICATE OPTIONS */ + +int debug FALSE; /* nonzero => print debugging info */ +int edebug FALSE; /* nonzero => print error recovery info */ +int xflag FALSE; /* nonzero => do not call action routines */ +int tflag FALSE; /* nonzero => print tokens as read */ + +/* GLOBAL VARIABLES REFERENCED BY ACTION ROUTINES */ + +int val; /* set to indicate translation element of LHS */ +int line; /* set to indicate line number of LHS */ +int *pv; /* used to reference translations of RHS */ +int *pl; /* used to reference line numbers of RHS */ +int lineno; /* used to reference lineno of current token */ + +/* INTERNAL STATIC VARIABLES */ + +static int *ps; /* parser stack pointer - states */ +static int s[pssize]; /* parser stack - states */ +static int v[pssize]; /* parser stack - translation elements */ +static int l[pssize]; /* parser stack - line numbers */ +static int *sps; /* save stack pointer - states*/ +static int *spv; /* save stack pointer - translation elements */ +static int *spl; /* save stack pointer - line numbers */ +static int ss[pssize]; /* save stack - states */ +static int sv[pssize]; /* save stack - translation elements */ +static int sl[pssize]; /* save stack - line numbers */ +static int must 7; /* number of tokens which must shift + correctly before error recovery is + considered successful */ +static int errcount 0; /* number of tokens left until successful */ +static int tskip; /* number of tokens skipped */ +static int spop; /* number of states popped */ +static int errmode 0; /* error recovery mode */ +static int tabmod FALSE; /* indicates index tables have been optimized */ + +/********************************************************************** + + PARSE - THE PARSER ITSELF + +**********************************************************************/ + +parse() + +{extern int (*act[])(), g[], pg[], r1[], r2[], a[], pa[], nwpbt; +int ac, op, n, state, *ap, *gp, control, i, r, + tlimit, slimit, *p, *ip, o, (*fp)(), t, errn; +token *ct, *tp; + +ps = &s[0]; +pv = &v[0]; +pl = &l[0]; + +state = 1; +*ps = 1; +*pv = 0; +*pl = 0; + +ct = lex(); + +if (!tabmod) + + { /* precompute index tables into action + and goto arrays */ + + ip = pa; + while ((o = *++ip) != -1) *ip = &a[o]; + ip = pg; + while ((o = *++ip) != -1) *ip = &g[o]; + tabmod = TRUE; + } + +while (TRUE) + {ap = pa[state]; + + if (debug) + cprint("executing state %d, token=%d\n",state, ct->type); + + while (TRUE) + + {ac = *ap++; + op = ac>>12; + n = ac&07777; + + switch (op) { + + case 1: /* SKIP ON TEST */ + + if (ct->type!=n) ++ap; + continue; + + case 2: /* SHIFT INPUT SYMBOL */ + + state = n; + +shift: val = ct->index; + line = ct->line; + ct = lex(); + + if (errcount) + {--errcount; + if (errcount==0) /* successful recovery */ + {ct = dmperr(); /* list recovery actions */ + control = 0; + break; + } + } + + control=1; /* stack new state */ + break; + + case 3: /* MAKE A REDUCTION */ + + if (debug) cprint ("reduce %d\n",n); + r = r2[n]; + ps =- r; + pv =- r; + pl =- r; + if (r>0) + {val = pv[1]; + line = pl[1]; + } + else + {val = ct->index; + line = ct->line; + } + if (!xflag && (fp = act[n])) (*fp)(); + state = *ps; + gp= pg[r1[n]]; + while (*gp) + {if (*gp==state) break; + gp=+2; + } + state = *++gp; + control = 1; /* stack new state */ + break; + + case 5: /* SHIFT ON MASK */ + + t = ct->type; + if (ap[t>>4] & (1<<(t&017))) /* bit on */ + {state = *(a+n+t-1); + goto shift; + } + + ap =+ nwpbt; /* skip over bit array */ + continue; + + case 4: /* ACCEPT INPUT */ + + if (errmode) + {ct = dmperr(); + control = 0; + break; + } + return (FALSE); + + case 0: /* SYNTAX ERROR */ + +/* The error recovery method used is to try skipping input symbols + and popping states off the stack in all possible combinations, + subject to a limitation on the number of symbols which may be + skipped. If a combination can be found which allows parsing + to continue for at least 7 more symbols, then the recovery is + considered a success. If no such combination can be found, the + parser gives up. + + In running through the possible recovery actions, skipping + input symbols is given priority over popping states, since + popping states tends to confuse the action routines, while + skipping symbols can not have any harmful effects on the + action routines. + + While searching for a successful combination of states and + symbols, the action routines are not called. When a successful + combination is found, the appropriate error messages are + written, the action routines are turned back on, and the parser + is reset at the point where the corrections have just been made. + + */ + + switch (errmode) { + + case 0: /* NEW ERROR */ + + if (edebug) cprint("errmode=0:st=%d,nst=%d,tok=%d\n", + state,ps-s,ct->type); + + synerr (ct->line); /* report syntax error */ + + p=s; + while (p<=ps) qprint (*p++); + pcursor (); + + tkeem(); /* enter error mode to save tokens */ + for (i=0;i<5;++i) + {tp = tok(i); + if (tp->type==1) break; + tprint (tp); + } + + save(); /* save parser stack */ + errcount = must; + errmode = 1; + xflag =| 2; /* turn off action routnes */ + + /* set up limits for recovery search */ + + tlimit = tbsize - must - 2; + slimit = ps-s; + + tskip = 0; + spop = 0; + errn = 1; + + case 1: /* try next recovery attempt */ + + restore(); + yreset(); + + if ((++tskip & 1) == 0) --spop; + if (spop<0 || ct->type==1 || tskip>tlimit) + {spop = errn++; + tskip = 0; + } + if (spop <= slimit) + {ct = ctok(tskip); + control = -spop; + break; + } + giveup (ct->line); /* give up */ + return (TRUE); + } + + if (edebug) cprint ("spop=%d,tskip=%d,token=%d\n", + spop,tskip,ct->type); + break; + } + + if (control>0) + {if (debug) cprint ("stack st=%d val=%d\n",state,val); + *++ps = state; + *++pv = val; + *++pl = line; + if (ps-s>=pssize) /* stack overflow */ + {stkovf (ct->line); + return (TRUE); + } + } + + else if (control<0) + {pv =+ control; + ps =+ control; + pl =+ control; + if (psline); + return (TRUE); + } + } + state = *ps; + break; + } + } +} + +/********************************************************************** + + DMPERR - PRINT ERROR RECOVERY ACTION TAKEN + RESET PARSER TO RESTART WITH ACTION ROUTINES + RETURN PTR TO NEW CURRENT TOKEN + +**********************************************************************/ + +token *dmperr() + + {int i; + token *tp; + extern token *ct; + + yreset(); + restore(); + if (spop>0) delmsg (ct->line); /* print DELETED: */ + for (i=1;i<=spop;++i) + qprint (ps[-spop+i]); /* print symbol associated with state */ + if (tskip>0) skpmsg (ct->line); + for(i=0;i= twp) + + /* If true, it is neccessary to read in another token. + If in normal mode, place the token in the first + element of the buffer. + */ + + {if (tokmode==0) ct=twp=tokbuf; + else + {if (twp>=tokbuf+tbsize) tkbovf (ct->line); + if (ct>twp) badtwp (ct->line); + } + rtoken (twp++); /* read token into next slot */ + } + + if (tflag && !tokmode) + {ptoken (ct, cout); + cputc (' ', cout); + } + lineno = ct->line; + return (ct); /* return ptr to token read */ + } + +token *tok(i) + + {token *p; + + p = ct + i; + if (p=tokbuf+tbsize) badtok (ct->line, i); + while (p>=twp) rtoken (twp++); + return (p); + } + +token *ctok(i) + + {return (ct = tok(i));} + +token *yreset() + + {return (ct = tokbuf);} + +tkeem() + + {int i,j; + token *tp1, *tp2; + + tokmode = 1; + j = i = twp - ct; /* number of valid tokens in buf */ + if (i>0) + {tp1 = tokbuf-1; + tp2 = ct-1; + while (i--) + {(++tp1)->type = (++tp2)->type; + tp1->index = tp2->index; + tp1->line = tp2->line; + } + } + ct = tokbuf; + twp = ct + j; + } + +tklem() + + {tokmode = 0;} + + +/********************************************************************** + + RTOKEN - PARSER READ TOKEN ROUTINE + +**********************************************************************/ + +rtoken(p) token *p; + + { + gettok(); + p->type = lextype; + p->index = lexindex; + p->line = lexline; + } + +/********************************************************************** + + PARSER ERROR MESSAGE ROUTINES + + synerr - announce syntax error + delmsg - print "DELETED:" message + skpmsg - print "SKIPPED:" message + + qprint - print symbol corresponding to parser state + tprint - print token + pcursor - print cursor symbol + + *** fatal errors *** + + giveup - announce failure of recovery attempt + stkovf - parser stack overflow + + *** internal fatal errors *** + + stkunf - parser stack underflow + tkbovf - token buffer overflow + badtwp - inconsistent token pointers + badtok - bad token reference + + ***** + + The routines are contained in the file YERROR.C so that + one may easily substitute other routines for them. + +*/ + \ No newline at end of file