home *** CD-ROM | disk | FTP | other *** search
-
- /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
- #include <cmpinclude.h>
- #include "iolib.h"
- init_iolib(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[53],base+0,1);
- MM(VV[54],L2,start,size,data);
- MM(VV[55],L3,start,size,data);
- MM(VV[56],L4,start,size,data);
- MF(VV[57],L5,start,size,data);
- MF(VV[58],L6,start,size,data);
- MF(VV[59],L7,start,size,data);
- MF(VV[60],L8,start,size,data);
- MM(VV[61],L9,start,size,data);
- MF(VV[62],L10,start,size,data);
- MF(VV[63],L11,start,size,data);
- MF(VV[25],L12,start,size,data);
- base[0]= VV[23];
- base[1]= VV[24];
- base[2]= VV[25];
- (void)simple_symlispcall_no_event(VV[64],base+0,3);
- base[0]= VV[23];
- base[1]= VV[26];
- base[2]= VV[25];
- (void)simple_symlispcall_no_event(VV[64],base+0,3);
- MF(VV[34],L15,start,size,data);
- base[0]= VV[23];
- base[1]= VV[33];
- base[2]= VV[34];
- (void)simple_symlispcall_no_event(VV[64],base+0,3);
- base[0]= VV[23];
- base[1]= VV[35];
- base[2]= VV[34];
- (void)simple_symlispcall_no_event(VV[64],base+0,3);
- VV[36]->s.s_stype=(short)stp_special;
- if(VV[36]->s.s_dbind == OBJNULL){
- VV[36]->s.s_dbind = Cnil;}
- VV[37]->s.s_stype=(short)stp_special;
- if(VV[37]->s.s_dbind == OBJNULL){
- VV[37]->s.s_dbind = Cnil;}
- VV[38]->s.s_stype=(short)stp_special;
- if(VV[38]->s.s_dbind == OBJNULL){
- VV[38]->s.s_dbind = Cnil;}
- VV[39]->s.s_stype=(short)stp_special;
- if(VV[39]->s.s_dbind == OBJNULL){
- VV[39]->s.s_dbind = Cnil;}
- MF(VV[65],L18,start,size,data);
- vs_top=vs_base=base;
- }
- /* macro definition for WITH-OPEN-STREAM */
-
- 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();
- {object V2= (V1->c.c_car);
- if(endp(V2))invalid_macro_call();
- base[2]= (V2->c.c_car);
- V2=V2->c.c_cdr;
- if(endp(V2))invalid_macro_call();
- base[3]= (V2->c.c_car);
- V2=V2->c.c_cdr;
- if(!endp(V2))invalid_macro_call();}
- V1=V1->c.c_cdr;
- base[4]= V1;}
- base[6]= base[4];
- symlispcall_no_event(VV[66],base+6,1);
- Llist();
- vs_top=sup;
- base[5]= vs_base[0];
- base[6]= car(base[5]);
- base[7]= cadr(base[5]);
- base[8]= list(2,base[2],base[3]);
- base[9]= make_cons(base[8],Cnil);
- base[10]= make_cons(VV[3],base[7]);
- base[11]= list(2,VV[4],base[2]);
- base[12]= list(3,VV[2],base[10],base[11]);
- base[13]= make_cons(base[12],Cnil);
- base[14]= append(base[6],base[13]);
- base[15]= listA(3,VV[1],base[9],base[14]);
- vs_top=(vs_base=base+15)+1;
- return;
- }
- /* macro definition for WITH-INPUT-FROM-STRING */
-
- static L3()
- { register object *base=vs_base;
- register object *sup=base+VM4;
- vs_reserve(VM4);
- check_arg(2);
- vs_top=sup;
- {object V3=base[0]->c.c_cdr;
- if(endp(V3))invalid_macro_call();
- {object V4= (V3->c.c_car);
- if(endp(V4))invalid_macro_call();
- base[2]= (V4->c.c_car);
- V4=V4->c.c_cdr;
- if(endp(V4))invalid_macro_call();
- base[3]= (V4->c.c_car);
- V4=V4->c.c_cdr;
- {object V5=getf(V4,VV[67],OBJNULL);
- if(V5==OBJNULL){
- base[4]= Cnil;
- } else {
- base[4]= V5;}}
- {object V6=getf(V4,VV[68],OBJNULL);
- if(V6==OBJNULL){
- base[5]= Cnil;
- } else {
- base[5]= V6;}}
- {object V7=getf(V4,VV[69],OBJNULL);
- if(V7==OBJNULL){
- base[6]= Cnil;
- } else {
- base[6]= V7;}}
- check_other_key(V4,3,VV[67],VV[68],VV[69]);}
- V3=V3->c.c_cdr;
- base[7]= V3;}
- if((base[4])==Cnil){
- goto T32;}
- base[9]= base[7];
- symlispcall_no_event(VV[66],base+9,1);
- Llist();
- vs_top=sup;
- base[8]= vs_base[0];
- base[9]= car(base[8]);
- base[10]= cadr(base[8]);
- base[11]= list(4,VV[5],base[3],base[5],base[6]);
- base[12]= list(2,base[2],base[11]);
- base[13]= make_cons(base[12],Cnil);
- base[14]= make_cons(VV[3],base[10]);
- base[15]= list(2,VV[7],base[2]);
- base[16]= list(3,VV[6],base[4],base[15]);
- base[17]= list(3,VV[2],base[14],base[16]);
- base[18]= make_cons(base[17],Cnil);
- base[19]= append(base[9],base[18]);
- base[20]= listA(3,VV[1],base[13],base[19]);
- vs_top=(vs_base=base+20)+1;
- return;
- T32:;
- base[8]= list(4,VV[5],base[3],base[5],base[6]);
- base[9]= list(2,base[2],base[8]);
- base[10]= make_cons(base[9],Cnil);
- base[11]= listA(3,VV[1],base[10],base[7]);
- vs_top=(vs_base=base+11)+1;
- return;
- }
- /* macro definition for WITH-OUTPUT-TO-STRING */
-
- static L4()
- { register object *base=vs_base;
- register object *sup=base+VM5;
- vs_reserve(VM5);
- check_arg(2);
- vs_top=sup;
- {object V8=base[0]->c.c_cdr;
- if(endp(V8))invalid_macro_call();
- {object V9= (V8->c.c_car);
- if(endp(V9))invalid_macro_call();
- base[2]= (V9->c.c_car);
- V9=V9->c.c_cdr;
- if(endp(V9)){
- base[3]= Cnil;
- } else {
- base[3]= (V9->c.c_car);
- V9=V9->c.c_cdr;}
- if(!endp(V9))invalid_macro_call();}
- V8=V8->c.c_cdr;
- base[4]= V8;}
- if((base[3])==Cnil){
- goto T41;}
- base[5]= list(2,VV[8],base[3]);
- base[6]= list(2,base[2],base[5]);
- base[7]= make_cons(base[6],Cnil);
- base[8]= listA(3,VV[1],base[7],base[4]);
- vs_top=(vs_base=base+8)+1;
- return;
- T41:;
- base[5]= list(2,base[2],VV[9]);
- base[6]= make_cons(base[5],Cnil);
- base[7]= list(2,VV[10],base[2]);
- base[8]= make_cons(base[7],Cnil);
- base[9]= append(base[4],base[8]);
- base[10]= listA(3,VV[1],base[6],base[9]);
- vs_top=(vs_base=base+10)+1;
- return;
- }
- /* function definition for READ-FROM-STRING */
-
- static L5()
- { register object *base=vs_base;
- register object *sup=base+VM6;
- vs_reserve(VM6);
- if(vs_top-vs_base<1) too_few_arguments();
- parse_key(vs_base+3,FALSE,FALSE,3,VV[68],VV[69],VV[70]);
- vs_base += 1;
- if(vs_base>=vs_top){vs_top=sup;goto T43;}
- vs_base++;
- if(vs_base>=vs_top){vs_top=sup;goto T44;}
- vs_top=sup;goto T45;
- T43:;
- base[1]= Ct;
- T44:;
- base[2]= Cnil;
- T45:;
- if(base[6]==Cnil){
- base[3]= VV[11];
- }else{}
- if(base[7]==Cnil){
- base[4]= make_fixnum(length(base[0]));
- }else{}
- base[10]= base[0];
- base[11]= base[3];
- base[12]= base[4];
- base[9]= simple_symlispcall_no_event(VV[5],base+10,3);
- if((base[5])==Cnil){
- goto T55;}
- base[11]= base[9];
- base[12]= base[1];
- base[13]= base[2];
- base[10]= simple_symlispcall_no_event(VV[71],base+11,3);
- base[12]= base[9];
- base[11]= simple_symlispcall_no_event(VV[7],base+12,1);
- vs_base=base+10;vs_top=base+12;
- return;
- T55:;
- base[11]= base[9];
- base[12]= base[1];
- base[13]= base[2];
- vs_top=(vs_base=base+11)+3;
- Lread();
- vs_top=sup;
- base[10]= vs_base[0];
- base[12]= base[9];
- base[11]= simple_symlispcall_no_event(VV[7],base+12,1);
- vs_base=base+10;vs_top=base+12;
- return;
- }
- /* function definition for WRITE-TO-STRING */
-
- static L6()
- { register object *base=vs_base;
- register object *sup=base+VM7;
- vs_reserve(VM7);
- if(vs_top-vs_base<1) too_few_arguments();
- parse_key(vs_base+1,TRUE,FALSE,10,VV[72],VV[73],VV[74],VV[75],VV[76],VV[77],VV[78],VV[79],VV[80],VV[81]);
- vs_top=sup;
- base[22]= simple_symlispcall_no_event(VV[82],base+23,0);
- base[23]= base[0];
- base[24]= VV[12];
- base[25]= base[22];
- {object V10;
- V10= base[1];
- vs_top=base+26;
- while(!endp(V10))
- {vs_push(car(V10));V10=cdr(V10);}
- vs_base=base+23;}
- Lwrite();
- vs_top=sup;
- base[23]= base[22];
- symlispcall_no_event(VV[10],base+23,1);
- return;
- }
- /* function definition for PRIN1-TO-STRING */
-
- static L7()
- { register object *base=vs_base;
- register object *sup=base+VM8;
- vs_reserve(VM8);
- check_arg(1);
- vs_top=sup;
- TTL:;
- base[1]= simple_symlispcall_no_event(VV[82],base+2,0);
- (void)(prin1(base[0],base[1]));
- base[2]= base[1];
- symlispcall_no_event(VV[10],base+2,1);
- return;
- }
- /* function definition for PRINC-TO-STRING */
-
- static L8()
- { register object *base=vs_base;
- register object *sup=base+VM9;
- vs_reserve(VM9);
- check_arg(1);
- vs_top=sup;
- TTL:;
- base[1]= simple_symlispcall_no_event(VV[82],base+2,0);
- (void)(princ(base[0],base[1]));
- base[2]= base[1];
- symlispcall_no_event(VV[10],base+2,1);
- return;
- }
- /* macro definition for WITH-OPEN-FILE */
-
- static L9()
- { register object *base=vs_base;
- register object *sup=base+VM10;
- vs_reserve(VM10);
- check_arg(2);
- vs_top=sup;
- {object V11=base[0]->c.c_cdr;
- if(endp(V11))invalid_macro_call();
- {object V12= (V11->c.c_car);
- if(endp(V12))invalid_macro_call();
- base[2]= (V12->c.c_car);
- V12=V12->c.c_cdr;
- base[3]= V12;}
- V11=V11->c.c_cdr;
- base[4]= V11;}
- base[6]= base[4];
- symlispcall_no_event(VV[66],base+6,1);
- Llist();
- vs_top=sup;
- base[5]= vs_base[0];
- base[6]= car(base[5]);
- base[7]= cadr(base[5]);
- base[8]= make_cons(VV[13],base[3]);
- base[9]= list(2,base[2],base[8]);
- base[10]= make_cons(base[9],Cnil);
- base[11]= make_cons(VV[3],base[7]);
- base[12]= list(2,VV[4],base[2]);
- base[13]= list(3,VV[2],base[11],base[12]);
- base[14]= make_cons(base[13],Cnil);
- base[15]= append(base[6],base[14]);
- base[16]= listA(3,VV[1],base[10],base[15]);
- vs_top=(vs_base=base+16)+1;
- return;
- }
- /* function definition for Y-OR-N-P */
-
- static L10()
- { register object *base=vs_base;
- register object *sup=base+VM11;
- vs_reserve(VM11);
- if(vs_base>=vs_top){vs_top=sup;goto T87;}
- vs_base++;
- vs_top[0]=Cnil;
- {object *p=vs_top;
- for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
- vs_top=sup;
- goto T88;
- T87:;
- base[0]= Cnil;
- base[1]= Cnil;
- T88:;
- base[2]= Cnil;
- T91:;
- if((base[0])==Cnil){
- goto T94;}
- base[3]= symbol_value(VV[14]);
- base[4]= VV[15];
- base[5]= base[0];
- base[6]= base[1];
- vs_top=(vs_base=base+3)+4;
- Lformat();
- vs_top=sup;
- T94:;
- base[3]= symbol_value(VV[14]);
- vs_top=(vs_base=base+3)+1;
- Lread();
- vs_top=sup;
- base[2]= vs_base[0];
- base[4]= base[2];
- vs_top=(vs_base=base+4)+1;
- Lsymbol_name();
- vs_top=sup;
- base[3]= vs_base[0];
- base[4]= VV[16];
- vs_top=(vs_base=base+3)+2;
- Lstring_equal();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T106;}
- base[3]= Ct;
- vs_top=(vs_base=base+3)+1;
- return;
- T106:;
- base[4]= base[2];
- vs_top=(vs_base=base+4)+1;
- Lsymbol_name();
- vs_top=sup;
- base[3]= vs_base[0];
- base[4]= VV[17];
- vs_top=(vs_base=base+3)+2;
- Lstring_equal();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T104;}
- base[3]= Cnil;
- vs_top=(vs_base=base+3)+1;
- return;
- T104:;
- goto T91;
- }
- /* function definition for YES-OR-NO-P */
-
- static L11()
- { register object *base=vs_base;
- register object *sup=base+VM12;
- vs_reserve(VM12);
- if(vs_base>=vs_top){vs_top=sup;goto T118;}
- vs_base++;
- vs_top[0]=Cnil;
- {object *p=vs_top;
- for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
- vs_top=sup;
- goto T119;
- T118:;
- base[0]= Cnil;
- base[1]= Cnil;
- T119:;
- base[2]= Cnil;
- T122:;
- if((base[0])==Cnil){
- goto T125;}
- base[3]= symbol_value(VV[14]);
- base[4]= VV[18];
- base[5]= base[0];
- base[6]= base[1];
- vs_top=(vs_base=base+3)+4;
- Lformat();
- vs_top=sup;
- T125:;
- base[3]= symbol_value(VV[14]);
- vs_top=(vs_base=base+3)+1;
- Lread();
- vs_top=sup;
- base[2]= vs_base[0];
- base[4]= base[2];
- vs_top=(vs_base=base+4)+1;
- Lsymbol_name();
- vs_top=sup;
- base[3]= vs_base[0];
- base[4]= VV[19];
- vs_top=(vs_base=base+3)+2;
- Lstring_equal();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T137;}
- base[3]= Ct;
- vs_top=(vs_base=base+3)+1;
- return;
- T137:;
- base[4]= base[2];
- vs_top=(vs_base=base+4)+1;
- Lsymbol_name();
- vs_top=sup;
- base[3]= vs_base[0];
- base[4]= VV[20];
- vs_top=(vs_base=base+3)+2;
- Lstring_equal();
- vs_top=sup;
- if((vs_base[0])==Cnil){
- goto T135;}
- base[3]= Cnil;
- vs_top=(vs_base=base+3)+1;
- return;
- T135:;
- goto T122;
- }
- /* function definition for SHARP-A-READER */
-
- static L12()
- { register object *base=vs_base;
- register object *sup=base+VM13;
- vs_reserve(VM13);
- check_arg(3);
- vs_top=sup;
- TTL:;
- base[4]= base[0];
- base[5]= Cnil;
- base[6]= Cnil;
- base[7]= Ct;
- vs_top=(vs_base=base+4)+4;
- Lread();
- vs_top=sup;
- base[3]= vs_base[0];
- if((symbol_value(VV[21]))==Cnil){
- goto T155;}
- base[4]= Cnil;
- vs_top=(vs_base=base+4)+1;
- return;
- T155:;
- base[4]= VV[11];
- base[5]= Cnil;
- base[6]= base[3];
- T158:;
- if(!(number_compare(base[4],base[2])>=0)){
- goto T159;}
- base[7]=symbol_function(VV[83]);
- base[8]= nreverse(base[5]);
- base[9]= VV[22];
- base[10]= base[3];
- lispcall_no_event(base+7,3);
- return;
- T159:;
- base[4]= one_plus(base[4]);
- base[7]= make_fixnum(length(base[6]));
- base[5]= make_cons(base[7],base[5]);
- base[6]= elt(base[6],0);
- goto T158;
- }
- /* function definition for SHARP-S-READER */
-
- static L15()
- { register object *base=vs_base;
- register object *sup=base+VM14;
- vs_reserve(VM14);
- check_arg(3);
- vs_top=sup;
- TTL:;
- if((base[2])==Cnil){
- goto T171;}
- if((symbol_value(VV[21]))!=Cnil){
- goto T171;}
- base[3]= VV[27];
- base[4]= base[2];
- vs_top=(vs_base=base+3)+2;
- Lerror();
- vs_top=sup;
- T171:;
- base[4]= base[0];
- vs_top=(vs_base=base+4)+1;
- Lread();
- vs_top=sup;
- base[3]= vs_base[0];
- if((get(car(base[3]),VV[28],Cnil))!=Cnil){
- goto T180;}
- base[4]= VV[29];
- base[5]= car(base[3]);
- vs_top=(vs_base=base+4)+2;
- Lerror();
- vs_top=sup;
- T180:;
- base[4]= cdr(base[3]);
- T187:;
- if(!(endp(base[4]))){
- goto T188;}
- base[5]= get(car(base[3]),VV[30],Cnil);
- T193:;
- if(!(endp(base[5]))){
- goto T194;}
- base[6]= VV[31];
- base[7]= car(base[3]);
- vs_top=(vs_base=base+6)+2;
- Lerror();
- return;
- T194:;
- if(!(type_of(car(base[5]))==t_symbol)){
- goto T200;}
- base[6]= car(base[5]);
- {object V13;
- V13= cdr(base[3]);
- vs_top=base+7;
- while(!endp(V13))
- {vs_push(car(V13));V13=cdr(V13);}
- vs_base=base+7;}
- super_funcall_no_event(base[6]);
- return;
- T200:;
- base[5]= cdr(base[5]);
- goto T193;
- T188:;
- base[6]= coerce_to_string(car(base[4]));
- base[7]= VV[32];
- vs_top=(vs_base=base+6)+2;
- Lintern();
- vs_top=sup;
- base[5]= vs_base[0];
- if(type_of(base[4])!=t_cons)FEwrong_type_argument(Scons,base[4]);
- (base[4])->c.c_car = base[5];
- base[4]= cddr(base[4]);
- goto T187;
- }
- /* function definition for DRIBBLE */
-
- static L18()
- { register object *base=vs_base;
- register object *sup=base+VM15;
- vs_reserve(VM15);
- if(vs_top-vs_base>2) too_many_arguments();
- if(vs_base>=vs_top){vs_top=sup;goto T216;}
- base[2]= Ct;
- vs_base++;
- if(vs_base>=vs_top){vs_top=sup;goto T217;}
- vs_top=sup;
- goto T218;
- T216:;
- base[0]= VV[40];
- base[2]= Cnil;
- T217:;
- base[1]= VV[41];
- T218:;
- if((base[2])!=Cnil){
- goto T222;}
- if((symbol_value(VV[36]))!=Cnil){
- goto T224;}
- base[3]= VV[42];
- vs_top=(vs_base=base+3)+1;
- Lerror();
- vs_top=sup;
- T224:;
- if(!(symbol_value(VV[37])==symbol_value(VV[43]))){
- goto T230;}
- setq(VV[43],symbol_value(VV[39]));
- goto T228;
- T230:;
- base[3]= VV[44];
- (void)simple_symlispcall_no_event(VV[84],base+3,1);
- T228:;
- base[3]= symbol_value(VV[36]);
- vs_top=(vs_base=base+3)+1;
- Lclose();
- vs_top=sup;
- setq(VV[36],Cnil);
- base[3]= Ct;
- base[4]= VV[45];
- base[5]= symbol_value(VV[38]);
- vs_top=(vs_base=base+3)+3;
- Lformat();
- return;
- T222:;
- if((symbol_value(VV[36]))==Cnil){
- goto T242;}
- base[3]= VV[46];
- base[4]= symbol_value(VV[38]);
- vs_top=(vs_base=base+3)+2;
- Lerror();
- return;
- T242:;
- base[4]= base[0];
- vs_top=(vs_base=base+4)+1;
- Lnamestring();
- vs_top=sup;
- base[3]= vs_base[0];
- base[5]= base[0];
- base[6]= VV[47];
- base[7]= VV[48];
- base[8]= VV[49];
- base[9]= base[1];
- base[10]= VV[50];
- base[11]= VV[51];
- vs_top=(vs_base=base+5)+7;
- Lopen();
- vs_top=sup;
- base[4]= vs_base[0];
- setq(VV[38],base[3]);
- setq(VV[36],base[4]);
- setq(VV[39],symbol_value(VV[43]));
- base[6]= symbol_value(VV[43]);
- base[7]= base[4];
- vs_top=(vs_base=base+6)+2;
- Lmake_echo_stream();
- vs_top=sup;
- base[5]= vs_base[0];
- base[7]= symbol_value(VV[43]);
- base[8]= base[4];
- vs_top=(vs_base=base+7)+2;
- Lmake_broadcast_stream();
- vs_top=sup;
- base[6]= vs_base[0];
- vs_top=(vs_base=base+5)+2;
- Lmake_two_way_stream();
- vs_top=sup;
- setq(VV[37],vs_base[0]);
- setq(VV[43],symbol_value(VV[37]));
- symlispcall_no_event(VV[85],base+6,0);
- Llist();
- vs_top=sup;
- base[5]= vs_base[0];
- base[6]= car(base[5]);
- base[7]= cadr(base[5]);
- base[8]= caddr(base[5]);
- base[9]= cadddr(base[5]);
- base[10]= car(cddddr(base[5]));
- base[11]= cadr(cddddr(base[5]));
- base[12]= Ct;
- base[13]= VV[52];
- base[14]= base[3];
- base[15]= base[11];
- base[16]= base[10];
- base[17]= base[9];
- base[18]= base[8];
- base[19]= base[7];
- base[20]= base[6];
- vs_top=(vs_base=base+12)+9;
- Lformat();
- return;
- }
-