/* Copyright (c) 1979 Regents of the University of California */
static char sccsid
[] = "@(#)fdec.c 1.7 10/28/80";
* 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));
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
]);
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
, -( roundup( DPOFF1
+width( p
-> type
)
, align( p
-> type
) ) ) );
* parameters used to be allocated backwards,
* then fixed. for pc, they are allocated correctly.
* also, they are aligned.
for (rl
= r
[3]; rl
!= NIL
; rl
= rl
[2]) {
if (rl
[1][0] != T_PPROC
) {
error("Types for arguments can be specified only by using type identifiers");
for (il
= rl
[1][1]; il
!= NIL
; il
= il
[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(il
[1], VAR
, p
, o
-= even(width(p
)));
dp
= defnl( il
[1] , VAR
, p
, o
= roundup( o
, A_STACK
) );
dp
= defnl(il
[1], REF
, p
, o
-= sizeof ( int * ) );
dp
= defnl( il
[1] , REF
, p
, o
= roundup( o
, A_STACK
) );
dp
= defnl(il
[1], FFUNC
, p
, o
-= sizeof ( int * ) );
dp
= defnl( il
[1] , FFUNC
, p
, o
= roundup( o
, A_STACK
) );
dp
= defnl(il
[1], FPROC
, p
, o
-= sizeof ( int * ) );
dp
= defnl( il
[1] , FPROC
, p
, o
= roundup( o
, A_STACK
) );
p
->value
[NL_OFFS
] = -o
+DPOFF2
;
* Correct the naivete (naievity)
for (il
= p
->chain
; il
!= NIL
; il
= il
->chain
)
il
->value
[NL_OFFS
] += p
->value
[NL_OFFS
];
p
-> value
[ NL_OFFS
] = roundup( o
, A_STACK
);
cntpatch
= put(2, O_CASE4
, 0);
nfppatch
= put(2, O_CASE4
, 0);
for (rl
= r
[3]; rl
; rl
= rl
[2]) {
dp
= defnl(rl
[1], VAR
, 0, 0);
bodycnts
[ cbn
] = getcnt();
put(2, O_TRA4
, 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
] );
* save the counter for this function
fp
-> value
[ NL_CNTR
] = bodycnts
[ cbn
];
* Funcext marks the procedure or
* function external in the symbol
* table. Funcext should only be
* called if PC, and is an error
error("External procedures and functions are not standard");
fp
->ext_flags
|= NEXTERN
;
stabefunc( fp
-> symbol
, fp
-> class , line
);
error("External procedures and functions can only be declared at the outermost level.");
error("Procedures or functions cannot be declared external.");
* when the actual (resolved)
* declaration of a procedure is
* encountered. It puts the names
* of the (function) and parameters
register struct nl
*q
, *p
;
error("Too many levels of function/procedure nesting");
sizes
[cbn
].om_max
= sizes
[cbn
].om_off
= -DPOFF1
;
if ( fp
-> class != PROG
) {
stabfunc( fp
-> symbol
, fp
-> class , line
, cbn
- 1 );
stabfunc( "program" , fp
-> class , line
, 0 );
for (q
= fp
->chain
; q
!= NIL
; q
= q
->chain
) {
stabparam( q
-> symbol
, p2type( q
-> type
)
* For functions, enter the fvar
q
= fp
-> ptr
[ NL_FVAR
];
sizes
[cbn
].om_off
-= lwidth( q
-> type
);
sizes
[cbn
].om_max
= sizes
[cbn
].om_off
;
stabvar( q
-> symbol
, p2type( q
-> type
) , cbn
, q
-> value
[ NL_OFFS
] , lwidth( q
-> type
)
* pick up the pointer to porf declaration
PorFHeader
[ ++nesting
] = fp
-> inTree
;
* finish a block by generating
* the code for the statements.
* It then looks for unresolved declarations
* of labels, procedures and functions,
* and cleans up the name list.
* For the program, it checks the
* semantics of the program
funcend(fp
, bundle
, endline
)
int var
, inp
, out
, chkref
, *blk
;
line
= program
->value
[3];
* Patch the branch to the
* entry point of the function
* Put out the block entrance code and the block name.
* the CONG is overlaid by a patch later!
var
= put(2, (lenstr(fp
->symbol
,0) << 8)
| (cbn
== 1 && opt('p') == 0 ? O_NODUMP
: O_BEG
), 0);
* output the number of bytes of arguments
* this is only checked on formal calls.
put(2, O_CASE4
, cbn
== 1 ? 0 : fp
->value
[NL_OFFS
]-DPOFF2
);
put(2, O_CASE2
, bundle
[1]);
* put out the procedure entry code
if ( fp
-> class == PROG
) {
putprintf( " .text" , 0 );
putprintf( " .align 1" , 0 );
putprintf( " .globl _main" , 0 );
putprintf( "_main:" , 0 );
putprintf( " .word 0" , 0 );
putprintf( " calls $0,_PCSTART" , 0 );
putprintf( " movl 4(ap),__argc" , 0 );
putprintf( " movl 8(ap),__argv" , 0 );
putprintf( " calls $0,_program" , 0 );
putprintf( " calls $0,_PCEXIT" , 0 );
putprintf( " .text" , 0 );
putprintf( " .align 1" , 0 );
putprintf( " .globl _program" , 0 );
putprintf( "_program:" , 0 );
putprintf( " .text" , 0 );
putprintf( " .align 1" , 0 );
putprintf( " .globl " , 1 );
for ( i
= 1 ; i
< cbn
; i
++ ) {
putprintf( EXTFORMAT
, 1 , enclosing
[ i
] );
for ( i
= 1 ; i
< cbn
; i
++ ) {
putprintf( EXTFORMAT
, 1 , enclosing
[ i
] );
putprintf( " .word 0x%x" , 0 , RUNCHECK
| RSAVEMASK
);
putprintf( " .word 0x%x" , 0 , RSAVEMASK
);
* call mcount for profiling
putprintf( " moval 1f,r0" , 0 );
putprintf( " jsb mcount" , 0 );
putprintf( " .data" , 0 );
putprintf( " .align 2" , 0 );
putprintf( " .long 0" , 0 );
putprintf( " .text" , 0 );
* set up unwind exception vector.
putprintf( " moval %s,%d(%s)" , 0
, UNWINDNAME
, UNWINDOFFSET
, P2FPNAME
);
* save address of display entry, for unwind.
putprintf( " moval %s+%d,%d(%s)" , 0
, DISPLAYNAME
, cbn
* sizeof(struct dispsave
)
, DPTROFFSET
, P2FPNAME
);
putprintf( " movq %s+%d,%d(%s)" , 0
, DISPLAYNAME
, cbn
* sizeof(struct dispsave
)
, DSAVEOFFSET
, P2FPNAME
);
* set up new display by saving AP and FP in appropriate
* slot in display structure.
putprintf( " movq %s,%s+%d" , 0
, P2APNAME
, DISPLAYNAME
, cbn
* sizeof(struct dispsave
) );
* ask second pass to allocate known locals
putlbracket( ftnno
, -sizes
[ cbn
].om_max
);
* and zero them if checking is on
* by calling zframe( bytes of locals , highest local address );
if ( ( -sizes
[ cbn
].om_max
) > DPOFF1
) {
putleaf( P2ICON
, 0 , 0 , ADDTYPE( P2FTN
| P2INT
, P2PTR
)
putleaf( P2ICON
, ( -sizes
[ cbn
].om_max
) - DPOFF1
putLV( 0 , cbn
, sizes
[ cbn
].om_max
, P2CHAR
);
putop( P2LISTOP
, P2INT
);
putdot( filename
, line
);
* check number of longs of arguments
* this can only be wrong for formal calls.
if ( fp
-> class != PROG
) {
putleaf( P2ICON
, 0 , 0 , ADDTYPE( P2PTR
, P2FTN
| P2INT
) ,
(fp
->value
[NL_OFFS
] - DPOFF2
) / sizeof(long) ,
putdot( filename
, line
);
if ( fp
-> value
[ NL_CNTR
] != 0 ) {
inccnt( fp
-> value
[ NL_CNTR
] );
inccnt( bodycnts
[ fp
-> nl_block
& 037 ] );
* The glorious buffers option.
* 0 = don't buffer output
* 2 = 512 byte buffer output
put(1, O_BUFF
| opt('b') << 8);
, ADDTYPE( P2FTN
| P2INT
, P2PTR
) , "_BUFF" );
putleaf( P2ICON
, opt( 'b' ) , 0 , P2INT
, 0 );
putdot( filename
, line
);
for (p
= fp
->chain
; p
!= NIL
; p
= p
->chain
) {
if (strcmp(p
->symbol
, "input") == 0) {
if (strcmp(p
->symbol
, "output") == 0) {
iop
= lookup1(p
->symbol
);
if (iop
== NIL
|| bn
!= cbn
) {
error("File %s listed in program statement but not declared", p
->symbol
);
error("File %s listed in program statement but declared as a %s", p
->symbol
, classes
[iop
->class]);
if (iop
->type
->class != FILET
) {
error("File %s listed in program statement but defined as %s",
p
->symbol
, nameof(iop
->type
));
put(2, O_LV
| bn
<< 8+INDX
, iop
->value
[NL_OFFS
]);
} while (p
->symbol
+i
== 0);
put(2, O_CON24
, text(iop
->type
) ? 0 : width(iop
->type
->type
));
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
putLV( p
-> symbol
, bn
, iop
-> value
[NL_OFFS
]
putCONG( p
-> symbol
, strlen( p
-> symbol
)
putop( P2LISTOP
, P2INT
);
putleaf( P2ICON
, strlen( p
-> symbol
)
putop( P2LISTOP
, P2INT
);
, text(iop
->type
) ? 0 : width(iop
->type
->type
)
putop( P2LISTOP
, P2INT
);
putdot( filename
, line
);
if (out
== 0 && fp
->chain
!= NIL
) {
error("The file output must appear in the program statement file list");
* Process the prog/proc/func body
pPointer Body
= tCopy( blk
);
pDEF( PorFHeader
[ nesting
-- ] ).PorFBody
= Body
;
if (cbn
== 1 && monflg
!= 0) {
patchfil(cntpatch
- 2, cnts
, 2);
patchfil(nfppatch
- 2, pfcnt
, 2);
if ( fp
-> class == PROG
&& monflg
) {
putleaf( P2ICON
, 0 , 0 , ADDTYPE( P2FTN
| P2INT
, P2PTR
)
putleaf( P2ICON
, cnts
, 0 , P2INT
, 0 );
putleaf( P2ICON
, pfcnt
, 0 , P2INT
, 0 );
putop( P2LISTOP
, P2INT
);
putdot( filename
, line
);
if (fp
->class == PROG
&& inp
== 0 && (input
->nl_flags
& (NUSED
|NMOD
)) != 0) {
error("Input is used but not defined in the program statement");
* Clean up the symbol table displays and check for unresolves
chkref
= syneflg
== errcnt
[cbn
] && opt('w') == 0;
for (i
= 0; i
<= 077; i
++) {
for (p
= disptab
[i
]; p
!= NIL
&& (p
->nl_block
& 037) == b
; p
= p
->nl_next
) {
* Check for variables defined
if (chkref
&& p
->symbol
!= NIL
)
* If the corresponding record is
* unused, we shouldn't complain about
if ((p
->nl_flags
& (NUSED
|NMOD
)) == 0) {
nerror("%s %s is neither used nor set", classes
[p
->class], p
->symbol
);
* If a var parameter is either
* modified or used that is enough.
if ((p
->nl_flags
& NUSED
) == 0) {
nerror("%s %s is never used", classes
[p
->class], p
->symbol
);
if (((p
->nl_flags
& NUSED
) == 0) && ((p
->ext_flags
& NEXTERN
) == 0)) {
nerror("%s %s is never used", classes
[p
->class], p
->symbol
);
if ((p
->nl_flags
& NMOD
) == 0) {
nerror("%s %s is used but never set", classes
[p
->class], p
->symbol
);
if (p
->chain
->ud_next
== NIL
)
if (p
->value
[NL_KINDS
] & ISUNDEF
)
nerror("%s undefined on line%s", p
->symbol
, cp
);
nerror("%s improperly used on line%s", p
->symbol
, cp
);
if ((p
->nl_flags
& NFORWD
))
nerror("Unresolved forward declaration of %s %s", classes
[p
->class], p
->symbol
);
if ((p
->nl_flags
& NFORWD
) && ((p
->ext_flags
& NEXTERN
) == 0))
nerror("Unresolved forward declaration of %s %s", classes
[p
->class], p
->symbol
);
if (p
->nl_flags
& NFORWD
)
nerror("label %s was declared but not defined", p
->symbol
);
if ((p
->nl_flags
& NMOD
) == 0)
nerror("No assignment to the function variable");
* if there were file variables declared at this level
* call pclose( &__disply[ cbn ] ) to clean them up.
putleaf( P2ICON
, 0 , 0 , ADDTYPE( P2FTN
| P2INT
, P2PTR
)
putRV( DISPLAYNAME
, 0 , cbn
* sizeof( struct dispsave
)
putdot( filename
, line
);
* the function variable is the return value.
* if it's a scalar valued function, return scalar,
* else, return a pointer to the structure value.
if ( fp
-> class == FUNC
) {
struct nl
*fvar
= fp
-> ptr
[ NL_FVAR
];
long fvartype
= p2type( fvar
-> type
);
char labelname
[ BUFSIZ
];
switch ( classify( fvar
-> type
) ) {
putRV( fvar
-> symbol
, ( fvar
-> nl_block
) & 037
, fvar
-> value
[ NL_OFFS
] , fvartype
);
sprintf( labelname
, PREFIXFORMAT
,
putprintf( " .data" , 0 );
putprintf( " .lcomm %s,%d" , 0 ,
labelname
, lwidth( fvar
-> type
) );
putprintf( " .text" , 0 );
putleaf( P2NAME
, 0 , 0 , fvartype
, labelname
);
putLV( fvar
-> symbol
, ( fvar
-> nl_block
) & 037
, fvar
-> value
[ NL_OFFS
] , fvartype
);
putstrop( P2STASG
, fvartype
, lwidth( fvar
-> type
) ,
putdot( filename
, line
);
putleaf( P2ICON
, 0 , 0 , fvartype
, labelname
);
putop( P2FORCE
, fvartype
);
putdot( filename
, line
);
* restore old display entry from save area
putprintf( " movq %d(%s),%s+%d" , 0
, DISPLAYNAME
, cbn
* sizeof(struct dispsave
) );
* let the second pass allocate locals
putprintf( " subl2 $LF%d,sp" , 0 , ftnno
);
* declare pcp counters, if any
if ( monflg
&& fp
-> class == PROG
) {
putprintf( " .data" , 0 );
putprintf( " .comm " , 1 );
putprintf( PCPCOUNT
, 1 );
putprintf( ",%d" , 0 , ( cnts
+ 1 ) * sizeof (long) );
putprintf( " .text" , 0 );
dumpnl(fp
->ptr
[2], fp
->symbol
);
* the proper variable size
patchfil(var
, sizes
[cbn
].om_max
, 2);
if (inpflist(fp
->symbol
)) {
* Segend is called to check for
* unresolved variables, funcs and
* procs, and deliver unresolved and
* baduse error diagnostics at the
* end of a routine segment (a separately
* compiled segment that is not the
* main program) for PC. This
* routine should only be called
error("Separately compiled routine segments are not standard.");
for (p
= disptab
[i
]; p
!= NIL
&& (p
->nl_block
& 037) == b
; p
= p
->nl_next
) {
if (p
->chain
->ud_next
== NIL
)
if (p
->value
[NL_KINDS
] & ISUNDEF
)
nerror("%s undefined on line%s", p
->symbol
, cp
);
nerror("%s improperly used on line%s", p
->symbol
, cp
);
if ((p
->nl_flags
& NFORWD
) && ((p
->ext_flags
& NEXTERN
) == 0))
nerror("Unresolved forward declaration of %s %s", classes
[p
->class], p
->symbol
);
if (((p
->nl_flags
& NMOD
) == 0) && ((p
->chain
->ext_flags
& NEXTERN
) == 0))
nerror("No assignment to the function variable");
error("Missing program statement and program body");
* Level1 does level one processing for
* separately compiled routine segments
error("Missing program statement");
error("Missing program statement");
sizes
[cbn
].om_max
= sizes
[cbn
].om_off
= -DPOFF1
;
printf(" %d", p
->ud_line
);
printf("In %s %s:\n", classes
[Fp
->class], Fp
->symbol
);