Merge pull request #173 from ccodere/carl-ansi-part1

Carl ansi part1
This commit is contained in:
David Given 2019-02-25 23:23:04 +01:00 committed by GitHub
commit ca3e272233
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
64 changed files with 2547 additions and 1989 deletions

View file

@ -537,7 +537,7 @@ void any2opnd(register struct expr **expp, int oper)
case CHAR: case CHAR:
case SHORT: case SHORT:
case ENUM: case ENUM:
/* case FLOAT: /* not necessary anymore */ /* case FLOAT: *//* not necessary anymore */
any2arith(expp, oper); any2arith(expp, oper);
break; break;
case ARRAY: case ARRAY:

View file

@ -36,6 +36,7 @@ void end_code(void);
struct expr; struct expr;
struct def; struct def;
struct idf; struct idf;
struct decspecs;
label code_string(char* val, int len); label code_string(char* val, int len);
void def_strings(register struct string_cst *sc); void def_strings(register struct string_cst *sc);

View file

@ -610,9 +610,9 @@ static void _error(int class, char *fn, unsigned int ln, char* fmt, va_list ap)
#endif /* LINT */ #endif /* LINT */
if (fn) if (fn)
fprint(stderr, "\"%s\", line %u: ", fn, ln); fprint(ERROUT, "\"%s\", line %u: ", fn, ln);
if (remark) if (remark)
fprint(stderr, "%s ", remark); fprint(ERROUT, "%s ", remark);
doprnt(stderr, fmt, ap); /* contents of error */ doprnt(ERROUT, fmt, ap); /* contents of error */
fprint(stderr, "\n"); fprint(ERROUT, "\n");
} }

View file

