"Fossies" - the Fresh Open Source Software Archive

Member "txr-217/parser.c" (10 Jun 2019, 39593 Bytes) of package /linux/misc/txr-217.tar.bz2:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "parser.c" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 215_vs_216.

    1 /* Copyright 2009-2019
    2  * Kaz Kylheku <kaz@kylheku.com>
    3  * Vancouver, Canada
    4  * All rights reserved.
    5  *
    6  * Redistribution and use in source and binary forms, with or without
    7  * modification, are permitted provided that the following conditions are met:
    8  *
    9  * 1. Redistributions of source code must retain the above copyright notice, this
   10  *    list of conditions and the following disclaimer.
   11  *
   12  * 2. Redistributions in binary form must reproduce the above copyright notice,
   13  *    this list of conditions and the following disclaimer in the documentation
   14  *    and/or other materials provided with the distribution.
   15  *
   16  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
   17  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
   18  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
   19  * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
   20  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
   21  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
   22  * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   23  * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
   24  * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
   25  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   26  */
   27 
   28 #include <stdio.h>
   29 #include <assert.h>
   30 #include <limits.h>
   31 #include <stdlib.h>
   32 #include <string.h>
   33 #include <stdarg.h>
   34 #include <wchar.h>
   35 #include <signal.h>
   36 #include <ctype.h>
   37 #include <wctype.h>
   38 #include <errno.h>
   39 #include "config.h"
   40 #include "alloca.h"
   41 #ifdef __CYGWIN__
   42 #include <sys/utsname.h>
   43 #endif
   44 #if HAVE_SYS_STAT
   45 #include <sys/stat.h>
   46 #endif
   47 #include "lib.h"
   48 #include "signal.h"
   49 #include "unwind.h"
   50 #include "gc.h"
   51 #include "args.h"
   52 #include "utf8.h"
   53 #include "hash.h"
   54 #include "eval.h"
   55 #include "stream.h"
   56 #include "y.tab.h"
   57 #include "sysif.h"
   58 #include "cadr.h"
   59 #include "struct.h"
   60 #include "parser.h"
   61 #include "regex.h"
   62 #include "itypes.h"
   63 #include "buf.h"
   64 #include "vm.h"
   65 #include "txr.h"
   66 #if HAVE_TERMIOS
   67 #include "linenoise/linenoise.h"
   68 #endif
   69 
   70 val parser_s, unique_s, circref_s;
   71 val listener_hist_len_s, listener_multi_line_p_s, listener_sel_inclusive_p_s;
   72 val listener_pprint_s, listener_greedy_eval_s;
   73 val rec_source_loc_s;
   74 val intr_s;
   75 static lino_t *lino_ctx;
   76 static int repl_level = 0;
   77 
   78 static val stream_parser_hash, catch_all;
   79 
   80 static void yy_tok_mark(struct yy_token *tok)
   81 {
   82   gc_conservative_mark(tok->yy_lval.val);
   83 }
   84 
   85 static void parser_mark(val obj)
   86 {
   87   int i;
   88   parser_t *p = coerce(parser_t *, obj->co.handle);
   89 
   90   assert (p->parser == nil || p->parser == obj);
   91   gc_mark(p->stream);
   92   gc_mark(p->name);
   93   gc_mark(p->prepared_msg);
   94   gc_mark(p->circ_ref_hash);
   95   if (p->syntax_tree != nao)
   96     gc_mark(p->syntax_tree);
   97   yy_tok_mark(&p->recent_tok);
   98   for (i = 0; i < 4; i++)
   99     yy_tok_mark(&p->tok_pushback[i]);
  100 }
  101 
  102 static void parser_destroy(val obj)
  103 {
  104   parser_t *p = coerce(parser_t *, obj->co.handle);
  105   parser_cleanup(p);
  106   free(p);
  107 }
  108 
  109 static struct cobj_ops parser_ops = {
  110   eq,
  111   cobj_print_op,
  112   parser_destroy,
  113   parser_mark,
  114   cobj_eq_hash_op,
  115 };
  116 
  117 void parser_common_init(parser_t *p)
  118 {
  119   int i;
  120   yyscan_t yyscan;
  121   val rec_source_loc_var = lookup_var(nil, rec_source_loc_s);
  122 
  123   p->parser = nil;
  124   p->lineno = 1;
  125   p->errors = 0;
  126   p->eof = 0;
  127   p->stream = nil;
  128   p->name = nil;
  129   p->prepared_msg = nil;
  130   p->circ_ref_hash = nil;
  131   p->circ_count = 0;
  132   p->syntax_tree = nil;
  133   p->quasi_level = 0;
  134   yylex_init(&yyscan);
  135   p->scanner = convert(scanner_t *, yyscan);
  136   yyset_extra(p, p->scanner);
  137   p->recent_tok.yy_char = 0;
  138   p->recent_tok.yy_lval.val = 0;
  139   for (i = 0; i < 4; i++) {
  140     p->tok_pushback[i].yy_char = 0;
  141     p->tok_pushback[i].yy_lval.val = 0;
  142   }
  143   p->tok_idx = 0;
  144   p->rec_source_loc = !nilp(cdr(rec_source_loc_var));
  145 }
  146 
  147 void parser_cleanup(parser_t *p)
  148 {
  149   if (p->scanner != 0)
  150     yylex_destroy(p->scanner);
  151   p->scanner = 0;
  152 }
  153 
  154 void parser_reset(parser_t *p)
  155 {
  156   yyscan_t yyscan;
  157   parser_cleanup(p);
  158   yylex_init(&yyscan);
  159   p->scanner = convert(scanner_t *, yyscan);
  160   yyset_extra(p, p->scanner);
  161 }
  162 
  163 val parser(val stream, val lineno)
  164 {
  165   parser_t *p = coerce(parser_t *, chk_malloc(sizeof *p));
  166   val parser;
  167   parser_common_init(p);
  168   parser = cobj(coerce(mem_t *, p), parser_s, &parser_ops);
  169   p->parser = parser;
  170   p->lineno = c_num(default_arg(lineno, one));
  171   p->stream = stream;
  172 
  173   return parser;
  174 }
  175 
  176 parser_t *parser_get_impl(val self, val parser)
  177 {
  178   return coerce(parser_t *, cobj_handle(self, parser, parser_s));
  179 }
  180 
  181 val ensure_parser(val stream)
  182 {
  183   loc pcdr = gethash_l(lit("internal error"), stream_parser_hash, stream, nulloc);
  184   val pars = deref(pcdr);
  185   if (pars)
  186     return pars;
  187   return set(pcdr, parser(stream, one));
  188 }
  189 
  190 static void pushback_token(parser_t *p, struct yy_token *tok)
  191 {
  192   assert (p->tok_idx < 4);
  193   p->tok_pushback[p->tok_idx++] = *tok;
  194 }
  195 
  196 val parser_set_lineno(val self, val stream, val lineno)
  197 {
  198   val parser = ensure_parser(stream);
  199   parser_t *pi = parser_get_impl(self, parser);
  200   pi->lineno = c_num(lineno);
  201   return stream;
  202 }
  203 
  204 void prime_parser(parser_t *p, val name, enum prime_parser prim)
  205 {
  206   struct yy_token sec_tok = { 0 };
  207 
  208   switch (prim) {
  209   case prime_lisp:
  210     sec_tok.yy_char = SECRET_ESCAPE_E;
  211     break;
  212   case prime_interactive:
  213     sec_tok.yy_char = SECRET_ESCAPE_I;
  214     break;
  215   case prime_regex:
  216     sec_tok.yy_char = SECRET_ESCAPE_R;
  217     break;
  218   }
  219 
  220   if (p->recent_tok.yy_char)
  221     pushback_token(p, &p->recent_tok);
  222   pushback_token(p, &sec_tok);
  223   prime_scanner(p->scanner, prim);
  224   set(mkloc(p->name, p->parser), name);
  225 }
  226 
  227 void prime_parser_post(parser_t *p, enum prime_parser prim)
  228 {
  229   p->eof = (p->recent_tok.yy_char == 0);
  230   if (prim == prime_interactive)
  231     p->recent_tok.yy_char = 0;
  232 }
  233 
  234 int parser_callgraph_circ_check(struct circ_stack *rs, val obj)
  235 {
  236   for (; rs; rs = rs->up) {
  237     if (rs->obj == obj)
  238       return 0;
  239   }
  240 
  241   return 1;
  242 }
  243 
  244 static val patch_ref(parser_t *p, val obj)
  245 {
  246   if (consp(obj)) {
  247     val a = pop(&obj);
  248     if (a == circref_s) {
  249       val num = car(obj);
  250       val rep = gethash(p->circ_ref_hash, num);
  251       if (!rep)
  252         yyerrorf(p->scanner, lit("dangling #~s# ref"), num, nao);
  253       if (consp(rep) && car(rep) == circref_s)
  254         yyerrorf(p->scanner, lit("absurd #~s# ref"), num, nao);
  255       if (!p->circ_count--)
  256         yyerrorf(p->scanner, lit("unexpected surplus #~s# ref"), num, nao);
  257       return rep;
  258     }
  259   }
  260   return nil;
  261 }
  262 
  263 static void circ_backpatch(parser_t *p, struct circ_stack *up, val obj)
  264 {
  265   struct circ_stack cs = { up, obj };
  266 
  267   if (!parser_callgraph_circ_check(up, obj))
  268     return;
  269 
  270 tail:
  271   if (!p->circ_count)
  272     return;
  273   if (!is_ptr(obj))
  274     return;
  275   switch (type(obj)) {
  276   case CONS:
  277     {
  278       val a = car(obj);
  279       val d = cdr(obj);
  280       val ra = patch_ref(p, a);
  281       val rd = patch_ref(p, d);
  282 
  283       if (ra)
  284         rplaca(obj, ra);
  285       else
  286         circ_backpatch(p, &cs, a);
  287 
  288       if (rd) {
  289         rplacd(obj, rd);
  290         break;
  291       }
  292 
  293       obj = d;
  294       goto tail;
  295     }
  296   case VEC:
  297     {
  298       cnum i;
  299       cnum l = c_num(length_vec(obj));
  300 
  301       for (i = 0; i < l; i++) {
  302         val in = num(i);
  303         val v = vecref(obj, in);
  304         val rv = patch_ref(p, v);
  305         if (rv)
  306           set(vecref_l(obj, in), rv);
  307         else
  308           circ_backpatch(p, &cs, v);
  309         if (!p->circ_count)
  310           break;
  311       }
  312 
  313       break;
  314     }
  315   case RNG:
  316     {
  317       val s = from(obj);
  318       val e = to(obj);
  319       val rs = patch_ref(p, s);
  320       val re = patch_ref(p, e);
  321 
  322       if (rs)
  323         set_from(obj, rs);
  324       else
  325         circ_backpatch(p, &cs, s);
  326 
  327       if (re) {
  328         set_to(obj, re);
  329         break;
  330       }
  331 
  332       obj = e;
  333       goto tail;
  334     }
  335   case COBJ:
  336     if (hashp(obj)) {
  337       val u = get_hash_userdata(obj);
  338       val ru = patch_ref(p, u);
  339       if (ru)
  340         set_hash_userdata(obj, ru);
  341       if (p->circ_count) {
  342         val iter = hash_begin(obj);
  343         val cell;
  344         val pairs = nil;
  345 
  346         while ((cell = hash_next(iter))) {
  347           circ_backpatch(p, &cs, cell);
  348           push(cell, &pairs);
  349         }
  350 
  351         clearhash(obj);
  352 
  353         while (pairs) {
  354           val cell = pop(&pairs);
  355           sethash(obj, us_car(cell), us_cdr(cell));
  356         }
  357       }
  358     } else if (structp(obj)) {
  359       val stype = struct_type(obj);
  360       val iter;
  361 
  362       for (iter = slots(stype); iter; iter = cdr(iter)) {
  363         val sn = car(iter);
  364         val sv = slot(obj, sn);
  365         val rsv = patch_ref(p, sv);
  366         if (rsv)
  367           slotset(obj, sn, rsv);
  368         else
  369           circ_backpatch(p, &cs, sv);
  370       }
  371     }
  372     break;
  373   case FUN:
  374     if (obj->f.functype == FINTERP) {
  375       val fun = obj->f.f.interp_fun;
  376       circ_backpatch(p, &cs, car(fun));
  377       obj = cadr(fun);
  378       goto tail;
  379     }
  380   default:
  381     break;
  382   }
  383   return;
  384 }
  385 
  386 void parser_resolve_circ(parser_t *p)
  387 {
  388   if (p->circ_count == 0)
  389     return;
  390 
  391 
  392   circ_backpatch(p, 0, p->syntax_tree);
  393 
  394   if (p->circ_count > 0)
  395     yyerrorf(p->scanner, lit("not all #<num># refs replaced in object ~s"),
  396              p->syntax_tree, nao);
  397 }
  398 
  399 void parser_circ_def(parser_t *p, val num, val expr)
  400 {
  401   if (!p->circ_ref_hash) {
  402     p->circ_ref_hash = make_hash(nil, nil, nil);
  403     setcheck(p->parser, p->circ_ref_hash);
  404   }
  405 
  406   {
  407     val new_p = nil;
  408     loc pcdr = gethash_l(lit("parser"), p->circ_ref_hash, num, mkcloc(new_p));
  409 
  410     if (!new_p && deref(pcdr) != unique_s)
  411       yyerrorf(p->scanner, lit("duplicate #~s= def"), num, nao);
  412 
  413     set(pcdr, expr);
  414   }
  415 }
  416 
  417 val parser_circ_ref(parser_t *p, val num)
  418 {
  419   val obj = if2(p->circ_ref_hash, gethash(p->circ_ref_hash, num));
  420 
  421   if (!obj)
  422     yyerrorf(p->scanner, lit("dangling #~s# ref"), num, nao);
  423 
  424   if (obj == unique_s && !p->circ_suppress) {
  425     p->circ_count++;
  426     return cons(circref_s, cons(num, nil));
  427   }
  428 
  429   return obj;
  430 }
  431 
  432 void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream)
  433 {
  434   enum { none, tl, tlo, txr } suffix;
  435 
  436   if (match_str(spec_file, lit(".txr"), negone))
  437     suffix = txr;
  438   else if (match_str(spec_file, lit(".tl"), negone))
  439     suffix = tl;
  440   else if (match_str(spec_file, lit(".tlo"), negone))
  441     suffix = tlo;
  442   else if (match_str(spec_file, lit(".txr_profile"), negone))
  443     suffix = tl;
  444   else
  445     suffix = none;
  446 
  447   errno = 0;
  448 
  449   {
  450     val spec_file_try = nil;
  451     FILE *in = 0;
  452 
  453     if (suffix == none && !*txr_lisp_p) {
  454       spec_file_try = scat(lit("."), spec_file, lit("txr"), nao);
  455       in = w_fopen(c_str(spec_file_try), L"r");
  456 #ifdef ENOENT
  457       if (in == 0 && errno != ENOENT)
  458         goto except;
  459 #endif
  460     }
  461 
  462     if (suffix == none) {
  463       if (in == 0) {
  464         spec_file_try = scat(lit("."), spec_file, lit("tlo"), nao);
  465         errno = 0;
  466         in = w_fopen(c_str(spec_file_try), L"r");
  467         *txr_lisp_p = chr('o');
  468 #ifdef ENOENT
  469         if (in == 0 && errno != ENOENT)
  470           goto except;
  471 #endif
  472       }
  473       if (in == 0) {
  474         spec_file_try = scat(lit("."), spec_file, lit("tl"), nao);
  475         errno = 0;
  476         in = w_fopen(c_str(spec_file_try), L"r");
  477         *txr_lisp_p = t;
  478 #ifdef ENOENT
  479         if (in == 0 && errno != ENOENT)
  480           goto except;
  481 #endif
  482       }
  483     }
  484 
  485     if (in == 0) {
  486       spec_file_try = spec_file;
  487       errno = 0;
  488       in = w_fopen(c_str(spec_file_try), L"r");
  489       if (in != 0) {
  490         switch (suffix) {
  491         case tl:
  492           *txr_lisp_p = t;
  493           break;
  494         case tlo:
  495           *txr_lisp_p = chr('o');
  496           break;
  497         case txr:
  498           *txr_lisp_p = nil;
  499           break;
  500         default:
  501           break;
  502         }
  503       }
  504     }
  505 
  506     if (in == 0) {
  507 #ifdef ENOENT
  508 except:
  509 #endif
  510       uw_throwf(errno_to_file_error(errno),
  511                 lit("unable to open ~a"), spec_file_try, nao);
  512     }
  513 
  514     *stream = make_stdio_stream(in, spec_file_try);
  515     *name = spec_file_try;
  516   }
  517 }
  518 
  519 val regex_parse(val string, val error_stream)
  520 {
  521   uses_or2;
  522   val save_stream = std_error;
  523   val stream = make_string_byte_input_stream(string);
  524   parser_t parser;
  525 
  526   error_stream = default_null_arg(error_stream);
  527   std_error = if3(error_stream == t, std_output, or2(error_stream, std_null));
  528 
  529   parser_common_init(&parser);
  530   parser.stream = stream;
  531 
  532   {
  533     int gc = gc_state(0);
  534     parse(&parser, if3(std_error != std_null, lit("regex"), lit("")), prime_regex);
  535     gc_state(gc);
  536   }
  537 
  538   parser_cleanup(&parser);
  539   std_error = save_stream;
  540 
  541   if (parser.errors)
  542     uw_throw(syntax_error_s, lit("regex-parse: syntax errors in regex"));
  543 
  544   return parser.syntax_tree;
  545 }
  546 
  547 static val lisp_parse_impl(val self, val interactive, val rlcp_p, val source_in,
  548                            val error_stream, val error_return_val, val name_in,
  549                            val lineno)
  550 {
  551   uses_or2;
  552   val source = default_null_arg(source_in);
  553   val input_stream = if3(stringp(source),
  554                          make_string_byte_input_stream(source),
  555                          or2(source, std_input));
  556   val name = or2(default_null_arg(name_in),
  557                  if3(stringp(source),
  558                      lit("string"),
  559                      stream_get_prop(input_stream, name_k)));
  560   val parser = ensure_parser(input_stream);
  561   val saved_dyn = dyn_env;
  562   parser_t *pi = parser_get_impl(self, parser);
  563   volatile val parsed = nil;
  564 
  565   if (rlcp_p)
  566     pi->rec_source_loc = 1;
  567 
  568   uw_simple_catch_begin;
  569 
  570   dyn_env = make_env(nil, nil, dyn_env);
  571 
  572   error_stream = default_null_arg(error_stream);
  573   error_stream = if3(error_stream == t, std_output, or2(error_stream, std_null));
  574   class_check (self, error_stream, stream_s);
  575 
  576   if (lineno && !missingp(lineno))
  577     pi->lineno = c_num(lineno);
  578 
  579   env_vbind(dyn_env, stderr_s, error_stream);
  580 
  581   for (;;) {
  582     int gc = gc_state(0);
  583     enum prime_parser prime = if3(interactive, prime_interactive, prime_lisp);
  584     parse(pi, if3(std_error != std_null, name, lit("")), prime);
  585     gc_state(gc);
  586 
  587     if (pi->syntax_tree == nao && pi->errors == 0 && !parser_eof(parser))
  588       continue;
  589 
  590     break;
  591   }
  592 
  593   parsed = t;
  594 
  595   uw_unwind {
  596     dyn_env = saved_dyn;
  597     if (!parsed) {
  598       parser_reset(pi);
  599     }
  600   }
  601 
  602   uw_catch_end;
  603 
  604   if (pi->errors || pi->syntax_tree == nao) {
  605     if (missingp(error_return_val))
  606       uw_throwf(syntax_error_s, lit("read: ~a: ~a"), name,
  607                 if3(pi->syntax_tree == nao,
  608                     lit("end of input reached without seeing object"),
  609                     lit("errors encountered")), nao);
  610     return error_return_val;
  611   }
  612 
  613   return pi->syntax_tree;
  614 }
  615 
  616 val lisp_parse(val source_in, val error_stream, val error_return_val,
  617                val name_in, val lineno)
  618 {
  619   val self = lit("lisp-parse");
  620   return lisp_parse_impl(self, nil, t, source_in, error_stream,
  621                          error_return_val, name_in, lineno);
  622 }
  623 
  624 val nread(val source_in, val error_stream, val error_return_val,
  625           val name_in, val lineno)
  626 {
  627   val self = lit("nread");
  628   return lisp_parse_impl(self, nil, nil, source_in, error_stream,
  629                          error_return_val, name_in, lineno);
  630 }
  631 
  632 val iread(val source_in, val error_stream, val error_return_val,
  633           val name_in, val lineno)
  634 {
  635   val self = lit("iread");
  636   return lisp_parse_impl(self, t, nil, source_in, error_stream,
  637                          error_return_val, name_in, lineno);
  638 }
  639 
  640 static val read_file_common(val self, val stream, val error_stream, val compiled)
  641 {
  642   val error_val = gensym(nil);
  643   val name = stream_get_prop(stream, name_k);
  644   val first = t;
  645   val big_endian = nil;
  646   val parser = ensure_parser(stream);
  647 
  648   if (compiled) {
  649     parser_t *pi = parser_get_impl(self, parser);
  650     pi->rec_source_loc = 0;
  651   }
  652 
  653   for (;;) {
  654     val form = lisp_parse(stream, error_stream, error_val, name, colon_k);
  655 
  656     if (form == error_val) {
  657       if (parser_errors(parser) != zero)
  658         return nil;
  659       if (parser_eof(parser))
  660         break;
  661       continue;
  662     }
  663 
  664     if (compiled && first) {
  665       val major = car(form);
  666       if (lt(major, one) || gt(major, num_fast(5)))
  667         uw_throwf(error_s,
  668                   lit("cannot load ~s: version number mismatch"),
  669                   stream, nao);
  670       big_endian = caddr(form);
  671       first = nil;
  672     } else if (compiled) {
  673       for (; form; form = cdr(form)) {
  674         val item = car(form);
  675         val nlevels = pop(&item);
  676         val nregs = pop(&item);
  677         val bytecode = pop(&item);
  678         val datavec = pop(&item);
  679         val funvec = car(item);
  680         val desc = vm_make_desc(nlevels, nregs, bytecode, datavec, funvec);
  681         if ((big_endian && itypes_little_endian) ||
  682             (!big_endian && !itypes_little_endian))
  683           buf_swap32(bytecode);
  684         (void) vm_execute_toplevel(desc);
  685         gc_hint(desc);
  686       }
  687     } else {
  688       (void) eval_intrinsic(form, nil);
  689     }
  690 
  691     if (parser_eof(parser))
  692       break;
  693   }
  694 
  695   return t;
  696 }
  697 
  698 val read_eval_stream(val self, val stream, val error_stream)
  699 {
  700   return read_file_common(self, stream, error_stream, nil);
  701 }
  702 
  703 val read_compiled_file(val self, val stream, val error_stream)
  704 {
  705   return read_file_common(self, stream, error_stream, t);
  706 }
  707 
  708 #if HAVE_TERMIOS
  709 
  710 static void load_rcfile(val name)
  711 {
  712   val resolved_name;
  713   val lisp_p = t;
  714   val stream = nil;
  715   val catch_syms = cons(error_s, nil);
  716   val path_private_to_me_p =  intern(lit("path-private-to-me-p"), user_package);
  717 
  718   uw_catch_begin (catch_syms, sy, va);
  719 
  720   open_txr_file(name, &lisp_p, &resolved_name, &stream);
  721 
  722   if (stream) {
  723     if (!funcall1(path_private_to_me_p, statf(stream))) {
  724       format(std_output,
  725              lit("** possible security problem: ~a is writable to others\n"),
  726              name, nao);
  727     } else {
  728       val saved_dyn_env = set_dyn_env(make_env(nil, nil, dyn_env));
  729       env_vbind(dyn_env, load_path_s, resolved_name);
  730       read_eval_stream(lit("listener"), stream, std_output);
  731       dyn_env = saved_dyn_env;
  732     }
  733   }
  734 
  735   uw_catch(sy, va)
  736   {
  737     (void) va;
  738     if (stream || sy != path_not_found_s) {
  739       format(std_output, lit("** type ~s exception while loading ~a\n"),
  740              sy, name, nao);
  741       format(std_output, lit("** details: ~a\n"), car(va), nao);
  742     }
  743   }
  744 
  745   uw_unwind {
  746     if (stream)
  747       close_stream(stream, nil);
  748   }
  749 
  750   uw_catch_end;
  751 }
  752 
  753 static val get_visible_syms(val package, int include_fallback)
  754 {
  755   val fblist;
  756 
  757   if (!include_fallback || nilp((fblist = package_fallback_list(package)))) {
  758     return package_symbols(package);
  759   } else {
  760     val symhash = copy_hash(package->pk.symhash);
  761 
  762     for (; fblist; fblist = cdr(fblist))
  763     {
  764       val fb_pkg = car(fblist);
  765       val hiter = hash_begin(fb_pkg->pk.symhash);
  766       val fcell;
  767       val new_p;
  768       while ((fcell = hash_next(hiter))) {
  769         loc pcdr = gethash_l(lit("listener"), symhash, us_car(fcell), mkcloc(new_p));
  770         if (new_p)
  771           set(pcdr, us_cdr(fcell));
  772       }
  773     }
  774     return hash_values(symhash);
  775   }
  776 }
  777 
  778 static void find_matching_syms(lino_completions_t *cpl,
  779                                val package, val prefix,
  780                                val line_prefix, char kind,
  781                                val force_qualify)
  782 {
  783   val is_cur = tnil(package == cur_package);
  784   val qualify = tnil(force_qualify || !is_cur);
  785   val pkg_name = if2(qualify,
  786                      if3(package == keyword_package && !force_qualify,
  787                          lit(""),
  788                          package_name(package)));
  789   val syms = ((kind == 'S' || kind == 'M')
  790               ? hash_keys((get_slot_syms(package, is_cur, tnil(kind == 'M'))))
  791               : get_visible_syms(package, is_cur != nil && !qualify));
  792 
  793   for ( ; syms; syms = cdr(syms)) {
  794     val sym = car(syms);
  795     val name = symbol_name(sym);
  796     val found = if3(cpl->substring,
  797                     search_str(name, prefix, zero, nil),
  798                     match_str(name, prefix, zero));
  799 
  800     if (found) {
  801       val comple;
  802 
  803       switch (kind) {
  804       case '(':
  805         if (!fboundp(sym) && !mboundp(sym) && !special_operator_p(sym))
  806           continue;
  807         break;
  808       case '[':
  809         if (!boundp(sym) && !lookup_fun(nil, sym))
  810           continue;
  811         break;
  812       case 'M':
  813       case 'S':
  814         break;
  815       default:
  816         break;
  817       }
  818 
  819       if (equal(name, prefix))
  820         continue;
  821 
  822       if (qualify)
  823         comple = format(nil, lit("~a~a:~a"), line_prefix, pkg_name, name, nao);
  824       else
  825         comple = format(nil, lit("~a~a"), line_prefix, name, nao);
  826 
  827       lino_add_completion(cpl, c_str(comple));
  828       gc_hint(comple);
  829     }
  830   }
  831 }
  832 
  833 static void provide_completions(const wchar_t *data,
  834                                 lino_completions_t *cpl,
  835                                 void *ctx)
  836 {
  837   const wchar_t *gly = L"!$%&*+-<=>?\\_~/";
  838   const wchar_t *ptr = data[0] ? data + wcslen(data) - 1 : 0;
  839   const wchar_t *sym = 0, *pkg = 0;
  840   const wchar_t *end;
  841   val keyword = nil;
  842   val package = nil;
  843 
  844   (void) ctx;
  845 
  846   if (!ptr)
  847     return;
  848 
  849   while ((iswalnum(convert(wint_t, *ptr)) || wcschr(gly, *ptr)) &&
  850          (sym = ptr) && ptr > data)
  851     ptr--;
  852 
  853   if (!sym)
  854     return;
  855 
  856   end = sym;
  857 
  858   if (*ptr == ':') {
  859     if (ptr == data) {
  860       keyword = t;
  861     } else {
  862       ptr--;
  863 
  864       while ((iswalnum(convert(wint_t, *ptr)) || wcschr(gly, *ptr)) &&
  865              (pkg = ptr) && ptr > data)
  866         ptr--;
  867 
  868       if (!pkg)
  869         keyword = t;
  870     }
  871   }
  872 
  873   if (keyword) {
  874     package = keyword_package;
  875     end = sym - 1;
  876   } else if (pkg) {
  877     size_t sz = sym - pkg;
  878     wchar_t *pkg_copy = convert(wchar_t *, alloca(sizeof *pkg_copy * sz));
  879 
  880     wmemcpy(pkg_copy, pkg, sz);
  881     pkg_copy[sz - 1] = 0;
  882 
  883     {
  884       val package_name = string(pkg_copy);
  885       package = find_package(package_name);
  886       if (!package)
  887         return;
  888     }
  889 
  890     end = pkg;
  891   }
  892 
  893   {
  894     val sym_pfx = string(sym);
  895     size_t lsz = end - data + 1;
  896     wchar_t *line_pfxs = convert(wchar_t *, alloca(sizeof *line_pfxs * lsz));
  897     wmemcpy(line_pfxs, data, lsz);
  898     line_pfxs[lsz - 1] = 0;
  899 
  900     {
  901       uses_or2;
  902       val line_pfx = string(line_pfxs);
  903       char prev = (end > data) ? end[-1] : 0;
  904       char pprev = (end > data + 1) ? end[-2] : 0;
  905       int quote = (pprev == '^' || pprev == '\'' || pprev == '#');
  906       int ppar = (pprev == '(');
  907       int dwim = (prev == '[');
  908       int par = (prev == '(');
  909       int slot = (prev == '.');
  910       int meth = (pprev == '.') && (dwim || par);
  911       char kind = (slot
  912                    ? 'S'
  913                    : (meth
  914                       ? 'M'
  915                       : (!pprev || (!quote && !ppar) || dwim) ? prev : 0));
  916 
  917       find_matching_syms(cpl, or2(package, cur_package),
  918                          sym_pfx, line_pfx, kind, if2(package, null(keyword)));
  919     }
  920   }
  921 }
  922 
  923 static wchar_t *provide_atom(lino_t *l, const wchar_t *str, int n, void *ctx)
  924 {
  925   val obj = nao;
  926   val form;
  927   val line = string(str);
  928   wchar_t *out = 0;
  929 
  930   (void) l;
  931   (void) ctx;
  932 
  933   uw_catch_begin (catch_all, exsym, exvals);
  934 
  935   form = lisp_parse(line, std_null, colon_k, lit("atomcb"), colon_k);
  936 
  937   if (atom(form)) {
  938     if (n == 1)
  939       obj = form;
  940   } else {
  941     val fform = flatcar(form);
  942     obj = ref(fform, num(-n));
  943   }
  944 
  945   if (obj != nao)
  946     out = chk_strdup(c_str(tostring(obj)));
  947 
  948   uw_catch (exsym, exvals) {
  949     (void) exsym;
  950     (void) exvals;
  951   }
  952 
  953   uw_unwind;
  954 
  955   uw_catch_end;
  956 
  957   return out;
  958 }
  959 
  960 static val repl_intr(val signo, val async_p)
  961 {
  962   uw_throw(intr_s, lit("intr"));
  963 }
  964 
  965 static val read_eval_ret_last(val env, val counter,
  966                               val in_stream, val out_stream)
  967 {
  968   val lineno = one;
  969   val error_val = gensym(nil);
  970   val name = format(nil, lit("paste-~a"), counter, nao);
  971   val value = nil;
  972   val loading = cdr(lookup_var(dyn_env, load_recursive_s));
  973   val saved_dyn_env = set_dyn_env(make_env(nil, nil, dyn_env));
  974   env_vbind(dyn_env, load_recursive_s, t);
  975 
  976   for (;; lineno = succ(lineno)) {
  977     val form = lisp_parse(in_stream, out_stream, error_val, name, lineno);
  978     val parser = get_parser(in_stream);
  979 
  980     if (form == error_val) {
  981       if (parser_errors(parser) != zero || parser_eof(parser))
  982         break;
  983       continue;
  984     }
  985 
  986     value = eval_intrinsic(form, nil);
  987 
  988     if (parser_eof(parser))
  989       break;
  990   }
  991 
  992   dyn_env = saved_dyn_env;
  993 
  994   if (!loading)
  995     uw_release_deferred_warnings();
  996 
  997   prinl(value, out_stream);
  998   return t;
  999 }
 1000 
 1001 static val get_home_path(void)
 1002 {
 1003 #ifdef __CYGWIN__
 1004   struct utsname un;
 1005 
 1006   if (uname(&un) >= 0) {
 1007     if (strncmp(un.sysname, "CYGNAL", 6) == 0)
 1008       return getenv_wrap(lit("USERPROFILE"));
 1009   }
 1010 #endif
 1011   return getenv_wrap(lit("HOME"));
 1012 }
 1013 
 1014 static val repl_warning(val out_stream, val exc, struct args *rest)
 1015 {
 1016   val args = args_get_list(rest);
 1017 
 1018   if (cdr(args))
 1019     uw_defer_warning(args);
 1020   else
 1021     format(out_stream, lit("** warning: ~!~a\n"), car(args), nao);
 1022 
 1023   uw_throw(continue_s, nil);
 1024 }
 1025 
 1026 static int is_balanced_line(const wchar_t *line, void *ctx)
 1027 {
 1028   enum state {
 1029     ST_START, ST_CMNT, ST_PAR, ST_BKT, ST_BRC, ST_HASH,
 1030     ST_LIT, ST_QLIT, ST_RGX, ST_RGXC, ST_RGXE, ST_CHR, ST_ESC, ST_AT,
 1031     ST_HASH_B, ST_BUF
 1032   };
 1033   int count[32], sp = 0;
 1034   enum state state[32];
 1035   count[sp] = 0;
 1036   state[sp] = ST_START;
 1037   wchar_t ch;
 1038 
 1039   while ((ch = *line++) != 0) {
 1040   again:
 1041     if (sp >= 30)
 1042       return 1;
 1043 
 1044     count[sp+1] = 0;
 1045     count[sp+2] = 0;
 1046 
 1047     switch (state[sp]) {
 1048     case ST_START:
 1049     case ST_PAR:
 1050     case ST_BKT:
 1051     case ST_BRC:
 1052       switch (ch) {
 1053       case ';':
 1054         state[++sp] = ST_CMNT;
 1055         break;
 1056       case '#':
 1057         state[++sp] = ST_HASH;
 1058         break;
 1059       case '"':
 1060         state[++sp] = ST_LIT;
 1061         break;
 1062       case '`':
 1063         state[++sp] = ST_QLIT;
 1064         break;
 1065       case '(':
 1066         if (state[sp] == ST_PAR)
 1067           count[sp]++;
 1068         else
 1069           state[++sp] = ST_PAR;
 1070         break;
 1071       case '[':
 1072         if (state[sp] == ST_BKT)
 1073           count[sp]++;
 1074         else
 1075           state[++sp] = ST_BKT;
 1076         break;
 1077       case ')': case ']': case '}':
 1078         {
 1079           enum state match = state[sp];
 1080 
 1081           while (sp > 0 && state[sp] != match)
 1082             sp--;
 1083           if (state[sp] != match)
 1084             return 1;
 1085           if (count[sp] == 0)
 1086             sp--;
 1087           else
 1088             count[sp]--;
 1089           break;
 1090         }
 1091       }
 1092       break;
 1093     case ST_CMNT:
 1094       if (ch == '\r')
 1095         sp--;
 1096       break;
 1097     case ST_HASH:
 1098       switch (ch) {
 1099       case '\\':
 1100         state[sp] = ST_CHR;
 1101         break;
 1102       case '/':
 1103         state[sp] = ST_RGX;
 1104         break;
 1105       case 'b':
 1106         state[sp] = ST_HASH_B;
 1107         break;
 1108       case ';':
 1109         --sp;
 1110         break;
 1111       default:
 1112         --sp;
 1113         goto again;
 1114       }
 1115       break;
 1116     case ST_LIT:
 1117       switch (ch) {
 1118       case '"':
 1119         sp--;
 1120         break;
 1121       case '\\':
 1122         state[++sp] = ST_ESC;
 1123         break;
 1124       }
 1125       break;
 1126     case ST_QLIT:
 1127       switch (ch) {
 1128       case '`':
 1129         sp--;
 1130         break;
 1131       case '\\':
 1132         state[++sp] = ST_ESC;
 1133         break;
 1134       case '@':
 1135         state[++sp] = ST_AT;
 1136         break;
 1137       }
 1138       break;
 1139     case ST_RGX:
 1140       switch (ch) {
 1141       case '/':
 1142         sp--;
 1143         break;
 1144       case '[':
 1145         state[++sp] = ST_RGXC;
 1146         break;
 1147       case '(':
 1148         state[++sp] = ST_RGXE;
 1149         break;
 1150       case '\\':
 1151         state[++sp] = ST_ESC;
 1152         break;
 1153       }
 1154       break;
 1155     case ST_RGXC:
 1156       switch (ch) {
 1157       case ']':
 1158         sp--;
 1159         break;
 1160       case '\\':
 1161         state[++sp] = ST_ESC;
 1162         break;
 1163       }
 1164       break;
 1165     case ST_RGXE:
 1166       switch (ch) {
 1167       case ')':
 1168         sp--;
 1169         break;
 1170       case '[':
 1171         state[++sp] = ST_RGXC;
 1172         break;
 1173       case '(':
 1174         state[++sp] = ST_RGXE;
 1175         break;
 1176       case '\\':
 1177         state[++sp] = ST_ESC;
 1178         break;
 1179       }
 1180       break;
 1181     case ST_CHR:
 1182       --sp;
 1183       break;
 1184     case ST_ESC:
 1185       --sp;
 1186       break;
 1187     case ST_AT:
 1188       switch (ch) {
 1189       case '(':
 1190         state[sp] = ST_PAR;
 1191         break;
 1192       case '[':
 1193         state[sp] = ST_BKT;
 1194         break;
 1195       case '{':
 1196         state[sp] = ST_BRC;
 1197         break;
 1198       default:
 1199         sp--;
 1200         break;
 1201       }
 1202       break;
 1203     case ST_HASH_B:
 1204       switch (ch) {
 1205       case '\'':
 1206         state[sp] = ST_BUF;
 1207         break;
 1208       default:
 1209         sp--;
 1210         break;
 1211       }
 1212       break;
 1213     case ST_BUF:
 1214       switch (ch) {
 1215       case '\'':
 1216         sp--;
 1217         break;
 1218       }
 1219       break;
 1220     }
 1221   }
 1222 
 1223   if (state[sp] == ST_CMNT)
 1224     sp--;
 1225 
 1226   return sp == 0 && state[sp] == ST_START && count[sp] == 0;
 1227 }
 1228 
 1229 static_forward(lino_os_t linenoise_txr_binding);
 1230 
 1231 val repl(val bindings, val in_stream, val out_stream, val env)
 1232 {
 1233   lino_t *ls = if3(repl_level++,
 1234                    lino_ctx,
 1235                    lino_ctx = lino_make(coerce(mem_t *, in_stream),
 1236                                         coerce(mem_t *, out_stream)));
 1237   wchar_t *line_w = 0;
 1238   val quit_k = intern(lit("quit"), keyword_package);
 1239   val read_k = intern(lit("read"), keyword_package);
 1240   val prompt_k = intern(lit("prompt"), keyword_package);
 1241   val p_k = intern(lit("p"), keyword_package);
 1242   val counter_sym = intern(lit("*n"), user_package);
 1243   val var_counter_sym = intern(lit("*v"), user_package);
 1244   val result_hash_sym = intern(lit("*r"), user_package);
 1245   val result_hash = make_hash(nil, nil, nil);
 1246   val done = nil;
 1247   val counter = one;
 1248   val home = if3(repl_level == 1, get_home_path(), nil);
 1249   val histfile = if2(home, format(nil, lit("~a/.txr_history"), home, nao));
 1250   const wchar_t *histfile_w = if3(home, c_str(histfile), NULL);
 1251   val rcfile = if2(home, format(nil, lit("~a/.txr_profile"), home, nao));
 1252   val old_sig_handler = set_sig_handler(num(SIGINT), func_n2(repl_intr));
 1253   val hist_len_var = lookup_global_var(listener_hist_len_s);
 1254   val multi_line_var = lookup_global_var(listener_multi_line_p_s);
 1255   val sel_inclusive_var = lookup_global_var(listener_sel_inclusive_p_s);
 1256   val pprint_var = lookup_global_var(listener_pprint_s);
 1257   val greedy_eval = lookup_global_var(listener_greedy_eval_s);
 1258   val rw_f = func_f1v(out_stream, repl_warning);
 1259   val saved_dyn_env = set_dyn_env(make_env(nil, nil, dyn_env));
 1260   val brackets = mkstring(num_fast(repl_level), chr('>'));
 1261 
 1262   env_vbind(dyn_env, stderr_s, out_stream);
 1263 
 1264   for (; bindings; bindings = cdr(bindings)) {
 1265     val binding = car(bindings);
 1266     reg_varl(car(binding), cdr(binding));
 1267   }
 1268 
 1269   reg_varl(result_hash_sym, result_hash);
 1270 
 1271   lino_set_completion_cb(ls, provide_completions, 0);
 1272   lino_set_atom_cb(ls, provide_atom, 0);
 1273   lino_set_enter_cb(ls, is_balanced_line, 0);
 1274   lino_set_tempfile_suffix(ls, ".tl");
 1275 
 1276   if (rcfile)
 1277     load_rcfile(rcfile);
 1278 
 1279   lino_hist_set_max_len(ls, c_num(cdr(hist_len_var)));
 1280 
 1281   if (histfile_w)
 1282     lino_hist_load(ls, histfile_w);
 1283 
 1284   lino_set_noninteractive(ls, opt_noninteractive);
 1285 
 1286   while (!done) {
 1287     val prompt = format(nil, lit("~d~a "), counter, brackets,nao);
 1288     val prev_counter = counter;
 1289     val var_counter = mod(counter, num_fast(100));
 1290     val var_name = format(nil, lit("*~d"), var_counter, nao);
 1291     val var_sym = intern(var_name, user_package);
 1292     uw_frame_t uw_handler;
 1293 
 1294     lino_hist_set_max_len(ls, c_num(cdr(hist_len_var)));
 1295     lino_set_multiline(ls, cdr(multi_line_var) != nil);
 1296     lino_set_selinclusive(ls, cdr(sel_inclusive_var) != nil);
 1297     reg_varl(counter_sym, counter);
 1298     reg_varl(var_counter_sym, var_counter);
 1299     line_w = linenoise(ls, c_str(prompt));
 1300 
 1301     rplacd(multi_line_var, tnil(lino_get_multiline(ls)));
 1302 
 1303     if (line_w == 0) {
 1304       switch (lino_get_error(ls)) {
 1305       case lino_intr:
 1306         put_line(lit("** intr"), out_stream);
 1307         continue;
 1308       case lino_eof:
 1309         break;
 1310       default:
 1311         put_line(lit("** error reading interactive input"), out_stream);
 1312         break;
 1313       }
 1314       break;
 1315     }
 1316 
 1317     {
 1318       size_t wsp = wcsspn(line_w, L" \t\n\r");
 1319 
 1320       if (line_w[wsp] == 0) {
 1321         free(line_w);
 1322         continue;
 1323       }
 1324 
 1325       if (line_w[wsp] == ';') {
 1326         lino_hist_add(ls, line_w);
 1327         free(line_w);
 1328         continue;
 1329       }
 1330     }
 1331 
 1332     counter = succ(counter);
 1333 
 1334     uw_catch_begin (catch_all, exsym, exvals);
 1335 
 1336     uw_push_handler(&uw_handler, cons(warning_s, nil), rw_f);
 1337 
 1338     {
 1339       val name = format(nil, lit("expr-~d"), prev_counter, nao);
 1340       val line = string(line_w);
 1341       val form = lisp_parse(line, out_stream, colon_k, name, colon_k);
 1342       if (form == quit_k) {
 1343         done = t;
 1344       } else if (form == prompt_k) {
 1345         pprinl(prompt, out_stream);
 1346         counter = prev_counter;
 1347       } else if (form == p_k) {
 1348         pprinl(prev_counter, out_stream);
 1349         counter = prev_counter;
 1350       } else {
 1351         val value = if3(form != read_k,
 1352                         eval_intrinsic(form, env),
 1353                         read_eval_ret_last(nil, prev_counter,
 1354                                            in_stream, out_stream));
 1355         val pprin = cdr(pprint_var);
 1356         val (*pfun)(val, val) = if3(pprin, pprinl, prinl);
 1357         val (*tsfun)(val) = if3(pprin, tostringp, tostring);
 1358         reg_varl(var_sym, value);
 1359         sethash(result_hash, var_counter, value);
 1360         pfun(value, out_stream);
 1361         lino_set_result(ls, chk_strdup(c_str(tsfun(value))));
 1362         lino_hist_add(ls, line_w);
 1363         if (cdr(greedy_eval)) {
 1364           val error_p = nil;
 1365           while (bindable(value) || consp(value))
 1366           {
 1367             value = eval_intrinsic_noerr(value, nil, &error_p);
 1368             /* env deliberately not passed to eval here */
 1369             if (error_p)
 1370               break;
 1371             pfun(value, out_stream);
 1372           }
 1373         }
 1374       }
 1375     }
 1376 
 1377     uw_pop_frame(&uw_handler);
 1378 
 1379     uw_catch (exsym, exvals) {
 1380       val exinfo = cons(exsym, exvals);
 1381       reg_varl(var_sym, exinfo);
 1382       sethash(result_hash, var_counter, exinfo);
 1383       lino_hist_add(ls, line_w);
 1384 
 1385       if (uw_exception_subtype_p(exsym, syntax_error_s)) {
 1386         put_line(lit("** syntax error"), out_stream);
 1387       } else if (uw_exception_subtype_p(exsym, error_s)) {
 1388         error_trace(exsym, exvals, out_stream, lit("**"));
 1389       } else {
 1390         format(out_stream, lit("** ~!~s exception, args: ~!~s\n"),
 1391                exsym, exvals, nao);
 1392       }
 1393     }
 1394 
 1395     uw_unwind {
 1396       free(line_w);
 1397       line_w = 0;
 1398     }
 1399 
 1400     uw_catch_end;
 1401 
 1402     gc_hint(prompt);
 1403   }
 1404 
 1405   set_sig_handler(num(SIGINT), old_sig_handler);
 1406 
 1407   dyn_env = saved_dyn_env;
 1408 
 1409   if (histfile_w) {
 1410     val histfile_tmp = format(nil, lit("~a/.txr_history.tmp"), home, nao);
 1411     if (lino_hist_save(ls, c_str(histfile_tmp)) == 0)
 1412       rename_path(histfile_tmp, histfile);
 1413     else
 1414       put_line(lit("** unable to save history file"), out_stream);
 1415     gc_hint(histfile_tmp);
 1416   }
 1417 
 1418   free(line_w);
 1419   if (--repl_level == 0) {
 1420     lino_free(lino_ctx);
 1421     lino_ctx = 0;
 1422   }
 1423   gc_hint(histfile);
 1424   return nil;
 1425 }
 1426 
 1427 #endif
 1428 
 1429 val get_parser(val stream)
 1430 {
 1431   return gethash(stream_parser_hash, stream);
 1432 }
 1433 
 1434 val parser_errors(val parser)
 1435 {
 1436   val self = lit("parser-errors");
 1437   parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_s));
 1438   return num(p->errors);
 1439 }
 1440 
 1441 val parser_eof(val parser)
 1442 {
 1443   val self = lit("parser-eof");
 1444   parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_s));
 1445   return tnil(p->eof);
 1446 }
 1447 
 1448 static val circref(val n)
 1449 {
 1450   uw_throwf(error_s, lit("unresolved #~s# reference in object syntax"),
 1451             n, nao);
 1452 }
 1453 
 1454 static int lino_fileno(mem_t *stream_in)
 1455 {
 1456   val stream = coerce(val, stream_in);
 1457   return c_num(stream_fd(stream));
 1458 }
 1459 
 1460 static int lino_puts(mem_t *stream_in, const wchar_t *str_in)
 1461 {
 1462   val stream = coerce(val, stream_in);
 1463   wchar_t ch;
 1464   while ((ch = *str_in++))
 1465     if (ch != LINO_PAD_CHAR)
 1466       if (put_char(chr(ch), stream) != t)
 1467         return 0;
 1468   flush_stream(stream);
 1469   return 1;
 1470 }
 1471 
 1472 static wint_t lino_getch(mem_t *stream_in)
 1473 {
 1474   wint_t ret = WEOF;
 1475 
 1476   val stream, ch;
 1477 
 1478   uw_catch_begin (catch_all, sy, va);
 1479 
 1480   stream = coerce(val, stream_in);
 1481   ch = get_char(stream);
 1482 
 1483   ret = if3(ch, c_num(ch), WEOF);
 1484 
 1485   uw_catch (sy, va) {
 1486     (void) sy;
 1487     (void) va;
 1488   }
 1489 
 1490   uw_unwind { }
 1491 
 1492   uw_catch_end;
 1493 
 1494   return ret;
 1495 }
 1496 
 1497 static wchar_t *lino_getl(mem_t *stream_in, wchar_t *buf, size_t nchar)
 1498 {
 1499   wchar_t *ptr = buf;
 1500   val stream = coerce(val, stream_in);
 1501 
 1502   if (nchar == 0)
 1503     return buf;
 1504 
 1505   while (nchar-- > 1) {
 1506     val ch = get_char(stream);
 1507     if (!ch)
 1508       break;
 1509     if ((*ptr++ = c_num(ch)) == '\n')
 1510       break;
 1511   }
 1512 
 1513   *ptr++ = 0;
 1514   return (ptr == buf + 1) ? 0 : buf;
 1515 }
 1516 
 1517 static wchar_t *lino_gets(mem_t *stream_in, wchar_t *buf, size_t nchar)
 1518 {
 1519   wchar_t *ptr = buf;
 1520   val stream = coerce(val, stream_in);
 1521 
 1522   if (nchar == 0)
 1523     return buf;
 1524 
 1525   while (nchar-- > 1) {
 1526     val ch = get_char(stream);
 1527     if (!ch)
 1528       break;
 1529     *ptr++ = c_num(ch);
 1530   }
 1531 
 1532   *ptr++ = 0;
 1533   return (ptr == buf + 1) ? 0 : buf;
 1534 }
 1535 
 1536 
 1537 static int lino_feof(mem_t *stream_in)
 1538 {
 1539   val stream = coerce(val, stream_in);
 1540   return get_error(stream) == t;
 1541 }
 1542 
 1543 static const wchli_t *lino_mode_str[] = {
 1544   wli("r"), wli("w")
 1545 };
 1546 
 1547 static mem_t *lino_open(const wchar_t *name_in, lino_file_mode_t mode_in)
 1548 {
 1549   val name = string(name_in);
 1550   val mode = static_str(lino_mode_str[mode_in]);
 1551   val ret = 0;
 1552   ignerr_begin;
 1553   ret = open_file(name, mode);
 1554 #if HAVE_CHMOD
 1555   if (mode_in == lino_overwrite)
 1556     (void) fchmod(c_num(stream_fd(ret)), S_IRUSR | S_IWUSR);
 1557 #endif
 1558   ignerr_end;
 1559   return coerce(mem_t *, ret);
 1560 }
 1561 
 1562 static mem_t *lino_open8(const char *name_in, lino_file_mode_t mode_in)
 1563 {
 1564   val name = string_utf8(name_in);
 1565   val mode = static_str(lino_mode_str[mode_in]);
 1566   mem_t *ret = 0;
 1567   ignerr_begin;
 1568   ret = coerce(mem_t *, open_file(name, mode));
 1569   ignerr_end;
 1570   return ret;
 1571 }
 1572 
 1573 static mem_t *lino_fdopen(int fd, lino_file_mode_t mode_in)
 1574 {
 1575   val mode = static_str(lino_mode_str[mode_in]);
 1576   return coerce(mem_t *, open_fileno(num(fd), mode));
 1577 }
 1578 
 1579 static void lino_close(mem_t *stream)
 1580 {
 1581   (void) close_stream(coerce(val, stream), nil);
 1582 }
 1583 
 1584 static_def(lino_os_t linenoise_txr_binding =
 1585            lino_os_init(chk_malloc, chk_realloc, chk_wmalloc,
 1586                         chk_wrealloc, chk_strdup, free,
 1587                         lino_fileno, lino_puts, lino_getch,
 1588                         lino_getl, lino_gets, lino_feof,
 1589                         lino_open, lino_open8, lino_fdopen, lino_close,
 1590                         wide_display_char_p));
 1591 
 1592 void parse_init(void)
 1593 {
 1594   parser_s = intern(lit("parser"), user_package);
 1595   circref_s = intern(lit("circref"), system_package);
 1596   intr_s = intern(lit("intr"), user_package);
 1597   listener_hist_len_s = intern(lit("*listener-hist-len*"), user_package);
 1598   listener_multi_line_p_s = intern(lit("*listener-multi-line-p*"), user_package);
 1599   listener_sel_inclusive_p_s = intern(lit("*listener-sel-inclusive-p*"), user_package);
 1600   listener_pprint_s = intern(lit("*listener-pprint-p*"), user_package);
 1601   listener_greedy_eval_s = intern(lit("*listener-greedy-eval-p*"), user_package);
 1602   rec_source_loc_s = intern(lit("*rec-source-loc*"), user_package);
 1603   unique_s = gensym(nil);
 1604   protect(&stream_parser_hash, &unique_s, &catch_all, convert(val *, 0));
 1605   stream_parser_hash = make_hash(t, nil, nil);
 1606   catch_all = cons(t, nil);
 1607   parser_l_init();
 1608   lino_init(&linenoise_txr_binding);
 1609   reg_var(listener_hist_len_s, num_fast(500));
 1610   reg_var(listener_multi_line_p_s, t);
 1611   reg_var(listener_sel_inclusive_p_s, nil);
 1612   reg_var(listener_pprint_s, nil);
 1613   reg_var(listener_greedy_eval_s, nil);
 1614   reg_var(rec_source_loc_s, nil);
 1615   reg_fun(circref_s, func_n1(circref));
 1616   reg_fun(intern(lit("get-parser"), system_package), func_n1(get_parser));
 1617   reg_fun(intern(lit("parser-errors"), system_package), func_n1(parser_errors));
 1618   reg_fun(intern(lit("parser-eof"), system_package), func_n1(parser_eof));
 1619   reg_fun(intern(lit("repl"), system_package), func_n4(repl));
 1620 }