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

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

/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "mislib.h"
init_mislib(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[34],base+0,1);
	MM(VV[35],L2,start,size,data);
	base[0]= VV[9];
	base[1]= VV[10];
	(void)simple_symlispcall_no_event(VV[36],base+0,2);
	base[0]= VV[11];
	base[1]= VV[12];
	(void)simple_symlispcall_no_event(VV[36],base+0,2);
	MF(VV[37],L7,start,size,data);
	MF(VV[38],L8,start,size,data);
	data->v.v_self[27]=VV[27]=string_to_object(VV[27]);
	vs_top=sup;
	MF(VV[39],L9,start,size,data);
	MF(VV[40],L10,start,size,data);
	vs_top=vs_base=base;
}
/*	macro definition for TIME	*/

static L2()
{	register object *base=vs_base;
	register object *sup=base+VM3;
	vs_reserve(VM3);
	check_arg(2);
	vs_top=sup;
	{object V1=base[0]->c.c_cdr;
	if(endp(V1))invalid_macro_call();
	base[2]= (V1->c.c_car);
	V1=V1->c.c_cdr;
	if(!endp(V1))invalid_macro_call();}
	base[3]= list(2,VV[7],base[2]);
	base[4]= list(3,VV[5],VV[6],base[3]);
	base[5]= listA(6,VV[1],VV[2],VV[3],VV[4],base[4],VV[8]);
	vs_top=(vs_base=base+5)+1;
	return;
}
/*	function definition for LEAP-YEAR-P	*/

static L7()
{	register object *base=vs_base;
	register object *sup=base+VM4;
	vs_reserve(VM4);
	check_arg(1);
	vs_top=sup;
TTL:;
	base[2]= base[0];
	base[3]= VV[13];
	vs_top=(vs_base=base+2)+2;
	Lmod();
	vs_top=sup;
	base[1]= vs_base[0];
	if(number_compare(small_fixnum(0),base[1])==0){
	goto T11;}
	base[1]= Cnil;
	vs_top=(vs_base=base+1)+1;
	return;
T11:;
	base[3]= base[0];
	base[4]= VV[14];
	vs_top=(vs_base=base+3)+2;
	Lmod();
	vs_top=sup;
	base[2]= vs_base[0];
	if(!(((number_compare(small_fixnum(0),base[2])==0?Ct:Cnil))==Cnil)){
	goto T16;}
	base[2]= Ct;
	vs_top=(vs_base=base+2)+1;
	return;
T16:;
	base[3]= base[0];
	base[4]= VV[15];
	vs_top=(vs_base=base+3)+2;
	Lmod();
	vs_top=sup;
	base[2]= vs_base[0];
	base[3]= (number_compare(small_fixnum(0),base[2])==0?Ct:Cnil);
	vs_top=(vs_base=base+3)+1;
	return;
}
/*	function definition for NUMBER-OF-DAYS-FROM-1900	*/

static L8()
{	register object *base=vs_base;
	register object *sup=base+VM5;
	vs_reserve(VM5);
	check_arg(1);
	vs_top=sup;
TTL:;
	base[1]= one_minus(base[0]);
	base[3]= number_minus(base[0],VV[16]);
	base[2]= number_times(base[3],VV[17]);
	base[4]= base[1];
	base[5]= VV[13];
	vs_top=(vs_base=base+4)+2;
	Lfloor();
	vs_top=sup;
	base[3]= vs_base[0];
	base[6]= base[1];
	base[7]= VV[14];
	vs_top=(vs_base=base+6)+2;
	Lfloor();
	vs_top=sup;
	base[5]= vs_base[0];
	base[4]= number_negate(base[5]);
	base[6]= base[1];
	base[7]= VV[15];
	vs_top=(vs_base=base+6)+2;
	Lfloor();
	vs_top=sup;
	base[5]= vs_base[0];
	base[6]= VV[18];
	vs_top=(vs_base=base+2)+5;
	Lplus();
	return;
}
/*	function definition for DECODE-UNIVERSAL-TIME	*/

