/* Copyright (c) 1979 Regents of the University of California */
static char sccsid
[] = "@(#)fhdr.c 1.3 6/1/81";
* this array keeps the pxp counters associated with
* functions and procedures, so that they can be output
* when their bodies are encountered
* prog/proc/func into the
* namelist. It also handles
* the arguments and puts out
* a transfer which defines
* the entry point of a procedure.
yyretrieve(); /* kludge */
if (r
[3] == NIL
&& (p
=lookup1(r
[2])) != NIL
&& bn
== cbn
) {
* in this block. it is either
* a redeclared symbol (error)
* or an external declaration.
if ((p
->class == FUNC
|| p
->class == PROC
) && (p
->nl_flags
& NFORWD
) != 0) {
if (p
->class == FUNC
&& r
[4])
error("Function type should be given only in forward declaration");
* get another counter for the actual
bodycnts
[ cbn
] = getcnt();
enclosing
[ cbn
] = p
-> symbol
;
* mark this proc/func as forward
pDEF( p
-> inTree
).PorFForward
= TRUE
;
/* if a routine segment is being compiled,
* do level one processing.
if ((r
[0] != T_PROG
) && (!progseen
))
* Declare the prog/proc/func
program
= p
= defnl(r
[2], PROG
, 0, 0);
error("Procedures do not have types, only functions do");
p
= enter(defnl(r
[2], PROC
, 0, 0));
p
-> extra_flags
|= NGLOBAL
;
error("Function type must be specified");
else if (il
[0] != T_TYID
) {
error("Function type can be specified only by using a type identifier");
p
= enter(defnl(r
[2], FUNC
, il
, NIL
));
* An arbitrary restriction
switch (o
= classify(p
->type
)) {
error("Functions should not return %ss", clnames
[o
]);
p
-> extra_flags
|= NGLOBAL
;
error("Procedure/function nesting too deep");
* For functions, the function variable
cp
= defnl(r
[2], FVAR
, p
->type
, 0);
* fvars used to be allocated and deallocated
* by the caller right before the arguments.
* the offset of the fvar was kept in
* value[NL_OFFS] of function (very wierd,
* now, they are locals to the function
* with the offset kept in the fvar.
cp
= defnl(r
[2], FVAR
, p
->type
,
(int)(DPOFF1
+lwidth(p
->type
)),
cp
-> extra_flags
|= NLOCAL
;
p
->value
[NL_OFFS
] = params(p
, r
[3]);
* because NL_LINENO field in the function
* namelist entry has been used (as have all
* the other fields), the line number is
* stored in the NL_LINENO field of its fvar.
p
->ptr
[NL_FVAR
]->value
[NL_LINENO
] = r
[1];
p
->value
[NL_LINENO
] = r
[1];
cntpatch
= put(2, O_CASE4
, (long)0);
nfppatch
= put(2, O_CASE4
, (long)0);
for (rl
= r
[3]; rl
; rl
= rl
[2]) {
dp
= defnl(rl
[1], VAR
, 0, 0);
bodycnts
[ cbn
] = getcnt();
put(2, O_TRA4
, (long)p
->entloc
);
pPointer PF
= tCopy( r
);
pSeize( PorFHeader
[ nesting
] );
PFs
= &( pDEF( PorFHeader
[ nesting
] ).PorFPFs
);
*PFs
= ListAppend( *PFs
, PF
);
pDEF( PorFHeader
[ nesting
] ).GlobProg
= PF
;
pRelease( PorFHeader
[ nesting
] );
* deal with the parameter declaration for a routine.
* p is the namelist entry of the routine.
* formalist is the parse tree for the parameter declaration.
* [1] pointer to a formal
* [2] pointer to next formal
* for by-value or by-reference formals, the formal is
* formal [0] T_PVAL or T_PVAR
* [2] pointer to type (error if not typeid)
* for function and procedure formals, the formal is
* formal [0] T_PFUNC or T_PPROC
* [1] pointer to id_list (error if more than one)
* [2] pointer to type (error if not typeid, or proc)
* [3] pointer to formalist for this routine.
p
-> value
[ NL_LINENO
] = formal
[4];
p
-> ptr
[ NL_FCHAIN
] = p
-> chain
;
struct nl
*chainp
, *savedp
;
register int **formalp
; /* an element of the formal list */
register int *formal
; /* a formal */
* parameters used to be allocated backwards,
* then fixed. for pc, they are allocated correctly.
* also, they are aligned.
for (formalp
= formalist
; formalp
!= NIL
; formalp
= formalp
[2]) {
if ( formal
[0] != T_PPROC
) {
error("Types must be specified for arguments");
if ( formal
[0] == T_PPROC
) {
error("Procedures cannot have types");
error("Types for arguments can be specified only by using type identifiers");
for (idlist
= formal
[1]; idlist
!= NIL
; idlist
= idlist
[2]) {
error("Files cannot be passed by value");
else if (p
->nl_flags
& NFILES
)
error("Files cannot be a component of %ss passed by value",
dp
= defnl(idlist
[1], VAR
, p
, o
);
dp
= defnl(idlist
[1], VAR
, p
,
dp
= defnl( idlist
[1] , VAR
, p
, o
= roundup( o
, (long)A_STACK
) );
dp
= defnl(idlist
[1], REF
, p
, o
-= sizeof ( int * ) );
dp
= defnl( idlist
[1] , REF
, p
, o
= roundup( o
, (long)A_STACK
) );
error("Each function argument must be declared separately");
dp
= defnl(idlist
[1], FFUNC
, p
, o
-= sizeof ( int * ) );
dp
= defnl( idlist
[1] , FFUNC
, p
, o
= roundup( o
, (long)A_STACK
) );
error("Each procedure argument must be declared separately");
dp
= defnl(idlist
[1], FPROC
, p
, o
-= sizeof ( int * ) );
dp
= defnl( idlist
[1] , FPROC
, p
, o
= roundup( o
, (long)A_STACK
) );
dp
-> extra_flags
|= NPARAM
;
* Correct the naivete (naivety)
for (dp
= p
->chain
; dp
!= NIL
; dp
= dp
->chain
)
dp
->value
[NL_OFFS
] += -o
+ DPOFF2
;
return roundup( o
, (long)A_STACK
);