home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / lsp / module.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  3.6 KB  |  177 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "module.h"
  5. init_module(start,size,data)char *start;int size;object data;
  6. {    register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
  7.     Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
  8.     VV[0]->s.s_stype=(short)stp_special;
  9.     if(VV[0]->s.s_dbind == OBJNULL){
  10.     VV[0]->s.s_dbind = Cnil;}
  11.     MF(VV[11],L1,start,size,data);
  12.     MF(VV[12],L2,start,size,data);
  13.     MF(VV[13],L3,start,size,data);
  14.     MF(VV[14],L4,start,size,data);
  15.     vs_top=vs_base=base;
  16. }
  17. /*    function definition for PROVIDE    */
  18.  
  19. static L1()
  20. {    register object *base=vs_base;
  21.     register object *sup=base+VM3;
  22.     vs_reserve(VM3);
  23.     check_arg(1);
  24.     vs_top=sup;
  25. TTL:;
  26.     base[1]= coerce_to_string(base[0]);
  27.     base[2]= symbol_value(VV[0]);
  28.     base[3]= VV[1];
  29.     base[4]= symbol_function(VV[15]);
  30.     vs_top=(vs_base=base+1)+4;
  31.     Ladjoin();
  32.     vs_top=sup;
  33.     setq(VV[0],vs_base[0]);
  34.     base[1]= symbol_value(VV[0]);
  35.     vs_top=(vs_base=base+1)+1;
  36.     return;
  37. }
  38. /*    function definition for REQUIRE    */
  39.  
  40. static L2()
  41. {    register object *base=vs_base;
  42.     register object *sup=base+VM4;
  43.     vs_reserve(VM4);
  44.     bds_check;
  45.     if(vs_top-vs_base<1) too_few_arguments();
  46.     if(vs_top-vs_base>2) too_many_arguments();
  47.     vs_base=vs_base+1;
  48.     if(vs_base>=vs_top){vs_top=sup;goto T7;}
  49.     vs_top=sup;
  50.     goto T8;
  51. T7:;
  52.     base[2]= coerce_to_string(base[0]);
  53.     vs_top=(vs_base=base+2)+1;
  54.     Lstring_downcase();
  55.     vs_top=sup;
  56.     base[1]= vs_base[0];
  57. T8:;
  58.     bds_bind(VV[2],VV[3]);
  59.     base[3]= coerce_to_string(base[0]);
  60.     base[4]= symbol_value(VV[0]);
  61.     base[5]= VV[1];
  62.     base[6]= symbol_function(VV[15]);
  63.     vs_top=(vs_base=base+3)+4;
  64.     Lmember();
  65.     vs_top=sup;
  66.     if((vs_base[0])!=Cnil){
  67.     goto T12;}
  68.     if(!(type_of(base[1])!=t_cons)){
  69.     goto T19;}
  70.     base[3]= base[1];
  71.     vs_top=(vs_base=base+3)+1;
  72.     Lload();
  73.     bds_unwind1;
  74.     return;
  75. T19:;
  76.     base[3]= base[1];
  77. T23:;
  78.     if(!(endp(base[3]))){
  79.     goto T24;}
  80.     base[4]= Cnil;
  81.     vs_top=(vs_base=base+4)+1;
  82.     bds_unwind1;
  83.     return;
  84. T24:;
  85.     base[4]= car(base[3]);
  86.     vs_top=(vs_base=base+4)+1;
  87.     Lload();
  88.     vs_top=sup;
  89.     base[3]= cdr(base[3]);
  90.     goto T23;
  91. T12:;
  92.     base[3]= Cnil;
  93.     vs_top=(vs_base=base+3)+1;
  94.     bds_unwind1;
  95.     return;
  96. }
  97. /*    function definition for DOCUMENTATION    */
  98.  
  99. static L3()
  100. {    register object *base=vs_base;
  101.     register object *sup=base+VM5;
  102.     vs_reserve(VM5);
  103.     check_arg(2);
  104.     vs_top=sup;
  105. TTL:;
  106.     {object V1= base[1];
  107.     if((V1!= VV[16]))goto T33;
  108.     base[2]= get(base[0],VV[4],Cnil);
  109.     vs_top=(vs_base=base+2)+1;
  110.     return;
  111. T33:;
  112.     if((V1!= VV[17]))goto T34;
  113.     base[2]= get(base[0],VV[5],Cnil);
  114.     vs_top=(vs_base=base+2)+1;
  115.     return;
  116. T34:;
  117.     if((V1!= VV[18]))goto T35;
  118.     base[2]= get(base[0],VV[6],Cnil);
  119.     vs_top=(vs_base=base+2)+1;
  120.     return;
  121. T35:;
  122.     if((V1!= VV[19]))goto T36;
  123.     base[2]= get(base[0],VV[7],Cnil);
  124.     vs_top=(vs_base=base+2)+1;
  125.     return;
  126. T36:;
  127.     if((V1!= VV[20]))goto T37;
  128.     base[2]= get(base[0],VV[8],Cnil);
  129.     vs_top=(vs_base=base+2)+1;
  130.     return;
  131. T37:;
  132.     base[2]= VV[9];
  133.     base[3]= base[1];
  134.     vs_top=(vs_base=base+2)+2;
  135.     Lerror();
  136.     return;}
  137. }
  138. /*    function definition for FIND-DOCUMENTATION    */
  139.  
  140. static L4()
  141. {    register object *base=vs_base;
  142.     register object *sup=base+VM6;
  143.     vs_reserve(VM6);
  144.     check_arg(1);
  145.     vs_top=sup;
  146. TTL:;
  147.     if(endp(base[0])){
  148.     goto T40;}
  149.     if(!(endp(cdr(base[0])))){
  150.     goto T41;}
  151. T40:;
  152.     base[1]= Cnil;
  153.     vs_top=(vs_base=base+1)+1;
  154.     return;
  155. T41:;
  156.     base[2]= car(base[0]);
  157.     vs_top=(vs_base=base+2)+1;
  158.     Lmacroexpand();
  159.     vs_top=sup;
  160.     base[1]= vs_base[0];
  161.     if(!(type_of(base[1])==t_string)){
  162.     goto T48;}
  163.     vs_top=(vs_base=base+1)+1;
  164.     return;
  165. T48:;
  166.     if(!(type_of(base[1])==t_cons)){
  167.     goto T51;}
  168.     if(!(car(base[1])==VV[10])){
  169.     goto T51;}
  170.     base[0]= cdr(base[0]);
  171.     goto TTL;
  172. T51:;
  173.     base[2]= Cnil;
  174.     vs_top=(vs_base=base+2)+1;
  175.     return;
  176. }
  177.