static L9()
{	register object *base=vs_base;
	register object *sup=base+VM6;
	vs_reserve(VM6);
	if(vs_top-vs_base<1) too_few_arguments();
	if(vs_top-vs_base>2) too_many_arguments();
	vs_base=vs_base+1;
	if(vs_base>=vs_top){vs_top=sup;goto T37;}
	vs_top=sup;
	goto T38;
T37:;
	base[1]= symbol_value(VV[19]);
T38:;
	base[2]= Cnil;
	base[3]= Cnil;
	base[4]= Cnil;
	base[5]= Cnil;
	base[6]= Cnil;
	base[7]= Cnil;
	base[8]= Cnil;
	base[9]= number_times(base[1],VV[20]);
	base[0]= number_minus(base[0],base[9]);
	base[9]= base[0];
	base[10]= VV[12];
	vs_top=(vs_base=base+9)+2;
	Lfloor();
	if(vs_base<vs_top){
	base[5]= vs_base[0];
	vs_base++;
	}else{
	base[5]= Cnil;}
	if(vs_base<vs_top){
	base[0]= vs_base[0];
	}else{
	base[0]= Cnil;}
	vs_top=sup;
	base[9]= base[5];
	base[10]= VV[21];
	vs_top=(vs_base=base+9)+2;
	Lmod();
	vs_top=sup;
	base[8]= vs_base[0];
	base[9]= base[0];
	base[10]= VV[20];
	vs_top=(vs_base=base+9)+2;
	Lfloor();
	if(vs_base<vs_top){
	base[4]= vs_base[0];
	vs_base++;
	}else{
	base[4]= Cnil;}
	if(vs_base<vs_top){
	base[0]= vs_base[0];
	}else{
	base[0]= Cnil;}
	vs_top=sup;
	base[9]= base[0];
	base[10]= VV[22];
	vs_top=(vs_base=base+9)+2;
	Lfloor();
	if(vs_base<vs_top){
	base[3]= vs_base[0];
	vs_base++;
	}else{
	base[3]= Cnil;}
	if(vs_base<vs_top){
	base[2]= vs_base[0];
	}else{
	base[2]= Cnil;}
	vs_top=sup;
	base[10]= base[5];
	base[11]= VV[23];
	vs_top=(vs_base=base+10)+2;
	Lfloor();
	vs_top=sup;
	base[9]= vs_base[0];
	base[7]= number_plus(VV[16],base[9]);
	base[9]= Cnil;
T65:;
	base[12]= base[7];
	vs_top=(vs_base=base+12)+1;
	L8();
	vs_top=sup;
	base[11]= vs_base[0];
	base[9]= number_minus(base[5],base[11]);
	base[10]= base[9];
	base[12]= base[7];
	vs_top=(vs_base=base+12)+1;
	L7();
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T75;}
	base[11]= VV[23];
	goto T73;
T75:;
	base[11]= VV[17];
T73:;
	if(!(number_compare(base[10],base[11])<0)){
	goto T66;}
	base[5]= one_plus(base[9]);
	goto T63;
T66:;
	base[7]= number_plus(base[7],VV[24]);
	goto T65;
T63:;
	base[9]= base[7];
	vs_top=(vs_base=base+9)+1;
	L7();
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T84;}
	if(!(number_compare(base[5],VV[22])==0)){
	goto T88;}
	base[9]= base[2];
	base[10]= base[3];
	base[11]= base[4];
	base[12]= VV[25];
	base[13]= VV[26];
	base[14]= base[7];
	base[15]= base[8];
	base[16]= Cnil;
	base[17]= base[1];
	vs_base=base+9;vs_top=base+18;
	return;
T88:;
	if(!(number_compare(base[5],VV[22])>0)){
	goto T84;}
	base[5]= number_minus(base[5],VV[24]);
T84:;
	base[9]= VV[27];
