home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / cmpnew / cmpcatch.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  8.8 KB  |  324 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "cmpcatch.h"
  5. init_cmpcatch(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.     (void)(putprop(VV[0],VV[1],VV[2]));
  9.     (void)(putprop(VV[0],VV[3],VV[4]));
  10.     (void)(putprop(VV[5],VV[6],VV[2]));
  11.     (void)(putprop(VV[5],VV[7],VV[4]));
  12.     (void)(putprop(VV[8],VV[9],VV[2]));
  13.     (void)(putprop(VV[8],VV[10],VV[4]));
  14.     MF(VV[1],L7,start,size,data);
  15.     (void)(putprop(VV[14],VV[15],VV[16]));
  16.     MF(VV[3],L9,start,size,data);
  17.     MF(VV[15],L10,start,size,data);
  18.     MF(VV[6],L11,start,size,data);
  19.     MF(VV[7],L12,start,size,data);
  20.     MF(VV[9],L13,start,size,data);
  21.     MF(VV[10],L14,start,size,data);
  22.     vs_top=vs_base=base;
  23. }
  24. /*    function definition for C1CATCH    */
  25.  
  26. static L7()
  27. {    register object *base=vs_base;
  28.     register object *sup=base+VM3;
  29.     vs_reserve(VM3);
  30.     check_arg(1);
  31.     vs_top=sup;
  32. TTL:;
  33.     base[2]= VV[11];
  34.     base[3]= Ct;
  35.     base[1]= simple_symlispcall_no_event(VV[35],base+2,2);
  36.     base[2]= Cnil;
  37.     if(!(endp(base[0]))){
  38.     goto T11;}
  39.     base[3]= VV[0];
  40.     base[4]= VV[12];
  41.     base[5]= VV[13];
  42.     (void)simple_symlispcall_no_event(VV[36],base+3,3);
  43. T11:;
  44.     base[3]= car(base[0]);
  45.     base[2]= simple_symlispcall_no_event(VV[37],base+3,1);
  46.     base[3]= base[1];
  47.     base[4]= cadr(base[2]);
  48.     (void)simple_symlispcall_no_event(VV[38],base+3,2);
  49.     base[3]= cdr(base[0]);
  50.     base[0]= simple_symlispcall_no_event(VV[39],base+3,1);
  51.     base[3]= base[1];
  52.     base[4]= cadr(base[0]);
  53.     (void)simple_symlispcall_no_event(VV[38],base+3,2);
  54.     base[3]= list(4,VV[0],base[1],base[2],base[0]);
  55.     vs_top=(vs_base=base+3)+1;
  56.     return;
  57. }
  58. /*    function definition for C2CATCH    */
  59.  
  60. static L9()
  61. {    register object *base=vs_base;
  62.     register object *sup=base+VM4;
  63.     vs_reserve(VM4);
  64.     bds_check;
  65.     check_arg(2);
  66.     vs_top=sup;
  67. TTL:;
  68.     bds_bind(VV[17],symbol_value(VV[17]));
  69.     bds_bind(VV[18],VV[19]);
  70.     base[4]= base[0];
  71.     base[5]= simple_symlispcall_no_event(VV[40],base+4,1);
  72.     bds_unwind1;
  73.     princ_str("\n    if(nlj_active)",VV[20]);
  74.     princ_str("\n    {nlj_active=FALSE;frs_pop();",VV[20]);
  75.     base[3]= VV[21];
  76.     base[4]= VV[22];
  77.     (void)simple_symlispcall_no_event(VV[41],base+3,2);
  78.     princ_char(125,VV[20]);
  79.     princ_str("\n    else{",VV[20]);
  80.     base[3]= make_cons(VV[24],symbol_value(VV[23]));
  81.     bds_bind(VV[23],base[3]);
  82.     base[4]= base[1];
  83.     base[5]= simple_symlispcall_no_event(VV[42],base+4,1);
  84.     bds_unwind1;
  85.     princ_char(125,VV[20]);
  86.     base[3]= Cnil;
  87.     vs_top=(vs_base=base+3)+1;
  88.     bds_unwind1;
  89.     return;
  90. }
  91. /*    function definition for SET-PUSH-CATCH-FRAME    */
  92.  
  93. static L10()
  94. {    register object *base=vs_base;
  95.     register object *sup=base+VM5;
  96.     vs_reserve(VM5);
  97.     check_arg(1);
  98.     vs_top=sup;
  99. TTL:;
  100.     princ_str("\n    frs_push(FRS_CATCH,",VV[20]);
  101.     base[1]= base[0];
  102.     (void)simple_symlispcall_no_event(VV[43],base+1,1);
  103.     princ_str(");",VV[20]);
  104.     base[1]= Cnil;
  105.     vs_top=(vs_base=base+1)+1;
  106.     return;
  107. }
  108. /*    function definition for C1UNWIND-PROTECT    */
  109.  
  110. static L11()
  111. {    register object *base=vs_base;
  112.     register object *sup=base+VM6;
  113.     vs_reserve(VM6);
  114.     bds_check;
  115.     check_arg(1);
  116.     vs_top=sup;
  117. TTL:;
  118.     base[2]= VV[11];
  119.     base[3]= Ct;
  120.     base[1]= simple_symlispcall_no_event(VV[35],base+2,2);
  121.     base[2]= Cnil;
  122.     if(!(endp(base[0]))){
  123.     goto T53;}
  124.     base[3]= VV[5];
  125.     base[4]= VV[12];
  126.     base[5]= VV[13];
  127.     (void)simple_symlispcall_no_event(VV[36],base+3,3);
  128. T53:;
  129.     base[3]= make_cons(VV[26],symbol_value(VV[25]));
  130.     base[4]= make_cons(VV[26],symbol_value(VV[27]));
  131.     base[5]= make_cons(VV[26],symbol_value(VV[28]));
  132.     bds_bind(VV[25],base[3]);
  133.     bds_bind(VV[27],base[4]);
  134.     bds_bind(VV[28],base[5]);
  135.     base[6]= car(base[0]);
  136.     base[7]= simple_symlispcall_no_event(VV[37],base+6,1);
  137.     bds_unwind1;
  138.     bds_unwind1;
  139.     bds_unwind1;
  140.     base[2]= base[7];
  141.     base[3]= base[1];
  142.     base[4]= cadr(base[2]);
  143.     (void)simple_symlispcall_no_event(VV[38],base+3,2);
  144.     base[3]= cdr(base[0]);
  145.     base[0]= simple_symlispcall_no_event(VV[39],base+3,1);
  146.     base[3]= base[1];
  147.     base[4]= cadr(base[0]);
  148.     (void)simple_symlispcall_no_event(VV[38],base+3,2);
  149.     base[3]= list(4,VV[5],base[1],base[2],base[0]);
  150.     vs_top=(vs_base=base+3)+1;
  151.     return;
  152. }
  153. /*    function definition for C2UNWIND-PROTECT    */
  154.  
  155. static L12()
  156. {    register object *base=vs_base;
  157.     register object *sup=base+VM7;
  158.     vs_reserve(VM7);
  159.     bds_check;
  160.     check_arg(2);
  161.     vs_top=sup;
  162. TTL:;
  163.     bds_bind(VV[17],symbol_value(VV[17]));
  164.     base[4]= simple_symlispcall_no_event(VV[44],base+5,0);
  165.     base[3]= list(2,VV[29],base[4]);
  166.     princ_str("\n    {object tag;frame_ptr fr;object p;bool active;",VV[20]);
  167.     princ_str("\n    frs_push(FRS_PROTECT,Cnil);",VV[20]);
  168.     princ_str("\n    if(nlj_active){tag=nlj_tag;fr=nlj_fr;active=TRUE;}",VV[20]);
  169.     princ_str("\n    else{",VV[20]);
  170.     bds_bind(VV[18],VV[30]);
  171.     base[5]= base[0];
  172.     base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
  173.     bds_unwind1;
  174.     princ_str("\n    active=FALSE;}",VV[20]);
  175.     princ_str("\n    ",VV[20]);
  176.     base[4]= base[3];
  177.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  178.     princ_str("=Cnil;",VV[20]);
  179.     princ_str("\n    while(vs_base<vs_top)",VV[20]);
  180.     princ_str("\n    {",VV[20]);
  181.     base[4]= base[3];
  182.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  183.     princ_str("=MMcons(vs_top[-1],",VV[20]);
  184.     base[4]= base[3];
  185.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  186.     princ_str(");vs_top--;}",VV[20]);
  187.     princ_str("\n    ",VV[20]);
  188.     (void)simple_symlispcall_no_event(VV[45],base+4,0);
  189.     princ_str("\n    nlj_active=FALSE;frs_pop();",VV[20]);
  190.     bds_bind(VV[18],VV[31]);
  191.     base[5]= base[1];
  192.     base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
  193.     bds_unwind1;
  194.     princ_str("\n    vs_base=vs_top=base+",VV[20]);
  195.     base[4]= (VV[17]->s.s_dbind);
  196.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  197.     princ_char(59,VV[20]);
  198.     setq(VV[32],Ct);
  199.     princ_str("\n    for(p= ",VV[20]);
  200.     base[4]= base[3];
  201.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  202.     princ_str(";!endp(p);p=MMcdr(p))vs_push(MMcar(p));",VV[20]);
  203.     princ_str("\n    if(active)unwind(fr,tag);else{",VV[20]);
  204.     base[4]= VV[21];
  205.     (void)simple_symlispcall_no_event(VV[41],base+4,1);
  206.     princ_str("}}",VV[20]);
  207.     base[4]= Cnil;
  208.     vs_top=(vs_base=base+4)+1;
  209.     bds_unwind1;
  210.     return;
  211. }
  212. /*    function definition for C1THROW    */
  213.  
  214. static L13()
  215. {    register object *base=vs_base;
  216.     register object *sup=base+VM8;
  217.     vs_reserve(VM8);
  218.     check_arg(1);
  219.     vs_top=sup;
  220. TTL:;
  221.     base[1]= simple_symlispcall_no_event(VV[35],base+2,0);
  222.     base[2]= Cnil;
  223.     if(endp(base[0])){
  224.     goto T128;}
  225.     if(!(endp(cdr(base[0])))){
  226.     goto T127;}
  227. T128:;
  228.     base[3]= VV[8];
  229.     base[4]= VV[33];
  230.     base[5]= make_fixnum(length(base[0]));
  231.     (void)simple_symlispcall_no_event(VV[36],base+3,3);
  232. T127:;
  233.     if(endp(cddr(base[0]))){
  234.     goto T135;}
  235.     base[3]= VV[8];
  236.     base[4]= VV[33];
  237.     base[5]= make_fixnum(length(base[0]));
  238.     (void)simple_symlispcall_no_event(VV[46],base+3,3);
  239. T135:;
  240.     base[3]= car(base[0]);
  241.     base[2]= simple_symlispcall_no_event(VV[37],base+3,1);
  242.     base[3]= base[1];
  243.     base[4]= cadr(base[2]);
  244.     (void)simple_symlispcall_no_event(VV[38],base+3,2);
  245.     base[3]= cadr(base[0]);
  246.     base[0]= simple_symlispcall_no_event(VV[37],base+3,1);
  247.     base[3]= base[1];
  248.     base[4]= cadr(base[0]);
  249.     (void)simple_symlispcall_no_event(VV[38],base+3,2);
  250.     base[3]= list(4,VV[8],base[1],base[2],base[0]);
  251.     vs_top=(vs_base=base+3)+1;
  252.     return;
  253. }
  254. /*    function definition for C2THROW    */
  255.  
  256. static L14()
  257. {    register object *base=vs_base;
  258.     register object *sup=base+VM9;
  259.     vs_reserve(VM9);
  260.     bds_check;
  261.     check_arg(2);
  262.     vs_top=sup;
  263. TTL:;
  264.     bds_bind(VV[17],symbol_value(VV[17]));
  265.     base[3]= Cnil;
  266.     princ_str("\n    {frame_ptr fr;",VV[20]);
  267.     {object V1= car(base[0]);
  268.     if((V1!= VV[47]))goto T156;
  269.     base[3]= caddr(base[0]);
  270.     goto T155;
  271. T156:;
  272.     if((V1!= VV[34]))goto T158;
  273.     {object V2;
  274.     V2= caaddr(base[0]);
  275.     {object V3= structure_ref((V2),VV[34],1);
  276.     if((V3!= VV[48]))goto T160;
  277.     base[3]= list(2,VV[29],structure_ref((V2),VV[34],2));
  278.     goto T155;
  279. T160:;
  280.     if((V3!= VV[49]))goto T162;
  281.     base[3]= structure_ref((V2),VV[34],4);
  282.     goto T155;
  283. T162:;
  284.     base[4]= simple_symlispcall_no_event(VV[44],base+5,0);
  285.     base[3]= list(2,VV[29],base[4]);
  286.     princ_str("\n    ",VV[20]);
  287.     base[4]= base[3];
  288.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  289.     princ_str("= ",VV[20]);
  290.     base[4]= (V2);
  291.     base[5]= Cnil;
  292.     (void)simple_symlispcall_no_event(VV[50],base+4,2);
  293.     princ_char(59,VV[20]);
  294.     goto T155;}}
  295. T158:;
  296.     base[4]= simple_symlispcall_no_event(VV[44],base+5,0);
  297.     base[3]= list(2,VV[29],base[4]);
  298.     bds_bind(VV[18],base[3]);
  299.     base[5]= base[0];
  300.     base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
  301.     bds_unwind1;}
  302. T155:;
  303.     princ_str("\n    fr=frs_sch_catch(",VV[20]);
  304.     base[4]= base[3];
  305.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  306.     princ_str(");",VV[20]);
  307.     princ_str("\n    if(fr==NULL) FEerror(\"The tag ~s is undefined.\",1,",VV[20]);
  308.     base[4]= base[3];
  309.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  310.     princ_str(");",VV[20]);
  311.     bds_bind(VV[18],VV[30]);
  312.     base[5]= base[1];
  313.     base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
  314.     bds_unwind1;
  315.     princ_str("\n    unwind(fr,",VV[20]);
  316.     base[4]= base[3];
  317.     (void)simple_symlispcall_no_event(VV[43],base+4,1);
  318.     princ_str(");}",VV[20]);
  319.     base[4]= Cnil;
  320.     vs_top=(vs_base=base+4)+1;
  321.     bds_unwind1;
  322.     return;
  323. }
  324.