home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / lsp / littleXlsp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-07-15  |  8.0 KB  |  430 lines
  1.  
  2. #include <cmpinclude.h>
  3. #include "littleXlsp.h"
  4. init_littleXlsp(){do_init(VV);}
  5. /*    function definition for OPEN-WINDOW    */
  6.  
  7. static L1()
  8. {    object *old_base=vs_base;
  9.     int x;
  10.     check_arg(0);
  11.     x=
  12.     open_window();
  13.     vs_top=(vs_base=old_base)+1;
  14.     vs_base[0]=make_fixnum(x);
  15. }
  16. /*    function definition for CLOSE-WINDOW    */
  17.  
  18. static L2()
  19. {    object *old_base=vs_base;
  20.     int x;
  21.     check_arg(1);
  22.     x=
  23.     close_window(
  24.     object_to_int(vs_base[0]));
  25.     vs_top=(vs_base=old_base)+1;
  26.     vs_base[0]=make_fixnum(x);
  27. }
  28. /*    function definition for CLEAR-WINDOW    */
  29.  
  30. static L3()
  31. {    object *old_base=vs_base;
  32.     int x;
  33.     check_arg(1);
  34.     x=
  35.     clear_window(
  36.     object_to_int(vs_base[0]));
  37.     vs_top=(vs_base=old_base)+1;
  38.     vs_base[0]=make_fixnum(x);
  39. }
  40. /*    function definition for DRAW-LINE    */
  41.  
  42. static L4()
  43. {    object *old_base=vs_base;
  44.     int x;
  45.     check_arg(5);
  46.     x=
  47.     draw_line(
  48.     object_to_int(vs_base[0]),
  49.     object_to_int(vs_base[1]),
  50.     object_to_int(vs_base[2]),
  51.     object_to_int(vs_base[3]),
  52.     object_to_int(vs_base[4]));
  53.     vs_top=(vs_base=old_base)+1;
  54.     vs_base[0]=make_fixnum(x);
  55. }
  56. /*    function definition for ERASE-LINE    */
  57.  
  58. static L5()
  59. {    object *old_base=vs_base;
  60.     int x;
  61.     check_arg(5);
  62.     x=
  63.     erase_line(
  64.     object_to_int(vs_base[0]),
  65.     object_to_int(vs_base[1]),
  66.     object_to_int(vs_base[2]),
  67.     object_to_int(vs_base[3]),
  68.     object_to_int(vs_base[4]));
  69.     vs_top=(vs_base=old_base)+1;
  70.     vs_base[0]=make_fixnum(x);
  71. }
  72. /*    function definition for DRAW-ARC    */
  73.  
  74. static L6()
  75. {    object *old_base=vs_base;
  76.     int x;
  77.     check_arg(7);
  78.     x=
  79.     draw_arc(
  80.     object_to_int(vs_base[0]),
  81.     object_to_int(vs_base[1]),
  82.     object_to_int(vs_base[2]),
  83.     object_to_int(vs_base[3]),
  84.     object_to_int(vs_base[4]),
  85.     object_to_int(vs_base[5]),
  86.     object_to_int(vs_base[6]));
  87.     vs_top=(vs_base=old_base)+1;
  88.     vs_base[0]=make_fixnum(x);
  89. }
  90. /*    function definition for CLEAR-ARC    */
  91.  
  92. static L7()
  93. {    object *old_base=vs_base;
  94.     int x;
  95.     check_arg(7);
  96.     x=
  97.     clear_arc(
  98.     object_to_int(vs_base[0]),
  99.     object_to_int(vs_base[1]),
  100.     object_to_int(vs_base[2]),
  101.     object_to_int(vs_base[3]),
  102.     object_to_int(vs_base[4]),
  103.     object_to_int(vs_base[5]),
  104.     object_to_int(vs_base[6]));
  105.     vs_top=(vs_base=old_base)+1;
  106.     vs_base[0]=make_fixnum(x);
  107. }
  108. /*    function definition for FILL-ARC    */
  109.  
  110. static L8()
  111. {    object *old_base=vs_base;
  112.     int x;
  113.     check_arg(7);
  114.     x=
  115.     fill_arc(
  116.     object_to_int(vs_base[0]),
  117.     object_to_int(vs_base[1]),
  118.     object_to_int(vs_base[2]),
  119.     object_to_int(vs_base[3]),
  120.     object_to_int(vs_base[4]),
  121.     object_to_int(vs_base[5]),
  122.     object_to_int(vs_base[6]));
  123.     vs_top=(vs_base=old_base)+1;
  124.     vs_base[0]=make_fixnum(x);
  125. }
  126. /*    function definition for RESIZE-WINDOW    */
  127.  
  128. static L9()
  129. {    object *old_base=vs_base;
  130.     int x;
  131.     check_arg(3);
  132.     x=
  133.     resize_window(
  134.     object_to_int(vs_base[0]),
  135.     object_to_int(vs_base[1]),
  136.     object_to_int(vs_base[2]));
  137.     vs_top=(vs_base=old_base)+1;
  138.     vs_base[0]=make_fixnum(x);
  139. }
  140. /*    function definition for RAISE-WINDOW    */
  141.  
  142. static L10()
  143. {    object *old_base=vs_base;
  144.     int x;
  145.     check_arg(1);
  146.     x=
  147.     raise_window(
  148.     object_to_int(vs_base[0]));
  149.     vs_top=(vs_base=old_base)+1;
  150.     vs_base[0]=make_fixnum(x);
  151. }
  152. /*    function definition for DRAW-TEXT-2    */
  153.  
  154. static L11()
  155. {    object *old_base=vs_base;
  156.     int x;
  157.     check_arg(4);
  158.     x=
  159.     draw_text(
  160.     object_to_int(vs_base[0]),
  161.     vs_base[1],
  162.     object_to_int(vs_base[2]),
  163.     object_to_int(vs_base[3]));
  164.     vs_top=(vs_base=old_base)+1;
  165.     vs_base[0]=make_fixnum(x);
  166. }
  167. /*    function definition for DRAW-TEXT    */
  168.  
  169. static L12()
  170. {register object *base=vs_base;
  171.     register object *sup=base+VM1; VC1
  172.     vs_reserve(VM1);
  173.     {object V1;
  174.     object V2;
  175.     object V3;
  176.     object V4;
  177.     check_arg(4);
  178.     V1=(base[0]);
  179.     V2=(base[1]);
  180.     V3=(base[2]);
  181.     V4=(base[3]);
  182.     vs_top=sup;
  183. TTL:;
  184.     base[4]= (V1);
  185.     base[6]= (V2);
  186.     vs_top=(vs_base=base+6)+1;
  187.     (void) (*Lnk3)();
  188.     vs_top=sup;
  189.     base[5]= vs_base[0];
  190.     base[6]= (V3);
  191.     base[7]= (V4);
  192.     vs_top=(vs_base=base+4)+4;
  193.     (void) (*Lnk4)();
  194.     return;
  195.     }
  196. }
  197. /*    function definition for CLEAR-TEXT-2    */
  198.  
  199. static L13()
  200. {    object *old_base=vs_base;
  201.     int x;
  202.     check_arg(4);
  203.     x=
  204.     erase_text(
  205.     object_to_int(vs_base[0]),
  206.     vs_base[1],
  207.     object_to_int(vs_base[2]),
  208.     object_to_int(vs_base[3]));
  209.     vs_top=(vs_base=old_base)+1;
  210.     vs_base[0]=make_fixnum(x);
  211. }
  212. /*    function definition for CLEAR-TEXT    */
  213.  
  214. static L14()
  215. {register object *base=vs_base;
  216.     register object *sup=base+VM2; VC2
  217.     vs_reserve(VM2);
  218.     {object V5;
  219.     object V6;
  220.     object V7;
  221.     object V8;
  222.     check_arg(4);
  223.     V5=(base[0]);
  224.     V6=(base[1]);
  225.     V7=(base[2]);
  226.     V8=(base[3]);
  227.     vs_top=sup;
  228. TTL:;
  229.     base[4]= (V5);
  230.     base[6]= (V6);
  231.     vs_top=(vs_base=base+6)+1;
  232.     (void) (*Lnk3)();
  233.     vs_top=sup;
  234.     base[5]= vs_base[0];
  235.     base[6]= (V7);
  236.     base[7]= (V8);
  237.     vs_top=(vs_base=base+4)+4;
  238.     (void) (*Lnk5)();
  239.     return;
  240.     }
  241. }
  242. /*    function definition for SET-ARC-MODE-2    */
  243.  
  244. static L15()
  245. {    object *old_base=vs_base;
  246.     int x;
  247.     check_arg(1);
  248.     x=
  249.     set_arc_mode(
  250.     object_to_int(vs_base[0]));
  251.     vs_top=(vs_base=old_base)+1;
  252.     vs_base[0]=make_fixnum(x);
  253. }
  254. /*    function definition for SET-ARC-MODE    */
  255.  
  256. static L16()
  257. {register object *base=vs_base;
  258.     register object *sup=base+VM3; VC3
  259.     vs_reserve(VM3);
  260.     {object V9;
  261.     check_arg(1);
  262.     V9=(base[0]);
  263.     vs_top=sup;
  264. TTL:;
  265.     if(!((V9)==VV[0])){
  266.     goto T12;}
  267.     base[1]= small_fixnum(1);
  268.     vs_top=(vs_base=base+1)+1;
  269.     (void) (*Lnk6)();
  270.     return;
  271. T12:;
  272.     base[1]= small_fixnum(0);
  273.     vs_top=(vs_base=base+1)+1;
  274.     (void) (*Lnk6)();
  275.     return;
  276.     }
  277. }
  278. /*    function definition for USE-FONT-2    */
  279.  
  280. static L17()
  281. {    object *old_base=vs_base;
  282.     int x;
  283.     check_arg(1);
  284.     x=
  285.     use_font(
  286.     vs_base[0]);
  287.     vs_top=(vs_base=old_base)+1;
  288.     vs_base[0]=make_fixnum(x);
  289. }
  290. /*    function definition for USE-FONT    */
  291.  
  292. static L18()
  293. {register object *base=vs_base;
  294.     register object *sup=base+VM4; VC4
  295.     vs_reserve(VM4);
  296.     {object V10;
  297.     check_arg(1);
  298.     V10=(base[0]);
  299.     vs_top=sup;
  300. TTL:;
  301.     base[2]= (V10);
  302.     vs_top=(vs_base=base+2)+1;
  303.     (void) (*Lnk3)();
  304.     vs_top=sup;
  305.     base[1]= vs_base[0];
  306.     vs_top=(vs_base=base+1)+1;
  307.     (void) (*Lnk7)();
  308.     return;
  309.     }
  310. }
  311. /*    function definition for SET-BACKGROUND-2    */
  312.  
  313. static L19()
  314. {    object *old_base=vs_base;
  315.     int x;
  316.     check_arg(2);
  317.     x=
  318.     set_background(
  319.     object_to_int(vs_base[0]),
  320.     vs_base[1]);
  321.     vs_top=(vs_base=old_base)+1;
  322.     vs_base[0]=make_fixnum(x);
  323. }
  324. /*    function definition for SET-BACKGROUND    */
  325.  
  326. static L20()
  327. {register object *base=vs_base;
  328.     register object *sup=base+VM5; VC5
  329.     vs_reserve(VM5);
  330.     {object V11;
  331.     object V12;
  332.     check_arg(2);
  333.     V11=(base[0]);
  334.     V12=(base[1]);
  335.     vs_top=sup;
  336. TTL:;
  337.     base[2]= (V11);
  338.     base[4]= (V12);
  339.     vs_top=(vs_base=base+4)+1;
  340.     (void) (*Lnk3)();
  341.     vs_top=sup;
  342.     base[3]= vs_base[0];
  343.     vs_top=(vs_base=base+2)+2;
  344.     (void) (*Lnk8)();
  345.     return;
  346.     }
  347. }
  348. /*    function definition for SET-FOREGROUND-2    */
  349.  
  350. static L21()
  351. {    object *old_base=vs_base;
  352.     int x;
  353.     check_arg(1);
  354.     x=
  355.     set_foreground(
  356.     vs_base[0]);
  357.     vs_top=(vs_base=old_base)+1;
  358.     vs_base[0]=make_fixnum(x);
  359. }
  360. /*    function definition for SET-FOREGROUND    */
  361.  
  362. static L22()
  363. {register object *base=vs_base;
  364.     register object *sup=base+VM6; VC6
  365.     vs_reserve(VM6);
  366.     {object V13;
  367.     check_arg(1);
  368.     V13=(base[0]);
  369.     vs_top=sup;
  370. TTL:;
  371.     base[2]= (V13);
  372.     vs_top=(vs_base=base+2)+1;
  373.     (void) (*Lnk3)();
  374.     vs_top=sup;
  375.     base[1]= vs_base[0];
  376.     vs_top=(vs_base=base+1)+1;
  377.     (void) (*Lnk9)();
  378.     return;
  379.     }
  380. }
  381. /*    C function defined by DEFCFUN    */
  382.  
  383. object get_c_string(s) object s;
  384. {
  385. object *vs=vs_top;
  386. object *old_top=vs_top+0;
  387. {
  388.  return(s->st.st_self);
  389. }
  390. vs_top=vs;
  391. }
  392. /*    function definition for GET_C_STRING_2    */
  393.  
  394. static L23()
  395. {    object *old_base=vs_base;
  396.     object x;
  397.     check_arg(1);
  398.     x=
  399.     get_c_string(
  400.     vs_base[0]);
  401.     vs_top=(vs_base=old_base)+1;
  402.     vs_base[0]=x;
  403. }
  404. /*    function definition for GET-C-STRING    */
  405.  
  406. static L24()
  407. {register object *base=vs_base;
  408.     register object *sup=base+VM7; VC7
  409.     vs_reserve(VM7);
  410.     {object V14;
  411.     check_arg(1);
  412.     V14=(base[0]);
  413.     vs_top=sup;
  414. TTL:;
  415.     base[1]= (VFUN_NARGS=3,(*(LnkLI10))(VV[1],(V14),VV[2]));
  416.     vs_top=(vs_base=base+1)+1;
  417.     (void) (*Lnk11)();
  418.     return;
  419.     }
  420. }
  421. static LnkT11(){ call_or_link(VV[11],&Lnk11);} /* GET_C_STRING_2 */
  422. static object  LnkTLI10(va_alist)va_dcl{va_list ap;va_start(ap);return(object )call_vproc(VV[10],&LnkLI10,ap);} /* CONCATENATE */
  423. static LnkT9(){ call_or_link(VV[9],&Lnk9);} /* SET-FOREGROUND-2 */
  424. static LnkT8(){ call_or_link(VV[8],&Lnk8);} /* SET-BACKGROUND-2 */
  425. static LnkT7(){ call_or_link(VV[7],&Lnk7);} /* USE-FONT-2 */
  426. static LnkT6(){ call_or_link(VV[6],&Lnk6);} /* SET-ARC-MODE-2 */
  427. static LnkT5(){ call_or_link(VV[5],&Lnk5);} /* CLEAR-TEXT-2 */
  428. static LnkT4(){ call_or_link(VV[4],&Lnk4);} /* DRAW-TEXT-2 */
  429. static LnkT3(){ call_or_link(VV[3],&Lnk3);} /* GET-C-STRING */
  430.