home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / UCB Logo 3.0 ƒ / sources / standard source / coms.c next >
Encoding:
C/C++ Source or Header  |  1993-08-14  |  8.4 KB  |  421 lines  |  [TEXT/ttxt]
  1. /*
  2.  *      coms.c      program execution control module    dvb
  3.  *
  4.  *    Copyright (C) 1993 by the Regents of the University of California
  5.  *
  6.  *      This program is free software; you can redistribute it and/or modify
  7.  *      it under the terms of the GNU General Public License as published by
  8.  *      the Free Software Foundation; either version 2 of the License, or
  9.  *      (at your option) any later version.
  10.  *  
  11.  *      This program is distributed in the hope that it will be useful,
  12.  *      but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.  *      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.  *      GNU General Public License for more details.
  15.  *  
  16.  *      You should have received a copy of the GNU General Public License
  17.  *      along with this program; if not, write to the Free Software
  18.  *      Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  *
  20.  */
  21.  
  22. #include "logo.h"
  23. #include "globals.h"
  24. #ifdef ibm
  25. #include "process.h"
  26. #endif
  27. #ifdef mac
  28. #include <console.h>
  29. #endif
  30. #ifdef __ZTC__
  31. #include <time.h>
  32. #include <controlc.h>
  33. #endif
  34.  
  35. FIXNUM ift_iff_flag = -1;
  36.  
  37. NODE *make_cont(enum labels cont, NODE *val) {
  38. #ifdef __ZTC__
  39.     union { enum labels lll;
  40.         NODE *ppp;} cast;
  41. #endif
  42.     NODE *retval = cons(NIL, val);
  43. #ifdef __ZTC__
  44.     cast.lll = cont;
  45.     retval->n_car = cast.ppp;
  46. #else
  47.     retval->n_car = (NODE *)cont;
  48. #endif
  49.     settype(retval, CONT);
  50.     return retval;
  51. }
  52.  
  53. NODE *loutput(NODE *arg)
  54. {
  55.     if (NOT_THROWING) {
  56.     stopping_flag = OUTPUT;
  57.     output_node = reref(output_node, car(arg));
  58.     }
  59.     return(UNBOUND);
  60. }
  61.  
  62. NODE *lstop()
  63. {
  64.     if (NOT_THROWING)
  65.     stopping_flag = STOP;
  66.     return(UNBOUND);
  67. }
  68.  
  69. NODE *lthrow(NODE *arg)
  70. {
  71.     if (NOT_THROWING) {
  72.     if (compare_node(car(arg),Error,TRUE) == 0) {
  73.         if (cdr(arg) != NIL)
  74.         err_logo(USER_ERR, cadr(arg));
  75.         else
  76.         err_logo(USER_ERR, UNBOUND);
  77.     } else {
  78.         stopping_flag = THROWING;
  79.         throw_node = reref(throw_node, car(arg));
  80.         if (cdr(arg) != NIL)
  81.         output_node = reref(output_node, cadr(arg));
  82.         else
  83.         output_node = reref(output_node, UNBOUND);
  84.     }
  85.     }
  86.     return(UNBOUND);
  87. }
  88.  
  89. NODE *lcatch(NODE *args)
  90. {
  91.     return make_cont(catch_continuation, cons(car(args), lrun(cdr(args))));
  92. }
  93.  
  94. int torf_arg(NODE *args)
  95. {
  96.     NODE *arg = car(args);
  97.  
  98.     while (NOT_THROWING) {
  99.     if (compare_node(arg, True, TRUE) == 0) return TRUE;
  100.     if (compare_node(arg, False, TRUE) == 0) return FALSE;
  101.     setcar(args, err_logo(BAD_DATA, arg));
  102.     arg = car(args);
  103.     }
  104.     return -1;
  105. }
  106.  
  107. NODE *lnot(NODE *args)
  108. {
  109.     int arg = torf_arg(args);
  110.  
  111.     if (NOT_THROWING) {
  112.     if (arg) return(False);
  113.     else return(True);
  114.     }
  115.     return(UNBOUND);
  116. }
  117.  
  118. NODE *land(NODE *args)
  119. {
  120.     int arg;
  121.  
  122.     if (args == NIL) return(True);
  123.     while (NOT_THROWING) {
  124.     arg = torf_arg(args);
  125.     if (arg == FALSE)
  126.         return(False);
  127.     args = cdr(args);
  128.     if (args == NIL) break;
  129.     }
  130.     if (NOT_THROWING) return(True);
  131.     else return(UNBOUND);
  132. }
  133.  
  134. NODE *lor(NODE *args)
  135. {
  136.     int arg;
  137.  
  138.     if (args == NIL) return(False);
  139.     while (NOT_THROWING) {
  140.     arg = torf_arg(args);
  141.     if (arg == TRUE)
  142.         return(True);
  143.     args = cdr(args);
  144.     if (args == NIL) break;
  145.     }
  146.     if (NOT_THROWING) return(False);
  147.     else return(UNBOUND);
  148. }
  149.  
  150. NODE *runnable_arg(NODE *args) {
  151.     NODE *arg = car(args);
  152.  
  153.     if (!aggregate(arg)) {
  154.     setcar(args, parser(arg, TRUE));
  155.     arg = car(args);
  156.     }
  157.     while (!is_list(arg) && NOT_THROWING) {
  158.     setcar(args, err_logo(BAD_DATA, arg));
  159.     arg = car(args);
  160.     }
  161.     return(arg);
  162. }
  163.  
  164. NODE *lif(NODE *args)    /* macroized */
  165. {
  166.     NODE *yes;
  167.     int pred;
  168.  
  169.     if (cddr(args) != NIL) return(lifelse(args));
  170.  
  171.     pred = torf_arg(args);
  172.     yes = runnable_arg(cdr(args));
  173.     if (NOT_THROWING) {
  174.     if (pred) return(yes);
  175.     return(NIL);
  176.     }
  177.     return(UNBOUND);
  178. }
  179.  
  180. NODE *lifelse(NODE *args)    /* macroized */
  181. {
  182.     NODE *yes, *no;
  183.     int pred;
  184.  
  185.     pred = torf_arg(args);
  186.     yes = runnable_arg(cdr(args));
  187.     no = runnable_arg(cddr(args));
  188.     if (NOT_THROWING) {
  189.     if (pred) return(yes);
  190.     return(no);
  191.     }
  192.     return(UNBOUND);
  193. }
  194.  
  195. NODE *lrun(NODE *args)    /* macroized */
  196. {
  197.     NODE *arg = runnable_arg(args);
  198.  
  199.     if (NOT_THROWING) return(arg);
  200.     return(UNBOUND);
  201. }
  202.  
  203. NODE *lrunresult(NODE *args)
  204. {
  205.     return make_cont(runresult_continuation, lrun(args));
  206. }
  207.  
  208. NODE *pos_int_arg(NODE *args)
  209. {
  210.     NODE *arg = car(args), *val;
  211.  
  212.     val = cnv_node_to_numnode(arg);
  213.     while ((nodetype(val) != INT || getint(val) < 0) && NOT_THROWING) {
  214.     gcref(val);
  215.     setcar(args, err_logo(BAD_DATA, arg));
  216.     arg = car(args);
  217.     val = cnv_node_to_numnode(arg);
  218.     }
  219.     setcar(args,val);
  220.     if (nodetype(val) == INT) return(val);
  221.     return UNBOUND;
  222. }
  223.  
  224. NODE *lrepeat(NODE *args)
  225. {
  226.     NODE *cnt, *torpt, *retval = NIL;
  227.  
  228.     cnt = pos_int_arg(args);
  229.     torpt = lrun(cdr(args));
  230.     if (NOT_THROWING) {
  231.     retval = make_cont(repeat_continuation, cons(cnt,torpt));
  232.     }
  233.     return(retval);
  234. }
  235.  
  236. NODE *lforever(NODE *args)
  237. {
  238.     NODE *torpt = lrun(args);
  239.  
  240.     if (NOT_THROWING)
  241.     return make_cont(repeat_continuation, cons(make_intnode(-1), torpt));
  242.     return NIL;
  243. }
  244.  
  245. NODE *ltest(NODE *args)
  246. {
  247.     int arg = torf_arg(args);
  248.  
  249.     if (tailcall != 0) return UNBOUND;
  250.     if (NOT_THROWING) {
  251.     ift_iff_flag = arg;
  252.     dont_fix_ift = 1;
  253.     }
  254.     return(UNBOUND);
  255. }
  256.  
  257. NODE *liftrue(NODE *args)
  258. {
  259.     if (ift_iff_flag < 0)
  260.     return(err_logo(NO_TEST,NIL));
  261.     else if (ift_iff_flag > 0)
  262.     return(lrun(args));
  263.     else
  264.     return(NIL);
  265. }
  266.  
  267. NODE *liffalse(NODE *args)
  268. {
  269.     if (ift_iff_flag < 0)
  270.     return(err_logo(NO_TEST,NIL));
  271.     else if (ift_iff_flag == 0)
  272.     return(lrun(args));
  273.     else
  274.     return(NIL);
  275. }
  276.  
  277. void prepare_to_exit(BOOLEAN okay)
  278. {
  279. #ifdef mac
  280.     if (okay) {
  281.     console_options.pause_atexit = 0;
  282.     exit(0);
  283.     }
  284. #endif
  285. #ifdef ibm
  286.     ltextscreen();
  287.     ibm_plain_mode();
  288. #ifdef __ZTC__
  289.     zflush();
  290.     controlc_close();
  291. #endif
  292. #endif
  293. #ifdef unix
  294.     extern int getpid();
  295.     char ef[30];
  296.  
  297.     charmode_off();
  298.     sprintf(ef, "/tmp/logo%d", getpid());
  299.     unlink(ef);
  300. #endif
  301. }
  302.  
  303. NODE *lbye()
  304. {
  305.     prepare_to_exit(TRUE);
  306.     if (ufun != NIL || loadstream != stdin) exit(0);
  307.     if (isatty(0) && isatty(1)) lcleartext();
  308.     printf("Thank you for using Logo.\n");
  309.     printf("Have a nice day.\n");
  310.     exit(0);
  311. }
  312.  
  313. NODE *lwait(NODE *args)
  314. {
  315.     NODE *num;
  316.     unsigned int n;
  317.  
  318.     num = pos_int_arg(args);
  319.     if (NOT_THROWING) {
  320.     fflush(stdout); /* csls v. 1 p. 7 */
  321. #ifdef __ZTC__
  322.     zflush();
  323. #endif
  324.     if (getint(num) > 0) {
  325. #ifdef bsd
  326. #ifdef ultrix
  327.         n = (unsigned int)getint(num) / 60;
  328.         sleep(n);
  329. #else
  330.         n = (unsigned int)getint(num) * 16667;
  331.         usleep(n);
  332. #endif
  333. #else
  334. #ifdef __ZTC__
  335.         usleep(getint(num) * 16667L);
  336. #else
  337.         n = ((unsigned int)getint(num)+30) / 60;
  338.         sleep(n);
  339. #endif
  340. #endif
  341.     }
  342.     }
  343.     return(UNBOUND);
  344. }
  345.  
  346. NODE *lshell(NODE *args)
  347. {
  348. #ifdef mac
  349.     printf("Sorry, no shell on the Mac.\n");
  350.     return(UNBOUND);
  351. #else
  352. #ifdef ibm
  353.     NODE *arg;
  354.     char in[5][40] = { "\0", "\0", "\0", "\0", "\0" };
  355.     int count = 0;
  356.  
  357.     arg = car(args);
  358.     while (!is_list(arg) && NOT_THROWING) {
  359.     setcar(args, err_logo(BAD_DATA, arg));
  360.     arg = car(args);
  361.     }
  362.     if (arg == NIL) {
  363.     ndprintf(stdout,"Type EXIT to return to Logo.\n");
  364.     if (spawnlp(P_WAIT, "command", "command", NULL))
  365.         err_logo(FILE_ERROR,
  366.           make_static_strnode
  367.          ("Could not open shell (probably due to low memory)"));
  368.     }
  369.     else {
  370.     print_stringlen = 39;
  371.     while (arg != NIL && count < 5) {
  372.         print_stringptr = in[count++];
  373.         ndprintf((FILE *)NULL,"%s",car(arg));
  374.         *print_stringptr = '\0';
  375.         arg = cdr(arg);
  376.     }
  377.     if (spawnlp(P_WAIT, in[0], in[0], in[1], in[2], in[3], in[4], NULL))
  378.         err_logo(FILE_ERROR,
  379.           make_static_strnode
  380.          ("Could not open shell (probably due to low memory)"));
  381.     }
  382.     return(UNBOUND);
  383. #else
  384.     extern FILE *popen();
  385.     char cmdbuf[300];
  386.     FILE *strm;
  387.     NODE *head = NIL, *tail, *this;
  388.     BOOLEAN wordmode = FALSE;
  389.     int len;
  390.  
  391.     if (cdr(args) != NIL) wordmode = TRUE;
  392.     print_stringptr = cmdbuf;
  393.     print_stringlen = 300;
  394.     ndprintf((FILE *)NULL,"%p\n",car(args));
  395.     *print_stringptr = '\0';
  396.     strm = popen(cmdbuf,"r");
  397.     fgets(cmdbuf,300,strm);
  398.     while (!feof(strm)) {
  399.     len = (int)strlen(cmdbuf);
  400.     if (cmdbuf[len-1] == '\n')
  401.         cmdbuf[--len] = '\0';
  402.     if (wordmode)
  403.         this = make_strnode(cmdbuf, (char *)NULL, len,
  404.             STRING, strnzcpy);
  405.     else
  406.         this = parser(make_static_strnode(cmdbuf), FALSE);
  407.     if (head == NIL) {
  408.         tail = head = cons(this,NIL);
  409.         ref(head);
  410.     } else {
  411.         setcdr(tail, cons(this,NIL));
  412.         tail = cdr(tail);
  413.     }
  414.     fgets(cmdbuf,300,strm);
  415.     }
  416.     pclose(strm);
  417.     return(unref(head));
  418. #endif
  419. #endif
  420. }
  421.