home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / kcl.lha / cmpnew / cmpbind.c next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  7.3 KB  |  274 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "cmpbind.h"
  5. init_cmpbind(start,size,data)char *start;int size;object data;
  6. {    register object *base=vs_top;register object *sup=base+VM2;vs_check;
  7.     Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
  8.     (void)(putprop(VV[0],VV[1],VV[2]));
  9.     MF(VV[9],L2,start,size,data);
  10.     MF(VV[10],L3,start,size,data);
  11.     MF(VV[11],L4,start,size,data);
  12.     MF(VV[1],L5,start,size,data);
  13.     vs_top=vs_base=base;
  14. }
  15. /*    function definition for C2BIND    */
  16.  
  17. static L2()
  18. {    register object *base=vs_base;
  19.     register object *sup=base+VM3;
  20.     vs_reserve(VM3);
  21.     check_arg(1);
  22.     vs_top=sup;
  23. TTL:;
  24.     {object V1= structure_ref(base[0],VV[3],1);
  25.     if((V1!= VV[12]))goto T2;
  26.     if((structure_ref(base[0],VV[3],3))==Cnil){
  27.     goto T4;}
  28.     princ_str("\n    ",VV[4]);
  29.     base[1]= structure_ref(base[0],VV[3],2);
  30.     (void)simple_symlispcall_no_event(VV[13],base+1,1);
  31.     princ_str("=MMcons(",VV[4]);
  32.     base[1]= structure_ref(base[0],VV[3],2);
  33.     (void)simple_symlispcall_no_event(VV[13],base+1,1);
  34.     princ_char(44,VV[4]);
  35.     (void)simple_symlispcall_no_event(VV[14],base+1,0);
  36.     princ_str(");",VV[4]);
  37.     base[1]= structure_ref(base[0],VV[3],2);
  38.     (void)simple_symlispcall_no_event(VV[15],base+1,1);
  39.     base[1]= simple_symlispcall_no_event(VV[16],base+2,0);
  40.     structure_set(base[0],VV[3],3,base[1]);
  41.     vs_top=(vs_base=base+1)+1;
  42.     return;
  43. T4:;
  44.     base[1]= Cnil;
  45.     vs_top=(vs_base=base+1)+1;
  46.     return;
  47. T2:;
  48.     if((V1!= VV[17]))goto T21;
  49.     princ_str("\n    bds_bind(VV[",VV[4]);
  50.     base[1]= structure_ref(base[0],VV[3],4);
  51.     (void)simple_symlispcall_no_event(VV[18],base+1,1);
  52.     princ_str("],",VV[4]);
  53.     base[1]= structure_ref(base[0],VV[3],2);
  54.     (void)simple_symlispcall_no_event(VV[13],base+1,1);
  55.     princ_str(");",VV[4]);
  56.     setq(VV[5],make_cons(VV[0],symbol_value(VV[5])));
  57.     base[1]= symbol_value(VV[5]);
  58.     vs_top=(vs_base=base+1)+1;
  59.     return;
  60. T21:;
  61.     princ_str("\n    V",VV[4]);
  62.     base[1]= structure_ref(base[0],VV[3],4);
  63.     (void)simple_symlispcall_no_event(VV[18],base+1,1);
  64.     princ_char(61,VV[4]);
  65.     {object V2= structure_ref(base[0],VV[3],1);
  66.     if((V2!= VV[19]))goto T38;
  67.     goto T37;
  68. T38:;
  69.     if((V2!= VV[20]))goto T39;
  70.     princ_str("fix",VV[4]);
  71.     goto T37;
  72. T39:;
  73.     if((V2!= VV[21]))goto T41;
  74.     princ_str("char_code",VV[4]);
  75.     goto T37;
  76. T41:;
  77.     if((V2!= VV[22]))goto T43;
  78.     princ_str("lf",VV[4]);
  79.     goto T37;
  80. T43:;
  81.     if((V2!= VV[23]))goto T45;
  82.     princ_str("sf",VV[4]);
  83.     goto T37;
  84. T45:;
  85.     (void)simple_symlispcall_no_event(VV[24],base+1,0);}
  86. T37:;
  87.     princ_char(40,VV[4]);
  88.     base[1]= structure_ref(base[0],VV[3],2);
  89.     (void)simple_symlispcall_no_event(VV[13],base+1,1);
  90.     princ_str(");",VV[4]);
  91.     base[1]= Cnil;
  92.     vs_top=(vs_base=base+1)+1;
  93.     return;}
  94. }
  95. /*    function definition for C2BIND-LOC    */
  96.  
  97. static L3()
  98. {    register object *base=vs_base;
  99.     register object *sup=base+VM4;
  100.     vs_reserve(VM4);
  101.     check_arg(2);
  102.     vs_top=sup;
  103. TTL:;
  104.     {object V3= structure_ref(base[0],VV[3],1);
  105.     if((V3!= VV[12]))goto T52;
  106.     if((structure_ref(base[0],VV[3],3))==Cnil){
  107.     goto T54;}
  108.     princ_str("\n    ",VV[4]);
  109.     base[2]= structure_ref(base[0],VV[3],2);
  110.     (void)simple_symlispcall_no_event(VV[13],base+2,1);
  111.     princ_str("=MMcons(",VV[4]);
  112.     base[2]= base[1];
  113.     (void)simple_symlispcall_no_event(VV[18],base+2,1);
  114.     princ_char(44,VV[4]);
  115.     (void)simple_symlispcall_no_event(VV[14],base+2,0);
  116.     princ_str(");",VV[4]);
  117.     base[2]= structure_ref(base[0],VV[3],2);
  118.     (void)simple_symlispcall_no_event(VV[15],base+2,1);
  119.     base[2]= simple_symlispcall_no_event(VV[16],base+3,0);
  120.     structure_set(base[0],VV[3],3,base[2]);
  121.     vs_top=(vs_base=base+2)+1;
  122.     return;
  123. T54:;
  124.     princ_str("\n    ",VV[4]);
  125.     base[2]= structure_ref(base[0],VV[3],2);
  126.     (void)simple_symlispcall_no_event(VV[13],base+2,1);
  127.     princ_str("= ",VV[4]);
  128.     base[2]= base[1];
  129.     (void)simple_symlispcall_no_event(VV[18],base+2,1);
  130.     princ_char(59,VV[4]);
  131.     base[2]= Cnil;
  132.     vs_top=(vs_base=base+2)+1;
  133.     return;
  134. T52:;
  135.     if((V3!= VV[17]))goto T77;
  136.     princ_str("\n    bds_bind(VV[",VV[4]);
  137.     base[2]= structure_ref(base[0],VV[3],4);
  138.     (void)simple_symlispcall_no_event(VV[18],base+2,1);
  139.     princ_str("],",VV[4]);
  140.     base[2]= base[1];
  141.     (void)simple_symlispcall_no_event(VV[18],base+2,1);
  142.     princ_str(");",VV[4]);
  143.     setq(VV[5],make_cons(VV[0],symbol_value(VV[5])));
  144.     base[2]= symbol_value(VV[5]);
  145.     vs_top=(vs_base=base+2)+1;
  146.     return;
  147. T77:;
  148.     princ_str("\n    V",VV[4]);
  149.     base[2]= structure_ref(base[0],VV[3],4);
  150.     (void)simple_symlispcall_no_event(VV[18],base+2,1);
  151.     princ_str("= ",VV[4]);
  152.     {object V4= structure_ref(base[0],VV[3],1);
  153.     if((V4!= VV[19]))goto T93;
  154.     base[2]= base[1];
  155.     (void)simple_symlispcall_no_event(VV[25],base+2,1);
  156.     goto T92;
  157. T93:;
  158.     if((V4!= VV[20]))goto T95;
  159.     base[2]= base[1];
  160.     (void)simple_symlispcall_no_event(VV[26],base+2,1);
  161.     goto T92;
  162. T95:;
  163.     if((V4!= VV[21]))goto T97;
  164.     base[2]= base[1];
  165.     (void)simple_symlispcall_no_event(VV[27],base+2,1);
  166.     goto T92;
  167. T97:;
  168.     if((V4!= VV[22]))goto T99;
  169.     base[2]= base[1];
  170.     (void)simple_symlispcall_no_event(VV[28],base+2,1);
  171.     goto T92;
  172. T99:;
  173.     if((V4!= VV[23]))goto T101;
  174.     base[2]= base[1];
  175.     (void)simple_symlispcall_no_event(VV[29],base+2,1);
  176.     goto T92;
  177. T101:;
  178.     (void)simple_symlispcall_no_event(VV[24],base+2,0);}
  179. T92:;
  180.     princ_char(59,VV[4]);
  181.     base[2]= Cnil;
  182.     vs_top=(vs_base=base+2)+1;
  183.     return;}
  184. }
  185. /*    function definition for C2BIND-INIT    */
  186.  
  187. static L4()
  188. {    register object *base=vs_base;
  189.     register object *sup=base+VM5;
  190.     vs_reserve(VM5);
  191.     bds_check;
  192.     check_arg(2);
  193.     vs_top=sup;
  194. TTL:;
  195.     {object V5= structure_ref(base[0],VV[3],1);
  196.     if((V5!= VV[12]))goto T104;
  197.     if((structure_ref(base[0],VV[3],3))==Cnil){
  198.     goto T106;}
  199.     base[2]= list(2,VV[6],structure_ref(base[0],VV[3],2));
  200.     bds_bind(VV[7],base[2]);
  201.     base[4]= base[1];
  202.     base[5]= simple_symlispcall_no_event(VV[30],base+4,1);
  203.     bds_unwind1;
  204.     princ_str("\n    ",VV[4]);
  205.     base[3]= base[2];
  206.     (void)simple_symlispcall_no_event(VV[18],base+3,1);
  207.     princ_str("=MMcons(",VV[4]);
  208.     base[3]= base[2];
  209.     (void)simple_symlispcall_no_event(VV[18],base+3,1);
  210.     princ_char(44,VV[4]);
  211.     base[3]= symbol_value(VV[8]);
  212.     (void)simple_symlispcall_no_event(VV[14],base+3,1);
  213.     princ_str(");",VV[4]);
  214.     base[2]= structure_ref(base[0],VV[3],2);
  215.     (void)simple_symlispcall_no_event(VV[15],base+2,1);
  216.     base[2]= simple_symlispcall_no_event(VV[16],base+3,0);
  217.     structure_set(base[0],VV[3],3,base[2]);
  218.     vs_top=(vs_base=base+2)+1;
  219.     return;
  220. T106:;
  221.     base[2]= list(2,VV[6],structure_ref(base[0],VV[3],2));
  222.     bds_bind(VV[7],base[2]);
  223.     base[3]= base[1];
  224.     symlispcall_no_event(VV[30],base+3,1);
  225.     bds_unwind1;
  226.     return;
  227. T104:;
  228.     if((V5!= VV[17]))goto T128;
  229.     base[2]= list(2,VV[0],structure_ref(base[0],VV[3],4));
  230.     bds_bind(VV[7],base[2]);
  231.     base[3]= base[1];
  232.     base[4]= simple_symlispcall_no_event(VV[30],base+3,1);
  233.     bds_unwind1;
  234.     setq(VV[5],make_cons(VV[0],symbol_value(VV[5])));
  235.     base[2]= symbol_value(VV[5]);
  236.     vs_top=(vs_base=base+2)+1;
  237.     return;
  238. T128:;
  239.     if((V5!= VV[19])
  240.     && (V5!= VV[20])
  241.     && (V5!= VV[21])
  242.     && (V5!= VV[22])
  243.     && (V5!= VV[23]))goto T133;
  244.     base[2]= list(3,VV[3],base[0],Cnil);
  245.     bds_bind(VV[7],base[2]);
  246.     base[3]= base[1];
  247.     symlispcall_no_event(VV[30],base+3,1);
  248.     bds_unwind1;
  249.     return;
  250. T133:;
  251.     symlispcall_no_event(VV[24],base+2,0);
  252.     return;}
  253. }
  254. /*    function definition for SET-BDS-BIND    */
  255.  
  256. static L5()
  257. {    register object *base=vs_base;
  258.     register object *sup=base+VM6;
  259.     vs_reserve(VM6);
  260.     check_arg(2);
  261.     vs_top=sup;
  262. TTL:;
  263.     princ_str("\n    bds_bind(VV[",VV[4]);
  264.     base[2]= base[1];
  265.     (void)simple_symlispcall_no_event(VV[18],base+2,1);
  266.     princ_str("],",VV[4]);
  267.     base[2]= base[0];
  268.     (void)simple_symlispcall_no_event(VV[18],base+2,1);
  269.     princ_str(");",VV[4]);
  270.     base[2]= Cnil;
  271.     vs_top=(vs_base=base+2)+1;
  272.     return;
  273. }
  274.