@ -455,7 +455,7 @@ void check_and_pad(struct expr **expp, struct type **tpp)
/* next selector is aligned by adding extra zeroes */ /* next selector is aligned by adding extra zeroes */
if (sd->sd_sdef) if (sd->sd_sdef)
zero_bytes(sd); zero_bytes(sd);
while (sd = sd->sd_sdef) { /* pad remaining selectors */ while ( (sd = sd->sd_sdef)!=0) { /* pad remaining selectors */
pad(sd->sd_type); pad(sd->sd_type);
if (sd->sd_sdef) if (sd->sd_sdef)
zero_bytes(sd); zero_bytes(sd);

View file

@ -49,7 +49,7 @@ next_option: /* to allow combined one-char options */
break; break;
case '-': case '-':
options[*text++] = 1; /* flags, debug options etc. */ options[(int)*text++] = 1; /* flags, debug options etc. */
goto next_option; goto next_option;
#ifndef LINT #ifndef LINT
@ -127,7 +127,7 @@ next_option: /* to allow combined one-char options */
register arith sz, algn; register arith sz, algn;
char c; char c;
while (c = *text++) { while ( (c = *text++) !=0) {
sz = txt2int(&text); sz = txt2int(&text);
algn = 0; algn = 0;
if (*text == '.') { if (*text == '.') {

View file

@ -283,7 +283,7 @@ struct sdef *idf2sdef(
} }
/* Tp not met; take an identification. */ /* Tp not met; take an identification. */
if (sdef = idf->id_sdef) { if ( (sdef = idf->id_sdef) ) {
/* There is an identification */ /* There is an identification */
error("illegal use of selector %s", idf->id_text); error("illegal use of selector %s", idf->id_text);
return sdef; return sdef;

View file

@ -273,7 +273,7 @@ void completed(struct type *tp)
case STRUCT: case STRUCT:
case UNION: case UNION:
case ENUM: case ENUM:
while (etp = etp->next) while ( (etp = etp->next) !=0)
{ {
if (!etp->tp_sdef) if (!etp->tp_sdef)
etp->tp_sdef = tp->tp_sdef; etp->tp_sdef = tp->tp_sdef;

View file

@ -19,9 +19,10 @@
#include "input.h" #include "input.h"
#include "main.h" #include "main.h"
#include "type.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) #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 /* Warning: The options specified inside comments take precedence over
* the ones on the command line. * the ones on the command line.
*/ */
CommentOptions() void CommentOptions(void)
{ {
register int ch, ci; register int ch, ci;
int on_on_minus = 0; int on_on_minus = 0;
@ -120,8 +121,7 @@ CommentOptions()
} }
STATIC void static void SkipComment(void)
SkipComment()
{ {
/* Skip ISO-Pascal comments (* ... *) or { ... }. /* Skip ISO-Pascal comments (* ... *) or { ... }.
Note : Note :
@ -153,9 +153,7 @@ SkipComment()
} }
} }
STATIC struct string * static struct string *GetString(register int delim)
GetString( delim )
register int delim;
{ {
/* Read a Pascal string, delimited by the character ' or ". /* Read a Pascal string, delimited by the character ' or ".
*/ */
@ -212,8 +210,7 @@ register int delim;
static char *s_error = "illegal line directive"; static char *s_error = "illegal line directive";
void void CheckForLineDirective(void)
CheckForLineDirective()
{ {
register int ch; register int ch;
register int i = 0; register int i = 0;
@ -276,8 +273,7 @@ CheckForLineDirective()
LineNumber = i; LineNumber = i;
} }
int int LLlex(void)
LLlex()
{ {
/* LLlex() is the Lexical Analyzer. /* LLlex() is the Lexical Analyzer.
The putting aside of tokens is taken into account. The putting aside of tokens is taken into account.
@ -531,10 +527,10 @@ again:
while (*np == '0') /* skip leading zeros */ while (*np == '0') /* skip leading zeros */
np++; np++;
tk->TOK_INT = str2long(np, 10); tk->TOK_INT = str2long(np, 10);
if( tk->TOK_INT < 0 || if( (tk->TOK_INT < 0) ||
strlen(np) > strlen(maxint_str) || (strlen(np) > strlen(maxint_str)) ||
strlen(np) == strlen(maxint_str) && (strlen(np) == strlen(maxint_str) &&
strcmp(np, maxint_str) > 0 ) strcmp(np, maxint_str) > 0) )
lexwarning("overflow in constant"); lexwarning("overflow in constant");
} }
toktype = int_type; toktype = int_type;

View file

@ -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 */ /* 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 /* Structure to store a string constant
*/ */
@ -46,3 +51,8 @@ extern struct type *toktype, *asidetype;
extern int tokenseen; extern int tokenseen;
#define ASIDE aside.tk_symb #define ASIDE aside.tk_symb
void CheckForLineDirective(void);
int LLlex(void);
#endif

View file

@ -14,15 +14,14 @@
#include "LLlex.h" #include "LLlex.h"
#include "Lpars.h" #include "Lpars.h"
#include "idf.h" #include "idf.h"
#include "node.h"
#include "type.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; extern int expect_label;
LLmessage(tk) void LLmessage(register int tk)
register int tk;
{ {
if( tk > 0 ) { if( tk > 0 ) {
/* if( tk > 0 ), it represents the token to be inserted. /* if( tk > 0 ), it represents the token to be inserted.

View file

@ -1,5 +1,5 @@
!File: debugcst.h !File: debugcst.h
/*#define DEBUG 1 /* perform various self-tests */ /*#define DEBUG 1 *//* perform various self-tests */
#define NDEBUG 1 /* disable assertions */ #define NDEBUG 1 /* disable assertions */
@ -55,7 +55,7 @@
!File: nocross.h !File: nocross.h
/*#define NOCROSS 1 /* define when cross compiler not needed */ /*#define NOCROSS 1 *//* define when cross compiler not needed */
!File: dbsymtab.h !File: dbsymtab.h

View file

@ -15,24 +15,29 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "code.h"
#include "chk_expr.h"
#include "tmpvar.h"
#include "typequiv.h"
#include "error.h"
MarkDef(nd, flags, on) void MarkDef(register struct node *nd, unsigned short flags, int on)
register struct node *nd;
unsigned short flags;
{ {
while( nd && nd->nd_class != Def ) { while (nd && nd->nd_class != Def)
if( (nd->nd_class == Arrsel) || {
(nd->nd_class == LinkDef) ) if ((nd->nd_class == Arrsel) || (nd->nd_class == LinkDef))
nd = nd->nd_left; nd = nd->nd_left;
else if (nd->nd_class == Arrow) else if (nd->nd_class == Arrow)
nd = nd->nd_right; nd = nd->nd_right;
else break; else
break;
} }
if( nd && (nd->nd_class == Def) ) { if (nd && (nd->nd_class == Def))
if( (flags & D_SET) && on && {
BlockScope != nd->nd_def->df_scope ) if ((flags & D_SET) && on && BlockScope != nd->nd_def->df_scope)
nd->nd_def->df_flags |= D_SETINHIGH; nd->nd_def->df_flags |= D_SETINHIGH;
if( on ) { if (on)
{
/* /*
if( (flags & D_SET) && if( (flags & D_SET) &&
(nd->nd_def->df_flags & D_WITH) ) (nd->nd_def->df_flags & D_WITH) )
@ -47,22 +52,21 @@ MarkDef(nd, flags, on)
} }
} }
void void AssertStat(register struct node *expp, unsigned short line)
AssertStat(expp, line)
register struct node *expp;
unsigned short line;
{ {
struct desig dsr; struct desig dsr;
if (!ChkExpression(expp)) if (!ChkExpression(expp))
return; return;
if( expp->nd_type != bool_type ) { if (expp->nd_type != bool_type)
{
node_error(expp, "type of assertion should be boolean"); node_error(expp, "type of assertion should be boolean");
return; return;
} }
if( !options['a'] && !err_occurred ) { if (!options['a'] && !err_occurred)
{
dsr = InitDesig; dsr = InitDesig;
CodeExpr(expp, &dsr, NO_LABEL); CodeExpr(expp, &dsr, NO_LABEL);
C_loc((arith) line); C_loc((arith) line);
@ -70,9 +74,7 @@ AssertStat(expp, line)
} }
} }
void void AssignStat(register struct node *left, register struct node *right)
AssignStat(left, right)
register struct node *left, *right;
{ {
register struct type *ltp, *rtp; register struct type *ltp, *rtp;
int retval = 0; int retval = 0;
@ -87,24 +89,28 @@ AssignStat(left, right)
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 = MkNode(IntReduc, NULLNODE, right, &dot);
right->nd_type = int_type; 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 = MkNode(IntCoerc, NULLNODE, right, &dot);
right->nd_type = long_type; right->nd_type = long_type;
} }
if( !TstAssCompat(ltp, rtp) ) { if (!TstAssCompat(ltp, rtp))
{
node_error(left, "type incompatibility in assignment"); node_error(left, "type incompatibility in assignment");
return; return;
} }
if( left->nd_class == Def && if (left->nd_class == Def && (left->nd_def->df_flags & D_INLOOP))
(left->nd_def->df_flags & D_INLOOP) ) { {
node_error(left, "assignment to a control variable"); node_error(left, "assignment to a control variable");
return; return;
} }
@ -112,13 +118,15 @@ AssignStat(left, right)
if (rtp == emptyset_type) if (rtp == emptyset_type)
right->nd_type = ltp; right->nd_type = ltp;
if( !err_occurred ) { if (!err_occurred)
{
dsr = InitDesig; dsr = InitDesig;
CodeExpr(right, &dsr, NO_LABEL); CodeExpr(right, &dsr, NO_LABEL);
if (rtp->tp_fund & (T_ARRAY | T_RECORD)) if (rtp->tp_fund & (T_ARRAY | T_RECORD))
CodeAddress(&dsr); CodeAddress(&dsr);
else { else
{
CodeValue(&dsr, rtp); CodeValue(&dsr, rtp);
if (ltp == real_type && BaseType(rtp) == int_type) if (ltp == real_type && BaseType(rtp) == int_type)
@ -133,21 +141,19 @@ AssignStat(left, right)
FreeNode(right); FreeNode(right);
} }
void void ProcStat(register struct node *nd)
ProcStat(nd)
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"); node_error(nd, "procedure call expected");
return; return;
} }
} }
void void ChkForStat(register struct node *nd)
ChkForStat(nd)
register struct node *nd;
{ {
register struct def *df; register struct def *df;
int retvar = 0; int retvar = 0;
@ -157,27 +163,30 @@ ChkForStat(nd)
MarkUsed(nd->nd_left); MarkUsed(nd->nd_left);
retvar &= ChkExpression(nd->nd_right); retvar &= ChkExpression(nd->nd_right);
MarkUsed(nd->nd_right); MarkUsed(nd->nd_right);
if( !retvar ) return; if (!retvar)
return;
assert(nd->nd_class == Def); assert(nd->nd_class == Def);
df = nd->nd_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"); node_error(nd, "for loop: control variable must be local");
return; return;
} }
assert(df->df_kind == D_VARIABLE); assert(df->df_kind == D_VARIABLE);
if( df->df_scope != GlobalScope && df->var_off >= 0 ) { if (df->df_scope != GlobalScope && df->var_off >= 0)
node_error(nd, {
"for loop: control variable can't be a parameter"); node_error(nd, "for loop: control variable can't be a parameter");
MarkDef(nd, (unsigned short) (D_LOOPVAR | D_SET | D_USED), 1); MarkDef(nd, (unsigned short) (D_LOOPVAR | D_SET | D_USED), 1);
return; 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"); 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; return;
@ -198,34 +207,28 @@ ChkForStat(nd)
node_error(nd, "for loop: control variable already used"); node_error(nd, "for loop: control variable already used");
if (df->df_flags & D_SETINHIGH) if (df->df_flags & D_SETINHIGH)
node_error(nd, node_error(nd, "for loop: control variable already set in block");
"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; return;
} }
void void EndForStat(register struct node *nd)
EndForStat(nd)
register struct node *nd;
{ {
register struct def *df; register struct def *df;
df = nd->nd_def; df = nd->nd_def;
if( (df->df_scope != BlockScope) || if ((df->df_scope != BlockScope)
(df->df_scope != GlobalScope && df->var_off >= 0) || || (df->df_scope != GlobalScope && df->var_off >= 0)
!(df->df_type->tp_fund & T_ORDINAL) || !(df->df_type->tp_fund & T_ORDINAL))
)
return; return;
MarkDef(nd, (unsigned short) (D_INLOOP | D_SET), 0); MarkDef(nd, (unsigned short) (D_INLOOP | D_SET), 0);
} }
arith arith CodeInitFor(register struct node *nd, int priority)
CodeInitFor(nd, priority)
register struct node *nd;
{ {
/* Push final-value, the value may only be evaluated /* 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.
@ -234,7 +237,8 @@ CodeInitFor(nd, priority)
arith tmp; arith tmp;
CodePExpr(nd); CodePExpr(nd);
if( nd->nd_class != Value ) { if (nd->nd_class != Value)
{
tmp = NewInt(priority); tmp = NewInt(priority);
C_dup(int_size); C_dup(int_size);
@ -245,14 +249,13 @@ CodeInitFor(nd, priority)
return (arith) 0; return (arith) 0;
} }
CodeFor(nd, stepsize, l1, l2) void CodeFor(struct node *nd, int stepsize, label l1, label l2)
struct node *nd;
label l1, l2;
{ {
/* Test if loop has to be done */ /* Test if loop has to be done */
if (stepsize == 1) /* TO */ if (stepsize == 1) /* TO */
C_bgt(l2); C_bgt(l2);
else /* DOWNTO */ else
/* DOWNTO */
C_blt(l2); C_blt(l2);
/* Label at begin of the body */ /* Label at begin of the body */
@ -262,10 +265,7 @@ CodeFor(nd, stepsize, l1, l2)
CodeDStore(nd); CodeDStore(nd);
} }
CodeEndFor(nd, stepsize, l1, l2, tmp2) void CodeEndFor(struct node *nd, int stepsize, label l1, label l2, arith tmp2)
struct node *nd;
label l1, l2;
arith tmp2;
{ {
/* Test if loop has to be done once more */ /* Test if loop has to be done once more */
CodePExpr(nd); CodePExpr(nd);
@ -279,7 +279,8 @@ CodeEndFor(nd, stepsize, l1, l2, tmp2)
/* Increment/decrement the control-variable */ /* Increment/decrement the control-variable */
if (stepsize == 1) /* TO */ if (stepsize == 1) /* TO */
C_inc(); C_inc();
else /* DOWNTO */ else
/* DOWNTO */
C_dec(); C_dec();
C_bra(l1); C_bra(l1);
@ -288,15 +289,14 @@ CodeEndFor(nd, stepsize, l1, l2, tmp2)
C_asp(int_size); C_asp(int_size);
} }
void void WithStat(struct node *nd)
WithStat(nd)
struct node *nd;
{ {
struct withdesig *wds; struct withdesig *wds;
struct desig ds; struct desig ds;
struct scopelist *scl; 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"); node_error(nd, "record variable expected");
return; return;
} }
@ -314,7 +314,8 @@ WithStat(nd)
scl->next = CurrVis; scl->next = CurrVis;
CurrVis = scl; CurrVis = scl;
if( err_occurred ) return; if (err_occurred)
return;
/* Generate code */ /* Generate code */
@ -338,16 +339,15 @@ WithStat(nd)
wds->w_desig = ds; wds->w_desig = ds;
} }
EndWith(saved_scl, nd) void EndWith(struct scopelist *saved_scl, struct node *nd)
struct scopelist *saved_scl;
struct node *nd;
{ {
/* restore scope, and release structures */ /* restore scope, and release structures */
struct scopelist *scl; struct scopelist *scl;
struct withdesig *wds; struct withdesig *wds;
struct node *nd1; struct node *nd1;
while( CurrVis != saved_scl ) { while (CurrVis != saved_scl)
{
/* release scopelist */ /* release scopelist */
scl = CurrVis; scl = CurrVis;
@ -366,7 +366,8 @@ EndWith(saved_scl, nd)
free_withdesig(wds); free_withdesig(wds);
} }
for( nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right ) { for (nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right)
{
MarkDef(nd1->nd_left, (unsigned short) (D_WITH), 0); MarkDef(nd1->nd_left, (unsigned short) (D_WITH), 0);
} }

38
lang/pc/comp/body.h Normal file
View file

@ -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_ */

View file

@ -124,9 +124,6 @@ cprogram {
"modules/src/string+lib", "modules/src/string+lib",
"modules/src/system+lib", "modules/src/system+lib",
}, },
vars = {
["+cflags"] = "-DSTATIC=static"
}
} }
installable { installable {

19
lang/pc/comp/casestat.h Normal file
View file

@ -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 <em_label.h>
struct node;
void CaseExpr(struct node *nd);
void CaseEnd(struct node *nd, label exit_label);
#endif /* CASESTAT_H_ */

View file

@ -12,6 +12,10 @@
#include "main.h" #include "main.h"
#include "node.h" #include "node.h"
#include "type.h" #include "type.h"
#include "code.h"
#include "error.h"
#include "typequiv.h"
#include "casestat.h"
struct case_hdr { struct case_hdr {
struct case_hdr *ch_next; /* in the free list */ 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) #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 void
CaseExpr(nd) CaseExpr(struct node *nd)
struct node *nd;
{ {
/* Check the expression and generate code for it /* Check the expression and generate code for it
*/ */
@ -64,9 +73,9 @@ CaseExpr(nd)
} }
void void
CaseEnd(nd, exit_label) CaseEnd(
struct node *nd; struct node *nd,
label exit_label; label exit_label)
{ {
/* Stack a new case header and fill in the necessary fields. /* Stack a new case header and fill in the necessary fields.
*/ */
@ -98,8 +107,7 @@ CaseEnd(nd, exit_label)
FreeNode(nd); FreeNode(nd);
} }
FreeCh(ch) static void FreeCh(register struct case_hdr *ch)
register struct case_hdr *ch;
{ {
/* free the allocated case structure /* free the allocated case structure
*/ */
@ -116,10 +124,10 @@ FreeCh(ch)
free_case_hdr(ch); free_case_hdr(ch);
} }
AddCases(ch, nd, CaseLabel) static int AddCases(
register struct case_hdr *ch; register struct case_hdr *ch,
register struct node *nd; register struct node *nd,
label CaseLabel; label CaseLabel)
{ {
while( nd ) { while( nd ) {
if( !AddOneCase(ch, nd, CaseLabel) ) if( !AddOneCase(ch, nd, CaseLabel) )
@ -129,10 +137,10 @@ AddCases(ch, nd, CaseLabel)
return 1; return 1;
} }
AddOneCase(ch, nd, lbl) static int AddOneCase(
register struct case_hdr *ch; register struct case_hdr *ch,
register struct node *nd; register struct node *nd,
label lbl; label lbl)
{ {
register struct case_entry *ce = new_case_entry(); register struct case_entry *ce = new_case_entry();
register struct case_entry *c1 = ch->ch_entries, *c2 = 0; register struct case_entry *c1 = ch->ch_entries, *c2 = 0;
@ -211,10 +219,10 @@ AddOneCase(ch, nd, lbl)
return 1; return 1;
} }
CaseCode(lbl, ch, exit_label) static void CaseCode(
label lbl; label lbl,
struct case_hdr *ch; struct case_hdr *ch,
label exit_label; label exit_label)
{ {
label CaseDescrLab = ++data_label; /* rom must have a label */ label CaseDescrLab = ++data_label; /* rom must have a label */

File diff suppressed because it is too large Load diff

View file

@ -1,5 +1,7 @@
/* E X P R E S S I O N C H E C K I N G */ /* 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 extern int (*ExprChkTable[])(); /* table of expression checking
functions, indexed by node class 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 ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp))
#define ChkVarAccess(expp) ((*VarAccChkTable[(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);

View file

@ -21,30 +21,44 @@
#include "required.h" #include "required.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "code.h"
#include "tmpvar.h"
#include "typequiv.h"
#include "error.h"
int fp_used; int fp_used;
void Long2Int(); static void CodeUoper(register struct node *);
void Int2Long(); static void CodeBoper(register struct node *, /* the expression tree itself */
void genrck(); label);
void CodeCall(); 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']) if (!options['L'])
C_fil_dlb((label ) 1, (arith) 0); C_fil_dlb((label ) 1, (arith) 0);
} }
routine_label(df) void routine_label(register struct def * df)
register struct def * df;
{ {
df->prc_label = ++data_label; df->prc_label = ++data_label;
C_df_dlb(df->prc_label); C_df_dlb(df->prc_label);
C_rom_scon(df->df_idf->id_text, (arith)(strlen(df->df_idf->id_text) + 1)); C_rom_scon(df->df_idf->id_text, (arith)(strlen(df->df_idf->id_text) + 1));
} }
RomString(nd) void RomString(register struct node *nd)
register struct node *nd;
{ {
C_df_dlb(++data_label); C_df_dlb(++data_label);
@ -57,23 +71,25 @@ RomString(nd)
nd->nd_SLA = data_label; nd->nd_SLA = data_label;
} }
RomReal(nd) void RomReal(register struct node *nd)
register struct node *nd; {
if (!nd->nd_RLA)
{ {
if (! nd->nd_RLA) {
C_df_dlb(++data_label); C_df_dlb(++data_label);
nd->nd_RLA = data_label; nd->nd_RLA = data_label;
C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size); C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
} }
} }
BssVar() void BssVar(void)
{ {
/* generate bss segments for global variables */ /* generate bss segments for global variables */
register struct def *df = GlobalScope->sc_def; register struct def *df = GlobalScope->sc_def;
while( df ) { while (df)
if( df->df_kind == D_VARIABLE ) { {
if (df->df_kind == D_VARIABLE)
{
C_df_dnam(df->var_name); C_df_dnam(df->var_name);
/* ??? undefined value ??? */ /* ??? undefined value ??? */
@ -83,9 +99,7 @@ BssVar()
} }
} }
arith static arith CodeGtoDescr(register struct scope *sc)
CodeGtoDescr(sc)
register struct scope *sc;
{ {
/* Create code for goto descriptors /* Create code for goto descriptors
*/ */
@ -93,9 +107,12 @@ CodeGtoDescr(sc)
register struct node *lb = sc->sc_lablist; register struct node *lb = sc->sc_lablist;
int first = 1; int first = 1;
while( lb ) { while (lb)
if( lb->nd_def->lab_descr ) { {
if( first ) { if (lb->nd_def->lab_descr)
{
if (first)
{
/* create local for target SP */ /* create local for target SP */
sc->sc_off = -WA(pointer_size - sc->sc_off); sc->sc_off = -WA(pointer_size - sc->sc_off);
C_ms_gto(); C_ms_gto();
@ -113,9 +130,7 @@ CodeGtoDescr(sc)
return (arith) 0; return (arith) 0;
} }
arith arith CodeBeginBlock(register struct def *df)
CodeBeginBlock(df)
register struct def *df;
{ {
/* Generate code at the beginning of the main program, /* Generate code at the beginning of the main program,
procedure or function. procedure or function.
@ -126,8 +141,10 @@ CodeBeginBlock(df)
TmpOpen(df->prc_vis->sc_scope); TmpOpen(df->prc_vis->sc_scope);
if ( df->df_kind == D_MODULE) /* nothing */ ; if (df->df_kind == D_MODULE) /* nothing */
else if (df->df_kind == D_PROGRAM ) { ;
else if (df->df_kind == D_PROGRAM)
{
C_exp("_m_a_i_n"); C_exp("_m_a_i_n");
C_pro_narg("_m_a_i_n"); C_pro_narg("_m_a_i_n");
C_ms_par((arith) 0); C_ms_par((arith) 0);
@ -136,13 +153,13 @@ CodeBeginBlock(df)
/* initialize external files */ /* initialize external files */
call_ini(); call_ini();
/* ignore floating point underflow */ /* ignore floating point underflow */C_lim();
C_lim();
C_loc((arith)(1 << EFUNFL)); C_loc((arith)(1 << EFUNFL));
C_ior(int_size); C_ior(int_size);
C_sim(); C_sim();
} }
else if (df->df_kind & (D_PROCEDURE | D_FUNCTION)) { else if (df->df_kind & (D_PROCEDURE | D_FUNCTION))
{
struct type *tp; struct type *tp;
register struct paramlist *param; register struct paramlist *param;
@ -152,7 +169,8 @@ CodeBeginBlock(df)
offset = CodeGtoDescr(df->prc_vis->sc_scope); offset = CodeGtoDescr(df->prc_vis->sc_scope);
CodeFil(); CodeFil();
if( options['t'] ) { if (options['t'])
{
C_lae_dlb(df->prc_label, (arith) 0); C_lae_dlb(df->prc_label, (arith) 0);
C_cal("procentry"); C_cal("procentry");
C_asp(pointer_size); C_asp(pointer_size);
@ -163,15 +181,19 @@ CodeBeginBlock(df)
* with the -R option. The variable, however, is always * with the -R option. The variable, however, is always
* allocated and initialized. * allocated and initialized.
*/ */
if( df->prc_res ) { if (df->prc_res)
{
C_zer((arith) int_size); C_zer((arith) int_size);
C_stl(df->prc_bool); C_stl(df->prc_bool);
} }
for( param = ParamList(df->df_type); param; param = param->next) { for (param = ParamList(df->df_type) ; param; param = param->next)
if( !IsVarParam(param) ) { {
if (!IsVarParam(param))
{
tp = TypeOfParam(param); tp = TypeOfParam(param);
if( IsConformantArray(tp) ) { if (IsConformantArray(tp))
{
/* Here, we have to make a copy of the /* Here, we have to make a copy of the
array. We must also remember how much array. We must also remember how much
room is reserved for copies, because room is reserved for copies, because
@ -179,7 +201,8 @@ CodeBeginBlock(df)
before we return. before we return.
*/ */
if( !StackAdjustment ) { if (!StackAdjustment)
{
/* First time we get here /* First time we get here
*/ */
StackAdjustment = NewInt(0); StackAdjustment = NewInt(0);
@ -217,12 +240,14 @@ CodeBeginBlock(df)
} }
} }
} }
else { else
{
crash("(CodeBeginBlock)"); crash("(CodeBeginBlock)");
/*NOTREACHED*/ /*NOTREACHED*/
} }
if( offset ) { if (offset)
{
/* save SP for non-local jump */ /* save SP for non-local jump */
C_lor((arith) 1); C_lor((arith) 1);
C_stl(offset); C_stl(offset);
@ -230,18 +255,19 @@ CodeBeginBlock(df)
return StackAdjustment; return StackAdjustment;
} }
CodeEndBlock(df, StackAdjustment) void CodeEndBlock(register struct def *df, arith StackAdjustment)
register struct def *df; {
arith StackAdjustment; if (df->df_kind == D_PROGRAM)
{ {
if( df->df_kind == D_PROGRAM) {
C_loc((arith) 0); C_loc((arith) 0);
C_cal("_hlt"); C_cal("_hlt");
} }
else if (df->df_kind & (D_PROCEDURE | D_FUNCTION)) { else if (df->df_kind & (D_PROCEDURE | D_FUNCTION))
{
struct type *tp; struct type *tp;
if( StackAdjustment ) { if (StackAdjustment)
{
/* remove copies of conformant arrays */ /* remove copies of conformant arrays */
C_lol(StackAdjustment); C_lol(StackAdjustment);
C_ass(word_size); C_ass(word_size);
@ -250,13 +276,16 @@ CodeEndBlock(df, StackAdjustment)
if (!options['n']) if (!options['n'])
RegisterMessages(df->prc_vis->sc_scope->sc_def); RegisterMessages(df->prc_vis->sc_scope->sc_def);
if( options['t'] ) { if (options['t'])
{
C_lae_dlb(df->prc_label, (arith) 0); C_lae_dlb(df->prc_label, (arith) 0);
C_cal("procexit"); C_cal("procexit");
C_asp(pointer_size); C_asp(pointer_size);
} }
if( tp = ResultType(df->df_type) ) { if ( (tp = ResultType(df->df_type)) )
if( !options['R'] ) { {
if (!options['R'])
{
C_lin((arith) LineNumber); C_lin((arith) LineNumber);
C_lol(df->prc_bool); C_lol(df->prc_bool);
C_cal("_nfa"); C_cal("_nfa");
@ -266,7 +295,8 @@ CodeEndBlock(df, StackAdjustment)
C_lol(-tp->tp_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); C_ldl(-tp->tp_size);
else { else
{
C_lal(-tp->tp_size); C_lal(-tp->tp_size);
C_loi(tp->tp_size); C_loi(tp->tp_size);
} }
@ -276,7 +306,8 @@ CodeEndBlock(df, StackAdjustment)
else else
C_ret((arith) 0); C_ret((arith) 0);
} }
else { else
{
crash("(CodeEndBlock)"); crash("(CodeEndBlock)");
/*NOTREACHED*/ /*NOTREACHED*/
} }
@ -285,18 +316,19 @@ CodeEndBlock(df, StackAdjustment)
TmpClose(); TmpClose();
} }
CodeExpr(nd, ds, true_label) void CodeExpr(register struct node *nd, register struct desig *ds,
register struct node *nd; label true_label)
register struct desig *ds;
label true_label;
{ {
register struct type *tp = nd->nd_type; 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: case Value:
switch( nd->nd_symb ) { switch (nd->nd_symb)
{
case INTEGER: case INTEGER:
C_loc(nd->nd_INT); C_loc(nd->nd_INT);
break; break;
@ -332,12 +364,14 @@ CodeExpr(nd, ds, true_label)
true_label = NO_LABEL; true_label = NO_LABEL;
break; break;
case Set: { case Set:
{
register arith *st = nd->nd_set; register arith *st = nd->nd_set;
register int i; register int i;
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
if( !st ) { if (!st)
{
C_zer(tp->tp_size); C_zer(tp->tp_size);
break; break;
} }
@ -357,12 +391,14 @@ CodeExpr(nd, ds, true_label)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
break; break;
case NameOrCall: { case NameOrCall:
{
/* actual procedure/function parameter */ /* actual procedure/function parameter */
struct node *left = nd->nd_left; struct node *left = nd->nd_left;
struct def *df = left->nd_def; 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; int level = df->df_scope->sc_level;
if (level <= 0 || (df->df_flags & D_EXTERNAL)) if (level <= 0 || (df->df_flags & D_EXTERNAL))
@ -388,7 +424,8 @@ CodeExpr(nd, ds, true_label)
CodeDesig(nd, ds); CodeDesig(nd, ds);
break; break;
case Cast: { case Cast:
{
/* convert integer to real */ /* convert integer to real */
struct node *right = nd->nd_right; struct node *right = nd->nd_right;
@ -397,7 +434,8 @@ CodeExpr(nd, ds, true_label)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
break; break;
} }
case IntCoerc: { case IntCoerc:
{
/* convert integer to long integer */ /* convert integer to long integer */
struct node *right = nd->nd_right; struct node *right = nd->nd_right;
@ -406,7 +444,8 @@ CodeExpr(nd, ds, true_label)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
break; break;
} }
case IntReduc: { case IntReduc:
{
/* convert a long to an integer */ /* convert a long to an integer */
struct node *right = nd->nd_right; struct node *right = nd->nd_right;
@ -420,7 +459,8 @@ CodeExpr(nd, ds, true_label)
/*NOTREACHED*/ /*NOTREACHED*/
} /* switch class */ } /* switch class */
if( true_label ) { if (true_label)
{
/* Only for boolean expressions /* Only for boolean expressions
*/ */
CodeValue(ds, tp); CodeValue(ds, tp);
@ -428,14 +468,14 @@ CodeExpr(nd, ds, true_label)
} }
} }
CodeUoper(nd) static void CodeUoper(register struct node *nd)
register struct node *nd;
{ {
register struct type *tp = nd->nd_type; register struct type *tp = nd->nd_type;
CodePExpr(nd->nd_right); CodePExpr(nd->nd_right);
switch( nd->nd_symb ) { switch (nd->nd_symb)
{
case '-': case '-':
assert(tp->tp_fund & T_NUMERIC); assert(tp->tp_fund & T_NUMERIC);
if (tp->tp_fund == T_INTEGER || tp->tp_fund == T_LONG) if (tp->tp_fund == T_INTEGER || tp->tp_fund == T_LONG)
@ -457,25 +497,56 @@ CodeUoper(nd)
} }
} }
Operands(leftop, rightop) /* truthvalue() serves as an auxiliary function of CodeBoper */
register struct node *leftop, *rightop; 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*/
}
}
static void Operands(register struct node *leftop, register struct node *rightop)
{ {
CodePExpr(leftop); CodePExpr(leftop);
CodePExpr(rightop); CodePExpr(rightop);
} }
CodeBoper(expr, true_label) static void CodeBoper(register struct node *expr, /* the expression tree itself */
register struct node *expr; /* the expression tree itself */ label true_label) /* label to jump to in logical exprs */
label true_label; /* label to jump to in logical exprs */
{ {
register struct node *leftop = expr->nd_left; register struct node *leftop = expr->nd_left;
register struct node *rightop = expr->nd_right; register struct node *rightop = expr->nd_right;
register struct type *tp = expr->nd_type; register struct type *tp = expr->nd_type;
switch( expr->nd_symb ) { switch (expr->nd_symb)
{
case '+': case '+':
Operands(leftop, rightop); Operands(leftop, rightop);
switch( tp->tp_fund ) { switch (tp->tp_fund)
{
case T_INTEGER: case T_INTEGER:
case T_LONG: case T_LONG:
C_adi(tp->tp_size); C_adi(tp->tp_size);
@ -493,7 +564,8 @@ CodeBoper(expr, true_label)
case '-': case '-':
Operands(leftop, rightop); Operands(leftop, rightop);
switch( tp->tp_fund ) { switch (tp->tp_fund)
{
case T_INTEGER: case T_INTEGER:
case T_LONG: case T_LONG:
C_sbi(tp->tp_size); C_sbi(tp->tp_size);
@ -512,7 +584,8 @@ CodeBoper(expr, true_label)
case '*': case '*':
Operands(leftop, rightop); Operands(leftop, rightop);
switch( tp->tp_fund ) { switch (tp->tp_fund)
{
case T_INTEGER: case T_INTEGER:
case T_LONG: case T_LONG:
C_mli(tp->tp_size); C_mli(tp->tp_size);
@ -539,12 +612,14 @@ CodeBoper(expr, true_label)
case DIV: case DIV:
case MOD: case MOD:
Operands(leftop, rightop); Operands(leftop, rightop);
if( tp->tp_fund == T_INTEGER ) { if (tp->tp_fund == T_INTEGER)
{
C_cal(expr->nd_symb == MOD ? "_mdi" : "_dvi"); C_cal(expr->nd_symb == MOD ? "_mdi" : "_dvi");
C_asp(2 * tp->tp_size); C_asp(2 * tp->tp_size);
C_lfr(tp->tp_size); C_lfr(tp->tp_size);
} }
else if( tp->tp_fund == T_LONG) { else if (tp->tp_fund == T_LONG)
{
C_cal(expr->nd_symb == MOD ? "_mdil" : "_dvil"); C_cal(expr->nd_symb == MOD ? "_mdil" : "_dvil");
C_asp(2 * tp->tp_size); C_asp(2 * tp->tp_size);
C_lfr(tp->tp_size); C_lfr(tp->tp_size);
@ -563,7 +638,8 @@ CodeBoper(expr, true_label)
CodePExpr(rightop); CodePExpr(rightop);
tp = BaseType(rightop->nd_type); tp = BaseType(rightop->nd_type);
switch( tp->tp_fund ) { switch (tp->tp_fund)
{
case T_INTEGER: case T_INTEGER:
case T_LONG: case T_LONG:
C_cmi(tp->tp_size); C_cmi(tp->tp_size);
@ -580,7 +656,8 @@ CodeBoper(expr, true_label)
break; break;
case T_SET: case T_SET:
if( expr->nd_symb == GREATEREQUAL ) { if (expr->nd_symb == GREATEREQUAL)
{
/* A >= B is the same as A equals A + B /* A >= B is the same as A equals A + B
*/ */
C_dup(2 * tp->tp_size); C_dup(2 * tp->tp_size);
@ -588,7 +665,8 @@ CodeBoper(expr, true_label)
C_ior(tp->tp_size); C_ior(tp->tp_size);
expr->nd_symb = '='; expr->nd_symb = '=';
} }
else if( expr->nd_symb == LESSEQUAL ) { else if (expr->nd_symb == LESSEQUAL)
{
/* A <= B is the same as A - B = [] /* A <= B is the same as A - B = []
*/ */
C_com(tp->tp_size); C_com(tp->tp_size);
@ -645,47 +723,19 @@ CodeBoper(expr, true_label)
C_zeq(true_label); C_zeq(true_label);
break; break;
default: default:
crash("(CodeBoper Bad operator %s\n)", crash("(CodeBoper Bad operator %s\n)", symbol2str(expr->nd_symb));
symbol2str(expr->nd_symb));
} }
} }
/* truthvalue() serves as an auxiliary function of CodeBoper */
truthvalue(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*/
}
}
CodeSet(nd) static void CodeSet(register struct node *nd)
register struct node *nd;
{ {
register struct type *tp = nd->nd_type; register struct type *tp = nd->nd_type;
C_zer(tp->tp_size); C_zer(tp->tp_size);
nd = nd->nd_right; nd = nd->nd_right;
while( nd ) { while (nd)
{
assert(nd->nd_class == Link && nd->nd_symb == ','); assert(nd->nd_class == Link && nd->nd_symb == ',');
CodeEl(nd->nd_left, tp); CodeEl(nd->nd_left, tp);
@ -693,27 +743,24 @@ CodeSet(nd)
} }
} }
CodeEl(nd, tp) static void CodeEl(register struct node *nd, register struct type *tp)
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); Operands(nd->nd_left, nd->nd_right);
C_loc(tp->tp_size); /* push size */ C_loc(tp->tp_size); /* push size */
C_cal("_bts"); /* library routine to fill set */ C_cal("_bts"); /* library routine to fill set */
C_asp(3 * word_size); C_asp(3 * word_size);
} }
else { else
{
CodePExpr(nd); CodePExpr(nd);
C_set(tp->tp_size); C_set(tp->tp_size);
C_ior(tp->tp_size); C_ior(tp->tp_size);
} }
} }
struct type * static struct type * CodeParameters(struct paramlist *param, struct node *arg)
CodeParameters(param, arg)
struct paramlist *param;
struct node *arg;
{ {
register struct type *tp, *left_tp, *last_tp = (struct type *) 0; register struct type *tp, *left_tp, *last_tp = (struct type *) 0;
struct node *left; struct node *left;
@ -728,7 +775,8 @@ CodeParameters(param, arg)
left = arg->nd_left; left = arg->nd_left;
left_tp = left->nd_type; left_tp = left->nd_type;
if( IsConformantArray(tp) ) { if (IsConformantArray(tp))
{
if (last_tp != tp) if (last_tp != tp)
/* push descriptors only once */ /* push descriptors only once */
CodeConfDescr(tp, left_tp); CodeConfDescr(tp, left_tp);
@ -736,11 +784,13 @@ CodeParameters(param, arg)
CodeDAddress(left); CodeDAddress(left);
return tp; return tp;
} }
if( IsVarParam(param) ) { if (IsVarParam(param))
{
CodeDAddress(left); CodeDAddress(left);
return tp; return tp;
} }
if( left_tp->tp_fund == T_STRINGCONST ) { if (left_tp->tp_fund == T_STRINGCONST)
{
CodePString(left, tp); CodePString(left, tp);
return tp; return tp;
} }
@ -756,21 +806,23 @@ CodeParameters(param, arg)
return tp; return tp;
} }
CodeConfDescr(ftp, atp) static void CodeConfDescr(register struct type *ftp, register struct type *atp)
register struct type *ftp, *atp;
{ {
struct type *elemtp = ftp->arr_elem; struct type *elemtp = ftp->arr_elem;
if (IsConformantArray(elemtp)) if (IsConformantArray(elemtp))
CodeConfDescr(elemtp, atp->arr_elem); CodeConfDescr(elemtp, atp->arr_elem);
if( atp->tp_fund == T_STRINGCONST ) { if (atp->tp_fund == T_STRINGCONST)
{
C_loc((arith) 1); C_loc((arith) 1);
C_loc(atp->tp_psize - 1); C_loc(atp->tp_psize - 1);
C_loc((arith) 1); C_loc((arith) 1);
} }
else if( IsConformantArray(atp) ) { else if (IsConformantArray(atp))
if( atp->arr_sclevel < proclevel ) { {
if (atp->arr_sclevel < proclevel)
{
C_lxa((arith) proclevel - atp->arr_sclevel); C_lxa((arith) proclevel - atp->arr_sclevel);
C_adp(atp->arr_cfdescr); C_adp(atp->arr_cfdescr);
} }
@ -779,7 +831,8 @@ CodeConfDescr(ftp, atp)
C_loi(3 * word_size); C_loi(3 * word_size);
} }
else { /* normal array */ else
{ /* normal array */
assert(atp->tp_fund == T_ARRAY); assert(atp->tp_fund == T_ARRAY);
assert(!IsConformantArray(atp)); assert(!IsConformantArray(atp));
C_lae_dlb(atp->arr_ardescr, (arith) 0); C_lae_dlb(atp->arr_ardescr, (arith) 0);
@ -787,18 +840,14 @@ CodeConfDescr(ftp, atp)
} }
} }
CodePString(nd, tp) static void CodePString(struct node *nd, struct type *tp)
struct node *nd;
struct type *tp;
{ {
/* no null padding */ /* no null padding */
C_lae_dlb(nd->nd_SLA, (arith) 0); C_lae_dlb(nd->nd_SLA, (arith) 0);
C_loi(tp->tp_size); C_loi(tp->tp_size);
} }
void void CodeCall(register struct node *nd)
CodeCall(nd)
register struct node *nd;
{ {
/* Generate code for a procedure call. Checking of parameters /* Generate code for a procedure call. Checking of parameters
and result is already done. and result is already done.
@ -810,7 +859,8 @@ CodeCall(nd)
assert(IsProcCall(left)); assert(IsProcCall(left));
if( left->nd_type == std_type ) { if (left->nd_type == std_type)
{
CodeStd(nd); CodeStd(nd);
return; return;
} }
@ -820,8 +870,8 @@ CodeCall(nd)
assert(left->nd_class == Def); assert(left->nd_class == Def);
if (df->df_kind & D_ROUTINE)
if( df->df_kind & D_ROUTINE ) { {
int level = df->df_scope->sc_level; int level = df->df_scope->sc_level;
if (level > 0 && !(df->df_flags & D_EXTERNAL)) if (level > 0 && !(df->df_flags & D_EXTERNAL))
@ -829,7 +879,8 @@ CodeCall(nd)
C_cal(df->prc_name); C_cal(df->prc_name);
C_asp(left->nd_type->prc_nbpar); C_asp(left->nd_type->prc_nbpar);
} }
else { else
{
label l1 = ++text_label; label l1 = ++text_label;
label l2 = ++text_label; label l2 = ++text_label;
@ -847,8 +898,7 @@ CodeCall(nd)
C_zeq(l1); 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); C_exg(pointer_size);
/* Now, the name of the procedure/function */ /* Now, the name of the procedure/function */C_cai();
C_cai();
C_asp(pointer_size + left->nd_type->prc_nbpar); C_asp(pointer_size + left->nd_type->prc_nbpar);
C_bra(l2); C_bra(l2);
@ -860,12 +910,11 @@ CodeCall(nd)
C_df_ilb(l2); C_df_ilb(l2);
} }
if( result_tp = ResultType(left->nd_type) ) if ( (result_tp = ResultType(left->nd_type)) )
C_lfr(result_tp->tp_size); C_lfr(result_tp->tp_size);
} }
CodeStd(nd) static void CodeStd(struct node *nd)
struct node *nd;
{ {
register struct node *arg = nd->nd_right; register struct node *arg = nd->nd_right;
register struct node *left = arg->nd_left; register struct node *left = arg->nd_left;
@ -874,7 +923,8 @@ CodeStd(nd)
assert(arg->nd_class == Link && arg->nd_symb == ','); assert(arg->nd_class == Link && arg->nd_symb == ',');
switch( req ) { switch (req)
{
case R_ABS: case R_ABS:
CodePExpr(left); CodePExpr(left);
if (tp == int_type) if (tp == int_type)
@ -904,7 +954,8 @@ CodeStd(nd)
case R_ARCTAN: case R_ARCTAN:
assert(tp == real_type); assert(tp == real_type);
CodePExpr(left); CodePExpr(left);
switch( req ) { switch (req)
{
case R_SIN: case R_SIN:
C_cal("_sin"); C_cal("_sin");
break; break;
@ -959,7 +1010,8 @@ CodeStd(nd)
case R_PRED: case R_PRED:
CodePExpr(left); CodePExpr(left);
C_loc((arith) 1); C_loc((arith) 1);
if( tp == long_type) Int2Long(); if (tp == long_type)
Int2Long();
if (req == R_SUCC) if (req == R_SUCC)
C_adi(tp->tp_size); C_adi(tp->tp_size);
@ -973,9 +1025,11 @@ CodeStd(nd)
case R_ODD: case R_ODD:
CodePExpr(left); CodePExpr(left);
C_loc((arith) 1); C_loc((arith) 1);
if( tp == long_type ) Int2Long(); if (tp == long_type)
Int2Long();
C_and(tp->tp_size); C_and(tp->tp_size);
if( tp == long_type ) Long2Int(); /* bool_size == int_size */ if (tp == long_type)
Long2Int(); /* bool_size == int_size */
break; break;
case R_EOF: case R_EOF:
@ -1020,10 +1074,10 @@ CodeStd(nd)
C_asp(pointer_size); C_asp(pointer_size);
break; break;
case R_PACK: { case R_PACK:
{
label lba = tp->arr_ardescr; label lba = tp->arr_ardescr;
CodeDAddress(left); CodeDAddress(left);
arg = arg->nd_right; arg = arg->nd_right;
left = arg->nd_left; left = arg->nd_left;
@ -1038,18 +1092,20 @@ CodeStd(nd)
break; break;
} }
case R_UNPACK: { case R_UNPACK:
{
/* change sequence of arguments of the library routine /* change sequence of arguments of the library routine
_unp to merge code of R_PACK and R_UNPACK. _unp to merge code of R_PACK and R_UNPACK.
*/ */
label lba, lbz = tp->arr_ardescr; label lba, lbz = tp->arr_ardescr;
tp = tp->arr_elem; tp = tp->arr_elem;
if (tp->tp_fund == T_SUBRANGE && if (tp->tp_fund == T_SUBRANGE && tp->sub_lb >= 0)
tp->sub_lb >= 0) { {
C_loc((arith) 1); C_loc((arith) 1);
} }
else C_loc((arith) 0); else
C_loc((arith) 0);
CodeDAddress(left); CodeDAddress(left);
arg = arg->nd_right; arg = arg->nd_right;
left = arg->nd_left; left = arg->nd_left;
@ -1091,31 +1147,31 @@ CodeStd(nd)
} }
} }
void void Long2Int(void)
Long2Int()
{ {
/* convert a long to integer */ /* convert a long to integer */
if (int_size == long_size) return; if (int_size == long_size)
return;
C_loc(long_size); C_loc(long_size);
C_loc(int_size); C_loc(int_size);
C_cii(); C_cii();
} }
void void Int2Long(void)
Int2Long()
{ {
/* convert integer to long */ /* convert integer to long */
if (int_size == long_size) return; if (int_size == long_size)
return;
C_loc(int_size); C_loc(int_size);
C_loc(long_size); C_loc(long_size);
C_cii(); C_cii();
} }
Int2Real(size) /* size is different for integers and longs */ void Int2Real(arith size)
arith size; /* size is different for integers and longs */
{ {
/* convert integer to real */ /* convert integer to real */
C_loc(size); C_loc(size);
@ -1123,7 +1179,7 @@ arith size;
C_cif(); C_cif();
} }
Real2Int() void Real2Int(void)
{ {
/* convert real to integer */ /* convert real to integer */
C_loc(real_size); C_loc(real_size);
@ -1131,20 +1187,21 @@ Real2Int()
C_cfi(); C_cfi();
} }
RangeCheck(tpl, tpr) void RangeCheck(register struct type *tpl, register struct type *tpr)
register struct type *tpl, *tpr;
{ {
/* Generate a range check if neccessary /* Generate a range check if neccessary
*/ */
arith llo, lhi, rlo, rhi; arith llo, lhi, rlo, rhi;
if( bounded(tpl) ) { if (bounded(tpl))
{
/* in this case we might need a range check */ /* in this case we might need a range check */
if (!bounded(tpr)) if (!bounded(tpr))
/* yes, we need one */ /* yes, we need one */
genrck(tpl); genrck(tpl);
else { else
{
/* both types are restricted. check the bounds to see /* both types are restricted. check the bounds to see
whether we need a range check. We don't need one whether we need a range check. We don't need one
if the range of values of the right hand side is a if the range of values of the right hand side is a
@ -1158,9 +1215,7 @@ RangeCheck(tpl, tpr)
} }
} }
void static void genrck(register struct type *tp)
genrck(tp)
register struct type *tp;
{ {
/* Generate a range check descriptor for type "tp" when /* Generate a range check descriptor for type "tp" when
necessary. Return its label. necessary. Return its label.
@ -1170,21 +1225,26 @@ genrck(tp)
register label o1; register label o1;
int newlabel = 0; int newlabel = 0;
if( options['R'] ) return; if (options['R'])
return;
getbounds(tp, &lb, &ub); getbounds(tp, &lb, &ub);
if( tp->tp_fund == T_SUBRANGE ) { if (tp->tp_fund == T_SUBRANGE)
if( !(o1 = tp->sub_rck) ) { {
if (!(o1 = tp->sub_rck))
{
tp->sub_rck = o1 = ++data_label; tp->sub_rck = o1 = ++data_label;
newlabel = 1; newlabel = 1;
} }
} }
else if( !(o1 = tp->enm_rck) ) { else if (!(o1 = tp->enm_rck))
{
tp->enm_rck = o1 = ++data_label; tp->enm_rck = o1 = ++data_label;
newlabel = 1; newlabel = 1;
} }
if( newlabel ) { if (newlabel)
{
C_df_dlb(o1); C_df_dlb(o1);
C_rom_cst(lb); C_rom_cst(lb);
C_rom_cst(ub); C_rom_cst(ub);
@ -1193,8 +1253,7 @@ genrck(tp)
C_rck(word_size); C_rck(word_size);
} }
CodePExpr(nd) void CodePExpr(register struct node *nd)
register struct node *nd;
{ {
/* Generate code to push the value of the expression "nd" /* Generate code to push the value of the expression "nd"
on the stack. on the stack.
@ -1211,8 +1270,7 @@ CodePExpr(nd)
CodeValue(&designator, nd->nd_type); CodeValue(&designator, nd->nd_type);
} }
CodeDAddress(nd) void CodeDAddress(struct node *nd)
struct node *nd;
{ {
/* Generate code to push the address of the designator "nd" /* Generate code to push the address of the designator "nd"
on the stack. on the stack.
@ -1225,8 +1283,7 @@ CodeDAddress(nd)
CodeAddress(&designator); CodeAddress(&designator);
} }
CodeDStore(nd) void CodeDStore(register struct node *nd)
register struct node *nd;
{ {
/* Generate code to store the expression on the stack /* Generate code to store the expression on the stack
into the designator "nd". into the designator "nd".
@ -1239,19 +1296,19 @@ CodeDStore(nd)
CodeStore(&designator, nd->nd_type); CodeStore(&designator, nd->nd_type);
} }
RegisterMessages(df) static void RegisterMessages(register struct def *df)
register struct def *df;
{ {
register struct type *tp; register struct type *tp;
for( ; df; df = df->df_nextinscope ) { for (; df; df = df->df_nextinscope)
if( df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG) ) { {
if (df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG))
{
/* Examine type and size /* Examine type and size
*/ */
tp = BaseType(df->df_type); tp = BaseType(df->df_type);
if (df->df_flags & D_VARPAR || tp->tp_fund & T_POINTER) if (df->df_flags & D_VARPAR || tp->tp_fund & T_POINTER)
C_ms_reg(df->var_off, pointer_size, C_ms_reg(df->var_off, pointer_size, reg_pointer, 0);
reg_pointer, 0);
else if (df->df_flags & D_LOOPVAR) else if (df->df_flags & D_LOOPVAR)
C_ms_reg(df->var_off, tp->tp_size, reg_loop, 2); C_ms_reg(df->var_off, tp->tp_size, reg_loop, 2);

56
lang/pc/comp/code.h Normal file
View file

@ -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_ */

View file

@ -17,6 +17,8 @@
#include "node.h" #include "node.h"
#include "required.h" #include "required.h"
#include "type.h" #include "type.h"
#include "cstoper.h"
#include "error.h"
long mach_long_sign; /* sign bit of the machine long */ long mach_long_sign; /* sign bit of the machine long */
long full_mask[MAXSIZE+1];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */ 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 wrd_bits; /* number of bits in a word */
arith max_intset; /* largest value of set of integer */ arith max_intset; /* largest value of set of integer */
overflow(expp) void CutSize(register struct node *expr);
struct node *expp;
void overflow(struct node *expp)
{ {
node_warning(expp, "overflow in constant expression"); node_warning(expp, "overflow in constant expression");
} }
cstunary(expp) void cstunary(register struct node *expp)
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; register arith o1 = expp->nd_right->nd_INT;
switch( expp->nd_symb ) { switch( expp->nd_symb ) {
@ -67,9 +66,7 @@ cstunary(expp)
expp->nd_right = NULLNODE; expp->nd_right = NULLNODE;
} }
void void cstbin(register struct node *expp)
cstbin(expp)
register struct node *expp;
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp. expressions below it, and the result restored in expp.
@ -197,9 +194,7 @@ cstbin(expp)
expp->nd_left = expp->nd_right = NULLNODE; expp->nd_left = expp->nd_right = NULLNODE;
} }
void void cstset(register struct node *expp)
cstset(expp)
register struct node *expp;
{ {
register arith *set1, *set2; register arith *set1, *set2;
arith *resultset = (arith *) 0; arith *resultset = (arith *) 0;
@ -353,8 +348,7 @@ cstset(expp)
expp->nd_left = expp->nd_right = NULLNODE; expp->nd_left = expp->nd_right = NULLNODE;
} }
cstcall(expp, req) void cstcall(register struct node *expp, int req)
register struct node *expp;
{ {
/* a standard procedure call is found that can be evaluated /* a standard procedure call is found that can be evaluated
compile time, so do so. compile time, so do so.
@ -441,8 +435,7 @@ cstcall(expp, req)
expp->nd_right = expp->nd_left = NULLNODE; expp->nd_right = expp->nd_left = NULLNODE;
} }
CutSize(expr) void CutSize(register struct node *expr)
register struct node *expr;
{ {
/* The constant value of the expression expr is made to conform /* The constant value of the expression expr is made to conform
* to the size of the type of the expression * to the size of the type of the expression
@ -460,8 +453,8 @@ CutSize(expr)
o1 &= 0177; o1 &= 0177;
} }
} }
else if( remainder != 0 && remainder != ~full_mask[size] || else if( (remainder != 0 && remainder != ~full_mask[size]) ||
(o1 & full_mask[size]) == 1 << (size * 8 - 1) ) { ((o1 & full_mask[size]) == 1 << (size * 8 - 1)) ) {
/* integers in [-maxint .. maxint] */ /* integers in [-maxint .. maxint] */
int nbits = (int) (sizeof(long) - size) * 8; int nbits = (int) (sizeof(long) - size) * 8;
@ -474,9 +467,8 @@ CutSize(expr)
expr->nd_INT = o1; expr->nd_INT = o1;
} }
InitCst() void InitCst(void)
{ {
extern char *Salloc();
register int i = 0; register int i = 0;
register arith bt = (arith)0; register arith bt = (arith)0;

36
lang/pc/comp/cstoper.h Normal file
View file

@ -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_ */

View file

@ -21,6 +21,14 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.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)) #define PC_BUFSIZ (sizeof(struct file) - offsetof(struct file, bufadr))
@ -177,7 +185,7 @@ ConstantDefinition
} : } :
IDENT { id = dot.TOK_IDF; } IDENT { id = dot.TOK_IDF; }
'=' Constant(&nd) '=' Constant(&nd)
{ if( df = define(id,CurrentScope,D_CONST) ) { { if (( df = define(id,CurrentScope,D_CONST))) {
df->con_const = nd; df->con_const = nd;
df->df_type = nd->nd_type; df->df_type = nd->nd_type;
df->df_flags |= D_SET; df->df_flags |= D_SET;
@ -197,7 +205,7 @@ TypeDefinition
} : } :
IDENT { id = dot.TOK_IDF; } IDENT { id = dot.TOK_IDF; }
'=' TypeDenoter(&tp) '=' TypeDenoter(&tp)
{ if( df = define(id, CurrentScope, D_TYPE) ) { { if ((df = define(id, CurrentScope, D_TYPE)) ) {
df->df_type = tp; df->df_type = tp;
df->df_flags |= D_SET; df->df_flags |= D_SET;
#ifdef DBSYMTAB #ifdef DBSYMTAB
@ -371,7 +379,7 @@ FunctionDeclaration
else DoDirective(dot.TOK_IDF, nd, tp, scl, 1); else DoDirective(dot.TOK_IDF, nd, tp, scl, 1);
} }
| |
{ if( df = DeclFunc(nd, tp, scl) ) { { if ((df = DeclFunc(nd, tp, scl) )) {
df->prc_res = df->prc_res =
- ResultType(df->df_type)->tp_size; - ResultType(df->df_type)->tp_size;
df->prc_bool = df->prc_bool =
@ -705,7 +713,7 @@ VariantPart(struct scope *scope; arith *cnt; int *palign;
{ max = tcnt; } { max = tcnt; }
VariantTail(scope, &tcnt, &max, cnt, palign, packed, *sel) VariantTail(scope, &tcnt, &max, cnt, palign, packed, *sel)
{ *cnt = max; { *cnt = max;
if( sp = (*sel)->sel_ptrs ) { if ( (sp = (*sel)->sel_ptrs) ) {
int errflag = 0; int errflag = 0;
ncst = (*sel)->sel_ncst; ncst = (*sel)->sel_ncst;
@ -987,16 +995,16 @@ Index_TypeSpecification(register struct type **ptp; register struct type *tp;)
register struct def *df1, *df2; register struct def *df1, *df2;
} : } :
IDENT IDENT
{ if( df1 = { if( (df1 =
define(dot.TOK_IDF, CurrentScope, D_LBOUND)) { define(dot.TOK_IDF, CurrentScope, D_LBOUND)) ) {
df1->bnd_type = tp; /* type conf. array */ df1->bnd_type = tp; /* type conf. array */
df1->df_flags |= D_SET; df1->df_flags |= D_SET;
} }
} }
UPTO UPTO
IDENT IDENT
{ if( df2 = { if( (df2 =
define(dot.TOK_IDF, CurrentScope, D_UBOUND)) { define(dot.TOK_IDF, CurrentScope, D_UBOUND)) ) {
df2->bnd_type = tp; /* type conf. array */ df2->bnd_type = tp; /* type conf. array */
df2->df_flags |= D_SET; df2->df_flags |= D_SET;
} }

View file

@ -15,13 +15,13 @@
#include "misc.h" #include "misc.h"
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "code.h"
#include "type.h" #include "type.h"
#include "lookup.h"
#include "error.h"
struct def * struct def *MkDef(register struct idf *id, register struct scope *scope,
MkDef(id, scope, kind) long kind)
register struct idf *id;
register struct scope *scope;
long kind;
{ {
/* Create a new definition structure in scope "scope", with /* Create a new definition structure in scope "scope", with
* id "id" and kind "kind". * id "id" and kind "kind".
@ -42,11 +42,8 @@ MkDef(id, scope, kind)
return df; return df;
} }
struct def * struct def *define(register struct idf *id, register struct scope *scope,
define(id, scope, kind) long kind)
register struct idf *id;
register struct scope *scope;
long kind;
{ {
/* Declare an identifier in a scope, but first check if it /* Declare an identifier in a scope, but first check if it
already has been defined. already has been defined.
@ -55,21 +52,25 @@ define(id, scope, kind)
*/ */
register struct def *df; register struct def *df;
if( df = lookup(id, scope, 0L) ) { if ( (df = lookup(id, scope, 0L)) )
if (df->df_kind == D_INUSE) { {
if( kind != D_INUSE ) { if (df->df_kind == D_INUSE)
error("\"%s\" already used in this block", {
id->id_text); if (kind != D_INUSE)
{
error("\"%s\" already used in this block", id->id_text);
} }
return MkDef(id, scope, kind); return MkDef(id, scope, kind);
} }
if (df->df_kind == D_ERROR ) { if (df->df_kind == D_ERROR)
{
/* used in forward references */ /* used in forward references */
df->df_kind = kind; df->df_kind = kind;
return df; return df;
} }
/* other cases fit in an int (assume at least 2 bytes) */ /* 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 */ /* generate error message somewhere else */
@ -82,27 +83,28 @@ define(id, scope, kind)
break; break;
case D_FORWTYPE: case D_FORWTYPE:
if( kind == D_FORWTYPE ) return df; if (kind == D_FORWTYPE)
if( kind == D_TYPE ) { return df;
if (kind == D_TYPE)
{
/* forward reference resolved */ /* forward reference resolved */
df->df_kind = D_FTYPE; df->df_kind = D_FTYPE;
return df; return df;
} }
else else
error("identifier \"%s\" must be a type", error("identifier \"%s\" must be a type", id->id_text);
id->id_text);
return NULLDEF; return NULLDEF;
case D_FWPROCEDURE: case D_FWPROCEDURE:
if( kind == D_PROCEDURE ) return df; if (kind == D_PROCEDURE)
error("procedure identification \"%s\" expected", return df;
id->id_text); error("procedure identification \"%s\" expected", id->id_text);
return NULLDEF; return NULLDEF;
case D_FWFUNCTION: case D_FWFUNCTION:
if( kind == D_FUNCTION ) return df; if (kind == D_FUNCTION)
error("function identification \"%s\" expected", return df;
id->id_text); error("function identification \"%s\" expected", id->id_text);
return NULLDEF; return NULLDEF;
} }
@ -116,42 +118,42 @@ define(id, scope, kind)
return MkDef(id, scope, kind); return MkDef(id, scope, kind);
} }
void void DoDirective(struct idf *directive, struct node *nd, struct type *tp,
DoDirective(directive, nd, tp, scl, function) struct scopelist *scl, int function)
struct idf *directive;
struct node *nd;
struct type *tp;
struct scopelist *scl;
{ {
long kind; /* kind of directive */ long kind; /* kind of directive */
int inp; /* internal or external name */ int inp; /* internal or external name */
int ext = 0; /* directive = EXTERN */ int ext = 0; /* directive = EXTERN */
struct def *df = lookup(directive, PervasiveScope, D_INUSE); struct def *df = lookup(directive, PervasiveScope, D_INUSE);
if( !df ) { if (!df)
{
if (!is_anon_idf(directive)) if (!is_anon_idf(directive))
node_error(nd, "\"%s\" unknown directive", node_error(nd, "\"%s\" unknown directive", directive->id_text);
directive->id_text);
return; return;
} }
if (df->df_kind == D_FORWARD) { if (df->df_kind == D_FORWARD)
{
kind = function ? D_FWFUNCTION : D_FWPROCEDURE; kind = function ? D_FWFUNCTION : D_FWPROCEDURE;
inp = (proclevel > 1); inp = (proclevel > 1);
} }
else if (df->df_kind == D_EXTERN) { else if (df->df_kind == D_EXTERN)
{
kind = function ? D_FUNCTION : D_PROCEDURE; kind = function ? D_FUNCTION : D_PROCEDURE;
inp = 0; inp = 0;
ext = 1; ext = 1;
} }
else { else
node_error(nd, "\"%s\" unknown directive", {
directive->id_text); node_error(nd, "\"%s\" unknown directive", directive->id_text);
return; return;
} }
if( df = define(nd->nd_IDF, CurrentScope, kind) ) { if ( (df = define(nd->nd_IDF, CurrentScope, kind)) )
if( df->df_kind != kind ) { {
if (df->df_kind != kind)
{
/* identifier already forward declared */ /* identifier already forward declared */
node_error(nd, "\"%s\" already forward declared", node_error(nd, "\"%s\" already forward declared",
nd->nd_IDF->id_text); nd->nd_IDF->id_text);
@ -161,7 +163,8 @@ DoDirective(directive, nd, tp, scl, function)
df->df_type = tp; df->df_type = tp;
df->prc_vis = scl; df->prc_vis = scl;
df->prc_name = gen_proc_name(nd->nd_IDF, inp); df->prc_name = gen_proc_name(nd->nd_IDF, inp);
if( ext ) { if (ext)
{
if (!(df->df_flags & D_EXTERNAL) && proclevel > 1) if (!(df->df_flags & D_EXTERNAL) && proclevel > 1)
tp->prc_nbpar -= pointer_size; tp->prc_nbpar -= pointer_size;
/* was added for static link which is not needed now. /* was added for static link which is not needed now.
@ -174,17 +177,16 @@ DoDirective(directive, nd, tp, scl, function)
} }
} }
struct def * struct def *DeclProc(register struct node *nd, struct type *tp,
DeclProc(nd, tp, scl) register struct scopelist *scl)
register struct node *nd;
struct type *tp;
register struct scopelist *scl;
{ {
register struct def *df; 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; df->df_flags |= D_SET;
if( df->df_kind == D_FWPROCEDURE ) { if (df->df_kind == D_FWPROCEDURE)
{
df->df_kind = D_PROCEDURE; /* identification */ df->df_kind = D_PROCEDURE; /* identification */
/* Simulate a call to open_scope(), which has already /* Simulate a call to open_scope(), which has already
@ -193,11 +195,10 @@ DeclProc(nd, tp, scl)
CurrVis = df->prc_vis; CurrVis = df->prc_vis;
if (tp->prc_params) if (tp->prc_params)
node_error(nd, node_error(nd, "\"%s\" already declared", nd->nd_IDF->id_text);
"\"%s\" already declared",
nd->nd_IDF->id_text);
} }
else { /* normal declaration */ else
{ /* normal declaration */
df->df_type = tp; 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() */ /* simulate open_scope() */
@ -205,23 +206,25 @@ DeclProc(nd, tp, scl)
} }
routine_label(df); routine_label(df);
} }
else CurrVis = scl; /* simulate open_scope() */ else
CurrVis = scl; /* simulate open_scope() */
return df; return df;
} }
struct def * struct def *
DeclFunc(nd, tp, scl) DeclFunc(register struct node *nd, struct type *tp,
register struct node *nd; register struct scopelist *scl)
struct type *tp;
register struct scopelist *scl;
{ {
register struct def *df; register struct def *df;
if( df = define(nd->nd_IDF, CurrentScope, D_FUNCTION) ) { if ( (df = define(nd->nd_IDF, CurrentScope, D_FUNCTION)) )
{
df->df_flags &= ~D_SET; df->df_flags &= ~D_SET;
if( df->df_kind == D_FUNCTION ) { /* declaration */ if (df->df_kind == D_FUNCTION)
if( !tp ) { { /* declaration */
if (!tp)
{
node_error(nd, "\"%s\" illegal function declaration", node_error(nd, "\"%s\" illegal function declaration",
nd->nd_IDF->id_text); nd->nd_IDF->id_text);
tp = construct_type(T_FUNCTION, error_type); tp = construct_type(T_FUNCTION, error_type);
@ -231,27 +234,26 @@ DeclFunc(nd, tp, scl)
df->df_type = tp; 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));
} }
else { /* identification */ else
{ /* identification */
assert(df->df_kind == D_FWFUNCTION); assert(df->df_kind == D_FWFUNCTION);
df->df_kind = D_FUNCTION; df->df_kind = D_FUNCTION;
CurrVis = df->prc_vis; CurrVis = df->prc_vis;
if (tp) if (tp)
node_error(nd, node_error(nd, "\"%s\" already declared", nd->nd_IDF->id_text);
"\"%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; return df;
} }
EndFunc(df) void EndFunc(register struct def *df)
register struct def *df;
{ {
/* assignment to functionname is illegal outside the functionblock */ /* assignment to functionname is illegal outside the functionblock */
df->prc_res = 0; df->prc_res = 0;
@ -259,19 +261,20 @@ EndFunc(df)
/* Give the error about assignment as soon as possible. The /* Give the error about assignment as soon as possible. The
* |= assignment inhibits a warning in the main procedure. * |= assignment inhibits a warning in the main procedure.
*/ */
if( !(df->df_flags & D_SET) ) { if (!(df->df_flags & D_SET))
{
error("function \"%s\" not assigned", df->df_idf->id_text); error("function \"%s\" not assigned", df->df_idf->id_text);
df->df_flags |= D_SET; df->df_flags |= D_SET;
} }
} }
EndBlock(block_df) void EndBlock(register struct def *block_df)
register struct def *block_df;
{ {
register struct def *tmp_def = CurrentScope->sc_def; register struct def *tmp_def = CurrentScope->sc_def;
register struct def *df; register struct def *df;
while( tmp_def ) { while (tmp_def)
{
df = tmp_def; df = tmp_def;
/* The length of a usd_def chain is at most 1. /* The length of a usd_def chain is at most 1.
* The while is just defensive programming. * The while is just defensive programming.
@ -279,23 +282,28 @@ EndBlock(block_df)
while (df->df_kind & D_INUSE) while (df->df_kind & D_INUSE)
df = df->usd_def; df = df->usd_def;
if( !is_anon_idf(df->df_idf) if (!is_anon_idf(df->df_idf) && (df->df_scope == CurrentScope))
&& (df->df_scope == CurrentScope) ) { {
if( !(df->df_kind & (D_ENUM|D_LABEL|D_ERROR)) ) { if (!(df->df_kind & (D_ENUM | D_LABEL | D_ERROR)))
if( !(df->df_flags & D_USED) ) { {
if( !(df->df_flags & D_SET) ) { if (!(df->df_flags & D_USED))
{
if (!(df->df_flags & D_SET))
{
warning("\"%s\" neither set nor used in \"%s\"", warning("\"%s\" neither set nor used in \"%s\"",
df->df_idf->id_text, block_df->df_idf->id_text); df->df_idf->id_text, block_df->df_idf->id_text);
} }
else { else
warning("\"%s\" unused in \"%s\"", {
df->df_idf->id_text, block_df->df_idf->id_text); warning("\"%s\" unused in \"%s\"", df->df_idf->id_text,
block_df->df_idf->id_text);
} }
} }
else if( !(df->df_flags & D_SET) ) { else if (!(df->df_flags & D_SET))
{
if (!(df->df_flags & D_LOOPVAR)) if (!(df->df_flags & D_LOOPVAR))
warning("\"%s\" not set in \"%s\"", warning("\"%s\" not set in \"%s\"", df->df_idf->id_text,
df->df_idf->id_text, block_df->df_idf->id_text); block_df->df_idf->id_text);
} }
} }

View file

@ -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 */ /* 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 constant {
struct node *co_const; /* result of a constant expression */ struct node *co_const; /* result of a constant expression */
#define con_const df_value.df_constant.co_const #define con_const df_value.df_constant.co_const
@ -153,3 +156,20 @@ extern struct def
*lookfor(); *lookfor();
#define NULLDEF ((struct def *) 0) #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

View file

@ -22,16 +22,15 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "code.h"
#include "error.h"
struct desig InitDesig = {DSG_INIT, 0, 0, NULLDEF, 0}; struct desig InitDesig = {DSG_INIT, 0, 0, NULLDEF, 0};
struct withdesig *WithDesigs; struct withdesig *WithDesigs;
void CodeValue();
STATIC int
properly(ds, size, al) static int properly(register struct desig *ds, arith size, int al)
register struct desig *ds;
arith size;
{ {
/* Check if it is allowed to load or store the value indicated /* Check if it is allowed to load or store the value indicated
by "ds" with LOI/STI. by "ds" with LOI/STI.
@ -55,9 +54,7 @@ properly(ds, size, al)
(! wordmodsz && ds->dsg_offset % size == 0)); (! wordmodsz && ds->dsg_offset % size == 0));
} }
CodeCopy(lhs, rhs, sz, psize) void CodeCopy(register struct desig *lhs, register struct desig *rhs, arith sz, arith *psize)
register struct desig *lhs, *rhs;
arith sz, *psize;
{ {
struct desig l, r; struct desig l, r;
@ -72,11 +69,7 @@ CodeCopy(lhs, rhs, sz, psize)
C_sti(sz); C_sti(sz);
} }
void void CodeMove(register struct desig *rhs, register struct node *left, struct type *rtp)
CodeMove(rhs, left, rtp)
register struct desig *rhs;
register struct node *left;
struct type *rtp;
{ {
struct desig dsl; struct desig dsl;
register struct desig *lhs = &dsl; register struct desig *lhs = &dsl;
@ -152,10 +145,7 @@ CodeMove(rhs, left, rtp)
} }
} }
void void CodeValue(register struct desig *ds, register struct type *tp)
CodeValue(ds, tp)
register struct desig *ds;
register struct type *tp;
{ {
/* Generate code to load the value of the designator described /* Generate code to load the value of the designator described
in "ds" in "ds"
@ -212,9 +202,7 @@ CodeValue(ds, tp)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
} }
CodeStore(ds, tp) void CodeStore(register struct desig *ds, register struct type *tp)
register struct desig *ds;
register struct type *tp;
{ {
/* Generate code to store the value on the stack in the designator /* Generate code to store the value on the stack in the designator
described in "ds" described in "ds"
@ -265,8 +253,7 @@ CodeStore(ds, tp)
ds->dsg_kind = DSG_INIT; ds->dsg_kind = DSG_INIT;
} }
CodeAddress(ds) void CodeAddress(register struct desig *ds)
register struct desig *ds;
{ {
/* Generate code to load the address of the designator described /* Generate code to load the address of the designator described
in "ds" in "ds"
@ -316,9 +303,7 @@ CodeAddress(ds)
ds->dsg_kind = DSG_PLOADED; ds->dsg_kind = DSG_PLOADED;
} }
CodeFieldDesig(df, ds) void CodeFieldDesig(register struct def *df, register struct desig *ds)
register struct def *df;
register struct desig *ds;
{ {
/* Generate code for a field designator. Only the code common for /* Generate code for a field designator. Only the code common for
address as well as value computation is generated, and the 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; ds->dsg_packed = df->fld_flags & F_PACKED;
} }
void void CodeVarDesig(register struct def *df, register struct desig *ds)
CodeVarDesig(df, ds)
register struct def *df;
register struct desig *ds;
{ {
/* Generate code for a variable represented by a "def" structure. /* Generate code for a variable represented by a "def" structure.
Of course, there are numerous cases: the variable is local, Of course, there are numerous cases: the variable is local,
@ -436,9 +418,7 @@ CodeVarDesig(df, ds)
ds->dsg_def = df; ds->dsg_def = df;
} }
CodeBoundDesig(df, ds) void CodeBoundDesig(register struct def *df, register struct desig *ds)
register struct def *df;
register struct desig *ds;
{ {
/* Generate code for the lower- and upperbound of a conformant array */ /* Generate code for the lower- and upperbound of a conformant array */
@ -464,9 +444,7 @@ CodeBoundDesig(df, ds)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
} }
CodeFuncDesig(df, ds) void CodeFuncDesig(register struct def *df, register struct desig *ds)
register struct def *df;
register struct desig *ds;
{ {
/* generate code to store the function result */ /* generate code to store the function result */
@ -500,9 +478,7 @@ CodeFuncDesig(df, ds)
ds->dsg_offset = df->prc_res; ds->dsg_offset = df->prc_res;
} }
CodeDesig(nd, ds) void CodeDesig(register struct node *nd, register struct desig *ds)
register struct node *nd;
register struct desig *ds;
{ {
/* Generate code for a designator. Use divide and conquer /* Generate code for a designator. Use divide and conquer
principle principle

View file

@ -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 */ /* 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 /* Generating code for designators is not particularly easy, especially if
@ -57,3 +60,32 @@ extern struct withdesig *WithDesigs;
extern struct desig InitDesig; extern struct desig InitDesig;
#define NO_LABEL ((label) 0) #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

View file

@ -14,15 +14,18 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "progs.h"
#include "enter.h"
#ifdef DBSYMTAB
#include "stab.h"
#endif
extern int proclevel; extern int proclevel;
extern int parlevel; extern int parlevel;
struct def *
Enter(name, kind, type, pnam)
char *name; struct def *Enter(char *name, long kind, register struct type *type, int pnam)
register struct type *type;
long kind;
{ {
/* Enter a definition for "name" with kind "kind" and type /* Enter a definition for "name" with kind "kind" and type
"type" in the Current Scope. If it is a standard name, also "type" in the Current Scope. If it is a standard name, also
@ -33,51 +36,57 @@ Enter(name, kind, type, pnam)
df = define(str2idf(name, 0), CurrentScope, kind); df = define(str2idf(name, 0), CurrentScope, kind);
df->df_type = type; df->df_type = type;
if( pnam ) { if (pnam)
{
df->df_value.df_reqname = pnam; df->df_value.df_reqname = pnam;
df->df_flags |= D_SET; df->df_flags |= D_SET;
} }
#ifdef DBSYMTAB #ifdef DBSYMTAB
else if (options['g']) stb_string(df, kind); else if (options['g'])
stb_string(df, kind);
#endif /* DBSYMTAB */ #endif /* DBSYMTAB */
return df; return df;
} }
EnterProgList(Idlist) void EnterProgList(register struct node *Idlist)
register struct node *Idlist;
{ {
register struct node *idlist = Idlist; register struct node *idlist = Idlist;
register struct def *df; register struct def *df;
for (; idlist; idlist = idlist->nd_next) for (; idlist; idlist = idlist->nd_next)
if (!strcmp(input, idlist->nd_IDF->id_text) if (!strcmp(input, idlist->nd_IDF->id_text)
|| || !strcmp(output, idlist->nd_IDF->id_text))
!strcmp(output, idlist->nd_IDF->id_text) {
) {
/* the occurence of input or output as program- /* the occurence of input or output as program-
* parameter is their declaration as a GLOBAL * parameter is their declaration as a GLOBAL
* variable of type text * variable of type text
*/ */
if( df = define(idlist->nd_IDF, CurrentScope, if ( (df = define(idlist->nd_IDF, CurrentScope,
D_VARIABLE) ) { D_VARIABLE)) )
{
df->df_type = text_type; df->df_type = text_type;
df->df_flags |= (D_SET | D_PROGPAR | D_NOREG); 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; df->var_name = input;
set_inp(); set_inp();
} }
else { else
{
df->var_name = output; df->var_name = output;
set_outp(); set_outp();
} }
#ifdef DBSYMTAB #ifdef DBSYMTAB
if (options['g']) stb_string(df, D_VARIABLE); if (options['g'])
stb_string(df, D_VARIABLE);
#endif /* DBSYMTAB */ #endif /* DBSYMTAB */
} }
} }
else { else
if( df = define(idlist->nd_IDF, CurrentScope, {
D_PARAMETER) ) { if ( (df = define(idlist->nd_IDF, CurrentScope,
D_PARAMETER)) )
{
df->df_type = error_type; df->df_type = error_type;
df->df_flags |= D_PROGPAR; df->df_flags |= D_PROGPAR;
df->var_name = idlist->nd_IDF->id_text; df->var_name = idlist->nd_IDF->id_text;
@ -87,9 +96,7 @@ EnterProgList(Idlist)
FreeNode(Idlist); FreeNode(Idlist);
} }
EnterEnumList(Idlist, type) void EnterEnumList(struct node *Idlist, register struct type *type)
struct node *Idlist;
register struct type *type;
{ {
/* Put a list of enumeration literals in the symbol table. /* 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.
@ -99,25 +106,24 @@ EnterEnumList(Idlist, type)
type->enm_ncst = 0; type->enm_ncst = 0;
for (; idlist; idlist = idlist->nd_next) for (; idlist; idlist = idlist->nd_next)
if( df = define(idlist->nd_IDF, CurrentScope, D_ENUM) ) { if ( (df = define(idlist->nd_IDF, CurrentScope, D_ENUM)) )
{
df->df_type = type; df->df_type = type;
df->enm_val = (type->enm_ncst)++; df->enm_val = (type->enm_ncst)++;
df->df_flags |= D_SET; df->df_flags |= D_SET;
if (! df1) { if (!df1)
{
type->enm_enums = df; type->enm_enums = df;
} }
else df1->enm_next = df; else
df1->enm_next = df;
df1 = df; df1 = df;
} }
FreeNode(Idlist); FreeNode(Idlist);
} }
EnterFieldList(Idlist, type, scope, addr, packed) void EnterFieldList(struct node *Idlist, register struct type *type,
struct node *Idlist; struct scope *scope, arith *addr, unsigned short packed)
register struct type *type;
struct scope *scope;
arith *addr;
unsigned short packed;
{ {
/* Put a list of fields in the symbol table. /* 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".
@ -126,14 +132,17 @@ EnterFieldList(Idlist, type, scope, addr, packed)
register struct node *idlist = Idlist; register struct node *idlist = Idlist;
for (; idlist; idlist = idlist->nd_next) for (; idlist; idlist = idlist->nd_next)
if( df = define(idlist->nd_IDF, scope, D_FIELD) ) { if ( (df = define(idlist->nd_IDF, scope, D_FIELD)) )
{
df->df_type = type; df->df_type = type;
if( packed ) { if (packed)
{
df->fld_flags |= F_PACKED; df->fld_flags |= F_PACKED;
df->fld_off = align(*addr, type->tp_palign); df->fld_off = align(*addr, type->tp_palign);
*addr = df->fld_off + type->tp_psize; *addr = df->fld_off + type->tp_psize;
} }
else { else
{
df->fld_off = align(*addr, type->tp_align); df->fld_off = align(*addr, type->tp_align);
*addr = df->fld_off + type->tp_size; *addr = df->fld_off + type->tp_size;
} }
@ -141,9 +150,7 @@ EnterFieldList(Idlist, type, scope, addr, packed)
FreeNode(Idlist); FreeNode(Idlist);
} }
EnterVarList(Idlist, type, local) void EnterVarList(struct node *Idlist, struct type *type, int local)
struct node *Idlist;
struct type *type;
{ {
/* Enter a list of identifiers representing variables into the /* Enter a list of identifiers representing variables into the
name list. "type" represents the type of the variables. name list. "type" represents the type of the variables.
@ -154,11 +161,13 @@ EnterVarList(Idlist, type, local)
register struct node *idlist = Idlist; register struct node *idlist = Idlist;
register struct scopelist *sc = CurrVis; register struct scopelist *sc = CurrVis;
for( ; idlist; idlist = idlist->nd_next ) { for (; idlist; idlist = idlist->nd_next)
{
if (!(df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE))) if (!(df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE)))
continue; /* skip this identifier */ continue; /* skip this identifier */
df->df_type = type; df->df_type = type;
if( local ) { if (local)
{
/* subtract size, which is already aligned, of /* subtract size, which is already aligned, of
* variable to the offset, as the variable list * variable to the offset, as the variable list
* exists only local to a procedure * exists only local to a procedure
@ -166,33 +175,50 @@ EnterVarList(Idlist, type, local)
sc->sc_scope->sc_off -= type->tp_size; sc->sc_scope->sc_off -= type->tp_size;
df->var_off = sc->sc_scope->sc_off; df->var_off = sc->sc_scope->sc_off;
} }
else { /* Global name */ else
{ /* Global name */
df->var_name = df->df_idf->id_text; df->var_name = df->df_idf->id_text;
df->df_flags |= D_NOREG; df->df_flags |= D_NOREG;
} }
#ifdef DBSYMTAB #ifdef DBSYMTAB
if (options['g']) stb_string(df, D_VARIABLE); if (options['g'])
stb_string(df, D_VARIABLE);
#endif /* DBSYMTAB */ #endif /* DBSYMTAB */
} }
FreeNode(Idlist); FreeNode(Idlist);
} }
arith
EnterParamList(fpl, parlist) static void LinkParam(struct paramlist **parlist, struct def *df)
register struct node *fpl; {
struct paramlist **parlist; 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 arith nb_pars = (proclevel > 1) ? pointer_size : 0;
register struct node *id; register struct node *id;
struct type *tp; struct type *tp;
struct def *df; struct def *df;
for( ; fpl; fpl = fpl->nd_right ) { for (; fpl; fpl = fpl->nd_right)
{
assert(fpl->nd_class == Link); assert(fpl->nd_class == Link);
tp = fpl->nd_type; tp = fpl->nd_type;
for (id = fpl->nd_left; id; id = id->nd_next) for (id = fpl->nd_left; id; id = id->nd_next)
if( df = define(id->nd_IDF, CurrentScope, D_VARIABLE) ) { if ( (df = define(id->nd_IDF, CurrentScope, D_VARIABLE)) )
{
df->var_off = nb_pars; df->var_off = nb_pars;
if (fpl->nd_INT & D_VARPAR || IsConformantArray(tp)) if (fpl->nd_INT & D_VARPAR || IsConformantArray(tp))
nb_pars += pointer_size; nb_pars += pointer_size;
@ -203,7 +229,8 @@ EnterParamList(fpl, parlist)
df->df_flags |= fpl->nd_INT; df->df_flags |= fpl->nd_INT;
} }
while( IsConformantArray(tp) ) { while (IsConformantArray(tp))
{
/* we need room for the descriptors */ /* we need room for the descriptors */
tp->arr_sclevel = CurrentScope->sc_level; tp->arr_sclevel = CurrentScope->sc_level;
@ -215,10 +242,7 @@ EnterParamList(fpl, parlist)
return nb_pars; return nb_pars;
} }
arith arith EnterParTypes(register struct node *fpl, struct paramlist **parlist)
EnterParTypes(fpl, parlist)
register struct node *fpl;
struct paramlist **parlist;
{ {
/* parameters.h in heading of procedural and functional /* parameters.h in heading of procedural and functional
parameters (only types are important, not the names). parameters (only types are important, not the names).
@ -228,12 +252,13 @@ EnterParTypes(fpl, parlist)
struct type *tp; struct type *tp;
struct def *df; struct def *df;
for( ; fpl; fpl = fpl->nd_right ) { for (; fpl; fpl = fpl->nd_right)
{
tp = fpl->nd_type; tp = fpl->nd_type;
for (id = fpl->nd_left; id; id = id->nd_next) for (id = fpl->nd_left; id; id = id->nd_next)
if( df = new_def() ) { if ( (df = new_def()) )
if( fpl->nd_INT & D_VARPAR || {
IsConformantArray(tp) ) if (fpl->nd_INT & D_VARPAR || IsConformantArray(tp))
nb_pars += pointer_size; nb_pars += pointer_size;
else else
nb_pars += tp->tp_size; nb_pars += tp->tp_size;
@ -241,7 +266,8 @@ EnterParTypes(fpl, parlist)
df->df_type = tp; df->df_type = tp;
df->df_flags |= fpl->nd_INT; df->df_flags |= fpl->nd_INT;
} }
while( IsConformantArray(tp) ) { while (IsConformantArray(tp))
{
nb_pars += 3 * word_size; nb_pars += 3 * word_size;
tp = tp->arr_elem; tp = tp->arr_elem;
} }
@ -249,17 +275,3 @@ EnterParTypes(fpl, parlist)
return nb_pars; 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;
}

26
lang/pc/comp/enter.h Normal file
View file

@ -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_ */

View file

@ -16,7 +16,10 @@
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <em_code.h> #include <em_code.h>
#include <system.h> #include <stdlib.h>
#include <stdio.h>
#include "print.h"
#include "system.h"
#include "LLlex.h" #include "LLlex.h"
#include "f_info.h" #include "f_info.h"
@ -37,9 +40,7 @@
int err_occurred; int err_occurred;
extern char *symbol2str(); static void _error(int, struct node *, char *, register va_list);
void _error();
/* There are three general error-message functions: /* There are three general error-message functions:
lexerror() lexical and pre-processor error messages lexerror() lexical and pre-processor error messages
@ -55,7 +56,7 @@ void _error();
#if __STDC__ #if __STDC__
#ifdef DEBUG #ifdef DEBUG
/*VARARGS*/ /*VARARGS*/
debug(char *fmt, ...) void debug(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -68,7 +69,7 @@ debug(char *fmt, ...)
#endif /* DEBUG */ #endif /* DEBUG */
/*VARARGS*/ /*VARARGS*/
error(char *fmt, ...) void error(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -80,7 +81,7 @@ error(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
node_error(struct node *node, char *fmt, ...) void node_error(struct node *node, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -92,7 +93,7 @@ node_error(struct node *node, char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
warning(char *fmt, ...) void warning(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -104,7 +105,7 @@ warning(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
node_warning(struct node *node, char *fmt, ...) void node_warning(struct node *node, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -116,7 +117,7 @@ node_warning(struct node *node, char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
lexerror(char *fmt, ...) void lexerror(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -128,7 +129,7 @@ lexerror(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
lexwarning(char *fmt, ...) void lexwarning(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -140,7 +141,7 @@ lexwarning(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
fatal(char *fmt, ...) void fatal(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -149,11 +150,11 @@ fatal(char *fmt, ...)
_error(FATAL, NULLNODE, fmt, ap); _error(FATAL, NULLNODE, fmt, ap);
} }
va_end(ap); va_end(ap);
sys_stop(S_EXIT); exit(EXIT_FAILURE);
} }
/*VARARGS*/ /*VARARGS*/
crash(char *fmt, ...) void crash(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -163,15 +164,15 @@ crash(char *fmt, ...)
} }
va_end(ap); va_end(ap);
#ifdef DEBUG #ifdef DEBUG
sys_stop(S_ABORT); abort();
#else #else
sys_stop(S_EXIT); exit(EXIT_FAILURE);
#endif #endif
} }
#else #else
#ifdef DEBUG #ifdef DEBUG
/*VARARGS*/ /*VARARGS*/
debug(va_alist) void debug(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -186,7 +187,7 @@ debug(va_alist)
#endif /* DEBUG */ #endif /* DEBUG */
/*VARARGS*/ /*VARARGS*/
error(va_alist) void error(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -200,7 +201,7 @@ error(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
node_error(va_alist) void node_error(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -215,7 +216,7 @@ node_error(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
warning(va_alist) void warning(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -229,7 +230,7 @@ warning(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
node_warning(va_alist) void node_warning(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -244,7 +245,7 @@ node_warning(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
lexerror(va_alist) void lexerror(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -258,7 +259,7 @@ lexerror(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
lexwarning(va_alist) void lexwarning(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -272,7 +273,7 @@ lexwarning(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
fatal(va_alist) void fatal(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -283,11 +284,11 @@ fatal(va_alist)
_error(FATAL, NULLNODE, fmt, ap); _error(FATAL, NULLNODE, fmt, ap);
} }
va_end(ap); va_end(ap);
sys_stop(S_EXIT); exit(EXIT_FAILURE);
} }
/*VARARGS*/ /*VARARGS*/
crash(va_alist) void crash(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -299,19 +300,14 @@ crash(va_alist)
} }
va_end(ap); va_end(ap);
#ifdef DEBUG #ifdef DEBUG
sys_stop(S_ABORT); abort();
#else #else
sys_stop(S_EXIT); exit(EXIT_FAILURE);
#endif #endif
} }
#endif #endif
void static void _error(int class, struct node *node, char *fmt, register va_list ap)
_error(class, node, fmt, ap)
int class;
struct node *node;
char *fmt;
register va_list ap;
{ {
/* _error attempts to limit the number of error messages /* _error attempts to limit the number of error messages
for a given line to MAXERR_LINE. for a given line to MAXERR_LINE.

25
lang/pc/comp/error.h Normal file
View file

@ -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_ */

View file

@ -16,6 +16,8 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "code.h"
#include "error.h"
} }
Constant(register struct node **pnd;) Constant(register struct node **pnd;)

View file

@ -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 */ /* 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 { struct id_u {
int id_res; int id_res;
@ -10,3 +12,5 @@ struct id_u {
#define id_def id_user.id_df #define id_def id_user.id_df
#include <idf_pkg.spec> #include <idf_pkg.spec>
#endif

View file

@ -12,10 +12,16 @@ struct f_info file_info;
#include <inp_pkg.body> #include <inp_pkg.body>
AtEoIF() int AtEoIF(void)
{ {
/* Make the unstacking of input streams noticable to the /* Make the unstacking of input streams noticable to the
lexical analyzer lexical analyzer
*/ */
return 1; return 1;
} }
int
AtEoIT(void)
{
return 0;
}

View file

@ -11,12 +11,13 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "label.h"
#include "error.h"
void CodeLabel(); static void CodeLabel(register struct def *df, int local);
DeclLabel(nd) void DeclLabel(struct node *nd)
struct node *nd;
{ {
struct def *df; 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 node *labnd = BlockScope->sc_lablist;
register struct def *df; register struct def *df;
@ -62,8 +63,7 @@ chk_labels(Slevel)
} }
} }
TstLabel(nd, Slevel) void TstLabel(register struct node *nd, int Slevel)
register struct node *nd;
{ {
register struct def *df; register struct def *df;
@ -105,9 +105,7 @@ TstLabel(nd, Slevel)
CodeLabel(df, 1); CodeLabel(df, 1);
} }
void void DefLabel(register struct node *nd, int Slevel)
DefLabel(nd, Slevel)
register struct node *nd;
{ {
register struct def *df; register struct def *df;
@ -142,9 +140,7 @@ DefLabel(nd, Slevel)
} }
} }
void static void CodeLabel(register struct def *df, int local)
CodeLabel(df, local)
register struct def *df;
{ {
if( err_occurred ) return; if( err_occurred ) return;

17
lang/pc/comp/label.h Normal file
View file

@ -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_ */

View file

@ -13,9 +13,9 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "lookup.h"
remove_def(df) void remove_def(register struct def *df)
register struct def *df;
{ {
struct idf *id= df->df_idf; struct idf *id= df->df_idf;
struct def *df1 = id->id_def; struct def *df1 = id->id_def;
@ -28,17 +28,9 @@ remove_def(df)
free_def(df); free_def(df);
} }
struct def * struct def *lookup(register struct idf *id, struct scope *scope, long inuse)
lookup(id, scope, inuse)
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; register struct def *df, *df1;
/* Look in the chain of definitions of this "id" for one with scope /* Look in the chain of definitions of this "id" for one with scope
@ -67,15 +59,10 @@ lookup(id, scope, inuse)
return df; return df;
} }
struct def *
lookfor(id, vis, give_error) struct def *lookfor(register struct node *id, struct scopelist *vis, int give_error)
register struct node *id;
struct scopelist *vis;
{ {
/* 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 def *df, *tmp_df;
register struct scopelist *sc = vis; register struct scopelist *sc = vis;
@ -84,8 +71,8 @@ lookfor(id, vis, give_error)
if( df ) { if( df ) {
while( vis->sc_scope->sc_level > while( vis->sc_scope->sc_level >
sc->sc_scope->sc_level ) { sc->sc_scope->sc_level ) {
if( tmp_df = define(id->nd_IDF, vis->sc_scope, if( (tmp_df = define(id->nd_IDF, vis->sc_scope,
D_INUSE)) D_INUSE)) )
tmp_df->usd_def = df; tmp_df->usd_def = df;
vis = nextvisible(vis); vis = nextvisible(vis);
} }
@ -96,8 +83,8 @@ lookfor(id, vis, give_error)
*/ */
if( (vis->sc_scope == GlobalScope) && if( (vis->sc_scope == GlobalScope) &&
!lookup(id->nd_IDF, GlobalScope, D_INUSE) ) { !lookup(id->nd_IDF, GlobalScope, D_INUSE) ) {
if( tmp_df = define(id->nd_IDF, vis->sc_scope, if( (tmp_df = define(id->nd_IDF, vis->sc_scope,
D_INUSE)) D_INUSE)) )
tmp_df->usd_def = df; tmp_df->usd_def = df;
} }

29
lang/pc/comp/lookup.h Normal file
View file

@ -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_ */

View file

@ -10,6 +10,7 @@
#include <system.h> #include <system.h>
#include <stb.h> #include <stb.h>
#include "print.h"
#include "LLlex.h" #include "LLlex.h"
#include "Lpars.h" #include "Lpars.h"
#include "class.h" #include "class.h"
@ -24,6 +25,10 @@
#include "tokenname.h" #include "tokenname.h"
#include "type.h" #include "type.h"
#include "scope.h" #include "scope.h"
#include "cstoper.h"
#include "stab.h"
#include "options.h"
#include "error.h"
char options[128]; char options[128];
char *ProgName; char *ProgName;
@ -36,9 +41,16 @@ label text_label;
struct def *program; struct def *program;
extern int fp_used; /* set if floating point used */ extern int fp_used; /* set if floating point used */
extern void LLparse(void);
main(argc, argv) int Compile(char *src, char *dst);
register char **argv; void AddRequired(void);
#ifdef DEBUG
void LexScan(void);
void Info(void);
#endif
int main(int argc, register char **argv)
{ {
register int Nargc = 1; register int Nargc = 1;
register char **Nargv = &argv[0]; register char **Nargv = &argv[0];
@ -54,14 +66,14 @@ main(argc, argv)
Nargv[Nargc] = 0; /* terminate the arg vector */ Nargv[Nargc] = 0; /* terminate the arg vector */
if( Nargc < 2 ) { if( Nargc < 2 ) {
fprint(STDERR, "%s: Use a file argument\n", ProgName); 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); if(!Compile(Nargv[1], Nargv[2]))
sys_stop(S_END); return EXIT_FAILURE;
return EXIT_SUCCESS;
} }
Compile(src, dst) int Compile(char *src, char *dst)
char *src, *dst;
{ {
extern struct tokenname tkidf[]; extern struct tokenname tkidf[];
extern struct tokenname tkstandard[]; extern struct tokenname tkstandard[];
@ -128,10 +140,10 @@ Compile(src, dst)
} }
#ifdef DEBUG #ifdef DEBUG
LexScan() void LexScan(void)
{ {
register struct token *tkp = &dot; register struct token *tkp = &dot;
extern char *symbol2str();
while( LLlex() > 0 ) { while( LLlex() > 0 ) {
print(">>> %s ", symbol2str(tkp->tk_symb)); print(">>> %s ", symbol2str(tkp->tk_symb));
@ -159,7 +171,7 @@ LexScan()
} }
#endif #endif
AddRequired() void AddRequired(void)
{ {
register struct def *df; register struct def *df;
extern struct def *Enter(); extern struct def *Enter();
@ -259,7 +271,7 @@ AddRequired()
#ifdef DEBUG #ifdef DEBUG
int cntlines; int cntlines;
Info() void Info(void)
{ {
extern int cnt_def, cnt_node, cnt_paramlist, cnt_type, cnt_scope, extern int cnt_def, cnt_node, cnt_paramlist, cnt_type, cnt_scope,
cnt_scopelist, cnt_tmpvar, cnt_withdesig, cnt_scopelist, cnt_tmpvar, cnt_withdesig,

View file

@ -12,25 +12,23 @@
#include "main.h" #include "main.h"
#include "misc.h" #include "misc.h"
#include "node.h" #include "node.h"
#include "print.h"
#include "error.h"
struct idf * struct idf *gen_anon_idf(void)
gen_anon_idf()
{ {
/* A new idf is created out of nowhere, to serve as an /* A new idf is created out of nowhere, to serve as an
anonymous name. anonymous name.
*/ */
static int name_cnt; static int name_cnt;
char *s = Malloc(strlen(FileName) + 50); char *s = Malloc(strlen(FileName) + 50);
char *sprint();
sprint(s, "#%d in %s, line %u", ++name_cnt, FileName, LineNumber); sprint(s, "#%d in %s, line %u", ++name_cnt, FileName, LineNumber);
s = Realloc(s, strlen(s)+1); s = Realloc(s, strlen(s)+1);
return str2idf(s, 0); return str2idf(s, 0);
} }
not_declared(what, id, where) void not_declared(char *what, register struct node *id, char *where)
char *what, *where;
register struct node *id;
{ {
/* The identifier "id" is not declared. If it is not generated, /* The identifier "id" is not declared. If it is not generated,
give an error message give an error message
@ -41,15 +39,13 @@ not_declared(what, id, where)
} }
} }
char * char *gen_proc_name(register struct idf *id, int inp)
gen_proc_name(id, inp)
register struct idf *id;
{ {
/* generate pseudo and internal name for procedure or function */ /* generate pseudo and internal name for procedure or function */
static int name_cnt; static int name_cnt;
static char buf[256]; static char buf[256];
char *sprint(), *Salloc();
if( inp ) { if( inp ) {
sprint(buf, "_%d%s", ++name_cnt, id->id_text); sprint(buf, "_%d%s", ++name_cnt, id->id_text);

View file

@ -1,5 +1,7 @@
/* M I S C E L L A N E O U S */ /* 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 is_anon_idf(x) ((x)->id_text[0] == '#')
#define id_not_declared(x) (not_declared("identifier", (x), "")) #define id_not_declared(x) (not_declared("identifier", (x), ""))
@ -9,11 +11,7 @@ extern struct idf
extern char extern char
*gen_proc_name(); *gen_proc_name();
void not_declared(char *what, register struct node *id, char *where);
extern char *symbol2str(); extern char *symbol2str();
extern arith NewInt();
extern arith NewPtr();
extern arith CodeBeginBlock();
extern arith EnterParamList();
extern arith EnterParTypes();
extern arith CodeInitFor();
extern arith IsString();

2
lang/pc/comp/next.in Normal file
View file

@ -0,0 +1,2 @@
#include "parameters.h"
#include "debug.h"

View file

@ -6,16 +6,14 @@
#include <alloc.h> #include <alloc.h>
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <system.h> #include "print.h"
#include "LLlex.h" #include "LLlex.h"
#include "node.h" #include "node.h"
#include "type.h" #include "type.h"
#include "error.h"
struct node * struct node *MkNode(int class, struct node *left, struct node *right, struct token *token)
MkNode(class, left, right, token)
struct node *left, *right;
struct token *token;
{ {
/* Create a node and initialize it with the given parameters /* Create a node and initialize it with the given parameters
*/ */
@ -29,9 +27,7 @@ MkNode(class, left, right, token)
return nd; return nd;
} }
struct node * struct node *MkLeaf(int class, struct token *token)
MkLeaf(class, token)
struct token *token;
{ {
register struct node *nd = new_node(); register struct node *nd = new_node();
@ -42,9 +38,7 @@ MkLeaf(class, token)
return nd; return nd;
} }
void void FreeNode(register struct node *nd)
FreeNode(nd)
register struct node *nd;
{ {
/* Put nodes that are no longer needed back onto the free list /* Put nodes that are no longer needed back onto the free list
*/ */
@ -54,8 +48,7 @@ FreeNode(nd)
free_node(nd); free_node(nd);
} }
NodeCrash(expp) int NodeCrash(struct node *expp)
struct node *expp;
{ {
crash("Illegal node %d", expp->nd_class); crash("Illegal node %d", expp->nd_class);
} }
@ -64,14 +57,13 @@ NodeCrash(expp)
extern char *symbol2str(); extern char *symbol2str();
indnt(lvl) void indnt(int lvl)
{ {
while( lvl-- ) while( lvl-- )
print(" "); print(" ");
} }
printnode(nd, lvl) void printnode(register struct node *nd, int lvl)
register struct node *nd;
{ {
indnt(lvl); indnt(lvl);
print("Class: %d; Symbol: %s\n", nd->nd_class, symbol2str(nd->nd_symb)); print("Class: %d; Symbol: %s\n", nd->nd_class, symbol2str(nd->nd_symb));
@ -83,8 +75,7 @@ printnode(nd, lvl)
} }
} }
PrNode(nd, lvl) void PrNode(register struct node *nd, int lvl)
register struct node *nd;
{ {
if( !nd ) { if( !nd ) {
indnt(lvl); print("<nilnode>\n"); indnt(lvl); print("<nilnode>\n");

View file

@ -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 */ /* 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 {
struct node *nd_left; struct node *nd_left;
@ -37,12 +40,22 @@ struct node {
#define nd_REL nd_token.TOK_REL #define nd_REL nd_token.TOK_REL
#define nd_RLA nd_token.TOK_RLA #define nd_RLA nd_token.TOK_RLA
#define nd_RIV nd_token.TOK_RIV #define nd_RIV nd_token.TOK_RIV
}; };
/* ALLOCDEF "node" 50 */ /* 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 IsProcCall(lnd) ((lnd)->nd_type->tp_fund & T_ROUTINE)
#define NULLNODE ((struct node *) 0) #define NULLNODE ((struct node *) 0)
#endif

View file

@ -7,7 +7,12 @@
#include "class.h" #include "class.h"
#include "const.h" #include "const.h"
#include "main.h" #include "main.h"
#include "LLlex.h"
#include "node.h"
#include "type.h" #include "type.h"
#include "options.h"
#include "error.h"
#define MINIDFSIZE 9 #define MINIDFSIZE 9
@ -18,13 +23,28 @@ recognize some keywords!
extern int idfsize; 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++ ) { switch( *text++ ) {
default: default:
options[text[-1]]++; /* flags, debug options etc. */ options[(int)text[-1]]++; /* flags, debug options etc. */
break; break;
/* recognized flags: /* recognized flags:
-i: largest value of set of integer -i: largest value of set of integer
@ -74,11 +94,11 @@ DoOption(text)
break; break;
} }
/* case 'u': /* underscore allowed in identifiers */ /* case 'u': *//* underscore allowed in identifiers */
/* class('_') = STIDF; /* class('_') = STIDF;*/
/* inidf['_'] = 1; /* inidf['_'] = 1;*/
/* break; /* break;*/
*/
case 'V' : { /* set object sizes and alignment requirements */ case 'V' : { /* set object sizes and alignment requirements */
/* syntax : -V[ [w|i|l|f|p] size? [.alignment]? ]* */ /* syntax : -V[ [w|i|l|f|p] size? [.alignment]? ]* */
@ -87,7 +107,7 @@ DoOption(text)
register int align; register int align;
char c, *t; char c, *t;
while( c = *text++ ) { while( (c = *text++) !=0 ) {
char *strchr(); char *strchr();
t = text; 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;
}

12
lang/pc/comp/options.h Normal file
View file

@ -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_ */

View file

@ -15,6 +15,11 @@
#include "main.h" #include "main.h"
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "enter.h"
#include "progs.h"
#ifdef DBSYMTAB
#include "stab.h"
#endif
} }
%lexical LLlex; %lexical LLlex;

View file

@ -4,6 +4,7 @@
#include <em.h> #include <em.h>
#include <assert.h> #include <assert.h>
#include "progs.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "main.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 int outpflag = 0; /* output mentioned in heading ? */
static label extfl_label; /* label of array of file pointers */ 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; inpflag = 1;
} }
set_outp() void set_outp(void)
{ {
outpflag = 1; outpflag = 1;
} }
void void make_extfl(void)
make_extfl()
{ {
if( err_occurred ) return; if( err_occurred ) return;
@ -57,9 +57,7 @@ make_extfl()
make_extfl_args( GlobalScope->sc_def ); make_extfl_args( GlobalScope->sc_def );
} }
void static void make_extfl_args(register struct def *df)
make_extfl_args(df)
register struct def *df;
{ {
if( !df ) return; if( !df ) return;
make_extfl_args(df->df_nextinscope); make_extfl_args(df->df_nextinscope);
@ -71,7 +69,7 @@ make_extfl_args(df)
} }
} }
call_ini() void call_ini(void)
{ {
C_lxl((arith) 0); C_lxl((arith) 0);
if( extflc ) if( extflc )

15
lang/pc/comp/progs.h Normal file
View file

@ -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_ */

View file

@ -6,6 +6,7 @@
#include <assert.h> #include <assert.h>
#include <em.h> #include <em.h>
#include "print.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "main.h" #include "main.h"
@ -13,25 +14,33 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "code.h"
#include "chk_expr.h"
#include "typequiv.h"
#include "error.h"
#include "readwrite.h"
/* DEBUG */ /* DEBUG */
#include "idf.h" #include "idf.h"
extern char *sprint();
void CodeRead();
void CodeReadln();
void CodeWrite();
void CodeWriteln();
void
ChkRead(arg) /* Internal function prototypes */
register struct node *arg; 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; struct node *file;
char *name = "read"; char *name = "read";
char *message, buff[80]; char *message, buff[80];
extern char *ChkAllowedVar();
assert(arg); assert(arg);
assert(arg->nd_symb == ','); assert(arg->nd_symb == ',');
@ -92,14 +101,12 @@ ChkRead(arg)
} }
} }
void void ChkReadln(register struct node *arg)
ChkReadln(arg)
register struct node *arg;
{ {
struct node *file; struct node *file;
char *name = "readln"; char *name = "readln";
char *message, buff[80]; char *message, buff[80];
extern char *ChkAllowedVar();
if( !arg ) { if( !arg ) {
if( !(file = ChkStdInOut(name, 0)) ) if( !(file = ChkStdInOut(name, 0)) )
@ -149,9 +156,7 @@ ChkReadln(arg)
CodeReadln(file); CodeReadln(file);
} }
void void ChkWrite(register struct node *arg)
ChkWrite(arg)
register struct node *arg;
{ {
struct node *left, *expp, *file; struct node *left, *expp, *file;
char *name = "write"; char *name = "write";
@ -191,9 +196,7 @@ ChkWrite(arg)
} }
} }
void void ChkWriteln(register struct node *arg)
ChkWriteln(arg)
register struct node *arg;
{ {
struct node *left, *expp, *file; struct node *left, *expp, *file;
char *name = "writeln"; char *name = "writeln";
@ -242,10 +245,7 @@ ChkWriteln(arg)
CodeWriteln(file); CodeWriteln(file);
} }
ChkWriteParameter(filetype, arg, name) static int ChkWriteParameter(struct type *filetype, struct node *arg, char *name)
struct type *filetype;
struct node *arg;
char *name;
{ {
struct type *tp; struct type *tp;
char *mess = "illegal write parameter"; char *mess = "illegal write parameter";
@ -277,7 +277,7 @@ ChkWriteParameter(filetype, arg, name)
/* Here we have a text-file */ /* Here we have a text-file */
if( arg = arg->nd_right ) { if( (arg = arg->nd_right) !=0 ) {
/* Total width */ /* Total width */
assert(arg->nd_symb == ':'); assert(arg->nd_symb == ':');
@ -289,7 +289,7 @@ ChkWriteParameter(filetype, arg, name)
else else
return 1; return 1;
if( arg = arg->nd_right ) { if( (arg = arg->nd_right)!=0 ) {
/* Fractional Part */ /* Fractional Part */
assert(arg->nd_symb == ':'); assert(arg->nd_symb == ':');
@ -305,9 +305,7 @@ ChkWriteParameter(filetype, arg, name)
return 1; return 1;
} }
struct node * struct node *ChkStdInOut(char *name, int st_out)
ChkStdInOut(name, st_out)
char *name;
{ {
register struct def *df; register struct def *df;
register struct node *nd; register struct node *nd;
@ -327,9 +325,7 @@ ChkStdInOut(name, st_out)
return nd; return nd;
} }
void static void CodeRead(register struct node *file, register struct node *arg)
CodeRead(file, arg)
register struct node *file, *arg;
{ {
struct type *tp = BaseType(arg->nd_type); struct type *tp = BaseType(arg->nd_type);
@ -386,9 +382,7 @@ CodeRead(file, arg)
} }
} }
void static void CodeReadln(struct node *file)
CodeReadln(file)
struct node *file;
{ {
if( err_occurred ) return; if( err_occurred ) return;
@ -397,9 +391,7 @@ CodeReadln(file)
C_asp(pointer_size); C_asp(pointer_size);
} }
void static void CodeWrite(register struct node *file, register struct node *arg)
CodeWrite(file, arg)
register struct node *file, *arg;
{ {
int width = 0; int width = 0;
register arith nbpars = pointer_size; register arith nbpars = pointer_size;
@ -484,9 +476,7 @@ CodeWrite(file, arg)
} }
} }
void static void CodeWriteln(register struct node *file)
CodeWriteln(file)
register struct node *file;
{ {
if( err_occurred ) return; if( err_occurred ) return;

18
lang/pc/comp/readwrite.h Normal file
View file

@ -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_ */

View file

@ -15,13 +15,15 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
#include "lookup.h"
#include "error.h"
struct scope *GlobalScope, *PervasiveScope, *BlockScope; struct scope *GlobalScope, *PervasiveScope, *BlockScope;
struct scopelist *CurrVis; struct scopelist *CurrVis;
extern int proclevel; /* declared in declar.g */ extern int proclevel; /* declared in declar.g */
static int sccount; static int sccount;
InitScope() void InitScope(void)
{ {
register struct scope *sc = new_scope(); register struct scope *sc = new_scope();
register struct scopelist *ls = new_scopelist(); register struct scopelist *ls = new_scopelist();
@ -33,7 +35,7 @@ InitScope()
CurrVis = ls; CurrVis = ls;
} }
open_scope() void open_scope(void)
{ {
register struct scope *sc = new_scope(); register struct scope *sc = new_scope();
register struct scopelist *ls = new_scopelist(); register struct scopelist *ls = new_scopelist();
@ -45,7 +47,7 @@ open_scope()
CurrVis = ls; CurrVis = ls;
} }
close_scope(doclean) void close_scope(int doclean)
{ {
/* When this procedure is called, the next visible scope is equal to /* When this procedure is called, the next visible scope is equal to
the statically enclosing scope the statically enclosing scope
@ -62,9 +64,7 @@ close_scope(doclean)
CurrVis = CurrVis->next; CurrVis = CurrVis->next;
} }
Forward(nd, tp) void Forward(register struct node *nd, register struct type *tp)
register struct node *nd;
register struct type *tp;
{ {
/* Enter a forward reference into the current scope. This is /* Enter a forward reference into the current scope. This is
* used in pointertypes. * used in pointertypes.
@ -79,7 +79,7 @@ Forward(nd, tp)
fw_type->f_type = 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 */ /* the program parameters must be global variables of some file type */
register struct def *df = CurrentScope->sc_def; 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 */ /* check if all forward declarations are defined */
register struct def *df = CurrentScope->sc_def; register struct def *df = CurrentScope->sc_def;

View file

@ -1,4 +1,6 @@
/* S C O P E M E C H A N I S M */ /* S C O P E M E C H A N I S M */
#ifndef SCOPE_H_
#define SCOPE_H_
struct scope { struct scope {
struct scope *next; struct scope *next;
@ -30,3 +32,14 @@ extern struct scopelist
#define CurrentScope (CurrVis->sc_scope) #define CurrentScope (CurrVis->sc_scope)
#define nextvisible(x) ((x)->next) /* use with scopelists */ #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

View file

@ -40,8 +40,7 @@ static struct db_str {
char *currpos; char *currpos;
} db_str; } db_str;
static static void create_db_str(void)
create_db_str()
{ {
if (! db_str.base) { if (! db_str.base) {
db_str.base = Malloc(INCR_SIZE); db_str.base = Malloc(INCR_SIZE);
@ -50,9 +49,7 @@ create_db_str()
db_str.currpos = db_str.base; db_str.currpos = db_str.base;
} }
static static void addc_db_str(int c)
addc_db_str(c)
int c;
{ {
int df = db_str.currpos - db_str.base; int df = db_str.currpos - db_str.base;
if (df >= db_str.sz-1) { if (df >= db_str.sz-1) {
@ -64,16 +61,12 @@ addc_db_str(c)
*db_str.currpos = '\0'; *db_str.currpos = '\0';
} }
static static void adds_db_str(char *s)
adds_db_str(s)
char *s;
{ {
while (*s) addc_db_str(*s++); while (*s) addc_db_str(*s++);
} }
static void static void stb_type(register struct type *tp, int assign_num)
stb_type(tp, assign_num)
register struct type *tp;
{ {
char buf[128]; char buf[128];
static int stb_count; static int stb_count;
@ -229,9 +222,7 @@ stb_type(tp, assign_num)
} }
} }
stb_addtp(s, tp) void stb_addtp(char *s, struct type *tp)
char *s;
struct type *tp;
{ {
create_db_str(); create_db_str();
adds_db_str(s); adds_db_str(s);
@ -247,10 +238,7 @@ stb_addtp(s, tp)
(arith) 0); (arith) 0);
} }
void void stb_string(register struct def *df, long kind)
stb_string(df, kind)
register struct def *df;
long kind;
{ {
register struct type *tp = df->df_type; register struct type *tp = df->df_type;
char buf[64]; char buf[64];

17
lang/pc/comp/stab.h Normal file
View file

@ -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_ */

View file

@ -17,6 +17,13 @@
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "type.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 */ int slevel = 0; /* nesting level of statements */
} }

23
lang/pc/comp/tmpvar.h Normal file
View file

@ -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_ */

View file

@ -13,6 +13,7 @@
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <em_reg.h> #include <em_reg.h>
#include <em_code.h>
#include "def.h" #include "def.h"
#include "main.h" #include "main.h"
@ -32,17 +33,14 @@ static struct scope *ProcScope; /* scope of procedure in which the
temporaries are allocated temporaries are allocated
*/ */
TmpOpen(sc) void TmpOpen(struct scope *sc)
struct scope *sc;
{ {
/* Initialize for temporaries in scope "sc". /* Initialize for temporaries in scope "sc".
*/ */
ProcScope = sc; ProcScope = sc;
} }
arith arith TmpSpace(arith sz, int al)
TmpSpace(sz, al)
arith sz;
{ {
register struct scope *sc = ProcScope; register struct scope *sc = ProcScope;
@ -50,10 +48,7 @@ TmpSpace(sz, al)
return sc->sc_off; return sc->sc_off;
} }
STATIC arith static arith NewTmp(struct tmpvar **plist, arith sz, int al, int regtype, int priority)
NewTmp(plist, sz, al, regtype, priority)
struct tmpvar **plist;
arith sz;
{ {
register arith offset; register arith offset;
register struct tmpvar *tmp; register struct tmpvar *tmp;
@ -71,22 +66,17 @@ NewTmp(plist, sz, al, regtype, priority)
return offset; return offset;
} }
arith arith NewInt(int reg_prior)
NewInt(reg_prior)
{ {
return NewTmp(&TmpInts, int_size, int_align, reg_any, reg_prior); return NewTmp(&TmpInts, int_size, int_align, reg_any, reg_prior);
} }
arith arith NewPtr(int reg_prior)
NewPtr(reg_prior)
{ {
return NewTmp(&TmpPtrs, pointer_size, pointer_align, reg_pointer, reg_prior); return NewTmp(&TmpPtrs, pointer_size, pointer_align, reg_pointer, reg_prior);
} }
STATIC static void FreeTmp(struct tmpvar **plist, arith off)
FreeTmp(plist, off)
struct tmpvar **plist;
arith off;
{ {
register struct tmpvar *tmp = new_tmpvar(); register struct tmpvar *tmp = new_tmpvar();
@ -95,19 +85,17 @@ FreeTmp(plist, off)
*plist = tmp; *plist = tmp;
} }
FreeInt(off) void FreeInt(arith off)
arith off;
{ {
FreeTmp(&TmpInts, off); FreeTmp(&TmpInts, off);
} }
FreePtr(off) void FreePtr(arith off)
arith off;
{ {
FreeTmp(&TmpPtrs, off); FreeTmp(&TmpPtrs, off);
} }
TmpClose() void TmpClose(void)
{ {
register struct tmpvar *tmp, *tmp1; register struct tmpvar *tmp, *tmp1;

View file

@ -2,8 +2,10 @@
#include "parameters.h" #include "parameters.h"
#include "Lpars.h" #include "Lpars.h"
#include "LLlex.h"
#include "idf.h" #include "idf.h"
#include "tokenname.h" #include "tokenname.h"
#include "error.h"
/* To centralize the declaration of %tokens, their presence in this /* To centralize the declaration of %tokens, their presence in this
file is taken as their declaration. The Makefile will produce file is taken as their declaration. The Makefile will produce
@ -84,8 +86,7 @@ struct tokenname tkstandard[] = { /* standard identifiers */
/* Some routines to handle tokennames */ /* Some routines to handle tokennames */
reserve(resv) void reserve(register struct tokenname *resv)
register struct tokenname *resv;
{ {
/* The names of the tokens described in resv are entered /* The names of the tokens described in resv are entered
as reserved words. as reserved words.

View file

@ -6,3 +6,6 @@ struct tokenname { /* Used for defining the name of a
int tn_symbol; int tn_symbol;
char *tn_name; char *tn_name;
}; };
void reserve(register struct tokenname *resv);

View file

@ -11,12 +11,19 @@
#include "LLlex.h" #include "LLlex.h"
#include "const.h" #include "const.h"
#include "chk_expr.h"
#include "def.h" #include "def.h"
#include "idf.h" #include "idf.h"
#include "main.h" #include "main.h"
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "lookup.h"
#include "type.h" #include "type.h"
#include "typequiv.h"
#include "error.h"
#ifdef DBSYMTAB
#include "stab.h"
#endif
#ifndef NOCROSS #ifndef NOCROSS
int int
@ -51,9 +58,15 @@ struct type
*void_type, *void_type,
*error_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 /* first, do some checking
*/ */
@ -75,7 +88,7 @@ CheckTypeSizes()
fatal("illegal realsize"); fatal("illegal realsize");
} }
InitTypes() void InitTypes(void)
{ {
/* First check the sizes of some basic EM-types /* First check the sizes of some basic EM-types
*/ */
@ -144,16 +157,12 @@ InitTypes()
emptyset_type->tp_align = word_align; emptyset_type->tp_align = word_align;
} }
int static int fit(arith sz, int nbytes)
fit(sz, nbytes)
arith sz;
{ {
return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0; return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0;
} }
struct type * struct type *standard_type(int fund, int algn, arith size)
standard_type(fund, algn, size)
arith size;
{ {
register struct type *tp = new_type(); register struct type *tp = new_type();
@ -166,9 +175,7 @@ standard_type(fund, algn, size)
return tp; return tp;
} }
struct type * struct type *construct_type(int fund, register struct type *tp)
construct_type(fund, tp)
register struct type *tp;
{ {
/* fund must be a type constructor. /* fund must be a type constructor.
* The pointer to the constructed type is returned. * The pointer to the constructed type is returned.
@ -212,10 +219,7 @@ construct_type(fund, tp)
return dtp; return dtp;
} }
struct type * struct type *proc_type(struct paramlist *parameters, arith n_bytes_params)
proc_type(parameters, n_bytes_params)
struct paramlist *parameters;
arith n_bytes_params;
{ {
register struct type *tp = construct_type(T_PROCEDURE, NULLTYPE); register struct type *tp = construct_type(T_PROCEDURE, NULLTYPE);
@ -224,11 +228,7 @@ proc_type(parameters, n_bytes_params)
return tp; return tp;
} }
struct type * struct type *func_type(struct paramlist * parameters, arith n_bytes_params, struct type *resulttype)
func_type(parameters, n_bytes_params, resulttype)
struct paramlist *parameters;
arith n_bytes_params;
struct type *resulttype;
{ {
register struct type *tp = construct_type(T_FUNCTION, resulttype); register struct type *tp = construct_type(T_FUNCTION, resulttype);
@ -237,9 +237,7 @@ func_type(parameters, n_bytes_params, resulttype)
return tp; return tp;
} }
chk_type_id(ptp, nd) void chk_type_id(register struct type **ptp, register struct node *nd)
register struct type **ptp;
register struct node *nd;
{ {
register struct def *df; register struct def *df;
@ -266,9 +264,7 @@ chk_type_id(ptp, nd)
} }
} }
struct type * struct type *subr_type(register struct node *lb, register struct node *ub)
subr_type(lb, ub)
register struct node *lb, *ub;
{ {
/* Construct a subrange type from the constant expressions /* Construct a subrange type from the constant expressions
indicated by "lb" and "ub", but first perform some checks indicated by "lb" and "ub", but first perform some checks
@ -322,9 +318,7 @@ subr_type(lb, ub)
return res; return res;
} }
getbounds(tp, plo, phi) void getbounds(register struct type *tp, arith *plo, arith *phi)
register struct type *tp;
arith *plo, *phi;
{ {
/* Get the bounds of a bounded type /* Get the bounds of a bounded type
*/ */
@ -345,10 +339,7 @@ getbounds(tp, plo, phi)
} }
} }
struct type * struct type *set_type(register struct type *tp, unsigned short packed)
set_type(tp, packed)
register struct type *tp;
unsigned short packed;
{ {
/* Construct a set type with base type "tp", but first /* Construct a set type with base type "tp", but first
perform some checks perform some checks
@ -415,9 +406,7 @@ set_type(tp, packed)
return tp; return tp;
} }
arith static arith ArrayElSize(register struct type *tp, int packed)
ArrayElSize(tp, packed)
register struct type *tp;
{ {
/* Align element size to alignment requirement of element type. /* Align element size to alignment requirement of element type.
Also make sure that its size is either a dividor of the word_size, Also make sure that its size is either a dividor of the word_size,
@ -444,9 +433,7 @@ ArrayElSize(tp, packed)
return algn; return algn;
} }
void void ArraySizes(register struct type *tp)
ArraySizes(tp)
register struct type *tp;
{ {
/* Assign sizes to an array type, and check index type /* Assign sizes to an array type, and check index type
*/ */
@ -492,9 +479,7 @@ ArraySizes(tp)
C_rom_cst(tp->arr_elsize); C_rom_cst(tp->arr_elsize);
} }
void static void FreeForward(register struct forwtype *for_type)
FreeForward(for_type)
register struct forwtype *for_type;
{ {
if( !for_type ) return; if( !for_type ) return;
@ -503,7 +488,7 @@ FreeForward(for_type)
free_forwtype(for_type); free_forwtype(for_type);
} }
chk_forw_types() void chk_forw_types(void)
{ {
/* check all forward references (in pointer types) */ /* check all forward references (in pointer types) */
@ -574,9 +559,8 @@ chk_forw_types()
} }
} }
TstCaseConstants(nd, sel, sel1) void TstCaseConstants(register struct node *nd, register struct selector *sel,
register struct node *nd; register struct selector *sel1)
register struct selector *sel, *sel1;
{ {
/* Insert selector of nested variant (sel1) in tagvalue-table of /* Insert selector of nested variant (sel1) in tagvalue-table of
current selector (sel). current selector (sel).
@ -599,19 +583,14 @@ TstCaseConstants(nd, sel, sel1)
} }
} }
arith arith align(arith pos, int al)
align(pos, al)
arith pos;
int al;
{ {
arith i; arith i;
return pos + ((i = pos % al) ? al - i : 0); return pos + ((i = pos % al) ? al - i : 0);
} }
int static int gcd(int m, int n)
gcd(m, n)
register int m, n;
{ {
/* Greatest Common Divisor /* Greatest Common Divisor
*/ */
@ -625,9 +604,7 @@ gcd(m, n)
return m; return m;
} }
int int lcm(int m, int n)
lcm(m, n)
int m, n;
{ {
/* Least Common Multiple /* Least Common Multiple
*/ */
@ -635,8 +612,7 @@ lcm(m, n)
} }
#ifdef DEBUG #ifdef DEBUG
DumpType(tp) void DumpType(register struct type *tp)
register struct type *tp;
{ {
if( !tp ) return; if( !tp ) return;

View file

@ -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 */ /* 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 { /* structure for parameterlist of a PROCEDURE */
struct paramlist *next; struct paramlist *next;
@ -160,16 +164,6 @@ extern arith
real_size; /* All from type.c */ real_size; /* All from type.c */
#endif /* NOCROSS */ #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) #define NULLTYPE ((struct type *) 0)
@ -192,3 +186,45 @@ struct type
extern long full_mask[]; extern long full_mask[];
#define ufit(n, i) (((n) & ~full_mask[(i)]) == 0) #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

View file

@ -14,20 +14,17 @@
#include "def.h" #include "def.h"
#include "node.h" #include "node.h"
#include "type.h" #include "type.h"
#include "error.h"
#include "typequiv.h"
int TstTypeEquiv(register struct type *tp1, register struct type *tp2)
int
TstTypeEquiv(tp1, tp2)
register struct type *tp1, *tp2;
{ {
/* test if two types are equivalent. /* test if two types are equivalent.
*/ */
return tp1 == tp2 || tp1 == error_type || tp2 == error_type; return tp1 == tp2 || tp1 == error_type || tp2 == error_type;
} }
arith arith IsString(register struct type *tp)
IsString(tp)
register struct type *tp;
{ {
/* string = packed array[1..ub] of char and ub > 1 */ /* string = packed array[1..ub] of char and ub > 1 */
if( tp->tp_fund & T_STRINGCONST ) return tp->tp_psize; if( tp->tp_fund & T_STRINGCONST ) return tp->tp_psize;
@ -45,9 +42,7 @@ IsString(tp)
return (arith) 0; return (arith) 0;
} }
int int TstStrCompat(register struct type *tp1, register struct type *tp2)
TstStrCompat(tp1, tp2)
register struct type *tp1, *tp2;
{ {
/* test if two types are compatible string-types. /* test if two types are compatible string-types.
*/ */
@ -62,9 +57,7 @@ TstStrCompat(tp1, tp2)
return ub1 == ub2; return ub1 == ub2;
} }
int int TstCompat(register struct type *tp1,register struct type *tp2)
TstCompat(tp1, tp2)
register struct type *tp1, *tp2;
{ {
/* test if two types are compatible. ISO 6.4.5 /* test if two types are compatible. ISO 6.4.5
*/ */
@ -110,9 +103,7 @@ TstCompat(tp1, tp2)
return tp1 == tp2; return tp1 == tp2;
} }
int int TstAssCompat(register struct type *tp1,register struct type *tp2)
TstAssCompat(tp1, tp2)
register struct type *tp1, *tp2;
{ {
/* test if two types are assignment compatible. ISO 6.4.6 /* test if two types are assignment compatible. ISO 6.4.6
*/ */
@ -128,9 +119,7 @@ TstAssCompat(tp1, tp2)
return 0; return 0;
} }
int int TstParEquiv(register struct type *tp1, register struct type *tp2)
TstParEquiv(tp1, tp2)
register struct type *tp1, *tp2;
{ {
/* Test if two parameter types are equivalent. ISO 6.6.3.6 /* 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) TstProcEquiv(tp1, tp2)
); );
} }
int int TstProcEquiv(register struct type *tp1, register struct type *tp2)
TstProcEquiv(tp1, tp2)
register struct type *tp1, *tp2;
{ {
/* Test if two procedure types are equivalent. ISO 6.6.3.6 /* Test if two procedure types are equivalent. ISO 6.6.3.6
*/ */
@ -190,10 +177,8 @@ TstProcEquiv(tp1, tp2)
return p1 == p2; return p1 == p2;
} }
int int TstParCompat(register struct type *formaltype, register struct type *actualtype,
TstParCompat(formaltype, actualtype, VARflag, nd, new_par_section) int VARflag, struct node *nd, int new_par_section)
register struct type *formaltype, *actualtype;
struct node *nd;
{ {
/* Check type compatibility for a parameter in a procedure call. /* 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; else return 0;
} }
int int TstConform(register struct type *formaltype, register struct type * actualtype, int new_par_section)
TstConform(formaltype, actualtype, new_par_section)
register struct type *formaltype, *actualtype;
{ {
/* Check conformability. /* Check conformability.

42
lang/pc/comp/typequiv.h Normal file
View file

@ -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_ */