/[gcl]/gcl/o/read.d
ViewVC logotype

Diff of /gcl/o/read.d

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by camm, Thu Jun 20 03:38:41 2002 UTC revision 1.9 by camm, Sat Jul 20 07:10:56 2002 UTC
# Line 42  object dispatch_reader; Line 42  object dispatch_reader;
42  #define SHARP_EQ_CONTEXT_SIZE   250  #define SHARP_EQ_CONTEXT_SIZE   250
43  #endif  #endif
44    
45    void
46  setup_READtable()  setup_READtable()
47  {  {
48          READtable = current_readtable();          READtable = current_readtable();
# Line 61  struct sharp_eq_context_struct { Line 62  struct sharp_eq_context_struct {
62  */  */
63    
64    
65    void
66  setup_READ()  setup_READ()
67  {  {
68          object x;          object x;
# Line 90  setup_READ() Line 92  setup_READ()
92          backq_level = 0;          backq_level = 0;
93  }  }
94    
95    void
96  setup_standard_READ()  setup_standard_READ()
97  {  {
98          READtable = standard_readtable;          READtable = standard_readtable;
# Line 109  object in; Line 112  object in;
112    
113  #define read_char(in)   code_char(readc_stream(in))  #define read_char(in)   code_char(readc_stream(in))
114    
115    void
116  unread_char(c, in)  unread_char(c, in)
117  object c, in;  object c, in;
118  {  {
# Line 196  L: Line 200  L:
200          READsuppress = old_READsuppress;          READsuppress = old_READsuppress;
201    
202          /* BUG FIX by Toshiba */          /* BUG FIX by Toshiba */
203          vs_pop;          vs_popp;
204    
205          if (e) {          if (e) {
206                  nlj_active = FALSE;                  nlj_active = FALSE;
# Line 264  L: Line 268  L:
268                  nlj_active = FALSE;                  nlj_active = FALSE;
269                  unwind(nlj_fr, nlj_tag);                  unwind(nlj_fr, nlj_tag);
270          }          }
271          vs_pop;          vs_popp;
272          /* BUG FIX by Toshiba */          /* BUG FIX by Toshiba */
273          vs_pop;          vs_popp;
274          return(x);          return(x);
275  }  }
276    
# Line 328  L: Line 332  L:
332                  nlj_active = FALSE;                  nlj_active = FALSE;
333                  unwind(nlj_fr, nlj_tag);                  unwind(nlj_fr, nlj_tag);
334          }          }
335          vs_pop;          vs_popp;
336          /* BUG FIX by Toshiba */          /* BUG FIX by Toshiba */
337          vs_pop;          vs_popp;
338          return(x);          return(x);
339  }  }
340  #ifdef UNIX  /* faster code for inner loop from file stream */  #ifdef UNIX  /* faster code for inner loop from file stream */
# Line 351  L: Line 355  L:
355    
356  #define read_char_to(res,in,eof_code) \  #define read_char_to(res,in,eof_code) \
357    do{FILE *fp; \    do{FILE *fp; \
358        if(fp=in->sm.sm_fp) \        if((fp=in->sm.sm_fp)) \
359          {int ch = getc(fp); \          {int ch = getc(fp); \
360        if (ch==EOF && feof(fp))  \        if (ch==EOF && feof(fp))  \
361           { eof_code;} \           { eof_code;} \
# Line 373  L: Line 377  L:
377     } while(0)     } while(0)
378  #endif  #endif
379    
380    void
381    too_long_token(void);
382  /*  /*
383          Read_object(in) reads an object from stream in.          Read_object(in) reads an object from stream in.
384          This routine corresponds to COMMON Lisp function READ.          This routine corresponds to COMMON Lisp function READ.
# Line 382  read_object(in) Line 388  read_object(in)
388  object in;  object in;
389  {  {
390          object x;          object x;
391          object c;          object c=Cnil;
392          enum chattrib a;          enum chattrib a;
393          object *old_vs_base;          object *old_vs_base;
394          object result;          object result;
395          object p;          object p;
396          int  colon, colon_type;          int  colon=0, colon_type;
397          int i, d;          int i;
398          bool df, ilf;          bool df, ilf;
399          VOL int length;          VOL int length;
400          vs_mark;          vs_mark;
# Line 586  SYMBOL: Line 592  SYMBOL:
592          return(x);          return(x);
593  }  }
594    
595    void
596  Lleft_parenthesis_reader()  Lleft_parenthesis_reader()
597  {  {
598          object in, c, x;          object in, c, x;
# Line 617  Lleft_parenthesis_reader() Line 624  Lleft_parenthesis_reader()
624                  }                  }
625                  vs_push(x);                  vs_push(x);
626                  *p = make_cons(x, Cnil);                  *p = make_cons(x, Cnil);
627                  vs_pop;                  vs_popp;
628                  p = &((*p)->c.c_cdr);                  p = &((*p)->c.c_cdr);
629          }          }
630    
# Line 648  parse_number(s, end, ep, radix) Line 655  parse_number(s, end, ep, radix)
655  char *s;  char *s;
656  int end, *ep, radix;  int end, *ep, radix;
657  {  {
658          object x, r;          object x=Cnil;
659          fixnum sign;          fixnum sign;
660          object integer_part;          object integer_part;
661          double fraction, fraction_unit, f;          double fraction, fraction_unit, f;
# Line 909  parse_integer(s, end, ep, radix) Line 916  parse_integer(s, end, ep, radix)
916  char *s;  char *s;
917  int end, *ep, radix;  int end, *ep, radix;
918  {  {
919          object x, r;          object x;
920          fixnum sign;          fixnum sign;
921          object integer_part;          object integer_part;
922          int i, d;          int i, d;
# Line 958  NO_NUMBER: Line 965  NO_NUMBER:
965  /**/  /**/
966          return(OBJNULL);          return(OBJNULL);
967  }  }
968   /*  
969    
970    void
971    too_long_string(void);
972    
973    /*
974          Read_string(delim, in) reads          Read_string(delim, in) reads
975          a simple string terminated by character code delim          a simple string terminated by character code delim
976          and places it in token.          and places it in token.
977          Delim is not included in the string but discarded.          Delim is not included in the string but discarded.
978  */  */
979    void
980  read_string(delim, in)  read_string(delim, in)
981  int delim;  int delim;
982  object in;  object in;
# Line 990  object in; Line 1003  object in;
1003          a sequence of constituent characters from stream in          a sequence of constituent characters from stream in
1004          and places it in token_buffer.          and places it in token_buffer.
1005  */  */
1006    void
1007  read_constituent(in)  read_constituent(in)
1008  object in;  object in;
1009  {  {
# Line 1011  object in; Line 1025  object in;
1025                    
1026  }  }
1027    
1028    void
1029  Ldouble_quote_reader()  Ldouble_quote_reader()
1030  {  {
1031          check_arg(2);          check_arg(2);
1032          vs_pop;          vs_popp;
1033          read_string('"', vs_base[0]);          read_string('"', vs_base[0]);
1034          vs_base[0] = copy_simple_string(token);          vs_base[0] = copy_simple_string(token);
1035  }  }
1036    
1037    void
1038  Ldispatch_reader()  Ldispatch_reader()
1039  {  {
1040          object c, x;          object c, x;
# Line 1052  Ldispatch_reader() Line 1068  Ldispatch_reader()
1068          super_funcall(x);          super_funcall(x);
1069  }  }
1070    
1071    void
1072  Lsingle_quote_reader()  Lsingle_quote_reader()
1073  {  {
1074          check_arg(2);          check_arg(2);
1075          vs_pop;          vs_popp;
1076          vs_push(sLquote);          vs_push(sLquote);
1077          vs_push(read_object(vs_base[0]));          vs_push(read_object(vs_base[0]));
1078          vs_push(Cnil);          vs_push(Cnil);
# Line 1064  Lsingle_quote_reader() Line 1081  Lsingle_quote_reader()
1081          vs_base[0] = vs_pop;          vs_base[0] = vs_pop;
1082  }  }
1083    
1084    void
1085  Lright_parenthesis_reader()  Lright_parenthesis_reader()
1086  {  {
1087          check_arg(2);          check_arg(2);
1088          vs_pop;          vs_popp;
1089          vs_pop;          vs_popp;
1090                  /*  no result  */                  /*  no result  */
1091  }  }
1092    
# Line 1076  Lright_parenthesis_reader() Line 1094  Lright_parenthesis_reader()
1094  Lcomma_reader(){}  Lcomma_reader(){}
1095  */  */
1096    
1097    void
1098  Lsemicolon_reader()  Lsemicolon_reader()
1099  {  {
1100          object c;          object c;
1101          object str= vs_base[0];          object str= vs_base[0];
1102          check_arg(2);          check_arg(2);
1103          vs_pop;          vs_popp;
1104          do          do
1105          { read_char_to(c,str, goto L); }          { read_char_to(c,str, goto L); }
1106                  while (char_code(c) != '\n');                  while (char_code(c) != '\n');
1107  L:        L:      
1108          vs_pop;          vs_popp;
1109          vs_base[0] = Cnil;          vs_base[0] = Cnil;
1110          /*  no result  */          /*  no result  */
1111  }  }
# Line 1098  Lbackquote_reader(){} Line 1117  Lbackquote_reader(){}
1117  /*  /*
1118          sharpmacro routines          sharpmacro routines
1119  */  */
1120    void
1121    extra_argument(int);
1122    
1123    void
1124  Lsharp_C_reader()  Lsharp_C_reader()
1125  {  {
1126          object x, c;          object x, c;
# Line 1106  Lsharp_C_reader() Line 1128  Lsharp_C_reader()
1128          check_arg(3);          check_arg(3);
1129          if (vs_base[2] != Cnil && !READsuppress)          if (vs_base[2] != Cnil && !READsuppress)
1130                  extra_argument('C');                  extra_argument('C');
1131          vs_pop;          vs_popp;
1132          vs_pop;          vs_popp;
1133          c = read_char(vs_base[0]);          c = read_char(vs_base[0]);
1134          if (char_code(c) != '(')          if (char_code(c) != '(')
1135                  FEerror("A left parenthesis is expected.", 0);                  FEerror("A left parenthesis is expected.", 0);
# Line 1140  Lsharp_C_reader() Line 1162  Lsharp_C_reader()
1162          vs_top = vs_base + 1;          vs_top = vs_base + 1;
1163  }  }
1164    
1165    void
1166  Lsharp_backslash_reader()  Lsharp_backslash_reader()
1167  {  {
1168          object c;          object c;
# Line 1150  Lsharp_backslash_reader() Line 1173  Lsharp_backslash_reader()
1173                      fix(vs_base[2]) != 0)                      fix(vs_base[2]) != 0)
1174                          FEerror("~S is an illegal CHAR-FONT.", 1, vs_base[2]);                          FEerror("~S is an illegal CHAR-FONT.", 1, vs_base[2]);
1175                          /*  assuming that CHAR-FONT-LIMIT is 1  */                          /*  assuming that CHAR-FONT-LIMIT is 1  */
1176          vs_pop;          vs_popp;
1177          vs_pop;          vs_popp;
1178          unread_char(code_char('\\'), vs_base[0]);          unread_char(code_char('\\'), vs_base[0]);
1179          if (READsuppress) {          if (READsuppress) {
1180                  (void)read_object(vs_base[0]);                  (void)read_object(vs_base[0]);
# Line 1194  Lsharp_backslash_reader() Line 1217  Lsharp_backslash_reader()
1217                  FEerror("~S is an illegal character name.", 1, c);                  FEerror("~S is an illegal character name.", 1, c);
1218  }  }
1219    
1220    void
1221  Lsharp_single_quote_reader()  Lsharp_single_quote_reader()
1222  {  {
1223    
1224          check_arg(3);          check_arg(3);
1225          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1226                  extra_argument('#');                  extra_argument('#');
1227          vs_pop;          vs_popp;
1228          vs_pop;          vs_popp;
1229          vs_push(sLfunction);          vs_push(sLfunction);
1230          vs_push(read_object(vs_base[0]));          vs_push(read_object(vs_base[0]));
1231          vs_push(Cnil);          vs_push(Cnil);
# Line 1219  Lsharp_single_quote_reader() Line 1243  Lsharp_single_quote_reader()
1243    
1244  object siScomma;  object siScomma;
1245    
1246    void
1247  Lsharp_left_parenthesis_reader()  Lsharp_left_parenthesis_reader()
1248  {  {
1249          object endp_temp;          object endp_temp;
1250    
1251          int dim;          int dim=0;
1252          int dimcount;          int dimcount;
1253          object in, x;          object in, x;
1254          int a;          int a;
# Line 1234  Lsharp_left_parenthesis_reader() Line 1259  Lsharp_left_parenthesis_reader()
1259                  dim = -1;                  dim = -1;
1260          else if (type_of(vs_base[2]) == t_fixnum)          else if (type_of(vs_base[2]) == t_fixnum)
1261                  dim = fix(vs_base[2]);                  dim = fix(vs_base[2]);
1262          vs_pop;          vs_popp;
1263          vs_pop;          vs_popp;
1264          in = vs_base[0];          in = vs_base[0];
1265          if (backq_level > 0) {          if (backq_level > 0) {
1266                  unreadc_stream('(', in);                  unreadc_stream('(', in);
# Line 1295  L: Line 1320  L:
1320          vs_push(x);          vs_push(x);
1321          x->v.v_self          x->v.v_self
1322          = (object *)alloc_relblock(dimcount * sizeof(object));          = (object *)alloc_relblock(dimcount * sizeof(object));
1323          vs_pop;          vs_popp;
1324          for (dim = 0; dim < dimcount; dim++)          for (dim = 0; dim < dimcount; dim++)
1325                  x->v.v_self[dim] = vsp[dim];                  x->v.v_self[dim] = vsp[dim];
1326          vs_top = vs_base;          vs_top = vs_base;
# Line 1303  L: Line 1328  L:
1328          vs_push(x);          vs_push(x);
1329  }  }
1330    
1331    void
1332  Lsharp_asterisk_reader()  Lsharp_asterisk_reader()
1333  {  {
1334          int dim;          int dim=0;
1335          int dimcount;          int dimcount;
1336          object in, x;          object in, x;
1337          object *vsp;                      object *vsp;            
# Line 1313  Lsharp_asterisk_reader() Line 1339  Lsharp_asterisk_reader()
1339          check_arg(3);          check_arg(3);
1340          if (READsuppress) {          if (READsuppress) {
1341                  read_constituent(vs_base[0]);                  read_constituent(vs_base[0]);
1342                  vs_pop;                  vs_popp;
1343                  vs_pop;                  vs_popp;
1344                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
1345                  return;                  return;
1346          }          }
# Line 1322  Lsharp_asterisk_reader() Line 1348  Lsharp_asterisk_reader()
1348                  dim = -1;                  dim = -1;
1349          else if (type_of(vs_head) == t_fixnum)          else if (type_of(vs_head) == t_fixnum)
1350                  dim = fix(vs_head);                  dim = fix(vs_head);
1351          vs_pop;          vs_popp;
1352          vs_pop;          vs_popp;
1353          in = vs_head;          in = vs_head;
1354          vsp = vs_top;          vsp = vs_top;
1355          dimcount = 0;          dimcount = 0;
# Line 1353  Lsharp_asterisk_reader() Line 1379  Lsharp_asterisk_reader()
1379          x = alloc_simple_bitvector(dimcount);          x = alloc_simple_bitvector(dimcount);
1380          vs_push(x);          vs_push(x);
1381          x->bv.bv_self = alloc_relblock((dimcount + 7)/8);          x->bv.bv_self = alloc_relblock((dimcount + 7)/8);
1382          vs_pop;          vs_popp;
1383          for (dim = 0; dim < dimcount; dim++)          for (dim = 0; dim < dimcount; dim++)
1384                  if (char_code(vsp[dim]) == '0')                  if (char_code(vsp[dim]) == '0')
1385                          x->bv.bv_self[dim/8] &= ~(0200 >> dim%8);                          x->bv.bv_self[dim/8] &= ~(0200 >> dim%8);
# Line 1364  Lsharp_asterisk_reader() Line 1390  Lsharp_asterisk_reader()
1390          vs_push(x);          vs_push(x);
1391  }  }
1392    
1393    void
1394  Lsharp_colon_reader()  Lsharp_colon_reader()
1395  {  {
1396          object in;          object in;
# Line 1373  Lsharp_colon_reader() Line 1400  Lsharp_colon_reader()
1400    
1401          if (vs_base[2] != Cnil && !READsuppress)          if (vs_base[2] != Cnil && !READsuppress)
1402                  extra_argument(':');                  extra_argument(':');
1403          vs_pop;          vs_popp;
1404          vs_pop;          vs_popp;
1405          in = vs_base[0];          in = vs_base[0];
1406          c = read_char(in);          c = read_char(in);
1407          a = cat(c);          a = cat(c);
# Line 1430  M: Line 1457  M:
1457          vs_base[0] = make_symbol(vs_base[0]);          vs_base[0] = make_symbol(vs_base[0]);
1458  }  }
1459    
1460    void
1461  Lsharp_dot_reader()  Lsharp_dot_reader()
1462  {  {
1463          check_arg(3);          check_arg(3);
1464          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1465                  extra_argument('.');                  extra_argument('.');
1466          vs_pop;          vs_popp;
1467          vs_pop;          vs_popp;
1468          if (READsuppress) {          if (READsuppress) {
1469                  read_object(vs_base[0]);                          read_object(vs_base[0]);        
1470                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
# Line 1446  Lsharp_dot_reader() Line 1474  Lsharp_dot_reader()
1474          vs_base[0] = ieval(vs_base[0]);          vs_base[0] = ieval(vs_base[0]);
1475  }  }
1476    
1477    void
1478  Lsharp_comma_reader()  Lsharp_comma_reader()
1479  {  {
1480          check_arg(3);          check_arg(3);
1481          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1482                  extra_argument(',');                  extra_argument(',');
1483          vs_pop;          vs_popp;
1484          vs_pop;          vs_popp;
1485          if (READsuppress) {          if (READsuppress) {
1486                  read_object(vs_base[0]);                  read_object(vs_base[0]);
1487                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
# Line 1462  Lsharp_comma_reader() Line 1491  Lsharp_comma_reader()
1491          vs_base[0] = ieval(vs_base[0]);          vs_base[0] = ieval(vs_base[0]);
1492  }  }
1493    
1494    void
1495  siLsharp_comma_reader_for_compiler()  siLsharp_comma_reader_for_compiler()
1496  {  {
1497          check_arg(3);          check_arg(3);
1498          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1499                  extra_argument(',');                  extra_argument(',');
1500          vs_pop;          vs_popp;
1501          vs_pop;          vs_popp;
1502          if (READsuppress) {          if (READsuppress) {
1503                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
1504                  return;                  return;
# Line 1480  siLsharp_comma_reader_for_compiler() Line 1510  siLsharp_comma_reader_for_compiler()
1510  /*  /*
1511          For fasload.          For fasload.
1512  */  */
1513    void
1514  Lsharp_exclamation_reader()  Lsharp_exclamation_reader()
1515  {  {
1516          check_arg(3);          check_arg(3);
1517          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1518                  extra_argument('!');                  extra_argument('!');
1519          vs_pop;          vs_popp;
1520          vs_pop;          vs_popp;
1521          if (READsuppress) {          if (READsuppress) {
1522                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
1523                  return;                  return;
1524          }          }
1525          vs_base[0] = read_object(vs_base[0]);          vs_base[0] = read_object(vs_base[0]);
1526          ieval(vs_base[0]);          ieval(vs_base[0]);
1527          vs_pop;          vs_popp;
1528  }  }
1529    
1530    void
1531  Lsharp_B_reader()  Lsharp_B_reader()
1532  {  {
1533          int i;          int i;
1534    
1535          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1536                  extra_argument('B');                  extra_argument('B');
1537          vs_pop;          vs_popp;
1538          vs_pop;          vs_popp;
1539          read_constituent(vs_base[0]);          read_constituent(vs_base[0]);
1540          if (READsuppress) {          if (READsuppress) {
1541                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
# Line 1519  Lsharp_B_reader() Line 1551  Lsharp_B_reader()
1551                          1, vs_base[0]);                          1, vs_base[0]);
1552  }  }
1553    
1554    void
1555  Lsharp_O_reader()  Lsharp_O_reader()
1556  {  {
1557          int i;          int i;
1558    
1559          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1560                  extra_argument('O');                  extra_argument('O');
1561          vs_pop;          vs_popp;
1562          vs_pop;          vs_popp;
1563          read_constituent(vs_base[0]);          read_constituent(vs_base[0]);
1564          if (READsuppress) {          if (READsuppress) {
1565                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
# Line 1542  Lsharp_O_reader() Line 1575  Lsharp_O_reader()
1575                          1, vs_base[0]);                          1, vs_base[0]);
1576  }  }
1577    
1578    void
1579  Lsharp_X_reader()  Lsharp_X_reader()
1580  {  {
1581          int i;          int i;
1582    
1583          if(vs_base[2] != Cnil && !READsuppress)          if(vs_base[2] != Cnil && !READsuppress)
1584                  extra_argument('X');                  extra_argument('X');
1585          vs_pop;          vs_popp;
1586          vs_pop;          vs_popp;
1587          read_constituent(vs_base[0]);          read_constituent(vs_base[0]);
1588          if (READsuppress) {          if (READsuppress) {
1589                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
# Line 1565  Lsharp_X_reader() Line 1599  Lsharp_X_reader()
1599                          1, vs_base[0]);                          1, vs_base[0]);
1600  }  }
1601    
1602    void
1603  Lsharp_R_reader()  Lsharp_R_reader()
1604  {  {
1605          int radix, i;          int radix=0, i;
1606    
1607          check_arg(3);          check_arg(3);
1608          if (READsuppress)          if (READsuppress)
# Line 1578  Lsharp_R_reader() Line 1613  Lsharp_R_reader()
1613                          FEerror("~S is an illegal radix.", 1, vs_base[2]);                          FEerror("~S is an illegal radix.", 1, vs_base[2]);
1614          } else          } else
1615                  FEerror("No radix was supplied in the #R readmacro.", 0);                  FEerror("No radix was supplied in the #R readmacro.", 0);
1616          vs_pop;          vs_popp;
1617          vs_pop;          vs_popp;
1618          read_constituent(vs_base[0]);          read_constituent(vs_base[0]);
1619          if (READsuppress) {          if (READsuppress) {
1620                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
# Line 1595  Lsharp_R_reader() Line 1630  Lsharp_R_reader()
1630                          1, vs_base[0]);                          1, vs_base[0]);
1631  }  }
1632    
1633  Lsharp_A_reader(){}  void Lsharp_A_reader(){}
1634    
1635  Lsharp_S_reader(){}  void Lsharp_S_reader(){}
1636    
1637    void
1638  Lsharp_eq_reader()  Lsharp_eq_reader()
1639  {  {
1640          int i;          int i;
# Line 1629  Lsharp_eq_reader() Line 1665  Lsharp_eq_reader()
1665          vs_top = vs_base+1;          vs_top = vs_base+1;
1666  }  }
1667    
1668    void
1669  Lsharp_sharp_reader()  Lsharp_sharp_reader()
1670  {  {
1671          int i;          int i;
1672    
1673          check_arg(3);          check_arg(3);
1674          if (READsuppress) {          if (READsuppress) {
1675                  vs_pop;                  vs_popp;
1676                  vs_pop;                  vs_popp;
1677                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
1678          }          }
1679          if (vs_base[2] == Cnil)          if (vs_base[2] == Cnil)
# Line 1655  Lsharp_sharp_reader() Line 1692  Lsharp_sharp_reader()
1692          vs_top = vs_base+1;          vs_top = vs_base+1;
1693  }  }
1694    
1695    void
1696  patch_sharp_cons(x)  patch_sharp_cons(x)
1697  object x;  object x;
1698  {  {
# Line 1726  object x; Line 1764  object x;
1764           break;           break;
1765         }         }
1766                    
1767            default:
1768                    break;
1769          }          }
1770          return(x);          return(x);
1771  }  }
1772    
1773  Lsharp_plus_reader(){}  void Lsharp_plus_reader(){}
1774    
1775  Lsharp_minus_reader(){}  void Lsharp_minus_reader(){}
1776    
1777  Lsharp_less_than_reader(){}  void Lsharp_less_than_reader(){}
1778    
1779  Lsharp_whitespace_reader(){}  void Lsharp_whitespace_reader(){}
1780    
1781  Lsharp_right_parenthesis_reader(){}  void Lsharp_right_parenthesis_reader(){}
1782    
1783    void
1784  Lsharp_vertical_bar_reader()  Lsharp_vertical_bar_reader()
1785  {  {
1786          int c;          int c;
# Line 1748  Lsharp_vertical_bar_reader() Line 1789  Lsharp_vertical_bar_reader()
1789          check_arg(3);          check_arg(3);
1790          if (vs_base[2] != Cnil && !READsuppress)          if (vs_base[2] != Cnil && !READsuppress)
1791                  extra_argument('|');                  extra_argument('|');
1792          vs_pop;          vs_popp;
1793          vs_pop;          vs_popp;
1794          for (;;) {          for (;;) {
1795                  c = readc_stream(vs_base[0]);                  c = readc_stream(vs_base[0]);
1796          L:          L:
# Line 1768  Lsharp_vertical_bar_reader() Line 1809  Lsharp_vertical_bar_reader()
1809                                  goto L;                                  goto L;
1810                  }                  }
1811          }          }
1812          vs_pop;          vs_popp;
1813          vs_base[0] = Cnil;          vs_base[0] = Cnil;
1814          /*  no result  */          /*  no result  */
1815  }  }
1816    
1817    void
1818  Ldefault_dispatch_macro()  Ldefault_dispatch_macro()
1819  {  {
1820          FEerror("The default dispatch macro signalled an error.", 0);          FEerror("The default dispatch macro signalled an error.", 0);
# Line 1781  Ldefault_dispatch_macro() Line 1823  Ldefault_dispatch_macro()
1823  /*  /*
1824          #p" ... " returns the pathname with namestring ... .          #p" ... " returns the pathname with namestring ... .
1825  */  */
1826  static  static void
1827  Lsharp_p_reader()  Lsharp_p_reader()
1828  {  {
1829          check_arg(3);          check_arg(3);
1830          if (vs_base[2] != Cnil && !READsuppress)          if (vs_base[2] != Cnil && !READsuppress)
1831                  extra_argument('p');                  extra_argument('p');
1832          vs_pop;          vs_popp;
1833          vs_pop;          vs_popp;
1834          vs_base[0] = read_object(vs_base[0]);          vs_base[0] = read_object(vs_base[0]);
1835          vs_base[0] = coerce_to_pathname(vs_base[0]);          vs_base[0] = coerce_to_pathname(vs_base[0]);
1836  }  }
# Line 1796  Lsharp_p_reader() Line 1838  Lsharp_p_reader()
1838  /*  /*
1839          #" ... " returns the pathname with namestring ... .          #" ... " returns the pathname with namestring ... .
1840  */  */
1841    void
1842  Lsharp_double_quote_reader()  Lsharp_double_quote_reader()
1843  {  {
1844          check_arg(3);          check_arg(3);
1845    
1846          if (vs_base[2] != Cnil && !READsuppress)          if (vs_base[2] != Cnil && !READsuppress)
1847                  extra_argument('"');                  extra_argument('"');
1848          vs_pop;          vs_popp;
1849          unread_char(vs_base[1], vs_base[0]);          unread_char(vs_base[1], vs_base[0]);
1850          vs_pop;          vs_popp;
1851          vs_base[0] = read_object(vs_base[0]);          vs_base[0] = read_object(vs_base[0]);
1852          vs_base[0] = coerce_to_pathname(vs_base[0]);          vs_base[0] = coerce_to_pathname(vs_base[0]);
1853  }  }
# Line 1813  Lsharp_double_quote_reader() Line 1856  Lsharp_double_quote_reader()
1856          #$ fixnum returns a random-state with the fixnum          #$ fixnum returns a random-state with the fixnum
1857          as its content.          as its content.
1858  */  */
1859    void
1860  Lsharp_dollar_reader()  Lsharp_dollar_reader()
1861  {  {
1862          int i;          int i;
# Line 1820  Lsharp_dollar_reader() Line 1864  Lsharp_dollar_reader()
1864          check_arg(3);          check_arg(3);
1865          if (vs_base[2] != Cnil && !READsuppress)          if (vs_base[2] != Cnil && !READsuppress)
1866                  extra_argument('$');                  extra_argument('$');
1867          vs_pop;          vs_popp;
1868          vs_pop;          vs_popp;
1869          vs_base[0] = read_object(vs_base[0]);          vs_base[0] = read_object(vs_base[0]);
1870          if (type_of(vs_base[0]) != t_fixnum)          if (type_of(vs_base[0]) != t_fixnum)
1871                  FEerror("Cannot make a random-state with the value ~S.",                  FEerror("Cannot make a random-state with the value ~S.",
# Line 1957  READ: Line 2001  READ:
2001    
2002          int i;          int i;
2003          bool e;          bool e;
2004          int old_sharp_eq_context_max;          volatile int old_sharp_eq_context_max=0;
2005          struct sharp_eq_context_struct          struct sharp_eq_context_struct
2006                  old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE];                  old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE];
2007          int old_backq_level;          volatile int old_backq_level=0;
2008    
2009  @  @
2010    
# Line 2176  READ: Line 2220  READ:
2220                  strm = symbol_value(sLAterminal_ioA);                  strm = symbol_value(sLAterminal_ioA);
2221          check_type_stream(&strm);          check_type_stream(&strm);
2222  #ifdef LISTEN_FOR_INPUT  #ifdef LISTEN_FOR_INPUT
2223          while(listen_stream(strm)) {read_char(strm);}          while(listen_stream(strm)) {readc_stream(strm);}
2224  #endif  #endif
2225          @(return Cnil)          @(return Cnil)
2226  @)  @)
# Line 2195  READ: Line 2239  READ:
2239              fix(radix) < 2 || fix(radix) > 36)              fix(radix) < 2 || fix(radix) > 36)
2240                  FEerror("~S is an illegal radix.", 1, radix);                  FEerror("~S is an illegal radix.", 1, radix);
2241          setup_READtable();          setup_READtable();
2242          while (READtable->rt.rt_self[strng->st.st_self[s]].rte_chattrib          while (READtable->rt.rt_self[(unsigned char)strng->st.st_self[s]].rte_chattrib
2243                 == cat_whitespace && s < e)                 == cat_whitespace && s < e)
2244                  s++;                  s++;
2245          if (s >= e) {          if (s >= e) {
# Line 2218  READ: Line 2262  READ:
2262          if (junk_allowed != Cnil)          if (junk_allowed != Cnil)
2263                  @(return x `make_fixnum(ep+s)`)                  @(return x `make_fixnum(ep+s)`)
2264          for (s += ep ;  s < e;  s++)          for (s += ep ;  s < e;  s++)
2265                  if (READtable->rt.rt_self[strng->st.st_self[s]]                  if (READtable->rt.rt_self[(unsigned char)strng->st.st_self[s]]
2266                      .rte_chattrib                      .rte_chattrib
2267                      != cat_whitespace)                      != cat_whitespace)
2268                          goto CANNOT_PARSE;                          goto CANNOT_PARSE;
# Line 2276  object str,eof; Line 2320  object str,eof;
2320          @(return `copy_readtable(from, to)`)          @(return `copy_readtable(from, to)`)
2321  @)  @)
2322    
2323    void
2324  Lreadtablep()  Lreadtablep()
2325  {  {
2326          check_arg(1);          check_arg(1);
# Line 2424  object x; Line 2469  object x;
2469          return(x);          return(x);
2470  }  }
2471                    
2472    void
2473  siLstring_to_object()  siLstring_to_object()
2474  {  {
2475          check_arg(1);          check_arg(1);
# Line 2433  siLstring_to_object() Line 2479  siLstring_to_object()
2479  }  }
2480    
2481    
2482    void
2483  siLstandard_readtable()  siLstandard_readtable()
2484  {  {
2485          check_arg(0);          check_arg(0);
# Line 2440  siLstandard_readtable() Line 2487  siLstandard_readtable()
2487          vs_push(standard_readtable);          vs_push(standard_readtable);
2488  }  }
2489    
2490  too_long_token()  void
2491    too_long_token(void)
2492  {  {
2493          char *q;          char *q;
2494          int i;          int i;
# Line 2458  too_long_token() Line 2506  too_long_token()
2506  */  */
2507  }  }
2508    
2509  too_long_string()  void
2510    too_long_string(void)
2511  {  {
2512          char *q;          char *q;
2513          int i;          int i;
# Line 2475  too_long_string() Line 2524  too_long_string()
2524  */  */
2525  }  }
2526    
2527    void
2528  extra_argument(c)  extra_argument(c)
2529  int c;  int c;
2530  {  {
# Line 2491  DEFVAR("*READ-BASE*",sLAread_baseA,LISP, Line 2541  DEFVAR("*READ-BASE*",sLAread_baseA,LISP,
2541  DEFVAR("*READ-SUPPRESS*",sLAread_suppressA,LISP,Cnil,"");  DEFVAR("*READ-SUPPRESS*",sLAread_suppressA,LISP,Cnil,"");
2542    
2543    
2544    void
2545  init_read()  init_read()
2546  {  {
2547          struct rtent *rtab;          struct rtent *rtab;
# Line 2636  init_read() Line 2687  init_read()
2687  */  */
2688  }  }
2689    
2690    void
2691  init_read_function()  init_read_function()
2692  {  {
2693          make_function("READ", Lread);          make_function("READ", Lread);
# Line 2682  object in; Line 2734  object in;
2734  {  {
2735          int dimcount, dim;          int dimcount, dim;
2736          object *vsp;                      object *vsp;            
   
2737          VOL object x;          VOL object x;
2738          int i;          int i;
2739          bool e;          bool e;
# Line 2695  object in; Line 2746  object in;
2746                  old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE];                  old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE];
2747          int old_backq_level;          int old_backq_level;
2748    
2749            vsp=(object *)&vsp;
2750          old_READtable = READtable;          old_READtable = READtable;
2751          old_READdefault_float_format = READdefault_float_format;          old_READdefault_float_format = READdefault_float_format;
2752          old_READbase = READbase;          old_READbase = READbase;

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26