home *** CD-ROM | disk | FTP | other *** search
/ Amiga ACS 1998 #4 / amigaacscoverdisc1998-041998.iso / utilities / shareware / dev / ucb_logoppc / source / lists.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-06-25  |  15.5 KB  |  712 lines
  1. /*
  2.  *      lists.c         logo list functions 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. #include "logo.h"
  22. #include "globals.h"
  23. #include <math.h>
  24.  
  25. NODE *bfable_arg(NODE *args) {
  26.     NODE *arg = car(args);
  27.  
  28.     while ((arg == NIL || arg == UNBOUND || arg == Null_Word ||
  29.         nodetype(arg) == ARRAY) && NOT_THROWING) {
  30.     setcar(args, err_logo(BAD_DATA, arg));
  31.     arg = car(args);
  32.     }
  33.     return arg;
  34. }
  35.  
  36. NODE *list_arg(NODE *args) {
  37.     NODE *arg = car(args);
  38.  
  39.     while (!(arg == NIL || is_list(arg)) && NOT_THROWING) {
  40.     setcar(args, err_logo(BAD_DATA, arg));
  41.     arg = car(args);
  42.     }
  43.     return arg;
  44. }
  45.  
  46. NODE *lbutfirst(NODE *args) {
  47.     NODE *val = UNBOUND, *arg;
  48.  
  49.     arg = bfable_arg(args);
  50.     if (NOT_THROWING) {
  51.     if (is_list(arg))
  52.         val = cdr(arg);
  53.     else {
  54.         setcar(args, cnv_node_to_strnode(arg));
  55.         arg = car(args);
  56.         if (getstrlen(arg) > 1)
  57.         val = make_strnode(getstrptr(arg) + 1,
  58.               getstrhead(arg),
  59.               getstrlen(arg) - 1,
  60.               nodetype(arg),
  61.               strnzcpy);
  62.         else
  63.         val = Null_Word;
  64.     }
  65.     }
  66.     return(val);
  67. }
  68.  
  69. NODE *lbutlast(NODE *args) {
  70.     NODE *val = UNBOUND, *lastnode = NIL, *tnode, *arg;
  71.  
  72.     arg = bfable_arg(args);
  73.     if (NOT_THROWING) {
  74.     if (is_list(arg)) {
  75.         args = arg;
  76.         val = NIL;
  77.         while (cdr(args) != NIL) {
  78.         tnode = cons(car(args), NIL);
  79.         if (val == NIL) {
  80.             val = tnode;
  81.             lastnode = tnode;
  82.         } else {
  83.             setcdr(lastnode, tnode);
  84.             lastnode = tnode;
  85.         }
  86.         args = cdr(args);
  87.         if (check_throwing) break;
  88.         }
  89.     } else {
  90.         setcar(args, cnv_node_to_strnode(arg));
  91.         arg = car(args);
  92.         if (getstrlen(arg) > 1)
  93.         val = make_strnode(getstrptr(arg),
  94.               getstrhead(arg),
  95.               getstrlen(arg) - 1,
  96.               nodetype(arg),
  97.               strnzcpy);
  98.         else
  99.         val = Null_Word;
  100.     }
  101.     }
  102.     return(val);
  103. }
  104.  
  105. NODE *lfirst(NODE *args) {
  106.     NODE *val = UNBOUND, *arg;
  107.  
  108.     if (nodetype(car(args)) == ARRAY) {
  109.     return make_intnode((FIXNUM)getarrorg(car(args)));
  110.     }
  111.     arg = bfable_arg(args);
  112.     if (NOT_THROWING) {
  113.     if (is_list(arg))
  114.         val = car(arg);
  115.     else {
  116.         setcar(args, cnv_node_to_strnode(arg));
  117.         arg = car(args);
  118.         val = make_strnode(getstrptr(arg), getstrhead(arg), 1,
  119.                    nodetype(arg), strnzcpy);
  120.     }
  121.     }
  122.     return(val);
  123. }
  124.  
  125. NODE *lfirsts(NODE *args) {
  126.     NODE *val = UNBOUND, *arg, *argp, *tail;
  127.  
  128.     arg = list_arg(args);
  129.     if (car(args) == NIL) return(NIL);
  130.     if (NOT_THROWING) {
  131.     val = cons(lfirst(arg), NIL);
  132.     tail = val;
  133.     for (argp = cdr(arg); argp != NIL; argp = cdr(argp)) {
  134.         setcdr(tail, cons(lfirst(argp), NIL));
  135.         tail = cdr(tail);
  136.         if (check_throwing) break;
  137.     }
  138.     if (stopping_flag == THROWING) {
  139.         return UNBOUND;
  140.     }
  141.     }
  142.     return(val);
  143. }
  144.  
  145. NODE *lbfs(NODE *args) {
  146.     NODE *val = UNBOUND, *arg, *argp, *tail;
  147.  
  148.     arg = list_arg(args);
  149.     if (car(args) == NIL) return(NIL);
  150.     if (NOT_THROWING) {
  151.     val = cons(lbutfirst(arg), NIL);
  152.     tail = val;
  153.     for (argp = cdr(arg); argp != NIL; argp = cdr(argp)) {
  154.         setcdr(tail, cons(lbutfirst(argp), NIL));
  155.         tail = cdr(tail);
  156.         if (check_throwing) break;
  157.     }
  158.     if (stopping_flag == THROWING) {
  159.         return UNBOUND;
  160.     }
  161.     }
  162.     return(val);
  163. }
  164.  
  165. NODE *llast(NODE *args) {
  166.     NODE *val = UNBOUND, *arg;
  167.  
  168.     arg = bfable_arg(args);
  169.     if (NOT_THROWING) {
  170.     if (is_list(arg)) {
  171.         args = arg;
  172.         while (cdr(args) != NIL) {
  173.         args = cdr(args);
  174.         if (check_throwing) break;
  175.         }
  176.         val = car(args);
  177.     }
  178.     else {
  179.         setcar(args, cnv_node_to_strnode(arg));
  180.         arg = car(args);
  181.         val = make_strnode(getstrptr(arg) + getstrlen(arg) - 1,
  182.                    getstrhead(arg), 1, nodetype(arg), strnzcpy);
  183.     }
  184.     }
  185.     return(val);
  186. }
  187.  
  188. NODE *llist(NODE *args) {
  189.     return(args);
  190. }
  191.  
  192. NODE *lemptyp(NODE *arg) {
  193.     return torf(car(arg) == NIL || car(arg) == Null_Word);
  194. }
  195.  
  196. NODE *char_arg(NODE *args) {
  197.     NODE *arg = car(args), *val;
  198.  
  199.     val = cnv_node_to_strnode(arg);
  200.     while ((val == UNBOUND || getstrlen(val) != 1) && NOT_THROWING) {
  201.     setcar(args, err_logo(BAD_DATA, arg));
  202.     arg = car(args);
  203.     val = cnv_node_to_strnode(arg);
  204.     }
  205.     setcar(args,val);
  206.     return(val);
  207. }
  208.  
  209. NODE *lascii(NODE *args) {
  210.     FIXNUM i;
  211.     NODE *val = UNBOUND, *arg;
  212.  
  213.     arg = char_arg(args);
  214.     if (NOT_THROWING) {
  215.     i = (FIXNUM)clearparity(*getstrptr(arg)) & 0377;
  216.     val = make_intnode(i);
  217.     }
  218.     return(val);
  219. }
  220.  
  221. NODE *lrawascii(NODE *args) {
  222.     FIXNUM i;
  223.     NODE *val = UNBOUND, *arg;
  224.  
  225.     arg = char_arg(args);
  226.     if (NOT_THROWING) {
  227.     i = (FIXNUM)(*getstrptr(arg));
  228.     val = make_intnode(i);
  229.     }
  230.     return(val);
  231. }
  232.  
  233. NODE *lbackslashedp(NODE *args) {
  234.     char i;
  235.     NODE *arg;
  236.  
  237.     arg = char_arg(args);
  238.     if (NOT_THROWING) {
  239.     i = *getstrptr(arg);
  240.     return torf(getparity(i));
  241.     }
  242.     return(UNBOUND);
  243. }
  244.  
  245. NODE *lchar(NODE *args) {
  246.     NODE *val = UNBOUND, *arg;
  247.     char c;
  248.  
  249.     arg = pos_int_arg(args);
  250.     if (NOT_THROWING) {
  251.     c = getint(arg);
  252.     val = make_strnode(&c, (struct string_block *)NULL, 1,
  253.                STRING, strnzcpy);
  254.     }
  255.     return(val);
  256. }
  257.  
  258. NODE *lcount(NODE *args) {
  259.     int cnt = 0;
  260.     NODE *arg;
  261.  
  262.     arg = car(args);
  263.     if (arg != NIL && arg != Null_Word) {
  264.     if (is_list(arg)) {
  265.         args = arg;
  266.         for (; args != NIL; cnt++) {
  267.         args = cdr(args);
  268.         if (check_throwing) break;
  269.         }
  270.     } else if (nodetype(arg) == ARRAY) {
  271.         cnt = getarrdim(arg);
  272.     } else {
  273.         setcar(args, cnv_node_to_strnode(arg));
  274.         cnt = getstrlen(car(args));
  275.     }
  276.     }
  277.     return(make_intnode((FIXNUM)cnt));
  278. }
  279.  
  280. NODE *lfput(NODE *args) {
  281.     NODE *lst, *arg;
  282.  
  283.     arg = car(args);
  284.     lst = list_arg(cdr(args));
  285.     if (NOT_THROWING)
  286.     return cons(arg,lst);
  287.     else
  288.     return UNBOUND;
  289. }
  290.  
  291. NODE *llput(NODE *args) {
  292.     NODE *lst, *arg, *val = UNBOUND, *lastnode = NIL, *tnode = NIL;
  293.  
  294.     arg = car(args);
  295.     lst = list_arg(cdr(args));
  296.     if (NOT_THROWING) {
  297.     val = NIL;
  298.     while (lst != NIL) {
  299.         tnode = cons(car(lst), NIL);
  300.         if (val == NIL) {
  301.         val = tnode;
  302.         } else {
  303.         setcdr(lastnode, tnode);
  304.         }
  305.         lastnode = tnode;
  306.         lst = cdr(lst);
  307.         if (check_throwing) break;
  308.     }
  309.     if (val == NIL)
  310.         val = cons(arg, NIL);
  311.     else
  312.         setcdr(lastnode, cons(arg, NIL));
  313.     }
  314.     return(val);
  315. }
  316.  
  317. NODE *string_arg(NODE *args) {
  318.     NODE *arg = car(args), *val;
  319.  
  320.     val = cnv_node_to_strnode(arg);
  321.     while (val == UNBOUND && NOT_THROWING) {
  322.     setcar(args, err_logo(BAD_DATA, arg));
  323.     arg = car(args);
  324.     val = cnv_node_to_strnode(arg);
  325.     }
  326.     setcar(args,val);
  327.     return(val);
  328. }
  329.  
  330. NODE *lword(NODE *args) {
  331.     NODE *val = NIL, *arg = NIL;
  332.     int cnt = 0;
  333.     NODETYPES str_type = STRING;
  334.  
  335.     if (args == NIL) return Null_Word;
  336.     val = args;
  337.     while (val != NIL && NOT_THROWING) {
  338.     arg = string_arg(val);
  339.     val = cdr(val);
  340.     if (NOT_THROWING) {
  341.         if (backslashed(arg))
  342.         str_type = VBAR_STRING;
  343.         cnt += getstrlen(arg);
  344.     }
  345.     }
  346.     if (NOT_THROWING)
  347.     val = make_strnode((char *)args, (struct string_block *)NULL,
  348.                cnt, str_type, word_strnzcpy); /* kludge */
  349.     else
  350.     val = UNBOUND;
  351.     return(val);
  352. }
  353.  
  354. NODE *lsentence(NODE *args) {
  355.     NODE *tnode = NIL, *lastnode = NIL, *val = NIL, *arg = NIL;
  356.  
  357.     while (args != NIL && NOT_THROWING) {
  358.     arg = car(args);
  359.     while (nodetype(arg) == ARRAY && NOT_THROWING) {
  360.         setcar(args, err_logo(BAD_DATA, arg));
  361.         arg = car(args);
  362.     }
  363.     args = cdr(args);
  364.     if (stopping_flag == THROWING) break;
  365.     if (is_list(arg)) {
  366.         while (arg != NIL && NOT_THROWING) {
  367.         tnode = cons(car(arg), NIL);
  368.         arg = cdr(arg);
  369.         if (val == NIL) val = tnode;
  370.         else setcdr(lastnode, tnode);
  371.         lastnode = tnode;
  372.         }
  373.     } else {
  374.         tnode = cons(arg, NIL);
  375.         if (val == NIL) val = tnode;
  376.         else setcdr(lastnode, tnode);
  377.         lastnode = tnode;
  378.     }
  379.     }
  380.     if (stopping_flag == THROWING) {
  381.     return UNBOUND;
  382.     }
  383.     return(val);
  384. }
  385.  
  386. NODE *lwordp(NODE *arg) {
  387.     arg = car(arg);
  388.     return torf(arg != UNBOUND && !aggregate(arg));
  389. }
  390.  
  391. NODE *llistp(NODE *arg) {
  392.     arg = car(arg);
  393.     return torf(is_list(arg));
  394. }
  395.  
  396. NODE *lnumberp(NODE *arg) {
  397.     setcar(arg, cnv_node_to_numnode(car(arg)));
  398.     return torf(car(arg) != UNBOUND);
  399. }
  400.  
  401. NODE *larrayp(NODE *arg) {
  402.     return torf(nodetype(car(arg)) == ARRAY);
  403. }
  404.  
  405. NODE *memberp_help(NODE *args, BOOLEAN notp, BOOLEAN substr) {
  406.     NODE *obj1, *obj2, *val;
  407.     int leng;
  408.     int caseig = (compare_node(valnode__caseobj(Caseignoredp),
  409.                    True, TRUE) == 0);
  410.  
  411.     val = False;
  412.     obj1 = car(args);
  413.     obj2 = cadr(args);
  414.     if (is_list(obj2)) {
  415.     if (substr) return False;
  416.     while (obj2 != NIL && NOT_THROWING) {
  417.         if (equalp_help(obj1, car(obj2), caseig))
  418.         return (notp ? obj2 : True);
  419.         obj2 = cdr(obj2);
  420.         if (check_throwing) break;
  421.     }
  422.     return (notp ? NIL : False);
  423.     }
  424.     else if (nodetype(obj2) == ARRAY) {
  425.     int len = getarrdim(obj2);
  426.     NODE **data = getarrptr(obj2);
  427.  
  428.     if (notp)
  429.         err_logo(BAD_DATA_UNREC,obj2);
  430.     if (substr) return False;
  431.     while (--len >= 0 && NOT_THROWING) {
  432.         if (equalp_help(obj1, *data++, caseig)) return True;
  433.     }
  434.     return False;
  435.     } else {
  436.     NODE *tmp;
  437.     int i;
  438.  
  439.     if (aggregate(obj1)) return (notp ? Null_Word : False);
  440.     setcar (cdr(args), cnv_node_to_strnode(obj2));
  441.     obj2 = cadr(args);
  442.     setcar (args, cnv_node_to_strnode(obj1));
  443.     obj1 = car(args);
  444.     tmp = NIL;
  445.     if (obj1 != UNBOUND && obj2 != UNBOUND &&
  446.         getstrlen(obj1) <= getstrlen(obj2) &&
  447.         (substr || (getstrlen(obj1) == 1))) {
  448.         leng = getstrlen(obj2) - getstrlen(obj1);
  449.         setcar(cdr(args),make_strnode(getstrptr(obj2), getstrhead(obj2),
  450.                       getstrlen(obj1), nodetype(obj2),
  451.                       strnzcpy));
  452.         tmp = cadr(args);
  453.         for (i = 0; i <= leng; i++) {
  454.         if (equalp_help(obj1, tmp, caseig)) {
  455.             if (notp) {
  456.             setstrlen(tmp,leng+getstrlen(obj1)-i);
  457.             return tmp;
  458.             } else return True;
  459.         }
  460.         setstrptr(tmp, getstrptr(tmp) + 1);
  461.         }
  462.     }
  463.     return (notp ? Null_Word : False);
  464.     }
  465. }
  466.  
  467. NODE *lmemberp(NODE *args) {
  468.     return(memberp_help(args, FALSE, FALSE));
  469. }
  470.  
  471. NODE *lsubstringp(NODE *args) {
  472.     return(memberp_help(args, FALSE, TRUE));
  473. }
  474.  
  475. NODE *lmember(NODE *args) {
  476.     return(memberp_help(args, TRUE, FALSE));
  477. }
  478.  
  479. NODE *integer_arg(NODE *args) {
  480.     NODE *arg = car(args), *val;
  481.     FIXNUM i;
  482.     FLONUM f;
  483.  
  484.     val = cnv_node_to_numnode(arg);
  485.     while ((nodetype(val) != INT) && NOT_THROWING) {
  486.     if (nodetype(val) == FLOATT &&
  487.             fmod((f = getfloat(val)), 1.0) == 0.0 &&
  488.             f >= -(FLONUM)MAXLOGOINT && f < (FLONUM)MAXLOGOINT) {
  489. #if HAVE_IRINT
  490.         i = irint(f);
  491. #else
  492.         i = f;
  493. #endif
  494.         val = make_intnode(i);
  495.         break;
  496.     }
  497.     setcar(args, err_logo(BAD_DATA, arg));
  498.     arg = car(args);
  499.     val = cnv_node_to_numnode(arg);
  500.     }
  501.     setcar(args,val);
  502.     if (nodetype(val) == INT) return(val);
  503.     return UNBOUND;
  504. }
  505.  
  506. FIXNUM int_arg(NODE *args) {
  507.     NODE *arg =integer_arg(args);
  508.  
  509.     if (NOT_THROWING) return getint(arg);
  510.     return 0;
  511. }
  512.  
  513. NODE *litem(NODE *args) {
  514.     int i;
  515.     NODE *obj, *val;
  516.  
  517.     val = integer_arg(args);
  518.     obj = cadr(args);
  519.     while ((obj == NIL || obj == Null_Word) && NOT_THROWING) {
  520.     setcar(cdr(args), err_logo(BAD_DATA, obj));
  521.     obj = cadr(args);
  522.     }
  523.     if (NOT_THROWING) {
  524.     i = getint(val);
  525.     if (is_list(obj)) {
  526.         if (i <= 0) {
  527.         err_logo(BAD_DATA_UNREC, val);
  528.         return UNBOUND;
  529.         }
  530.         while (--i > 0) {
  531.         obj = cdr(obj);
  532.         if (obj == NIL) {
  533.             err_logo(BAD_DATA_UNREC, val);
  534.             return UNBOUND;
  535.         }
  536.         }
  537.         return car(obj);
  538.     }
  539.     else if (nodetype(obj) == ARRAY) {
  540.         i -= getarrorg(obj);
  541.         if (i < 0 || i >= getarrdim(obj)) {
  542.         err_logo(BAD_DATA_UNREC, val);
  543.         return UNBOUND;
  544.         }
  545.         return (getarrptr(obj))[i];
  546.     }
  547.     else {
  548.         if (i <= 0) {
  549.         err_logo(BAD_DATA_UNREC, val);
  550.         return UNBOUND;
  551.         }
  552.         setcar (cdr(args), cnv_node_to_strnode(obj));
  553.         obj = cadr(args);
  554.         if (i > getstrlen(obj)) {
  555.         err_logo(BAD_DATA_UNREC, val);
  556.         return UNBOUND;
  557.         }
  558.         return make_strnode(getstrptr(obj) + i - 1, getstrhead(obj),
  559.                 1, nodetype(obj), strnzcpy);
  560.     }
  561.     }
  562.     return(UNBOUND);
  563. }
  564.  
  565. int circular(NODE *arr, NODE *new) {
  566.     if (new == NIL) return(0);
  567.     else if (nodetype(new) == ARRAY) {
  568.     int i = getarrdim(new);
  569.     NODE **p = getarrptr(new);
  570.  
  571.     if (new == arr) return(1);
  572.     while (--i >= 0) {
  573.         if (circular(arr,*p++)) return(1);
  574.     }
  575.     return(0);
  576.     } else if (is_list(new)) {
  577.     while (new != NIL) {
  578.         if (circular(arr,car(new))) return(1);
  579.         new = cdr(new);
  580.     }
  581.     return(0);
  582.     } else return(0);
  583. }
  584.  
  585. NODE *setitem_helper(NODE *args, BOOLEAN safe) {
  586.     int i;
  587.     NODE *obj, *val, *cont;
  588.  
  589.     val = integer_arg(args);
  590.     obj = cadr(args);
  591.     while (nodetype(obj) != ARRAY && NOT_THROWING) {
  592.     setcar(cdr(args), err_logo(BAD_DATA, obj));
  593.     obj = cadr(args);
  594.     }
  595.     cont = car(cddr(args));
  596.     if (NOT_THROWING) {
  597.     i = getint(val);
  598.     if (safe) {
  599.         while (circular(obj,cont) && NOT_THROWING) {
  600.         setcar(cddr(args), err_logo(BAD_DATA, cont));
  601.         cont = car(cddr(args));
  602.         }
  603.     }
  604.     if (NOT_THROWING) {
  605.         i -= getarrorg(obj);
  606.         while ((i < 0 || i >= getarrdim(obj)) && NOT_THROWING) {
  607.             setcar(args, err_logo(BAD_DATA, val));
  608.             val = integer_arg(args);
  609.             i = getint(val);
  610.         }
  611.         if (NOT_THROWING) {
  612.             (getarrptr(obj))[i] = cont;
  613.             check_valid_oldyoung(obj, cont);
  614.         }
  615.     }
  616.     }
  617.     return(UNBOUND);
  618. }
  619.  
  620. NODE *lsetitem(NODE *args) {
  621.     return setitem_helper(args, TRUE);
  622. }
  623.  
  624. NODE *l_setitem(NODE *args) {
  625.     return setitem_helper(args, FALSE);
  626. }
  627.  
  628. NODE *larray(NODE *args) {
  629.     NODE *arg;
  630.     int d, o;
  631.  
  632.     arg = pos_int_arg(args);
  633.     if (cdr(args) != NIL) o = int_arg(cdr(args));
  634.     else o = 1;
  635.  
  636.     if (NOT_THROWING) {
  637.     d = getint(arg);
  638.     arg = make_array(d);
  639.     setarrorg(arg,o);
  640.     return arg;
  641.     }
  642.     return UNBOUND;
  643. }
  644.  
  645. FLONUM float_arg(NODE *args) {
  646.     NODE *arg = car(args), *val;
  647.  
  648.     val = cnv_node_to_numnode(arg);
  649.     while (!is_number(val) && NOT_THROWING) {
  650.     setcar(args, err_logo(BAD_DATA, arg));
  651.     arg = car(args);
  652.     val = cnv_node_to_numnode(arg);
  653.     }
  654.     setcar(args,val);
  655.     if (nodetype(val) == FLOATT) return getfloat(val);
  656.     if (nodetype(val) == INT) return (FLONUM)getint(val);
  657.     return 0.0;
  658. }
  659.  
  660. NODE *lform(NODE *args) {
  661.     FLONUM number;
  662.     int width, precision = 0;
  663.     char result[100];
  664.     char format[20];
  665.  
  666.     number = float_arg(args);
  667.     width = (int)int_arg(cdr(args));
  668.     if (width < 0) {
  669.     print_stringptr = format;
  670.     print_stringlen = 20;
  671.     ndprintf((FILE *)NULL,"%p\n",string_arg(cddr(args)));
  672.     *print_stringptr = '\0';
  673.     } else
  674.     precision = (int)int_arg(cddr(args));
  675.     if (NOT_THROWING) {
  676.     if (width >= 100) width = 99;
  677.     if (width < 0)
  678.         sprintf(result,format,number);
  679.     else
  680.         sprintf(result,"%*.*f",width,precision,number);
  681.     return(make_strnode(result, (struct string_block *)NULL,
  682.                 (int)strlen(result), STRING, strnzcpy));
  683.     }
  684.     return(UNBOUND);
  685. }
  686.  
  687. NODE *l_setfirst(NODE *args) {
  688.     NODE *list, *newval;
  689.  
  690.     list = car(args);
  691.     newval = cadr(args);
  692.     while (NOT_THROWING && (list == NIL || !is_list(list))) {
  693.     setcar(args, err_logo(BAD_DATA,list));
  694.     list = car(args);
  695.     }
  696.     setcar(list,newval);
  697.     return(UNBOUND);
  698. }
  699.  
  700. NODE *l_setbf(NODE *args) {
  701.     NODE *list, *newval;
  702.  
  703.     list = car(args);
  704.     newval = cadr(args);
  705.     while (NOT_THROWING && (list == NIL || !is_list(list))) {
  706.     setcar(args, err_logo(BAD_DATA,list));
  707.     list = car(args);
  708.     }
  709.     setcdr(list,newval);
  710.     return(UNBOUND);
  711. }
  712.