ftp.nice.ch/pub/next/developer/languages/lisp/AKCL.1.599.s.tar.gz#/akcl-1-599/lsp/listlib.c

This is listlib.c in view mode; [Download] [Up]

/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "listlib.h"
init_listlib(start,size,data)char *start;int size;object data;
{	register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
	Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
	base[0]= VV[0];
	(void)simple_symlispcall_no_event(VV[1],base+0,1);
	MF(VV[2],L2,start,size,data);
	MF(VV[3],L3,start,size,data);
	MF(VV[4],L4,start,size,data);
	MF(VV[5],L5,start,size,data);
	MF(VV[6],L6,start,size,data);
	MF(VV[7],L7,start,size,data);
	MF(VV[8],L8,start,size,data);
	MF(VV[9],L9,start,size,data);
	MF(VV[10],L10,start,size,data);
	vs_top=vs_base=base;
}
/*	function definition for UNION	*/

static L2()
{	register object *base=vs_base;
	register object *sup=base+VM3;
	vs_reserve(VM3);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	if((base[0])!=Cnil){
	goto T4;}
	vs_top=(vs_base=base+1)+1;
	return;
T4:;
	base[9]=symbol_function(VV[14]);
	base[10]= car(base[0]);
	base[11]= base[1];
	{object V1;
	V1= base[2];
	 vs_top=base+12;
	 while(!endp(V1))
	 {vs_push(car(V1));V1=cdr(V1);}
	vs_base=base+10;}
	funcall_no_event(base[9]);
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T7;}
	base[9]= cdr(base[0]);
	base[10]= base[1];
	{object V2;
	V2= base[2];
	 vs_top=base+11;
	 while(!endp(V2))
	 {vs_push(car(V2));V2=cdr(V2);}
	vs_base=base+9;}
	L2();
	return;
T7:;
	{object V3= car(base[0]);
	base[10]= cdr(base[0]);
	base[11]= base[1];
	{object V4;
	V4= base[2];
	 vs_top=base+12;
	 while(!endp(V4))
	 {vs_push(car(V4));V4=cdr(V4);}
	vs_base=base+10;}
	L2();
	vs_top=sup;
	base[9]= vs_base[0];
	base[10]= make_cons(V3,base[9]);
	vs_top=(vs_base=base+10)+1;
	return;}
}
/*	function definition for NUNION	*/

static L3()
{	register object *base=vs_base;
	register object *sup=base+VM4;
	vs_reserve(VM4);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	if((base[0])!=Cnil){
	goto T20;}
	vs_top=(vs_base=base+1)+1;
	return;
T20:;
	base[9]=symbol_function(VV[14]);
	base[10]= car(base[0]);
	base[11]= base[1];
	{object V5;
	V5= base[2];
	 vs_top=base+12;
	 while(!endp(V5))
	 {vs_push(car(V5));V5=cdr(V5);}
	vs_base=base+10;}
	funcall_no_event(base[9]);
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T23;}
	base[9]= cdr(base[0]);
	base[10]= base[1];
	{object V6;
	V6= base[2];
	 vs_top=base+11;
	 while(!endp(V6))
	 {vs_push(car(V6));V6=cdr(V6);}
	vs_base=base+9;}
	L3();
	return;
T23:;
	base[10]= cdr(base[0]);
	base[11]= base[1];
	{object V7;
	V7= base[2];
	 vs_top=base+12;
	 while(!endp(V7))
	 {vs_push(car(V7));V7=cdr(V7);}
	vs_base=base+10;}
	L3();
	vs_top=sup;
	base[9]= vs_base[0];
	if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
	(base[0])->c.c_cdr = base[9];
	vs_top=(vs_base=base+0)+1;
	return;
}
/*	function definition for INTERSECTION	*/

