home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / error.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  14.7 KB  |  749 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.  
  24.     error.c
  25.  
  26.     Errors
  27. */
  28.  
  29. #include "include.h"
  30. #include <varargs.h>
  31. object siSuniversal_error_handler;
  32.  
  33. static object null_string;
  34.  
  35. object siSterminal_interrupt;
  36.  
  37. terminal_interrupt(correctable)
  38. {
  39.     ifuncall1(siSterminal_interrupt, correctable?Ct:Cnil);
  40. }
  41.  
  42. object
  43. ihs_function_name(x)
  44. object x;
  45. {
  46.     object y;
  47.  
  48.     switch (type_of(x)) {
  49.     case t_symbol:
  50.         return(x);
  51.  
  52.     case t_cons:
  53.         y = x->c.c_car;
  54.         if (y == Slambda)
  55.             return(Slambda);
  56.         if (y == Slambda_closure)
  57.             return(Slambda_closure);
  58.         if (y == Slambda_block || y == siSlambda_block_expanded) {
  59.             x = x->c.c_cdr;
  60.             if (type_of(x) != t_cons)
  61.                 return(Slambda_block);
  62.             return(x->c.c_car);
  63.         }
  64.         if (y == Slambda_block_closure) {
  65.             x = x->c.c_cdr;
  66.             if (type_of(x) != t_cons)
  67.                 return(Slambda_block_closure);
  68.             x = x->c.c_cdr;
  69.             if (type_of(x) != t_cons)
  70.                 return(Slambda_block_closure);
  71.             x = x->c.c_cdr;
  72.             if (type_of(x) != t_cons)
  73.                 return(Slambda_block_closure);
  74.             x = x->c.c_cdr;
  75.             if (type_of(x) != t_cons)
  76.                 return(Slambda_block_closure);
  77.             return(x->c.c_car);
  78.         }
  79.         /* a general special form */
  80.         if (y->s.s_sfdef != NOT_SPECIAL)
  81.           return y;
  82.         return(Cnil);
  83.  
  84.     case t_cfun:
  85.         case t_sfun:
  86.         case t_vfun:
  87.         case t_cclosure:
  88.         case t_gfun:
  89.  
  90.         return(x->cf.cf_name);
  91.  
  92.     default:
  93.         return(Cnil);
  94.     }
  95. }
  96.  
  97. object
  98. ihs_top_function_name()
  99. {
  100.     object x;
  101.     ihs_ptr h = ihs_top;
  102.  
  103.     while (h >= ihs_org) {
  104.         x = ihs_function_name(h->ihs_function);
  105.         if (x != Cnil)
  106.             return(x);
  107.         h--;
  108.     }
  109.     return(Cnil);
  110. }
  111.  
  112.  
  113. call_error_handler()
  114. {
  115.     super_funcall(siSuniversal_error_handler);
  116. }
  117.  
  118.  
  119. FEerror(s, num, arg1, arg2, arg3, arg4)
  120. char *s;
  121. int num;
  122. object arg1, arg2, arg3, arg4;
  123. {
  124.     vs_base = vs_top;
  125.  
  126.     vs_push(Kerror);            /*  :ERROR  */
  127.     vs_push(Cnil);                /*  not correctable  */
  128.     vs_push(ihs_top_function_name());    /*  function  */
  129.     vs_push(null_string);            /*  continue-format-string  */
  130.     vs_push(Cnil);
  131.     if(num >= 1) vs_push(arg1);        /*  arguments  */
  132.     if(num >= 2) vs_push(arg2);
  133.     if(num >= 3) vs_push(arg3);
  134.     if(num >= 4) vs_push(arg4);
  135.     vs_base[4] = make_simple_string(s);    /*  error-format-string  */
  136.     call_error_handler();
  137. }
  138.  
  139. FEwrong_type_argument(type, value)
  140. object type, value;
  141. {
  142.     vs_base = vs_top;
  143.     vs_push(Kwrong_type_argument);
  144.     vs_push(Cnil);
  145.     vs_push(ihs_top_function_name());
  146.     vs_push(null_string);
  147.     vs_push(Cnil);
  148.     vs_push(value);
  149.     vs_push(type);
  150.     vs_base[4] = make_simple_string("~S is not of type ~S.");
  151.     call_error_handler();
  152. }
  153.  
  154. FEtoo_few_arguments(base, top)
  155. object *base, *top;
  156. {
  157.     vs_base = vs_top;
  158.     vs_push(Ktoo_few_arguments);
  159.     vs_push(Cnil);
  160.     vs_push(ihs_top_function_name());
  161.     vs_push(null_string);
  162.     vs_push(make_simple_string("~S [or a callee] requires more than ~R argument~:p."));
  163.     vs_push(ihs_top_function_name());
  164.     vs_push(make_fixnum(top - base));
  165.     call_error_handler();
  166. }
  167.  
  168. FEtoo_few_argumentsF(args)
  169. object args;
  170. {
  171.     vs_base = vs_top;
  172.     vs_push(Ktoo_few_arguments);
  173.     vs_push(Cnil);
  174.     vs_push(ihs_top_function_name());
  175.     vs_push(null_string);
  176.     vs_push(Cnil);
  177.     vs_push(ihs_top_function_name());
  178.     vs_push(args);
  179.     vs_base[4] = make_simple_string("Too few arguments.");
  180.     call_error_handler();
  181. }
  182.  
  183. FEtoo_many_arguments(base, top)
  184. object *base, *top;
  185. {
  186.     vs_base = vs_top;
  187.     vs_push(Ktoo_many_arguments);
  188.     vs_push(Cnil);
  189.     vs_push(ihs_top_function_name());
  190.     vs_push(null_string);
  191.     vs_push(make_simple_string("~S [or a callee] requires less than ~R argument~:p."));
  192.     vs_push(ihs_top_function_name());
  193.     vs_push(make_fixnum(top - base));
  194.     call_error_handler();
  195. }
  196.  
  197. FEtoo_many_argumentsF(args)
  198. object args;
  199. {
  200.     vs_base = vs_top;
  201.     vs_push(Ktoo_many_arguments);
  202.     vs_push(Cnil);
  203.     vs_push(ihs_top_function_name());
  204.     vs_push(null_string);
  205.     vs_push(Cnil);
  206.     vs_push(ihs_top_function_name());
  207.     vs_push(args);
  208.     vs_base[4] = make_simple_string("Too many arguments.");
  209.     call_error_handler();
  210. }
  211.  
  212. FEinvalid_macro_call()
  213. {
  214.     vs_base = vs_top;
  215.     vs_push(Kinvalid_form);
  216.     vs_push(Cnil);
  217.     vs_push(ihs_top_function_name());
  218.     vs_push(null_string);
  219.     vs_push(make_simple_string("Invalid macro call to ~S."));
  220.     vs_push(ihs_top_function_name());
  221.     call_error_handler();
  222. }
  223.  
  224. FEunexpected_keyword(key)
  225. object key;
  226. {
  227.     if (!keywordp(key))
  228.         not_a_keyword(key);
  229.     vs_base = vs_top;
  230.     vs_push(Kunexpected_keyword);
  231.     vs_push(Cnil);
  232.     vs_push(ihs_top_function_name());
  233.     vs_push(null_string);
  234.     vs_push(Cnil);
  235.     vs_push(ihs_top_function_name());
  236.     vs_push(key);
  237.     vs_base[4]
  238.     = make_simple_string("~S does not allow the keyword ~S.");
  239.     call_error_handler();
  240. }
  241.  
  242. FEinvalid_form(s, form)
  243. char *s;
  244. object form;
  245. {
  246.     vs_base = vs_top;
  247.     vs_push(Kinvalid_form);
  248.     vs_push(Cnil);
  249.     vs_push(ihs_top_function_name());
  250.     vs_push(null_string);
  251.     vs_push(Cnil);
  252.     vs_push(form);
  253.     vs_base[4] = make_simple_string(s);
  254.     call_error_handler();
  255. }
  256.  
  257. FEunbound_variable(sym)
  258. object sym;
  259. {
  260.     vs_base = vs_top;
  261.     vs_push(Kunbound_variable);
  262.     vs_push(Cnil);
  263.     vs_push(ihs_top_function_name());
  264.     vs_push(null_string);
  265.     vs_push(Cnil);
  266.     vs_push(sym);
  267.     vs_base[4] = make_simple_string("The variable ~S is unbound.");
  268.     call_error_handler();
  269. }
  270.  
  271. FEinvalid_variable(s, obj)
  272. char *s;
  273. object obj;
  274. {
  275.     vs_base = vs_top;
  276.     vs_push(Kinvalid_variable);
  277.     vs_push(Cnil);
  278.     vs_push(ihs_top_function_name());
  279.     vs_push(null_string);
  280.     vs_push(Cnil);
  281.     vs_push(obj);
  282.     vs_base[4] = make_simple_string(s);
  283.     call_error_handler();
  284. }
  285.  
  286. FEundefined_function(fname)
  287. object fname;
  288. {
  289.     vs_base = vs_top;
  290.     vs_push(Kundefined_function);
  291.     vs_push(Cnil);
  292.     vs_push(ihs_top_function_name());
  293.     vs_push(null_string);
  294.     vs_push(Cnil);
  295.     vs_push(fname);
  296.     vs_base[4] = make_simple_string("The function ~S is undefined.");
  297.     call_error_handler();
  298. }
  299.  
  300. FEinvalid_function(obj)
  301. object obj;
  302. {
  303.     vs_base = vs_top;
  304.     vs_push(Kinvalid_function);
  305.     vs_push(Cnil);
  306.     vs_push(ihs_top_function_name());
  307.     vs_push(null_string);
  308.     vs_push(Cnil);
  309.     vs_push(obj);
  310.     vs_base[4] = make_simple_string("~S is invalid as a function.");
  311.     call_error_handler();
  312. }
  313.  
  314.  
  315. CEerror(err_str, cont_str, num, arg1, arg2, arg3, arg4)
  316. char *err_str, *cont_str;
  317. int num;
  318. object arg1, arg2, arg3, arg4;
  319. {
  320.     object *old_base = vs_base;
  321.     object *old_top = vs_top;
  322.  
  323.     vs_base = vs_top;
  324.  
  325.     vs_push(Kerror);            /*  :ERROR  */
  326.     vs_push(Ct);                /*  correctable  */
  327.     vs_push(ihs_top_function_name());    /*  function  */
  328.     vs_push(make_simple_string(cont_str));
  329.                         /*  continue-format-string  */
  330.     vs_push(Cnil);
  331.     if(num >= 1) vs_push(arg1);        /*  arguments  */
  332.     if(num >= 2) vs_push(arg2);
  333.     if(num >= 3) vs_push(arg3);
  334.     if(num >= 4) vs_push(arg4);
  335.     vs_base[4] = make_simple_string(err_str);
  336.                         /*  error-format-string  */
  337.     call_error_handler();
  338.  
  339.     vs_top = old_top;
  340.     vs_base = old_base;
  341. }
  342.  
  343. /*
  344.     Lisp interface to IHS
  345. */
  346.  
  347. ihs_ptr get_ihs_ptr(x)
  348. object x;
  349. {
  350.     ihs_ptr p;
  351.  
  352.     if (type_of(x) != t_fixnum)
  353.         goto ILLEGAL;
  354.     p = ihs_org + fix(x);
  355.     if (ihs_org <= p && p <= ihs_top)
  356.         return(p);
  357. ILLEGAL:
  358.     FEerror("~S is an illegal ihs index.", 1, x);
  359. }
  360.  
  361. siLihs_top()
  362. {
  363.     check_arg(0);
  364.     vs_push(make_fixnum(ihs_top - ihs_org));
  365. }
  366.  
  367. siLihs_fun()
  368. {
  369.     check_arg(1);
  370.     vs_base[0] = get_ihs_ptr(vs_base[0])->ihs_function;
  371. }
  372.  
  373. siLihs_vs()
  374. {
  375.     check_arg(1);
  376.     vs_base[0] = make_fixnum(get_ihs_ptr(vs_base[0])->ihs_base - vs_org);
  377. }
  378.  
  379. frame_ptr get_frame_ptr(x)
  380. object(x);
  381. {
  382.     frame_ptr p;
  383.  
  384.     if (type_of(x) != t_fixnum)
  385.         goto ILLEGAL;
  386.     p = frs_org + fix(x);
  387.     if (frs_org <= p && p <= frs_top)
  388.         return(p);
  389. ILLEGAL:
  390.     FEerror("~S is an illegal frs index.", 1, x);
  391. }
  392.  
  393. siLfrs_top()
  394. {
  395.     check_arg(0);
  396.     vs_push(make_fixnum(frs_top - frs_org));
  397. }
  398.  
  399. siLfrs_vs()
  400. {
  401.     check_arg(1);
  402.     vs_base[0] = make_fixnum(get_frame_ptr(vs_base[0])->frs_lex - vs_org);
  403. }
  404.  
  405. siLfrs_bds()
  406. {
  407.     check_arg(1);
  408.     vs_base[0]
  409.     = make_fixnum(get_frame_ptr(vs_base[0])->frs_bds_top - bds_org);
  410. }
  411.  
  412. siLfrs_class()
  413. {
  414.     enum fr_class c;
  415.  
  416.     check_arg(1);
  417.  
  418.     c = get_frame_ptr(vs_base[0])->frs_class;
  419.     if (c == FRS_CATCH) vs_base[0] = Kcatch;
  420.     else if (c == FRS_PROTECT) vs_base[0] = Kprotect;
  421.     else if (c == FRS_CATCHALL) vs_base[0] = Kcatchall;
  422.     else FEerror("Unknown frs class was detected.", 0);
  423. }
  424.  
  425. siLfrs_tag()
  426. {
  427.     check_arg(1);
  428.     vs_base[0] = get_frame_ptr(vs_base[0])->frs_val;
  429. }
  430.  
  431. siLfrs_ihs()
  432. {
  433.     check_arg(1);
  434.     vs_base[0]
  435.     = make_fixnum(get_frame_ptr(vs_base[0])->frs_ihs - ihs_org);
  436. }
  437.  
  438. bds_ptr get_bds_ptr(x)
  439. object(x);
  440. {
  441.     bds_ptr p;
  442.  
  443.     if (type_of(x) != t_fixnum)
  444.         goto ILLEGAL;
  445.     p = bds_org + fix(x);
  446.     if (bds_org <= p && p <= bds_top)
  447.         return(p);
  448. ILLEGAL:
  449.     FEerror("~S is an illegal bds index.", 1, x);
  450. }
  451.  
  452. siLbds_top()
  453. {
  454.     check_arg(0);
  455.     vs_push(make_fixnum(bds_top - bds_org));
  456. }
  457.  
  458. siLbds_var()
  459. {
  460.     check_arg(1);
  461.     vs_base[0] = get_bds_ptr(vs_base[0])->bds_sym;
  462. }
  463.  
  464. siLbds_val()
  465. {
  466.     check_arg(1);
  467.     vs_base[0] = get_bds_ptr(vs_base[0])->bds_val;
  468. }
  469.  
  470. object *get_vs_ptr(x)
  471. object(x);
  472. {
  473.     object *p;
  474.  
  475.     if (type_of(x) != t_fixnum)
  476.         goto ILLEGAL;
  477.     p = vs_org + fix(x);
  478.     if (vs_org <= p && p < vs_top)
  479.         return(p);
  480. ILLEGAL:
  481.     FEerror("~S is an illegal vs index.", 1, x);
  482. }
  483.  
  484. siLvs_top()
  485. {
  486.     object x;
  487.     check_arg(0);
  488.     /* shouldn't ref vs_top in a vs_push */
  489.     x = (make_fixnum(vs_top - vs_org));
  490.     vs_push(x);
  491. }
  492.  
  493. siLvs()
  494. {
  495.     check_arg(1);
  496.     vs_base[0] = *get_vs_ptr(vs_base[0]);
  497. }
  498.  
  499. siLsch_frs_base ()
  500. {
  501.     frame_ptr x;
  502.     ihs_ptr y;
  503.  
  504.     check_arg(2);
  505.     y = get_ihs_ptr(vs_base[1]);
  506.     for (x = get_frame_ptr(vs_base[0]);
  507.          x <= frs_top && x->frs_ihs < y; 
  508.          x++);
  509.     if (x > frs_top) vs_base[0] = Cnil;
  510.     else vs_base[0] = make_fixnum(x - frs_org);
  511.     vs_top--;
  512. }
  513.  
  514. siLinternal_super_go()
  515. {
  516.     frame_ptr fr;
  517.  
  518.     check_arg(3);
  519.  
  520.     fr = frs_sch(vs_base[0]);
  521.     if (fr == NULL)
  522.         FEerror("The tag ~S is missing.", 1, vs_base[0]);
  523.     if (vs_base[2] == Cnil)
  524.         vs_base[0] = vs_base[1];
  525.     else
  526.         vs_base[0] = MMcons(vs_base[0], vs_base[1]);
  527.     vs_base++;
  528.     vs_top = vs_base;
  529.     unwind(fr,vs_base[-1]);
  530. }
  531.  
  532. siLuniversal_error_handler()
  533. {
  534.     int i;
  535.  
  536.     for (i = 0;  i < vs_base[4]->st.st_fillp;  i++)
  537.         putchar(vs_base[4]->st.st_self[i]);
  538.     printf("\nLisp initialization failed.\n");
  539.     exit(0);
  540. }
  541.  
  542. check_arg_failed(n)
  543. int n;
  544. {
  545.     object *base = vs_base, *top = vs_top;
  546.  
  547.     vs_base = vs_top;
  548.     if (top - base < n)
  549.         vs_push(Ktoo_few_arguments);
  550.     else
  551.         vs_push(Ktoo_many_arguments);
  552.     vs_push(Cnil);
  553.     vs_push(ihs_top_function_name());
  554.     vs_push(null_string);
  555.     if (top - base < n)
  556.         vs_push(make_simple_string("~S [or a callee] requires ~R argument~:p,~%but only ~R ~:*~[were~;was~:;were~] supplied."));
  557.     else
  558.         vs_push(make_simple_string("~S [or a callee] requires only ~R argument~:p,~%but ~R ~:*~[were~;was~:;were~] supplied."));
  559.     vs_push(ihs_top_function_name());
  560.     vs_push(make_fixnum(n));
  561.     vs_push(make_fixnum(top - base));
  562.     call_error_handler();
  563. }
  564.  
  565. too_few_arguments()
  566. {
  567.     FEtoo_few_arguments(vs_base, vs_top);
  568. }
  569.  
  570. too_many_arguments()
  571. {
  572.     FEtoo_many_arguments(vs_base, vs_top);
  573. }
  574.  
  575. ck_larg_at_least(n, x)
  576. int n; object x;
  577. {
  578.     for(; n > 0; n--, x = x->c.c_cdr)
  579.         if(endp(x))
  580.           FEerror("APPLY sended too few arguments to LAMBDA.", 0);
  581. }
  582.  
  583. ck_larg_exactly(n, x)
  584. int n; object x;
  585. {
  586.     for(; n > 0; n--, x = x->c.c_cdr)
  587.         if(endp(x))
  588.           FEerror("APPLY sended too few arguments to LAMBDA.", 0);
  589.     if(!endp(x)) FEerror("APPLY sended too many arguments to LAMBDA.", 0);
  590. }
  591.  
  592. invalid_macro_call()
  593. {
  594.     FEinvalid_macro_call();
  595. }
  596.  
  597. keyword_value_mismatch()
  598. {
  599.     FEerror("Keywords and values do not match.", 0);
  600. }
  601.  
  602. not_a_keyword(x)
  603. object x;
  604. {
  605.     FEerror("~S is not a keyword.", 1, x);
  606. }
  607.  
  608. unexpected_keyword(key)
  609. object key;
  610. {
  611.     FEunexpected_keyword(key);
  612. }
  613.  
  614. object
  615. wrong_type_argument(typ, obj)
  616. object typ, obj;
  617. {
  618.     FEwrong_type_argument(typ, obj);
  619.     /*  no return  */
  620. }
  621.  
  622. illegal_declare(form)
  623. {
  624.     FEinvalid_form("~S is an illegal declaration form.", form);
  625. }
  626.  
  627. not_a_symbol(obj)
  628. {
  629.     FEinvalid_variable("~S is not a symbol.", obj);
  630. }
  631.  
  632. not_a_variable(obj)
  633. {
  634.     FEinvalid_variable("~S is not a variable.", obj);
  635. }
  636.  
  637. illegal_index(x, i)
  638. object x, i;
  639. {
  640.     FEerror("~S is an illegal index to ~S.", 2, i, x);
  641. }
  642.  
  643.      
  644.  
  645. Lerror()
  646. {
  647.     object *base = vs_base, *top = vs_top;
  648.  
  649.     if (top - base == 0)
  650.         too_few_arguments();
  651.     vs_base = vs_top;
  652.     vs_push(Kerror);
  653.     vs_push(Cnil);
  654.     vs_push( (ihs_top > ihs_org) ?
  655.         ihs_function_name((ihs_top - 1)->ihs_function)
  656.         : Cnil);
  657.     vs_push(null_string);
  658.     while (base < top)
  659.         vs_push(*base++);
  660.     call_error_handler();
  661. }
  662.  
  663. object
  664. LVerror(va_alist)
  665.      va_dcl
  666. {va_list ap;
  667.  va_start(ap);
  668.  fcall.fun= make_cfun(Lerror,Cnil,Cnil,0,0);
  669.  fcalln_general(ap);
  670.  va_end(ap);
  671.  return Cnil;
  672. }
  673.      
  674. Lcerror()
  675. {
  676.     object *base = vs_base, *top = vs_top;
  677.  
  678.     if (top - base < 2)
  679.         too_few_arguments();
  680.     vs_base = vs_top;
  681.     vs_push(Kerror);
  682.     vs_push(Ct);
  683.     vs_push(ihs_function_name((ihs_top - 1)->ihs_function));
  684.     while (base < top)
  685.         vs_push(*base++);
  686.     super_funcall(siSuniversal_error_handler);
  687.     vs_base = vs_top;
  688.     vs_push(Cnil);
  689. }
  690. int
  691. vfun_wrong_number_of_args(x)
  692.      object x;
  693. {FEerror("Expected ~S args but received ~S args",2,
  694.      x,make_fixnum(VFUN_NARGS));
  695. }
  696.  
  697. init_error()
  698. {
  699.     make_function("ERROR", Lerror);
  700.     make_function("CERROR", Lcerror);
  701.  
  702.     Kerror = make_keyword("ERROR");
  703.     Kwrong_type_argument = make_keyword("WRONG-TYPE-ARGUMENT");
  704.     Ktoo_few_arguments = make_keyword("TOO-FEW-ARGUMENTS");
  705.     Ktoo_many_arguments = make_keyword("TOO-MANY-ARGUMENTS");
  706.     Kunexpected_keyword = make_keyword("UNEXPECTED-KEYWORD");
  707.     Kinvalid_form = make_keyword("INVALID-FORM");
  708.     Kunbound_variable = make_keyword("UNBOUND-VARIABLE");
  709.     Kinvalid_variable = make_keyword("INVALID-VARIABLE");
  710.     Kundefined_function = make_keyword("UNDEFINED-FUNCTION");
  711.     Kinvalid_function = make_keyword("INVALID-FUNCTION");
  712.  
  713.     make_si_function("IHS-TOP", siLihs_top);
  714.     make_si_function("IHS-FUN", siLihs_fun);
  715.     make_si_function("IHS-VS", siLihs_vs);
  716.  
  717.     Kcatch = make_keyword("CATCH");
  718.     Kprotect = make_keyword("PROTECT");
  719.     Kcatchall = make_keyword("CATCHALL");
  720.  
  721.     make_si_function("FRS-TOP", siLfrs_top);
  722.     make_si_function("FRS-VS", siLfrs_vs);
  723.     make_si_function("FRS-BDS", siLfrs_bds);
  724.     make_si_function("FRS-CLASS", siLfrs_class);
  725.     make_si_function("FRS-TAG", siLfrs_tag);
  726.     make_si_function("FRS-IHS", siLfrs_ihs);
  727.  
  728.     make_si_function("BDS-TOP", siLbds_top);
  729.     make_si_function("BDS-VAR", siLbds_var);
  730.     make_si_function("BDS-VAL", siLbds_val);
  731.  
  732.     make_si_function("VS-TOP", siLvs_top);
  733.     make_si_function("VS", siLvs);
  734.  
  735.     make_si_function("SCH-FRS-BASE", siLsch_frs_base);
  736.  
  737.     make_si_function("INTERNAL-SUPER-GO", siLinternal_super_go);
  738.  
  739.     siSuniversal_error_handler =
  740.     make_si_function("UNIVERSAL-ERROR-HANDLER",
  741.              siLuniversal_error_handler);
  742.  
  743.     null_string = make_simple_string("");
  744.     enter_mark_origin(&null_string);
  745.  
  746.     siSterminal_interrupt = make_si_ordinary("TERMINAL-INTERRUPT");
  747.     enter_mark_origin(&siSterminal_interrupt);
  748. }
  749.