T105:;
	if(!(number_compare(base[5],car(base[9]))<=0)){
	goto T106;}
	base[10]= make_fixnum(length(base[9]));
	base[6]= number_minus(VV[28],base[10]);
	goto T103;
T106:;
	base[5]= number_minus(base[5],car(base[9]));
	base[9]= cdr(base[9]);
	goto T105;
T103:;
	base[9]= base[2];
	base[10]= base[3];
	base[11]= base[4];
	base[12]= base[5];
	base[13]= base[6];
	base[14]= base[7];
	base[15]= base[8];
	base[16]= Cnil;
	base[17]= base[1];
	vs_base=base+9;vs_top=base+18;
	return;
}
/*	function definition for ENCODE-UNIVERSAL-TIME	*/

static L10()
{	register object *base=vs_base;
	register object *sup=base+VM7;
	vs_reserve(VM7);
	if(vs_top-vs_base<6) too_few_arguments();
	if(vs_top-vs_base>7) too_many_arguments();
	vs_base=vs_base+6;
	if(vs_base>=vs_top){vs_top=sup;goto T125;}
	vs_top=sup;
	goto T126;
T125:;
	base[6]= symbol_value(VV[19]);
T126:;
	base[2]= number_plus(base[2],base[6]);
	base[7]= VV[29];
	base[8]= base[5];
	base[9]= VV[30];
	vs_top=(vs_base=base+7)+3;
	Lmonotonically_nondecreasing();
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T130;}
	symlispcall_no_event(VV[41],base+8,0);
	Llist();
	vs_top=sup;
	base[7]= vs_base[0];
	base[8]= car(base[7]);
	base[9]= cadr(base[7]);
	base[10]= caddr(base[7]);
	base[11]= cadddr(base[7]);
	base[12]= car(cddddr(base[7]));
	base[13]= cadr(cddddr(base[7]));
	base[14]= caddr(cddddr(base[7]));
	base[15]= cadddr(cddddr(base[7]));
	base[16]= nth(8,base[7]);
	base[18]= base[13];
	base[19]= VV[14];
	vs_top=(vs_base=base+18)+2;
	Lmod();
	vs_top=sup;
	base[17]= vs_base[0];
	base[18]= number_minus(base[13],base[17]);
	base[5]= number_plus(base[5],base[18]);
	base[17]= number_minus(base[5],base[13]);
	if(!(number_compare(base[17],VV[32])<0)){
	goto T153;}
	base[5]= number_plus(base[5],VV[14]);
	goto T130;
T153:;
	base[17]= number_minus(base[5],base[13]);
	if(!(number_compare(base[17],VV[33])>=0)){
	goto T130;}
	base[5]= number_minus(base[5],VV[14]);
T130:;
	base[7]= base[5];
	vs_top=(vs_base=base+7)+1;
	L7();
	vs_top=sup;
	if((vs_base[0])==Cnil){
	goto T160;}
	if(number_compare(base[4],VV[26])>0){
	goto T159;}
T160:;
	base[3]= number_minus(base[3],VV[24]);
T159:;
	base[9]= base[3];
	base[11]= base[5];
	vs_top=(vs_base=base+11)+1;
	L8();
	vs_top=sup;
	base[10]= vs_base[0];
	{object V2;
	base[11]= VV[27];
	base[12]= number_minus(VV[28],base[4]);
	vs_top=(vs_base=base+11)+2;
	Lbutlast();
	vs_top=sup;
	V2= vs_base[0];
	 vs_top=base+11;
	 while(!endp(V2))
	 {vs_push(car(V2));V2=cdr(V2);}
	vs_base=base+9;}
	Lplus();
	vs_top=sup;
	base[8]= vs_base[0];
	base[7]= number_times(base[8],VV[12]);
	base[8]= number_times(base[2],VV[20]);
	base[9]= number_times(base[1],VV[22]);
	base[10]= base[0];
	vs_top=(vs_base=base+7)+4;
	Lplus();
	return;
}

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