This is structure.c in view mode; [Download] [Up]
Changes file for /usr/local/src/kcl/c/structure.c
Created on Fri May 25 09:34:32 1990
Usage \n@s[Original text\n@s|Replacement Text\n@s]
See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c
for a program to merge change files. Anything not between
"\n@s[" and "\n@s]" is a simply a comment.
This file was constructed using emacs and merge.el
Enhancements Copyright (c) W. Schelter All rights reserved.
by (Bill Schelter) wfs@carl.ma.utexas.edu
****Change:(orig (15 17 d))
@s[object siSstructure_print_function;
object siSstructure_slot_descriptions;
object siSstructure_include;
@s|
@s]
****Change:(orig (18 18 a))
@s[
@s|
#define COERCE_DEF(x) if (type_of(x)==t_symbol) \
x=getf(x->s.s_plist,siLs_data,Cnil)
#define check_type_structure(x) \
if(type_of((x))!=t_structure) \
FEwrong_type_argument(Sstructure,(x))
@s]
****Change:(orig (22 31 c))
@s[{
do {
if (type_of(x) != t_symbol)
return(FALSE);
@s, } while (x != Cnil);
return(FALSE);
}
@s|{ if (x==y) return 1;
if (type_of(x)!= t_structure
|| type_of(y)!=t_structure)
FEerror("bad call to structure_subtypep",0);
{if (S_DATA(y)->included == Cnil) return 0;
while ((x=S_DATA(x)->includes) != Cnil)
{ if (x==y) return 1;}
return 0;
}}
@s]
****Change:(orig (32 32 a))
@s[
@s|
static
bad_raw_type()
{ FEerror("Bad raw struct type",0);}
@s]
****Change:(orig (34 34 c))
@s[structure_ref(x, name, n)
@s|structure_ref(x, name, i)
@s]
****Change:(orig (36 38 c))
@s[object x, name;
int n;
{
int i;
@s|object x, name;
int i;
{unsigned short *s_pos;
COERCE_DEF(name);
if (type_of(x) != t_structure ||
(type_of(name)!=t_structure) ||
!structure_subtypep(x->str.str_def, name))
FEwrong_type_argument((type_of(name)==t_structure ?
S_DATA(name)->name : name),
x);
s_pos = &SLOT_POS(x->str.str_def,0);
switch((SLOT_TYPE(x->str.str_def,i)))
{
case aet_object: return(STREF(object,x,s_pos[i]));
case aet_fix: return(make_fixnum((STREF(int,x,s_pos[i]))));
case aet_ch: return(code_char(STREF(char,x,s_pos[i])));
case aet_bit:
case aet_char: return(make_fixnum(STREF(char,x,s_pos[i])));
case aet_sf: return(make_shortfloat(STREF(shortfloat,x,s_pos[i])));
case aet_lf: return(make_longfloat(STREF(longfloat,x,s_pos[i])));
case aet_uchar: return(make_fixnum(STREF(unsigned char,x,s_pos[i])));
case aet_ushort: return(make_fixnum(STREF(unsigned short,x,s_pos[i])));
case aet_short: return(make_fixnum(STREF(short,x,s_pos[i])));
default:
bad_raw_type();
return 0;
}}
@s]
****Change:(orig (40 43 c))
@s[ if (type_of(x) != t_structure ||
!structure_subtypep(x->str.str_name, name))
FEwrong_type_argument(name, x);
return(x->str.str_self[n]);
@s|
void
siLstructure_ref1()
{object x=vs_base[0];
int n=fix(vs_base[1]);
object def;
check_type_structure(x);
def=x->str.str_def;
if(n>= S_DATA(def)->length)
FEerror("Structure ref out of bounds",0);
vs_base[0]=structure_ref(x,x->str.str_def,n);
vs_top=vs_base+1;
@s]
****Change:(orig (45 45 a))
@s[}
@s|}
@s]
****Change:(orig (47 47 c))
@s[structure_set(x, name, n, v)
@s|structure_set(x, name, i, v)
@s]
****Change:(orig (49 51 c))
@s[object x, name, v;
int n;
{
int i;
@s|object x, name, v;
int i;
{unsigned short *s_pos;
COERCE_DEF(name);
if (type_of(x) != t_structure ||
type_of(name) != t_structure ||
!structure_subtypep(x->str.str_def, name))
FEwrong_type_argument((type_of(name)==t_structure ?
S_DATA(name)->name : name)
, x);
@s]
****Change:(orig (53 57 c))
@s[ if (type_of(x) != t_structure ||
!structure_subtypep(x->str.str_name, name))
FEwrong_type_argument(name, x);
x->str.str_self[n] = v;
@s, return(v);
@s|#ifdef SGC
/* make sure the structure header is on a writable page */
if (x->d.m) FEerror("bad gc field"); else x->d.m = 0;
#endif
s_pos= & SLOT_POS(x->str.str_def,0);
switch(SLOT_TYPE(x->str.str_def,i)){
case aet_object: STREF(object,x,s_pos[i])=v; break;
case aet_fix: (STREF(int,x,s_pos[i]))=fix(v); break;
case aet_ch: STREF(char,x,s_pos[i])=char_code(v); break;
case aet_bit:
case aet_char: STREF(char,x,s_pos[i])=fix(v); break;
case aet_sf: STREF(shortfloat,x,s_pos[i])=sf(v); break;
case aet_lf: STREF(longfloat,x,s_pos[i])=lf(v); break;
case aet_uchar: STREF(unsigned char,x,s_pos[i])=fix(v); break;
case aet_ushort: STREF(unsigned short,x,s_pos[i])=fix(v); break;
case aet_short: STREF(short,x,s_pos[i])=fix(v); break;
default:
bad_raw_type();
}
return(v);
@s]
****Change:(orig (59 59 a))
@s[}
@s|}
void
siLstructure_subtype_p()
{object x,y;
check_arg(2);
x=vs_base[0];
y=vs_base[1];
if (type_of(x)!=t_structure)
{vs_base[0]=Cnil; goto BOTTOM;}
x=x->str.str_def;
COERCE_DEF(y);
if (structure_subtypep(x,y)) vs_base[0]=Ct;
else vs_base[0]=Cnil;
BOTTOM:
vs_top=vs_base+1;
}
@s]
****Change:(orig (64 64 a))
@s[object x;
{
object *p, s;
@s|object x;
{
object *p, s;
struct s_data *def=S_DATA(x->str.str_def);
@s]
****Change:(orig (66 69 c))
@s[
s = getf(x->str.str_name->s.s_plist,
siSstructure_slot_descriptions, Cnil);
vs_push(x->str.str_name);
@s|
s = def->slot_descriptions;
vs_push(def->name);
@s]
****Change:(orig (72 72 c))
@s[ for (i=0, n=x->str.str_length; !endp(s)&&i<n; s=s->c.c_cdr, i++) {
@s| for (i=0, n=def->length; !endp(s)&&i<n; s=s->c.c_cdr, i++) {
@s]
****Change:(orig (75 75 c))
@s[ *p = make_cons(x->str.str_self[i], Cnil);
@s| *p = make_cons(structure_ref(x,x->str.str_def,i), Cnil);
@s]
****Change:(orig (81 81 a))
@s[ stack_cons();
return(vs_pop);
}
@s| stack_cons();
return(vs_pop);
}
void
@s]
****Change:(orig (84 85 c))
@s[ object x;
int narg, i;
@s| object x,name,*base;
struct s_data *def;
int narg, i,size;
base=vs_base;
if ((narg = vs_top - base) == 0)
too_few_arguments();
x = alloc_object(t_structure);
name=base[0];
COERCE_DEF(name);
if (type_of(name)!=t_structure ||
(def=S_DATA(name))->length != --narg)
FEerror("Bad make_structure args for type ~a",1,
base[0]);
x->str.str_def = name;
x->str.str_self = NULL;
size=S_DATA(name)->size;
base[0] = x;
x->str.str_self = (object *)
(def->staticp == Cnil ? alloc_relblock(size)
: alloc_contblock(size));
/* There may be holes in the structure.
We want them zero, so that equal can work better.
*/
if (S_DATA(name)->has_holes != Cnil)
bzero(x->str.str_self,size);
{unsigned char *s_type;
unsigned short *s_pos;
s_pos= (&SLOT_POS(x->str.str_def,0));
s_type = (&(SLOT_TYPE(x->str.str_def,0)));
base=base+1;
for (i = 0; i < narg; i++)
{object v=base[i];
switch(s_type[i]){
case aet_object: STREF(object,x,s_pos[i])=v; break;
case aet_fix: (STREF(int,x,s_pos[i]))=fix(v); break;
case aet_ch: STREF(char,x,s_pos[i])=char_code(v); break;
case aet_bit:
case aet_char: STREF(char,x,s_pos[i])=fix(v); break;
case aet_sf: STREF(shortfloat,x,s_pos[i])=sf(v); break;
case aet_lf: STREF(longfloat,x,s_pos[i])=lf(v); break;
case aet_uchar: STREF(unsigned char,x,s_pos[i])=fix(v); break;
case aet_ushort: STREF(unsigned short,x,s_pos[i])=fix(v); break;
case aet_short: STREF(short,x,s_pos[i])=fix(v); break;
default:
bad_raw_type();
@s]
****Change:(orig (87 97 c))
@s[ if ((narg = vs_top - vs_base) == 0)
too_few_arguments();
x = alloc_object(t_structure);
x->str.str_name = vs_base[0];
@s, x->str.str_self[i] = vs_top[i];
@s| }}
vs_top = base;
vs_base=base-1;
}
@s]
****Change:(orig (99 99 a))
@s[}
@s|}
void
@s]
****Change:(orig (103 103 c))
@s[ object x, y;
int i, j;
@s| object x, y;
struct s_data *def;
@s]
****Change:(orig (105 105 c))
@s[
check_arg(2);
@s|
if (vs_top-vs_base < 1) too_few_arguments();
@s]
****Change:(orig (107 110 c))
@s[ if (type_of(x) != t_structure || x->str.str_name != vs_base[1])
FEwrong_type_argument(vs_base[1], x);
vs_base[1] = y = alloc_object(t_structure);
y->str.str_name = x->str.str_name;
@s| check_type_structure(x);
vs_base[0] = y = alloc_object(t_structure);
def=S_DATA(y->str.str_def = x->str.str_def);
@s]
****Change:(orig (112 116 c))
@s[ y->str.str_length = j = x->str.str_length;
y->str.str_self = (object *)alloc_relblock(sizeof(object)*j);
for (i = 0; i < j; i++)
y->str.str_self[i] = x->str.str_self[i];
@s, vs_base++;
@s| y->str.str_self = (object *)alloc_relblock(def->size);
bcopy(x->str.str_self,y->str.str_self,def->size);
vs_top=vs_base+1;
@s]
****Change:(orig (118 118 a))
@s[}
@s|}
void
@s]
****Change:(orig (122 124 c))
@s[ if (type_of(vs_base[0]) != t_structure)
FEwrong_type_argument(Sstructure, vs_base[0]);
vs_base[0] = vs_base[0]->str.str_name;
@s| check_type_structure(vs_base[0]);
vs_base[0] = S_DATA(vs_base[0]->str.str_def)->name;
@s]
****Change:(orig (126 126 a))
@s[}
@s|}
void
@s]
****Change:(orig (129 130 d))
@s[siLstructure_ref()
{
object x;
int i;
@s|siLstructure_ref()
{
@s]
****Change:(orig (132 144 c))
@s[
x = vs_base[0];
if (type_of(x) != t_structure ||
!structure_subtypep(x->str.str_name, vs_base[1]))
@s, vs_base[0] = x->str.str_self[i];
vs_top = vs_base+1;
@s| vs_base[0]=structure_ref(vs_base[0],vs_base[1],fix(vs_base[2]));
vs_top=vs_base+1;
@s]
****Change:(orig (146 146 a))
@s[}
@s|}
void
@s]
****Change:(orig (149 150 d))
@s[siLstructure_set()
{
object x;
int i;
@s|siLstructure_set()
{
@s]
****Change:(orig (152 163 c))
@s[
x = vs_base[0];
if (type_of(x) != t_structure ||
!structure_subtypep(x->str.str_name, vs_base[1]))
@s, x->str.str_self[i] = vs_base[3];
@s| structure_set(vs_base[0],vs_base[1],fix(vs_base[2]),vs_base[3]);
@s]
****Change:(orig (166 166 a))
@s[ vs_base = vs_top-1;
}
@s| vs_base = vs_top-1;
}
void
@s]
****Change:(orig (227 227 a))
@s[ vs_base[0] = l->c.c_car;
vs_pop;
}
@s| vs_base[0] = l->c.c_car;
vs_pop;
}
siLmake_s_data_structure()
{object x,y,raw,*base;
int i;
check_arg(5);
x=vs_base[0];
base=vs_base;
raw=vs_base[1];
y=alloc_object(t_structure);
y->str.str_def=y;
y->str.str_self = (object *)( x->v.v_self);
S_DATA(y)->name =siLs_data;
S_DATA(y)->length=(raw->v.v_dim);
S_DATA(y)->raw =raw;
for(i=3; i<raw->v.v_dim; i++)
y->str.str_self[i]=Cnil;
S_DATA(y)->slot_position=base[2];
S_DATA(y)->slot_descriptions=base[3];
S_DATA(y)->staticp=base[4];
S_DATA(y)->size = (raw->v.v_dim)*sizeof(object);
vs_base[0]=y;
vs_top=vs_base+1;
}
void
siLstructure_def()
{check_arg(1);
check_type_structure(vs_base[0]);
vs_base[0]=vs_base[0]->str.str_def;
}
short aet_sizes [] = {
sizeof(object), /* aet_object t */
sizeof(char), /* aet_ch string-char */
sizeof(char), /* aet_bit bit */
sizeof(fixnum), /* aet_fix fixnum */
sizeof(float), /* aet_sf short-float */
sizeof(double), /* aet_lf long-float */
sizeof(char), /* aet_char signed char */
sizeof(char), /* aet_uchar unsigned char */
sizeof(short), /* aet_short signed short */
sizeof(short) /* aet_ushort unsigned short */
};
void
siLsize_of()
{ object x= vs_base[0];
int i;
i= aet_sizes[get_aelttype(x)];
vs_base[0]=make_fixnum(i);
}
void
siLaet_type()
{vs_base[0]=make_fixnum(get_aelttype(vs_base[0]));}
/* Return N such that something of type ARG can be aligned on
an address which is a multiple of N */
void
siLalignment()
{struct {double x; int y; double z;
float x1; int y1; float z1;}
joe;
joe.z=3.0;
if (vs_base[0]==Slong_float)
{vs_base[0]=make_fixnum((int)&joe.z- (int)&joe.y); return;}
else
if (vs_base[0]==Sshort_float)
{vs_base[0]=make_fixnum((int)&(joe.z1)-(int)&(joe.y1)); return;}
else
{siLsize_of();}
}
@s]
****Change:(orig (230 238 c))
@s[ siSstructure_print_function
= make_si_ordinary("STRUCTURE-PRINT-FUNCTION");
enter_mark_origin(&siSstructure_print_function);
siSstructure_slot_descriptions
@s, enter_mark_origin(&siSstructure_include);
@s| siLs_data=make_si_ordinary("S-DATA");
@s]
****Change:(orig (239 239 a))
@s[ make_si_function("MAKE-STRUCTURE", siLmake_structure);
@s| make_si_function("MAKE-STRUCTURE", siLmake_structure);
make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure);
@s]
****Change:(orig (242 242 a))
@s[ make_si_function("STRUCTURE-REF", siLstructure_ref);
@s| make_si_function("STRUCTURE-REF", siLstructure_ref);
make_si_function("STRUCTURE-DEF", siLstructure_def);
make_si_function("STRUCTURE-REF1", siLstructure_ref1);
@s]
****Change:(orig (245 245 c))
@s[ make_si_function("STRUCTUREP", siLstructurep);
@s| make_si_function("STRUCTUREP", siLstructurep);
make_si_function("SIZE-OF", siLsize_of);
make_si_function("ALIGNMENT",siLalignment);
make_si_function("STRUCTURE-SUBTYPE-P",siLstructure_subtype_p);
@s]
****Change:(orig (247 247 a))
@s[ make_si_function("LIST-NTH", siLlist_nth);
@s| make_si_function("LIST-NTH", siLlist_nth);
make_si_function("AET-TYPE",siLaet_type);
@s]
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.