home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / glisp / glisp.000 / GLISP.UNIX.TAR / closunix / clos_lf9.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-04-03  |  13.4 KB  |  603 lines
  1. /*                 GRAPHIC LISP            */
  2. /*        Scritto nel 1991-94 da Zoia Andrea Michele     */
  3. /*        Via Pergola #1 Tirano (SO) Tel. 0342-704210    */
  4.  
  5. #include "clos.h"
  6.  
  7. #define getinit()                        \
  8.   node n;                                                       \
  9.   node ni=nin                                                   \
  10.  
  11. #define getint(v)                        \
  12.   if(!IS_CONS(nin))                                             \
  13.     error(E_FEWARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&ni);        \
  14.   eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);            \
  15.   n=calc_pointer(nout);                        \
  16.   if(!IS_VALUE(n) || !(GET_VTYPE(n)==NT_INTEGER) )              \
  17.     error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&n);         \
  18.   v=INTEGER(n);                            \
  19.   nin=CONSRIGHT(nin);
  20.  
  21. #define getstring(v)                        \
  22.   if(!IS_CONS(nin))                                             \
  23.     error(E_FEWARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&ni);        \
  24.   eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);            \
  25.   n=calc_pointer(nout);                        \
  26.   if(!IS_VALUE(n) || !(GET_VTYPE(n)==NT_STRING) )               \
  27.     error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&n);         \
  28.   v=STRING(n);                            \
  29.   nin=CONSRIGHT(nin);
  30.  
  31. #define getstream(v)                        \
  32.   if(!IS_CONS(nin))                                             \
  33.     error(E_FEWARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&ni);        \
  34.   eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);            \
  35.   n=calc_pointer(nout);                        \
  36.   if(!IS_VALUE(n) || !(GET_VTYPE(n)==NT_STREAM) )               \
  37.     error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&n);         \
  38.   v=STREAM(n);                            \
  39.   nin=CONSRIGHT(nin);
  40.  
  41. /* funzioni di File e Console I/O ***************************/
  42. /* FOPEN      , FCLOSE     , FSEEK     , FTELL           */
  43. /* FEOF       , FERROR     , FCLEARERR                      */
  44. /* FREADBYTE  , FWRITEBYTE                                  */
  45. /* FINPUT     , FPRINT     , FSCANF                         */
  46. /* PRINT      , INPUT      , LOAD                              */
  47. /* READLINE   , READCHAR   , CURPOS    , TEXTCOLOR          */
  48. /* CLS                                   */
  49. /************************************************************/
  50.  
  51.  
  52. void lf_fopen LF_PARAMS
  53. {
  54.  /* sintassi (open nomefile string) */
  55.  getinit();
  56.  str_t s;
  57.  FILE *f;
  58.  
  59.  getstring(s);string_get(s,buf1);
  60.  getstring(s);string_get(s,buf2);
  61.  f=fopen(buf1,buf2);
  62.  if(f){
  63.    TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_STREAM;
  64.    STREAM(nout->node)=f;
  65.  }else{
  66.    nout->node=NIL;
  67.  }
  68.  nout->type=P_ALLNODE;
  69. }
  70.  
  71. void lf_fclose LF_PARAMS
  72. {
  73.  /* sintassi (close stream) */
  74.  getinit();
  75.  FILE *f;
  76.  
  77.  getstream(f);
  78.  nout->type=P_ALLNODE;
  79.  if(f==stdin || f==stdout || f==stderr || f==stdaux || f==stdprn || !f){
  80.    nout->node=NIL;
  81.  }else{
  82.    if(fclose(f)==EOF){
  83.      nout->node=NIL;
  84.    }else{
  85.      nout->node=T;
  86.      STREAM(n)=NULL;
  87.    }
  88.  }
  89. }
  90.  
  91. void lf_fseek LF_PARAMS
  92. {
  93.  /* sintassi (fseek stream intero{offset} intero{whence} ) */
  94.  getinit();
  95.  FILE *f;
  96.  n_int o,w;
  97.  
  98.  getstream(f);
  99.  getint(o);
  100.  getint(w);
  101.  if(w<0 || w>2)
  102.    error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  103.  if(f){
  104.    fseek(f,o,(int)w);
  105.    nout->node=T;
  106.  }else{
  107.    nout->node=NIL;
  108.  }
  109.  nout->type=P_ALLNODE;
  110. }
  111.  
  112.  
  113. void lf_ftell LF_PARAMS
  114. {
  115.  /* sintassi (ftell stream ) */
  116.  getinit();
  117.  FILE *f;
  118.  long pos;
  119.  
  120.  getstream(f);
  121.  nout->node=P_ALLNODE;
  122.  if(f){
  123.    pos=ftell(f);
  124.    if(pos!=-1L){
  125.      TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_INTEGER;
  126.      INTEGER(nout->node)=pos;
  127.      nout->type=P_ALLNODE;
  128.      return;
  129.    }
  130.  }
  131.  nout->node=NIL;
  132. }
  133.  
  134. void lf_feof LF_PARAMS
  135. {
  136.  getinit();
  137.  FILE *f;
  138.  
  139.  getstream(f);
  140.  nout->type=P_ALLNODE;
  141.  nout->node=f?(feof(f)?T:NIL):T;
  142. }
  143.  
  144. void lf_ferror LF_PARAMS
  145. {
  146.  getinit();
  147.  FILE *f;
  148.  
  149.  getstream(f);
  150.  nout->type=P_ALLNODE;
  151.  nout->node=f?(ferror(f)?T:NIL):T;
  152. }
  153.  
  154. void lf_fclearerr LF_PARAMS
  155. {
  156.  getinit();
  157.  FILE *f;
  158.  
  159.  getstream(f);
  160.  if(f)clearerr(f);
  161.  nout->type=P_ALLNODE;
  162.  nout->node=f?T:NIL;
  163. }
  164.  
  165. void lf_freadbyte LF_PARAMS
  166. {
  167.  /* (freadbyte stream) */
  168.  node n;
  169.  FILE *fin;
  170.  if(IS_CONS(nin)){
  171.   eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  172.   n=calc_pointer(nout);
  173.   if(IS_VALUE(n)&&GET_VTYPE(n)==NT_STREAM){
  174.     fin=STREAM(n);
  175.     if(fin==stdout||fin==stderr||fin==stdprn||fin==stdaux||fin==NULL){
  176.       nout->node=NIL;
  177.       nout->type=P_ALLNODE;
  178.       return;
  179.     }
  180.     TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_INTEGER;
  181.     INTEGER(nout->node)=(n_int)lisp_get_char(STREAM(n));
  182.     nout->type=P_ALLNODE;
  183.     return;
  184.   }
  185.   error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  186.  }
  187.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nin);
  188. }
  189.  
  190. void lf_fwritebyte LF_PARAMS
  191. {
  192.  /* (fwritebyte stream integer) */
  193.  FILE *f;
  194.  node n,nn=nin;
  195.  
  196.  if(IS_CONS(nin)){
  197.   eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  198.   n=calc_pointer(nout);
  199.   if(IS_VALUE(n)&&GET_VTYPE(n)==NT_STREAM){
  200.     f=STREAM(n);
  201.     nin=CONSRIGHT(nin);
  202.     if(IS_CONS(nin)){
  203.       eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  204.       n=calc_pointer(nout);
  205.       if(IS_VALUE(n)&&GET_VTYPE(n)==NT_INTEGER){
  206.     lisp_put_char((int)INTEGER(n),f);
  207.     return;
  208.       }
  209.       error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  210.     }
  211.     error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  212.   }
  213.   error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  214.  }
  215.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  216. }
  217.  
  218.  
  219.  
  220. void lf_fprint LF_PARAMS
  221. {
  222.  /* sintassi (fprint stream {sx}* ) */
  223.  /* serve per stampare le s-espressioni su un file */
  224.  
  225.  node n=nin;
  226.  node np;
  227.  node f;
  228.  
  229.  if(IS_CONS(nin)){
  230.    eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  231.    f=calc_pointer(nout);
  232.    if(IS_VALUE(f) && GET_VTYPE(f)==NT_STREAM){
  233.      if(STREAM(f)==NULL){
  234.        nout->node=NIL;
  235.        nout->type=P_ALLNODE;
  236.        return;
  237.      }
  238.      nout->node=NIL;
  239.      nout->type=P_ALLNODE;
  240.      nin=CONSRIGHT(nin);
  241.      while(nin!=NIL){
  242.        if(IS_CONS(nin)){
  243.      eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  244.      np=calc_pointer(nout);
  245.      if(IS_VALUE(np) && GET_VTYPE(np)==NT_STRING){
  246.        lisp_print_string(string_getconv(STRING(np),buf1),STREAM(f));
  247.      }else{
  248.        fprint_func(np,STREAM(f));
  249.      }
  250.        }else{
  251.      error(E_BADLIST,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  252.        }
  253.        nin=CONSRIGHT(nin);
  254.      }
  255.      return;
  256.    }
  257.    error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nin);
  258.  }
  259.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nin);
  260. }
  261.  
  262.  
  263. void lf_finput LF_PARAMS
  264. {
  265.  /* (input streamin streamout{puo' essere nil o NULL} prompt) */
  266.  
  267.  FILE *fin,*fout;
  268.  node n,nn=nin;
  269.  
  270.  if(IS_CONS(nin)){
  271.   eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  272.   n=calc_pointer(nout);
  273.   if(IS_VALUE(n)&&GET_VTYPE(n)==NT_STREAM){
  274.     fin=STREAM(n);
  275.     if(fin==stdout||fin==stderr||fin==stdprn||fin==stdaux||fin==NULL){
  276.       nout->node=NIL;
  277.       nout->type=P_ALLNODE;
  278.       return;
  279.     }
  280.     nin=CONSRIGHT(nin);
  281.     if(IS_CONS(nin)){
  282.       eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  283.       n=calc_pointer(nout);
  284.       if( (IS_VALUE(n)&&GET_VTYPE(n)==NT_STREAM) || n==NIL){
  285.     fout=(n==NIL)?NULL:STREAM(n);
  286.     nin=CONSRIGHT(nin);
  287.     if(IS_CONS(nin)){
  288.       eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  289.       n=calc_pointer(nout);
  290.       if( IS_VALUE(n)&&GET_VTYPE(n)==NT_STRING ){
  291.         nout->node=input_func(fin,fout,string_get(STRING(n),buf3));
  292.         if(nout->node==VOID){
  293.           nout->node=node_alloc(PARSE_ERROR_ID);
  294.         }
  295.         nout->type=P_ALLNODE;
  296.         return;
  297.       }
  298.       error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  299.     }
  300.     error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  301.       }
  302.       error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  303.     }
  304.     error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  305.   }
  306.   error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  307.  }
  308.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  309. }
  310.  
  311.  
  312.  
  313. /*  fscanf:  interi, reali, stringhe */
  314.  
  315.  
  316. void lf_fscanf LF_PARAMS
  317. {
  318.  
  319.  /* (fscanf streamin type ) */
  320.  /* ritorna *SYNTAX_ERROR* o il valore */
  321.  
  322.  FILE *fin;
  323.  node n,nn=nin;
  324.  double v;
  325.  n_int i;
  326.  int ret;
  327.  
  328.  if(IS_CONS(nin)){
  329.   eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  330.   n=calc_pointer(nout);
  331.   if(IS_VALUE(n)&&GET_VTYPE(n)==NT_STREAM){
  332.     fin=STREAM(n);
  333.     if(fin==stdin||fin==stdout||fin==stderr||fin==stdprn||fin==stdaux||fin==NULL){
  334.       nout->node=NIL;
  335.       nout->type=P_ALLNODE;
  336.       return;
  337.     }
  338.     nin=CONSRIGHT(nin);
  339.     if(IS_CONS(nin)){
  340.       eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  341.       n=calc_pointer(nout);
  342.       if( IS_VALUE(n)&&GET_VTYPE(n)==NT_INTEGER ){
  343.     nout->type=P_ALLNODE;
  344.     switch(INTEGER(n)){
  345.       case 0: /* integer */
  346.         ret=fscanf(fin,"%ld",&i);
  347.         if(ret==0){
  348.           nout->node=node_alloc( PARSE_ERROR_ID );
  349.           return;
  350.         }
  351.         TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_INTEGER;
  352.         INTEGER(nout->node)=(n_int)i;
  353.         return;
  354.       case 1: /* real */
  355.         ret=fscanf(fin,"%lf",&v);
  356.         if(ret==0){
  357.           nout->node=node_alloc( PARSE_ERROR_ID );
  358.           return;
  359.         }
  360.         TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_REAL;
  361.         REAL(nout->node)=v;
  362.         return;
  363.       case 2: /* string */
  364.         if(!fgets(buf1,MAX_ID_LENGHT+1,fin)){
  365.           *buf1=0;
  366.         }
  367.         nout->node=node_make();
  368.         STRING(nout->node)=string_put(buf1,nout->node);
  369.         TYPE(nout->node)|=NT_IS_VALUE+NT_STRING;
  370.         return;
  371.     }
  372.       }
  373.       error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  374.     }
  375.     error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  376.   }
  377.   error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  378.  }
  379.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  380. }
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392. void lf_input LF_PARAMS
  393. {
  394.  /* accetta una s-espressione da tastiera e la ritorna */
  395.  if(nin==NIL){
  396.    if( (nout->node=input_func(stdin,stdout,INPUT_PROMPT)) ==VOID){
  397.      nout->node=node_alloc(PARSE_ERROR_ID);
  398.    }
  399.    nout->type=P_ALLNODE;
  400.    return;
  401.  }
  402.  error(nin==NIL?E_FEWARGS:E_BADLIST,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&nin);
  403. }
  404.  
  405. void lf_print LF_PARAMS
  406. {
  407.  node n=nin;
  408.  node np;
  409.  
  410.  nout->node=NIL;
  411.  nout->type=P_ALLNODE;
  412.  while(nin!=NIL){
  413.    if(IS_CONS(nin)){
  414.      eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  415.      np=calc_pointer(nout);
  416.      if(IS_VALUE(np) && GET_VTYPE(np)==NT_STRING){
  417.        lisp_print_string(string_getconv(STRING(np),buf1),stdout);
  418.      }else{
  419.        fprint_func(np,stdout);
  420.      }
  421.    }else{
  422.      error(E_BADLIST,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  423.    }
  424.    nin=CONSRIGHT(nin);
  425.  }
  426. }
  427.  
  428.  
  429. void    lf_load LF_PARAMS
  430. {
  431.  node n=nin;
  432.  
  433.  while(nin!=NIL){
  434.   if(IS_CONS(nin)){
  435.     eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  436.     nout->node=calc_pointer(nout);
  437.     if(IS_VALUE(nout->node)&&GET_VTYPE(nout->node)==NT_STRING){
  438.       if(eval_lisp_file(string_get(STRING(nout->node),buf3),genv,lenv)==VOID){
  439.     nout->node=NIL;
  440.     nout->type=P_ALLNODE;
  441.     return;
  442.       }
  443.     }
  444.     else
  445.       error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nout->node);
  446.     nin=CONSRIGHT(nin);
  447.   }
  448.   else
  449.     error(E_BADLIST,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  450.  }
  451.  nout->node=T;
  452.  nout->type=P_ALLNODE;
  453. }
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461. void lf_readline LF_PARAMS
  462. {
  463.  /* SINTASSI: (READLINE {INT}? {STRINGA}? */
  464.  node n;
  465.  int  len=MAX_ID_LENGHT;
  466.  
  467.  if(IS_CONS(nin)){
  468.    eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  469.    nin=CONSRIGHT(nin);
  470.    n=calc_pointer(nout);
  471.    if(IS_VALUE(n) && GET_VTYPE(n)==NT_INTEGER){
  472.      len=(int)INTEGER(n);
  473.    }else{
  474.      error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&n);
  475.    }
  476.  }
  477.  buf1[0]=0;
  478.  if(IS_CONS(nin)){
  479.    eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  480.    nin=CONSRIGHT(nin);
  481.    n=calc_pointer(nout);
  482.    if(IS_VALUE(n) && GET_VTYPE(n)==NT_STRING){
  483.      string_get(STRING(n),buf1);
  484.    }else{
  485.      error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&n);
  486.    }
  487.  }
  488.  if(nin==NIL){
  489.    lisp_get_string(buf1,len,stdin);
  490.  
  491.    TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_STRING;
  492.    STRING(nout->node)=string_put(buf1,nout->node);
  493.  
  494.    nout->type=P_ALLNODE;
  495.    return;
  496.  }
  497.  error(E_TOOMANYARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nin);
  498. }
  499.  
  500.  
  501.  
  502.  
  503.  
  504.  
  505. /* 80x25 */
  506.  
  507. void lf_curpos LF_PARAMS
  508. {
  509.  node n,nn=nin;
  510.  n_int x,y;
  511.  
  512.  if(IS_CONS(nin)){
  513.    eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  514.    n=calc_pointer(nout);
  515.    if( IS_VALUE(n) && GET_VTYPE(n)==NT_INTEGER ){
  516.      x=INTEGER(n);
  517.      nin=CONSRIGHT(nin);
  518.      if(x>0 && x<81){
  519.        if(IS_CONS(nin)){
  520.      eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  521.      n=calc_pointer(nout);
  522.      if( IS_VALUE(n) && GET_VTYPE(n)==NT_INTEGER ){
  523.        y=INTEGER(n);
  524.        if(y>0 && y<26){
  525.          lisp_curpos((unsigned)x,(unsigned)y);
  526.          return;
  527.        }
  528.      }
  529.      error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  530.        }
  531.        error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  532.      }
  533.    }
  534.    error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  535.  }
  536.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  537. }
  538.  
  539.  
  540. void lf_textcolor LF_PARAMS
  541. {
  542.  node n,nn=nin;
  543.  n_int f=0,b=0,a=0;
  544.  
  545.  if(IS_CONS(nin)){
  546.    eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  547.    n=calc_pointer(nout);
  548.    if( IS_VALUE(n) && GET_VTYPE(n)==NT_INTEGER ){
  549.      f=INTEGER(n);
  550.    }else
  551.      error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  552.    nin=CONSRIGHT(nin);
  553.    if(IS_CONS(nin)){
  554.      eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  555.      n=calc_pointer(nout);
  556.      if( IS_VALUE(n) && GET_VTYPE(n)==NT_INTEGER ){
  557.        b=INTEGER(n);
  558.      }else
  559.        error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  560.      nin=CONSRIGHT(nin);
  561.      if(IS_CONS(nin)){
  562.        eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);
  563.        n=calc_pointer(nout);
  564.        if( IS_VALUE(n) && GET_VTYPE(n)==NT_INTEGER ){
  565.      a=INTEGER(n);
  566.        }else
  567.      error(E_BADARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&n);
  568.      }
  569.    }
  570.    lisp_charcolor(f,b,a);
  571.    return;
  572.  }
  573.  error(E_FEWARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nn);
  574. }
  575.  
  576.  
  577. void lf_cls LF_PARAMS
  578. {
  579.  if(!IS_CONS(nin)){
  580.    lisp_cls();
  581.    nout->node=T;
  582.    nout->type=P_ALLNODE;
  583.    return;
  584.  }
  585.  error(E_TOOMANYARGS,ERR_MERROR|ERR_PNODE|ERR_TBLVL,&nin);
  586. }
  587.  
  588. void lf_readchar LF_PARAMS
  589. {
  590.  TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_INTEGER;
  591.  INTEGER(nout->node)=cl_getch();
  592.  nout->type=P_ALLNODE;
  593. }
  594.  
  595. /*
  596. void lf_charready LF_PARAMS
  597. {
  598.  TYPE(nout->node=node_make())|=NT_IS_VALUE+NT_INTEGER;
  599.  nout->node=cl_kbhit()?T:NIL;
  600.  nout->type=P_ALLNODE;
  601. }
  602. */
  603.