/* Copyright (c) 1979 Regents of the University of California */
* pi - Pascal interpreter code translator
* Charles Haley, Bill Joy UCB
* Version 1.2 November 1978
* 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 a forward 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");
* mark this proc/func as forward
pDEF( p
-> inTree
).PorFForward
= TRUE
;
* 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);
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], REF
, p
, o
-= sizeof ( int * ) );
error("Procedure/function parameters not implemented");
p
->value
[NL_OFFS
] = -o
+DPOFF2
;
for (il
= p
->chain
; il
!= NIL
; il
= il
->chain
)
il
->value
[NL_OFFS
] += p
->value
[NL_OFFS
];
cntpatch
= put2(O_PXPBUF
, 0);
nfppatch
= put3(NIL
, 0, 0);
for (rl
= r
[3]; rl
; rl
= rl
[2]) {
dp
= defnl(rl
[1], VAR
, 0, 0);
put2(O_TRACNT
, 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
] );
* 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
;
for (q
= fp
->chain
; q
!= NIL
; q
= q
->chain
)
* For functions, enter the fvar
* 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
;
int toplabel
= newlabel();
int botlabel
= newlabel();
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
= put1(cbn
== 1 && opt('p') == 0 ? O_NODUMP
: O_BEG
);
put( 2 + (sizeof ( char * )/sizeof ( short )) , O_CONG
, 8, fp
->symbol
);
* put out the procedure entry code
if ( fp
-> class == PROG
) {
putprintf( " .comm _display,%d"
, DSPLYSZ
* sizeof( int * ) );
puttext( " .globl _main" );
putprintf( " .globl _%.7s" , fp
-> symbol
);
putprintf( "_%.7s:" , fp
-> symbol
);
/* register save mask for function */
putprintf( " jbr B%d" , botlabel
);
putprintf( "T%d:" , toplabel
);
putprintf( " movl _display+%o,(fp)" , cbn
* sizeof( int * ) );
putprintf( " movl fp,_display+%o" , cbn
* sizeof( int * ) );
/* 'allocate' local storage */
* The glorious buffers option.
* 0 = don't buffer output
* 2 = 512 byte buffer output
put1(O_BUFF
| opt('b') << 8);
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
));
put2(O_LV
| bn
<< 9, iop
->value
[NL_OFFS
]);
i
= b
- ( (int) p
->symbol
);
put( 2 + (sizeof ( char * )/sizeof ( short ))
, text(iop
->type
) ? 0: width(iop
->type
->type
));
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
, cnts
, 1);
patchfil(nfppatch
, pfcnt
, 1);
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
& 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
)
nerror("label %s was declared but not defined", p
->symbol
);
if ((p
->nl_flags
& NMOD
) == 0)
nerror("No assignment to the function variable");
putprintf( " movl (fp),_display+%o"
, cbn
* sizeof( int * ) );
putprintf( "B%d:" , botlabel
);
putprintf( " subl2 $.F%d,sp" , ftnno
);
putprintf( " jbr T%d" , toplabel
);
if ( fp
-> class == PROG
)
dumpnl(fp
->ptr
[2], fp
->symbol
);
* the proper variable size
if (sizes
[cbn
].om_max
< TOOMUCH
)
nerror("Storage requirement of %ld bytes exceeds hardware capacity", -sizes
[cbn
].om_max
);
if (inpflist(fp
->symbol
)) {
printf(" %d", p
->ud_line
);
printf("In %s %s:\n", classes
[Fp
->class], Fp
->symbol
);