static L4()
{	register object *base=vs_base;
	register object *sup=base+VM5;
	vs_reserve(VM5);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	if((base[0])!=Cnil){
	goto T36;}
	base[9]= Cnil;
	vs_top=(vs_base=base+9)+1;
	return;
T36:;
	base[9]=symbol_function(VV[14]);
	base[10]= car(base[0]);
	base[11]= base[1];
	{object V8;
	V8= base[2];
	 vs_top=base+12;
	 while(!endp(V8))
	 {vs_push(car(V8));V8=cdr(V8);}
	vs_base=base+10;}
	funcall_no_event(base[9]);
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T39;}
	{object V9= car(base[0]);
	base[10]= cdr(base[0]);
	base[11]= base[1];
	{object V10;
	V10= base[2];
	 vs_top=base+12;
	 while(!endp(V10))
	 {vs_push(car(V10));V10=cdr(V10);}
	vs_base=base+10;}
	L4();
	vs_top=sup;
	base[9]= vs_base[0];
	base[10]= make_cons(V9,base[9]);
	vs_top=(vs_base=base+10)+1;
	return;}
T39:;
	base[9]= cdr(base[0]);
	base[10]= base[1];
	{object V11;
	V11= base[2];
	 vs_top=base+11;
	 while(!endp(V11))
	 {vs_push(car(V11));V11=cdr(V11);}
	vs_base=base+9;}
	L4();
	return;
}
/*	function definition for NINTERSECTION	*/

static L5()
{	register object *base=vs_base;
	register object *sup=base+VM6;
	vs_reserve(VM6);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	if((base[0])!=Cnil){
	goto T52;}
	base[9]= Cnil;
	vs_top=(vs_base=base+9)+1;
	return;
T52:;
	base[9]=symbol_function(VV[14]);
	base[10]= car(base[0]);
	base[11]= base[1];
	{object V12;
	V12= base[2];
	 vs_top=base+12;
	 while(!endp(V12))
	 {vs_push(car(V12));V12=cdr(V12);}
	vs_base=base+10;}
	funcall_no_event(base[9]);
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T55;}
	base[10]= cdr(base[0]);
	base[11]= base[1];
	{object V13;
	V13= base[2];
	 vs_top=base+12;
	 while(!endp(V13))
	 {vs_push(car(V13));V13=cdr(V13);}
	vs_base=base+10;}
	L5();
	vs_top=sup;
	base[9]= vs_base[0];
	if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
	(base[0])->c.c_cdr = base[9];
	vs_top=(vs_base=base+0)+1;
	return;
T55:;
	base[9]= cdr(base[0]);
	base[10]= base[1];
	{object V14;
	V14= base[2];
	 vs_top=base+11;
	 while(!endp(V14))
	 {vs_push(car(V14));V14=cdr(V14);}
	vs_base=base+9;}
	L5();
	return;
}
/*	function definition for SET-DIFFERENCE	*/

static L6()
{	register object *base=vs_base;
	register object *sup=base+VM7;
	vs_reserve(VM7);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	if((base[0])!=Cnil){
	goto T68;}
	base[9]= Cnil;
	vs_top=(vs_base=base+9)+1;
	return;
T68:;
	base[9]=symbol_function(VV[14]);
	base[10]= car(base[0]);
	base[11]= base[1];
	{object V15;
	V15= base[2];
	 vs_top=base+12;
	 while(!endp(V15))
	 {vs_push(car(V15));V15=cdr(V15);}
	vs_base=base+10;}
	funcall_no_event(base[9]);
	vs_top=sup;
	if((vs_base[0])!=Cnil){
	goto T71;}
	{object V16= car(base[0]);
	base[10]= cdr(base[0]);
	base[11]= base[1];
	{object V17;
	V17= base[2];
	 vs_top=base+12;
	 while(!endp(V17))
	 {vs_push(car(V17));V17=cdr(V17);}
	vs_base=base+10;}
	L6();
	vs_top=sup;
	base[9]= vs_base[0];
	base[10]= make_cons(V16,base[9]);
	vs_top=(vs_base=base+10)+1;
	return;}
T71:;
	base[9]= cdr(base[0]);
	base[10]= base[1];
	{object V18;
	V18= base[2];
	 vs_top=base+11;
	 while(!endp(V18))
	 {vs_push(car(V18));V18=cdr(V18);}
	vs_base=base+9;}
	L6();
	return;
}
/*	function definition for NSET-DIFFERENCE	*/

