From 41cb541e7e304575f8cc3eb137b1964144ca4a16 Mon Sep 17 00:00:00 2001 From: carl Date: Sun, 24 Feb 2019 00:44:50 +0800 Subject: [PATCH] Pascal compiler better type checking and function declarations (Better ISO C compatibility) --- lang/pc/comp/LLlex.c | 28 +- lang/pc/comp/LLlex.h | 10 + lang/pc/comp/LLmessage.c | 9 +- lang/pc/comp/Parameters | 4 +- lang/pc/comp/body.c | 229 +++---- lang/pc/comp/body.h | 38 ++ lang/pc/comp/build.lua | 3 - lang/pc/comp/casestat.h | 19 + lang/pc/comp/casestat.xc | 46 +- lang/pc/comp/chk_expr.c | 1089 ++++++++++++++++--------------- lang/pc/comp/chk_expr.h | 13 + lang/pc/comp/code.c | 1269 +++++++++++++++++++------------------ lang/pc/comp/code.h | 56 ++ lang/pc/comp/cstoper.c | 34 +- lang/pc/comp/cstoper.h | 36 ++ lang/pc/comp/declar.g | 24 +- lang/pc/comp/def.c | 290 ++++----- lang/pc/comp/def.xh | 20 + lang/pc/comp/desig.c | 52 +- lang/pc/comp/desig.xh | 32 + lang/pc/comp/enter.c | 226 +++---- lang/pc/comp/enter.h | 26 + lang/pc/comp/error.c | 64 +- lang/pc/comp/error.h | 25 + lang/pc/comp/expression.g | 2 + lang/pc/comp/idf.h | 4 + lang/pc/comp/input.c | 8 +- lang/pc/comp/label.c | 20 +- lang/pc/comp/label.h | 17 + lang/pc/comp/lookup.c | 35 +- lang/pc/comp/lookup.h | 29 + lang/pc/comp/main.c | 34 +- lang/pc/comp/misc.c | 16 +- lang/pc/comp/misc.h | 12 +- lang/pc/comp/next.in | 2 + lang/pc/comp/node.c | 27 +- lang/pc/comp/node.xh | 15 +- lang/pc/comp/options.c | 55 +- lang/pc/comp/options.h | 12 + lang/pc/comp/program.g | 5 + lang/pc/comp/progs.c | 16 +- lang/pc/comp/progs.h | 15 + lang/pc/comp/readwrite.c | 70 +- lang/pc/comp/readwrite.h | 18 + lang/pc/comp/scope.c | 16 +- lang/pc/comp/scope.xh | 13 + lang/pc/comp/stab.c | 24 +- lang/pc/comp/stab.h | 17 + lang/pc/comp/statement.g | 7 + lang/pc/comp/tmpvar.h | 23 + lang/pc/comp/tmpvar.xc | 32 +- lang/pc/comp/tokenname.c | 5 +- lang/pc/comp/tokenname.h | 3 + lang/pc/comp/type.c | 94 +-- lang/pc/comp/type.xh | 56 +- lang/pc/comp/typequiv.c | 45 +- lang/pc/comp/typequiv.h | 42 ++ 57 files changed, 2494 insertions(+), 1937 deletions(-) create mode 100644 lang/pc/comp/body.h create mode 100644 lang/pc/comp/casestat.h create mode 100644 lang/pc/comp/code.h create mode 100644 lang/pc/comp/cstoper.h create mode 100644 lang/pc/comp/enter.h create mode 100644 lang/pc/comp/error.h create mode 100644 lang/pc/comp/label.h create mode 100644 lang/pc/comp/lookup.h create mode 100644 lang/pc/comp/next.in create mode 100644 lang/pc/comp/options.h create mode 100644 lang/pc/comp/progs.h create mode 100644 lang/pc/comp/readwrite.h create mode 100644 lang/pc/comp/stab.h create mode 100644 lang/pc/comp/tmpvar.h create mode 100644 lang/pc/comp/typequiv.h diff --git a/lang/pc/comp/LLlex.c b/lang/pc/comp/LLlex.c index 4de2c0d8b..4cb24d47b 100644 --- a/lang/pc/comp/LLlex.c +++ b/lang/pc/comp/LLlex.c @@ -19,9 +19,10 @@ #include "input.h" #include "main.h" #include "type.h" +#include "error.h" +#include "ack_string.h" + -extern long str2long(); -extern char *Malloc(); #define TO_LOWER(ch) (ch |= ( ch>='A' && ch<='Z' ) ? 0x0020 : 0) @@ -43,7 +44,7 @@ int tokenseen = 0; /* Some comment-options must precede any program text */ /* Warning: The options specified inside comments take precedence over * the ones on the command line. */ -CommentOptions() +void CommentOptions(void) { register int ch, ci; int on_on_minus = 0; @@ -120,8 +121,7 @@ CommentOptions() } -STATIC void -SkipComment() +static void SkipComment(void) { /* Skip ISO-Pascal comments (* ... *) or { ... }. Note : @@ -153,9 +153,7 @@ SkipComment() } } -STATIC struct string * -GetString( delim ) -register int delim; +static struct string *GetString(register int delim) { /* Read a Pascal string, delimited by the character ' or ". */ @@ -212,8 +210,7 @@ register int delim; static char *s_error = "illegal line directive"; -void -CheckForLineDirective() +void CheckForLineDirective(void) { register int ch; register int i = 0; @@ -276,8 +273,7 @@ CheckForLineDirective() LineNumber = i; } -int -LLlex() +int LLlex(void) { /* LLlex() is the Lexical Analyzer. The putting aside of tokens is taken into account. @@ -531,10 +527,10 @@ again: while (*np == '0') /* skip leading zeros */ np++; tk->TOK_INT = str2long(np, 10); - if( tk->TOK_INT < 0 || - strlen(np) > strlen(maxint_str) || - strlen(np) == strlen(maxint_str) && - strcmp(np, maxint_str) > 0 ) + if( (tk->TOK_INT < 0) || + (strlen(np) > strlen(maxint_str)) || + (strlen(np) == strlen(maxint_str) && + strcmp(np, maxint_str) > 0) ) lexwarning("overflow in constant"); } toktype = int_type; diff --git a/lang/pc/comp/LLlex.h b/lang/pc/comp/LLlex.h index 7aa6f5420..656b9cbad 100644 --- a/lang/pc/comp/LLlex.h +++ b/lang/pc/comp/LLlex.h @@ -1,4 +1,9 @@ /* T O K E N D E S C R I P T O R D E F I N I T I O N */ +#ifndef LLLEX_H_ +#define LLLEX_H_ + +#include "em_label.h" +#include "em_arith.h" /* Structure to store a string constant */ @@ -46,3 +51,8 @@ extern struct type *toktype, *asidetype; extern int tokenseen; #define ASIDE aside.tk_symb + +void CheckForLineDirective(void); +int LLlex(void); + +#endif diff --git a/lang/pc/comp/LLmessage.c b/lang/pc/comp/LLmessage.c index 965887f41..21b3cceac 100644 --- a/lang/pc/comp/LLmessage.c +++ b/lang/pc/comp/LLmessage.c @@ -14,15 +14,14 @@ #include "LLlex.h" #include "Lpars.h" #include "idf.h" +#include "node.h" #include "type.h" +#include "misc.h" +#include "error.h" -extern char *symbol2str(); -extern char *Malloc(), *Salloc(); -extern struct idf *gen_anon_idf(); extern int expect_label; -LLmessage(tk) - register int tk; +void LLmessage(register int tk) { if( tk > 0 ) { /* if( tk > 0 ), it represents the token to be inserted. diff --git a/lang/pc/comp/Parameters b/lang/pc/comp/Parameters index 7ff99bafb..46d4ed683 100644 --- a/lang/pc/comp/Parameters +++ b/lang/pc/comp/Parameters @@ -1,5 +1,5 @@ !File: debugcst.h -/*#define DEBUG 1 /* perform various self-tests */ +/*#define DEBUG 1 *//* perform various self-tests */ #define NDEBUG 1 /* disable assertions */ @@ -55,7 +55,7 @@ !File: nocross.h -/*#define NOCROSS 1 /* define when cross compiler not needed */ +/*#define NOCROSS 1 *//* define when cross compiler not needed */ !File: dbsymtab.h diff --git a/lang/pc/comp/body.c b/lang/pc/comp/body.c index 091ab6927..510c18343 100644 --- a/lang/pc/comp/body.c +++ b/lang/pc/comp/body.c @@ -15,31 +15,36 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "code.h" +#include "chk_expr.h" +#include "tmpvar.h" +#include "typequiv.h" +#include "error.h" -MarkDef(nd, flags, on) - register struct node *nd; - unsigned short flags; +void MarkDef(register struct node *nd, unsigned short flags, int on) { - while( nd && nd->nd_class != Def ) { - if( (nd->nd_class == Arrsel) || - (nd->nd_class == LinkDef) ) + while (nd && nd->nd_class != Def) + { + if ((nd->nd_class == Arrsel) || (nd->nd_class == LinkDef)) nd = nd->nd_left; - else if( nd->nd_class == Arrow ) + else if (nd->nd_class == Arrow) nd = nd->nd_right; - else break; + else + break; } - if( nd && (nd->nd_class == Def) ) { - if( (flags & D_SET) && on && - BlockScope != nd->nd_def->df_scope ) + if (nd && (nd->nd_class == Def)) + { + if ((flags & D_SET) && on && BlockScope != nd->nd_def->df_scope) nd->nd_def->df_flags |= D_SETINHIGH; - if( on ) { + if (on) + { /* - if( (flags & D_SET) && - (nd->nd_def->df_flags & D_WITH) ) - node_warning(nd, - "variable \"%s\" already referenced in with", - nd->nd_def->df_idf->id_text); - */ + if( (flags & D_SET) && + (nd->nd_def->df_flags & D_WITH) ) + node_warning(nd, + "variable \"%s\" already referenced in with", + nd->nd_def->df_idf->id_text); + */ nd->nd_def->df_flags |= flags; } else @@ -47,32 +52,29 @@ MarkDef(nd, flags, on) } } -void -AssertStat(expp, line) - register struct node *expp; - unsigned short line; +void AssertStat(register struct node *expp, unsigned short line) { struct desig dsr; - if( !ChkExpression(expp) ) - return; + if (!ChkExpression(expp)) + return; - if( expp->nd_type != bool_type ) { + if (expp->nd_type != bool_type) + { node_error(expp, "type of assertion should be boolean"); return; } - if( !options['a'] && !err_occurred ) { + if (!options['a'] && !err_occurred) + { dsr = InitDesig; CodeExpr(expp, &dsr, NO_LABEL); - C_loc((arith)line); + C_loc((arith) line); C_cal("_ass"); } } -void -AssignStat(left, right) - register struct node *left, *right; +void AssignStat(register struct node *left, register struct node *right) { register struct type *ltp, *rtp; int retval = 0; @@ -85,43 +87,49 @@ AssignStat(left, right) ltp = left->nd_type; rtp = right->nd_type; - MarkDef(left, (unsigned short)D_SET, 1); + MarkDef(left, (unsigned short) D_SET, 1); - if( !retval ) return; + if (!retval) + return; - if( ltp == int_type && rtp == long_type ) { + if (ltp == int_type && rtp == long_type) + { right = MkNode(IntReduc, NULLNODE, right, &dot); right->nd_type = int_type; } - else if( ltp == long_type && rtp == int_type ) { + else if (ltp == long_type && rtp == int_type) + { right = MkNode(IntCoerc, NULLNODE, right, &dot); right->nd_type = long_type; } - if( !TstAssCompat(ltp, rtp) ) { + if (!TstAssCompat(ltp, rtp)) + { node_error(left, "type incompatibility in assignment"); return; } - if( left->nd_class == Def && - (left->nd_def->df_flags & D_INLOOP) ) { + if (left->nd_class == Def && (left->nd_def->df_flags & D_INLOOP)) + { node_error(left, "assignment to a control variable"); return; } - if( rtp == emptyset_type ) + if (rtp == emptyset_type) right->nd_type = ltp; - if( !err_occurred ) { + if (!err_occurred) + { dsr = InitDesig; CodeExpr(right, &dsr, NO_LABEL); - if( rtp->tp_fund & (T_ARRAY | T_RECORD) ) + if (rtp->tp_fund & (T_ARRAY | T_RECORD)) CodeAddress(&dsr); - else { + else + { CodeValue(&dsr, rtp); - if( ltp == real_type && BaseType(rtp) == int_type ) + if (ltp == real_type && BaseType(rtp) == int_type) Int2Real(rtp->tp_size); RangeCheck(ltp, rtp); @@ -133,21 +141,19 @@ AssignStat(left, right) FreeNode(right); } -void -ProcStat(nd) - register struct node *nd; +void ProcStat(register struct node *nd) { - if( !ChkCall(nd) ) return; + if (!ChkCall(nd)) + return; - if( nd->nd_type ) { + if (nd->nd_type) + { node_error(nd, "procedure call expected"); return; } } -void -ChkForStat(nd) - register struct node *nd; +void ChkForStat(register struct node *nd) { register struct def *df; int retvar = 0; @@ -157,84 +163,82 @@ ChkForStat(nd) MarkUsed(nd->nd_left); retvar &= ChkExpression(nd->nd_right); MarkUsed(nd->nd_right); - if( !retvar ) return; + if (!retvar) + return; assert(nd->nd_class == Def); df = nd->nd_def; - if( df->df_scope != BlockScope ) { + if (df->df_scope != BlockScope) + { node_error(nd, "for loop: control variable must be local"); return; } assert(df->df_kind == D_VARIABLE); - if( df->df_scope != GlobalScope && df->var_off >= 0 ) { - node_error(nd, - "for loop: control variable can't be a parameter"); - MarkDef(nd,(unsigned short)(D_LOOPVAR | D_SET | D_USED), 1); + if (df->df_scope != GlobalScope && df->var_off >= 0) + { + node_error(nd, "for loop: control variable can't be a parameter"); + MarkDef(nd, (unsigned short) (D_LOOPVAR | D_SET | D_USED), 1); return; } - if( !(df->df_type->tp_fund & T_ORDINAL) ) { + if (!(df->df_type->tp_fund & T_ORDINAL)) + { node_error(nd, "for loop: control variable must be ordinal"); - MarkDef(nd,(unsigned short)(D_LOOPVAR | D_SET | D_USED), 1); + MarkDef(nd, (unsigned short) (D_LOOPVAR | D_SET | D_USED), 1); return; } - if( !TstCompat(df->df_type, nd->nd_left->nd_type) ) + if (!TstCompat(df->df_type, nd->nd_left->nd_type)) node_error(nd, - "for loop: initial value incompatible with control variable"); + "for loop: initial value incompatible with control variable"); - if( !TstCompat(df->df_type, nd->nd_right->nd_type) ) + if (!TstCompat(df->df_type, nd->nd_right->nd_type)) node_error(nd, - "for loop: final value incompatible with control variable"); - - if( df->df_type == long_type ) + "for loop: final value incompatible with control variable"); + + if (df->df_type == long_type) node_error(nd, "for loop: control variable can not be a long"); - if( df->df_flags & D_INLOOP ) + if (df->df_flags & D_INLOOP) node_error(nd, "for loop: control variable already used"); - if( df->df_flags & D_SETINHIGH ) - node_error(nd, - "for loop: control variable already set in block"); + if (df->df_flags & D_SETINHIGH) + node_error(nd, "for loop: control variable already set in block"); - MarkDef(nd,(unsigned short) (D_LOOPVAR | D_INLOOP | D_SET | D_USED), 1); + MarkDef(nd, (unsigned short) (D_LOOPVAR | D_INLOOP | D_SET | D_USED), 1); return; } -void -EndForStat(nd) - register struct node *nd; +void EndForStat(register struct node *nd) { register struct def *df; df = nd->nd_def; - if( (df->df_scope != BlockScope) || - (df->df_scope != GlobalScope && df->var_off >= 0) || - !(df->df_type->tp_fund & T_ORDINAL) - ) + if ((df->df_scope != BlockScope) + || (df->df_scope != GlobalScope && df->var_off >= 0) + || !(df->df_type->tp_fund & T_ORDINAL)) return; - MarkDef(nd,(unsigned short) (D_INLOOP | D_SET), 0); + MarkDef(nd, (unsigned short) (D_INLOOP | D_SET), 0); } -arith -CodeInitFor(nd, priority) - register struct node *nd; +arith CodeInitFor(register struct node *nd, int priority) { /* Push final-value, the value may only be evaluated - once, so generate a temporary for it, when not a constant. - */ + once, so generate a temporary for it, when not a constant. + */ arith tmp; CodePExpr(nd); - if( nd->nd_class != Value ) { + if (nd->nd_class != Value) + { tmp = NewInt(priority); C_dup(int_size); @@ -245,14 +249,13 @@ CodeInitFor(nd, priority) return (arith) 0; } -CodeFor(nd, stepsize, l1, l2) - struct node *nd; - label l1, l2; +void CodeFor(struct node *nd, int stepsize, label l1, label l2) { /* Test if loop has to be done */ - if( stepsize == 1 ) /* TO */ + if (stepsize == 1) /* TO */ C_bgt(l2); - else /* DOWNTO */ + else + /* DOWNTO */ C_blt(l2); /* Label at begin of the body */ @@ -262,24 +265,22 @@ CodeFor(nd, stepsize, l1, l2) CodeDStore(nd); } -CodeEndFor(nd, stepsize, l1, l2, tmp2) - struct node *nd; - label l1, l2; - arith tmp2; +void CodeEndFor(struct node *nd, int stepsize, label l1, label l2, arith tmp2) { /* Test if loop has to be done once more */ CodePExpr(nd); C_dup(int_size); - if( tmp2 ) + if (tmp2) C_lol(tmp2); else CodePExpr(nd->nd_right); C_beq(l2); /* Increment/decrement the control-variable */ - if( stepsize == 1 ) /* TO */ + if (stepsize == 1) /* TO */ C_inc(); - else /* DOWNTO */ + else + /* DOWNTO */ C_dec(); C_bra(l1); @@ -288,33 +289,33 @@ CodeEndFor(nd, stepsize, l1, l2, tmp2) C_asp(int_size); } -void -WithStat(nd) - struct node *nd; +void WithStat(struct node *nd) { struct withdesig *wds; struct desig ds; struct scopelist *scl; - if( nd->nd_type->tp_fund != T_RECORD ) { + if (nd->nd_type->tp_fund != T_RECORD) + { node_error(nd, "record variable expected"); return; } - MarkDef(nd, (unsigned short)(D_USED | D_SET | D_WITH), 1); + MarkDef(nd, (unsigned short) (D_USED | D_SET | D_WITH), 1); /* - if( (nd->nd_class == Arrow) && - (nd->nd_right->nd_type->tp_fund & T_FILE) ) { - nd->nd_right->nd_def->df_flags |= D_WITH; - } - */ + if( (nd->nd_class == Arrow) && + (nd->nd_right->nd_type->tp_fund & T_FILE) ) { + nd->nd_right->nd_def->df_flags |= D_WITH; + } + */ scl = new_scopelist(); scl->sc_scope = nd->nd_type->rec_scope; scl->next = CurrVis; CurrVis = scl; - if( err_occurred ) return; + if (err_occurred) + return; /* Generate code */ @@ -338,24 +339,23 @@ WithStat(nd) wds->w_desig = ds; } -EndWith(saved_scl, nd) - struct scopelist *saved_scl; - struct node *nd; +void EndWith(struct scopelist *saved_scl, struct node *nd) { /* restore scope, and release structures */ struct scopelist *scl; struct withdesig *wds; struct node *nd1; - while( CurrVis != saved_scl ) { + while (CurrVis != saved_scl) + { /* release scopelist */ scl = CurrVis; CurrVis = CurrVis->next; free_scopelist(scl); - if( WithDesigs == 0 ) - continue; /* we didn't generate any code */ + if (WithDesigs == 0) + continue; /* we didn't generate any code */ /* release temporary */ FreePtr(WithDesigs->w_desig.dsg_offset); @@ -366,8 +366,9 @@ EndWith(saved_scl, nd) free_withdesig(wds); } - for( nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right ) { - MarkDef(nd1->nd_left, (unsigned short)(D_WITH), 0); + for (nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right) + { + MarkDef(nd1->nd_left, (unsigned short) (D_WITH), 0); } FreeNode(nd); diff --git a/lang/pc/comp/body.h b/lang/pc/comp/body.h new file mode 100644 index 000000000..97af25657 --- /dev/null +++ b/lang/pc/comp/body.h @@ -0,0 +1,38 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef BODY_H_ +#define BODY_H_ + +#include "em_arith.h" +#include "em_label.h" + + +struct node; +struct scopelist; + + +void MarkDef(register struct node *nd, unsigned short flags, int on); + +/* Assert statement */ +void AssertStat(register struct node *expp, unsigned short line); +/** Assign statement */ +void AssignStat(register struct node *left, register struct node *right); +/** Procedure call statement */ +void ProcStat(register struct node *nd); + +/** ??? */ +void ChkForStat(register struct node *nd); +/** ??? */ +void EndForStat(register struct node *nd); +arith CodeInitFor(register struct node *nd, int priority); +void CodeFor(struct node *nd, int stepsize, label l1, label l2); +void CodeEndFor(struct node *nd, int stepsize, label l1, label l2, arith tmp2); + +/* With statement */ +void WithStat(struct node *nd); +void EndWith(struct scopelist *saved_scl, struct node *nd); + +#endif /* BODY_H_ */ diff --git a/lang/pc/comp/build.lua b/lang/pc/comp/build.lua index d856709a3..740f88f43 100644 --- a/lang/pc/comp/build.lua +++ b/lang/pc/comp/build.lua @@ -124,9 +124,6 @@ cprogram { "modules/src/string+lib", "modules/src/system+lib", }, - vars = { - ["+cflags"] = "-DSTATIC=static" - } } installable { diff --git a/lang/pc/comp/casestat.h b/lang/pc/comp/casestat.h new file mode 100644 index 000000000..4f9cfc654 --- /dev/null +++ b/lang/pc/comp/casestat.h @@ -0,0 +1,19 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef CASESTAT_H_ +#define CASESTAT_H_ + +#include + +struct node; + +void CaseExpr(struct node *nd); +void CaseEnd(struct node *nd, label exit_label); + + + + +#endif /* CASESTAT_H_ */ diff --git a/lang/pc/comp/casestat.xc b/lang/pc/comp/casestat.xc index 554a6216d..71bc95d0b 100644 --- a/lang/pc/comp/casestat.xc +++ b/lang/pc/comp/casestat.xc @@ -12,6 +12,10 @@ #include "main.h" #include "node.h" #include "type.h" +#include "code.h" +#include "error.h" +#include "typequiv.h" +#include "casestat.h" struct case_hdr { struct case_hdr *ch_next; /* in the free list */ @@ -40,9 +44,14 @@ struct case_entry { */ #define compact(nr, low, up) (nr != 0 && (up - low) / nr <= DENSITY) +static void FreeCh(register struct case_hdr *); +static int AddCases(register struct case_hdr *, register struct node *, label); +static int AddOneCase(register struct case_hdr *, register struct node *, label); +static void CaseCode(label, struct case_hdr *, label); + + void -CaseExpr(nd) - struct node *nd; +CaseExpr(struct node *nd) { /* Check the expression and generate code for it */ @@ -64,9 +73,9 @@ CaseExpr(nd) } void -CaseEnd(nd, exit_label) - struct node *nd; - label exit_label; +CaseEnd( + struct node *nd, + label exit_label) { /* Stack a new case header and fill in the necessary fields. */ @@ -98,8 +107,7 @@ CaseEnd(nd, exit_label) FreeNode(nd); } -FreeCh(ch) - register struct case_hdr *ch; +static void FreeCh(register struct case_hdr *ch) { /* free the allocated case structure */ @@ -116,10 +124,10 @@ FreeCh(ch) free_case_hdr(ch); } -AddCases(ch, nd, CaseLabel) - register struct case_hdr *ch; - register struct node *nd; - label CaseLabel; +static int AddCases( + register struct case_hdr *ch, + register struct node *nd, + label CaseLabel) { while( nd ) { if( !AddOneCase(ch, nd, CaseLabel) ) @@ -129,10 +137,10 @@ AddCases(ch, nd, CaseLabel) return 1; } -AddOneCase(ch, nd, lbl) - register struct case_hdr *ch; - register struct node *nd; - label lbl; +static int AddOneCase( + register struct case_hdr *ch, + register struct node *nd, + label lbl) { register struct case_entry *ce = new_case_entry(); register struct case_entry *c1 = ch->ch_entries, *c2 = 0; @@ -211,10 +219,10 @@ AddOneCase(ch, nd, lbl) return 1; } -CaseCode(lbl, ch, exit_label) - label lbl; - struct case_hdr *ch; - label exit_label; +static void CaseCode( + label lbl, + struct case_hdr *ch, + label exit_label) { label CaseDescrLab = ++data_label; /* rom must have a label */ diff --git a/lang/pc/comp/chk_expr.c b/lang/pc/comp/chk_expr.c index a9e8ba73a..6ce142525 100644 --- a/lang/pc/comp/chk_expr.c +++ b/lang/pc/comp/chk_expr.c @@ -1,7 +1,7 @@ /* E X P R E S S I O N C H E C K I N G */ /* Check expressions, and try to evaluate them as far as possible. -*/ + */ #include "parameters.h" #include "debug.h" @@ -11,8 +11,7 @@ #include #include #include -#include -#include +#include "print.h" #include "LLlex.h" #include "Lpars.h" @@ -26,25 +25,29 @@ #include "required.h" #include "scope.h" #include "type.h" +#include "typequiv.h" +#include "readwrite.h" +#include "body.h" +#include "cstoper.h" +#include "error.h" -extern char *symbol2str(); -STATIC int ChkUnOper(); +static int ChkValue(register struct node *); +static int ChkUnOper(register struct node *); +static int ChkStandard(register struct node *, register struct node *); -STATIC -Xerror(nd, mess) - register struct node *nd; - char *mess; + +static void Xerror(register struct node *nd, char *mess) { - if( nd->nd_class == Def && nd->nd_def ) { - if( nd->nd_def->df_kind != D_ERROR ) - node_error(nd,"\"%s\": %s", - nd->nd_def->df_idf->id_text, mess); + if (nd->nd_class == Def && nd->nd_def) + { + if (nd->nd_def->df_kind != D_ERROR) + node_error(nd, "\"%s\": %s", nd->nd_def->df_idf->id_text, mess); } - else node_error(nd, "%s", mess); + else + node_error(nd, "%s", mess); } -struct node * -ZeroParam() +struct node *ZeroParam(void) { register struct node *nd; @@ -58,103 +61,107 @@ ZeroParam() return nd; } -MarkUsed(nd) - register struct node *nd; +void MarkUsed(register struct node *nd) { - while( nd && nd->nd_class != Def ) { - if( (nd->nd_class == Arrsel) || (nd->nd_class == LinkDef) ) + while (nd && nd->nd_class != Def) + { + if ((nd->nd_class == Arrsel) || (nd->nd_class == LinkDef)) nd = nd->nd_left; - else if( nd->nd_class == Arrow) + else if (nd->nd_class == Arrow) nd = nd->nd_right; - else break; + else + break; } - if( nd && nd->nd_class == Def ) { + if (nd && nd->nd_class == Def) + { register struct def *df = nd->nd_def; - if( df->df_kind != D_FIELD ) { - if( !(df->df_flags & (D_SET|D_VARPAR)) && - (df->df_scope == CurrentScope) ) - if( !is_anon_idf(df->df_idf) ) { - warning("\"%s\" used before set", - df->df_idf->id_text); + if (df->df_kind != D_FIELD) + { + if (!(df->df_flags & (D_SET | D_VARPAR)) + && (df->df_scope == CurrentScope)) + if (!is_anon_idf(df->df_idf)) + { + warning("\"%s\" used before set", df->df_idf->id_text); } df->df_flags |= (D_USED | D_SET); } } } -int -ChkConstant(expp) - register struct node *expp; +int ChkConstant(register struct node *expp) { register struct node *nd; - if( !(nd = expp->nd_right) ) nd = expp; + if (!(nd = expp->nd_right)) + nd = expp; - if( nd->nd_class == Name && !ChkLinkOrName(nd) ) return 0; + if (nd->nd_class == Name && !ChkLinkOrName(nd)) + return 0; - if( nd->nd_class != Value || expp->nd_left ) { + if (nd->nd_class != Value || expp->nd_left) + { Xerror(nd, "constant expected"); return 0; } - if( expp->nd_class == Uoper ) + if (expp->nd_class == Uoper) return ChkUnOper(expp); - else if( nd != expp ) { + else if (nd != expp) + { Xerror(expp, "constant expected"); return 0; } return 1; } -int -ChkVariable(expp) - register struct node *expp; +int ChkVariable(register struct node *expp) { /* Check that "expp" indicates an item that can be accessed */ - if( !ChkLhs(expp) ) return 0; + if (!ChkLhs(expp)) + return 0; - if( expp->nd_class == Def && expp->nd_def->df_kind == D_FUNCTION ) { + if (expp->nd_class == Def && expp->nd_def->df_kind == D_FUNCTION) + { Xerror(expp, "illegal use of function name"); return 0; } return 1; } -int -ChkLhs(expp) - register struct node *expp; +int ChkLhs(register struct node *expp) { int class; - /* Check that "expp" indicates an item that can be the lhs - of an assignment. - */ - if( !ChkVarAccess(expp) ) return 0; + + if (!ChkVarAccess(expp)) return 0; class = expp->nd_class; /* a constant is replaced by it's value in ChkLinkOrName, check here !, * the remaining classes are checked by ChkVarAccess */ - if( class == Value ) { + if (class == Value) + { node_error(expp, "can't access a value"); return 0; } - if( class == Def && - !(expp->nd_def->df_kind & (D_FIELD | D_FUNCTION | D_VARIABLE)) ) { + if (class == Def + && !(expp->nd_def->df_kind & (D_FIELD | D_FUNCTION | D_VARIABLE))) + { Xerror(expp, "variable expected"); return 0; } /* assignment to function name */ - if( class == Def && expp->nd_def->df_kind == D_FUNCTION ) - if( expp->nd_def->prc_res ) + if (class == Def && expp->nd_def->df_kind == D_FUNCTION) + if (expp->nd_def->prc_res) expp->nd_type = ResultType(expp->nd_def->df_type); - else { + else + { Xerror(expp, "illegal assignment to function-name"); return 0; } @@ -163,55 +170,58 @@ ChkLhs(expp) } #ifdef DEBUG -STATIC int -ChkValue(expp) - register struct node *expp; +static int ChkValue(register struct node *expp) { - switch( expp->nd_symb ) { + switch( expp->nd_symb ) + { case INTEGER: case REAL: case STRING: case NIL: - return 1; + return 1; default: - crash("(ChkValue)"); + crash("(ChkValue)"); } /*NOTREACHED*/ } #endif -int -ChkLinkOrName(expp) - register struct node *expp; +int ChkLinkOrName(register struct node *expp) { register struct def *df; expp->nd_type = error_type; - if( expp->nd_class == Name ) { + if (expp->nd_class == Name) + { expp->nd_def = lookfor(expp, CurrVis, 1); expp->nd_class = Def; expp->nd_type = expp->nd_def->df_type; } - else if( expp->nd_class == Link ) { + else if (expp->nd_class == Link) + { /* a selection from a record */ register struct node *left = expp->nd_left; assert(expp->nd_symb == '.'); - if( !ChkVariable(left) ) return 0; + if (!ChkVariable(left)) + return 0; - if( left->nd_type->tp_fund != T_RECORD ) { + if (left->nd_type->tp_fund != T_RECORD) + { Xerror(left, "illegal selection"); return 0; } - if( !(df = lookup(expp->nd_IDF, left->nd_type->rec_scope, D_INUSE)) ) { + if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope, D_INUSE))) + { id_not_declared(expp); return 0; } - else { + else + { expp->nd_def = df; expp->nd_type = df->df_type; expp->nd_class = LinkDef; @@ -222,16 +232,19 @@ ChkLinkOrName(expp) df = expp->nd_def; - if( df->df_kind & (D_ENUM | D_CONST) ) { + if (df->df_kind & (D_ENUM | D_CONST)) + { MarkUsed(expp); /* Replace an enum-literal or a CONST identifier by its value. - */ - if( df->df_kind == D_ENUM ) { + */ + if (df->df_kind == D_ENUM) + { expp->nd_class = Value; expp->nd_INT = df->enm_val; expp->nd_symb = INTEGER; } - else { + else + { unsigned int ln = expp->nd_lineno; assert(df->df_kind == D_CONST); @@ -242,38 +255,39 @@ ChkLinkOrName(expp) return df->df_kind != D_ERROR; } -STATIC int -ChkExLinkOrName(expp) - register struct node *expp; +static int ChkExLinkOrName(register struct node *expp) { - if( !ChkLinkOrName(expp) ) return 0; - if( expp->nd_class != Def ) return 1; + if (!ChkLinkOrName(expp)) + return 0; + if (expp->nd_class != Def) + return 1; - if( !(expp->nd_def->df_kind & D_VALUE) ) { + if (!(expp->nd_def->df_kind & D_VALUE)) + { Xerror(expp, "value expected"); } return 1; } -STATIC int -ChkUnOper(expp) - register struct node *expp; +static int ChkUnOper(register struct node *expp) { /* Check an unary operation. - */ + */ register struct node *right = expp->nd_right; register struct type *tpr; - if( !ChkExpression(right) ) return 0; + if (!ChkExpression(right)) return 0; MarkUsed(right); expp->nd_type = tpr = BaseType(right->nd_type); - switch( expp->nd_symb ) { + switch (expp->nd_symb) + { case '+': - if( tpr->tp_fund & T_NUMERIC ) { + if (tpr->tp_fund & T_NUMERIC) + { *expp = *right; free_node(right); return 1; @@ -281,13 +295,16 @@ ChkUnOper(expp) break; case '-': - if( tpr->tp_fund == T_INTEGER || tpr->tp_fund == T_LONG ) { - if( right->nd_class == Value ) + if (tpr->tp_fund == T_INTEGER || tpr->tp_fund == T_LONG) + { + if (right->nd_class == Value) cstunary(expp); return 1; } - if( tpr->tp_fund == T_REAL ) { - if( right->nd_class == Value ) { + if (tpr->tp_fund == T_REAL) + { + if (right->nd_class == Value) + { expp->nd_token.tk_data.tk_real = right->nd_RIV; expp->nd_class = Value; expp->nd_symb = REAL; @@ -299,8 +316,9 @@ ChkUnOper(expp) break; case NOT: - if( tpr == bool_type ) { - if( right->nd_class == Value ) + if (tpr == bool_type) + { + if (right->nd_class == Value) cstunary(expp); return 1; } @@ -319,86 +337,81 @@ ChkUnOper(expp) return 0; } -STATIC struct type * -ResultOfOperation(operator, tpl, tpr) - struct type *tpl, *tpr; +static struct type * +ResultOfOperation(int operator, struct type *tpl, struct type *tpr) { /* Return the result type of the binary operation "operator", - with operand types "tpl" and "tpr". + with operand types "tpl" and "tpr". */ - switch( operator ) { - case '=' : - case NOTEQUAL : - case '<' : - case '>' : - case LESSEQUAL : - case GREATEREQUAL: - case IN : - return bool_type; - case '+' : - case '-' : - case '*' : - if( tpl == real_type || tpr == real_type ) - return real_type; - if( tpl == long_type || tpr == long_type) - return long_type; - return tpl; - case '/' : - return real_type; + switch (operator) + { + case '=': + case NOTEQUAL: + case '<': + case '>': + case LESSEQUAL: + case GREATEREQUAL: + case IN: + return bool_type; + case '+': + case '-': + case '*': + if (tpl == real_type || tpr == real_type) + return real_type; + if (tpl == long_type || tpr == long_type) + return long_type; + return tpl; + case '/': + return real_type; } - if (tpr == long_type && tpl == int_type) return tpr; + if (tpr == long_type && tpl == int_type) + return tpr; return tpl; } -STATIC int -AllowedTypes(operator) +static int AllowedTypes(int operator) { /* Return a bit mask indicating the allowed operand types for - binary operator "operator". + binary operator "operator". */ - switch( operator ) { - case '+' : - case '-' : - case '*' : - return T_NUMERIC | T_SET; - case '/' : - return T_NUMERIC; - case DIV : - case MOD : - return T_INTEGER | T_LONG; - case OR : - case AND : - return T_ENUMERATION; - case '=' : - case NOTEQUAL : - return T_ENUMERATION | T_CHAR | T_NUMERIC | - T_SET | T_POINTER | T_STRINGCONST | - T_STRING; - case LESSEQUAL : - case GREATEREQUAL: - return T_ENUMERATION | T_CHAR | T_NUMERIC | - T_SET | T_STRINGCONST; - case '<' : - case '>' : - return T_ENUMERATION | T_CHAR | T_NUMERIC | - T_STRINGCONST; - default : - crash("(AllowedTypes)"); + switch (operator) + { + case '+': + case '-': + case '*': + return T_NUMERIC | T_SET; + case '/': + return T_NUMERIC; + case DIV: + case MOD: + return T_INTEGER | T_LONG; + case OR: + case AND: + return T_ENUMERATION; + case '=': + case NOTEQUAL: + return T_ENUMERATION | T_CHAR | T_NUMERIC | T_SET | T_POINTER + | T_STRINGCONST | T_STRING; + case LESSEQUAL: + case GREATEREQUAL: + return T_ENUMERATION | T_CHAR | T_NUMERIC | T_SET | T_STRINGCONST; + case '<': + case '>': + return T_ENUMERATION | T_CHAR | T_NUMERIC | T_STRINGCONST; + default: + crash("(AllowedTypes)"); } /*NOTREACHED*/ } -STATIC int -Boolean(operator) +static int Boolean(int operator) { return operator == OR || operator == AND; } -STATIC int -ChkBinOper(expp) - register struct node *expp; +static int ChkBinOper(register struct node *expp) { /* Check a binary operation. */ @@ -418,167 +431,175 @@ ChkBinOper(expp) tpl = BaseType(left->nd_type); tpr = BaseType(right->nd_type); - expp->nd_type = ResultOfOperation(expp->nd_symb, tpl ,tpr); + expp->nd_type = ResultOfOperation(expp->nd_symb, tpl, tpr); /* Check that the application of the operator is allowed on the type - of the operands. - There are some needles and pins: - - Boolean operators are only allowed on boolean operands, but the - "allowed-mask" of "AllowedTypes" can only indicate an enumeration - type. - - The IN-operator has as right-hand-side operand a set. - - Strings and packed arrays can be equivalent. - - In some cases, integers must be converted to reals. - - If one of the operands is the empty set then the result doesn't - have to be the empty set. - */ - - if( expp->nd_symb == IN ) { - if( tpr->tp_fund != T_SET ) { + of the operands. + There are some needles and pins: + - Boolean operators are only allowed on boolean operands, but the + "allowed-mask" of "AllowedTypes" can only indicate an enumeration + type. + - The IN-operator has as right-hand-side operand a set. + - Strings and packed arrays can be equivalent. + - In some cases, integers must be converted to reals. + - If one of the operands is the empty set then the result doesn't + have to be the empty set. + */ + + if (expp->nd_symb == IN) + { + if (tpr->tp_fund != T_SET) + { node_error(expp, "\"IN\": right operand must be a set"); return 0; } - if( !TstAssCompat(tpl, ElementType(tpr)) ) { + if (!TstAssCompat(tpl, ElementType(tpr) )) + { node_error(expp, "\"IN\": incompatible types"); return 0; } - if( left->nd_class == Value && right->nd_class == Set ) + if (left->nd_class == Value && right->nd_class == Set) cstset(expp); return retval; } - if( !retval ) return 0; + if (!retval) + return 0; allowed = AllowedTypes(expp->nd_symb); - if( !(tpr->tp_fund & allowed) || !(tpl->tp_fund & allowed) ) { + if (!(tpr->tp_fund & allowed) || !(tpl->tp_fund & allowed)) + { arith ub; extern arith IsString(); - if( allowed & T_STRINGCONST && (ub = IsString(tpl)) ) { - if( ub == IsString(tpr) ) + if (allowed & T_STRINGCONST && (ub = IsString(tpl))) + { + if (ub == IsString(tpr)) return 1; - else { + else + { node_error(expp, "\"%s\": incompatible types", symbol2str(expp->nd_symb)); return 0; } } - else if( allowed & T_STRING && tpl->tp_fund == T_STRING ) - return 1; + else if (allowed & T_STRING && tpl->tp_fund == T_STRING) + return 1; node_error(expp, "\"%s\": illegal operand type(s)", - symbol2str(expp->nd_symb)); + symbol2str(expp->nd_symb)); return 0; } - if( Boolean(expp->nd_symb) && tpl != bool_type ) { + if (Boolean(expp->nd_symb) && tpl != bool_type) + { node_error(expp, "\"%s\": illegal operand type(s)", - symbol2str(expp->nd_symb)); + symbol2str(expp->nd_symb)); return 0; } - if( allowed & T_NUMERIC ) { - if( (tpl == int_type || tpl == long_type) && - (tpr == real_type || expp->nd_symb == '/') ) { - expp->nd_left = - MkNode(Cast, NULLNODE, expp->nd_left, &dot); + if (allowed & T_NUMERIC) + { + if ((tpl == int_type || tpl == long_type) + && (tpr == real_type || expp->nd_symb == '/')) + { + expp->nd_left = MkNode(Cast, NULLNODE, expp->nd_left, &dot); expp->nd_left->nd_type = tpl = real_type; } - if( tpl == real_type && - (tpr == int_type || tpr == long_type)) { - expp->nd_right = - MkNode(Cast, NULLNODE, expp->nd_right, &dot); + if (tpl == real_type && (tpr == int_type || tpr == long_type)) + { + expp->nd_right = MkNode(Cast, NULLNODE, expp->nd_right, &dot); expp->nd_right->nd_type = tpr = real_type; } - if( tpl == int_type && tpr == long_type) { - expp->nd_left = - MkNode(IntCoerc, NULLNODE, expp->nd_left, &dot); + if (tpl == int_type && tpr == long_type) + { + expp->nd_left = MkNode(IntCoerc, NULLNODE, expp->nd_left, &dot); expp->nd_left->nd_type = long_type; } - else if( tpl == long_type && tpr == int_type) { - expp->nd_right = - MkNode(IntCoerc, NULLNODE, expp->nd_right, &dot); + else if (tpl == long_type && tpr == int_type) + { + expp->nd_right = MkNode(IntCoerc, NULLNODE, expp->nd_right, &dot); expp->nd_right->nd_type = long_type; } } /* Operands must be compatible */ - if( !TstCompat(tpl, tpr) ) { + if (!TstCompat(tpl, tpr)) + { node_error(expp, "\"%s\": incompatible types", - symbol2str(expp->nd_symb)); + symbol2str(expp->nd_symb)); return 0; } - if( tpl->tp_fund & T_SET ) { - if( tpl == emptyset_type ) + if (tpl->tp_fund & T_SET) + { + if (tpl == emptyset_type) left->nd_type = tpr; - else if( tpr == emptyset_type ) + else if (tpr == emptyset_type) right->nd_type = tpl; - if( expp->nd_type == emptyset_type ) + if (expp->nd_type == emptyset_type) expp->nd_type = tpr; - if( left->nd_class == Set && right->nd_class == Set ) + if (left->nd_class == Set && right->nd_class == Set) cstset(expp); } - else if( tpl->tp_fund != T_REAL && - left->nd_class == Value && right->nd_class == Value ) - cstbin(expp); + else if (tpl->tp_fund != T_REAL && left->nd_class == Value + && right->nd_class == Value) + cstbin(expp); return 1; } -STATIC int -ChkElement(expp, tp, set, cnt) - register struct node *expp; - register struct type **tp; - arith **set; - unsigned *cnt; +static int ChkElement(register struct node *expp, register struct type **tp, + arith **set, unsigned *cnt) { /* Check elements of a set. This routine may call itself - recursively. Also try to compute the set! - */ + recursively. Also try to compute the set! + */ register struct node *left = expp->nd_left; register struct node *right = expp->nd_right; register int i; extern char *Malloc(); - if( expp->nd_class == Link && expp->nd_symb == UPTO ) { + if (expp->nd_class == Link && expp->nd_symb == UPTO) + { /* [ ... , expr1 .. expr2, ... ] - First check expr1 and expr2, and try to compute them. - */ - if( !ChkElement(left, tp, set, cnt) || - !ChkElement(right, tp, set, cnt) ) + First check expr1 and expr2, and try to compute them. + */ + if (!ChkElement(left, tp, set, cnt) || !ChkElement(right, tp, set, cnt)) return 0; - if( left->nd_class == Value && - right->nd_class == Value && *set ) { + if (left->nd_class == Value && right->nd_class == Value && *set) + { - if( left->nd_INT > right->nd_INT ) { + if (left->nd_INT > right->nd_INT) + { /* Remove lower and upper bound of the range. - */ + */ *cnt -= 2; - (*set)[left->nd_INT/wrd_bits] &= - ~(1 << (left->nd_INT%wrd_bits)); - (*set)[right->nd_INT/wrd_bits] &= - ~(1 << (right->nd_INT%wrd_bits)); + (*set)[left->nd_INT / wrd_bits] &= ~(1 + << (left->nd_INT % wrd_bits)); + (*set)[right->nd_INT / wrd_bits] &= ~(1 + << (right->nd_INT % wrd_bits)); } else /* We have a constant range. Put all elements - in the set. - */ - for( i = left->nd_INT + 1; i < right->nd_INT; i++ ) - (*set)[i/wrd_bits] |= ( 1 << (i%wrd_bits) ); + in the set. + */ + for (i = left->nd_INT + 1; i < right->nd_INT; i++) + (*set)[i / wrd_bits] |= (1 << (i % wrd_bits)); } return 1; } /* Here, a single element is checked - */ - if( !ChkExpression(expp) ) return 0; + */ + if (!ChkExpression(expp)) return 0; MarkUsed(expp); - if( *tp == emptyset_type ) { + if (*tp == emptyset_type) + { /* first element in set determines the type of the set */ unsigned size; @@ -587,32 +608,38 @@ ChkElement(expp, tp, set, cnt) *set = (arith *) Malloc(size); clear((char *) *set, size); } - else if( !TstCompat(ElementType(*tp), expp->nd_type) ) { + else if (!TstCompat(ElementType(*tp), expp->nd_type)) + { node_error(expp, "set element has incompatible type"); return 0; } - if( expp->nd_class == Value ) { + if (expp->nd_class == Value) + { /* a constant element - */ + */ i = expp->nd_INT; - if( expp->nd_type == int_type ) { + if (expp->nd_type == int_type) + { /* Check only integer base-types because they are not - equal to the integer host-type. The other base-types - are equal to their host-types. - */ + equal to the integer host-type. The other base-types + are equal to their host-types. + */ - if( i < 0 || i > max_intset ) { + if (i < 0 || i > max_intset) + { node_error(expp, "set element out of range"); return 0; } } - if( *set ) (*set)[i/wrd_bits] |= ( 1 << (i%wrd_bits)); + if (*set) + (*set)[i / wrd_bits] |= (1 << (i % wrd_bits)); (*cnt)++; } - else if( *set ) { + else if (*set) + { free((char *) *set); *set = (arith *) 0; } @@ -620,13 +647,11 @@ ChkElement(expp, tp, set, cnt) return 1; } -STATIC int -ChkSet(expp) - register struct node *expp; +static int ChkSet(register struct node *expp) { /* Check the legality of a SET aggregate, and try to evaluate it - compile time. Unfortunately this is all rather complicated. - */ + compile time. Unfortunately this is all rather complicated. + */ register struct node *nd = expp->nd_right; arith *set = (arith *) 0; unsigned cnt = 0; @@ -636,38 +661,42 @@ ChkSet(expp) expp->nd_type = emptyset_type; /* Now check the elements given, and try to compute a constant set. - First allocate room for the set, but only if it isn't empty. - */ - if( !nd ) { + First allocate room for the set, but only if it isn't empty. + */ + if (!nd) + { /* The resulting set IS empty, so we just return - */ + */ expp->nd_class = Set; expp->nd_set = (arith *) 0; return 1; } /* Now check the elements, one by one - */ - while( nd ) { + */ + while (nd) + { assert(nd->nd_class == Link && nd->nd_symb == ','); - if( !ChkElement(nd->nd_left, &(expp->nd_type), &set, &cnt) ) + if (!ChkElement(nd->nd_left, &(expp->nd_type), &set, &cnt)) return 0; nd = nd->nd_right; } - if( set ) { + if (set) + { /* Yes, it was a constant set, and we managed to compute it! - Notice that at the moment there is no such thing as - partial evaluation. Either we evaluate the set, or we - don't (at all). Improvement not neccesary (???) - ??? sets have a contant part and a variable part ??? - */ + Notice that at the moment there is no such thing as + partial evaluation. Either we evaluate the set, or we + don't (at all). Improvement not neccesary (???) + ??? sets have a contant part and a variable part ??? + */ expp->nd_class = Set; - if( !cnt ) { + if (!cnt) + { /* after all the work we've done, the set turned out - out to be empty! - */ + out to be empty! + */ free((char *) set); set = (arith *) 0; } @@ -679,37 +708,41 @@ ChkSet(expp) return 1; } -char * -ChkAllowedVar(nd, reading) /* reading indicates read or readln */ - register struct node *nd; +char *ChkAllowedVar(register struct node *nd, int reading) +/* reading indicates read or readln */ + { char *message = 0; - switch( nd->nd_class ) { + switch (nd->nd_class) + { case Def: - if( nd->nd_def->df_flags & D_INLOOP ) { + if (nd->nd_def->df_flags & D_INLOOP) + { message = "control variable"; break; } - if( nd->nd_def->df_kind != D_FIELD ) break; + if (nd->nd_def->df_kind != D_FIELD) + break; /* FALL THROUGH */ case LinkDef: assert(nd->nd_def->df_kind == D_FIELD); - if( nd->nd_def->fld_flags & F_PACKED ) + if (nd->nd_def->fld_flags & F_PACKED) message = "field of packed record"; - else if( nd->nd_def->fld_flags & F_SELECTOR ) + else if (nd->nd_def->fld_flags & F_SELECTOR) message = "variant selector"; break; case Arrsel: - if( IsPacked(nd->nd_left->nd_type) ) - if( !reading ) message = "component of packed array"; + if (IsPacked(nd->nd_left->nd_type)) + if (!reading) + message = "component of packed array"; break; case Arrow: - if( nd->nd_right->nd_type->tp_fund == T_FILE ) + if (nd->nd_right->nd_type->tp_fund == T_FILE) message = "filebuffer variable"; break; @@ -721,24 +754,24 @@ ChkAllowedVar(nd, reading) /* reading indicates read or readln */ return message; } -int -ChkVarPar(nd, name) - register struct node *nd, *name; +static int ChkVarPar(register struct node *nd, register struct node *name) { /* ISO 6.6.3.3 : - An actual variable parameter shall not denote a field - that is the selector of a variant-part or a component - of a variable where that variable possesses a type - that is designated packed. - */ + An actual variable parameter shall not denote a field + that is the selector of a variant-part or a component + of a variable where that variable possesses a type + that is designated packed. + */ static char err_mes[80]; char *message = (char *) 0; - if( !ChkVariable(nd) ) return 0; + if (!ChkVariable(nd)) + return 0; message = ChkAllowedVar(nd, 0); - if( message ) { + if (message) + { sprint(err_mes, "%s can't be a variable parameter", message); Xerror(name, err_mes); return 0; @@ -746,22 +779,22 @@ ChkVarPar(nd, name) return 1; } -STATIC struct node * -getarg(argp, bases, varaccess, name, paramtp) - struct node **argp, *name; - struct type *paramtp; +static struct node * +getarg(struct node **argp, int bases, int varaccess, struct node *name, + struct type *paramtp) { /* This routine is used to fetch the next argument from an - argument list. The argument list is indicated by "argp". - The parameter "bases" is a bitset indicating which types are - allowed at this point, and "varaccess" is a flag indicating - that the address from this argument is taken, so that it - must be a varaccess and may not be a register variable. - */ + argument list. The argument list is indicated by "argp". + The parameter "bases" is a bitset indicating which types are + allowed at this point, and "varaccess" is a flag indicating + that the address from this argument is taken, so that it + must be a varaccess and may not be a register variable. + */ register struct node *arg = (*argp)->nd_right; register struct node *left; - if( !arg ) { + if (!arg) + { Xerror(name, "too few arguments supplied"); return 0; } @@ -769,41 +802,50 @@ getarg(argp, bases, varaccess, name, paramtp) left = arg->nd_left; *argp = arg; - if( paramtp && paramtp->tp_fund & T_ROUTINE ) { + if (paramtp && paramtp->tp_fund & T_ROUTINE) + { /* From the context it appears that the occurrence of the - procedure/function-identifier is not a call. - */ - if( left->nd_class != NameOrCall ) { + procedure/function-identifier is not a call. + */ + if (left->nd_class != NameOrCall) + { Xerror(name, "illegal proc/func parameter"); return 0; } - else if( ChkLinkOrName(left->nd_left) ) { + else if (ChkLinkOrName(left->nd_left)) + { left->nd_type = left->nd_left->nd_type; MarkUsed(left->nd_left); } - else return 0; + else + return 0; } - else if( varaccess ) { - if( !ChkVarPar(left, name) ) { - MarkUsed(left); - return 0; - } + else if (varaccess) + { + if (!ChkVarPar(left, name)) + { + MarkUsed(left); + return 0; + } } - else if( !ChkExpression(left) ) { + else if (!ChkExpression(left)) + { MarkUsed(left); return 0; } MarkUsed(left); - if( !varaccess && bases == T_INTEGER && - BaseType(left->nd_type)->tp_fund == T_LONG) { + if (!varaccess && bases == T_INTEGER + && BaseType(left->nd_type)->tp_fund == T_LONG) + { arg->nd_left = MkNode(IntReduc, NULLNODE, left, &dot); arg->nd_left->nd_type = int_type; left = arg->nd_left; } - if( bases && !(BaseType(left->nd_type)->tp_fund & bases) ) { + if (bases && !(BaseType(left->nd_type)->tp_fund & bases)) + { Xerror(name, "unexpected parameter type"); return 0; } @@ -811,12 +853,10 @@ getarg(argp, bases, varaccess, name, paramtp) return left; } -STATIC int -ChkProcCall(expp) - struct node *expp; +static int ChkProcCall(struct node *expp) { /* Check a procedure call - */ + */ register struct node *left; struct node *name; register struct paramlist *param; @@ -828,104 +868,107 @@ ChkProcCall(expp) name = left = expp->nd_left; - if( left->nd_type == error_type ) { + if (left->nd_type == error_type) + { /* Just check parameters as if they were value parameters - */ + */ expp->nd_type = error_type; - while( expp->nd_right ) - (void) getarg(&expp, 0, 0, name, NULLTYPE); + while (expp->nd_right) + (void) getarg(&expp, 0, 0, name, NULLTYPE ); return 0; } expp->nd_type = ResultType(left->nd_type); /* Check parameter list - */ - for( param = ParamList(left->nd_type); param; param = param->next ) { - if( !(left = getarg(&expp, 0, (int) IsVarParam(param), name, - TypeOfParam(param))) ) + */ + for (param = ParamList(left->nd_type) ; param; param = param->next) + { + if (!(left = getarg(&expp, 0, (int) IsVarParam(param), name, + TypeOfParam(param)))) return 0; cnt++; new_par_section = lasttp != TypeOfParam(param); - if( !TstParCompat(TypeOfParam(param), left->nd_type, - (int) IsVarParam(param), left, new_par_section) ) { - sprint(ebuf, "type incompatibility in parameter %d", - cnt); + if (!TstParCompat(TypeOfParam(param), left->nd_type, + (int) IsVarParam(param), left, new_par_section)) + { + sprint(ebuf, "type incompatibility in parameter %d", cnt); Xerror(name, ebuf); retval = 0; } /* Convert between integers and longs. */ - if( !IsVarParam(param) && options['d'] ) { - if( left->nd_type->tp_fund == T_INTEGER && - TypeOfParam(param)->tp_fund == T_LONG) { - expp->nd_left = - MkNode(IntCoerc, NULLNODE, left, &dot); + if (!IsVarParam(param) && options['d']) + { + if (left->nd_type->tp_fund == T_INTEGER + && TypeOfParam(param)->tp_fund == T_LONG) + { + expp->nd_left = MkNode(IntCoerc, NULLNODE, left, &dot); expp->nd_left->nd_type = long_type; left = expp->nd_left; } - else if( left->nd_type->tp_fund == T_LONG && - TypeOfParam(param)->tp_fund == T_INTEGER) { - expp->nd_left = - MkNode(IntReduc, NULLNODE, left, &dot); + else if (left->nd_type->tp_fund == T_LONG + && TypeOfParam(param)->tp_fund == T_INTEGER) + { + expp->nd_left = MkNode(IntReduc, NULLNODE, left, &dot); expp->nd_left->nd_type = int_type; left = expp->nd_left; } } - if( left->nd_type == emptyset_type ) + if (left->nd_type == emptyset_type) /* type of emptyset determined by the context */ left->nd_type = TypeOfParam(param); lasttp = TypeOfParam(param); } - if( expp->nd_right ) { + if (expp->nd_right) + { Xerror(name, "too many arguments supplied"); - while( expp->nd_right ) - (void) getarg(&expp, 0, 0, name, NULLTYPE); + while (expp->nd_right) + (void) getarg(&expp, 0, 0, name, NULLTYPE ); return 0; } return retval; } -STATIC int ChkStandard(); - -int -ChkCall(expp) - register struct node *expp; +int ChkCall(register struct node *expp) { /* Check something that looks like a procedure or function call. - Of course this does not have to be a call at all, - it may also be a standard procedure call. - */ + Of course this does not have to be a call at all, + it may also be a standard procedure call. + */ /* First, get the name of the function or procedure - */ + */ register struct node *left = expp->nd_left; expp->nd_type = error_type; - if( ChkLinkOrName(left) ) { + if (ChkLinkOrName(left)) + { MarkUsed(left); - if( IsProcCall(left) || left->nd_type == error_type ) { + if (IsProcCall(left) || left->nd_type == error_type) + { /* A call. - It may also be a call to a standard procedure - */ + It may also be a call to a standard procedure + */ - if( left->nd_type == std_type ) + if (left->nd_type == std_type) /* A standard procedure - */ + */ return ChkStandard(expp, left); /* Here, we have found a real procedure call. - */ + */ } - else { + else + { node_error(left, "procedure or function expected"); return 0; } @@ -933,38 +976,34 @@ ChkCall(expp) return ChkProcCall(expp); } -STATIC int -ChkExCall(expp) - register struct node *expp; +static int ChkExCall(register struct node *expp) { - if( !ChkCall(expp) ) return 0; + if (!ChkCall(expp)) + return 0; - if( !expp->nd_type ) { + if (!expp->nd_type) + { node_error(expp, "function call expected"); return 0; } return 1; } -STATIC int -ChkNameOrCall(expp) - register struct node *expp; +static int ChkNameOrCall(register struct node *expp) { /* From the context it appears that the occurrence of the function- - identifier is a call to that function - */ + identifier is a call to that function + */ assert(expp->nd_class == NameOrCall); expp->nd_class = Call; return ChkExCall(expp); } -STATIC int -ChkStandard(expp,left) - register struct node *expp, *left; +static int ChkStandard(register struct node *expp, register struct node *left) { /* Check a call of a standard procedure or function - */ + */ struct node *arg = expp; struct node *name = left; @@ -974,208 +1013,228 @@ ChkStandard(expp,left) req = left->nd_def->df_value.df_reqname; - switch( req ) { - case R_ABS: - case R_SQR: - if( !(left = getarg(&arg, T_NUMERIC, 0, name, NULLTYPE)) ) + switch (req) + { + case R_ABS: + case R_SQR: + if (!(left = getarg(&arg, T_NUMERIC, 0, name, NULLTYPE ))) return 0; expp->nd_type = left->nd_type; - if( left->nd_class == Value && - expp->nd_type->tp_fund != T_REAL ) + if (left->nd_class == Value && expp->nd_type->tp_fund != T_REAL) cstcall(expp, req); break; - case R_SIN: - case R_COS: - case R_EXP: - case R_LN: - case R_SQRT: - case R_ARCTAN: - if( !(left = getarg(&arg, T_NUMERIC, 0, name, NULLTYPE)) ) + case R_SIN: + case R_COS: + case R_EXP: + case R_LN: + case R_SQRT: + case R_ARCTAN: + if (!(left = getarg(&arg, T_NUMERIC, 0, name, NULLTYPE ))) return 0; expp->nd_type = real_type; - if( BaseType(left->nd_type)->tp_fund == T_INTEGER || - BaseType(left->nd_type)->tp_fund == T_LONG) { - arg->nd_left = MkNode(Cast,NULLNODE, arg->nd_left,&dot); + if (BaseType(left->nd_type)->tp_fund == T_INTEGER + || BaseType(left->nd_type)->tp_fund == T_LONG) + { + arg->nd_left = MkNode(Cast, NULLNODE, arg->nd_left, &dot); arg->nd_left->nd_type = real_type; } break; - case R_TRUNC: - case R_ROUND: - if( !(left = getarg(&arg, T_REAL, 0, name, NULLTYPE)) ) + case R_TRUNC: + case R_ROUND: + if (!(left = getarg(&arg, T_REAL, 0, name, NULLTYPE ))) return 0; expp->nd_type = int_type; break; - case R_ORD: - if( !(left = getarg(&arg, T_ORDINAL, 0, name, NULLTYPE)) ) + case R_ORD: + if (!(left = getarg(&arg, T_ORDINAL, 0, name, NULLTYPE ))) return 0; - if( BaseType(left->nd_type)->tp_fund == T_LONG ) { + if (BaseType(left->nd_type)->tp_fund == T_LONG) + { arg->nd_left = MkNode(IntReduc, NULLNODE, arg->nd_left, &dot); arg->nd_left->nd_type = int_type; } expp->nd_type = int_type; - if( left->nd_class == Value ) + if (left->nd_class == Value) cstcall(expp, R_ORD); break; - case R_CHR: - if( !(left = getarg(&arg, T_INTEGER, 0, name, NULLTYPE)) ) + case R_CHR: + if (!(left = getarg(&arg, T_INTEGER, 0, name, NULLTYPE ))) return 0; expp->nd_type = char_type; - if( left->nd_class == Value ) + if (left->nd_class == Value) cstcall(expp, R_CHR); break; - case R_SUCC: - case R_PRED: - if( !(left = getarg(&arg, T_ORDINAL, 0, name, NULLTYPE)) ) + case R_SUCC: + case R_PRED: + if (!(left = getarg(&arg, T_ORDINAL, 0, name, NULLTYPE ))) return 0; expp->nd_type = left->nd_type; - if( left->nd_class == Value && options['R'] ) + if (left->nd_class == Value && options['R']) cstcall(expp, req); break; - case R_ODD: - if( !(left = getarg(&arg, T_INTEGER | T_LONG , 0, name, NULLTYPE)) ) + case R_ODD: + if (!(left = getarg(&arg, T_INTEGER | T_LONG, 0, name, NULLTYPE ))) return 0; expp->nd_type = bool_type; - if( left->nd_class == Value ) + if (left->nd_class == Value) cstcall(expp, R_ODD); break; - case R_EOF: - case R_EOLN: - case R_GET: - case R_PAGE: { + case R_EOF: + case R_EOLN: + case R_GET: + case R_PAGE: + { int st_out; - if( req == R_PAGE ) { + if (req == R_PAGE) + { expp->nd_type = NULLTYPE; st_out = 1; } - else { + else + { st_out = 0; - if (req == R_GET) { + if (req == R_GET) + { expp->nd_type = NULLTYPE; } - else expp->nd_type = bool_type; + else + expp->nd_type = bool_type; } - if( !arg->nd_right ) { + if (!arg->nd_right) + { struct node *nd; - if( !(nd = ChkStdInOut(name->nd_IDF->id_text, st_out)) ) + if (!(nd = ChkStdInOut(name->nd_IDF->id_text, st_out))) return 0; expp->nd_right = MkNode(Link, nd, NULLNODE, &dot); expp->nd_right->nd_symb = ','; arg = arg->nd_right; } - else { - if( !(left = getarg(&arg, T_FILE, 1, name, NULLTYPE)) ) + else + { + if (!(left = getarg(&arg, T_FILE, 1, name, NULLTYPE ))) return 0; - if( (req == R_PAGE || req == R_EOLN) - && left->nd_type != text_type ) { + if ((req == R_PAGE || req == R_EOLN) && left->nd_type != text_type) + { Xerror(name, "textfile expected"); return 0; } } break; - } - case R_REWRITE: - case R_PUT: - case R_RESET: - if( !(left = getarg(&arg, T_FILE, 1, name, NULLTYPE)) ) + } + case R_REWRITE: + case R_PUT: + case R_RESET: + if (!(left = getarg(&arg, T_FILE, 1, name, NULLTYPE ))) return 0; expp->nd_type = NULLTYPE; break; - case R_PACK: - case R_UNPACK: { + case R_PACK: + case R_UNPACK: + { struct type *tp1, *tp2, *tp3; - if( req == R_PACK ) { + if (req == R_PACK) + { /* pack(a, i, z) */ - if( !(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE)) ) + if (!(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE ))) return 0; - tp1 = left->nd_type; /* (a) */ - if( !(left = getarg(&arg, 0, 0, name, NULLTYPE)) ) + tp1 = left->nd_type; /* (a) */ + if (!(left = getarg(&arg, 0, 0, name, NULLTYPE ))) return 0; - tp2 = left->nd_type; /* (i) */ - if( !(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE)) ) + tp2 = left->nd_type; /* (i) */ + if (!(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE ))) return 0; - tp3 = left->nd_type; /* (z) */ + tp3 = left->nd_type; /* (z) */ } - else { + else + { /* unpack(z, a, i) */ - if( !(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE)) ) + if (!(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE ))) return 0; - tp3 = left->nd_type; /* (z) */ - if( !(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE)) ) + tp3 = left->nd_type; /* (z) */ + if (!(left = getarg(&arg, T_ARRAY, 1, name, NULLTYPE ))) return 0; - tp1 = left->nd_type; /* (a) */ - if( !(left = getarg(&arg, 0, 0, name, NULLTYPE)) ) + tp1 = left->nd_type; /* (a) */ + if (!(left = getarg(&arg, 0, 0, name, NULLTYPE ))) return 0; - tp2 = left->nd_type; /* (i) */ + tp2 = left->nd_type; /* (i) */ } - if( IsConformantArray(tp1) || IsPacked(tp1) ) { + if (IsConformantArray(tp1) || IsPacked(tp1)) + { Xerror(name, "unpacked array expected"); return 0; } - if( !TstAssCompat(IndexType(tp1), tp2) ) { + if (!TstAssCompat(IndexType(tp1), tp2)) + { Xerror(name, "ordinal constant expected"); return 0; } - if( IsConformantArray(tp3) || !IsPacked(tp3) ) { + if (IsConformantArray(tp3) || !IsPacked(tp3)) + { Xerror(name, "packed array expected"); return 0; } - if( !TstTypeEquiv(tp1->arr_elem, tp3->arr_elem) ) { + if (!TstTypeEquiv(tp1->arr_elem, tp3->arr_elem)) + { Xerror(name, "component types of arrays not equal"); return 0; } expp->nd_type = NULLTYPE; break; - } + } - case R_NEW: - case R_DISPOSE: - if( !(left = getarg(&arg, T_POINTER, 1, name, NULLTYPE)) ) + case R_NEW: + case R_DISPOSE: + if (!(left = getarg(&arg, T_POINTER, 1, name, NULLTYPE ))) return 0; - if( arg->nd_right ) { + if (arg->nd_right) + { /* varargs new/dispose(p,c1,.....) */ register struct selector *sel; register arith i; - if( PointedtoType(left->nd_type)->tp_fund != T_RECORD ) + if (PointedtoType(left->nd_type) ->tp_fund != T_RECORD) break; - sel = PointedtoType(left->nd_type)->rec_sel; - do { - if( !sel ) break; + sel = PointedtoType(left->nd_type) ->rec_sel; + do + { + if (!sel) + break; arg = arg->nd_right; left = arg->nd_left; /* ISO : COMPILETIME CONSTANTS NOT PERMITTED */ - if( !ChkConstant(left) ) return 0; + if (!ChkConstant(left)) + return 0; - if( !TstCompat(left->nd_type, sel->sel_type) ) { - node_error(left, - "type incompatibility in caselabel"); + if (!TstCompat(left->nd_type, sel->sel_type)) + { + node_error(left, "type incompatibility in caselabel"); return 0; } i = left->nd_INT - sel->sel_lb; - if( i < 0 || i >= sel->sel_ncst ) { - node_error(left, - "case constant: out of bounds"); + if (i < 0 || i >= sel->sel_ncst) + { + node_error(left, "case constant: out of bounds"); return 0; } sel = sel->sel_ptrs[i]; - } while( arg->nd_right ); + } while (arg->nd_right); FreeNode(expp->nd_right->nd_right); expp->nd_right->nd_right = NULLNODE; @@ -1183,19 +1242,20 @@ ChkStandard(expp,left) expp->nd_type = NULLTYPE; break; - case R_HALT: - if( !arg->nd_right ) /* insert 0 parameter */ + case R_HALT: + if (!arg->nd_right) /* insert 0 parameter */ arg->nd_right = ZeroParam(); - if( !(left = getarg(&arg, T_INTEGER, 0, name, NULLTYPE)) ) + if (!(left = getarg(&arg, T_INTEGER, 0, name, NULLTYPE ))) return 0; expp->nd_type = NULLTYPE; break; - default: + default: crash("(ChkStandard)"); } - - if( arg->nd_right ) { + + if (arg->nd_right) + { Xerror(name, "too many arguments supplied"); return 0; } @@ -1203,14 +1263,12 @@ ChkStandard(expp,left) return 1; } -STATIC int -ChkArrow(expp) - register struct node *expp; +static int ChkArrow(register struct node *expp) { /* Check an application of the '^' operator. - The operand must be a variable of a pointer-type or a - variable of a file-type. - */ + The operand must be a variable of a pointer-type or a + variable of a file-type. + */ register struct type *tp; @@ -1219,13 +1277,15 @@ ChkArrow(expp) expp->nd_type = error_type; - if( !ChkVariable(expp->nd_right) ) return 0; + if (!ChkVariable(expp->nd_right)) + return 0; MarkUsed(expp->nd_right); tp = expp->nd_right->nd_type; - if( !(tp->tp_fund & (T_POINTER | T_FILE)) ) { + if (!(tp->tp_fund & (T_POINTER | T_FILE))) + { node_error(expp, "\"^\": illegal operand"); return 0; } @@ -1234,15 +1294,13 @@ ChkArrow(expp) return 1; } -STATIC int -ChkArr(expp) - register struct node *expp; +static int ChkArr(register struct node *expp) { /* Check an array selection. - The left hand side must be a variable of an array type, - and the right hand side must be an expression that is - assignment compatible with the array-index. - */ + The left hand side must be a variable of an array type, + and the right hand side must be an expression that is + assignment compatible with the array-index. + */ register struct type *tpl, *tpr; int retval; @@ -1262,22 +1320,26 @@ ChkArr(expp) tpl = expp->nd_left->nd_type; tpr = expp->nd_right->nd_type; - if( tpl == error_type || tpr == error_type ) return 0; + if (tpl == error_type || tpr == error_type) + return 0; - if( tpl->tp_fund != T_ARRAY ) { + if (tpl->tp_fund != T_ARRAY) + { node_error(expp, "not indexing an ARRAY type"); return 0; } /* Type of the index must be assignment compatible with - the index type of the array. - */ - if( !TstCompat(IndexType(tpl), tpr) ) { + the index type of the array. + */ + if (!TstCompat(IndexType(tpl), tpr)) + { node_error(expp, "incompatible index type"); return 0; } - if( tpr == long_type ) { + if (tpr == long_type) + { expp->nd_right = MkNode(IntReduc, NULLNODE, expp->nd_right, &dot); expp->nd_right->nd_type = int_type; } @@ -1286,23 +1348,19 @@ ChkArr(expp) return retval; } -STATIC int -done_before() +static int done_before(struct node *expp) { return 1; } -STATIC int -no_var_access(expp) - struct node *expp; +static int no_var_access(struct node *expp) { node_error(expp, "variable-access expected"); return 0; } -extern int NodeCrash(); - -int (*ExprChkTable[])() = { +int (*ExprChkTable[])(struct node*) = +{ #ifdef DEBUG ChkValue, #else @@ -1323,23 +1381,24 @@ int (*ExprChkTable[])() = { NodeCrash, NodeCrash, NodeCrash -}; - -int (*VarAccChkTable[])() = { - no_var_access, - ChkLinkOrName, - no_var_access, - no_var_access, - no_var_access, - NodeCrash, - no_var_access, - no_var_access, - ChkArrow, - ChkArr, - done_before, - ChkLinkOrName, - done_before, - no_var_access, - no_var_access, - no_var_access -}; + }; + + int (*VarAccChkTable[])() = + { + no_var_access, + ChkLinkOrName, + no_var_access, + no_var_access, + no_var_access, + NodeCrash, + no_var_access, + no_var_access, + ChkArrow, + ChkArr, + done_before, + ChkLinkOrName, + done_before, + no_var_access, + no_var_access, + no_var_access + }; diff --git a/lang/pc/comp/chk_expr.h b/lang/pc/comp/chk_expr.h index 7357155b1..396ee8fb5 100644 --- a/lang/pc/comp/chk_expr.h +++ b/lang/pc/comp/chk_expr.h @@ -1,5 +1,7 @@ /* E X P R E S S I O N C H E C K I N G */ +struct node; + extern int (*ExprChkTable[])(); /* table of expression checking functions, indexed by node class */ @@ -10,3 +12,14 @@ extern int (*VarAccChkTable[])(); /* table of variable-access checking #define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp)) #define ChkVarAccess(expp) ((*VarAccChkTable[(expp)->nd_class])(expp)) + +int ChkConstant(register struct node *expp); +int ChkVariable(register struct node *expp); +/* Check that "expp" indicates an item that can be the lhs + of an assignment, return 1 if possible, on return 0. + */ +int ChkLhs(register struct node *expp); +int ChkLinkOrName(register struct node *expp); +char *ChkAllowedVar(register struct node *nd, int reading); +int ChkCall(register struct node *expp); +void MarkUsed(register struct node *nd); diff --git a/lang/pc/comp/code.c b/lang/pc/comp/code.c index 5cdc6644a..37cafde73 100644 --- a/lang/pc/comp/code.c +++ b/lang/pc/comp/code.c @@ -21,59 +21,75 @@ #include "required.h" #include "scope.h" #include "type.h" +#include "code.h" +#include "tmpvar.h" +#include "typequiv.h" +#include "error.h" -int fp_used; +int fp_used; -void Long2Int(); -void Int2Long(); -void genrck(); -void CodeCall(); +static void CodeUoper(register struct node *); +static void CodeBoper(register struct node *, /* the expression tree itself */ +label); +static void CodeSet(register struct node *); +static void CodeEl(register struct node *, register struct type *); +static void CodePString(struct node *, struct type *); +/* General internal system API calls */ +static void CodeStd(struct node *); -CodeFil() +static void genrck(register struct type *); +static void RegisterMessages(register struct def *); +static void CodeConfDescr(register struct type *, register struct type *); + +extern void call_ini(void); + + + +static void CodeFil(void) { - if ( !options['L'] ) - C_fil_dlb((label) 1, (arith) 0); + if (!options['L']) + C_fil_dlb((label ) 1, (arith) 0); } -routine_label(df) - register struct def * df; +void routine_label(register struct def * df) { df->prc_label = ++data_label; C_df_dlb(df->prc_label); C_rom_scon(df->df_idf->id_text, (arith)(strlen(df->df_idf->id_text) + 1)); } -RomString(nd) - register struct node *nd; +void RomString(register struct node *nd) { C_df_dlb(++data_label); /* A string of the string_type is null-terminated. */ - if( nd->nd_type == string_type ) - C_rom_scon(nd->nd_STR, nd->nd_SLE + 1); /* with trailing '\0' */ + if (nd->nd_type == string_type) + C_rom_scon(nd->nd_STR, nd->nd_SLE + 1); /* with trailing '\0' */ else - C_rom_scon(nd->nd_STR, nd->nd_SLE); /* no trailing '\0' */ + C_rom_scon(nd->nd_STR, nd->nd_SLE); /* no trailing '\0' */ nd->nd_SLA = data_label; } -RomReal(nd) - register struct node *nd; +void RomReal(register struct node *nd) { - if (! nd->nd_RLA) { + if (!nd->nd_RLA) + { C_df_dlb(++data_label); nd->nd_RLA = data_label; C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size); } } -BssVar() +void BssVar(void) { /* generate bss segments for global variables */ register struct def *df = GlobalScope->sc_def; - while( df ) { - if( df->df_kind == D_VARIABLE ) { + while (df) + { + if (df->df_kind == D_VARIABLE) + { C_df_dnam(df->var_name); /* ??? undefined value ??? */ @@ -83,19 +99,20 @@ BssVar() } } -arith -CodeGtoDescr(sc) - register struct scope *sc; +static arith CodeGtoDescr(register struct scope *sc) { /* Create code for goto descriptors - */ + */ register struct node *lb = sc->sc_lablist; int first = 1; - while( lb ) { - if( lb->nd_def->lab_descr ) { - if( first ) { + while (lb) + { + if (lb->nd_def->lab_descr) + { + if (first) + { /* create local for target SP */ sc->sc_off = -WA(pointer_size - sc->sc_off); C_ms_gto(); @@ -107,27 +124,27 @@ CodeGtoDescr(sc) } lb = lb->nd_next; } - if( !first ) + if (!first) return sc->sc_off; else return (arith) 0; } -arith -CodeBeginBlock(df) - register struct def *df; +arith CodeBeginBlock(register struct def *df) { /* Generate code at the beginning of the main program, - procedure or function. - */ + procedure or function. + */ arith StackAdjustment = 0; - arith offset = 0; /* offset to save StackPointer */ + arith offset = 0; /* offset to save StackPointer */ TmpOpen(df->prc_vis->sc_scope); - if ( df->df_kind == D_MODULE) /* nothing */ ; - else if (df->df_kind == D_PROGRAM ) { + if (df->df_kind == D_MODULE) /* nothing */ + ; + else if (df->df_kind == D_PROGRAM) + { C_exp("_m_a_i_n"); C_pro_narg("_m_a_i_n"); C_ms_par((arith) 0); @@ -136,13 +153,13 @@ CodeBeginBlock(df) /* initialize external files */ call_ini(); - /* ignore floating point underflow */ - C_lim(); - C_loc((arith) (1 << EFUNFL)); + /* ignore floating point underflow */C_lim(); + C_loc((arith)(1 << EFUNFL)); C_ior(int_size); C_sim(); } - else if (df->df_kind & (D_PROCEDURE | D_FUNCTION)) { + else if (df->df_kind & (D_PROCEDURE | D_FUNCTION)) + { struct type *tp; register struct paramlist *param; @@ -152,8 +169,9 @@ CodeBeginBlock(df) offset = CodeGtoDescr(df->prc_vis->sc_scope); CodeFil(); - if( options['t'] ) { - C_lae_dlb(df->prc_label,(arith)0); + if (options['t']) + { + C_lae_dlb(df->prc_label, (arith) 0); C_cal("procentry"); C_asp(pointer_size); } @@ -163,25 +181,30 @@ CodeBeginBlock(df) * with the -R option. The variable, however, is always * allocated and initialized. */ - if( df->prc_res ) { + if (df->prc_res) + { C_zer((arith) int_size); C_stl(df->prc_bool); } - for( param = ParamList(df->df_type); param; param = param->next) { - if( !IsVarParam(param) ) { + for (param = ParamList(df->df_type) ; param; param = param->next) + { + if (!IsVarParam(param)) + { tp = TypeOfParam(param); - if( IsConformantArray(tp) ) { + if (IsConformantArray(tp)) + { /* Here, we have to make a copy of the - array. We must also remember how much - room is reserved for copies, because - we have to adjust the stack pointer - before we return. - */ - - if( !StackAdjustment ) { + array. We must also remember how much + room is reserved for copies, because + we have to adjust the stack pointer + before we return. + */ + + if (!StackAdjustment) + { /* First time we get here - */ + */ StackAdjustment = NewInt(0); C_loc((arith) 0); C_stl(StackAdjustment); @@ -192,9 +215,9 @@ CodeBeginBlock(df) /* First compute size of the array */ C_lol(tp->arr_cfdescr + word_size); C_inc(); - /* gives number of elements */ + /* gives number of elements */ C_lol(tp->arr_cfdescr + 2 * word_size); - /* size of elements */ + /* size of elements */ C_mli(word_size); C_loc(word_size - 1); C_adi(word_size); @@ -205,24 +228,26 @@ CodeBeginBlock(df) C_lol(StackAdjustment); C_adi(word_size); C_stl(StackAdjustment); - /* remember stack adjustments */ + /* remember stack adjustments */ - C_los(word_size); /* copy */ - C_lor((arith) 1); - /* push new address of array - ... downwards ... ??? - */ + C_los(word_size); /* copy */ + C_lor((arith) 1); + /* push new address of array + ... downwards ... ??? + */ C_stl(param->par_def->var_off); } } } } - else { + else + { crash("(CodeBeginBlock)"); /*NOTREACHED*/ } - if( offset ) { + if (offset) + { /* save SP for non-local jump */ C_lor((arith) 1); C_stl(offset); @@ -230,43 +255,48 @@ CodeBeginBlock(df) return StackAdjustment; } -CodeEndBlock(df, StackAdjustment) - register struct def *df; - arith StackAdjustment; +void CodeEndBlock(register struct def *df, arith StackAdjustment) { - if( df->df_kind == D_PROGRAM) { + if (df->df_kind == D_PROGRAM) + { C_loc((arith) 0); C_cal("_hlt"); } - else if (df->df_kind & (D_PROCEDURE | D_FUNCTION)) { + else if (df->df_kind & (D_PROCEDURE | D_FUNCTION)) + { struct type *tp; - if( StackAdjustment ) { + if (StackAdjustment) + { /* remove copies of conformant arrays */ C_lol(StackAdjustment); C_ass(word_size); FreeInt(StackAdjustment); } - if( !options['n'] ) + if (!options['n']) RegisterMessages(df->prc_vis->sc_scope->sc_def); - if( options['t'] ) { - C_lae_dlb(df->prc_label,(arith)0); + if (options['t']) + { + C_lae_dlb(df->prc_label, (arith) 0); C_cal("procexit"); C_asp(pointer_size); } - if( tp = ResultType(df->df_type) ) { - if( !options['R'] ) { - C_lin((arith)LineNumber); + if ( (tp = ResultType(df->df_type)) ) + { + if (!options['R']) + { + C_lin((arith) LineNumber); C_lol(df->prc_bool); C_cal("_nfa"); C_asp(word_size); } - if( tp->tp_size == word_size ) + if (tp->tp_size == word_size) C_lol(-tp->tp_size); - else if( tp->tp_size == 2 * word_size ) + else if (tp->tp_size == 2 * word_size) C_ldl(-tp->tp_size); - else { + else + { C_lal(-tp->tp_size); C_loi(tp->tp_size); } @@ -276,27 +306,29 @@ CodeEndBlock(df, StackAdjustment) else C_ret((arith) 0); } - else { + else + { crash("(CodeEndBlock)"); /*NOTREACHED*/ } - C_end(- df->prc_vis->sc_scope->sc_off); + C_end(-df->prc_vis->sc_scope->sc_off); TmpClose(); } -CodeExpr(nd, ds, true_label) - register struct node *nd; - register struct desig *ds; - label true_label; +void CodeExpr(register struct node *nd, register struct desig *ds, + label true_label) { register struct type *tp = nd->nd_type; - if( tp->tp_fund == T_REAL ) fp_used = 1; + if (tp->tp_fund == T_REAL) + fp_used = 1; - switch( nd->nd_class ) { + switch (nd->nd_class) + { case Value: - switch( nd->nd_symb ) { + switch (nd->nd_symb) + { case INTEGER: C_loc(nd->nd_INT); break; @@ -306,7 +338,7 @@ CodeExpr(nd, ds, true_label) C_loi(tp->tp_size); break; case STRING: - if( tp->tp_fund == T_CHAR ) + if (tp->tp_fund == T_CHAR) C_loc(nd->nd_INT); else C_lae_dlb(nd->nd_SLA, (arith) 0); @@ -332,19 +364,21 @@ CodeExpr(nd, ds, true_label) true_label = NO_LABEL; break; - case Set: { + case Set: + { register arith *st = nd->nd_set; register int i; ds->dsg_kind = DSG_LOADED; - if( !st ) { + if (!st) + { C_zer(tp->tp_size); break; } - for( i = tp->tp_size / word_size, st += i; i > 0; i--) + for (i = tp->tp_size / word_size, st += i; i > 0; i--) C_loc(*--st); - } + } break; case Xset: @@ -357,18 +391,20 @@ CodeExpr(nd, ds, true_label) ds->dsg_kind = DSG_LOADED; break; - case NameOrCall: { + case NameOrCall: + { /* actual procedure/function parameter */ struct node *left = nd->nd_left; struct def *df = left->nd_def; - if( df->df_kind & D_ROUTINE ) { + if (df->df_kind & D_ROUTINE) + { int level = df->df_scope->sc_level; - if( level <= 0 || (df->df_flags & D_EXTERNAL) ) + if (level <= 0 || (df->df_flags & D_EXTERNAL)) C_zer(pointer_size); else - C_lxl((arith) (proclevel - level)); + C_lxl((arith)(proclevel - level)); C_lpi(df->prc_name); ds->dsg_kind = DSG_LOADED; @@ -388,7 +424,8 @@ CodeExpr(nd, ds, true_label) CodeDesig(nd, ds); break; - case Cast: { + case Cast: + { /* convert integer to real */ struct node *right = nd->nd_right; @@ -397,7 +434,8 @@ CodeExpr(nd, ds, true_label) ds->dsg_kind = DSG_LOADED; break; } - case IntCoerc: { + case IntCoerc: + { /* convert integer to long integer */ struct node *right = nd->nd_right; @@ -406,7 +444,8 @@ CodeExpr(nd, ds, true_label) ds->dsg_kind = DSG_LOADED; break; } - case IntReduc: { + case IntReduc: + { /* convert a long to an integer */ struct node *right = nd->nd_right; @@ -420,272 +459,283 @@ CodeExpr(nd, ds, true_label) /*NOTREACHED*/ } /* switch class */ - if( true_label ) { + if (true_label) + { /* Only for boolean expressions - */ + */ CodeValue(ds, tp); C_zeq(true_label); } } -CodeUoper(nd) - register struct node *nd; +static void CodeUoper(register struct node *nd) { register struct type *tp = nd->nd_type; CodePExpr(nd->nd_right); - switch( nd->nd_symb ) { - case '-': - assert(tp->tp_fund & T_NUMERIC); - if( tp->tp_fund == T_INTEGER || tp->tp_fund == T_LONG ) - C_ngi(tp->tp_size); - else - C_ngf(tp->tp_size); - break; + switch (nd->nd_symb) + { + case '-': + assert(tp->tp_fund & T_NUMERIC); + if (tp->tp_fund == T_INTEGER || tp->tp_fund == T_LONG) + C_ngi(tp->tp_size); + else + C_ngf(tp->tp_size); + break; - case NOT: - C_teq(); - break; + case NOT: + C_teq(); + break; - case '(': - break; + case '(': + break; - default: - crash("(CodeUoper)"); - /*NOTREACHED*/ + default: + crash("(CodeUoper)"); + /*NOTREACHED*/ + } +} + +/* truthvalue() serves as an auxiliary function of CodeBoper */ +static void truthvalue(int relop) +{ + switch (relop) + { + case '<': + C_tlt(); + break; + case LESSEQUAL: + C_tle(); + break; + case '>': + C_tgt(); + break; + case GREATEREQUAL: + C_tge(); + break; + case '=': + C_teq(); + break; + case NOTEQUAL: + C_tne(); + break; + default: + crash("(truthvalue)"); + /*NOTREACHED*/ } } -Operands(leftop, rightop) - register struct node *leftop, *rightop; + + +static void Operands(register struct node *leftop, register struct node *rightop) { CodePExpr(leftop); CodePExpr(rightop); } -CodeBoper(expr, true_label) - register struct node *expr; /* the expression tree itself */ - label true_label; /* label to jump to in logical exprs */ +static void CodeBoper(register struct node *expr, /* the expression tree itself */ +label true_label) /* label to jump to in logical exprs */ { register struct node *leftop = expr->nd_left; register struct node *rightop = expr->nd_right; register struct type *tp = expr->nd_type; - switch( expr->nd_symb ) { - case '+': - Operands(leftop, rightop); - switch( tp->tp_fund ) { - case T_INTEGER: - case T_LONG: - C_adi(tp->tp_size); - break; - case T_REAL: - C_adf(tp->tp_size); - break; - case T_SET: - C_ior(tp->tp_size); - break; - default: - crash("(CodeBoper: bad type +)"); - } + switch (expr->nd_symb) + { + case '+': + Operands(leftop, rightop); + switch (tp->tp_fund) + { + case T_INTEGER: + case T_LONG: + C_adi(tp->tp_size); break; - - case '-': - Operands(leftop, rightop); - switch( tp->tp_fund ) { - case T_INTEGER: - case T_LONG: - C_sbi(tp->tp_size); - break; - case T_REAL: - C_sbf(tp->tp_size); - break; - case T_SET: - C_com(tp->tp_size); - C_and(tp->tp_size); - break; - default: - crash("(CodeBoper: bad type -)"); - } + case T_REAL: + C_adf(tp->tp_size); break; - - case '*': - Operands(leftop, rightop); - switch( tp->tp_fund ) { - case T_INTEGER: - case T_LONG: - C_mli(tp->tp_size); - break; - case T_REAL: - C_mlf(tp->tp_size); - break; - case T_SET: - C_and(tp->tp_size); - break; - default: - crash("(CodeBoper: bad type *)"); - } + case T_SET: + C_ior(tp->tp_size); break; + default: + crash("(CodeBoper: bad type +)"); + } + break; - case '/': - Operands(leftop, rightop); - if( tp->tp_fund == T_REAL ) - C_dvf(tp->tp_size); - else - crash("(CodeBoper: bad type /)"); + case '-': + Operands(leftop, rightop); + switch (tp->tp_fund) + { + case T_INTEGER: + case T_LONG: + C_sbi(tp->tp_size); break; - - case DIV: - case MOD: - Operands(leftop, rightop); - if( tp->tp_fund == T_INTEGER ) { - C_cal(expr->nd_symb == MOD ? "_mdi" : "_dvi"); - C_asp(2 * tp->tp_size); - C_lfr(tp->tp_size); - } - else if( tp->tp_fund == T_LONG) { - C_cal(expr->nd_symb == MOD ? "_mdil" : "_dvil"); - C_asp(2 * tp->tp_size); - C_lfr(tp->tp_size); - } - else - crash("(CodeBoper: bad type MOD)"); + case T_REAL: + C_sbf(tp->tp_size); break; - - case '<': - case LESSEQUAL: - case '>': - case GREATEREQUAL: - case '=': - case NOTEQUAL: - CodePExpr(leftop); - CodePExpr(rightop); - tp = BaseType(rightop->nd_type); - - switch( tp->tp_fund ) { - case T_INTEGER: - case T_LONG: - C_cmi(tp->tp_size); - break; - case T_REAL: - C_cmf(tp->tp_size); - break; - case T_ENUMERATION: - case T_CHAR: - C_cmu(word_size); - break; - case T_POINTER: - C_cmp(); - break; - - case T_SET: - if( expr->nd_symb == GREATEREQUAL ) { - /* A >= B is the same as A equals A + B - */ - C_dup(2 * tp->tp_size); - C_asp(tp->tp_size); - C_ior(tp->tp_size); - expr->nd_symb = '='; - } - else if( expr->nd_symb == LESSEQUAL ) { - /* A <= B is the same as A - B = [] - */ - C_com(tp->tp_size); - C_and(tp->tp_size); - C_zer(tp->tp_size); - expr->nd_symb = '='; - } - C_cms(tp->tp_size); - break; - - case T_STRINGCONST: - case T_ARRAY: - C_loc((arith) IsString(tp)); - C_cal("_bcp"); - C_asp(2 * pointer_size + word_size); - C_lfr(word_size); - break; - - case T_STRING: - C_cmp(); - break; - - default: - crash("(CodeBoper : bad type COMPARE)"); - } - truthvalue(expr->nd_symb); - if( true_label != NO_LABEL ) - C_zeq(true_label); + case T_SET: + C_com(tp->tp_size); + C_and(tp->tp_size); break; + default: + crash("(CodeBoper: bad type -)"); + } + break; - case IN: - /* In this case, evaluate right hand side first! The INN - instruction expects the bit number on top of the stack - */ - CodePExpr(rightop); - CodePExpr(leftop); - if( rightop->nd_type == emptyset_type ) - C_and(rightop->nd_type->tp_size); - else - C_inn(rightop->nd_type->tp_size); - - if( true_label != NO_LABEL ) - C_zeq(true_label); + case '*': + Operands(leftop, rightop); + switch (tp->tp_fund) + { + case T_INTEGER: + case T_LONG: + C_mli(tp->tp_size); break; - - case AND: - case OR: - Operands(leftop, rightop); - if( expr->nd_symb == AND ) - C_and(tp->tp_size); - else - C_ior(tp->tp_size); - if( true_label != NO_LABEL ) - C_zeq(true_label); + case T_REAL: + C_mlf(tp->tp_size); + break; + case T_SET: + C_and(tp->tp_size); break; default: - crash("(CodeBoper Bad operator %s\n)", - symbol2str(expr->nd_symb)); - } -} + crash("(CodeBoper: bad type *)"); + } + break; -/* truthvalue() serves as an auxiliary function of CodeBoper */ -truthvalue(relop) -{ - switch( relop ) { - case '<': - C_tlt(); + case '/': + Operands(leftop, rightop); + if (tp->tp_fund == T_REAL) + C_dvf(tp->tp_size); + else + crash("(CodeBoper: bad type /)"); + break; + + case DIV: + case MOD: + Operands(leftop, rightop); + if (tp->tp_fund == T_INTEGER) + { + C_cal(expr->nd_symb == MOD ? "_mdi" : "_dvi"); + C_asp(2 * tp->tp_size); + C_lfr(tp->tp_size); + } + else if (tp->tp_fund == T_LONG) + { + C_cal(expr->nd_symb == MOD ? "_mdil" : "_dvil"); + C_asp(2 * tp->tp_size); + C_lfr(tp->tp_size); + } + else + crash("(CodeBoper: bad type MOD)"); + break; + + case '<': + case LESSEQUAL: + case '>': + case GREATEREQUAL: + case '=': + case NOTEQUAL: + CodePExpr(leftop); + CodePExpr(rightop); + tp = BaseType(rightop->nd_type); + + switch (tp->tp_fund) + { + case T_INTEGER: + case T_LONG: + C_cmi(tp->tp_size); + break; + case T_REAL: + C_cmf(tp->tp_size); break; - case LESSEQUAL: - C_tle(); + case T_ENUMERATION: + case T_CHAR: + C_cmu(word_size); break; - case '>': - C_tgt(); + case T_POINTER: + C_cmp(); break; - case GREATEREQUAL: - C_tge(); + + case T_SET: + if (expr->nd_symb == GREATEREQUAL) + { + /* A >= B is the same as A equals A + B + */ + C_dup(2 * tp->tp_size); + C_asp(tp->tp_size); + C_ior(tp->tp_size); + expr->nd_symb = '='; + } + else if (expr->nd_symb == LESSEQUAL) + { + /* A <= B is the same as A - B = [] + */ + C_com(tp->tp_size); + C_and(tp->tp_size); + C_zer(tp->tp_size); + expr->nd_symb = '='; + } + C_cms(tp->tp_size); break; - case '=': - C_teq(); + + case T_STRINGCONST: + case T_ARRAY: + C_loc((arith) IsString(tp)); + C_cal("_bcp"); + C_asp(2 * pointer_size + word_size); + C_lfr(word_size); break; - case NOTEQUAL: - C_tne(); + + case T_STRING: + C_cmp(); break; + default: - crash("(truthvalue)"); - /*NOTREACHED*/ + crash("(CodeBoper : bad type COMPARE)"); + } + truthvalue(expr->nd_symb); + if (true_label != NO_LABEL ) + C_zeq(true_label); + break; + + case IN: + /* In this case, evaluate right hand side first! The INN + instruction expects the bit number on top of the stack + */ + CodePExpr(rightop); + CodePExpr(leftop); + if (rightop->nd_type == emptyset_type) + C_and(rightop->nd_type->tp_size); + else + C_inn(rightop->nd_type->tp_size); + + if (true_label != NO_LABEL ) + C_zeq(true_label); + break; + + case AND: + case OR: + Operands(leftop, rightop); + if (expr->nd_symb == AND) + C_and(tp->tp_size); + else + C_ior(tp->tp_size); + if (true_label != NO_LABEL ) + C_zeq(true_label); + break; + default: + crash("(CodeBoper Bad operator %s\n)", symbol2str(expr->nd_symb)); } } -CodeSet(nd) - register struct node *nd; + +static void CodeSet(register struct node *nd) { register struct type *tp = nd->nd_type; C_zer(tp->tp_size); nd = nd->nd_right; - while( nd ) { + while (nd) + { assert(nd->nd_class == Link && nd->nd_symb == ','); CodeEl(nd->nd_left, tp); @@ -693,27 +743,24 @@ CodeSet(nd) } } -CodeEl(nd, tp) - register struct node *nd; - register struct type *tp; +static void CodeEl(register struct node *nd, register struct type *tp) { - if( nd->nd_class == Link && nd->nd_symb == UPTO ) { + if (nd->nd_class == Link && nd->nd_symb == UPTO) + { Operands(nd->nd_left, nd->nd_right); - C_loc(tp->tp_size); /* push size */ - C_cal("_bts"); /* library routine to fill set */ + C_loc(tp->tp_size); /* push size */ + C_cal("_bts"); /* library routine to fill set */ C_asp(3 * word_size); } - else { + else + { CodePExpr(nd); C_set(tp->tp_size); C_ior(tp->tp_size); } } -struct type * -CodeParameters(param, arg) - struct paramlist *param; - struct node *arg; +static struct type * CodeParameters(struct paramlist *param, struct node *arg) { register struct type *tp, *left_tp, *last_tp = (struct type *) 0; struct node *left; @@ -721,56 +768,61 @@ CodeParameters(param, arg) assert(param && arg); - if( param->next ) + if (param->next) last_tp = CodeParameters(param->next, arg->nd_right); tp = TypeOfParam(param); left = arg->nd_left; left_tp = left->nd_type; - if( IsConformantArray(tp) ) { - if( last_tp != tp ) + if (IsConformantArray(tp)) + { + if (last_tp != tp) /* push descriptors only once */ CodeConfDescr(tp, left_tp); CodeDAddress(left); return tp; } - if( IsVarParam(param) ) { + if (IsVarParam(param)) + { CodeDAddress(left); return tp; } - if( left_tp->tp_fund == T_STRINGCONST ) { + if (left_tp->tp_fund == T_STRINGCONST) + { CodePString(left, tp); return tp; } ds = InitDesig; - CodeExpr(left, &ds, NO_LABEL); + CodeExpr(left, &ds, NO_LABEL ); CodeValue(&ds, left_tp); RangeCheck(tp, left_tp); - if( tp == real_type && BaseType(left_tp) == int_type ) + if (tp == real_type && BaseType(left_tp) == int_type) Int2Real(int_size); return tp; } -CodeConfDescr(ftp, atp) - register struct type *ftp, *atp; +static void CodeConfDescr(register struct type *ftp, register struct type *atp) { struct type *elemtp = ftp->arr_elem; - if( IsConformantArray(elemtp) ) + if (IsConformantArray(elemtp)) CodeConfDescr(elemtp, atp->arr_elem); - if( atp->tp_fund == T_STRINGCONST ) { + if (atp->tp_fund == T_STRINGCONST) + { C_loc((arith) 1); C_loc(atp->tp_psize - 1); C_loc((arith) 1); } - else if( IsConformantArray(atp) ) { - if( atp->arr_sclevel < proclevel ) { + else if (IsConformantArray(atp)) + { + if (atp->arr_sclevel < proclevel) + { C_lxa((arith) proclevel - atp->arr_sclevel); C_adp(atp->arr_cfdescr); } @@ -779,30 +831,27 @@ CodeConfDescr(ftp, atp) C_loi(3 * word_size); } - else { /* normal array */ + else + { /* normal array */ assert(atp->tp_fund == T_ARRAY); assert(!IsConformantArray(atp)); C_lae_dlb(atp->arr_ardescr, (arith) 0); - C_loi( 3 * word_size); + C_loi(3 * word_size); } } -CodePString(nd, tp) - struct node *nd; - struct type *tp; +static void CodePString(struct node *nd, struct type *tp) { /* no null padding */ C_lae_dlb(nd->nd_SLA, (arith) 0); C_loi(tp->tp_size); } -void -CodeCall(nd) - register struct node *nd; +void CodeCall(register struct node *nd) { /* Generate code for a procedure call. Checking of parameters - and result is already done. - */ + and result is already done. + */ register struct node *left = nd->nd_left; register struct node *right = nd->nd_right; register struct def *df = left->nd_def; @@ -810,26 +859,28 @@ CodeCall(nd) assert(IsProcCall(left)); - if( left->nd_type == std_type ) { + if (left->nd_type == std_type) + { CodeStd(nd); return; - } + } - if( right ) + if (right) (void) CodeParameters(ParamList(left->nd_type), right); assert(left->nd_class == Def); - - if( df->df_kind & D_ROUTINE ) { + if (df->df_kind & D_ROUTINE) + { int level = df->df_scope->sc_level; - if( level > 0 && !(df->df_flags & D_EXTERNAL) ) - C_lxl((arith) (proclevel - level)); + if (level > 0 && !(df->df_flags & D_EXTERNAL)) + C_lxl((arith)(proclevel - level)); C_cal(df->prc_name); C_asp(left->nd_type->prc_nbpar); } - else { + else + { label l1 = ++text_label; label l2 = ++text_label; @@ -845,27 +896,25 @@ CodeCall(nd) C_cmp(); C_zeq(l1); - /* At this point, on top of the stack the LB */ + /* At this point, on top of the stack the LB */ C_exg(pointer_size); - /* Now, the name of the procedure/function */ - C_cai(); + /* Now, the name of the procedure/function */C_cai(); C_asp(pointer_size + left->nd_type->prc_nbpar); C_bra(l2); /* value is a global procedure/function */ C_df_ilb(l1); - C_asp(pointer_size); /* no LB needed */ + C_asp(pointer_size); /* no LB needed */ C_cai(); C_asp(left->nd_type->prc_nbpar); C_df_ilb(l2); } - if( result_tp = ResultType(left->nd_type) ) + if ( (result_tp = ResultType(left->nd_type)) ) C_lfr(result_tp->tp_size); } -CodeStd(nd) - struct node *nd; +static void CodeStd(struct node *nd) { register struct node *arg = nd->nd_right; register struct node *left = arg->nd_left; @@ -874,248 +923,255 @@ CodeStd(nd) assert(arg->nd_class == Link && arg->nd_symb == ','); - switch( req ) { - case R_ABS: - CodePExpr(left); - if( tp == int_type ) - C_cal("_abi"); - else if ( tp == long_type ) - C_cal("_abl"); - else - C_cal("_abr"); - C_asp(tp->tp_size); - C_lfr(tp->tp_size); - break; + switch (req) + { + case R_ABS: + CodePExpr(left); + if (tp == int_type) + C_cal("_abi"); + else if (tp == long_type) + C_cal("_abl"); + else + C_cal("_abr"); + C_asp(tp->tp_size); + C_lfr(tp->tp_size); + break; - case R_SQR: - CodePExpr(left); - C_dup(tp->tp_size); - if( tp == int_type || tp == long_type ) - C_mli(tp->tp_size); - else - C_mlf(real_size); - break; + case R_SQR: + CodePExpr(left); + C_dup(tp->tp_size); + if (tp == int_type || tp == long_type) + C_mli(tp->tp_size); + else + C_mlf(real_size); + break; + case R_SIN: + case R_COS: + case R_EXP: + case R_LN: + case R_SQRT: + case R_ARCTAN: + assert(tp == real_type); + CodePExpr(left); + switch (req) + { case R_SIN: + C_cal("_sin"); + break; case R_COS: + C_cal("_cos"); + break; case R_EXP: + C_cal("_exp"); + break; case R_LN: + C_cal("_log"); + break; case R_SQRT: - case R_ARCTAN: - assert(tp == real_type); - CodePExpr(left); - switch( req ) { - case R_SIN: - C_cal("_sin"); - break; - case R_COS: - C_cal("_cos"); - break; - case R_EXP: - C_cal("_exp"); - break; - case R_LN: - C_cal("_log"); - break; - case R_SQRT: - C_cal("_sqt"); - break; - case R_ARCTAN: - C_cal("_atn"); - break; - default: - crash("(CodeStd)"); - /*NOTREACHED*/ - } - C_asp(real_size); - C_lfr(real_size); + C_cal("_sqt"); break; - - case R_TRUNC: - assert(tp == real_type); - CodePExpr(left); - Real2Int(); + case R_ARCTAN: + C_cal("_atn"); break; + default: + crash("(CodeStd)"); + /*NOTREACHED*/ + } + C_asp(real_size); + C_lfr(real_size); + break; - case R_ROUND: - assert(tp == real_type); - CodePExpr(left); - C_cal("_rnd"); - C_asp(real_size); - C_lfr(real_size); - Real2Int(); - break; + case R_TRUNC: + assert(tp == real_type); + CodePExpr(left); + Real2Int(); + break; - case R_ORD: - CodePExpr(left); - break; + case R_ROUND: + assert(tp == real_type); + CodePExpr(left); + C_cal("_rnd"); + C_asp(real_size); + C_lfr(real_size); + Real2Int(); + break; - case R_CHR: - CodePExpr(left); - genrck(char_type); - break; + case R_ORD: + CodePExpr(left); + break; - case R_SUCC: - case R_PRED: - CodePExpr(left); - C_loc((arith)1); - if( tp == long_type) Int2Long(); + case R_CHR: + CodePExpr(left); + genrck(char_type); + break; - if( req == R_SUCC ) - C_adi(tp->tp_size); - else - C_sbi(tp->tp_size); + case R_SUCC: + case R_PRED: + CodePExpr(left); + C_loc((arith) 1); + if (tp == long_type) + Int2Long(); - if( bounded(left->nd_type) ) - genrck(left->nd_type); - break; + if (req == R_SUCC) + C_adi(tp->tp_size); + else + C_sbi(tp->tp_size); - case R_ODD: - CodePExpr(left); - C_loc((arith) 1); - if( tp == long_type ) Int2Long(); - C_and(tp->tp_size); - if( tp == long_type ) Long2Int(); /* bool_size == int_size */ - break; + if (bounded(left->nd_type)) + genrck(left->nd_type); + break; - case R_EOF: - case R_EOLN: - CodeDAddress(left); - if( req == R_EOF ) - C_cal("_efl"); - else - C_cal("_eln"); - C_asp(pointer_size); - C_lfr(word_size); - break; + case R_ODD: + CodePExpr(left); + C_loc((arith) 1); + if (tp == long_type) + Int2Long(); + C_and(tp->tp_size); + if (tp == long_type) + Long2Int(); /* bool_size == int_size */ + break; - case R_REWRITE: - case R_RESET: - CodeDAddress(left); - if( tp == text_type ) - C_loc((arith) 0); - else - C_loc(tp->next->tp_psize); - /* ??? elements of packed size ??? */ - if( req == R_REWRITE ) - C_cal("_cre"); - else - C_cal("_opn"); - C_asp(pointer_size + word_size); - break; + case R_EOF: + case R_EOLN: + CodeDAddress(left); + if (req == R_EOF) + C_cal("_efl"); + else + C_cal("_eln"); + C_asp(pointer_size); + C_lfr(word_size); + break; - case R_PUT: - case R_GET: - CodeDAddress(left); - if( req == R_PUT ) - C_cal("_put"); - else - C_cal("_get"); - C_asp(pointer_size); - break; + case R_REWRITE: + case R_RESET: + CodeDAddress(left); + if (tp == text_type) + C_loc((arith) 0); + else + C_loc(tp->next->tp_psize); + /* ??? elements of packed size ??? */ + if (req == R_REWRITE) + C_cal("_cre"); + else + C_cal("_opn"); + C_asp(pointer_size + word_size); + break; - case R_PAGE: - CodeDAddress(left); - C_cal("_pag"); - C_asp(pointer_size); - break; + case R_PUT: + case R_GET: + CodeDAddress(left); + if (req == R_PUT) + C_cal("_put"); + else + C_cal("_get"); + C_asp(pointer_size); + break; - case R_PACK: { - label lba = tp->arr_ardescr; + case R_PAGE: + CodeDAddress(left); + C_cal("_pag"); + C_asp(pointer_size); + break; + case R_PACK: + { + label lba = tp->arr_ardescr; - CodeDAddress(left); - arg = arg->nd_right; - left = arg->nd_left; - CodePExpr(left); - arg = arg->nd_right; - left = arg->nd_left; - CodeDAddress(left); - C_lae_dlb(left->nd_type->arr_ardescr, (arith) 0); - C_lae_dlb(lba, (arith) 0); - C_cal("_pac"); - C_asp(4 * pointer_size + word_size); - break; - } + CodeDAddress(left); + arg = arg->nd_right; + left = arg->nd_left; + CodePExpr(left); + arg = arg->nd_right; + left = arg->nd_left; + CodeDAddress(left); + C_lae_dlb(left->nd_type->arr_ardescr, (arith) 0); + C_lae_dlb(lba, (arith) 0); + C_cal("_pac"); + C_asp(4 * pointer_size + word_size); + break; + } - case R_UNPACK: { - /* change sequence of arguments of the library routine - _unp to merge code of R_PACK and R_UNPACK. - */ - label lba, lbz = tp->arr_ardescr; + case R_UNPACK: + { + /* change sequence of arguments of the library routine + _unp to merge code of R_PACK and R_UNPACK. + */ + label lba, lbz = tp->arr_ardescr; - tp = tp->arr_elem; - if (tp->tp_fund == T_SUBRANGE && - tp->sub_lb >= 0) { - C_loc((arith) 1); - } - else C_loc((arith) 0); - CodeDAddress(left); - arg = arg->nd_right; - left = arg->nd_left; - CodeDAddress(left); - lba = left->nd_type->arr_ardescr; - arg = arg->nd_right; - left = arg->nd_left; - CodePExpr(left); - C_lae_dlb(lbz, (arith) 0); - C_lae_dlb(lba, (arith) 0); - C_cal("_unp"); - C_asp(4 * pointer_size + 2 * word_size); - break; + tp = tp->arr_elem; + if (tp->tp_fund == T_SUBRANGE && tp->sub_lb >= 0) + { + C_loc((arith) 1); } + else + C_loc((arith) 0); + CodeDAddress(left); + arg = arg->nd_right; + left = arg->nd_left; + CodeDAddress(left); + lba = left->nd_type->arr_ardescr; + arg = arg->nd_right; + left = arg->nd_left; + CodePExpr(left); + C_lae_dlb(lbz, (arith) 0); + C_lae_dlb(lba, (arith) 0); + C_cal("_unp"); + C_asp(4 * pointer_size + 2 * word_size); + break; + } - case R_NEW: - case R_DISPOSE: - CodeDAddress(left); - C_loc(PointedtoType(tp)->tp_size); - if( req == R_NEW ) - C_cal("_new"); - else - C_cal("_dis"); - C_asp(pointer_size + word_size); - break; + case R_NEW: + case R_DISPOSE: + CodeDAddress(left); + C_loc(PointedtoType(tp)->tp_size); + if (req == R_NEW) + C_cal("_new"); + else + C_cal("_dis"); + C_asp(pointer_size + word_size); + break; - case R_HALT: - if( left ) - CodePExpr(left); - else - C_zer(int_size); - C_cal("_hlt"); /* can't return */ - C_asp(int_size); /* help the optimizer(s) */ - break; + case R_HALT: + if (left) + CodePExpr(left); + else + C_zer(int_size); + C_cal("_hlt"); /* can't return */ + C_asp(int_size); /* help the optimizer(s) */ + break; - default: - crash("(CodeStd)"); - /*NOTREACHED*/ + default: + crash("(CodeStd)"); + /*NOTREACHED*/ } } -void -Long2Int() +void Long2Int(void) { /* convert a long to integer */ - if (int_size == long_size) return; + if (int_size == long_size) + return; C_loc(long_size); C_loc(int_size); C_cii(); } -void -Int2Long() +void Int2Long(void) { /* convert integer to long */ - if (int_size == long_size) return; + if (int_size == long_size) + return; C_loc(int_size); C_loc(long_size); C_cii(); } -Int2Real(size) /* size is different for integers and longs */ -arith size; +void Int2Real(arith size) +/* size is different for integers and longs */ { /* convert integer to real */ C_loc(size); @@ -1123,7 +1179,7 @@ arith size; C_cif(); } -Real2Int() +void Real2Int(void) { /* convert real to integer */ C_loc(real_size); @@ -1131,60 +1187,64 @@ Real2Int() C_cfi(); } -RangeCheck(tpl, tpr) - register struct type *tpl, *tpr; +void RangeCheck(register struct type *tpl, register struct type *tpr) { /* Generate a range check if neccessary - */ + */ arith llo, lhi, rlo, rhi; - if( bounded(tpl) ) { + if (bounded(tpl)) + { /* in this case we might need a range check */ - if( !bounded(tpr) ) + if (!bounded(tpr)) /* yes, we need one */ genrck(tpl); - else { + else + { /* both types are restricted. check the bounds to see - whether we need a range check. We don't need one - if the range of values of the right hand side is a - subset of the range of values of the left hand side. - */ + whether we need a range check. We don't need one + if the range of values of the right hand side is a + subset of the range of values of the left hand side. + */ getbounds(tpl, &llo, &lhi); getbounds(tpr, &rlo, &rhi); - if( llo > rlo || lhi < rhi ) + if (llo > rlo || lhi < rhi) genrck(tpl); } } } -void -genrck(tp) - register struct type *tp; +static void genrck(register struct type *tp) { /* Generate a range check descriptor for type "tp" when - necessary. Return its label. - */ + necessary. Return its label. + */ arith lb, ub; register label o1; int newlabel = 0; - if( options['R'] ) return; + if (options['R']) + return; getbounds(tp, &lb, &ub); - if( tp->tp_fund == T_SUBRANGE ) { - if( !(o1 = tp->sub_rck) ) { + if (tp->tp_fund == T_SUBRANGE) + { + if (!(o1 = tp->sub_rck)) + { tp->sub_rck = o1 = ++data_label; newlabel = 1; } } - else if( !(o1 = tp->enm_rck) ) { + else if (!(o1 = tp->enm_rck)) + { tp->enm_rck = o1 = ++data_label; newlabel = 1; } - if( newlabel ) { + if (newlabel) + { C_df_dlb(o1); C_rom_cst(lb); C_rom_cst(ub); @@ -1193,71 +1253,68 @@ genrck(tp) C_rck(word_size); } -CodePExpr(nd) - register struct node *nd; +void CodePExpr(register struct node *nd) { /* Generate code to push the value of the expression "nd" - on the stack. - */ + on the stack. + */ struct desig designator; struct type *tp = BaseType(nd->nd_type); - + designator = InitDesig; - CodeExpr(nd, &designator, NO_LABEL); - if( tp->tp_fund & (T_ARRAY | T_RECORD) ) + CodeExpr(nd, &designator, NO_LABEL ); + if (tp->tp_fund & (T_ARRAY | T_RECORD)) CodeAddress(&designator); else CodeValue(&designator, nd->nd_type); } -CodeDAddress(nd) - struct node *nd; +void CodeDAddress(struct node *nd) { /* Generate code to push the address of the designator "nd" - on the stack. - */ + on the stack. + */ struct desig designator; - + designator = InitDesig; CodeDesig(nd, &designator); CodeAddress(&designator); } -CodeDStore(nd) - register struct node *nd; +void CodeDStore(register struct node *nd) { /* Generate code to store the expression on the stack - into the designator "nd". - */ + into the designator "nd". + */ struct desig designator; - + designator = InitDesig; CodeDesig(nd, &designator); CodeStore(&designator, nd->nd_type); } -RegisterMessages(df) - register struct def *df; +static void RegisterMessages(register struct def *df) { register struct type *tp; - for( ; df; df = df->df_nextinscope ) { - if( df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG) ) { + for (; df; df = df->df_nextinscope) + { + if (df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG)) + { /* Examine type and size - */ + */ tp = BaseType(df->df_type); - if( df->df_flags & D_VARPAR || tp->tp_fund & T_POINTER ) - C_ms_reg(df->var_off, pointer_size, - reg_pointer, 0); + if (df->df_flags & D_VARPAR || tp->tp_fund & T_POINTER) + C_ms_reg(df->var_off, pointer_size, reg_pointer, 0); - else if( df->df_flags & D_LOOPVAR ) - C_ms_reg(df->var_off, tp->tp_size, reg_loop,2); - else if( tp->tp_fund & T_NUMERIC ) + else if (df->df_flags & D_LOOPVAR) + C_ms_reg(df->var_off, tp->tp_size, reg_loop, 2); + else if (tp->tp_fund & T_NUMERIC) C_ms_reg(df->var_off, tp->tp_size, - tp->tp_fund == T_REAL ? reg_float : reg_any, 0); + tp->tp_fund == T_REAL ? reg_float : reg_any, 0); } } } diff --git a/lang/pc/comp/code.h b/lang/pc/comp/code.h new file mode 100644 index 000000000..06fc03c5b --- /dev/null +++ b/lang/pc/comp/code.h @@ -0,0 +1,56 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef CODE_H_ +#define CODE_H_ + +#include "em_arith.h" +#include "em_label.h" + +struct def; +struct node; +struct type; +struct desig; + +void routine_label(register struct def * df); +void RomString(register struct node *nd); +void RomReal(register struct node *nd); +void BssVar(void); +arith CodeBeginBlock(register struct def *df); +void CodeEndBlock(register struct def *df, arith StackAdjustment); +void CodeExpr(register struct node *nd, register struct desig *ds, + label true_label); +void CodeCall(register struct node *nd); +void RangeCheck(register struct type *tpl, register struct type *tpr); + +/* Generate code to push the value of the expression "nd" + on the stack. +*/ +void CodePExpr(register struct node *nd); + +/* Generate code to push the address of the designator "nd" + on the stack. + */ +void CodeDAddress(struct node *nd); + +/* Generate code to store the expression on the stack + into the designator "nd". + */ +void CodeDStore(register struct node *nd); + +/* Generate code to convert long to int */ +void Long2Int(void); +/* Generate code to convert int to long */ +void Int2Long(void); +/* Generate code to convert int to real */ +void Int2Real(arith size); +/* Generate code to convert real to int */ +void Real2Int(void); + + + + + +#endif /* CODE_H_ */ diff --git a/lang/pc/comp/cstoper.c b/lang/pc/comp/cstoper.c index a756b351b..af783e7e7 100644 --- a/lang/pc/comp/cstoper.c +++ b/lang/pc/comp/cstoper.c @@ -17,6 +17,8 @@ #include "node.h" #include "required.h" #include "type.h" +#include "cstoper.h" +#include "error.h" long mach_long_sign; /* sign bit of the machine long */ long full_mask[MAXSIZE+1];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */ @@ -26,18 +28,15 @@ char *maxint_str; /* string representation of maximum integer */ arith wrd_bits; /* number of bits in a word */ arith max_intset; /* largest value of set of integer */ -overflow(expp) - struct node *expp; +void CutSize(register struct node *expr); + +void overflow(struct node *expp) { node_warning(expp, "overflow in constant expression"); } -cstunary(expp) - register struct node *expp; +void cstunary(register struct node *expp) { - /* The unary operation in "expp" is performed on the constant - expression below it, and the result restored in expp. - */ register arith o1 = expp->nd_right->nd_INT; switch( expp->nd_symb ) { @@ -67,9 +66,7 @@ cstunary(expp) expp->nd_right = NULLNODE; } -void -cstbin(expp) - register struct node *expp; +void cstbin(register struct node *expp) { /* The binary operation in "expp" is performed on the constant expressions below it, and the result restored in expp. @@ -197,9 +194,7 @@ cstbin(expp) expp->nd_left = expp->nd_right = NULLNODE; } -void -cstset(expp) - register struct node *expp; +void cstset(register struct node *expp) { register arith *set1, *set2; arith *resultset = (arith *) 0; @@ -353,8 +348,7 @@ cstset(expp) expp->nd_left = expp->nd_right = NULLNODE; } -cstcall(expp, req) - register struct node *expp; +void cstcall(register struct node *expp, int req) { /* a standard procedure call is found that can be evaluated compile time, so do so. @@ -441,8 +435,7 @@ cstcall(expp, req) expp->nd_right = expp->nd_left = NULLNODE; } -CutSize(expr) - register struct node *expr; +void CutSize(register struct node *expr) { /* The constant value of the expression expr is made to conform * to the size of the type of the expression @@ -460,8 +453,8 @@ CutSize(expr) o1 &= 0177; } } - else if( remainder != 0 && remainder != ~full_mask[size] || - (o1 & full_mask[size]) == 1 << (size * 8 - 1) ) { + else if( (remainder != 0 && remainder != ~full_mask[size]) || + ((o1 & full_mask[size]) == 1 << (size * 8 - 1)) ) { /* integers in [-maxint .. maxint] */ int nbits = (int) (sizeof(long) - size) * 8; @@ -474,9 +467,8 @@ CutSize(expr) expr->nd_INT = o1; } -InitCst() +void InitCst(void) { - extern char *Salloc(); register int i = 0; register arith bt = (arith)0; diff --git a/lang/pc/comp/cstoper.h b/lang/pc/comp/cstoper.h new file mode 100644 index 000000000..f0b5d2102 --- /dev/null +++ b/lang/pc/comp/cstoper.h @@ -0,0 +1,36 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef CSTOPER_H_ +#define CSTOPER_H_ + +/* Forward struct declarations. */ +struct node; + +/* The unary operation in "expp" is performed on the constant + expression below it, and the result restored in expp. +*/ +void cstunary(register struct node *expp); + +/* The binary operation in "expp" is performed on the constant + expressions below it, and the result restored in expp. +*/ +void cstbin(register struct node *expp); +void cstset(register struct node *expp); + +/* Standard system function call that can be evaluated + * a compile time. + */ +void cstcall(register struct node *expp, int req); + +/* The constant value of the expression expr is made to conform + * to the size of the type of the expression + */ +void CutSize(register struct node *expr); +void InitCst(void); + + + +#endif /* CSTOPER_H_ */ diff --git a/lang/pc/comp/declar.g b/lang/pc/comp/declar.g index 54f488fe0..64a7133fd 100644 --- a/lang/pc/comp/declar.g +++ b/lang/pc/comp/declar.g @@ -21,6 +21,14 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "code.h" +#include "error.h" +#include "label.h" +#include "enter.h" +#ifdef DBSYMTAB +#include "stab.h" +#endif + #define PC_BUFSIZ (sizeof(struct file) - offsetof(struct file, bufadr)) @@ -177,7 +185,7 @@ ConstantDefinition } : IDENT { id = dot.TOK_IDF; } '=' Constant(&nd) - { if( df = define(id,CurrentScope,D_CONST) ) { + { if (( df = define(id,CurrentScope,D_CONST))) { df->con_const = nd; df->df_type = nd->nd_type; df->df_flags |= D_SET; @@ -197,7 +205,7 @@ TypeDefinition } : IDENT { id = dot.TOK_IDF; } '=' TypeDenoter(&tp) - { if( df = define(id, CurrentScope, D_TYPE) ) { + { if ((df = define(id, CurrentScope, D_TYPE)) ) { df->df_type = tp; df->df_flags |= D_SET; #ifdef DBSYMTAB @@ -371,7 +379,7 @@ FunctionDeclaration else DoDirective(dot.TOK_IDF, nd, tp, scl, 1); } | - { if( df = DeclFunc(nd, tp, scl) ) { + { if ((df = DeclFunc(nd, tp, scl) )) { df->prc_res = - ResultType(df->df_type)->tp_size; df->prc_bool = @@ -705,7 +713,7 @@ VariantPart(struct scope *scope; arith *cnt; int *palign; { max = tcnt; } VariantTail(scope, &tcnt, &max, cnt, palign, packed, *sel) { *cnt = max; - if( sp = (*sel)->sel_ptrs ) { + if ( (sp = (*sel)->sel_ptrs) ) { int errflag = 0; ncst = (*sel)->sel_ncst; @@ -987,16 +995,16 @@ Index_TypeSpecification(register struct type **ptp; register struct type *tp;) register struct def *df1, *df2; } : IDENT - { if( df1 = - define(dot.TOK_IDF, CurrentScope, D_LBOUND)) { + { if( (df1 = + define(dot.TOK_IDF, CurrentScope, D_LBOUND)) ) { df1->bnd_type = tp; /* type conf. array */ df1->df_flags |= D_SET; } } UPTO IDENT - { if( df2 = - define(dot.TOK_IDF, CurrentScope, D_UBOUND)) { + { if( (df2 = + define(dot.TOK_IDF, CurrentScope, D_UBOUND)) ) { df2->bnd_type = tp; /* type conf. array */ df2->df_flags |= D_SET; } diff --git a/lang/pc/comp/def.c b/lang/pc/comp/def.c index 745bb48e0..823ee4b36 100644 --- a/lang/pc/comp/def.c +++ b/lang/pc/comp/def.c @@ -15,13 +15,13 @@ #include "misc.h" #include "node.h" #include "scope.h" +#include "code.h" #include "type.h" +#include "lookup.h" +#include "error.h" -struct def * -MkDef(id, scope, kind) - register struct idf *id; - register struct scope *scope; - long kind; +struct def *MkDef(register struct idf *id, register struct scope *scope, + long kind) { /* Create a new definition structure in scope "scope", with * id "id" and kind "kind". @@ -36,79 +36,81 @@ MkDef(id, scope, kind) id->id_def = df; /* enter the definition in the list of definitions in this scope - */ + */ df->df_nextinscope = scope->sc_def; scope->sc_def = df; return df; } -struct def * -define(id, scope, kind) - register struct idf *id; - register struct scope *scope; - long kind; +struct def *define(register struct idf *id, register struct scope *scope, + long kind) { /* Declare an identifier in a scope, but first check if it - already has been defined. - If so, then check for the cases in which this is legal, - and otherwise give an error message. - */ + already has been defined. + If so, then check for the cases in which this is legal, + and otherwise give an error message. + */ register struct def *df; - if( df = lookup(id, scope, 0L) ) { - if (df->df_kind == D_INUSE) { - if( kind != D_INUSE ) { - error("\"%s\" already used in this block", - id->id_text); + if ( (df = lookup(id, scope, 0L)) ) + { + if (df->df_kind == D_INUSE) + { + if (kind != D_INUSE) + { + error("\"%s\" already used in this block", id->id_text); } return MkDef(id, scope, kind); } - if (df->df_kind == D_ERROR ) { + if (df->df_kind == D_ERROR) + { /* used in forward references */ df->df_kind = kind; return df; } /* other cases fit in an int (assume at least 2 bytes) */ - switch((int) df->df_kind ) { + switch ((int) df->df_kind) + { - case D_LABEL : + case D_LABEL: /* generate error message somewhere else */ return NULLDEF; - case D_PARAMETER : - if( kind == D_VARIABLE ) - /* program parameter declared as variable */ + case D_PARAMETER: + if (kind == D_VARIABLE) + /* program parameter declared as variable */ return df; break; - case D_FORWTYPE : - if( kind == D_FORWTYPE ) return df; - if( kind == D_TYPE ) { - /* forward reference resolved */ + case D_FORWTYPE: + if (kind == D_FORWTYPE) + return df; + if (kind == D_TYPE) + { + /* forward reference resolved */ df->df_kind = D_FTYPE; return df; } else - error("identifier \"%s\" must be a type", - id->id_text); + error("identifier \"%s\" must be a type", id->id_text); return NULLDEF; - case D_FWPROCEDURE : - if( kind == D_PROCEDURE ) return df; - error("procedure identification \"%s\" expected", - id->id_text); + case D_FWPROCEDURE: + if (kind == D_PROCEDURE) + return df; + error("procedure identification \"%s\" expected", id->id_text); return NULLDEF; - case D_FWFUNCTION : - if( kind == D_FUNCTION ) return df; - error("function identification \"%s\" expected", - id->id_text); + case D_FWFUNCTION: + if (kind == D_FUNCTION) + return df; + error("function identification \"%s\" expected", id->id_text); return NULLDEF; } - if( kind != D_ERROR ) + if (kind != D_ERROR) /* avoid spurious error messages */ - error("identifier \"%s\" already declared",id->id_text); + error("identifier \"%s\" already declared", id->id_text); return NULLDEF; } @@ -116,142 +118,142 @@ define(id, scope, kind) return MkDef(id, scope, kind); } -void -DoDirective(directive, nd, tp, scl, function) - struct idf *directive; - struct node *nd; - struct type *tp; - struct scopelist *scl; +void DoDirective(struct idf *directive, struct node *nd, struct type *tp, + struct scopelist *scl, int function) { - long kind; /* kind of directive */ - int inp; /* internal or external name */ - int ext = 0; /* directive = EXTERN */ + long kind; /* kind of directive */ + int inp; /* internal or external name */ + int ext = 0; /* directive = EXTERN */ struct def *df = lookup(directive, PervasiveScope, D_INUSE); - if( !df ) { - if( !is_anon_idf(directive) ) - node_error(nd, "\"%s\" unknown directive", - directive->id_text); + if (!df) + { + if (!is_anon_idf(directive)) + node_error(nd, "\"%s\" unknown directive", directive->id_text); return; } - if (df->df_kind == D_FORWARD) { + if (df->df_kind == D_FORWARD) + { kind = function ? D_FWFUNCTION : D_FWPROCEDURE; inp = (proclevel > 1); } - else if (df->df_kind == D_EXTERN) { + else if (df->df_kind == D_EXTERN) + { kind = function ? D_FUNCTION : D_PROCEDURE; inp = 0; ext = 1; } - else { - node_error(nd, "\"%s\" unknown directive", - directive->id_text); + else + { + node_error(nd, "\"%s\" unknown directive", directive->id_text); return; } - if( df = define(nd->nd_IDF, CurrentScope, kind) ) { - if( df->df_kind != kind ) { + if ( (df = define(nd->nd_IDF, CurrentScope, kind)) ) + { + if (df->df_kind != kind) + { /* identifier already forward declared */ node_error(nd, "\"%s\" already forward declared", - nd->nd_IDF->id_text); + nd->nd_IDF->id_text); return; } df->df_type = tp; df->prc_vis = scl; df->prc_name = gen_proc_name(nd->nd_IDF, inp); - if( ext ) { + if (ext) + { if (!(df->df_flags & D_EXTERNAL) && proclevel > 1) tp->prc_nbpar -= pointer_size; /* was added for static link which is not needed now. - But make sure this is done only once (look at the - D_EXTERNAL flag). - */ + But make sure this is done only once (look at the + D_EXTERNAL flag). + */ df->df_flags |= D_EXTERNAL; } df->df_flags |= D_SET; } } -struct def * -DeclProc(nd, tp, scl) - register struct node *nd; - struct type *tp; - register struct scopelist *scl; +struct def *DeclProc(register struct node *nd, struct type *tp, + register struct scopelist *scl) { register struct def *df; - if( df = define(nd->nd_IDF, CurrentScope, D_PROCEDURE) ) { + if ( (df = define(nd->nd_IDF, CurrentScope, D_PROCEDURE)) ) + { df->df_flags |= D_SET; - if( df->df_kind == D_FWPROCEDURE ) { - df->df_kind = D_PROCEDURE; /* identification */ + if (df->df_kind == D_FWPROCEDURE) + { + df->df_kind = D_PROCEDURE; /* identification */ /* Simulate a call to open_scope(), which has already * been performed in the forward declaration. */ CurrVis = df->prc_vis; - if( tp->prc_params ) - node_error(nd, - "\"%s\" already declared", - nd->nd_IDF->id_text); + if (tp->prc_params) + node_error(nd, "\"%s\" already declared", nd->nd_IDF->id_text); } - else { /* normal declaration */ + else + { /* normal declaration */ df->df_type = tp; - df->prc_name = gen_proc_name(nd->nd_IDF, (proclevel>1)); + df->prc_name = gen_proc_name(nd->nd_IDF, (proclevel > 1)); /* simulate open_scope() */ CurrVis = df->prc_vis = scl; } routine_label(df); } - else CurrVis = scl; /* simulate open_scope() */ + else + CurrVis = scl; /* simulate open_scope() */ return df; } struct def * -DeclFunc(nd, tp, scl) - register struct node *nd; - struct type *tp; - register struct scopelist *scl; +DeclFunc(register struct node *nd, struct type *tp, + register struct scopelist *scl) { register struct def *df; - if( df = define(nd->nd_IDF, CurrentScope, D_FUNCTION) ) { - df->df_flags &= ~D_SET; - if( df->df_kind == D_FUNCTION ) { /* declaration */ - if( !tp ) { - node_error(nd, "\"%s\" illegal function declaration", - nd->nd_IDF->id_text); - tp = construct_type(T_FUNCTION, error_type); + if ( (df = define(nd->nd_IDF, CurrentScope, D_FUNCTION)) ) + { + df->df_flags &= ~D_SET; + if (df->df_kind == D_FUNCTION) + { /* declaration */ + if (!tp) + { + node_error(nd, "\"%s\" illegal function declaration", + nd->nd_IDF->id_text); + tp = construct_type(T_FUNCTION, error_type); + } + /* simulate open_scope() */ + CurrVis = df->prc_vis = scl; + df->df_type = tp; + df->prc_name = gen_proc_name(nd->nd_IDF, (proclevel > 1)); } - /* simulate open_scope() */ - CurrVis = df->prc_vis = scl; - df->df_type = tp; - df->prc_name = gen_proc_name(nd->nd_IDF, (proclevel > 1)); - } - else { /* identification */ - assert(df->df_kind == D_FWFUNCTION); + else + { /* identification */ + assert(df->df_kind == D_FWFUNCTION); - df->df_kind = D_FUNCTION; - CurrVis = df->prc_vis; + df->df_kind = D_FUNCTION; + CurrVis = df->prc_vis; - if( tp ) - node_error(nd, - "\"%s\" already declared", - nd->nd_IDF->id_text); + if (tp) + node_error(nd, "\"%s\" already declared", nd->nd_IDF->id_text); - } - routine_label(df); + } + routine_label(df); } - else CurrVis = scl; /* simulate open_scope() */ + else + CurrVis = scl; /* simulate open_scope() */ return df; } -EndFunc(df) - register struct def *df; +void EndFunc(register struct def *df) { /* assignment to functionname is illegal outside the functionblock */ df->prc_res = 0; @@ -259,47 +261,53 @@ EndFunc(df) /* Give the error about assignment as soon as possible. The * |= assignment inhibits a warning in the main procedure. */ - if( !(df->df_flags & D_SET) ) { - error("function \"%s\" not assigned",df->df_idf->id_text); + if (!(df->df_flags & D_SET)) + { + error("function \"%s\" not assigned", df->df_idf->id_text); df->df_flags |= D_SET; } } -EndBlock(block_df) - register struct def *block_df; +void EndBlock(register struct def *block_df) { register struct def *tmp_def = CurrentScope->sc_def; register struct def *df; - while( tmp_def ) { - df = tmp_def; - /* The length of a usd_def chain is at most 1. + while (tmp_def) + { + df = tmp_def; + /* The length of a usd_def chain is at most 1. * The while is just defensive programming. */ - while( df->df_kind & D_INUSE ) - df = df->usd_def; - - if( !is_anon_idf(df->df_idf) - && (df->df_scope == CurrentScope) ) { - if( !(df->df_kind & (D_ENUM|D_LABEL|D_ERROR)) ) { - if( !(df->df_flags & D_USED) ) { - if( !(df->df_flags & D_SET) ) { - warning("\"%s\" neither set nor used in \"%s\"", - df->df_idf->id_text, block_df->df_idf->id_text); - } - else { - warning("\"%s\" unused in \"%s\"", - df->df_idf->id_text, block_df->df_idf->id_text); + while (df->df_kind & D_INUSE) + df = df->usd_def; + + if (!is_anon_idf(df->df_idf) && (df->df_scope == CurrentScope)) + { + if (!(df->df_kind & (D_ENUM | D_LABEL | D_ERROR))) + { + if (!(df->df_flags & D_USED)) + { + if (!(df->df_flags & D_SET)) + { + warning("\"%s\" neither set nor used in \"%s\"", + df->df_idf->id_text, block_df->df_idf->id_text); + } + else + { + warning("\"%s\" unused in \"%s\"", df->df_idf->id_text, + block_df->df_idf->id_text); + } + } + else if (!(df->df_flags & D_SET)) + { + if (!(df->df_flags & D_LOOPVAR)) + warning("\"%s\" not set in \"%s\"", df->df_idf->id_text, + block_df->df_idf->id_text); + } } - } - else if( !(df->df_flags & D_SET) ) { - if( !(df->df_flags & D_LOOPVAR) ) - warning("\"%s\" not set in \"%s\"", - df->df_idf->id_text, block_df->df_idf->id_text); - } - } - } - tmp_def = tmp_def->df_nextinscope; + } + tmp_def = tmp_def->df_nextinscope; } } diff --git a/lang/pc/comp/def.xh b/lang/pc/comp/def.xh index 827ab2135..ad09b4100 100644 --- a/lang/pc/comp/def.xh +++ b/lang/pc/comp/def.xh @@ -1,5 +1,8 @@ /* I D E N T I F I E R D E S C R I P T O R S T R U C T U R E */ +#ifndef DEF_H_ +#define DEF_H_ + struct constant { struct node *co_const; /* result of a constant expression */ #define con_const df_value.df_constant.co_const @@ -153,3 +156,20 @@ extern struct def *lookfor(); #define NULLDEF ((struct def *) 0) + + +struct def *MkDef(register struct idf *id, register struct scope *scope, + long kind); +struct def *define(register struct idf *id, register struct scope *scope, + long kind); +void DoDirective(struct idf *directive, struct node *nd, struct type *tp, + struct scopelist *scl, int function); +struct def *DeclProc(register struct node *nd, struct type *tp, + register struct scopelist *scl); +struct def * +DeclFunc(register struct node *nd, struct type *tp, + register struct scopelist *scl); +void EndFunc(register struct def *df); +void EndBlock(register struct def *block_df); + +#endif diff --git a/lang/pc/comp/desig.c b/lang/pc/comp/desig.c index 566bb36a4..3e88fd633 100644 --- a/lang/pc/comp/desig.c +++ b/lang/pc/comp/desig.c @@ -22,16 +22,15 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "code.h" +#include "error.h" struct desig InitDesig = {DSG_INIT, 0, 0, NULLDEF, 0}; struct withdesig *WithDesigs; -void CodeValue(); -STATIC int -properly(ds, size, al) - register struct desig *ds; - arith size; + +static int properly(register struct desig *ds, arith size, int al) { /* Check if it is allowed to load or store the value indicated by "ds" with LOI/STI. @@ -55,9 +54,7 @@ properly(ds, size, al) (! wordmodsz && ds->dsg_offset % size == 0)); } -CodeCopy(lhs, rhs, sz, psize) - register struct desig *lhs, *rhs; - arith sz, *psize; +void CodeCopy(register struct desig *lhs, register struct desig *rhs, arith sz, arith *psize) { struct desig l, r; @@ -72,11 +69,7 @@ CodeCopy(lhs, rhs, sz, psize) C_sti(sz); } -void -CodeMove(rhs, left, rtp) - register struct desig *rhs; - register struct node *left; - struct type *rtp; +void CodeMove(register struct desig *rhs, register struct node *left, struct type *rtp) { struct desig dsl; register struct desig *lhs = &dsl; @@ -152,10 +145,7 @@ CodeMove(rhs, left, rtp) } } -void -CodeValue(ds, tp) - register struct desig *ds; - register struct type *tp; +void CodeValue(register struct desig *ds, register struct type *tp) { /* Generate code to load the value of the designator described in "ds" @@ -212,9 +202,7 @@ CodeValue(ds, tp) ds->dsg_kind = DSG_LOADED; } -CodeStore(ds, tp) - register struct desig *ds; - register struct type *tp; +void CodeStore(register struct desig *ds, register struct type *tp) { /* Generate code to store the value on the stack in the designator described in "ds" @@ -265,8 +253,7 @@ CodeStore(ds, tp) ds->dsg_kind = DSG_INIT; } -CodeAddress(ds) - register struct desig *ds; +void CodeAddress(register struct desig *ds) { /* Generate code to load the address of the designator described in "ds" @@ -316,9 +303,7 @@ CodeAddress(ds) ds->dsg_kind = DSG_PLOADED; } -CodeFieldDesig(df, ds) - register struct def *df; - register struct desig *ds; +void CodeFieldDesig(register struct def *df, register struct desig *ds) { /* Generate code for a field designator. Only the code common for address as well as value computation is generated, and the @@ -369,10 +354,7 @@ CodeFieldDesig(df, ds) ds->dsg_packed = df->fld_flags & F_PACKED; } -void -CodeVarDesig(df, ds) - register struct def *df; - register struct desig *ds; +void CodeVarDesig(register struct def *df, register struct desig *ds) { /* Generate code for a variable represented by a "def" structure. Of course, there are numerous cases: the variable is local, @@ -436,9 +418,7 @@ CodeVarDesig(df, ds) ds->dsg_def = df; } -CodeBoundDesig(df, ds) - register struct def *df; - register struct desig *ds; +void CodeBoundDesig(register struct def *df, register struct desig *ds) { /* Generate code for the lower- and upperbound of a conformant array */ @@ -464,9 +444,7 @@ CodeBoundDesig(df, ds) ds->dsg_kind = DSG_LOADED; } -CodeFuncDesig(df, ds) - register struct def *df; - register struct desig *ds; +void CodeFuncDesig(register struct def *df, register struct desig *ds) { /* generate code to store the function result */ @@ -500,9 +478,7 @@ CodeFuncDesig(df, ds) ds->dsg_offset = df->prc_res; } -CodeDesig(nd, ds) - register struct node *nd; - register struct desig *ds; +void CodeDesig(register struct node *nd, register struct desig *ds) { /* Generate code for a designator. Use divide and conquer principle diff --git a/lang/pc/comp/desig.xh b/lang/pc/comp/desig.xh index ff4849dcd..0bbb99c1c 100644 --- a/lang/pc/comp/desig.xh +++ b/lang/pc/comp/desig.xh @@ -1,3 +1,6 @@ +#ifndef DESIG_H_ +#define DESIG_H_ + /* D E S I G N A T O R D E S C R I P T I O N S */ /* Generating code for designators is not particularly easy, especially if @@ -57,3 +60,32 @@ extern struct withdesig *WithDesigs; extern struct desig InitDesig; #define NO_LABEL ((label) 0) + + + +/* Copies psize bytes from "rhs" to "lhs" */ +void CodeCopy(register struct desig *lhs, register struct desig *rhs, arith sz, arith *psize); +/* Generate code for an assignment. */ +void CodeMove(register struct desig *rhs, register struct node *left, struct type *rtp); +/* Generate code to load the value of the designator described + in "ds" onto the operand stack. */ +void CodeValue(register struct desig *ds, register struct type *tp); +/* Generate code to store the value on the stack in the designator + described in "ds" */ +void CodeStore(register struct desig *ds, register struct type *tp); +/* Generate code to load the address of the designator described + in "ds" unto the operand stack */ +void CodeAddress(register struct desig *ds); +/* Generate code for a field designator. */ +void CodeFieldDesig(register struct def *df, register struct desig *ds); +/* Generate code for a variable represented by a "def" structure.*/ +void CodeVarDesig(register struct def *df, register struct desig *ds); +/* Generate code for the lower- and upperbound of a conformant array */ +void CodeBoundDesig(register struct def *df, register struct desig *ds); +/* generate code to store the function result */ +void CodeFuncDesig(register struct def *df, register struct desig *ds); +/* Generate code for a designator. Use divide and conquer + principle */ +void CodeDesig(register struct node *nd, register struct desig *ds); + +#endif diff --git a/lang/pc/comp/enter.c b/lang/pc/comp/enter.c index 6eda97fdc..f3fc578fa 100644 --- a/lang/pc/comp/enter.c +++ b/lang/pc/comp/enter.c @@ -14,126 +14,135 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "progs.h" +#include "enter.h" +#ifdef DBSYMTAB +#include "stab.h" +#endif + +extern int proclevel; +extern int parlevel; + -extern int proclevel; -extern int parlevel; -struct def * -Enter(name, kind, type, pnam) - char *name; - register struct type *type; - long kind; +struct def *Enter(char *name, long kind, register struct type *type, int pnam) { /* Enter a definition for "name" with kind "kind" and type - "type" in the Current Scope. If it is a standard name, also - put its number in the definition structure, and mark the - name as set, to inhibit warnings about used before set. - */ + "type" in the Current Scope. If it is a standard name, also + put its number in the definition structure, and mark the + name as set, to inhibit warnings about used before set. + */ register struct def *df; df = define(str2idf(name, 0), CurrentScope, kind); df->df_type = type; - if( pnam ) { + if (pnam) + { df->df_value.df_reqname = pnam; df->df_flags |= D_SET; } #ifdef DBSYMTAB - else if (options['g']) stb_string(df, kind); + else if (options['g']) + stb_string(df, kind); #endif /* DBSYMTAB */ return df; } -EnterProgList(Idlist) - register struct node *Idlist; +void EnterProgList(register struct node *Idlist) { register struct node *idlist = Idlist; register struct def *df; - for( ; idlist; idlist = idlist->nd_next ) - if ( !strcmp(input, idlist->nd_IDF->id_text) - || - !strcmp(output, idlist->nd_IDF->id_text) - ) { + for (; idlist; idlist = idlist->nd_next) + if (!strcmp(input, idlist->nd_IDF->id_text) + || !strcmp(output, idlist->nd_IDF->id_text)) + { /* the occurence of input or output as program- * parameter is their declaration as a GLOBAL * variable of type text */ - if( df = define(idlist->nd_IDF, CurrentScope, - D_VARIABLE) ) { + if ( (df = define(idlist->nd_IDF, CurrentScope, + D_VARIABLE)) ) + { df->df_type = text_type; df->df_flags |= (D_SET | D_PROGPAR | D_NOREG); - if( !strcmp(input, idlist->nd_IDF->id_text) ) { + if (!strcmp(input, idlist->nd_IDF->id_text)) + { df->var_name = input; set_inp(); } - else { + else + { df->var_name = output; set_outp(); } #ifdef DBSYMTAB - if (options['g']) stb_string(df, D_VARIABLE); + if (options['g']) + stb_string(df, D_VARIABLE); #endif /* DBSYMTAB */ } } - else { - if( df = define(idlist->nd_IDF, CurrentScope, - D_PARAMETER) ) { + else + { + if ( (df = define(idlist->nd_IDF, CurrentScope, + D_PARAMETER)) ) + { df->df_type = error_type; df->df_flags |= D_PROGPAR; df->var_name = idlist->nd_IDF->id_text; } } - + FreeNode(Idlist); } -EnterEnumList(Idlist, type) - struct node *Idlist; - register struct type *type; +void EnterEnumList(struct node *Idlist, register struct type *type) { /* Put a list of enumeration literals in the symbol table. - They all have type "type". Also assign numbers to them. - */ + They all have type "type". Also assign numbers to them. + */ register struct def *df, *df1 = 0; register struct node *idlist = Idlist; type->enm_ncst = 0; - for( ; idlist; idlist = idlist->nd_next ) - if( df = define(idlist->nd_IDF, CurrentScope, D_ENUM) ) { + for (; idlist; idlist = idlist->nd_next) + if ( (df = define(idlist->nd_IDF, CurrentScope, D_ENUM)) ) + { df->df_type = type; df->enm_val = (type->enm_ncst)++; df->df_flags |= D_SET; - if (! df1) { + if (!df1) + { type->enm_enums = df; } - else df1->enm_next = df; + else + df1->enm_next = df; df1 = df; } FreeNode(Idlist); } -EnterFieldList(Idlist, type, scope, addr, packed) - struct node *Idlist; - register struct type *type; - struct scope *scope; - arith *addr; - unsigned short packed; +void EnterFieldList(struct node *Idlist, register struct type *type, + struct scope *scope, arith *addr, unsigned short packed) { /* Put a list of fields in the symbol table. - They all have type "type", and are put in scope "scope". - */ + They all have type "type", and are put in scope "scope". + */ register struct def *df; register struct node *idlist = Idlist; - for( ; idlist; idlist = idlist->nd_next ) - if( df = define(idlist->nd_IDF, scope, D_FIELD) ) { + for (; idlist; idlist = idlist->nd_next) + if ( (df = define(idlist->nd_IDF, scope, D_FIELD)) ) + { df->df_type = type; - if( packed ) { + if (packed) + { df->fld_flags |= F_PACKED; df->fld_off = align(*addr, type->tp_palign); *addr = df->fld_off + type->tp_psize; } - else { + else + { df->fld_off = align(*addr, type->tp_align); *addr = df->fld_off + type->tp_size; } @@ -141,24 +150,24 @@ EnterFieldList(Idlist, type, scope, addr, packed) FreeNode(Idlist); } -EnterVarList(Idlist, type, local) - struct node *Idlist; - struct type *type; +void EnterVarList(struct node *Idlist, struct type *type, int local) { /* Enter a list of identifiers representing variables into the - name list. "type" represents the type of the variables. - "local" is set if the variables are declared local to a - procedure. - */ + name list. "type" represents the type of the variables. + "local" is set if the variables are declared local to a + procedure. + */ register struct def *df; register struct node *idlist = Idlist; register struct scopelist *sc = CurrVis; - for( ; idlist; idlist = idlist->nd_next ) { - if( !(df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE)) ) - continue; /* skip this identifier */ + for (; idlist; idlist = idlist->nd_next) + { + if (!(df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE))) + continue; /* skip this identifier */ df->df_type = type; - if( local ) { + if (local) + { /* subtract size, which is already aligned, of * variable to the offset, as the variable list * exists only local to a procedure @@ -166,74 +175,90 @@ EnterVarList(Idlist, type, local) sc->sc_scope->sc_off -= type->tp_size; df->var_off = sc->sc_scope->sc_off; } - else { /* Global name */ + else + { /* Global name */ df->var_name = df->df_idf->id_text; df->df_flags |= D_NOREG; } #ifdef DBSYMTAB - if (options['g']) stb_string(df, D_VARIABLE); + if (options['g']) + stb_string(df, D_VARIABLE); #endif /* DBSYMTAB */ } FreeNode(Idlist); } -arith -EnterParamList(fpl, parlist) - register struct node *fpl; - struct paramlist **parlist; + +static void LinkParam(struct paramlist **parlist, struct def *df) +{ + static struct paramlist *pr; + + if (!*parlist) + *parlist = pr = new_paramlist(); + else + { + pr->next = new_paramlist(); + pr = pr->next; + } + pr->par_def = df; +} + + +arith EnterParamList(register struct node *fpl, struct paramlist **parlist) { register arith nb_pars = (proclevel > 1) ? pointer_size : 0; register struct node *id; struct type *tp; struct def *df; - for( ; fpl; fpl = fpl->nd_right ) { + for (; fpl; fpl = fpl->nd_right) + { assert(fpl->nd_class == Link); tp = fpl->nd_type; - for( id = fpl->nd_left; id; id = id->nd_next ) - if( df = define(id->nd_IDF, CurrentScope, D_VARIABLE) ) { - df->var_off = nb_pars; - if( fpl->nd_INT & D_VARPAR || IsConformantArray(tp) ) - nb_pars += pointer_size; - else - nb_pars += tp->tp_size; - LinkParam(parlist, df); - df->df_type = tp; - df->df_flags |= fpl->nd_INT; - } + for (id = fpl->nd_left; id; id = id->nd_next) + if ( (df = define(id->nd_IDF, CurrentScope, D_VARIABLE)) ) + { + df->var_off = nb_pars; + if (fpl->nd_INT & D_VARPAR || IsConformantArray(tp)) + nb_pars += pointer_size; + else + nb_pars += tp->tp_size; + LinkParam(parlist, df); + df->df_type = tp; + df->df_flags |= fpl->nd_INT; + } - while( IsConformantArray(tp) ) { + while (IsConformantArray(tp)) + { /* we need room for the descriptors */ tp->arr_sclevel = CurrentScope->sc_level; tp->arr_cfdescr = nb_pars; nb_pars += 3 * word_size; tp = tp->arr_elem; - } + } } return nb_pars; } -arith -EnterParTypes(fpl, parlist) - register struct node *fpl; - struct paramlist **parlist; +arith EnterParTypes(register struct node *fpl, struct paramlist **parlist) { /* parameters.h in heading of procedural and functional - parameters (only types are important, not the names). - */ + parameters (only types are important, not the names). + */ register arith nb_pars = 0; register struct node *id; struct type *tp; struct def *df; - for( ; fpl; fpl = fpl->nd_right ) { + for (; fpl; fpl = fpl->nd_right) + { tp = fpl->nd_type; - for( id = fpl->nd_left; id; id = id->nd_next ) - if( df = new_def() ) { - if( fpl->nd_INT & D_VARPAR || - IsConformantArray(tp) ) + for (id = fpl->nd_left; id; id = id->nd_next) + if ( (df = new_def()) ) + { + if (fpl->nd_INT & D_VARPAR || IsConformantArray(tp)) nb_pars += pointer_size; else nb_pars += tp->tp_size; @@ -241,7 +266,8 @@ EnterParTypes(fpl, parlist) df->df_type = tp; df->df_flags |= fpl->nd_INT; } - while( IsConformantArray(tp) ) { + while (IsConformantArray(tp)) + { nb_pars += 3 * word_size; tp = tp->arr_elem; } @@ -249,17 +275,3 @@ EnterParTypes(fpl, parlist) return nb_pars; } -LinkParam(parlist, df) - struct paramlist **parlist; - struct def *df; -{ - static struct paramlist *pr; - - if( !*parlist ) - *parlist = pr = new_paramlist(); - else { - pr->next = new_paramlist(); - pr = pr->next; - } - pr->par_def = df; -} diff --git a/lang/pc/comp/enter.h b/lang/pc/comp/enter.h new file mode 100644 index 000000000..68338c38f --- /dev/null +++ b/lang/pc/comp/enter.h @@ -0,0 +1,26 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef ENTER_H_ +#define ENTER_H_ + +#include "em_arith.h" + +/* Forward structure declarations. */ +struct type; +struct node; +struct paramlist; + + +struct def *Enter(char *name, long kind, register struct type *type, int pnam); +void EnterProgList(register struct node *Idlist); +void EnterEnumList(struct node *Idlist, register struct type *type); +void EnterFieldList(struct node *Idlist, register struct type *type, + struct scope *scope, arith *addr, unsigned short packed); +void EnterVarList(struct node *Idlist, struct type *type, int local); +arith EnterParamList(register struct node *fpl, struct paramlist **parlist); +arith EnterParTypes(register struct node *fpl, struct paramlist **parlist); + +#endif /* ENTER_H_ */ diff --git a/lang/pc/comp/error.c b/lang/pc/comp/error.c index dd75c79e6..768403b2d 100644 --- a/lang/pc/comp/error.c +++ b/lang/pc/comp/error.c @@ -16,7 +16,10 @@ #include #include #include -#include +#include +#include +#include "print.h" +#include "system.h" #include "LLlex.h" #include "f_info.h" @@ -37,9 +40,7 @@ int err_occurred; -extern char *symbol2str(); - -void _error(); +static void _error(int, struct node *, char *, register va_list); /* There are three general error-message functions: lexerror() lexical and pre-processor error messages @@ -55,7 +56,7 @@ void _error(); #if __STDC__ #ifdef DEBUG /*VARARGS*/ -debug(char *fmt, ...) +void debug(char *fmt, ...) { va_list ap; @@ -68,7 +69,7 @@ debug(char *fmt, ...) #endif /* DEBUG */ /*VARARGS*/ -error(char *fmt, ...) +void error(char *fmt, ...) { va_list ap; @@ -80,7 +81,7 @@ error(char *fmt, ...) } /*VARARGS*/ -node_error(struct node *node, char *fmt, ...) +void node_error(struct node *node, char *fmt, ...) { va_list ap; @@ -92,7 +93,7 @@ node_error(struct node *node, char *fmt, ...) } /*VARARGS*/ -warning(char *fmt, ...) +void warning(char *fmt, ...) { va_list ap; @@ -104,7 +105,7 @@ warning(char *fmt, ...) } /*VARARGS*/ -node_warning(struct node *node, char *fmt, ...) +void node_warning(struct node *node, char *fmt, ...) { va_list ap; @@ -116,7 +117,7 @@ node_warning(struct node *node, char *fmt, ...) } /*VARARGS*/ -lexerror(char *fmt, ...) +void lexerror(char *fmt, ...) { va_list ap; @@ -128,7 +129,7 @@ lexerror(char *fmt, ...) } /*VARARGS*/ -lexwarning(char *fmt, ...) +void lexwarning(char *fmt, ...) { va_list ap; @@ -140,7 +141,7 @@ lexwarning(char *fmt, ...) } /*VARARGS*/ -fatal(char *fmt, ...) +void fatal(char *fmt, ...) { va_list ap; @@ -149,11 +150,11 @@ fatal(char *fmt, ...) _error(FATAL, NULLNODE, fmt, ap); } va_end(ap); - sys_stop(S_EXIT); + exit(EXIT_FAILURE); } /*VARARGS*/ -crash(char *fmt, ...) +void crash(char *fmt, ...) { va_list ap; @@ -163,15 +164,15 @@ crash(char *fmt, ...) } va_end(ap); #ifdef DEBUG - sys_stop(S_ABORT); + abort(); #else - sys_stop(S_EXIT); + exit(EXIT_FAILURE); #endif } #else #ifdef DEBUG /*VARARGS*/ -debug(va_alist) +void debug(va_alist) va_dcl { va_list ap; @@ -186,7 +187,7 @@ debug(va_alist) #endif /* DEBUG */ /*VARARGS*/ -error(va_alist) +void error(va_alist) va_dcl { va_list ap; @@ -200,7 +201,7 @@ error(va_alist) } /*VARARGS*/ -node_error(va_alist) +void node_error(va_alist) va_dcl { va_list ap; @@ -215,7 +216,7 @@ node_error(va_alist) } /*VARARGS*/ -warning(va_alist) +void warning(va_alist) va_dcl { va_list ap; @@ -229,7 +230,7 @@ warning(va_alist) } /*VARARGS*/ -node_warning(va_alist) +void node_warning(va_alist) va_dcl { va_list ap; @@ -244,7 +245,7 @@ node_warning(va_alist) } /*VARARGS*/ -lexerror(va_alist) +void lexerror(va_alist) va_dcl { va_list ap; @@ -258,7 +259,7 @@ lexerror(va_alist) } /*VARARGS*/ -lexwarning(va_alist) +void lexwarning(va_alist) va_dcl { va_list ap; @@ -272,7 +273,7 @@ lexwarning(va_alist) } /*VARARGS*/ -fatal(va_alist) +void fatal(va_alist) va_dcl { va_list ap; @@ -283,11 +284,11 @@ fatal(va_alist) _error(FATAL, NULLNODE, fmt, ap); } va_end(ap); - sys_stop(S_EXIT); + exit(EXIT_FAILURE); } /*VARARGS*/ -crash(va_alist) +void crash(va_alist) va_dcl { va_list ap; @@ -299,19 +300,14 @@ crash(va_alist) } va_end(ap); #ifdef DEBUG - sys_stop(S_ABORT); + abort(); #else - sys_stop(S_EXIT); + exit(EXIT_FAILURE); #endif } #endif -void -_error(class, node, fmt, ap) - int class; - struct node *node; - char *fmt; - register va_list ap; +static void _error(int class, struct node *node, char *fmt, register va_list ap) { /* _error attempts to limit the number of error messages for a given line to MAXERR_LINE. diff --git a/lang/pc/comp/error.h b/lang/pc/comp/error.h new file mode 100644 index 000000000..b6fa60d63 --- /dev/null +++ b/lang/pc/comp/error.h @@ -0,0 +1,25 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef ERROR_H_ +#define ERROR_H_ + +/* Forward struct declarations */ +struct node; + +#ifdef DEBUG +void debug(char *fmt, ...); +#endif /* DEBUG */ + +void error(char *fmt, ...); +void node_error(struct node *node, char *fmt, ...); +void warning(char *fmt, ...); +void node_warning(struct node *node, char *fmt, ...); +void lexerror(char *fmt, ...); +void lexwarning(char *fmt, ...); +void fatal(char *fmt, ...); +void crash(char *fmt, ...); + +#endif /* ERROR_H_ */ diff --git a/lang/pc/comp/expression.g b/lang/pc/comp/expression.g index c21961006..25f79de0c 100644 --- a/lang/pc/comp/expression.g +++ b/lang/pc/comp/expression.g @@ -16,6 +16,8 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "code.h" +#include "error.h" } Constant(register struct node **pnd;) diff --git a/lang/pc/comp/idf.h b/lang/pc/comp/idf.h index 62e72bb57..9cb3dffb4 100644 --- a/lang/pc/comp/idf.h +++ b/lang/pc/comp/idf.h @@ -1,4 +1,6 @@ /* U S E R D E C L A R E D P A R T O F I D F */ +#ifndef IDF_H_ +#define IDF_H_ struct id_u { int id_res; @@ -10,3 +12,5 @@ struct id_u { #define id_def id_user.id_df #include + +#endif diff --git a/lang/pc/comp/input.c b/lang/pc/comp/input.c index 7497440c6..6f8a00d32 100644 --- a/lang/pc/comp/input.c +++ b/lang/pc/comp/input.c @@ -12,10 +12,16 @@ struct f_info file_info; #include -AtEoIF() +int AtEoIF(void) { /* Make the unstacking of input streams noticable to the lexical analyzer */ return 1; } + +int +AtEoIT(void) +{ + return 0; +} diff --git a/lang/pc/comp/label.c b/lang/pc/comp/label.c index b303b7dc5..e6e8def2e 100644 --- a/lang/pc/comp/label.c +++ b/lang/pc/comp/label.c @@ -11,12 +11,13 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "label.h" +#include "error.h" -void CodeLabel(); +static void CodeLabel(register struct def *df, int local); -DeclLabel(nd) - struct node *nd; +void DeclLabel(struct node *nd) { struct def *df; @@ -29,7 +30,7 @@ DeclLabel(nd) } } -chk_labels(Slevel) +void chk_labels(int Slevel) { register struct node *labnd = BlockScope->sc_lablist; register struct def *df; @@ -62,8 +63,7 @@ chk_labels(Slevel) } } -TstLabel(nd, Slevel) - register struct node *nd; +void TstLabel(register struct node *nd, int Slevel) { register struct def *df; @@ -105,9 +105,7 @@ TstLabel(nd, Slevel) CodeLabel(df, 1); } -void -DefLabel(nd, Slevel) - register struct node *nd; +void DefLabel(register struct node *nd, int Slevel) { register struct def *df; @@ -142,9 +140,7 @@ DefLabel(nd, Slevel) } } -void -CodeLabel(df, local) - register struct def *df; +static void CodeLabel(register struct def *df, int local) { if( err_occurred ) return; diff --git a/lang/pc/comp/label.h b/lang/pc/comp/label.h new file mode 100644 index 000000000..001865f86 --- /dev/null +++ b/lang/pc/comp/label.h @@ -0,0 +1,17 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef LABEL_H_ +#define LABEL_H_ + +struct node; + +void DeclLabel(struct node *nd); +void chk_labels(int Slevel); +void TstLabel(register struct node *nd, int Slevel); +void DefLabel(register struct node *nd, int Slevel); + + +#endif /* LABEL_H_ */ diff --git a/lang/pc/comp/lookup.c b/lang/pc/comp/lookup.c index f051c99f4..ea9ab976c 100644 --- a/lang/pc/comp/lookup.c +++ b/lang/pc/comp/lookup.c @@ -13,9 +13,9 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "lookup.h" -remove_def(df) - register struct def *df; +void remove_def(register struct def *df) { struct idf *id= df->df_idf; struct def *df1 = id->id_def; @@ -28,17 +28,9 @@ remove_def(df) free_def(df); } -struct def * -lookup(id, scope, inuse) - register struct idf *id; - struct scope *scope; - long inuse; +struct def *lookup(register struct idf *id, struct scope *scope, long inuse) { - /* Look up a definition of an identifier in scope "scope". - Make the "def" list self-organizing. - Return a pointer to its "def" structure if it exists, - otherwise return 0. - */ + register struct def *df, *df1; /* Look in the chain of definitions of this "id" for one with scope @@ -67,15 +59,10 @@ lookup(id, scope, inuse) return df; } -struct def * -lookfor(id, vis, give_error) - register struct node *id; - struct scopelist *vis; + +struct def *lookfor(register struct node *id, struct scopelist *vis, int give_error) { - /* Look for an identifier in the visibility range started by "vis". - If it is not defined create a dummy definition and - if give_error is set, give an error message. - */ + register struct def *df, *tmp_df; register struct scopelist *sc = vis; @@ -84,8 +71,8 @@ lookfor(id, vis, give_error) if( df ) { while( vis->sc_scope->sc_level > sc->sc_scope->sc_level ) { - if( tmp_df = define(id->nd_IDF, vis->sc_scope, - D_INUSE)) + if( (tmp_df = define(id->nd_IDF, vis->sc_scope, + D_INUSE)) ) tmp_df->usd_def = df; vis = nextvisible(vis); } @@ -96,8 +83,8 @@ lookfor(id, vis, give_error) */ if( (vis->sc_scope == GlobalScope) && !lookup(id->nd_IDF, GlobalScope, D_INUSE) ) { - if( tmp_df = define(id->nd_IDF, vis->sc_scope, - D_INUSE)) + if( (tmp_df = define(id->nd_IDF, vis->sc_scope, + D_INUSE)) ) tmp_df->usd_def = df; } diff --git a/lang/pc/comp/lookup.h b/lang/pc/comp/lookup.h new file mode 100644 index 000000000..3b3c3eba5 --- /dev/null +++ b/lang/pc/comp/lookup.h @@ -0,0 +1,29 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef LOOKUP_H_ +#define LOOKUP_H_ + +struct def; +struct idf; +struct scope; +struct node; + +void remove_def(register struct def *df); + +/* Look up a definition of an identifier in scope "scope". + Make the "def" list self-organizing. + Return a pointer to its "def" structure if it exists, + otherwise return NULL. +*/ +struct def *lookup(register struct idf *id, struct scope *scope, long inuse); + +/* Look for an identifier in the visibility range started by "vis". + If it is not defined create a dummy definition and + if give_error is set, give an error message. +*/ +struct def *lookfor(register struct node *id, struct scopelist *vis, int give_error); + +#endif /* LOOKUP_H_ */ diff --git a/lang/pc/comp/main.c b/lang/pc/comp/main.c index 46eabf855..a7305e4cb 100644 --- a/lang/pc/comp/main.c +++ b/lang/pc/comp/main.c @@ -10,6 +10,7 @@ #include #include +#include "print.h" #include "LLlex.h" #include "Lpars.h" #include "class.h" @@ -24,6 +25,10 @@ #include "tokenname.h" #include "type.h" #include "scope.h" +#include "cstoper.h" +#include "stab.h" +#include "options.h" +#include "error.h" char options[128]; char *ProgName; @@ -36,9 +41,16 @@ label text_label; struct def *program; extern int fp_used; /* set if floating point used */ +extern void LLparse(void); -main(argc, argv) - register char **argv; +int Compile(char *src, char *dst); +void AddRequired(void); +#ifdef DEBUG +void LexScan(void); +void Info(void); +#endif + +int main(int argc, register char **argv) { register int Nargc = 1; register char **Nargv = &argv[0]; @@ -54,14 +66,14 @@ main(argc, argv) Nargv[Nargc] = 0; /* terminate the arg vector */ if( Nargc < 2 ) { fprint(STDERR, "%s: Use a file argument\n", ProgName); - sys_stop(S_EXIT); + return EXIT_FAILURE; } - if(!Compile(Nargv[1], Nargv[2])) sys_stop(S_EXIT); - sys_stop(S_END); + if(!Compile(Nargv[1], Nargv[2])) + return EXIT_FAILURE; + return EXIT_SUCCESS; } -Compile(src, dst) - char *src, *dst; +int Compile(char *src, char *dst) { extern struct tokenname tkidf[]; extern struct tokenname tkstandard[]; @@ -128,10 +140,10 @@ Compile(src, dst) } #ifdef DEBUG -LexScan() +void LexScan(void) { register struct token *tkp = ˙ - extern char *symbol2str(); + while( LLlex() > 0 ) { print(">>> %s ", symbol2str(tkp->tk_symb)); @@ -159,7 +171,7 @@ LexScan() } #endif -AddRequired() +void AddRequired(void) { register struct def *df; extern struct def *Enter(); @@ -259,7 +271,7 @@ AddRequired() #ifdef DEBUG int cntlines; -Info() +void Info(void) { extern int cnt_def, cnt_node, cnt_paramlist, cnt_type, cnt_scope, cnt_scopelist, cnt_tmpvar, cnt_withdesig, diff --git a/lang/pc/comp/misc.c b/lang/pc/comp/misc.c index cb9a40ef9..7f4f15079 100644 --- a/lang/pc/comp/misc.c +++ b/lang/pc/comp/misc.c @@ -12,25 +12,23 @@ #include "main.h" #include "misc.h" #include "node.h" +#include "print.h" +#include "error.h" -struct idf * -gen_anon_idf() +struct idf *gen_anon_idf(void) { /* A new idf is created out of nowhere, to serve as an anonymous name. */ static int name_cnt; char *s = Malloc(strlen(FileName) + 50); - char *sprint(); sprint(s, "#%d in %s, line %u", ++name_cnt, FileName, LineNumber); s = Realloc(s, strlen(s)+1); return str2idf(s, 0); } -not_declared(what, id, where) - char *what, *where; - register struct node *id; +void not_declared(char *what, register struct node *id, char *where) { /* The identifier "id" is not declared. If it is not generated, give an error message @@ -41,15 +39,13 @@ not_declared(what, id, where) } } -char * -gen_proc_name(id, inp) - register struct idf *id; +char *gen_proc_name(register struct idf *id, int inp) { /* generate pseudo and internal name for procedure or function */ static int name_cnt; static char buf[256]; - char *sprint(), *Salloc(); + if( inp ) { sprint(buf, "_%d%s", ++name_cnt, id->id_text); diff --git a/lang/pc/comp/misc.h b/lang/pc/comp/misc.h index ec1abe06c..1f0c95113 100644 --- a/lang/pc/comp/misc.h +++ b/lang/pc/comp/misc.h @@ -1,5 +1,7 @@ /* M I S C E L L A N E O U S */ +struct node; + #define is_anon_idf(x) ((x)->id_text[0] == '#') #define id_not_declared(x) (not_declared("identifier", (x), "")) @@ -9,11 +11,7 @@ extern struct idf extern char *gen_proc_name(); +void not_declared(char *what, register struct node *id, char *where); + extern char *symbol2str(); -extern arith NewInt(); -extern arith NewPtr(); -extern arith CodeBeginBlock(); -extern arith EnterParamList(); -extern arith EnterParTypes(); -extern arith CodeInitFor(); -extern arith IsString(); + diff --git a/lang/pc/comp/next.in b/lang/pc/comp/next.in new file mode 100644 index 000000000..8d08f7397 --- /dev/null +++ b/lang/pc/comp/next.in @@ -0,0 +1,2 @@ +#include "parameters.h" +#include "debug.h" diff --git a/lang/pc/comp/node.c b/lang/pc/comp/node.c index 1d8a491f0..46141505e 100644 --- a/lang/pc/comp/node.c +++ b/lang/pc/comp/node.c @@ -6,16 +6,14 @@ #include #include #include -#include +#include "print.h" #include "LLlex.h" #include "node.h" #include "type.h" +#include "error.h" -struct node * -MkNode(class, left, right, token) - struct node *left, *right; - struct token *token; +struct node *MkNode(int class, struct node *left, struct node *right, struct token *token) { /* Create a node and initialize it with the given parameters */ @@ -29,9 +27,7 @@ MkNode(class, left, right, token) return nd; } -struct node * -MkLeaf(class, token) - struct token *token; +struct node *MkLeaf(int class, struct token *token) { register struct node *nd = new_node(); @@ -42,9 +38,7 @@ MkLeaf(class, token) return nd; } -void -FreeNode(nd) - register struct node *nd; +void FreeNode(register struct node *nd) { /* Put nodes that are no longer needed back onto the free list */ @@ -54,8 +48,7 @@ FreeNode(nd) free_node(nd); } -NodeCrash(expp) - struct node *expp; +int NodeCrash(struct node *expp) { crash("Illegal node %d", expp->nd_class); } @@ -64,14 +57,13 @@ NodeCrash(expp) extern char *symbol2str(); -indnt(lvl) +void indnt(int lvl) { while( lvl-- ) print(" "); } -printnode(nd, lvl) - register struct node *nd; +void printnode(register struct node *nd, int lvl) { indnt(lvl); print("Class: %d; Symbol: %s\n", nd->nd_class, symbol2str(nd->nd_symb)); @@ -83,8 +75,7 @@ printnode(nd, lvl) } } -PrNode(nd, lvl) - register struct node *nd; +void PrNode(register struct node *nd, int lvl) { if( !nd ) { indnt(lvl); print("\n"); diff --git a/lang/pc/comp/node.xh b/lang/pc/comp/node.xh index 1f8c56d3e..da1b25394 100644 --- a/lang/pc/comp/node.xh +++ b/lang/pc/comp/node.xh @@ -1,4 +1,7 @@ /* N O D E O F A N A B S T R A C T P A R S E T R E E */ +#ifndef NODE_H_ +#define NODE_H_ + struct node { struct node *nd_left; @@ -37,12 +40,22 @@ struct node { #define nd_REL nd_token.TOK_REL #define nd_RLA nd_token.TOK_RLA #define nd_RIV nd_token.TOK_RIV + + + }; /* ALLOCDEF "node" 50 */ -extern struct node *MkNode(), *MkLeaf(), *ChkStdInOut(); +struct node *MkNode(int class, struct node *left, struct node *right, struct token *token); +struct node *MkLeaf(int class, struct token *token); +void FreeNode(register struct node *nd); +int NodeCrash(struct node *expp); + + #define IsProcCall(lnd) ((lnd)->nd_type->tp_fund & T_ROUTINE) #define NULLNODE ((struct node *) 0) + +#endif diff --git a/lang/pc/comp/options.c b/lang/pc/comp/options.c index 4ecf51a68..75df7c3ad 100644 --- a/lang/pc/comp/options.c +++ b/lang/pc/comp/options.c @@ -7,7 +7,12 @@ #include "class.h" #include "const.h" #include "main.h" +#include "LLlex.h" +#include "node.h" #include "type.h" +#include "options.h" +#include "error.h" + #define MINIDFSIZE 9 @@ -18,13 +23,28 @@ recognize some keywords! extern int idfsize; -DoOption(text) - register char *text; + +static int txt2int(register char **tp) +{ + /* the integer pointed to by *tp is read, while increasing + *tp; the resulting value is yielded. + */ + register int val = 0; + register int ch; + + while( ch = **tp, ch >= '0' && ch <= '9' ) { + val = val * 10 + ch - '0'; + (*tp)++; + } + return val; +} + +void DoOption(register char *text) { switch( *text++ ) { default: - options[text[-1]]++; /* flags, debug options etc. */ + options[(int)text[-1]]++; /* flags, debug options etc. */ break; /* recognized flags: -i: largest value of set of integer @@ -74,11 +94,11 @@ DoOption(text) break; } - /* case 'u': /* underscore allowed in identifiers */ - /* class('_') = STIDF; - /* inidf['_'] = 1; - /* break; - */ + /* case 'u': *//* underscore allowed in identifiers */ + /* class('_') = STIDF;*/ + /* inidf['_'] = 1;*/ + /* break;*/ + case 'V' : { /* set object sizes and alignment requirements */ /* syntax : -V[ [w|i|l|f|p] size? [.alignment]? ]* */ @@ -87,7 +107,7 @@ DoOption(text) register int align; char c, *t; - while( c = *text++ ) { + while( (c = *text++) !=0 ) { char *strchr(); t = text; @@ -150,19 +170,4 @@ DoOption(text) } } -int -txt2int(tp) - register char **tp; -{ - /* the integer pointed to by *tp is read, while increasing - *tp; the resulting value is yielded. - */ - register int val = 0; - register int ch; - - while( ch = **tp, ch >= '0' && ch <= '9' ) { - val = val * 10 + ch - '0'; - (*tp)++; - } - return val; -} + diff --git a/lang/pc/comp/options.h b/lang/pc/comp/options.h new file mode 100644 index 000000000..b02dddc30 --- /dev/null +++ b/lang/pc/comp/options.h @@ -0,0 +1,12 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef OPTIONS_H_ +#define OPTIONS_H_ + +/* Parse command line options */ +void DoOption(register char *text); + +#endif /* OPTIONS_H_ */ diff --git a/lang/pc/comp/program.g b/lang/pc/comp/program.g index dfd649e8e..e82113899 100644 --- a/lang/pc/comp/program.g +++ b/lang/pc/comp/program.g @@ -15,6 +15,11 @@ #include "main.h" #include "node.h" #include "scope.h" +#include "enter.h" +#include "progs.h" +#ifdef DBSYMTAB +#include "stab.h" +#endif } %lexical LLlex; diff --git a/lang/pc/comp/progs.c b/lang/pc/comp/progs.c index 6ed227eb9..054cc680a 100644 --- a/lang/pc/comp/progs.c +++ b/lang/pc/comp/progs.c @@ -4,6 +4,7 @@ #include #include +#include "progs.h" #include "LLlex.h" #include "def.h" #include "main.h" @@ -15,20 +16,19 @@ static int inpflag = 0; /* input mentioned in heading ? */ static int outpflag = 0; /* output mentioned in heading ? */ static label extfl_label; /* label of array of file pointers */ -void make_extfl_args(); +static void make_extfl_args(); -set_inp() +void set_inp(void) { inpflag = 1; } -set_outp() +void set_outp(void) { outpflag = 1; } -void -make_extfl() +void make_extfl(void) { if( err_occurred ) return; @@ -57,9 +57,7 @@ make_extfl() make_extfl_args( GlobalScope->sc_def ); } -void -make_extfl_args(df) - register struct def *df; +static void make_extfl_args(register struct def *df) { if( !df ) return; make_extfl_args(df->df_nextinscope); @@ -71,7 +69,7 @@ make_extfl_args(df) } } -call_ini() +void call_ini(void) { C_lxl((arith) 0); if( extflc ) diff --git a/lang/pc/comp/progs.h b/lang/pc/comp/progs.h new file mode 100644 index 000000000..9842ef4bd --- /dev/null +++ b/lang/pc/comp/progs.h @@ -0,0 +1,15 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + * Created on: 2019-02-23 + * + */ +#ifndef PROGS_H_ +#define PROGS_H_ + +void set_inp(void); +void set_outp(void); +void make_extfl(void); + +#endif /* PROGS_H_ */ diff --git a/lang/pc/comp/readwrite.c b/lang/pc/comp/readwrite.c index 35ed8860d..2ede52b3d 100644 --- a/lang/pc/comp/readwrite.c +++ b/lang/pc/comp/readwrite.c @@ -6,6 +6,7 @@ #include #include +#include "print.h" #include "LLlex.h" #include "def.h" #include "main.h" @@ -13,25 +14,33 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "code.h" +#include "chk_expr.h" +#include "typequiv.h" +#include "error.h" +#include "readwrite.h" + /* DEBUG */ #include "idf.h" -extern char *sprint(); -void CodeRead(); -void CodeReadln(); -void CodeWrite(); -void CodeWriteln(); -void -ChkRead(arg) - register struct node *arg; + +/* Internal function prototypes */ +static int ChkWriteParameter(struct type *, struct node *, char *); +static void CodeRead(register struct node *, register struct node *); +static void CodeRead(register struct node *, register struct node *); +static void CodeReadln(struct node *); +static void CodeWrite(register struct node *, register struct node *); +static void CodeWriteln(register struct node *); + +void ChkRead(register struct node *arg) { struct node *file; char *name = "read"; char *message, buff[80]; - extern char *ChkAllowedVar(); + assert(arg); assert(arg->nd_symb == ','); @@ -92,14 +101,12 @@ ChkRead(arg) } } -void -ChkReadln(arg) - register struct node *arg; +void ChkReadln(register struct node *arg) { struct node *file; char *name = "readln"; char *message, buff[80]; - extern char *ChkAllowedVar(); + if( !arg ) { if( !(file = ChkStdInOut(name, 0)) ) @@ -149,9 +156,7 @@ ChkReadln(arg) CodeReadln(file); } -void -ChkWrite(arg) - register struct node *arg; +void ChkWrite(register struct node *arg) { struct node *left, *expp, *file; char *name = "write"; @@ -191,9 +196,7 @@ ChkWrite(arg) } } -void -ChkWriteln(arg) - register struct node *arg; +void ChkWriteln(register struct node *arg) { struct node *left, *expp, *file; char *name = "writeln"; @@ -242,10 +245,7 @@ ChkWriteln(arg) CodeWriteln(file); } -ChkWriteParameter(filetype, arg, name) - struct type *filetype; - struct node *arg; - char *name; +static int ChkWriteParameter(struct type *filetype, struct node *arg, char *name) { struct type *tp; char *mess = "illegal write parameter"; @@ -277,7 +277,7 @@ ChkWriteParameter(filetype, arg, name) /* Here we have a text-file */ - if( arg = arg->nd_right ) { + if( (arg = arg->nd_right) !=0 ) { /* Total width */ assert(arg->nd_symb == ':'); @@ -289,7 +289,7 @@ ChkWriteParameter(filetype, arg, name) else return 1; - if( arg = arg->nd_right ) { + if( (arg = arg->nd_right)!=0 ) { /* Fractional Part */ assert(arg->nd_symb == ':'); @@ -305,9 +305,7 @@ ChkWriteParameter(filetype, arg, name) return 1; } -struct node * -ChkStdInOut(name, st_out) - char *name; +struct node *ChkStdInOut(char *name, int st_out) { register struct def *df; register struct node *nd; @@ -327,9 +325,7 @@ ChkStdInOut(name, st_out) return nd; } -void -CodeRead(file, arg) - register struct node *file, *arg; +static void CodeRead(register struct node *file, register struct node *arg) { struct type *tp = BaseType(arg->nd_type); @@ -386,9 +382,7 @@ CodeRead(file, arg) } } -void -CodeReadln(file) - struct node *file; +static void CodeReadln(struct node *file) { if( err_occurred ) return; @@ -397,9 +391,7 @@ CodeReadln(file) C_asp(pointer_size); } -void -CodeWrite(file, arg) - register struct node *file, *arg; +static void CodeWrite(register struct node *file, register struct node *arg) { int width = 0; register arith nbpars = pointer_size; @@ -484,9 +476,7 @@ CodeWrite(file, arg) } } -void -CodeWriteln(file) - register struct node *file; +static void CodeWriteln(register struct node *file) { if( err_occurred ) return; diff --git a/lang/pc/comp/readwrite.h b/lang/pc/comp/readwrite.h new file mode 100644 index 000000000..23dec6c05 --- /dev/null +++ b/lang/pc/comp/readwrite.h @@ -0,0 +1,18 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef READWRITE_H_ +#define READWRITE_H_ + +/* Forward structure declarations */ +struct node; + +struct node *ChkStdInOut(char *name, int st_out); +void ChkRead(register struct node *arg); +void ChkReadln(register struct node *arg); +void ChkWrite(register struct node *arg); +void ChkWriteln(register struct node *arg); + +#endif /* READWRITE_H_ */ diff --git a/lang/pc/comp/scope.c b/lang/pc/comp/scope.c index 5c09ff925..e02d18a3b 100644 --- a/lang/pc/comp/scope.c +++ b/lang/pc/comp/scope.c @@ -15,13 +15,15 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "lookup.h" +#include "error.h" struct scope *GlobalScope, *PervasiveScope, *BlockScope; struct scopelist *CurrVis; extern int proclevel; /* declared in declar.g */ static int sccount; -InitScope() +void InitScope(void) { register struct scope *sc = new_scope(); register struct scopelist *ls = new_scopelist(); @@ -33,7 +35,7 @@ InitScope() CurrVis = ls; } -open_scope() +void open_scope(void) { register struct scope *sc = new_scope(); register struct scopelist *ls = new_scopelist(); @@ -45,7 +47,7 @@ open_scope() CurrVis = ls; } -close_scope(doclean) +void close_scope(int doclean) { /* When this procedure is called, the next visible scope is equal to the statically enclosing scope @@ -62,9 +64,7 @@ close_scope(doclean) CurrVis = CurrVis->next; } -Forward(nd, tp) - register struct node *nd; - register struct type *tp; +void Forward(register struct node *nd, register struct type *tp) { /* Enter a forward reference into the current scope. This is * used in pointertypes. @@ -79,7 +79,7 @@ Forward(nd, tp) fw_type->f_type = tp; } -chk_prog_params() +void chk_prog_params(void) { /* the program parameters must be global variables of some file type */ register struct def *df = CurrentScope->sc_def; @@ -102,7 +102,7 @@ chk_prog_params() } } -chk_directives() +void chk_directives(void) { /* check if all forward declarations are defined */ register struct def *df = CurrentScope->sc_def; diff --git a/lang/pc/comp/scope.xh b/lang/pc/comp/scope.xh index 9562bd14b..948361ed5 100644 --- a/lang/pc/comp/scope.xh +++ b/lang/pc/comp/scope.xh @@ -1,4 +1,6 @@ /* S C O P E M E C H A N I S M */ +#ifndef SCOPE_H_ +#define SCOPE_H_ struct scope { struct scope *next; @@ -30,3 +32,14 @@ extern struct scopelist #define CurrentScope (CurrVis->sc_scope) #define nextvisible(x) ((x)->next) /* use with scopelists */ + + +void InitScope(void); +void open_scope(void); +void close_scope(int doclean); +void Forward(register struct node *nd, register struct type *tp); +void chk_prog_params(void); +void chk_directives(void); + + +#endif diff --git a/lang/pc/comp/stab.c b/lang/pc/comp/stab.c index 0b8c52f23..03815de8d 100644 --- a/lang/pc/comp/stab.c +++ b/lang/pc/comp/stab.c @@ -40,8 +40,7 @@ static struct db_str { char *currpos; } db_str; -static -create_db_str() +static void create_db_str(void) { if (! db_str.base) { db_str.base = Malloc(INCR_SIZE); @@ -50,9 +49,7 @@ create_db_str() db_str.currpos = db_str.base; } -static -addc_db_str(c) - int c; +static void addc_db_str(int c) { int df = db_str.currpos - db_str.base; if (df >= db_str.sz-1) { @@ -64,16 +61,12 @@ addc_db_str(c) *db_str.currpos = '\0'; } -static -adds_db_str(s) - char *s; +static void adds_db_str(char *s) { while (*s) addc_db_str(*s++); } -static void -stb_type(tp, assign_num) - register struct type *tp; +static void stb_type(register struct type *tp, int assign_num) { char buf[128]; static int stb_count; @@ -229,9 +222,7 @@ stb_type(tp, assign_num) } } -stb_addtp(s, tp) - char *s; - struct type *tp; +void stb_addtp(char *s, struct type *tp) { create_db_str(); adds_db_str(s); @@ -247,10 +238,7 @@ stb_addtp(s, tp) (arith) 0); } -void -stb_string(df, kind) - register struct def *df; - long kind; +void stb_string(register struct def *df, long kind) { register struct type *tp = df->df_type; char buf[64]; diff --git a/lang/pc/comp/stab.h b/lang/pc/comp/stab.h new file mode 100644 index 000000000..50d817f69 --- /dev/null +++ b/lang/pc/comp/stab.h @@ -0,0 +1,17 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + * Created on: 2019-02-22 + * + */ +#ifndef STAB_H_ +#define STAB_H_ + +struct def; +struct type; + +void stb_string(register struct def *df, long kind); +void stb_addtp(char *s, struct type *tp); + +#endif /* STAB_H_ */ diff --git a/lang/pc/comp/statement.g b/lang/pc/comp/statement.g index a77f6ee96..f11fefea6 100644 --- a/lang/pc/comp/statement.g +++ b/lang/pc/comp/statement.g @@ -17,6 +17,13 @@ #include "node.h" #include "scope.h" #include "type.h" +#include "body.h" +#include "code.h" +#include "error.h" +#include "readwrite.h" +#include "casestat.h" +#include "tmpvar.h" +#include "label.h" int slevel = 0; /* nesting level of statements */ } diff --git a/lang/pc/comp/tmpvar.h b/lang/pc/comp/tmpvar.h new file mode 100644 index 000000000..979cfc8e0 --- /dev/null +++ b/lang/pc/comp/tmpvar.h @@ -0,0 +1,23 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef TMPVAR_H_ +#define TMPVAR_H_ + +#include "em_arith.h" + + +struct scope; + +void TmpOpen(struct scope *sc); +arith TmpSpace(arith sz, int al); +arith NewInt(int reg_prior); +arith NewPtr(int reg_prior); +void FreeInt(arith off); +void FreePtr(arith off); +void TmpClose(void); + + +#endif /* TMPVAR_H_ */ diff --git a/lang/pc/comp/tmpvar.xc b/lang/pc/comp/tmpvar.xc index fbf76de69..5ff5b39ca 100644 --- a/lang/pc/comp/tmpvar.xc +++ b/lang/pc/comp/tmpvar.xc @@ -13,6 +13,7 @@ #include #include #include +#include #include "def.h" #include "main.h" @@ -32,17 +33,14 @@ static struct scope *ProcScope; /* scope of procedure in which the temporaries are allocated */ -TmpOpen(sc) - struct scope *sc; +void TmpOpen(struct scope *sc) { /* Initialize for temporaries in scope "sc". */ ProcScope = sc; } -arith -TmpSpace(sz, al) - arith sz; +arith TmpSpace(arith sz, int al) { register struct scope *sc = ProcScope; @@ -50,10 +48,7 @@ TmpSpace(sz, al) return sc->sc_off; } -STATIC arith -NewTmp(plist, sz, al, regtype, priority) - struct tmpvar **plist; - arith sz; +static arith NewTmp(struct tmpvar **plist, arith sz, int al, int regtype, int priority) { register arith offset; register struct tmpvar *tmp; @@ -71,22 +66,17 @@ NewTmp(plist, sz, al, regtype, priority) return offset; } -arith -NewInt(reg_prior) +arith NewInt(int reg_prior) { return NewTmp(&TmpInts, int_size, int_align, reg_any, reg_prior); } -arith -NewPtr(reg_prior) +arith NewPtr(int reg_prior) { return NewTmp(&TmpPtrs, pointer_size, pointer_align, reg_pointer, reg_prior); } -STATIC -FreeTmp(plist, off) - struct tmpvar **plist; - arith off; +static void FreeTmp(struct tmpvar **plist, arith off) { register struct tmpvar *tmp = new_tmpvar(); @@ -95,19 +85,17 @@ FreeTmp(plist, off) *plist = tmp; } -FreeInt(off) - arith off; +void FreeInt(arith off) { FreeTmp(&TmpInts, off); } -FreePtr(off) - arith off; +void FreePtr(arith off) { FreeTmp(&TmpPtrs, off); } -TmpClose() +void TmpClose(void) { register struct tmpvar *tmp, *tmp1; diff --git a/lang/pc/comp/tokenname.c b/lang/pc/comp/tokenname.c index 547287347..5f446ad12 100644 --- a/lang/pc/comp/tokenname.c +++ b/lang/pc/comp/tokenname.c @@ -2,8 +2,10 @@ #include "parameters.h" #include "Lpars.h" +#include "LLlex.h" #include "idf.h" #include "tokenname.h" +#include "error.h" /* To centralize the declaration of %tokens, their presence in this file is taken as their declaration. The Makefile will produce @@ -84,8 +86,7 @@ struct tokenname tkstandard[] = { /* standard identifiers */ /* Some routines to handle tokennames */ -reserve(resv) - register struct tokenname *resv; +void reserve(register struct tokenname *resv) { /* The names of the tokens described in resv are entered as reserved words. diff --git a/lang/pc/comp/tokenname.h b/lang/pc/comp/tokenname.h index 79ccdc4cd..082fae82e 100644 --- a/lang/pc/comp/tokenname.h +++ b/lang/pc/comp/tokenname.h @@ -6,3 +6,6 @@ struct tokenname { /* Used for defining the name of a int tn_symbol; char *tn_name; }; + + +void reserve(register struct tokenname *resv); diff --git a/lang/pc/comp/type.c b/lang/pc/comp/type.c index d13419cf4..8b8eb17f6 100644 --- a/lang/pc/comp/type.c +++ b/lang/pc/comp/type.c @@ -11,12 +11,19 @@ #include "LLlex.h" #include "const.h" +#include "chk_expr.h" #include "def.h" #include "idf.h" #include "main.h" #include "node.h" #include "scope.h" +#include "lookup.h" #include "type.h" +#include "typequiv.h" +#include "error.h" +#ifdef DBSYMTAB +#include "stab.h" +#endif #ifndef NOCROSS int @@ -51,9 +58,15 @@ struct type *void_type, *error_type; -void ArraySizes(); -CheckTypeSizes() +/* Local forward declarations */ +static arith ArrayElSize(register struct type *, int); +static void FreeForward(register struct forwtype *); +static int gcd(int, int); + + + +static void CheckTypeSizes(void) { /* first, do some checking */ @@ -75,7 +88,7 @@ CheckTypeSizes() fatal("illegal realsize"); } -InitTypes() +void InitTypes(void) { /* First check the sizes of some basic EM-types */ @@ -144,16 +157,12 @@ InitTypes() emptyset_type->tp_align = word_align; } -int -fit(sz, nbytes) - arith sz; +static int fit(arith sz, int nbytes) { return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0; } -struct type * -standard_type(fund, algn, size) - arith size; +struct type *standard_type(int fund, int algn, arith size) { register struct type *tp = new_type(); @@ -166,9 +175,7 @@ standard_type(fund, algn, size) return tp; } -struct type * -construct_type(fund, tp) - register struct type *tp; +struct type *construct_type(int fund, register struct type *tp) { /* fund must be a type constructor. * The pointer to the constructed type is returned. @@ -212,10 +219,7 @@ construct_type(fund, tp) return dtp; } -struct type * -proc_type(parameters, n_bytes_params) - struct paramlist *parameters; - arith n_bytes_params; +struct type *proc_type(struct paramlist *parameters, arith n_bytes_params) { register struct type *tp = construct_type(T_PROCEDURE, NULLTYPE); @@ -224,11 +228,7 @@ proc_type(parameters, n_bytes_params) return tp; } -struct type * -func_type(parameters, n_bytes_params, resulttype) - struct paramlist *parameters; - arith n_bytes_params; - struct type *resulttype; +struct type *func_type(struct paramlist * parameters, arith n_bytes_params, struct type *resulttype) { register struct type *tp = construct_type(T_FUNCTION, resulttype); @@ -237,9 +237,7 @@ func_type(parameters, n_bytes_params, resulttype) return tp; } -chk_type_id(ptp, nd) - register struct type **ptp; - register struct node *nd; +void chk_type_id(register struct type **ptp, register struct node *nd) { register struct def *df; @@ -266,9 +264,7 @@ chk_type_id(ptp, nd) } } -struct type * -subr_type(lb, ub) - register struct node *lb, *ub; +struct type *subr_type(register struct node *lb, register struct node *ub) { /* Construct a subrange type from the constant expressions indicated by "lb" and "ub", but first perform some checks @@ -322,9 +318,7 @@ subr_type(lb, ub) return res; } -getbounds(tp, plo, phi) - register struct type *tp; - arith *plo, *phi; +void getbounds(register struct type *tp, arith *plo, arith *phi) { /* Get the bounds of a bounded type */ @@ -345,10 +339,7 @@ getbounds(tp, plo, phi) } } -struct type * -set_type(tp, packed) - register struct type *tp; - unsigned short packed; +struct type *set_type(register struct type *tp, unsigned short packed) { /* Construct a set type with base type "tp", but first perform some checks @@ -415,9 +406,7 @@ set_type(tp, packed) return tp; } -arith -ArrayElSize(tp, packed) - register struct type *tp; +static arith ArrayElSize(register struct type *tp, int packed) { /* Align element size to alignment requirement of element type. Also make sure that its size is either a dividor of the word_size, @@ -444,9 +433,7 @@ ArrayElSize(tp, packed) return algn; } -void -ArraySizes(tp) - register struct type *tp; +void ArraySizes(register struct type *tp) { /* Assign sizes to an array type, and check index type */ @@ -492,9 +479,7 @@ ArraySizes(tp) C_rom_cst(tp->arr_elsize); } -void -FreeForward(for_type) - register struct forwtype *for_type; +static void FreeForward(register struct forwtype *for_type) { if( !for_type ) return; @@ -503,7 +488,7 @@ FreeForward(for_type) free_forwtype(for_type); } -chk_forw_types() +void chk_forw_types(void) { /* check all forward references (in pointer types) */ @@ -574,9 +559,8 @@ chk_forw_types() } } -TstCaseConstants(nd, sel, sel1) - register struct node *nd; - register struct selector *sel, *sel1; +void TstCaseConstants(register struct node *nd, register struct selector *sel, + register struct selector *sel1) { /* Insert selector of nested variant (sel1) in tagvalue-table of current selector (sel). @@ -599,19 +583,14 @@ TstCaseConstants(nd, sel, sel1) } } -arith -align(pos, al) - arith pos; - int al; +arith align(arith pos, int al) { arith i; return pos + ((i = pos % al) ? al - i : 0); } -int -gcd(m, n) - register int m, n; +static int gcd(int m, int n) { /* Greatest Common Divisor */ @@ -625,9 +604,7 @@ gcd(m, n) return m; } -int -lcm(m, n) - int m, n; +int lcm(int m, int n) { /* Least Common Multiple */ @@ -635,8 +612,7 @@ lcm(m, n) } #ifdef DEBUG -DumpType(tp) - register struct type *tp; +void DumpType(register struct type *tp) { if( !tp ) return; diff --git a/lang/pc/comp/type.xh b/lang/pc/comp/type.xh index 92e91231b..dfb311750 100644 --- a/lang/pc/comp/type.xh +++ b/lang/pc/comp/type.xh @@ -1,4 +1,8 @@ /* T Y P E D E S C R I P T O R S T R U C T U R E */ +#ifndef TYPE_H_ +#define TYPE_H_ + + struct paramlist { /* structure for parameterlist of a PROCEDURE */ struct paramlist *next; @@ -160,16 +164,6 @@ extern arith real_size; /* All from type.c */ #endif /* NOCROSS */ -extern arith - align(); - -struct type - *construct_type(), - *standard_type(), - *proc_type(), - *func_type(), - *set_type(), - *subr_type(); /* All from type.c */ #define NULLTYPE ((struct type *) 0) @@ -192,3 +186,45 @@ struct type extern long full_mask[]; #define ufit(n, i) (((n) & ~full_mask[(i)]) == 0) + +struct node; + +/* Initialize internal types */ +void InitTypes(void); +/* Construct a standard type with specified size in bytes + and specified alignment. */ +struct type *standard_type(int fund, int algn, arith size); +/* Construct a user defined type. */ +struct type *construct_type(int fund, register struct type *tp); +/* Constructs a new procedure type with the specified parameters. */ +struct type *proc_type(struct paramlist *parameters, arith n_bytes_params); +/* Constructs a new function type with the specified parameters and result type. */ +struct type *func_type(struct paramlist * parameters, arith n_bytes_params, struct type *resulttype); +void chk_type_id(register struct type **ptp, register struct node *nd); +/* Construct a new subrange type from a lower bound "lb" to an upper bound "ub" */ +struct type *subr_type(register struct node *lb, register struct node *ub); +/* Return the bounds of the specified type "tp", assert if this is not a bounded type. */ +void getbounds(register struct type *tp, arith *plo, arith *phi); +/* Construct a new set type. */ +struct type *set_type(register struct type *tp, unsigned short packed); +/* Assign sizes to an array type, and check index type and generate array descriptor */ +void ArraySizes(register struct type *tp); +/* Check all forward declaration */ +void chk_forw_types(void); +/* Insert selector of nested variant (sel1) in tagvalue-table of + current selector (sel). +*/ +void TstCaseConstants(register struct node *nd, register struct selector *sel, + register struct selector *sel1); +/* Return the "pos" aligned to "al". */ +arith align(arith pos, int al); +/* Print type information for "tp". */ +void DumpType(register struct type *tp); +/* Least Common Multiple */ +int lcm(int m, int n); + + + + + +#endif diff --git a/lang/pc/comp/typequiv.c b/lang/pc/comp/typequiv.c index 1b90f39a2..929b16878 100644 --- a/lang/pc/comp/typequiv.c +++ b/lang/pc/comp/typequiv.c @@ -14,20 +14,17 @@ #include "def.h" #include "node.h" #include "type.h" +#include "error.h" +#include "typequiv.h" - -int -TstTypeEquiv(tp1, tp2) - register struct type *tp1, *tp2; +int TstTypeEquiv(register struct type *tp1, register struct type *tp2) { /* test if two types are equivalent. */ return tp1 == tp2 || tp1 == error_type || tp2 == error_type; } -arith -IsString(tp) - register struct type *tp; +arith IsString(register struct type *tp) { /* string = packed array[1..ub] of char and ub > 1 */ if( tp->tp_fund & T_STRINGCONST ) return tp->tp_psize; @@ -45,9 +42,7 @@ IsString(tp) return (arith) 0; } -int -TstStrCompat(tp1, tp2) - register struct type *tp1, *tp2; +int TstStrCompat(register struct type *tp1, register struct type *tp2) { /* test if two types are compatible string-types. */ @@ -62,9 +57,7 @@ TstStrCompat(tp1, tp2) return ub1 == ub2; } -int -TstCompat(tp1, tp2) - register struct type *tp1, *tp2; +int TstCompat(register struct type *tp1,register struct type *tp2) { /* test if two types are compatible. ISO 6.4.5 */ @@ -110,9 +103,7 @@ TstCompat(tp1, tp2) return tp1 == tp2; } -int -TstAssCompat(tp1, tp2) - register struct type *tp1, *tp2; +int TstAssCompat(register struct type *tp1,register struct type *tp2) { /* test if two types are assignment compatible. ISO 6.4.6 */ @@ -128,9 +119,7 @@ TstAssCompat(tp1, tp2) return 0; } -int -TstParEquiv(tp1, tp2) - register struct type *tp1, *tp2; +int TstParEquiv(register struct type *tp1, register struct type *tp2) { /* Test if two parameter types are equivalent. ISO 6.6.3.6 */ @@ -150,18 +139,16 @@ TstParEquiv(tp1, tp2) || ( ( - tp1->tp_fund == T_PROCEDURE && tp2->tp_fund == T_PROCEDURE + (tp1->tp_fund == T_PROCEDURE && tp2->tp_fund == T_PROCEDURE) || - tp1->tp_fund == T_FUNCTION && tp2->tp_fund == T_FUNCTION + (tp1->tp_fund == T_FUNCTION && tp2->tp_fund == T_FUNCTION) ) && TstProcEquiv(tp1, tp2) ); } -int -TstProcEquiv(tp1, tp2) - register struct type *tp1, *tp2; +int TstProcEquiv(register struct type *tp1, register struct type *tp2) { /* Test if two procedure types are equivalent. ISO 6.6.3.6 */ @@ -190,10 +177,8 @@ TstProcEquiv(tp1, tp2) return p1 == p2; } -int -TstParCompat(formaltype, actualtype, VARflag, nd, new_par_section) - register struct type *formaltype, *actualtype; - struct node *nd; +int TstParCompat(register struct type *formaltype, register struct type *actualtype, + int VARflag, struct node *nd, int new_par_section) { /* Check type compatibility for a parameter in a procedure call. */ @@ -231,9 +216,7 @@ TstParCompat(formaltype, actualtype, VARflag, nd, new_par_section) else return 0; } -int -TstConform(formaltype, actualtype, new_par_section) - register struct type *formaltype, *actualtype; +int TstConform(register struct type *formaltype, register struct type * actualtype, int new_par_section) { /* Check conformability. diff --git a/lang/pc/comp/typequiv.h b/lang/pc/comp/typequiv.h new file mode 100644 index 000000000..923551130 --- /dev/null +++ b/lang/pc/comp/typequiv.h @@ -0,0 +1,42 @@ +/* Copyright (c) 2019 ACK Project. + * See the copyright notice in the ACK home directory, + * in the file "Copyright". + * + */ +#ifndef TYPEQUIV_H_ +#define TYPEQUIV_H_ + +#include "em_arith.h" + + +struct type; +struct node; + +/* test if two types are equivalent. */ +int TstTypeEquiv(register struct type *tp1, register struct type *tp2); +arith IsString(register struct type *tp); +/* test if two types are compatible string-types. */ +int TstStrCompat(register struct type *tp1, register struct type *tp2); +/* test if two types are compatible. ISO 6.4.5 */ +int TstCompat(register struct type *tp1,register struct type *tp2); +/* test if two types are assignment compatible. ISO 6.4.6 */ +int TstAssCompat(register struct type *tp1,register struct type *tp2); +/* Test if two parameter types are equivalent. ISO 6.6.3.6 */ +int TstParEquiv(register struct type *tp1, register struct type *tp2); +/* Test if two procedure types are equivalent. ISO 6.6.3.6 */ +int TstProcEquiv(register struct type *tp1, register struct type *tp2); +/* Check type compatibility for a parameter in a procedure call. */ +int TstParCompat(register struct type *formaltype, register struct type *actualtype, + int VARflag, struct node *nd, int new_par_section); +/* Check conformability. + + DEVIATION FROM STANDARD (ISO 6.6.3.7.2): + Allow with value parameters also conformant arrays as actual + type.(ISO only with var. parameters) + + Do as much checking on indextypes as possible. +*/ +int TstConform(register struct type *formaltype, register struct type * actualtype, int new_par_section); + + +#endif /* TYPEQUIV_H_ */ -- 2.34.1