Pascal compiler better type checking and function declarations (Better ISO C compatibility)

lang/pc/comp/LLlex.c

@@ -19,9 +19,10 @@
 #include	"input.h"
 #include	"main.h"
 #include	"type.h"
+#include    "error.h"
+#include    "ack_string.h"
+
 
-extern long	str2long();
-extern char	*Malloc();
 
 #define	TO_LOWER(ch)	(ch |= ( ch>='A' && ch<='Z' ) ? 0x0020 : 0)
 
@@ -43,7 +44,7 @@ int tokenseen = 0;	/* Some comment-options must precede any program text */
 /* Warning: The options specified inside comments take precedence over
  * the ones on the command line.
  */
-CommentOptions()
+void CommentOptions(void)
 {
 	register int ch, ci;
 	int	on_on_minus = 0;
@@ -120,8 +121,7 @@ CommentOptions()
 }
 
 
-STATIC void
+static void SkipComment(void)
-SkipComment()
 {
 	/*	Skip ISO-Pascal comments (* ... *) or { ... }.
 		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 ".
 	*/
@@ -212,8 +210,7 @@ register int delim;
 
 static char *s_error = "illegal line directive";
 
-void
+void CheckForLineDirective(void)
-CheckForLineDirective()
 {
 	register int	ch;
 	register int	i = 0;
@@ -276,8 +273,7 @@ CheckForLineDirective()
 	LineNumber = i;
 }
 
-int
+int LLlex(void)
-LLlex()
 {
 	/*	LLlex() is the Lexical Analyzer.
 		The putting aside of tokens is taken into account.
@@ -531,10 +527,10 @@ again:
 				while (*np == '0')	/* skip leading zeros */
 					np++;
 				tk->TOK_INT = str2long(np, 10);
-				if( tk->TOK_INT < 0 ||
+				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");
 			}
 			toktype = int_type;

lang/pc/comp/LLlex.h

@@ -1,4 +1,9 @@
 /* T O K E N   D E S C R I P T O R   D E F I N I T I O N */
+#ifndef LLLEX_H_
+#define LLLEX_H_
+
+#include "em_label.h"
+#include "em_arith.h"
 
 /* Structure to store a string constant
 */
@@ -46,3 +51,8 @@ extern struct type *toktype, *asidetype;
 extern int tokenseen;
 
 #define	ASIDE	aside.tk_symb
+
+void CheckForLineDirective(void);
+int LLlex(void);
+
+#endif

lang/pc/comp/LLmessage.c

@@ -14,15 +14,14 @@
 #include	"LLlex.h"
 #include	"Lpars.h"
 #include	"idf.h"
+#include    "node.h"
 #include	"type.h"
+#include    "misc.h"
+#include    "error.h"
 
-extern char		*symbol2str();
-extern char		*Malloc(), *Salloc();
-extern struct idf	*gen_anon_idf();
 extern int expect_label;
 
-LLmessage(tk)
+void LLmessage(register int tk)
-	register int tk;
 {
 	if( tk > 0 )	{
 		/* if( tk > 0 ), it represents the token to be inserted.

lang/pc/comp/Parameters

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

lang/pc/comp/body.c

@@ -15,31 +15,36 @@
 #include	"node.h"
 #include	"scope.h"
 #include	"type.h"
+#include    "code.h"
+#include    "chk_expr.h"
+#include    "tmpvar.h"
+#include    "typequiv.h"
+#include    "error.h"
 
-MarkDef(nd, flags, on)
+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;
-		else if( nd->nd_class == Arrow )
+		else if (nd->nd_class == Arrow)
 			nd = nd->nd_right;
-		else break;
+		else
+			break;
 	}
-	if( nd && (nd->nd_class == Def) ) {
+	if (nd && (nd->nd_class == Def))
-		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;
-		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) )
-				node_warning(nd,
+			 node_warning(nd,
-				"variable \"%s\" already referenced in with",
+			 "variable \"%s\" already referenced in with",
-				nd->nd_def->df_idf->id_text);
+			 nd->nd_def->df_idf->id_text);
-			*/
+			 */
 			nd->nd_def->df_flags |= flags;
 		}
 		else
@@ -47,32 +52,29 @@ 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;
 
-	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");
 		return;
 	}
 
-	if( !options['a'] && !err_occurred ) {
+	if (!options['a'] && !err_occurred)
+	{
 		dsr = InitDesig;
 		CodeExpr(expp, &dsr, NO_LABEL);
-		C_loc((arith)line);
+		C_loc((arith) line);
 		C_cal("_ass");
 	}
 }
 
-void
+void AssignStat(register struct node *left, register struct node *right)
-AssignStat(left, right)
-	register struct node *left, *right;
 {
 	register struct type *ltp, *rtp;
 	int retval = 0;
@@ -85,43 +87,49 @@ AssignStat(left, right)
 	ltp = left->nd_type;
 	rtp = right->nd_type;
 
-	MarkDef(left, (unsigned short)D_SET, 1);
+	MarkDef(left, (unsigned short) D_SET, 1);
 
-	if( !retval ) return;
+	if (!retval)
+		return;
 
-	if( ltp == int_type && rtp == long_type )	{
+	if (ltp == int_type && rtp == long_type)
+	{
 		right = MkNode(IntReduc, NULLNODE, right, &dot);
 		right->nd_type = int_type;
 	}
-	else if( ltp == long_type && rtp == int_type )	{
+	else if (ltp == long_type && rtp == int_type)
+	{
 		right = MkNode(IntCoerc, NULLNODE, right, &dot);
 		right->nd_type = long_type;
 	}
 
-	if( !TstAssCompat(ltp, rtp) )	{
+	if (!TstAssCompat(ltp, rtp))
+	{
 		node_error(left, "type incompatibility in assignment");
 		return;
 	}
 
-	if( left->nd_class == Def &&
+	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");
 		return;
 	}
 
-	if( rtp == emptyset_type )
+	if (rtp == emptyset_type)
 		right->nd_type = ltp;
 
-	if( !err_occurred )	{
+	if (!err_occurred)
+	{
 		dsr = InitDesig;
 		CodeExpr(right, &dsr, NO_LABEL);
 
-		if( rtp->tp_fund & (T_ARRAY | T_RECORD) )
+		if (rtp->tp_fund & (T_ARRAY | T_RECORD))
 			CodeAddress(&dsr);
-		else	{
+		else
+		{
 			CodeValue(&dsr, rtp);
 
-			if( ltp == real_type && BaseType(rtp) == int_type )
+			if (ltp == real_type && BaseType(rtp) == int_type)
 				Int2Real(rtp->tp_size);
 
 			RangeCheck(ltp, rtp);
@@ -133,21 +141,19 @@ AssignStat(left, right)
 	FreeNode(right);
 }
 
-void
+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");
 		return;
 	}
 }
 
-void
+void ChkForStat(register struct node *nd)
-ChkForStat(nd)
-	register struct node *nd;
 {
 	register struct def *df;
 	int retvar = 0;
@@ -157,84 +163,82 @@ ChkForStat(nd)
 	MarkUsed(nd->nd_left);
 	retvar &= ChkExpression(nd->nd_right);
 	MarkUsed(nd->nd_right);
-	if( !retvar ) return;
+	if (!retvar)
+		return;
 
 	assert(nd->nd_class == Def);
 
 	df = nd->nd_def;
 
-	if( df->df_scope != BlockScope )	{
+	if (df->df_scope != BlockScope)
+	{
 		node_error(nd, "for loop: control variable must be local");
 		return;
 	}
 
 	assert(df->df_kind == D_VARIABLE);
 
-	if( df->df_scope != GlobalScope && df->var_off >= 0 )	{
+	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;
 	}
 
-	if( !(df->df_type->tp_fund & T_ORDINAL) )	{
+	if (!(df->df_type->tp_fund & T_ORDINAL))
+	{
 		node_error(nd, "for loop: control variable must be ordinal");
-		MarkDef(nd,(unsigned short)(D_LOOPVAR | D_SET | D_USED), 1);
+		MarkDef(nd, (unsigned short) (D_LOOPVAR | D_SET | D_USED), 1);
 		return;
 	}
 
-	if( !TstCompat(df->df_type, nd->nd_left->nd_type) )
+	if (!TstCompat(df->df_type, nd->nd_left->nd_type))
 		node_error(nd,
-		  "for loop: initial value incompatible with control variable");
+				"for loop: initial value incompatible with control variable");
 
-	if( !TstCompat(df->df_type, nd->nd_right->nd_type) )
+	if (!TstCompat(df->df_type, nd->nd_right->nd_type))
 		node_error(nd,
-		    "for loop: final value incompatible with control variable");
+				"for loop: final value incompatible with control variable");
 
-	if( df->df_type == long_type )
+	if (df->df_type == long_type)
 		node_error(nd, "for loop: control variable can not be a long");
 
-	if( df->df_flags & D_INLOOP )
+	if (df->df_flags & D_INLOOP)
 		node_error(nd, "for loop: control variable already used");
 
-	if( df->df_flags & D_SETINHIGH )
+	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;
 }
 
-void
+void EndForStat(register struct node *nd)
-EndForStat(nd)
-	register struct node *nd;
 {
 	register struct def *df;
 
 	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;
 
-	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
-	   once, so generate a temporary for it, when not a constant.
+	 once, so generate a temporary for it, when not a constant.
-	*/
+	 */
 
 	arith tmp;
 
 	CodePExpr(nd);
-	if( nd->nd_class != Value )	{
+	if (nd->nd_class != Value)
+	{
 		tmp = NewInt(priority);
 
 		C_dup(int_size);
@@ -245,14 +249,13 @@ CodeInitFor(nd, priority)
 	return (arith) 0;
 }
 
-CodeFor(nd, stepsize, l1, l2)
+void CodeFor(struct node *nd, int stepsize, label l1, label l2)
-	struct node *nd;
-	label l1, l2;
 {
 	/* Test if loop has to be done */
-	if( stepsize == 1 )	/* TO */
+	if (stepsize == 1) /* TO */
 		C_bgt(l2);
-	else			/* DOWNTO */
+	else
+		/* DOWNTO */
 		C_blt(l2);
 
 	/* Label at begin of the body */
@@ -262,24 +265,22 @@ CodeFor(nd, stepsize, l1, l2)
 	CodeDStore(nd);
 }
 
-CodeEndFor(nd, stepsize, l1, l2, tmp2)
+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 */
 	CodePExpr(nd);
 	C_dup(int_size);
-	if( tmp2 )
+	if (tmp2)
 		C_lol(tmp2);
 	else
 		CodePExpr(nd->nd_right);
 	C_beq(l2);
 
 	/* Increment/decrement the control-variable */
-	if( stepsize == 1 )	/* TO */
+	if (stepsize == 1) /* TO */
 		C_inc();
-	else			/* DOWNTO */
+	else
+		/* DOWNTO */
 		C_dec();
 	C_bra(l1);
 
@@ -288,33 +289,33 @@ CodeEndFor(nd, stepsize, l1, l2, tmp2)
 	C_asp(int_size);
 }
 
-void
+void WithStat(struct node *nd)
-WithStat(nd)
-	struct node *nd;
 {
 	struct withdesig *wds;
 	struct desig ds;
 	struct scopelist *scl;
 
-	if( nd->nd_type->tp_fund != T_RECORD )	{
+	if (nd->nd_type->tp_fund != T_RECORD)
+	{
 		node_error(nd, "record variable expected");
 		return;
 	}
 
-	MarkDef(nd, (unsigned short)(D_USED | D_SET | D_WITH), 1);
+	MarkDef(nd, (unsigned short) (D_USED | D_SET | D_WITH), 1);
 	/*
-	if( (nd->nd_class == Arrow) &&
+	 if( (nd->nd_class == Arrow) &&
-	    (nd->nd_right->nd_type->tp_fund & T_FILE) ) {
+	 (nd->nd_right->nd_type->tp_fund & T_FILE) ) {
-		nd->nd_right->nd_def->df_flags |= D_WITH;
+	 nd->nd_right->nd_def->df_flags |= D_WITH;
-	}
+	 }
-	*/
+	 */
 
 	scl = new_scopelist();
 	scl->sc_scope = nd->nd_type->rec_scope;
 	scl->next = CurrVis;
 	CurrVis = scl;
 
-	if( err_occurred ) return;
+	if (err_occurred)
+		return;
 
 	/* Generate code */
 
@@ -338,24 +339,23 @@ WithStat(nd)
 	wds->w_desig = ds;
 }
 
-EndWith(saved_scl, nd)
+void EndWith(struct scopelist *saved_scl, struct node *nd)
-	struct scopelist *saved_scl;
-	struct node *nd;
 {
 	/* restore scope, and release structures */
 	struct scopelist *scl;
 	struct withdesig *wds;
 	struct node *nd1;
 
-	while( CurrVis != saved_scl )	{
+	while (CurrVis != saved_scl)
+	{
 
 		/* release scopelist */
 		scl = CurrVis;
 		CurrVis = CurrVis->next;
 		free_scopelist(scl);
 
-		if( WithDesigs == 0 )
+		if (WithDesigs == 0)
-			continue;	/* we didn't generate any code */
+			continue; /* we didn't generate any code */
 
 		/* release temporary */
 		FreePtr(WithDesigs->w_desig.dsg_offset);
@@ -366,8 +366,9 @@ EndWith(saved_scl, nd)
 		free_withdesig(wds);
 	}
 
-	for( nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right ) {
+	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);
 	}
 
 	FreeNode(nd);

lang/pc/comp/body.h

@@ -0,0 +1,38 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef BODY_H_
+#define BODY_H_
+
+#include "em_arith.h"
+#include "em_label.h"
+
+
+struct node;
+struct scopelist;
+
+
+void MarkDef(register struct node *nd, unsigned short flags, int on);
+
+/* Assert statement */
+void AssertStat(register struct node *expp, unsigned short line);
+/** Assign statement */
+void AssignStat(register struct node *left, register struct node *right);
+/** Procedure call statement */
+void ProcStat(register struct node *nd);
+
+/** ??? */
+void ChkForStat(register struct node *nd);
+/** ??? */
+void EndForStat(register struct node *nd);
+arith CodeInitFor(register struct node *nd, int priority);
+void CodeFor(struct node *nd, int stepsize, label l1, label l2);
+void CodeEndFor(struct node *nd, int stepsize, label l1, label l2, arith tmp2);
+
+/* With statement */
+void WithStat(struct node *nd);
+void EndWith(struct scopelist *saved_scl, struct node *nd);
+
+#endif /* BODY_H_ */

lang/pc/comp/build.lua

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

lang/pc/comp/casestat.h

@@ -0,0 +1,19 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef CASESTAT_H_
+#define CASESTAT_H_
+
+#include <em_label.h>
+
+struct node;
+
+void CaseExpr(struct node *nd);
+void CaseEnd(struct node *nd, label exit_label);
+
+
+
+
+#endif /* CASESTAT_H_ */

lang/pc/comp/casestat.xc

@@ -12,6 +12,10 @@
 #include	"main.h"
 #include	"node.h"
 #include	"type.h"
+#include    "code.h"
+#include    "error.h"
+#include    "typequiv.h"
+#include    "casestat.h"
 
 struct case_hdr	{
 	struct case_hdr *ch_next;		/* in the free list */
@@ -40,9 +44,14 @@ struct case_entry	{
 */
 #define	compact(nr, low, up)	(nr != 0 && (up - low) / nr <= DENSITY)
 
+static void FreeCh(register struct case_hdr *);
+static int AddCases(register struct case_hdr *, register struct node *, label);
+static int AddOneCase(register struct case_hdr *, register struct node *, label);
+static void CaseCode(label, struct case_hdr *, label);
+
+
 void
-CaseExpr(nd)
+CaseExpr(struct node *nd)
-	struct node *nd;
 {
 	/* Check the expression and generate code for it
 	*/
@@ -64,9 +73,9 @@ CaseExpr(nd)
 }
 
 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.
 	*/
@@ -98,8 +107,7 @@ CaseEnd(nd, exit_label)
 	FreeNode(nd);
 }
 
-FreeCh(ch)
+static void FreeCh(register struct case_hdr *ch)
-	register struct case_hdr *ch;
 {
 	/*	 free the allocated case structure	
 	*/
@@ -116,10 +124,10 @@ FreeCh(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 )	{
 		if( !AddOneCase(ch, nd, CaseLabel) )
@@ -129,10 +137,10 @@ AddCases(ch, nd, CaseLabel)
 	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 *c1 = ch->ch_entries, *c2 = 0;
@@ -211,10 +219,10 @@ AddOneCase(ch, nd, lbl)
 	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 */
 

lang/pc/comp/chk_expr.h

@@ -1,5 +1,7 @@
 /* E X P R E S S I O N   C H E C K I N G */
 
+struct node;
+
 extern int	(*ExprChkTable[])();	/* table of expression checking
 					   functions, indexed by node class
 					*/
@@ -10,3 +12,14 @@ extern int	(*VarAccChkTable[])();	/* table of variable-access checking
 
 #define	ChkExpression(expp)	((*ExprChkTable[(expp)->nd_class])(expp))
 #define	ChkVarAccess(expp)	((*VarAccChkTable[(expp)->nd_class])(expp))
+
+int ChkConstant(register struct node *expp);
+int ChkVariable(register struct node *expp);
+/* Check that "expp" indicates an item that can be the lhs
+   of an assignment, return 1 if possible, on return 0.
+ */
+int ChkLhs(register struct node *expp);
+int ChkLinkOrName(register struct node *expp);
+char *ChkAllowedVar(register struct node *nd, int reading);
+int ChkCall(register struct node *expp);
+void MarkUsed(register struct node *nd);

lang/pc/comp/code.h

@@ -0,0 +1,56 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef CODE_H_
+#define CODE_H_
+
+#include "em_arith.h"
+#include "em_label.h"
+
+struct def;
+struct node;
+struct type;
+struct desig;
+
+void routine_label(register struct def * df);
+void RomString(register struct node *nd);
+void RomReal(register struct node *nd);
+void BssVar(void);
+arith CodeBeginBlock(register struct def *df);
+void CodeEndBlock(register struct def *df, arith StackAdjustment);
+void CodeExpr(register struct node *nd, register struct desig *ds,
+		label true_label);
+void CodeCall(register struct node *nd);
+void RangeCheck(register struct type *tpl, register struct type *tpr);
+
+/*	Generate code to push the value of the expression "nd"
+    on the stack.
+*/
+void CodePExpr(register struct node *nd);
+
+/*	Generate code to push the address of the designator "nd"
+    on the stack.
+ */
+void CodeDAddress(struct node *nd);
+
+/*	Generate code to store the expression on the stack
+    into the designator "nd".
+ */
+void CodeDStore(register struct node *nd);
+
+/* Generate code to convert long to int */
+void Long2Int(void);
+/* Generate code to convert int to long */
+void Int2Long(void);
+/* Generate code to convert int to real */
+void Int2Real(arith size);
+/* Generate code to convert real to int */
+void Real2Int(void);
+
+
+
+
+
+#endif /* CODE_H_ */

lang/pc/comp/cstoper.c

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

lang/pc/comp/cstoper.h

@@ -0,0 +1,36 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef CSTOPER_H_
+#define CSTOPER_H_
+
+/* Forward struct declarations. */
+struct node;
+
+/*	The unary operation in "expp" is performed on the constant
+	expression below it, and the result restored in expp.
+*/
+void cstunary(register struct node *expp);
+
+/*	The binary operation in "expp" is performed on the constant
+	expressions below it, and the result restored in expp.
+*/
+void cstbin(register struct node *expp);
+void cstset(register struct node *expp);
+
+/* Standard system function call that can be evaluated
+ * a compile time.
+ */
+void cstcall(register struct node *expp, int req);
+
+/* The constant value of the expression expr is made to conform
+ * to the size of the type of the expression
+ */
+void CutSize(register struct node *expr);
+void InitCst(void);
+
+
+
+#endif /* CSTOPER_H_ */

lang/pc/comp/declar.g

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

lang/pc/comp/def.c

@@ -15,13 +15,13 @@
 #include	"misc.h"
 #include	"node.h"
 #include	"scope.h"
+#include    "code.h"
 #include	"type.h"
+#include    "lookup.h"
+#include    "error.h"
 
-struct def *
+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
 	 *	id "id" and kind "kind".
@@ -36,79 +36,81 @@ MkDef(id, scope, kind)
 	id->id_def = df;
 
 	/* enter the definition in the list of definitions in this scope
-	*/
+	 */
 	df->df_nextinscope = scope->sc_def;
 	scope->sc_def = df;
 	return df;
 }
 
-struct def *
+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
-		already has been defined.
+	 already has been defined.
-		If so, then check for the cases in which this is legal,
+	 If so, then check for the cases in which this is legal,
-		and otherwise give an error message.
+	 and otherwise give an error message.
-	*/
+	 */
 	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);
 		}
-		if (df->df_kind == D_ERROR ) {
+		if (df->df_kind == D_ERROR)
+		{
 			/* used in forward references */
 			df->df_kind = kind;
 			return df;
 		}
 		/* other cases fit in an int (assume at least 2 bytes) */
-		switch((int) df->df_kind )	{
+		switch ((int) df->df_kind)
+		{
 
-		    case D_LABEL :
+		case D_LABEL:
 			/* generate error message somewhere else */
 			return NULLDEF;
 
-		    case D_PARAMETER :
+		case D_PARAMETER:
-			if( kind == D_VARIABLE )
+			if (kind == D_VARIABLE)
-			/* program parameter declared as variable */
+				/* program parameter declared as variable */
 				return df;
 			break;
 
-		    case D_FORWTYPE :
+		case D_FORWTYPE:
-			if( kind == D_FORWTYPE ) return df;
+			if (kind == D_FORWTYPE)
-			if( kind == D_TYPE )	{
+				return df;
-			/* forward reference resolved */
+			if (kind == D_TYPE)
+			{
+				/* forward reference resolved */
 				df->df_kind = D_FTYPE;
 				return df;
 			}
 			else
-				error("identifier \"%s\" must be a type",
+				error("identifier \"%s\" must be a type", id->id_text);
-							id->id_text);
 			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;
 
-		    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;
 
 		}
-		if( kind != D_ERROR )
+		if (kind != D_ERROR)
 			/* avoid spurious error messages */
-		        error("identifier \"%s\" already declared",id->id_text);
+			error("identifier \"%s\" already declared", id->id_text);
 
 		return NULLDEF;
 	}
@@ -116,142 +118,142 @@ define(id, scope, kind)
 	return MkDef(id, scope, kind);
 }
 
-void
+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);
 
-	if( !df )	{
+	if (!df)
-		if( !is_anon_idf(directive) )
+	{
-			node_error(nd, "\"%s\" unknown directive",
+		if (!is_anon_idf(directive))
-							directive->id_text);
+			node_error(nd, "\"%s\" unknown directive", directive->id_text);
 		return;
 	}
 
-	if (df->df_kind == D_FORWARD) {
+	if (df->df_kind == D_FORWARD)
+	{
 		kind = function ? D_FWFUNCTION : D_FWPROCEDURE;
 		inp = (proclevel > 1);
 	}
-	else if (df->df_kind == D_EXTERN) {
+	else if (df->df_kind == D_EXTERN)
+	{
 		kind = function ? D_FUNCTION : D_PROCEDURE;
 		inp = 0;
 		ext = 1;
 	}
-	else {
+	else
-		node_error(nd, "\"%s\" unknown directive",
+	{
-						directive->id_text);
+		node_error(nd, "\"%s\" unknown directive", directive->id_text);
 		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 */
 			node_error(nd, "\"%s\" already forward declared",
-							nd->nd_IDF->id_text);
+					nd->nd_IDF->id_text);
 			return;
 		}
 
 		df->df_type = tp;
 		df->prc_vis = scl;
 		df->prc_name = gen_proc_name(nd->nd_IDF, inp);
-		if( ext ) {
+		if (ext)
+		{
 			if (!(df->df_flags & D_EXTERNAL) && proclevel > 1)
 				tp->prc_nbpar -= pointer_size;
 			/* was added for static link which is not needed now.
-			   But make sure this is done only once (look at the
+			 But make sure this is done only once (look at the
-			   D_EXTERNAL flag).
+			 D_EXTERNAL flag).
-			*/
+			 */
 			df->df_flags |= D_EXTERNAL;
 		}
 		df->df_flags |= D_SET;
 	}
 }
 
-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;
 
-	if( df = define(nd->nd_IDF, CurrentScope, D_PROCEDURE) )	{
+	if ( (df = define(nd->nd_IDF, CurrentScope, D_PROCEDURE)) )
+	{
 		df->df_flags |= D_SET;
-		if( df->df_kind == D_FWPROCEDURE )	{
+		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
 			 * been performed in the forward declaration.
 			 */
 			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->prc_name = gen_proc_name(nd->nd_IDF, (proclevel>1));
+			df->prc_name = gen_proc_name(nd->nd_IDF, (proclevel > 1));
 			/* simulate open_scope() */
 			CurrVis = df->prc_vis = scl;
 		}
 		routine_label(df);
 	}
-	else CurrVis = scl;		/* simulate open_scope() */
+	else
+		CurrVis = scl; /* simulate open_scope() */
 
 	return df;
 }
 
 struct def *
-DeclFunc(nd, tp, scl)
+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;
 
-	if( df = define(nd->nd_IDF, CurrentScope, D_FUNCTION) )	{
+	if ( (df = define(nd->nd_IDF, CurrentScope, D_FUNCTION)) )
-	    df->df_flags &= ~D_SET;
+	{
-	    if( df->df_kind == D_FUNCTION )	{	/* declaration */
+		df->df_flags &= ~D_SET;
-		if( !tp )	{
+		if (df->df_kind == D_FUNCTION)
-			node_error(nd, "\"%s\" illegal function declaration",
+		{ /* declaration */
-							nd->nd_IDF->id_text);
+			if (!tp)
-			tp = construct_type(T_FUNCTION, error_type);
+			{
+				node_error(nd, "\"%s\" illegal function declaration",
+						nd->nd_IDF->id_text);
+				tp = construct_type(T_FUNCTION, error_type);
+			}
+			/* simulate open_scope() */
+			CurrVis = df->prc_vis = scl;
+			df->df_type = tp;
+			df->prc_name = gen_proc_name(nd->nd_IDF, (proclevel > 1));
 		}
-		/* simulate open_scope() */
+		else
-		CurrVis = df->prc_vis = scl;
+		{ /* identification */
-		df->df_type = tp;
+			assert(df->df_kind == D_FWFUNCTION);
-		df->prc_name = gen_proc_name(nd->nd_IDF, (proclevel > 1));
-	    }
-	    else	{			/* identification */
-		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;
 }
 
-EndFunc(df)
+void EndFunc(register struct def *df)
-	register struct def *df;
 {
 	/* assignment to functionname is illegal outside the functionblock */
 	df->prc_res = 0;
@@ -259,47 +261,53 @@ EndFunc(df)
 	/* Give the error about assignment as soon as possible. The
 	 * |= assignment inhibits a warning in the main procedure.
 	 */
-	if( !(df->df_flags & D_SET) ) {
+	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;
 	}
 }
 
-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 *df;
 
-	while( tmp_def ) {
+	while (tmp_def)
-	    df = tmp_def;
+	{
-	    	/* The length of a usd_def chain is at most 1.
+		df = tmp_def;
+		/* The length of a usd_def chain is at most 1.
 		 * The while is just defensive programming.
 		 */
-	    while( df->df_kind & D_INUSE )
+		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))
-			    warning("\"%s\" neither set nor used in \"%s\"",
+				{
-				df->df_idf->id_text, block_df->df_idf->id_text);
+					if (!(df->df_flags & D_SET))
+					{
+						warning("\"%s\" neither set nor used in \"%s\"",
+								df->df_idf->id_text, block_df->df_idf->id_text);
+					}
+					else
+					{
+						warning("\"%s\" unused in \"%s\"", df->df_idf->id_text,
+								block_df->df_idf->id_text);
+					}
+				}
+				else if (!(df->df_flags & D_SET))
+				{
+					if (!(df->df_flags & D_LOOPVAR))
+						warning("\"%s\" not set in \"%s\"", df->df_idf->id_text,
+								block_df->df_idf->id_text);
+				}
 			}
-			else {
+
-			    warning("\"%s\" unused in \"%s\"",
-				df->df_idf->id_text, block_df->df_idf->id_text);
-			}
-		    }
-		    else if( !(df->df_flags & D_SET) ) {
-			if( !(df->df_flags & D_LOOPVAR) )
-			    warning("\"%s\" not set in \"%s\"",
-				df->df_idf->id_text, block_df->df_idf->id_text);
-		    }
 		}
-
+		tmp_def = tmp_def->df_nextinscope;
-	    }
-	    tmp_def = tmp_def->df_nextinscope;
 	}
 }

lang/pc/comp/def.xh

@@ -1,5 +1,8 @@
 /* I D E N T I F I E R   D E S C R I P T O R   S T R U C T U R E */
 
+#ifndef DEF_H_
+#define DEF_H_
+
 struct constant	{
 	struct node *co_const;	/* result of a constant expression */
 #define con_const	df_value.df_constant.co_const
@@ -153,3 +156,20 @@ extern struct def
 	*lookfor();
 
 #define NULLDEF ((struct def *) 0)
+
+
+struct def *MkDef(register struct idf *id, register struct scope *scope,
+		long kind);
+struct def *define(register struct idf *id, register struct scope *scope,
+		long kind);
+void DoDirective(struct idf *directive, struct node *nd, struct type *tp,
+		struct scopelist *scl, int function);
+struct def *DeclProc(register struct node *nd, struct type *tp,
+		register struct scopelist *scl);
+struct def *
+DeclFunc(register struct node *nd, struct type *tp,
+		register struct scopelist *scl);
+void EndFunc(register struct def *df);
+void EndBlock(register struct def *block_df);
+
+#endif

lang/pc/comp/desig.c

@@ -22,16 +22,15 @@
 #include	"node.h"
 #include	"scope.h"
 #include	"type.h"
+#include    "code.h"
+#include    "error.h"
 
 struct desig	InitDesig = {DSG_INIT, 0, 0, NULLDEF, 0};
 struct withdesig *WithDesigs;
 
-void CodeValue();
 
-STATIC int
+
-properly(ds, size, al)
+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
 		by "ds" with LOI/STI.
@@ -55,9 +54,7 @@ properly(ds, size, al)
 		(! 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;
 
@@ -72,11 +69,7 @@ CodeCopy(lhs, rhs, sz, psize)
 	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;
 	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
 		in "ds"
@@ -212,9 +202,7 @@ CodeValue(ds, tp)
 	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
 		described in "ds"
@@ -265,8 +253,7 @@ CodeStore(ds, tp)
 	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
 	   	in "ds"
@@ -316,9 +303,7 @@ CodeAddress(ds)
 	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
 	   address as well as value computation is generated, and the
@@ -369,10 +354,7 @@ CodeFieldDesig(df, ds)
 	ds->dsg_packed = df->fld_flags & F_PACKED;
 }
 
-void
+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.
 		Of course, there are numerous cases: the variable is local,
@@ -436,9 +418,7 @@ CodeVarDesig(df, ds)
 	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 */
 
@@ -464,9 +444,7 @@ CodeBoundDesig(df, ds)
 	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 */
 
@@ -500,9 +478,7 @@ CodeFuncDesig(df, ds)
 	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
 		principle

lang/pc/comp/desig.xh

@@ -1,3 +1,6 @@
+#ifndef DESIG_H_
+#define DESIG_H_
+
 /* D E S I G N A T O R   D E S C R I P T I O N S */
 
 /* Generating code for designators is not particularly easy, especially if
@@ -57,3 +60,32 @@ extern struct withdesig	*WithDesigs;
 extern struct desig	InitDesig;
 
 #define NO_LABEL	((label) 0)
+
+
+
+/* Copies psize bytes from "rhs" to "lhs" */
+void CodeCopy(register struct desig *lhs, register struct desig *rhs, arith sz, arith *psize);
+/* Generate code for an assignment. */
+void CodeMove(register struct desig *rhs, register struct node *left, struct type *rtp);
+/*	Generate code to load the value of the designator described
+	in "ds" onto the operand stack. */
+void CodeValue(register struct desig *ds, register struct type *tp);
+/*	Generate code to store the value on the stack in the designator
+	described in "ds" */
+void CodeStore(register struct desig *ds, register struct type *tp);
+/*	Generate code to load the address of the designator described
+	in "ds" unto the operand stack */
+void CodeAddress(register struct desig *ds);
+/* Generate code for a field designator. */
+void CodeFieldDesig(register struct def *df, register struct desig *ds);
+/*	Generate code for a variable represented by a "def" structure.*/
+void CodeVarDesig(register struct def *df, register struct desig *ds);
+/* Generate code for the lower- and upperbound of a conformant array */
+void CodeBoundDesig(register struct def *df, register struct desig *ds);
+/* generate code to store the function result */
+void CodeFuncDesig(register struct def *df, register struct desig *ds);
+/*	Generate code for a designator. Use divide and conquer
+	principle */
+void CodeDesig(register struct node *nd, register struct desig *ds);
+
+#endif

lang/pc/comp/enter.c

@@ -14,70 +14,79 @@
 #include	"node.h"
 #include	"scope.h"
 #include	"type.h"
+#include    "progs.h"
+#include    "enter.h"
+#ifdef DBSYMTAB
+#include	"stab.h"
+#endif
 
-extern int	proclevel;
+extern int 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
-		"type" in the Current Scope. If it is a standard name, also
+	 "type" in the Current Scope. If it is a standard name, also
-		put its number in the definition structure, and mark the
+	 put its number in the definition structure, and mark the
-		name as set, to inhibit warnings about used before set.
+	 name as set, to inhibit warnings about used before set.
-	*/
+	 */
 	register struct def *df;
 
 	df = define(str2idf(name, 0), CurrentScope, kind);
 	df->df_type = type;
-	if( pnam ) {
+	if (pnam)
+	{
 		df->df_value.df_reqname = pnam;
 		df->df_flags |= D_SET;
 	}
 #ifdef DBSYMTAB
-	else if (options['g']) stb_string(df, kind);
+	else if (options['g'])
+		stb_string(df, kind);
 #endif /*  DBSYMTAB */
 	return df;
 }
 
-EnterProgList(Idlist)
+void EnterProgList(register struct node *Idlist)
-	register struct node *Idlist;
 {
 	register struct node *idlist = Idlist;
 	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- 
 			 * parameter is their declaration as a GLOBAL
 			 *  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_flags |= (D_SET | D_PROGPAR | D_NOREG);
-				if( !strcmp(input, idlist->nd_IDF->id_text) ) {
+				if (!strcmp(input, idlist->nd_IDF->id_text))
+				{
 					df->var_name = input;
 					set_inp();
 				}
-				else {
+				else
+				{
 					df->var_name = output;
 					set_outp();
 				}
 #ifdef DBSYMTAB
-				if (options['g']) stb_string(df, D_VARIABLE);
+				if (options['g'])
+					stb_string(df, D_VARIABLE);
 #endif /*  DBSYMTAB */
 			}
 		}
-		else	{
+		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_flags |= D_PROGPAR;
 				df->var_name = idlist->nd_IDF->id_text;
@@ -87,53 +96,53 @@ EnterProgList(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.
-		They all have type "type". Also assign numbers to them.
+	 They all have type "type". Also assign numbers to them.
-	*/
+	 */
 	register struct def *df, *df1 = 0;
 	register struct node *idlist = Idlist;
 
 	type->enm_ncst = 0;
-	for( ; idlist; idlist = idlist->nd_next )
+	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->enm_val = (type->enm_ncst)++;
 			df->df_flags |= D_SET;
-			if (! df1) {
+			if (!df1)
+			{
 				type->enm_enums = df;
 			}
-			else	df1->enm_next = df;
+			else
+				df1->enm_next = df;
 			df1 = df;
 		}
 	FreeNode(Idlist);
 }
 
-EnterFieldList(Idlist, type, scope, addr, packed)
+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.
-		They all have type "type", and are put in scope "scope".
+	 They all have type "type", and are put in scope "scope".
-	*/
+	 */
 	register struct def *df;
 	register struct node *idlist = Idlist;
 
-	for( ; idlist; idlist = idlist->nd_next )
+	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;
-			if( packed )	{
+			if (packed)
+			{
 				df->fld_flags |= F_PACKED;
 				df->fld_off = align(*addr, type->tp_palign);
 				*addr = df->fld_off + type->tp_psize;
 			}
-			else	{
+			else
+			{
 				df->fld_off = align(*addr, type->tp_align);
 				*addr = df->fld_off + type->tp_size;
 			}
@@ -141,24 +150,24 @@ EnterFieldList(Idlist, type, scope, addr, packed)
 	FreeNode(Idlist);
 }
 
-EnterVarList(Idlist, type, local)
+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
-		name list. "type" represents the type of the variables.
+	 name list. "type" represents the type of the variables.
-		"local" is set if the variables are declared local to a
+	 "local" is set if the variables are declared local to a
-		procedure.
+	 procedure.
-	*/
+	 */
 	register struct def *df;
 	register struct node *idlist = Idlist;
 	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)) )
+	{
-			continue;	/* skip this identifier */
+		if (!(df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE)))
+			continue; /* skip this identifier */
 		df->df_type = type;
-		if( local )	{
+		if (local)
+		{
 			/* subtract size, which is already aligned, of
 			 * variable to the offset, as the variable list
 			 * exists only local to a procedure
@@ -166,74 +175,52 @@ EnterVarList(Idlist, type, local)
 			sc->sc_scope->sc_off -= type->tp_size;
 			df->var_off = sc->sc_scope->sc_off;
 		}
-		else	{ /* Global name */
+		else
+		{ /* Global name */
 			df->var_name = df->df_idf->id_text;
 			df->df_flags |= D_NOREG;
 		}
 #ifdef DBSYMTAB
-		if (options['g']) stb_string(df, D_VARIABLE);
+		if (options['g'])
+			stb_string(df, D_VARIABLE);
 #endif /*  DBSYMTAB */
 	}
 	FreeNode(Idlist);
 }
 
-arith
+
-EnterParamList(fpl, parlist)
+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 struct node *id;
 	struct type *tp;
 	struct def *df;
 
-	for( ; fpl; fpl = fpl->nd_right )	{
+	for (; fpl; fpl = fpl->nd_right)
+	{
 		assert(fpl->nd_class == Link);
 
 		tp = fpl->nd_type;
-		for( id = fpl->nd_left; id; id = id->nd_next )
+		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;
+			{
-			if( fpl->nd_INT & D_VARPAR || IsConformantArray(tp) )
+				df->var_off = nb_pars;
-				nb_pars += pointer_size;
+				if (fpl->nd_INT & D_VARPAR || IsConformantArray(tp))
-			else
-				nb_pars += tp->tp_size;
-			LinkParam(parlist, df);
-			df->df_type = tp;
-			df->df_flags |= fpl->nd_INT;
-		    }
-
-		while( IsConformantArray(tp) )	{
-			/* we need room for the descriptors */
-
-			tp->arr_sclevel = CurrentScope->sc_level;
-			tp->arr_cfdescr = nb_pars;
-			nb_pars += 3 * word_size;
-			tp = tp->arr_elem;
-    		}
-	}
-	return nb_pars;
-}
-
-arith
-EnterParTypes(fpl, parlist)
-	register struct node *fpl;
-	struct paramlist **parlist;
-{
-	/* parameters.h in heading of procedural and functional
-	   parameters (only types are important, not the names).
-	*/
-	register arith nb_pars = 0;
-	register struct node *id;
-	struct type *tp;
-	struct def *df;
-
-	for( ; fpl; fpl = fpl->nd_right ) {
-		tp = fpl->nd_type;
-		for( id = fpl->nd_left; id; id = id->nd_next )
-			if( df = new_def() )	{
-				if( fpl->nd_INT & D_VARPAR ||
-				    IsConformantArray(tp) )
 					nb_pars += pointer_size;
 				else
 					nb_pars += tp->tp_size;
@@ -241,7 +228,13 @@ EnterParTypes(fpl, parlist)
 				df->df_type = tp;
 				df->df_flags |= fpl->nd_INT;
 			}
-		while( IsConformantArray(tp) ) {
+
+		while (IsConformantArray(tp))
+		{
+			/* we need room for the descriptors */
+
+			tp->arr_sclevel = CurrentScope->sc_level;
+			tp->arr_cfdescr = nb_pars;
 			nb_pars += 3 * word_size;
 			tp = tp->arr_elem;
 		}
@@ -249,17 +242,36 @@ EnterParTypes(fpl, parlist)
 	return nb_pars;
 }
 
-LinkParam(parlist, df)
+arith EnterParTypes(register struct node *fpl, struct paramlist **parlist)
-	struct paramlist **parlist;
-	struct def *df;
 {
-	static struct paramlist *pr;
+	/* parameters.h in heading of procedural and functional
+	 parameters (only types are important, not the names).
+	 */
+	register arith nb_pars = 0;
+	register struct node *id;
+	struct type *tp;
+	struct def *df;
 
-	if( !*parlist )
+	for (; fpl; fpl = fpl->nd_right)
-		*parlist = pr = new_paramlist();
+	{
-	else	{
+		tp = fpl->nd_type;
-		pr->next = new_paramlist();
+		for (id = fpl->nd_left; id; id = id->nd_next)
-		pr = pr->next;
+			if ( (df = new_def()) )
+			{
+				if (fpl->nd_INT & D_VARPAR || IsConformantArray(tp))
+					nb_pars += pointer_size;
+				else
+					nb_pars += tp->tp_size;
+				LinkParam(parlist, df);
+				df->df_type = tp;
+				df->df_flags |= fpl->nd_INT;
+			}
+		while (IsConformantArray(tp))
+		{
+			nb_pars += 3 * word_size;
+			tp = tp->arr_elem;
+		}
 	}
-	pr->par_def = df;
+	return nb_pars;
 }
+

lang/pc/comp/enter.h

@@ -0,0 +1,26 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef ENTER_H_
+#define ENTER_H_
+
+#include "em_arith.h"
+
+/* Forward structure declarations. */
+struct type;
+struct node;
+struct paramlist;
+
+
+struct def *Enter(char *name, long kind, register struct type *type, int pnam);
+void EnterProgList(register struct node *Idlist);
+void EnterEnumList(struct node *Idlist, register struct type *type);
+void EnterFieldList(struct node *Idlist, register struct type *type,
+		struct scope *scope, arith *addr, unsigned short packed);
+void EnterVarList(struct node *Idlist, struct type *type, int local);
+arith EnterParamList(register struct node *fpl, struct paramlist **parlist);
+arith EnterParTypes(register struct node *fpl, struct paramlist **parlist);
+
+#endif /* ENTER_H_ */

lang/pc/comp/error.c

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

lang/pc/comp/error.h

@@ -0,0 +1,25 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef ERROR_H_
+#define ERROR_H_
+
+/* Forward struct declarations */
+struct node;
+
+#ifdef DEBUG
+void debug(char *fmt, ...);
+#endif /* DEBUG */
+
+void error(char *fmt, ...);
+void node_error(struct node *node, char *fmt, ...);
+void warning(char *fmt, ...);
+void node_warning(struct node *node, char *fmt, ...);
+void lexerror(char *fmt, ...);
+void lexwarning(char *fmt, ...);
+void fatal(char *fmt, ...);
+void crash(char *fmt, ...);
+
+#endif /* ERROR_H_ */

lang/pc/comp/expression.g

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

lang/pc/comp/idf.h

@@ -1,4 +1,6 @@
 /* U S E R   D E C L A R E D   P A R T   O F   I D F */
+#ifndef IDF_H_
+#define IDF_H_
 
 struct id_u {
 	int id_res;
@@ -10,3 +12,5 @@ struct id_u {
 #define id_def		id_user.id_df
 
 #include	<idf_pkg.spec>
+
+#endif

lang/pc/comp/input.c

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

lang/pc/comp/label.c

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

lang/pc/comp/label.h

@@ -0,0 +1,17 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef LABEL_H_
+#define LABEL_H_
+
+struct node;
+
+void DeclLabel(struct node *nd);
+void chk_labels(int Slevel);
+void TstLabel(register struct node *nd, int Slevel);
+void DefLabel(register struct node *nd, int Slevel);
+
+
+#endif /* LABEL_H_ */

lang/pc/comp/lookup.c

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

lang/pc/comp/lookup.h

@@ -0,0 +1,29 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef LOOKUP_H_
+#define LOOKUP_H_
+
+struct def;
+struct idf;
+struct scope;
+struct node;
+
+void remove_def(register struct def *df);
+
+/*	Look up a definition of an identifier in scope "scope".
+	Make the "def" list self-organizing.
+	Return a pointer to its "def" structure if it exists,
+	otherwise return NULL.
+*/
+struct def *lookup(register struct idf *id, struct scope *scope, long inuse);
+
+/*	Look for an identifier in the visibility range started by "vis".
+	If it is not defined create a dummy definition and
+	if give_error is set, give an error message.
+*/
+struct def *lookfor(register struct node *id, struct scopelist *vis, int give_error);
+
+#endif /* LOOKUP_H_ */

lang/pc/comp/main.c

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

lang/pc/comp/misc.c

@@ -12,25 +12,23 @@
 #include	"main.h"
 #include	"misc.h"
 #include	"node.h"
+#include    "print.h"
+#include    "error.h"
 
-struct idf *
+struct idf *gen_anon_idf(void)
-gen_anon_idf()
 {
 	/*	A new idf is created out of nowhere, to serve as an
 		anonymous name.
 	*/
 	static int name_cnt;
 	char *s = Malloc(strlen(FileName) + 50);
-	char *sprint();
 
 	sprint(s, "#%d in %s, line %u", ++name_cnt, FileName, LineNumber);
 	s = Realloc(s, strlen(s)+1);
 	return str2idf(s, 0);
 }
 
-not_declared(what, id, where)
+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,
 		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 */
 
 	static int name_cnt;
 	static char buf[256];
-	char *sprint(), *Salloc();
+
 
 	if( inp )	{
 		sprint(buf, "_%d%s", ++name_cnt, id->id_text);

lang/pc/comp/misc.h

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

lang/pc/comp/next.in

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

lang/pc/comp/node.c

@@ -6,16 +6,14 @@
 #include	<alloc.h>
 #include	<em_arith.h>
 #include	<em_label.h>
-#include	<system.h>
+#include    "print.h"
 
 #include	"LLlex.h"
 #include	"node.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
 	*/
@@ -29,9 +27,7 @@ MkNode(class, left, right, token)
 	return nd;
 }
 
-struct node *
+struct node *MkLeaf(int class, struct token *token)
-MkLeaf(class, token)
-	struct token *token;
 {
 	register struct node *nd = new_node();
 
@@ -42,9 +38,7 @@ MkLeaf(class, token)
 	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
 	*/
@@ -54,8 +48,7 @@ FreeNode(nd)
 	free_node(nd);
 }
 
-NodeCrash(expp)
+int NodeCrash(struct node *expp)
-	struct node *expp;
 {
 	crash("Illegal node %d", expp->nd_class);
 }
@@ -64,14 +57,13 @@ NodeCrash(expp)
 
 extern char *symbol2str();
 
-indnt(lvl)
+void indnt(int lvl)
 {
 	while( lvl-- )
 		print("  ");
 }
 
-printnode(nd, lvl)
+void printnode(register struct node *nd, int lvl)
-	register struct node *nd;
 {
 	indnt(lvl);
 	print("Class: %d; Symbol: %s\n", nd->nd_class, symbol2str(nd->nd_symb));
@@ -83,8 +75,7 @@ printnode(nd, lvl)
 	}
 }
 
-PrNode(nd, lvl)
+void PrNode(register struct node *nd, int lvl)
-	register struct node *nd;
 {
 	if( !nd )	{
 		indnt(lvl); print("<nilnode>\n");

lang/pc/comp/node.xh

@@ -1,4 +1,7 @@
 /* N O D E   O F   A N   A B S T R A C T   P A R S E T R E E */
+#ifndef NODE_H_
+#define NODE_H_
+
 
 struct node {
 	struct node *nd_left;
@@ -37,12 +40,22 @@ struct node {
 #define nd_REL		nd_token.TOK_REL
 #define nd_RLA		nd_token.TOK_RLA
 #define nd_RIV		nd_token.TOK_RIV
+
+
+
 };
 
 /* ALLOCDEF "node" 50 */
 
-extern struct node *MkNode(), *MkLeaf(), *ChkStdInOut();
+struct node *MkNode(int class, struct node *left, struct node *right, struct token *token);
+struct node *MkLeaf(int class, struct token *token);
+void FreeNode(register struct node *nd);
+int NodeCrash(struct node *expp);
+
+
 
 #define IsProcCall(lnd)	((lnd)->nd_type->tp_fund & T_ROUTINE)
 
 #define	NULLNODE ((struct node *) 0)
+
+#endif

lang/pc/comp/options.c

@@ -7,7 +7,12 @@
 #include	"class.h"
 #include	"const.h"
 #include	"main.h"
+#include    "LLlex.h"
+#include    "node.h"
 #include	"type.h"
+#include    "options.h"
+#include    "error.h"
+
 
 #define	MINIDFSIZE	9
 
@@ -18,13 +23,28 @@ recognize some keywords!
 
 extern int	idfsize;
 
-DoOption(text)
+
-	register char *text;
+static int txt2int(register char **tp)
+{
+	/*	the integer pointed to by *tp is read, while increasing
+		*tp; the resulting value is yielded.
+	*/
+	register int val = 0;
+	register int ch;
+
+	while( ch = **tp, ch >= '0' && ch <= '9' )	{
+		val = val * 10 + ch - '0';
+		(*tp)++;
+	}
+	return val;
+}
+
+void DoOption(register char *text)
 {
 	switch( *text++ )	{
 
 	default:
-		options[text[-1]]++;	/* flags, debug options etc.	*/
+		options[(int)text[-1]]++;	/* flags, debug options etc.	*/
 		break;
 				/* recognized flags:
 					-i: largest value of set of integer
@@ -74,11 +94,11 @@ DoOption(text)
 		break;
 	}
 
-	/* case 'u':			/* underscore allowed in identifiers */
+	/* case 'u':			*//* underscore allowed in identifiers */
-		/* class('_') = STIDF;
+		/* class('_') = STIDF;*/
-		/* inidf['_'] = 1;
+		/* inidf['_'] = 1;*/
-		/* break;
+		/* break;*/
-		*/
+
 
 	case 'V' :	{ /* set object sizes and alignment requirements */
 			  /* syntax : -V[ [w|i|l|f|p] size? [.alignment]? ]* */
@@ -87,7 +107,7 @@ DoOption(text)
 		register int align;
 		char c, *t;
 
-		while( c = *text++ )	{
+		while( (c = *text++) !=0 )	{
 			char *strchr();
 
 			t = text;
@@ -150,19 +170,4 @@ DoOption(text)
 	}
 }
 
-int
-txt2int(tp)
-	register char **tp;
-{
-	/*	the integer pointed to by *tp is read, while increasing
-		*tp; the resulting value is yielded.
-	*/
-	register int val = 0;
-	register int ch;
 
-	while( ch = **tp, ch >= '0' && ch <= '9' )	{
-		val = val * 10 + ch - '0';
-		(*tp)++;
-	}
-	return val;
-}

lang/pc/comp/options.h

@@ -0,0 +1,12 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef OPTIONS_H_
+#define OPTIONS_H_
+
+/* Parse command line options */
+void DoOption(register char *text);
+
+#endif /* OPTIONS_H_ */

lang/pc/comp/program.g

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

lang/pc/comp/progs.c

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

lang/pc/comp/progs.h

@@ -0,0 +1,15 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory, 
+ *  in the file "Copyright".
+ *
+ *  Created on: 2019-02-23
+ *  
+ */
+#ifndef PROGS_H_
+#define PROGS_H_
+
+void set_inp(void);
+void set_outp(void);
+void make_extfl(void);
+
+#endif /* PROGS_H_ */

lang/pc/comp/readwrite.c

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

lang/pc/comp/readwrite.h

@@ -0,0 +1,18 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef READWRITE_H_
+#define READWRITE_H_
+
+/* Forward structure declarations */
+struct node;
+
+struct node *ChkStdInOut(char *name, int st_out);
+void ChkRead(register struct node *arg);
+void ChkReadln(register struct node *arg);
+void ChkWrite(register struct node *arg);
+void ChkWriteln(register struct node *arg);
+
+#endif /* READWRITE_H_ */

lang/pc/comp/scope.c

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

lang/pc/comp/scope.xh

@@ -1,4 +1,6 @@
 /* S C O P E   M E C H A N I S M */
+#ifndef SCOPE_H_
+#define SCOPE_H_
 
 struct scope {
 	struct scope *next;
@@ -30,3 +32,14 @@ extern struct scopelist
 
 #define	CurrentScope	(CurrVis->sc_scope)
 #define	nextvisible(x)	((x)->next)		/* use with scopelists */
+
+
+void InitScope(void);
+void open_scope(void);
+void close_scope(int doclean);
+void Forward(register struct node *nd, register struct type *tp);
+void chk_prog_params(void);
+void chk_directives(void);
+
+
+#endif

lang/pc/comp/stab.c

@@ -40,8 +40,7 @@ static struct db_str {
 	char		*currpos;
 } db_str;
 
-static
+static void create_db_str(void)
-create_db_str()
 {
 	if (! db_str.base) {
 		db_str.base = Malloc(INCR_SIZE);
@@ -50,9 +49,7 @@ create_db_str()
 	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;
 	if (df >= db_str.sz-1) {
@@ -64,16 +61,12 @@ addc_db_str(c)
 	*db_str.currpos = '\0';
 }
 
-static
+static void adds_db_str(char *s)
-adds_db_str(s)
-	char	*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];
 	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();
 	adds_db_str(s);
@@ -247,10 +238,7 @@ stb_addtp(s, tp)
 		     (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;
 	char buf[64];

lang/pc/comp/stab.h

@@ -0,0 +1,17 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory, 
+ *  in the file "Copyright".
+ *
+ *  Created on: 2019-02-22
+ *  
+ */
+#ifndef STAB_H_
+#define STAB_H_
+
+struct def;
+struct type;
+
+void stb_string(register struct def *df, long kind);
+void stb_addtp(char *s, struct type *tp);
+
+#endif /* STAB_H_ */

lang/pc/comp/statement.g

@@ -17,6 +17,13 @@
 #include	"node.h"
 #include	"scope.h"
 #include	"type.h"
+#include    "body.h"
+#include    "code.h"
+#include    "error.h"
+#include    "readwrite.h"
+#include    "casestat.h"
+#include    "tmpvar.h"
+#include    "label.h"
 
 int slevel = 0;		/* nesting level of statements */
 }

lang/pc/comp/tmpvar.h

@@ -0,0 +1,23 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef TMPVAR_H_
+#define TMPVAR_H_
+
+#include "em_arith.h"
+
+
+struct scope;
+
+void TmpOpen(struct scope *sc);
+arith TmpSpace(arith sz, int al);
+arith NewInt(int reg_prior);
+arith NewPtr(int reg_prior);
+void FreeInt(arith off);
+void FreePtr(arith off);
+void TmpClose(void);
+
+
+#endif /* TMPVAR_H_ */

lang/pc/comp/tmpvar.xc

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

lang/pc/comp/tokenname.c

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

lang/pc/comp/tokenname.h

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

lang/pc/comp/type.c

@@ -11,12 +11,19 @@
 
 #include	"LLlex.h"
 #include	"const.h"
+#include    "chk_expr.h"
 #include	"def.h"
 #include	"idf.h"
 #include	"main.h"
 #include	"node.h"
 #include	"scope.h"
+#include    "lookup.h"
 #include	"type.h"
+#include    "typequiv.h"
+#include    "error.h"
+#ifdef DBSYMTAB
+#include	"stab.h"
+#endif
 
 #ifndef NOCROSS
 int
@@ -51,9 +58,15 @@ struct type
 	*void_type,
 	*error_type;
 
-void ArraySizes();
 
-CheckTypeSizes()
+/* Local forward declarations */
+static arith ArrayElSize(register struct type *, int);
+static void FreeForward(register struct forwtype *);
+static int gcd(int, int);
+
+
+
+static void CheckTypeSizes(void)
 {
 	/* first, do some checking
 	*/
@@ -75,7 +88,7 @@ CheckTypeSizes()
 		fatal("illegal realsize");
 }
 
-InitTypes()
+void InitTypes(void)
 {
 	/* First check the sizes of some basic EM-types
 	*/
@@ -144,16 +157,12 @@ InitTypes()
 	emptyset_type->tp_align = word_align;
 }
 
-int
+static int fit(arith sz, int nbytes)
-fit(sz, nbytes)
-        arith sz;
 {
 	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();
 
@@ -166,9 +175,7 @@ standard_type(fund, algn, size)
 	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.
 	 *	The pointer to the constructed type is returned.
@@ -212,10 +219,7 @@ construct_type(fund, tp)
 	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);
 
@@ -224,11 +228,7 @@ proc_type(parameters, n_bytes_params)
 	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);
 
@@ -237,9 +237,7 @@ func_type(parameters, n_bytes_params, resulttype)
 	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;
 
@@ -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
 		indicated by "lb" and "ub", but first perform some checks
@@ -322,9 +318,7 @@ subr_type(lb, ub)
 	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
 	*/
@@ -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
 		perform some checks
@@ -415,9 +406,7 @@ set_type(tp, packed)
 	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.
 	   Also make sure that its size is either a dividor of the word_size,
@@ -444,9 +433,7 @@ ArrayElSize(tp, packed)
 	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
 	*/
@@ -492,9 +479,7 @@ ArraySizes(tp)
 	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;
 
@@ -503,7 +488,7 @@ FreeForward(for_type)
 	free_forwtype(for_type);
 }
 
-chk_forw_types()
+void chk_forw_types(void)
 {
 	/* check all forward references (in pointer types) */
 
@@ -574,9 +559,8 @@ chk_forw_types()
 	}
 }
 
-TstCaseConstants(nd, sel, sel1)
+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
 	   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;
 
 	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
  	*/
@@ -625,9 +604,7 @@ gcd(m, n)
 	return m;
 }
 
-int
+int lcm(int m, int n)
-lcm(m, n)
-	int m, n;
 {
 	/*	Least Common Multiple
  	*/
@@ -635,8 +612,7 @@ lcm(m, n)
 }
 
 #ifdef DEBUG
-DumpType(tp)
+void DumpType(register struct type *tp)
-	register struct type *tp;
 {
 	if( !tp ) return;
 

lang/pc/comp/type.xh

@@ -1,4 +1,8 @@
 /* T Y P E   D E S C R I P T O R   S T R U C T U R E */
+#ifndef TYPE_H_
+#define TYPE_H_
+
+
 
 struct paramlist {		/* structure for parameterlist of a PROCEDURE */
 	struct paramlist *next;
@@ -160,16 +164,6 @@ extern arith
 	real_size;		/* All from type.c */
 #endif /* NOCROSS */
 
-extern arith
-	align();
-
-struct type
-	*construct_type(),
-	*standard_type(),
-	*proc_type(),
-	*func_type(),
-	*set_type(),
-	*subr_type();		/* All from type.c */
 
 #define NULLTYPE ((struct type *) 0)
 
@@ -192,3 +186,45 @@ struct type
 extern long full_mask[];
 
 #define ufit(n, i)	(((n) & ~full_mask[(i)]) == 0)
+
+struct node;
+
+/* Initialize internal types */
+void InitTypes(void);
+/* Construct a standard type with specified size in bytes
+   and specified alignment. */
+struct type *standard_type(int fund, int algn, arith size);
+/* Construct a user defined type. */
+struct type *construct_type(int fund, register struct type *tp);
+/* Constructs a new procedure type with the specified parameters. */
+struct type *proc_type(struct paramlist *parameters, arith n_bytes_params);
+/* Constructs a new function type with the specified parameters and result type. */
+struct type *func_type(struct paramlist * parameters, arith n_bytes_params, struct type *resulttype);
+void chk_type_id(register struct type **ptp, register struct node *nd);
+/* Construct a new subrange type from a lower bound "lb" to an upper bound "ub" */
+struct type *subr_type(register struct node *lb, register struct node *ub);
+/* Return the bounds of the specified type "tp", assert if this is not a bounded type. */
+void getbounds(register struct type *tp, arith *plo, arith *phi);
+/* Construct a new set type. */
+struct type *set_type(register struct type *tp, unsigned short packed);
+/* Assign sizes to an array type, and check index type and generate array descriptor */
+void ArraySizes(register struct type *tp);
+/* Check all forward declaration */
+void chk_forw_types(void);
+/* Insert selector of nested variant (sel1) in tagvalue-table of
+   current selector (sel).
+*/
+void TstCaseConstants(register struct node *nd, register struct selector *sel,
+		register struct selector *sel1);
+/* Return the "pos" aligned to "al". */
+arith align(arith pos, int al);
+/* Print type information for "tp". */
+void DumpType(register struct type *tp);
+/* Least Common Multiple */
+int lcm(int m, int n);
+
+
+
+
+
+#endif

lang/pc/comp/typequiv.c

@@ -14,20 +14,17 @@
 #include	"def.h"
 #include	"node.h"
 #include	"type.h"
+#include    "error.h"
+#include    "typequiv.h"
 
-
+int TstTypeEquiv(register struct type *tp1, register struct type *tp2)
-int
-TstTypeEquiv(tp1, tp2)
-	register struct type *tp1, *tp2;
 {
 	/*	test if two types are equivalent.
 	*/
 	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 */
 	if( tp->tp_fund & T_STRINGCONST ) return tp->tp_psize;
@@ -45,9 +42,7 @@ IsString(tp)
 	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.
 	*/
@@ -62,9 +57,7 @@ TstStrCompat(tp1, tp2)
 		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
 	*/
@@ -110,9 +103,7 @@ TstCompat(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
 	*/
@@ -128,9 +119,7 @@ TstAssCompat(tp1, tp2)
 	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
 	*/
@@ -150,18 +139,16 @@ TstParEquiv(tp1, tp2)
 		||
 		   (
 		     (
-		      tp1->tp_fund == T_PROCEDURE && tp2->tp_fund == T_PROCEDURE
+		      (tp1->tp_fund == T_PROCEDURE && tp2->tp_fund == T_PROCEDURE)
 		     ||
-		      tp1->tp_fund == T_FUNCTION && tp2->tp_fund == T_FUNCTION
+		      (tp1->tp_fund == T_FUNCTION && tp2->tp_fund == T_FUNCTION)
 		     )
 		   &&
 		     TstProcEquiv(tp1, tp2)
 		   );
 }
 
-int
+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
 	*/
@@ -190,10 +177,8 @@ TstProcEquiv(tp1, tp2)
 	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.
 	*/
@@ -231,9 +216,7 @@ TstParCompat(formaltype, actualtype, VARflag, nd, new_par_section)
 	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.
 		

lang/pc/comp/typequiv.h

@@ -0,0 +1,42 @@
+/*  Copyright (c) 2019 ACK Project.
+ *  See the copyright notice in the ACK home directory,
+ *  in the file "Copyright".
+ *
+ */
+#ifndef TYPEQUIV_H_
+#define TYPEQUIV_H_
+
+#include	"em_arith.h"
+
+
+struct type;
+struct node;
+
+/*	test if two types are equivalent. */
+int TstTypeEquiv(register struct type *tp1, register struct type *tp2);
+arith IsString(register struct type *tp);
+/*	test if two types are compatible string-types. */
+int TstStrCompat(register struct type *tp1, register struct type *tp2);
+/*	test if two types are compatible. ISO 6.4.5 */
+int TstCompat(register struct type *tp1,register struct type *tp2);
+/*	test if two types are assignment compatible. ISO 6.4.6 */
+int TstAssCompat(register struct type *tp1,register struct type *tp2);
+/*	Test if two parameter types are equivalent.  ISO 6.6.3.6 */
+int TstParEquiv(register struct type *tp1, register struct type *tp2);
+/*	Test if two procedure types are equivalent. ISO 6.6.3.6 */
+int TstProcEquiv(register struct type *tp1, register struct type *tp2);
+/*	Check type compatibility for a parameter in a procedure call. */
+int TstParCompat(register struct type *formaltype, register struct type *actualtype,
+	int VARflag, struct node *nd, int new_par_section);
+/*	Check conformability.
+
+	DEVIATION FROM STANDARD (ISO 6.6.3.7.2):
+	Allow with value parameters also conformant arrays as actual
+	type.(ISO only with var. parameters)
+
+	Do as much checking on indextypes as possible.
+*/
+int TstConform(register struct type *formaltype, register struct type * actualtype, int new_par_section);
+
+
+#endif /* TYPEQUIV_H_ */