static L7()
{	register object *base=vs_base;
	register object *sup=base+VM8;
	vs_reserve(VM8);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	if((base[0])!=Cnil){
	goto T84;}
	base[9]= Cnil;
	vs_top=(vs_base=base+9)+1;
	return;
T84:;
	base[9]=symbol_function(VV[14]);
	base[10]= car(base[0]);
	base[11]= base[1];
	{object V19;
	V19= base[2];
	 vs_top=base+12;
	 while(!endp(V19))
	 {vs_push(car(V19));V19=cdr(V19);}
	vs_base=base+10;}
	funcall_no_event(base[9]);
	vs_top=sup;
	if((vs_base[0])!=Cnil){
	goto T87;}
	base[10]= cdr(base[0]);
	base[11]= base[1];
	{object V20;
	V20= base[2];
	 vs_top=base+12;
	 while(!endp(V20))
	 {vs_push(car(V20));V20=cdr(V20);}
	vs_base=base+10;}
	L7();
	vs_top=sup;
	base[9]= vs_base[0];
	if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
	(base[0])->c.c_cdr = base[9];
	vs_top=(vs_base=base+0)+1;
	return;
T87:;
	base[9]= cdr(base[0]);
	base[10]= base[1];
	{object V21;
	V21= base[2];
	 vs_top=base+11;
	 while(!endp(V21))
	 {vs_push(car(V21));V21=cdr(V21);}
	vs_base=base+9;}
	L7();
	return;
}
/*	function definition for SET-EXCLUSIVE-OR	*/

static L8()
{	register object *base=vs_base;
	register object *sup=base+VM9;
	vs_reserve(VM9);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	base[10]= base[0];
	base[11]= base[1];
	{object V22;
	V22= base[2];
	 vs_top=base+12;
	 while(!endp(V22))
	 {vs_push(car(V22));V22=cdr(V22);}
	vs_base=base+10;}
	L6();
	vs_top=sup;
	base[9]= vs_base[0];
	base[11]= base[1];
	base[12]= base[0];
	{object V23;
	V23= base[2];
	 vs_top=base+13;
	 while(!endp(V23))
	 {vs_push(car(V23));V23=cdr(V23);}
	vs_base=base+11;}
	L6();
	vs_top=sup;
	base[10]= vs_base[0];
	base[11]= append(base[9],base[10]);
	vs_top=(vs_base=base+11)+1;
	return;
}
/*	function definition for NSET-EXCLUSIVE-OR	*/

static L9()
{	register object *base=vs_base;
	register object *sup=base+VM10;
	vs_reserve(VM10);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	base[10]= base[0];
	base[11]= base[1];
	{object V24;
	V24= base[2];
	 vs_top=base+12;
	 while(!endp(V24))
	 {vs_push(car(V24));V24=cdr(V24);}
	vs_base=base+10;}
	L6();
	vs_top=sup;
	base[9]= vs_base[0];
	base[11]= base[1];
	base[12]= base[0];
	{object V25;
	V25= base[2];
	 vs_top=base+13;
	 while(!endp(V25))
	 {vs_push(car(V25));V25=cdr(V25);}
	vs_base=base+11;}
	L7();
	vs_top=sup;
	base[10]= vs_base[0];
	base[11]= nconc(base[9],base[10]);
	vs_top=(vs_base=base+11)+1;
	return;
}
/*	function definition for SUBSETP	*/

static L10()
{	register object *base=vs_base;
	register object *sup=base+VM11;
	vs_reserve(VM11);
	if(vs_top-vs_base<2) too_few_arguments();
	parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
	vs_top=sup;
	base[9]= base[0];
T116:;
	if((base[9])!=Cnil){
	goto T117;}
	base[10]= Ct;
	vs_top=(vs_base=base+10)+1;
	return;
T117:;
	base[10]=symbol_function(VV[14]);
	base[11]= car(base[9]);
	base[12]= base[1];
	{object V26;
	V26= base[2];
	 vs_top=base+13;
	 while(!endp(V26))
	 {vs_push(car(V26));V26=cdr(V26);}
	vs_base=base+11;}
	funcall_no_event(base[10]);
	vs_top=sup;
	if((vs_base[0])!=Cnil){
	goto T121;}
	base[10]= Cnil;
	vs_top=(vs_base=base+10)+1;
	return;
T121:;
	base[9]= cdr(base[9]);
	goto T116;
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.