projects / unix-history / blob
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
BSD 4_3_Net_2 release
[unix-history] / usr / src / usr.bin / pascal / src / var.c
/*-
* Copyright (c) 1980 The Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
#ifndef lint
static char sccsid[] = "@(#)var.c 5.5 (Berkeley) 4/16/91";
#endif /* not lint */
#include "whoami.h"
#include "0.h"
#include "objfmt.h"
#include "align.h"
#include "iorec.h"
#ifdef PC
# include "pc.h"
#endif PC
#include "tmps.h"
#include "tree_ty.h"
/*
* Declare variables of a var part. DPOFF1 is
* the local variable storage for all prog/proc/func
* modules aside from the block mark. The total size
* of all the local variables is entered into the
* size array.
*/
/*ARGSUSED*/
varbeg( lineofyvar , r )
int lineofyvar;
{
static bool var_order = FALSE;
static bool var_seen = FALSE;
/* this allows for multiple declaration
* parts except when the "standard"
* option has been specified.
* If routine segment is being compiled,
* do level one processing.
*/
#ifndef PI1
if (!progseen)
level1();
line = lineofyvar;
if ( parts[ cbn ] & RPRT ) {
if ( opt( 's' ) ) {
standard();
error("Variable declarations should precede routine declarations");
} else {
if ( !var_order ) {
var_order = TRUE;
warning();
error("Variable declarations should precede routine declarations");
}
}
}
if ( parts[ cbn ] & VPRT ) {
if ( opt( 's' ) ) {
standard();
error("All variables should be declared in one var part");
} else {
if ( !var_seen ) {
var_seen = TRUE;
warning();
error("All variables should be declared in one var part");
}
}
}
parts[ cbn ] |= VPRT;
#endif
/*
* #ifndef PI0
* sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
* #endif
*/
forechain = NIL;
#ifdef PI0
send(REVVBEG);
#endif
}
var(vline, vidl, vtype)
#ifdef PI0
int vline;
struct tnode *vidl, *vtype;
{
register struct nl *np;
register struct tnode *vl;
np = gtype(vtype);
line = vline;
/* why is this here? */
for (vl = vidl; vl != TR_NIL; vl = vl->list_node.next) {
}
}
send(REVVAR, vline, vidl, vtype);
}
#else
int vline;
register struct tnode *vidl;
struct tnode *vtype;
{
register struct nl *np;
register struct om *op;
long w;
int o2;
#ifdef PC
struct nl *vp;
#endif
np = gtype(vtype);
line = vline;
w = lwidth(np);
op = &sizes[cbn];
for (; vidl != TR_NIL; vidl = vidl->list_node.next) {
# ifdef OBJ
op->curtmps.om_off =
roundup((int)(op->curtmps.om_off-w), (long)align(np));
o2 = op -> curtmps.om_off;
# endif OBJ
# ifdef PC
if ( cbn == 1 ) {
/*
* global variables are not accessed off the fp
* but rather by their names.
*/
o2 = 0;
} else {
/*
* locals are aligned, too.
*/
op->curtmps.om_off =
roundup((int)(op->curtmps.om_off - w),
(long)align(np));
o2 = op -> curtmps.om_off;
}
# endif PC
# ifdef PC
vp = enter(defnl((char *) vidl->list_node.list, VAR, np, o2));
# else
(void) enter(defnl((char *) vidl->list_node.list, VAR, np, o2));
# endif
if ( np != NLNIL && (np -> nl_flags & NFILES) ) {
dfiles[ cbn ] = TRUE;
}
# ifdef PC
if ( cbn == 1 ) {
putprintf( " .data" , 0 );
aligndot(align(np));
putprintf( " .comm " , 1 );
putprintf( EXTFORMAT , 1 , (int) vidl->list_node.list );
putprintf( ",%d" , 0 , (int) w );
putprintf( " .text" , 0 );
stabgvar( vp , w , line );
vp -> extra_flags |= NGLOBAL;
} else {
vp -> extra_flags |= NLOCAL;
}
# endif PC
}
# ifdef PTREE
{
pPointer *Vars;
pPointer Var = VarDecl( ovidl , vtype );
pSeize( PorFHeader[ nesting ] );
Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
*Vars = ListAppend( *Vars , Var );
pRelease( PorFHeader[ nesting ] );
}
# endif
}
#endif
varend()
{
foredecl();
#ifndef PI0
sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
#else
send(REVVEND);
#endif
}
/*
* Find the width of a type in bytes.
*/
width(np)
struct nl *np;
{
return (lwidth(np));
}
long
lwidth(np)
struct nl *np;
{
register struct nl *p;
p = np;
if (p == NIL)
return (0);
loop:
switch (p->class) {
default:
panic("wclass");
case TYPE:
switch (nloff(p)) {
case TNIL:
return (2);
case TSTR:
case TSET:
panic("width");
default:
p = p->type;
goto loop;
}
case ARRAY:
return (aryconst(p, 0));
case PTR:
return ( sizeof ( int * ) );
case FILET:
return ( sizeof(struct iorec) + lwidth( p -> type ) );
case CRANGE:
p = p->type;
goto loop;
case RANGE:
if (p->type == nl+TDOUBLE)
#ifdef DEBUG
return (hp21mx ? 4 : 8);
#else
return (8);
#endif
case SCAL:
return (bytes(p->range[0], p->range[1]));
case SET:
setran(p->type);
/*
* Sets are some multiple of longs
*/
return roundup((int)((set.uprbp >> 3) + 1),
(long)(sizeof(long)));
case STR:
case RECORD:
return ( p->value[NL_OFFS] );
}
}
/*
* round up x to a multiple of y
* for computing offsets of aligned things.
* y had better be positive.
* rounding is in the direction of x.
*/
long
roundup( x , y )
int x;
register long y;
{
if ( y == 0 ) {
return x;
}
if ( x >= 0 ) {
return ( ( ( x + ( y - 1 ) ) / y ) * y );
} else {
return ( ( ( x - ( y - 1 ) ) / y ) * y );
}
}
/*
* alignment of an object using the c alignment scheme
*/
int
align( np )
struct nl *np;
{
register struct nl *p;
long elementalign;
p = np;
if ( p == NIL ) {
return 0;
}
alignit:
switch ( p -> class ) {
default:
panic( "align" );
case TYPE:
switch ( nloff( p ) ) {
case TNIL:
return A_POINT;
case TSTR:
return A_STRUCT;
case TSET:
return A_SET;
default:
p = p -> type;
goto alignit;
}
case ARRAY:
/*
* arrays are structures, since they can get
* assigned form/to as structure assignments.
* preserve internal alignment if it is greater.
*/
elementalign = align(p -> type);
return elementalign > A_STRUCT ? elementalign : A_STRUCT;
case PTR:
return A_POINT;
case FILET:
return A_FILET;
case CRANGE:
case RANGE:
if ( p -> type == nl+TDOUBLE ) {
return A_DOUBLE;
}
/* else, fall through */
case SCAL:
switch ( bytes( p -> range[0] , p -> range[1] ) ) {
case 4:
return A_LONG;
case 2:
return A_SHORT;
case 1:
return A_CHAR;
default:
panic( "align: scal" );
}
case SET:
return A_SET;
case STR:
/*
* arrays of chars are structs
*/
return A_STRUCT;
case RECORD:
/*
* the alignment of a record is in its align_info field
* why don't we use this for the rest of the namelist?
*/
return p -> align_info;
}
}
#ifdef PC
/*
* output an alignment pseudo-op.
*/
aligndot(alignment)
int alignment;
#if defined(vax) || defined(tahoe)
{
switch (alignment) {
case 1:
return;
case 2:
putprintf(" .align 1", 0);
return;
default:
case 4:
putprintf(" .align 2", 0);
return;
}
}
#endif vax || tahoe
#ifdef mc68000
{
switch (alignment) {
case 1:
return;
default:
putprintf(" .even", 0);
return;
}
}
#endif mc68000
#endif PC
/*
* Return the width of an element
* of a n time subscripted np.
*/
long aryconst(np, n)
struct nl *np;
int n;
{
register struct nl *p;
long s, d;
if ((p = np) == NIL)
return (NIL);
if (p->class != ARRAY)
panic("ary");
/*
* If it is a conformant array, we cannot find the width from
* the type.
*/
if (p->chain->class == CRANGE)
return (NIL);
s = lwidth(p->type);
/*
* Arrays of anything but characters are word aligned.
*/
if (s & 1)
if (s != 1)
s++;
/*
* Skip the first n subscripts
*/
while (n >= 0) {
p = p->chain;
n--;
}
/*
* Sum across remaining subscripts.
*/
while (p != NIL) {
if (p->class != RANGE && p->class != SCAL)
panic("aryran");
d = p->range[1] - p->range[0] + 1;
s *= d;
p = p->chain;
}
return (s);
}
/*
* Find the lower bound of a set, and also its size in bits.
*/
setran(q)
struct nl *q;
{
register lb, ub;
register struct nl *p;
p = q;
if (p == NIL)
return;
lb = p->range[0];
ub = p->range[1];
if (p->class != RANGE && p->class != SCAL)
panic("setran");
set.lwrb = lb;
/* set.(upperbound prime) = number of bits - 1; */
set.uprbp = ub-lb;
}
/*
* Return the number of bytes required to hold an arithmetic quantity
*/
bytes(lb, ub)
long lb, ub;
{
#ifndef DEBUG
if (lb < -32768 || ub > 32767)
return (4);
else if (lb < -128 || ub > 127)
return (2);
#else
if (!hp21mx && (lb < -32768 || ub > 32767))
return (4);
if (lb < -128 || ub > 127)
return (2);
#endif
else
return (1);
}
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.