home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume20 / fpc / part02 < prev    next >
Text File  |  1989-10-23  |  50KB  |  2,167 lines
  1. Subject:  v20i051:  Portable compiler of the FP language, Part02/06
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Edoardo Biagioni <biagioni@cs.unc.edu>
  7. Posting-number: Volume 20, Issue 51
  8. Archive-name: fpc/part02
  9.  
  10.  
  11. #    This is a shell archive.
  12. #    Remove everything above and including the cut line.
  13. #    Then run the rest of the file through sh.
  14. -----cut here-----cut here-----cut here-----cut here-----
  15. #!/bin/sh
  16. # shar:    Shell Archiver
  17. #    Run the following text with /bin/sh to create:
  18. #    fp.c.part1
  19. #    lex.yy.c
  20. echo shar: extracting fp.c.part1 '(32154 characters)'
  21. sed 's/^XX//' << \SHAR_EOF > fp.c.part1
  22. XX#include <stdio.h>
  23. XX#include <strings.h>
  24. XX#include <ctype.h>
  25. XX#include "fp.h"
  26. XX
  27. XXextern char * malloc ();
  28. XXextern char * sprintf ();
  29. XXextern exit ();
  30. XX/* for me, this should be void exit, but the man (3) page doesn't
  31. XX * think so. Some implementations have void exit, some don't, so
  32. XX * either way there is no way to tell lint to shut up about it.
  33. XX * Just ignore it if it comes up */
  34. XX
  35. XXstruct fp_object nilobj = {NILOBJ};
  36. XXstruct fp_object tobj = {TRUEOBJ};
  37. XXstruct fp_object fobj = {FALSEOBJ};
  38. XX
  39. XXstruct stackframe * stack = 0;
  40. XX
  41. XXint fpargc;
  42. XXchar ** fpargv;
  43. XX
  44. XXfp_data staticstore = 0; /* a vector of all the things that
  45. XX             * are allocated statically, so we can
  46. XX             * return them at the end. */
  47. XX
  48. XX/*
  49. XX#define NORETURN    1
  50. XX */
  51. XX/*
  52. XX#ifdef DEBUG
  53. XX#define TSTRET    /* used to test reference counting * /
  54. XX#define CHECKREF    /* used to print reference count, pointer values * /
  55. XX#endif
  56. XX */
  57. XX#ifdef NOCHECK
  58. XX#define NCOUNTVEC
  59. XX/* nocheck is the fast option, so if we have it we certainly don't want
  60. XX   to count vectors */
  61. XX#endif
  62. XX
  63. XX#ifdef NCOUNTVEC
  64. XX#ifdef TSTRET
  65. XX#undef NCOUNTVEC
  66. XX#endif
  67. XX#endif
  68. XX
  69. XX#define nonvector(x)    ((x->fp_type != NILOBJ) && \
  70. XX             (x->fp_type != VECTOR))
  71. XX#define nonboolean(x)    ((x->fp_type != TRUEOBJ) && \
  72. XX             (x->fp_type != FALSEOBJ))
  73. XX
  74. XX#ifndef NOCHECK
  75. XXvoid checkpair (data, fname)
  76. XXfp_data data;
  77. XXchar * fname;
  78. XX{
  79. XX  void parmbot ();
  80. XX
  81. XX  if (data->fp_type != VECTOR)
  82. XX    parmbot (fname, "input is not a vector", data);
  83. XX  if ((data->fp_header.fp_next == 0) ||
  84. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  85. XX    parmbot (fname, "input is not a 2-element vector", data);
  86. XX}
  87. XX#else
  88. XX#define checkpair(data, fname)    /* no-op, don't waste code and time */
  89. XX#endif
  90. XX
  91. XXint depthcount = 0;
  92. XX
  93. XXvoid indent (n, out)
  94. XXint n;
  95. XXFILE * out;
  96. XX{
  97. XX  register int icount;
  98. XX
  99. XX  for (icount = 8; icount <= n; icount += 8)
  100. XX    (void) putc ('\t', out);
  101. XX  for (icount -= 8; icount < n; icount++)
  102. XX    (void) putc (' ', out);
  103. XX}
  104. XX
  105. XXint numprsize (n)
  106. XXlong n;
  107. XX{
  108. XX  int res;
  109. XX
  110. XX  for (res = 1; n > 9; res++)
  111. XX    n /= 10;
  112. XX  return (res);
  113. XX}
  114. XX
  115. XXint floatprsize (n)
  116. XXfloat n;
  117. XX{
  118. XX  char str [100];
  119. XX
  120. XX  (void) sprintf (str, "%f", n);
  121. XX  return (strlen (str));
  122. XX}
  123. XX
  124. XXint isstring (data)
  125. XXfp_data data;
  126. XX{
  127. XX  if (data->fp_type != VECTOR)
  128. XX    return (0);
  129. XX  while (data != 0)
  130. XX    if (data->fp_entry->fp_type != CHARCONST)
  131. XX      return (0);
  132. XX    else
  133. XX      data = data->fp_header.fp_next;
  134. XX  return (1);
  135. XX}
  136. XX
  137. XXint printlen (data)
  138. XXfp_data data;
  139. XX{
  140. XX  register fp_data ptr;
  141. XX  register int str;
  142. XX  register int result;
  143. XX#ifndef NOCHECK
  144. XX  void genbottom ();
  145. XX#endif
  146. XX
  147. XX  switch (data->fp_type)
  148. XX  {
  149. XX    case NILOBJ:
  150. XX      return (2);        /* <> */
  151. XX    case TRUEOBJ:
  152. XX      return (1);        /* T */
  153. XX    case FALSEOBJ:
  154. XX      return (1);        /* F */
  155. XX    case INTCONST:
  156. XX      return (numprsize (data->fp_header.fp_int));
  157. XX    case ATOMCONST:
  158. XX      return (strlen (data->fp_header.fp_atom));
  159. XX    case FLOATCONST:
  160. XX      return (floatprsize (data->fp_header.fp_float));
  161. XX    case CHARCONST:
  162. XX      return (2);
  163. XX    case VECTOR:
  164. XX      str = isstring (data);
  165. XX      if (str)
  166. XX    result = 2;    /* for the "" */
  167. XX      else
  168. XX    result = 1;
  169. XX/* 2 for the brackets, -1 since blank not placed before first item */
  170. XX      ptr = data;
  171. XX      while (ptr != 0)
  172. XX      {
  173. XX    if (str)
  174. XX      result += 2;
  175. XX    else
  176. XX      result += 2 + printlen (ptr->fp_entry);
  177. XX        /* 1 for the comma, 1 for the blank between elements */
  178. XX    ptr = ptr->fp_header.fp_next;
  179. XX      }
  180. XX      return (result);
  181. XX#ifndef NOCHECK
  182. XX    default:
  183. XX      genbottom ("print: unknown object type", data);
  184. XX      return (0);
  185. XX#endif
  186. XX  }
  187. XX}
  188. XX
  189. XXvoid printfpdata (out, data, ind)
  190. XXFILE * out;
  191. XXfp_data data;
  192. XXint ind;
  193. XX{
  194. XX  int chars, str;
  195. XX  char c;
  196. XX  fp_data track;
  197. XX#ifndef NOCHECK
  198. XX  void genbottom ();
  199. XX#endif
  200. XX
  201. XX#ifndef NOCHECK
  202. XX  if (data == 0)        /* invalid argument, abort */
  203. XX    genbottom ("print: null pointer passed to printfpdata", fp_nil);
  204. XX#endif
  205. XX  switch (data->fp_type)
  206. XX  {
  207. XX    case NILOBJ:
  208. XX      (void) fprintf (out, "<>");
  209. XX      break;
  210. XX    case TRUEOBJ:
  211. XX      (void) putc ('T', out);
  212. XX      break;
  213. XX    case FALSEOBJ:
  214. XX      (void) putc ('F', out);
  215. XX      break;
  216. XX    case INTCONST:
  217. XX      (void) fprintf (out, "%d", data->fp_header.fp_int);
  218. XX      break;
  219. XX    case ATOMCONST:
  220. XX      (void) fprintf (out, "%s", data->fp_header.fp_atom);
  221. XX      break;
  222. XX    case CHARCONST:
  223. XX      c = data->fp_header.fp_char;
  224. XX      if ((c > '~') || (c < ' '))
  225. XX    (void) fprintf (out, "'%3o", c);
  226. XX      else
  227. XX    (void) fprintf (out, "'%c", c);
  228. XX      break;
  229. XX    case FLOATCONST:
  230. XX      (void) fprintf (out, "%f", data->fp_header.fp_float);
  231. XX      break;
  232. XX    case VECTOR:
  233. XX      str = isstring (data);
  234. XX      if (str)
  235. XX    (void) putc ('"', out);
  236. XX      else
  237. XX      {
  238. XX    chars = printlen (data);
  239. XX    (void) putc ('<', out);
  240. XX      }
  241. XX      track = data;
  242. XX      while (track != 0)
  243. XX      {
  244. XX    if (str)
  245. XX      (void) putc (track->fp_entry->fp_header.fp_char, out);
  246. XX    else
  247. XX      printfpdata (out, track->fp_entry, ind + 1);
  248. XX    track = track->fp_header.fp_next;
  249. XX    if ((! str) && (track != 0))
  250. XX    {
  251. XX      putc (',', out);
  252. XX      if (chars > (80 - ind))    /* put on separate lines, indent */
  253. XX      {
  254. XX        (void) putc ('\n', out);
  255. XX        indent (ind + 1, out);
  256. XX      }
  257. XX      else
  258. XX        (void) putc (' ', out);
  259. XX    }
  260. XX      }
  261. XX      if (str)
  262. XX    (void) putc ('"', out);
  263. XX      else
  264. XX    (void) putc ('>', out);
  265. XX      break;
  266. XX#ifndef NOCHECK
  267. XX    default:
  268. XX      genbottom ("print: unknown object type", data);
  269. XX#endif
  270. XX  }
  271. XX#ifdef CHECKREF
  272. XX  (void) fprintf (out, ".%d/%d", data->fp_ref, data);
  273. XX#endif
  274. XX}
  275. XX
  276. XXlong unsigned currsize = 0;    /* keep stats about allocation */
  277. XXlong unsigned maxsize = 0;    /* keep stats about allocation */
  278. XX
  279. XXfp_data freelist = 0;        /* pointer to list of free cells */
  280. XX
  281. XXvoid makefree ()
  282. XX{
  283. XX  register fp_data cells;
  284. XX#define BLOCKSIZE 512
  285. XX
  286. XX  cells = (fp_data) malloc ((unsigned) BLOCKSIZE * VECTSIZE);
  287. XX#ifndef NOCHECK
  288. XX  if (cells == 0)
  289. XX    genbottom ("memory allocator: out of space", fp_nil);
  290. XX#endif
  291. XX  for (freelist = cells; (cells - freelist) < BLOCKSIZE; cells++)
  292. XX    cells->fp_entry = cells + 1;
  293. XX  cells = freelist + BLOCKSIZE - 1;
  294. XX  cells->fp_entry = 0;
  295. XX}
  296. XX
  297. XX#ifndef NCOUNTVEC
  298. XXint nalloc = 0;
  299. XX#endif
  300. XX
  301. XXfp_data newconst (type)
  302. XXint type;
  303. XX{
  304. XX  register fp_data new;
  305. XX
  306. XX#ifdef TSTRET
  307. XX  (void) fprintf (stderr, "entering newconst\n");
  308. XX#endif
  309. XX  if (freelist == 0)
  310. XX    makefree ();
  311. XX  new = freelist;
  312. XX  freelist = new->fp_entry;
  313. XX  new->fp_type = type;
  314. XX#ifndef NCOUNTVEC
  315. XX  currsize += CONSTSIZE;
  316. XX  if (currsize > maxsize)
  317. XX    maxsize = currsize;
  318. XX#endif
  319. XX#ifdef TSTRET
  320. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d",
  321. XX          CONSTSIZE, new->fp_type);
  322. XX  (void) fprintf (stderr, ", max is %d, now exiting newconst\n", maxsize);
  323. XX#endif
  324. XX  return (new);
  325. XX}
  326. XX
  327. XXfp_data newcell ()
  328. XX{
  329. XX  register fp_data new;
  330. XX
  331. XX#ifdef TSTRET
  332. XX  (void) fprintf (stderr, "entering newcell, size is %d\n", size);
  333. XX#endif
  334. XX  if (freelist == 0)
  335. XX    makefree ();
  336. XX  new = freelist;
  337. XX  freelist = new->fp_entry;
  338. XX  new->fp_type = VECTOR;        /* init type, ref count */
  339. XX  new->fp_ref = 1;
  340. XX  new->fp_header.fp_next = 0;
  341. XX#ifndef NCOUNTVEC
  342. XX  nalloc++;
  343. XX  currsize += VECTSIZE;
  344. XX  if (currsize > maxsize)
  345. XX    maxsize = currsize;
  346. XX#endif
  347. XX#ifdef TSTRET
  348. XX  (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
  349. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d", VECTSIZE, VECTOR);
  350. XX  (void) fprintf (stderr, ", max is %d, now exiting newcell\n", maxsize);
  351. XX#endif
  352. XX  return (new);
  353. XX}
  354. XX
  355. XXfp_data newpair ()
  356. XX{
  357. XX  register fp_data head, tail;
  358. XX
  359. XX#ifdef TSTRET
  360. XX  (void) fprintf (stderr, "entering newpair, size is %d\n", size);
  361. XX#endif
  362. XX  if (freelist == 0)
  363. XX    makefree ();
  364. XX  head = freelist;
  365. XX  freelist = head->fp_entry;
  366. XX  if (freelist == 0)
  367. XX    makefree ();
  368. XX  tail = freelist;
  369. XX  freelist = tail->fp_entry;
  370. XX  head->fp_type = VECTOR;        /* init type, ref count */
  371. XX  head->fp_ref = 1;
  372. XX  head->fp_header.fp_next = tail;
  373. XX  tail->fp_type = VECTOR;
  374. XX  tail->fp_ref = 1;
  375. XX  tail->fp_header.fp_next = 0;
  376. XX#ifndef NCOUNTVEC
  377. XX  nalloc += 2;
  378. XX  currsize += (VECTSIZE + VECTSIZE);
  379. XX  if (currsize > maxsize)
  380. XX    maxsize = currsize;
  381. XX#endif
  382. XX#ifdef TSTRET
  383. XX  (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
  384. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d",
  385. XX          2 * VECTSIZE, VECTOR);
  386. XX  (void) fprintf (stderr, ", max is %d, now exiting newpair\n", maxsize);
  387. XX#endif
  388. XX  return (head);
  389. XX}
  390. XX
  391. XX/* the following is less efficient than newconst, newcell or newpair,
  392. XX   so should only be used with vectors of length > 2 or of variable
  393. XX   length */
  394. XXfp_data newvect (size)
  395. XXlong size;
  396. XX{
  397. XX  register fp_data new, old;
  398. XX#ifdef TSTRET
  399. XX  register int space;
  400. XX#endif
  401. XX
  402. XX#ifdef TSTRET
  403. XX  (void) fprintf (stderr, "entering newvect, size is %d\n", size);
  404. XX  space = size * VECTSIZE;
  405. XX#endif
  406. XX#ifndef NCOUNTVEC
  407. XX  currsize += size * VECTSIZE;
  408. XX  nalloc += size;
  409. XX  if (currsize > maxsize)
  410. XX    maxsize = currsize;
  411. XX#endif
  412. XX/* build the vector back-to-front */
  413. XX  old = (fp_data) 0;
  414. XX  while (size-- > 0)
  415. XX  {
  416. XX    if (freelist == 0) makefree ();
  417. XX    new = freelist;
  418. XX    freelist = freelist->fp_entry;
  419. XX    new->fp_type = VECTOR;        /* init type, ref count */
  420. XX    new->fp_ref = 1;
  421. XX    new->fp_header.fp_next = old;
  422. XX    old = new;
  423. XX  }
  424. XX#ifdef TSTRET
  425. XX  (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
  426. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d",
  427. XX          space, new->fp_type);
  428. XX  (void) fprintf (stderr, ", max is %d, now exiting newvect\n", maxsize);
  429. XX#endif
  430. XX  return (new);
  431. XX}
  432. XX
  433. XX#ifndef NCOUNTVEC
  434. XXint dalloc = 0;
  435. XX#endif
  436. XX
  437. XX/* returnvect should only be called via dec_ref, which checks for reference
  438. XX   count == 0 and type == vector */
  439. XXvoid returnvect (data)
  440. XXfp_data data;
  441. XX{
  442. XX  register fp_data old;
  443. XX
  444. XX#ifdef TSTRET
  445. XX  (void) fprintf (stderr, "entering returnvect, input is ");
  446. XX  printfpdata (stderr, data, 0);
  447. XX  (void) fprintf (stderr, "\nref count is %d\n", data->fp_ref);
  448. XX#endif
  449. XX  while ((data != 0) && (data->fp_ref == 0))
  450. XX  {
  451. XX#ifdef TSTRET
  452. XX    if (data->fp_ref < 0)
  453. XX    {
  454. XX      (void) fprintf (stderr,
  455. XX              "reference counting error, negative count found\n");
  456. XX      (void) fprintf (stderr, "data is ");
  457. XX      printfpdata (stderr, data, 0);
  458. XX      (void) fprintf (stderr, "\nreference count is %d\n", data->fp_ref);
  459. XX      (void) exit (1);
  460. XX    }
  461. XX#endif
  462. XX#ifndef NCOUNTVEC
  463. XX    currsize -= VECTSIZE;
  464. XX    dalloc++;
  465. XX#endif
  466. XX    dec_ref (data->fp_entry);    /* return element */
  467. XX    old = data;
  468. XX    data = data->fp_header.fp_next;
  469. XX    if (data != 0)        /* return tail, if it has other ref */
  470. XX      data->fp_ref--;
  471. XX#ifndef NORETURN
  472. XX    old->fp_entry = freelist;    /* return self */
  473. XX    freelist = old;
  474. XX#endif
  475. XX  }
  476. XX#ifdef TSTRET
  477. XX  (void) fprintf (stderr, "%d vectors deallocated\nexiting returnvect",
  478. XX          dalloc);
  479. XX#endif
  480. XX}
  481. XX
  482. XXvoid checkstorage ()
  483. XX{
  484. XX#ifndef NCOUNTVEC
  485. XX  if (staticstore != 0)
  486. XX    dec_ref (staticstore);
  487. XX  if (nalloc != dalloc)
  488. XX  {
  489. XX    fprintf (stderr, "WARNING: %d cells allocated, %d deallocated\n",
  490. XX         nalloc, dalloc);
  491. XX    fprintf (stderr, "(the two numbers should be the same)\n");
  492. XX    fprintf (stderr, "This is an implementation error. The above\n");
  493. XX    fprintf (stderr, "results may be incorrect.\n");
  494. XX  }
  495. XX#endif
  496. XX}
  497. XX
  498. XXvoid printstorage ()
  499. XX{
  500. XX  checkstorage ();
  501. XX#ifndef NCOUNTVEC
  502. XX  (void) fprintf (stdout,
  503. XX              "%d cells allocated, %d cells deallocated\n", nalloc, dalloc);
  504. XX  (void) fprintf (stdout,
  505. XX              "maximum space needed was %d bytes\n", maxsize);
  506. XX#endif
  507. XX}
  508. XX
  509. XXvoid putfpdata (data)
  510. XXfp_data data;
  511. XX{
  512. XX#ifdef DEBUG
  513. XX  (void) fprintf (stderr, "entering putfpdata\n");
  514. XX#endif
  515. XX  printfpdata (stdout, data, 0);
  516. XX  (void) putc ('\n', stdout);
  517. XX#ifdef DEBUG
  518. XX  (void) fprintf (stderr, "exiting putfpdata\n");
  519. XX#endif
  520. XX}
  521. XX
  522. XXvoid putfpstring (data, out)
  523. XXfp_data data;
  524. XXFILE * out;
  525. XX{
  526. XX#ifndef NOCHECK
  527. XX  if ((data->fp_type != NILOBJ) && ! isstring (data))
  528. XX    genbottom ("print string: input was not a string", data);
  529. XX#endif
  530. XX  if (data->fp_type != NILOBJ)
  531. XX    while (data != 0)
  532. XX    {
  533. XX      (void) putc (data->fp_entry->fp_header.fp_char, out);
  534. XX      data = data->fp_header.fp_next;
  535. XX    }
  536. XX}
  537. XX
  538. XXvoid putfpstrings (data)
  539. XXfp_data data;
  540. XX/* if the argument is a string it outputs it using putfpstring;
  541. XX * otherwise it must be a vector of pairs <filename string>, the
  542. XX * strings become the contents of the named files
  543. XX */
  544. XX{
  545. XX  extern FILE * fopen ();
  546. XX  extern int fclose ();
  547. XX  static void toCstring ();
  548. XX  register FILE * out;
  549. XX  register fp_data fname;
  550. XX  register fp_data string;
  551. XX  register fp_data entry;
  552. XX  register int closeres;
  553. XX  char filename [FNAMELEN];
  554. XX
  555. XX  if ((data->fp_type == NILOBJ) || isstring (data))
  556. XX    putfpstring (data, stdout);
  557. XX  else
  558. XX    while (data != 0)
  559. XX    {
  560. XX      entry = data->fp_entry;
  561. XX      data = data->fp_header.fp_next;
  562. XX#ifndef NOCHECK
  563. XX      checkpair (entry, "output routine");
  564. XX#endif
  565. XX      fname = entry->fp_entry;
  566. XX      string = entry->fp_header.fp_next->fp_entry;
  567. XX#ifndef NOCHECK
  568. XX      if (! isstring (fname))
  569. XX    genbottom ("print: file name is not a string", entry);
  570. XX/* string-ness of the string is checked in putfpstring */
  571. XX#endif
  572. XX      toCstring (fname, filename);
  573. XX      out = fopen (filename, "w");
  574. XX#ifndef NOCHECK
  575. XX      if (out == 0)
  576. XX    genbottom ("print: unable to open the output file", fname);
  577. XX#endif
  578. XX      putfpstring (string, out);
  579. XX      closeres = fclose (out);
  580. XX#ifndef NOCHECK
  581. XX      if (closeres == EOF)
  582. XX    genbottom ("print: unable to close the output file", fname);
  583. XX#endif
  584. XX    }
  585. XX}
  586. XX
  587. XXfp_data readfpdata (in, input_char, dryrun)
  588. XXFILE * in;
  589. XXchar * input_char;
  590. XXint dryrun;    /* check file (1), or actually input it (0)? */
  591. XX        /* if it's a dry run, returns fp_true if correct, */
  592. XX        /* fp_false if the file is unreadable. */
  593. XX{
  594. XX  char string [128];
  595. XX  fp_data res, next, last, numconst;
  596. XX  unsigned int pos = 0;
  597. XX  long num;
  598. XX  float real;
  599. XX  int isneg = 0;
  600. XX  int negexp = 0;
  601. XX  void genbottom ();
  602. XX
  603. XX  while (isspace (*input_char))
  604. XX    *input_char = getc (in);
  605. XX  if (*input_char == '<')    /* opening vector */
  606. XX  {
  607. XX    *input_char = getc (in);
  608. XX    while (isspace (*input_char))
  609. XX      *input_char = getc (in);
  610. XX    last = 0;
  611. XX    if (dryrun)
  612. XX      res = fp_true;
  613. XX    else
  614. XX      res = fp_nil;
  615. XX    while (*input_char != '>')
  616. XX    {
  617. XX      if (dryrun)
  618. XX      {
  619. XX        if (readfpdata (in, input_char, 1) ->fp_type != TRUEOBJ)
  620. XX      return (fp_false);
  621. XX      }
  622. XX      else
  623. XX      {
  624. XX    next = newcell ();
  625. XX    next->fp_entry = readfpdata (in, input_char, 0);
  626. XX    if (last == 0)
  627. XX      res = next;
  628. XX    else
  629. XX      last->fp_header.fp_next = next;
  630. XX    last = next;
  631. XX      }
  632. XX      while (isspace (*input_char))
  633. XX    *input_char = getc (in);
  634. XX      if ((*input_char != ',') && (*input_char != '>'))
  635. XX    if (dryrun)
  636. XX      return (fp_false);
  637. XX    else
  638. XX      genbottom ("read: comma or > expected after vector element", res);
  639. XX      if (*input_char == ',')
  640. XX        *input_char = getc (in);
  641. XX      while (isspace (*input_char))
  642. XX    *input_char = getc (in);
  643. XX    }
  644. XX    *input_char = getc (in);
  645. XX  }    /* end if vector */
  646. XX  else if (((*input_char >= '0') && (*input_char <= '9')) ||
  647. XX       (*input_char == '-') || (*input_char == '+') ||
  648. XX       (*input_char == '.'))    /* number */
  649. XX  {
  650. XX    isneg = *input_char == '-';
  651. XX    if (isneg || (*input_char == '+'))
  652. XX    {
  653. XX      *input_char = getc (in);
  654. XX      while (isspace (*input_char))
  655. XX    *input_char = getc (in);
  656. XX    }
  657. XX    num = 0;
  658. XX    while ((*input_char >= '0') && (*input_char <= '9'))
  659. XX    {
  660. XX      num = (num * 10) + (*input_char - '0');
  661. XX      *input_char = getc (in);
  662. XX    }
  663. XX    if ((*input_char != '.') && (*input_char != 'e') && (*input_char != 'E'))
  664. XX    {        /* means we have finished reading an integer */
  665. XX      if (dryrun)
  666. XX    return (fp_true);
  667. XX      res = newconst (INTCONST);
  668. XX      res->fp_header.fp_int = (isneg) ? (-num) : num;
  669. XX    }
  670. XX    else    /* floating point number */
  671. XX    {
  672. XX      real = num;
  673. XX      if (*input_char == '.')    /* reading the fractional part */
  674. XX      {
  675. XX    num = 10;        /* num is now the divisor */
  676. XX    *input_char = getc (in);
  677. XX    while ((*input_char >= '0') && (*input_char <= '9'))
  678. XX    {
  679. XX      real += ((float) (*input_char - '0')) / (float) (num);
  680. XX      num *= 10;
  681. XX      *input_char = getc (in);
  682. XX    }
  683. XX      }
  684. XX      if ((*input_char == 'e') || (*input_char == 'E'))
  685. XX      {        /* time to read the exponent */
  686. XX    *input_char = getc (in);
  687. XX    negexp = *input_char == '-';
  688. XX    if (negexp || (*input_char == '+'))
  689. XX    {
  690. XX      *input_char = getc (in);
  691. XX      while (isspace (*input_char))
  692. XX        *input_char = getc (in);
  693. XX    }
  694. XX    num = 0;
  695. XX    while ((*input_char >= '0') && (*input_char <= '9'))
  696. XX    {
  697. XX      num = (num * 10) + (*input_char - '0');
  698. XX      *input_char = getc (in);
  699. XX    }
  700. XX    while (num-- > 0)
  701. XX      if (negexp)
  702. XX        real /= 10;
  703. XX      else
  704. XX        real *= 10;
  705. XX      }
  706. XX      if (dryrun)
  707. XX    return (fp_true);
  708. XX      res = newconst (FLOATCONST);
  709. XX      res->fp_header.fp_float = (isneg) ? (-real) : real;
  710. XX    }
  711. XX  }    /* end if number */
  712. XX  else if (*input_char == '\'')        /* single char */
  713. XX  {
  714. XX    *input_char = getc (in);
  715. XX    if (*input_char == '\\')
  716. XX      *input_char = getc (in);
  717. XX    if (! dryrun)
  718. XX    {
  719. XX      res = newconst (CHARCONST);
  720. XX      res->fp_header.fp_char = *input_char;
  721. XX    }
  722. XX    *input_char = getc (in);
  723. XX  }    /* end if char */
  724. XX  else if (*input_char == '"')        /* string, i.e., vector of chars */
  725. XX  {
  726. XX    last = 0;
  727. XX    if (! dryrun)
  728. XX      res = fp_nil;
  729. XX    while (1)
  730. XX    {
  731. XX      *input_char = getc (in);
  732. XX      if (*input_char == '\\')
  733. XX    *input_char = getc (in);
  734. XX      else if (*input_char == '"')
  735. XX    break;
  736. XX      if (! dryrun)
  737. XX      {
  738. XX    numconst = newconst (CHARCONST);
  739. XX    numconst->fp_header.fp_char = *input_char;
  740. XX    next = newcell ();
  741. XX    next->fp_entry = numconst;
  742. XX    if (last == 0)
  743. XX      res = next;
  744. XX    else
  745. XX      last->fp_header.fp_next = next;
  746. XX    last = next;
  747. XX      }
  748. XX    }
  749. XX    *input_char = getc (in);
  750. XX  }    /* end if string */
  751. XX  else if (isalpha (*input_char))        /* symbol */
  752. XX  {
  753. XX    while (isalnum (*input_char) || (*input_char == '.'))
  754. XX    {
  755. XX      string [pos++] = *input_char;
  756. XX      *input_char = getc (in);
  757. XX    }
  758. XX    string [pos] = '\0';
  759. XX    if (dryrun)
  760. XX      return (fp_true);
  761. XX    if ((pos == 1) && (string [0] == 'T'))
  762. XX      res = fp_true;
  763. XX    else if ((pos == 1) && (string [0] == 'F'))
  764. XX      res = fp_false;
  765. XX    else
  766. XX    {
  767. XX      res = newconst (ATOMCONST);
  768. XX      res->fp_header.fp_atom = malloc (pos + 1);
  769. XX      (void) strcpy (res->fp_header.fp_atom, string);
  770. XX    }
  771. XX  }    /* end if symbol */
  772. XX  else if (((int) *input_char) == EOF)        /* end of file */
  773. XX  {
  774. XX    if (dryrun)
  775. XX      return (fp_false);
  776. XX    else
  777. XX      genbottom ("read: end of file reached before end of FFP object\n",
  778. XX         res);
  779. XX  }
  780. XX  else if (dryrun)
  781. XX    return (fp_false);
  782. XX  else
  783. XX  {
  784. XX    sprintf (string,
  785. XX         "read: unknown token type\nchar was %c (%d decimal)\n",
  786. XX         *input_char, *input_char);
  787. XX    genbottom (string, fp_nil);
  788. XX  }
  789. XX  return (res);
  790. XX}
  791. XX
  792. XXfp_data readfpstring (in)
  793. XXFILE * in;
  794. XX{
  795. XX  fp_data res = 0;
  796. XX  fp_data chase, cptr;
  797. XX  int input_char;
  798. XX
  799. XX  if ((in == 0) || ((input_char = getc (in)) == EOF))
  800. XX    res = fp_nil;
  801. XX  else
  802. XX  {
  803. XX    chase = res = newcell ();
  804. XX    cptr = newconst (CHARCONST);
  805. XX    cptr->fp_header.fp_char = input_char;
  806. XX    chase->fp_entry = cptr;
  807. XX    while ((input_char = getc (in)) != EOF)
  808. XX    {
  809. XX      chase = chase->fp_header.fp_next = newcell ();
  810. XX      cptr = newconst (CHARCONST);
  811. XX      cptr->fp_header.fp_char = input_char;
  812. XX      chase->fp_entry = cptr;
  813. XX    }
  814. XX  }
  815. XX  return (res);
  816. XX}
  817. XX
  818. XXfp_data getfpdata ()
  819. XX{
  820. XX  fp_data res;
  821. XX  char input_char;
  822. XX
  823. XX#ifdef DEBUG
  824. XX  (void) fprintf (stderr, "entering getfpdata\n");
  825. XX#endif
  826. XX  input_char = getc (stdin);
  827. XX  res = readfpdata (stdin, &input_char, 0);
  828. XX#ifdef DEBUG
  829. XX  (void) fprintf (stderr, "exiting getfpdata, result is ");
  830. XX  printfpdata (stderr, res, 0);
  831. XX  (void) putc ('\n', stderr);
  832. XX#endif
  833. XX  return (res);
  834. XX}
  835. XX
  836. XXfp_data getfpchar ()
  837. XX{
  838. XX  fp_data res;
  839. XX
  840. XX#ifdef DEBUG
  841. XX  (void) fprintf (stderr, "entering getfpchar\n");
  842. XX#endif
  843. XX  res = newconst (CHARCONST);
  844. XX  res->fp_header.fp_char = getc (stdin);
  845. XX#ifdef DEBUG
  846. XX  (void) fprintf (stderr, "exiting getfpchar, result is ");
  847. XX  printfpdata (stderr, res, 0);
  848. XX  (void) putc ('\n', stderr);
  849. XX#endif
  850. XX  return (res);
  851. XX}
  852. XX
  853. XXfp_data getfpstring ()
  854. XX{
  855. XX  fp_data res;
  856. XX
  857. XX#ifdef DEBUG
  858. XX  (void) fprintf (stderr, "entering getfpstring\n");
  859. XX#endif
  860. XX  res = readfpstring (stdin);
  861. XX#ifdef DEBUG
  862. XX  (void) fprintf (stderr, "exiting getfpstring, result is ");
  863. XX  printfpdata (stderr, res, 0);
  864. XX  (void) putc ('\n', stderr);
  865. XX#endif
  866. XX  return (res);
  867. XX}
  868. XX
  869. XX#ifndef NOCHECK
  870. XXint getonec (f)
  871. XXFILE * f;
  872. XX{
  873. XX  int ch, ch1;
  874. XX
  875. XX  ch1 = ch = getc (f);
  876. XX  while ((ch1 != '\n') && (ch1 != EOF))
  877. XX    ch1 = getc (f);
  878. XX  return (ch);
  879. XX}
  880. XX
  881. XXvoid stackdump (interfile, inter, outfile, baddata)
  882. XXFILE * interfile;
  883. XXint inter;
  884. XXFILE * outfile;
  885. XXint baddata;
  886. XX{
  887. XX  int ch;
  888. XX  int levels = 0;
  889. XX
  890. XX  while (stack != 0)
  891. XX  {
  892. XX    if ((! baddata) || (levels++ > 1))
  893. XX    {
  894. XX      (void) fprintf (outfile, "called by routine %s, with input\n",
  895. XX              stack->st_name);
  896. XX      printfpdata (outfile, stack->st_data, 0);
  897. XX    }
  898. XX    else
  899. XX      (void) fprintf (outfile,
  900. XX              "called by routine %s, with probably bad data\n",
  901. XX              stack->st_name);
  902. XX    stack = stack->st_prev;
  903. XX    (void) putc ('\n', outfile);
  904. XX    if (inter)
  905. XX    {
  906. XX      (void) fprintf (outfile, "continue stack dump?\n", stack->st_name);
  907. XX      ch = getonec (interfile);
  908. XX      if ((ch == 'n') || (ch == 'N'))
  909. XX    break;
  910. XX    }
  911. XX  }
  912. XX}
  913. XX#endif
  914. XX
  915. XX/* cannot be static because used by the main loop, sometimes */
  916. XXvoid genbottom (message, data)
  917. XXchar * message;
  918. XXfp_data data;
  919. XX{
  920. XX  int ch;
  921. XX  static int reentrant = 0;
  922. XX  FILE * core;
  923. XX
  924. XX  (void) fprintf (stderr, "error: bottom produced during execution\n");
  925. XX  (void) fprintf (stderr, "%s\n", message);
  926. XX  if (reentrant)
  927. XX    (void) fprintf (stderr, "an invalid pointer was input to the primitive\n");
  928. XX  else
  929. XX  {
  930. XX    reentrant = 1;        /* might be called by printfpdata */
  931. XX    printfpdata (stderr, data, 0);
  932. XX    (void) putc ('\n', stderr);
  933. XX    reentrant = 0;
  934. XX  }
  935. XX#ifndef NOCHECK
  936. XX  (void) fprintf (stderr, "do you wish a stack dump (y/n)?\n");
  937. XX  ch = getonec (stdin);
  938. XX  if (ch == EOF)
  939. XX  {
  940. XX    (void) fprintf (stderr, "dumping the stack to file 'core'\n");
  941. XX    core = fopen ("core", "w");
  942. XX    stackdump (stdin, 0, core, reentrant);
  943. XX    reentrant = fclose (core);
  944. XX  }
  945. XX  else if ((ch != 'n') && (ch != 'N'))
  946. XX  {
  947. XX    (void) fprintf (stderr, "interactive stack dump (y/n)?\n");
  948. XX    ch = getonec (stdin);
  949. XX    (void) fprintf (stderr, "dumping the relevant portions of the stack:\n");
  950. XX    stackdump (stdin, (ch == 'y') || (ch == 'Y'), stderr, reentrant);
  951. XX  }
  952. XX#endif
  953. XX  (void) fprintf (stderr, "aborting...\n");
  954. XX  (void) exit (1);
  955. XX}
  956. XX
  957. XXfp_data checkpoint (data)
  958. XXfp_data data;
  959. XX/* behaves the same as id, but outputs its data */
  960. XX{
  961. XX  static int asked = 0;
  962. XX  static int keepasking = 0;
  963. XX  struct stackframe * savestack;
  964. XX  static FILE * tty;
  965. XX  int ch;
  966. XX
  967. XX#ifndef NOCHECK
  968. XX  if (! asked)
  969. XX  {
  970. XX    asked = 1;
  971. XX    tty = fopen  ("/dev/tty", "r");
  972. XX    if (tty != 0)
  973. XX    {
  974. XX      (void) fprintf (stderr,
  975. XX           "do you wish to interact with the checkpoints (y/n)?\n");
  976. XX      ch = getonec (tty);
  977. XX      keepasking = ((ch == 'y') || (ch == 'Y'));
  978. XX    }
  979. XX  }
  980. XX#endif
  981. XX  (void) fprintf (stderr, "checkpoint encountered, input is\n");
  982. XX  printfpdata (stderr, data, 0);
  983. XX  (void) putc ('\n', stderr);
  984. XX#ifndef NOCHECK
  985. XX  if (keepasking)
  986. XX  {
  987. XX    (void) fprintf (stderr,
  988. XX"type y for stack dump, a to abort, space or new-line to continue\n");
  989. XX    ch = getonec (tty);
  990. XX    if ((ch == 'a') || (ch == 'A'))
  991. XX    {
  992. XX      (void) fprintf (stderr, "\naborting...\n");
  993. XX      (void) exit (1);
  994. XX    }
  995. XX    if ((ch == 'y') || (ch == 'Y'))
  996. XX    {
  997. XX      savestack = stack;
  998. XX      (void) fprintf (stderr, "interactive stack dump (y/n)?\n");
  999. XX      ch = getonec (tty);
  1000. XX      (void) fprintf (stderr, "dumping the relevant portions of the stack:\n");
  1001. XX      stackdump (tty, ((ch == 'y') || (ch == 'Y')), stderr, 0);
  1002. XX      stack = savestack;
  1003. XX    }
  1004. XX  }
  1005. XX#endif
  1006. XX  return (data);
  1007. XX}
  1008. XX
  1009. XXfp_data error (data)
  1010. XXfp_data data;
  1011. XX{
  1012. XX  genbottom ("error: ", data);
  1013. XX}
  1014. XX
  1015. XXfp_data tl (data)
  1016. XXfp_data data;
  1017. XX{
  1018. XX  register fp_data res;
  1019. XX
  1020. XX#ifdef DEBUG
  1021. XX  (void) fprintf (stderr, "entering tl, object is ");
  1022. XX  printfpdata (stderr, data, 0);
  1023. XX  (void) putc ('\n', stderr);
  1024. XX#endif
  1025. XX#ifndef NOCHECK
  1026. XX  if (data->fp_type != VECTOR)
  1027. XX    genbottom ("tl: data is not a vector", data);
  1028. XX#endif
  1029. XX  res = data->fp_header.fp_next;
  1030. XX  if (res == 0)
  1031. XX    res = & nilobj;
  1032. XX  else
  1033. XX    res->fp_ref += 1;
  1034. XX  dec_ref (data);
  1035. XX#ifdef DEBUG
  1036. XX  (void) fprintf (stderr, "exiting tl, result is ");
  1037. XX  printfpdata (stderr, res, 0);
  1038. XX  (void) putc ('\n', stderr);
  1039. XX#endif
  1040. XX  return (res);
  1041. XX}
  1042. XX
  1043. XXfp_data tlr (data)
  1044. XXfp_data data;
  1045. XX{
  1046. XX  register fp_data res, vector, prev, next;
  1047. XX
  1048. XX#ifdef DEBUG
  1049. XX  (void) fprintf (stderr, "entering tlr, object is ");
  1050. XX  printfpdata (stderr, data, 0);
  1051. XX  (void) putc ('\n', stderr);
  1052. XX#endif
  1053. XX#ifndef NOCHECK
  1054. XX  if (data->fp_type != VECTOR)
  1055. XX    genbottom ("tlr: data is not a vector", data);
  1056. XX#endif
  1057. XX  vector = data;
  1058. XX  if (vector->fp_header.fp_next == 0)
  1059. XX    res = fp_nil;
  1060. XX  else
  1061. XX  {
  1062. XX    prev = res = next = newcell ();
  1063. XX    next->fp_entry = vector->fp_entry;
  1064. XX    inc_ref (next->fp_entry);
  1065. XX    while ((vector = vector->fp_header.fp_next)->fp_header.fp_next != 0)
  1066. XX    {
  1067. XX      next = newcell ();
  1068. XX      next->fp_entry = vector->fp_entry;
  1069. XX      prev->fp_header.fp_next = next;
  1070. XX      prev = next;
  1071. XX      inc_ref (next->fp_entry);
  1072. XX    }
  1073. XX  }
  1074. XX  dec_ref (data);
  1075. XX#ifdef DEBUG
  1076. XX  (void) fprintf (stderr, "exiting tlr, result is ");
  1077. XX  printfpdata (stderr, res, 0);
  1078. XX  (void) putc ('\n', stderr);
  1079. XX#endif
  1080. XX  return (res);
  1081. XX}
  1082. XX
  1083. XXfp_data rotl (data)
  1084. XXfp_data data;
  1085. XX{
  1086. XX  register fp_data res, from, to;
  1087. XX  register long size;
  1088. XX
  1089. XX#ifdef DEBUG
  1090. XX  (void) fprintf (stderr, "entering rotl, object is ");
  1091. XX  printfpdata (stderr, data, 0);
  1092. XX  (void) putc ('\n', stderr);
  1093. XX#endif
  1094. XX#ifndef NOCHECK
  1095. XX  if (nonvector (data))
  1096. XX    genbottom ("rotl: data is not a vector or nil", data);
  1097. XX#endif
  1098. XX  res = data;
  1099. XX  if (data->fp_type != NILOBJ)
  1100. XX  {
  1101. XX    for (size = 0; res != 0; res = res->fp_header.fp_next)
  1102. XX      size++;
  1103. XX    res = newvect (size);
  1104. XX    from = data->fp_header.fp_next;
  1105. XX    to = res;
  1106. XX    while (from != 0)
  1107. XX    {
  1108. XX      to->fp_entry = from->fp_entry;
  1109. XX      inc_ref (to->fp_entry);
  1110. XX      to = to->fp_header.fp_next;
  1111. XX      from = from->fp_header.fp_next;
  1112. XX    }
  1113. XX    to->fp_entry = data->fp_entry;
  1114. XX    inc_ref (to->fp_entry);
  1115. XX    dec_ref (data);
  1116. XX  }
  1117. XX#ifdef DEBUG
  1118. XX  (void) fprintf (stderr, "exiting rotl, result is ");
  1119. XX  printfpdata (stderr, res, 0);
  1120. XX  (void) putc ('\n', stderr);
  1121. XX#endif
  1122. XX  return (res);
  1123. XX}
  1124. XX
  1125. XXfp_data rotr (data)
  1126. XXfp_data data;
  1127. XX{
  1128. XX  register fp_data res, from, to;
  1129. XX  register long size;
  1130. XX
  1131. XX#ifdef DEBUG
  1132. XX  (void) fprintf (stderr, "entering rotr, object is ");
  1133. XX  printfpdata (stderr, data, 0);
  1134. XX  (void) putc ('\n', stderr);
  1135. XX#endif
  1136. XX#ifndef NOCHECK
  1137. XX  if (nonvector (data))
  1138. XX    genbottom ("rotr: data is not a vector or nil", data);
  1139. XX#endif
  1140. XX  res = data;
  1141. XX  if (data->fp_type != NILOBJ)
  1142. XX  {
  1143. XX    for (size = 0; res != 0; res = res->fp_header.fp_next)
  1144. XX      size++;
  1145. XX    res = newvect (size);
  1146. XX    from = data;
  1147. XX    to = res->fp_header.fp_next;
  1148. XX    while (to != 0)
  1149. XX    {
  1150. XX      to->fp_entry = from->fp_entry;
  1151. XX      inc_ref (to->fp_entry);
  1152. XX      to = to->fp_header.fp_next;
  1153. XX      from = from->fp_header.fp_next;
  1154. XX    }
  1155. XX    res->fp_entry = from->fp_entry;
  1156. XX    inc_ref (res->fp_entry);
  1157. XX    dec_ref (data);
  1158. XX  }
  1159. XX#ifdef DEBUG
  1160. XX  (void) fprintf (stderr, "exiting rotr, result is ");
  1161. XX  printfpdata (stderr, res, 0);
  1162. XX  (void) putc ('\n', stderr);
  1163. XX#endif
  1164. XX  return (res);
  1165. XX}
  1166. XX
  1167. XXfp_data id (data)
  1168. XXfp_data data;
  1169. XX{
  1170. XX#ifdef DEBUG
  1171. XX  (void) fprintf (stderr, "entering id, object is ");
  1172. XX  printfpdata (stderr, data, 0);
  1173. XX  (void) putc ('\n', stderr);
  1174. XX#endif
  1175. XX#ifdef DEBUG
  1176. XX  (void) fprintf (stderr, "exiting id, result is ");
  1177. XX  printfpdata (stderr, data, 0);
  1178. XX  (void) putc ('\n', stderr);
  1179. XX#endif
  1180. XX  return (data);
  1181. XX}
  1182. XX
  1183. XXfp_data atom (data)
  1184. XXfp_data data;
  1185. XX{
  1186. XX  register fp_data res;
  1187. XX
  1188. XX#ifdef DEBUG
  1189. XX  (void) fprintf (stderr, "entering atom, object is ");
  1190. XX  printfpdata (stderr, data, 0);
  1191. XX  (void) putc ('\n', stderr);
  1192. XX#endif
  1193. XX  if (data->fp_type != VECTOR)
  1194. XX    res = (fp_true);
  1195. XX  else
  1196. XX    res = (fp_false);
  1197. XX  dec_ref (data);
  1198. XX#ifdef DEBUG
  1199. XX  (void) fprintf (stderr, "exiting atom, result is ");
  1200. XX  printfpdata (stderr, res, 0);
  1201. XX  (void) putc ('\n', stderr);
  1202. XX#endif
  1203. XX  return (res);
  1204. XX}
  1205. XX
  1206. XXfp_data reverse (data)
  1207. XXfp_data data;
  1208. XX{
  1209. XX  register fp_data res, saveres, vector;
  1210. XX
  1211. XX#ifdef DEBUG
  1212. XX  (void) fprintf (stderr, "entering reverse, object is ");
  1213. XX  printfpdata (stderr, data, 0);
  1214. XX  (void) putc ('\n', stderr);
  1215. XX#endif
  1216. XX#ifndef NOCHECK
  1217. XX  if (nonvector (data))
  1218. XX    genbottom ("reverse: data is not a vector or nil", data);
  1219. XX#endif
  1220. XX  if (data->fp_type == NILOBJ)
  1221. XX    res = data;
  1222. XX  else
  1223. XX  {
  1224. XX    vector = data;
  1225. XX    res = 0;
  1226. XX    while (vector != 0)
  1227. XX    {
  1228. XX      saveres = res;
  1229. XX      res = newcell ();
  1230. XX      res->fp_header.fp_next = saveres;
  1231. XX      res->fp_entry = vector->fp_entry;
  1232. XX      inc_ref (res->fp_entry);
  1233. XX      vector = vector->fp_header.fp_next;
  1234. XX    }
  1235. XX    dec_ref (data);
  1236. XX  }
  1237. XX#ifdef DEBUG
  1238. XX  (void) fprintf (stderr, "exiting reverse, result is ");
  1239. XX  printfpdata (stderr, res, 0);
  1240. XX  (void) putc ('\n', stderr);
  1241. XX#endif
  1242. XX  return (res);
  1243. XX}
  1244. XX
  1245. XXfp_data distl (data)
  1246. XXfp_data data;
  1247. XX{
  1248. XX  register fp_data obj, vector, res, newobjs, prev, next;
  1249. XX
  1250. XX#ifdef DEBUG
  1251. XX  (void) fprintf (stderr, "entering distl, object is ");
  1252. XX  printfpdata (stderr, data, 0);
  1253. XX  (void) putc ('\n', stderr);
  1254. XX#endif
  1255. XX#ifndef NOCHECK
  1256. XX  if (data->fp_type != VECTOR)
  1257. XX    genbottom ("distl: input is not a vector", data);
  1258. XX  if ((data->fp_header.fp_next == 0) ||
  1259. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  1260. XX    genbottom ("distl: input is not a 2-element vector", data);
  1261. XX#endif
  1262. XX  obj = data->fp_entry;
  1263. XX  vector = data->fp_header.fp_next->fp_entry;
  1264. XX#ifndef NOCHECK
  1265. XX  if (nonvector (vector))
  1266. XX    genbottom ("distl: 2nd element is not a vector or nil", data);
  1267. XX#endif
  1268. XX  res = vector;
  1269. XX  if (vector->fp_type != NILOBJ)
  1270. XX  {
  1271. XX    res = next = newcell ();
  1272. XX    newobjs = newpair ();
  1273. XX    newobjs->fp_entry = obj;
  1274. XX    inc_ref (obj);
  1275. XX    newobjs->fp_header.fp_next->fp_entry = vector->fp_entry;
  1276. XX    inc_ref (vector->fp_entry);
  1277. XX    next->fp_entry = newobjs;
  1278. XX    while ((vector = vector->fp_header.fp_next) != 0)
  1279. XX    {
  1280. XX      prev = next;
  1281. XX      next = newcell ();
  1282. XX      newobjs = newpair ();
  1283. XX      newobjs->fp_entry = obj;
  1284. XX      inc_ref (obj);
  1285. XX      newobjs->fp_header.fp_next->fp_entry = vector->fp_entry;
  1286. XX      inc_ref (vector->fp_entry);
  1287. XX      next->fp_entry = newobjs;
  1288. XX      prev->fp_header.fp_next = next;
  1289. XX    }
  1290. XX  }
  1291. XX  dec_ref (data);
  1292. XX#ifdef DEBUG
  1293. XX  (void) fprintf (stderr, "exiting distl, result is ");
  1294. XX  printfpdata (stderr, res, 0);
  1295. XX  (void) putc ('\n', stderr);
  1296. XX#endif
  1297. XX  return (res);
  1298. XX}
  1299. XX
  1300. XXfp_data distr (data)
  1301. XXfp_data data;
  1302. XX{
  1303. XX  register fp_data obj, vector, res, newobjs, prev, next;
  1304. XX
  1305. XX#ifdef DEBUG
  1306. XX  (void) fprintf (stderr, "entering distr, object is ");
  1307. XX  printfpdata (stderr, data, 0);
  1308. XX  (void) putc ('\n', stderr);
  1309. XX#endif
  1310. XX#ifndef NOCHECK
  1311. XX  if (data->fp_type != VECTOR)
  1312. XX    genbottom ("distr: input is not a vector", data);
  1313. XX  if ((data->fp_header.fp_next == 0) ||
  1314. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  1315. XX    genbottom ("distr: input is not a 2-element vector", data);
  1316. XX#endif
  1317. XX  vector = data->fp_entry;
  1318. XX  obj = data->fp_header.fp_next->fp_entry;
  1319. XX#ifndef NOCHECK
  1320. XX  if (nonvector (vector))
  1321. XX    genbottom ("distr: 1st element is not a vector or nil", data);
  1322. XX#endif
  1323. XX  res = vector;    /* so it's correct if vector == nil */
  1324. XX  if (vector->fp_type != NILOBJ)
  1325. XX  {
  1326. XX    res = next = newcell ();
  1327. XX    newobjs = newpair ();
  1328. XX    newobjs->fp_header.fp_next->fp_entry = obj;
  1329. XX    inc_ref (obj);
  1330. XX    newobjs->fp_entry = vector->fp_entry;
  1331. XX    inc_ref (vector->fp_entry);
  1332. XX    next->fp_entry = newobjs;
  1333. XX    while ((vector = vector->fp_header.fp_next) != 0)
  1334. XX    {
  1335. XX      prev = next;
  1336. XX      next = newcell ();
  1337. XX      newobjs = newpair ();
  1338. XX      newobjs->fp_header.fp_next->fp_entry = obj;
  1339. XX      inc_ref (obj);
  1340. XX      newobjs->fp_entry = vector->fp_entry;
  1341. XX      inc_ref (vector->fp_entry);
  1342. XX      next->fp_entry = newobjs;
  1343. XX      prev->fp_header.fp_next = next;
  1344. XX    }
  1345. XX  }
  1346. XX  dec_ref (data);
  1347. XX#ifdef DEBUG
  1348. XX  (void) fprintf (stderr, "exiting distr, result is ");
  1349. XX  printfpdata (stderr, res, 0);
  1350. XX  (void) putc ('\n', stderr);
  1351. XX#endif
  1352. XX  return (res);
  1353. XX}
  1354. XX
  1355. XXfp_data apndl (data)
  1356. XXfp_data data;
  1357. XX{
  1358. XX  register fp_data vector, el, res;
  1359. XX
  1360. XX#ifdef DEBUG
  1361. XX  (void) fprintf (stderr, "entering apndl, object is ");
  1362. XX  printfpdata (stderr, data, 0);
  1363. XX  (void) putc ('\n', stderr);
  1364. XX#endif
  1365. XX#ifndef NOCHECK
  1366. XX  if (data->fp_type != VECTOR)
  1367. XX    genbottom ("apndl: input is not a vector", data);
  1368. XX  if ((data->fp_header.fp_next == 0) ||
  1369. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  1370. XX    genbottom ("apndl: input is not a 2-element vector", data);
  1371. XX#endif
  1372. XX  el = data->fp_entry;
  1373. XX  vector = data->fp_header.fp_next->fp_entry;
  1374. XX#ifndef NOCHECK
  1375. XX  if (nonvector (vector))
  1376. XX    genbottom ("apndl: 2nd element is not a vector or nil", data);
  1377. XX#endif
  1378. XX  if (vector->fp_type != VECTOR)        /* nil? */
  1379. XX    vector = 0;
  1380. XX  else
  1381. XX    inc_ref (vector);
  1382. XX  res = newcell ();
  1383. XX  res->fp_entry = el;
  1384. XX  inc_ref (el);
  1385. XX  res->fp_header.fp_next = vector;
  1386. XX  dec_ref (data);
  1387. XX#ifdef DEBUG
  1388. XX  (void) fprintf (stderr, "exiting apndl, result is ");
  1389. XX  printfpdata (stderr, res, 0);
  1390. XX  (void) putc ('\n', stderr);
  1391. XX#endif
  1392. XX  return (res);
  1393. XX}
  1394. SHAR_EOF
  1395. if test 32154 -ne "`wc -c fp.c.part1`"
  1396. then
  1397. echo shar: error transmitting fp.c.part1 '(should have been 32154 characters)'
  1398. fi
  1399. echo shar: extracting lex.yy.c '(12642 characters)'
  1400. sed 's/^XX//' << \SHAR_EOF > lex.yy.c
  1401. XX# include "stdio.h"
  1402. XX# define U(x) x
  1403. XX# define NLSTATE yyprevious=YYNEWLINE
  1404. XX# define BEGIN yybgin = yysvec + 1 +
  1405. XX# define INITIAL 0
  1406. XX# define YYLERR yysvec
  1407. XX# define YYSTATE (yyestate-yysvec-1)
  1408. XX# define YYOPTIM 1
  1409. XX# define YYLMAX 200
  1410. XX# define output(c) (void) putc(c,yyout)
  1411. XX# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
  1412. XX# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
  1413. XX# define yymore() (yymorfg=1)
  1414. XX# define ECHO (void) fprintf(yyout, "%s",yytext)
  1415. XX# define REJECT { nstr = yyreject(); goto yyfussy;}
  1416. XXint yyleng; extern char yytext[];
  1417. XXint yymorfg;
  1418. XXextern char *yysptr, yysbuf[];
  1419. XXint yytchar;
  1420. XXFILE *yyin ={stdin}, *yyout ={stdout};
  1421. XXextern int yylineno;
  1422. XXstruct yysvf { 
  1423. XX    struct yywork *yystoff;
  1424. XX    struct yysvf *yyother;
  1425. XX    int *yystops;};
  1426. XXstruct yysvf *yyestate;
  1427. XXextern struct yysvf yysvec[], *yybgin;
  1428. XX# define YYNEWLINE 10
  1429. XXyylex(){
  1430. XXint nstr; extern int yyprevious;
  1431. XXwhile((nstr = yylook()) >= 0)
  1432. XXyyfussy: switch(nstr){
  1433. XXcase 0:
  1434. XXif(yywrap()) return(0); break;
  1435. XXcase 1:
  1436. XX    { return (Def); }
  1437. XXbreak;
  1438. XXcase 2:
  1439. XX    { return (Then); }
  1440. XXbreak;
  1441. XXcase 3:
  1442. XX    { return (Else); }
  1443. XXbreak;
  1444. XXcase 4:
  1445. XX    { return (Compose); }
  1446. XXbreak;
  1447. XXcase 5:
  1448. XX    { return (Alpha); }
  1449. XXbreak;
  1450. XXcase 6:
  1451. XX    { return (Tree); }
  1452. XXbreak;
  1453. XXcase 7:
  1454. XX    { return (Insert); }
  1455. XXbreak;
  1456. XXcase 8:
  1457. XX    { return (Rinsert); }
  1458. XXbreak;
  1459. XXcase 9:
  1460. XX    { return (','); }
  1461. XXbreak;
  1462. XXcase 10:
  1463. XX    { return ('['); }
  1464. XXbreak;
  1465. XXcase 11:
  1466. XX    { return (']'); }
  1467. XXbreak;
  1468. XXcase 12:
  1469. XX    { return ('('); }
  1470. XXbreak;
  1471. XXcase 13:
  1472. XX    { return (')'); }
  1473. XXbreak;
  1474. XXcase 14:
  1475. XX    { return ('<'); }
  1476. XXbreak;
  1477. XXcase 15:
  1478. XX    { return ('>'); }
  1479. XXbreak;
  1480. XXcase 16:
  1481. XX    { return ('_'); }
  1482. XXbreak;
  1483. XXcase 17:
  1484. XX    { return (Bu); }
  1485. XXbreak;
  1486. XXcase 18:
  1487. XX    { return (Bur); }
  1488. XXbreak;
  1489. XXcase 19:
  1490. XX    { return (While); }
  1491. XXbreak;
  1492. XXcase 20:
  1493. XX    { return ('+'); }
  1494. XXbreak;
  1495. XXcase 21:
  1496. XX    { return ('*'); }
  1497. XXbreak;
  1498. XXcase 22:
  1499. XX    { return (Div); }
  1500. XXbreak;
  1501. XXcase 23:
  1502. XX    { return ('='); }
  1503. XXbreak;
  1504. XXcase 24:
  1505. XX    { return (Leq); }
  1506. XXbreak;
  1507. XXcase 25:
  1508. XX    { return (Geq); }
  1509. XXbreak;
  1510. XXcase 26:
  1511. XX    { return (Noteq); }
  1512. XXbreak;
  1513. XXcase 27:
  1514. XX    { return (TrueConst); }
  1515. XXbreak;
  1516. XXcase 28:
  1517. XX    { return (FalseConst); }
  1518. XXbreak;
  1519. XXcase 29:
  1520. XX{ return (Symbol); }
  1521. XXbreak;
  1522. XXcase 30:
  1523. XX    { return (Rsel); }
  1524. XXbreak;
  1525. XXcase 31:
  1526. XX{ return (Float); }
  1527. XXbreak;
  1528. XXcase 32:
  1529. XX{ return (Float); }
  1530. XXbreak;
  1531. XXcase 33:
  1532. XX{ return (Sel); }
  1533. XXbreak;
  1534. XXcase 34:
  1535. XX    { return (Sel); }
  1536. XXbreak;
  1537. XXcase 35:
  1538. XX    { return ('-'); }
  1539. XXbreak;
  1540. XXcase 36:
  1541. XX{ return (String); }
  1542. XXbreak;
  1543. XXcase 37:
  1544. XX    { return (CharConst); }
  1545. XXbreak;
  1546. XXcase 38:
  1547. XX    { return (CharConst); }
  1548. XXbreak;
  1549. XXcase 39:
  1550. XX{ set_line (yytext); }
  1551. XXbreak;
  1552. XXcase 40:
  1553. XX    { inc_line (); }
  1554. XXbreak;
  1555. XXcase 41:
  1556. XX    { inc_line (); }
  1557. XXbreak;
  1558. XXcase 42:
  1559. XX    ;
  1560. XXbreak;
  1561. XXcase -1:
  1562. XXbreak;
  1563. XXdefault:
  1564. XX(void) fprintf(yyout,"bad switch yylook %d",nstr);
  1565. XX} return(0); }
  1566. XX/* end of yylex */
  1567. XXint yyvstop[] ={
  1568. XX0,
  1569. XX
  1570. XX42,
  1571. XX0,
  1572. XX
  1573. XX41,
  1574. XX0,
  1575. XX
  1576. XX42,
  1577. XX0,
  1578. XX
  1579. XX42,
  1580. XX0,
  1581. XX
  1582. XX42,
  1583. XX0,
  1584. XX
  1585. XX42,
  1586. XX0,
  1587. XX
  1588. XX12,
  1589. XX42,
  1590. XX0,
  1591. XX
  1592. XX13,
  1593. XX42,
  1594. XX0,
  1595. XX
  1596. XX21,
  1597. XX42,
  1598. XX0,
  1599. XX
  1600. XX20,
  1601. XX42,
  1602. XX0,
  1603. XX
  1604. XX9,
  1605. XX42,
  1606. XX0,
  1607. XX
  1608. XX35,
  1609. XX42,
  1610. XX0,
  1611. XX
  1612. XX7,
  1613. XX42,
  1614. XX0,
  1615. XX
  1616. XX34,
  1617. XX42,
  1618. XX0,
  1619. XX
  1620. XX3,
  1621. XX42,
  1622. XX0,
  1623. XX
  1624. XX14,
  1625. XX42,
  1626. XX0,
  1627. XX
  1628. XX23,
  1629. XX42,
  1630. XX0,
  1631. XX
  1632. XX15,
  1633. XX42,
  1634. XX0,
  1635. XX
  1636. XX29,
  1637. XX42,
  1638. XX0,
  1639. XX
  1640. XX29,
  1641. XX42,
  1642. XX0,
  1643. XX
  1644. XX28,
  1645. XX29,
  1646. XX42,
  1647. XX0,
  1648. XX
  1649. XX27,
  1650. XX29,
  1651. XX42,
  1652. XX0,
  1653. XX
  1654. XX10,
  1655. XX42,
  1656. XX0,
  1657. XX
  1658. XX8,
  1659. XX42,
  1660. XX0,
  1661. XX
  1662. XX11,
  1663. XX42,
  1664. XX0,
  1665. XX
  1666. XX16,
  1667. XX42,
  1668. XX0,
  1669. XX
  1670. XX29,
  1671. XX42,
  1672. XX0,
  1673. XX
  1674. XX29,
  1675. XX42,
  1676. XX0,
  1677. XX
  1678. XX29,
  1679. XX42,
  1680. XX0,
  1681. XX
  1682. XX4,
  1683. XX29,
  1684. XX42,
  1685. XX0,
  1686. XX
  1687. XX29,
  1688. XX42,
  1689. XX0,
  1690. XX
  1691. XX42,
  1692. XX0,
  1693. XX
  1694. XX26,
  1695. XX0,
  1696. XX
  1697. XX36,
  1698. XX0,
  1699. XX
  1700. XX40,
  1701. XX0,
  1702. XX
  1703. XX38,
  1704. XX0,
  1705. XX
  1706. XX38,
  1707. XX0,
  1708. XX
  1709. XX33,
  1710. XX0,
  1711. XX
  1712. XX2,
  1713. XX0,
  1714. XX
  1715. XX32,
  1716. XX0,
  1717. XX
  1718. XX34,
  1719. XX0,
  1720. XX
  1721. XX30,
  1722. XX0,
  1723. XX
  1724. XX24,
  1725. XX0,
  1726. XX
  1727. XX25,
  1728. XX0,
  1729. XX
  1730. XX29,
  1731. XX0,
  1732. XX
  1733. XX29,
  1734. XX0,
  1735. XX
  1736. XX6,
  1737. XX0,
  1738. XX
  1739. XX5,
  1740. XX29,
  1741. XX0,
  1742. XX
  1743. XX17,
  1744. XX29,
  1745. XX0,
  1746. XX
  1747. XX29,
  1748. XX0,
  1749. XX
  1750. XX29,
  1751. XX0,
  1752. XX
  1753. XX37,
  1754. XX0,
  1755. XX
  1756. XX31,
  1757. XX0,
  1758. XX
  1759. XX1,
  1760. XX29,
  1761. XX0,
  1762. XX
  1763. XX18,
  1764. XX29,
  1765. XX0,
  1766. XX
  1767. XX22,
  1768. XX29,
  1769. XX0,
  1770. XX
  1771. XX29,
  1772. XX0,
  1773. XX
  1774. XX29,
  1775. XX0,
  1776. XX
  1777. XX19,
  1778. XX29,
  1779. XX0,
  1780. XX
  1781. XX39,
  1782. XX0,
  1783. XX0};
  1784. XX# define YYTYPE char
  1785. XXstruct yywork { YYTYPE verify, advance; } yycrank[] ={
  1786. XX0,0,    0,0,    1,3,    0,0,    
  1787. XX6,36,    0,0,    7,38,    0,0,    
  1788. XX0,0,    0,0,    0,0,    1,4,    
  1789. XX0,0,    6,36,    0,0,    7,39,    
  1790. XX0,0,    0,0,    0,0,    0,0,    
  1791. XX0,0,    0,0,    0,0,    0,0,    
  1792. XX0,0,    0,0,    0,0,    0,0,    
  1793. XX0,0,    0,0,    0,0,    0,0,    
  1794. XX0,0,    34,56,    1,5,    1,6,    
  1795. XX1,7,    6,37,    63,65,    7,38,    
  1796. XX1,8,    1,9,    1,10,    1,11,    
  1797. XX1,12,    1,13,    1,14,    65,67,    
  1798. XX1,15,    1,16,    26,51,    6,36,    
  1799. XX56,63,    7,38,    63,63,    0,0,    
  1800. XX0,0,    0,0,    8,40,    0,0,    
  1801. XX1,17,    1,18,    1,19,    1,20,    
  1802. XX5,35,    18,47,    1,21,    8,0,    
  1803. XX6,36,    1,22,    7,38,    1,23,    
  1804. XX14,42,    14,42,    14,42,    14,42,    
  1805. XX14,42,    14,42,    14,42,    14,42,    
  1806. XX14,42,    14,42,    20,48,    0,0,    
  1807. XX0,0,    1,24,    14,43,    0,0,    
  1808. XX0,0,    0,0,    0,0,    8,40,    
  1809. XX1,25,    1,26,    1,27,    0,0,    
  1810. XX1,28,    0,0,    1,29,    1,30,    
  1811. XX29,52,    1,31,    22,50,    50,59,    
  1812. XX64,66,    8,40,    31,54,    2,5,    
  1813. XX33,55,    2,34,    55,62,    62,64,    
  1814. XX1,32,    2,8,    2,9,    2,10,    
  1815. XX2,11,    2,12,    2,13,    2,14,    
  1816. XX1,33,    2,15,    8,40,    30,53,    
  1817. XX53,60,    54,61,    0,0,    0,0,    
  1818. XX0,0,    0,0,    0,0,    0,0,    
  1819. XX0,0,    2,17,    2,18,    2,19,    
  1820. XX2,20,    0,0,    0,0,    0,0,    
  1821. XX0,0,    0,0,    2,22,    0,0,    
  1822. XX2,23,    0,0,    0,0,    0,0,    
  1823. XX0,0,    8,41,    0,0,    0,0,    
  1824. XX0,0,    0,0,    0,0,    0,0,    
  1825. XX0,0,    0,0,    2,24,    0,0,    
  1826. XX0,0,    0,0,    0,0,    0,0,    
  1827. XX0,0,    2,25,    2,26,    2,27,    
  1828. XX0,0,    2,28,    0,0,    2,29,    
  1829. XX2,30,    16,44,    2,31,    16,45,    
  1830. XX16,45,    16,45,    16,45,    16,45,    
  1831. XX16,45,    16,45,    16,45,    16,45,    
  1832. XX16,45,    2,32,    0,0,    0,0,    
  1833. XX0,0,    0,0,    0,0,    0,0,    
  1834. XX0,0,    2,33,    21,49,    21,49,    
  1835. XX21,49,    21,49,    21,49,    21,49,    
  1836. XX21,49,    21,49,    21,49,    21,49,    
  1837. XX0,0,    0,0,    0,0,    0,0,    
  1838. XX0,0,    0,0,    0,0,    21,49,    
  1839. XX21,49,    21,49,    21,49,    21,49,    
  1840. XX21,49,    21,49,    21,49,    21,49,    
  1841. XX21,49,    21,49,    21,49,    21,49,    
  1842. XX21,49,    21,49,    21,49,    21,49,    
  1843. XX21,49,    21,49,    21,49,    21,49,    
  1844. XX21,49,    21,49,    21,49,    21,49,    
  1845. XX21,49,    0,0,    0,0,    0,0,    
  1846. XX0,0,    16,46,    0,0,    21,49,    
  1847. XX21,49,    21,49,    21,49,    21,49,    
  1848. XX21,49,    21,49,    21,49,    21,49,    
  1849. XX21,49,    21,49,    21,49,    21,49,    
  1850. XX21,49,    21,49,    21,49,    21,49,    
  1851. XX21,49,    21,49,    21,49,    21,49,    
  1852. XX21,49,    21,49,    21,49,    21,49,    
  1853. XX21,49,    41,57,    0,0,    0,0,    
  1854. XX0,0,    0,0,    0,0,    0,0,    
  1855. XX0,0,    42,58,    41,0,    42,42,    
  1856. XX42,42,    42,42,    42,42,    42,42,    
  1857. XX42,42,    42,42,    42,42,    42,42,    
  1858. XX42,42,    44,44,    44,44,    44,44,    
  1859. XX44,44,    44,44,    44,44,    44,44,    
  1860. XX44,44,    44,44,    44,44,    67,67,    
  1861. XX0,0,    68,67,    41,57,    58,58,    
  1862. XX58,58,    58,58,    58,58,    58,58,    
  1863. XX58,58,    58,58,    58,58,    58,58,    
  1864. XX58,58,    0,0,    0,0,    0,0,    
  1865. XX41,57,    0,0,    0,0,    0,0,    
  1866. XX0,0,    0,0,    0,0,    0,0,    
  1867. XX0,0,    0,0,    0,0,    0,0,    
  1868. XX0,0,    0,0,    0,0,    0,0,    
  1869. XX67,68,    41,57,    68,68,    0,0,    
  1870. XX0,0,    0,0,    0,0,    0,0,    
  1871. XX0,0,    0,0,    0,0,    0,0,    
  1872. XX0,0,    0,0,    67,67,    0,0,    
  1873. XX68,67,    0,0,    0,0,    0,0,    
  1874. XX0,0,    0,0,    0,0,    0,0,    
  1875. XX0,0,    0,0,    0,0,    0,0,    
  1876. XX0,0,    0,0,    0,0,    67,67,    
  1877. XX0,0,    68,67,    0,0,    0,0,    
  1878. XX0,0};
  1879. XXstruct yysvf yysvec[] ={
  1880. XX0,    0,    0,
  1881. XXyycrank+-1,    0,        0,    
  1882. XXyycrank+-74,    yysvec+1,    0,    
  1883. XXyycrank+0,    0,        yyvstop+1,
  1884. XXyycrank+0,    0,        yyvstop+3,
  1885. XXyycrank+3,    0,        yyvstop+5,
  1886. XXyycrank+-3,    0,        yyvstop+7,
  1887. XXyycrank+-5,    0,        yyvstop+9,
  1888. XXyycrank+-57,    0,        yyvstop+11,
  1889. XXyycrank+0,    0,        yyvstop+13,
  1890. XXyycrank+0,    0,        yyvstop+16,
  1891. XXyycrank+0,    0,        yyvstop+19,
  1892. XXyycrank+0,    0,        yyvstop+22,
  1893. XXyycrank+0,    0,        yyvstop+25,
  1894. XXyycrank+24,    0,        yyvstop+28,
  1895. XXyycrank+0,    0,        yyvstop+31,
  1896. XXyycrank+127,    0,        yyvstop+34,
  1897. XXyycrank+0,    0,        yyvstop+37,
  1898. XXyycrank+4,    0,        yyvstop+40,
  1899. XXyycrank+0,    0,        yyvstop+43,
  1900. XXyycrank+21,    0,        yyvstop+46,
  1901. XXyycrank+146,    0,        yyvstop+49,
  1902. XXyycrank+1,    yysvec+21,    yyvstop+52,
  1903. XXyycrank+0,    yysvec+21,    yyvstop+55,
  1904. XXyycrank+0,    yysvec+21,    yyvstop+59,
  1905. XXyycrank+0,    0,        yyvstop+63,
  1906. XXyycrank+3,    0,        yyvstop+66,
  1907. XXyycrank+0,    0,        yyvstop+69,
  1908. XXyycrank+0,    0,        yyvstop+72,
  1909. XXyycrank+3,    yysvec+21,    yyvstop+75,
  1910. XXyycrank+6,    yysvec+21,    yyvstop+78,
  1911. XXyycrank+1,    yysvec+21,    yyvstop+81,
  1912. XXyycrank+0,    yysvec+21,    yyvstop+84,
  1913. XXyycrank+4,    yysvec+21,    yyvstop+88,
  1914. XXyycrank+-1,    yysvec+7,    yyvstop+91,
  1915. XXyycrank+0,    0,        yyvstop+93,
  1916. XXyycrank+0,    yysvec+6,    0,    
  1917. XXyycrank+0,    0,        yyvstop+95,
  1918. XXyycrank+0,    yysvec+7,    0,    
  1919. XXyycrank+0,    0,        yyvstop+97,
  1920. XXyycrank+0,    0,        yyvstop+99,
  1921. XXyycrank+-268,    0,        yyvstop+101,
  1922. XXyycrank+231,    0,        yyvstop+103,
  1923. XXyycrank+0,    0,        yyvstop+105,
  1924. XXyycrank+241,    0,        yyvstop+107,
  1925. XXyycrank+0,    yysvec+16,    yyvstop+109,
  1926. XXyycrank+0,    0,        yyvstop+111,
  1927. XXyycrank+0,    0,        yyvstop+113,
  1928. XXyycrank+0,    0,        yyvstop+115,
  1929. XXyycrank+0,    yysvec+21,    yyvstop+117,
  1930. XXyycrank+1,    yysvec+21,    yyvstop+119,
  1931. XXyycrank+0,    0,        yyvstop+121,
  1932. XXyycrank+0,    yysvec+21,    yyvstop+123,
  1933. XXyycrank+10,    yysvec+21,    yyvstop+126,
  1934. XXyycrank+7,    yysvec+21,    yyvstop+129,
  1935. XXyycrank+5,    yysvec+21,    yyvstop+131,
  1936. XXyycrank+-4,    yysvec+7,    0,    
  1937. XXyycrank+0,    0,        yyvstop+133,
  1938. XXyycrank+255,    0,        yyvstop+135,
  1939. XXyycrank+0,    yysvec+21,    yyvstop+137,
  1940. XXyycrank+0,    yysvec+21,    yyvstop+140,
  1941. XXyycrank+0,    yysvec+21,    yyvstop+143,
  1942. XXyycrank+3,    yysvec+21,    yyvstop+146,
  1943. XXyycrank+-6,    yysvec+7,    0,    
  1944. XXyycrank+3,    yysvec+21,    yyvstop+148,
  1945. XXyycrank+-13,    yysvec+7,    0,    
  1946. XXyycrank+0,    yysvec+21,    yyvstop+150,
  1947. XXyycrank+-298,    yysvec+7,    0,    
  1948. XXyycrank+-300,    yysvec+7,    yyvstop+153,
  1949. XX0,    0,    0};
  1950. XXstruct yywork *yytop = yycrank+365;
  1951. XXstruct yysvf *yybgin = yysvec+1;
  1952. XXchar yymatch[] ={
  1953. XX00  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1954. XX01  ,01  ,012 ,01  ,01  ,01  ,01  ,01  ,
  1955. XX01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1956. XX01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1957. XX01  ,01  ,'"' ,01  ,01  ,01  ,01  ,01  ,
  1958. XX01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1959. XX'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
  1960. XX'0' ,'0' ,01  ,01  ,01  ,01  ,01  ,01  ,
  1961. XX01  ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1962. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1963. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1964. XX'A' ,'A' ,'A' ,01  ,01  ,01  ,01  ,01  ,
  1965. XX01  ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1966. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1967. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1968. XX'A' ,'A' ,'A' ,01  ,01  ,01  ,01  ,01  ,
  1969. XX0};
  1970. XXchar yyextra[] ={
  1971. XX0,0,0,0,0,0,0,0,
  1972. XX0,0,0,0,0,0,0,0,
  1973. XX0,0,0,0,0,0,0,0,
  1974. XX0,0,0,0,0,0,0,0,
  1975. XX0,0,0,0,0,0,0,0,
  1976. XX0,0,0,0,0,0,0,0,
  1977. XX0};
  1978. XX/*    ncform    4.1    83/08/11    */
  1979. XX
  1980. XXint yylineno =1;
  1981. XX# define YYU(x) x
  1982. XX# define NLSTATE yyprevious=YYNEWLINE
  1983. XXchar yytext[YYLMAX];
  1984. XXstruct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
  1985. XXchar yysbuf[YYLMAX];
  1986. XXchar *yysptr = yysbuf;
  1987. XXint *yyfnd;
  1988. XXextern struct yysvf *yyestate;
  1989. XXint yyprevious = YYNEWLINE;
  1990. XXyylook(){
  1991. XX    register struct yysvf *yystate, **lsp;
  1992. XX    register struct yywork *yyt;
  1993. XX    struct yysvf *yyz;
  1994. XX    int yych;
  1995. XX    struct yywork *yyr;
  1996. XX# ifdef LEXDEBUG
  1997. XX    int debug;
  1998. XX# endif
  1999. XX    char *yylastch;
  2000. XX    /* start off machines */
  2001. XX# ifdef LEXDEBUG
  2002. XX    debug = 0;
  2003. XX# endif
  2004. XX    if (!yymorfg)
  2005. XX        yylastch = yytext;
  2006. XX    else {
  2007. XX        yymorfg=0;
  2008. XX        yylastch = yytext+yyleng;
  2009. XX        }
  2010. XX    for(;;){
  2011. XX        lsp = yylstate;
  2012. XX        yyestate = yystate = yybgin;
  2013. XX        if (yyprevious==YYNEWLINE) yystate++;
  2014. XX        for (;;){
  2015. XX# ifdef LEXDEBUG
  2016. XX            if(debug)(void) fprintf(yyout,"state %d\n",yystate-yysvec-1);
  2017. XX# endif
  2018. XX            yyt = yystate->yystoff;
  2019. XX            if(yyt == yycrank){        /* may not be any transitions */
  2020. XX                yyz = yystate->yyother;
  2021. XX                if(yyz == 0)break;
  2022. XX                if(yyz->yystoff == yycrank)break;
  2023. XX                }
  2024. XX            *yylastch++ = yych = input();
  2025. XX        tryagain:
  2026. XX# ifdef LEXDEBUG
  2027. XX            if(debug){
  2028. XX                (void) fprintf(yyout,"char ");
  2029. XX                allprint(yych);
  2030. XX                (void) putchar('\n');
  2031. XX                }
  2032. XX# endif
  2033. XX            yyr = yyt;
  2034. XX            if ( (int)yyt > (int)yycrank){
  2035. XX                yyt = yyr + yych;
  2036. XX                if (yyt <= yytop && yyt->verify+yysvec == yystate){
  2037. XX                    if(yyt->advance+yysvec == YYLERR)    /* error transitions */
  2038. XX                        {unput(*--yylastch);break;}
  2039. XX                    *lsp++ = yystate = yyt->advance+yysvec;
  2040. XX                    goto contin;
  2041. XX                    }
  2042. XX                }
  2043. XX# ifdef YYOPTIM
  2044. XX            else if((int)yyt < (int)yycrank) {        /* r < yycrank */
  2045. XX                yyt = yyr = yycrank+(yycrank-yyt);
  2046. XX# ifdef LEXDEBUG
  2047. XX                if(debug)(void) fprintf(yyout,"compressed state\n");
  2048. XX# endif
  2049. XX                yyt = yyt + yych;
  2050. XX                if(yyt <= yytop && yyt->verify+yysvec == yystate){
  2051. XX                    if(yyt->advance+yysvec == YYLERR)    /* error transitions */
  2052. XX                        {unput(*--yylastch);break;}
  2053. XX                    *lsp++ = yystate = yyt->advance+yysvec;
  2054. XX                    goto contin;
  2055. XX                    }
  2056. XX                yyt = yyr + YYU(yymatch[yych]);
  2057. XX# ifdef LEXDEBUG
  2058. XX                if(debug){
  2059. XX                    (void) fprintf(yyout,"try fall back character ");
  2060. XX                    allprint(YYU(yymatch[yych]));
  2061. XX                    (void) putchar('\n');
  2062. XX                    }
  2063. XX# endif
  2064. XX                if(yyt <= yytop && yyt->verify+yysvec == yystate){
  2065. XX                    if(yyt->advance+yysvec == YYLERR)    /* error transition */
  2066. XX                        {unput(*--yylastch);break;}
  2067. XX                    *lsp++ = yystate = yyt->advance+yysvec;
  2068. XX                    goto contin;
  2069. XX                    }
  2070. XX                }
  2071. XX            if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
  2072. XX# ifdef LEXDEBUG
  2073. XX                if(debug)(void) fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
  2074. XX# endif
  2075. XX                goto tryagain;
  2076. XX                }
  2077. XX# endif
  2078. XX            else
  2079. XX                {unput(*--yylastch);break;}
  2080. XX        contin:
  2081. XX# ifdef LEXDEBUG
  2082. XX            if(debug){
  2083. XX                (void) fprintf(yyout,"state %d char ",yystate-yysvec-1);
  2084. XX                allprint(yych);
  2085. XX                (void) putchar('\n');
  2086. XX                }
  2087. XX# endif
  2088. XX            ;
  2089. XX            }
  2090. XX# ifdef LEXDEBUG
  2091. XX        if(debug){
  2092. XX            (void) fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
  2093. XX            allprint(yych);
  2094. XX            (void) putchar('\n');
  2095. XX            }
  2096. XX# endif
  2097. XX        while (lsp-- > yylstate){
  2098. XX            *yylastch-- = 0;
  2099. XX            if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
  2100. XX                yyolsp = lsp;
  2101. XX                if(yyextra[*yyfnd]){        /* must backup */
  2102. XX                    while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
  2103. XX                        lsp--;
  2104. XX                        unput(*yylastch--);
  2105. XX                        }
  2106. XX                    }
  2107. XX                yyprevious = YYU(*yylastch);
  2108. XX                yylsp = lsp;
  2109. XX                yyleng = yylastch-yytext+1;
  2110. XX                yytext[yyleng] = 0;
  2111. XX# ifdef LEXDEBUG
  2112. XX                if(debug){
  2113. XX                    (void) fprintf(yyout,"\nmatch ");
  2114. XX                    sprint(yytext);
  2115. XX                    (void) fprintf(yyout," action %d\n",*yyfnd);
  2116. XX                    }
  2117. XX# endif
  2118. XX                return(*yyfnd++);
  2119. XX                }
  2120. XX            unput(*yylastch);
  2121. XX            }
  2122. XX        if (yytext[0] == 0  /* && feof(yyin) */)
  2123. XX            {
  2124. XX            yysptr=yysbuf;
  2125. XX            return(0);
  2126. XX            }
  2127. XX        yyprevious = yytext[0] = input();
  2128. XX        if (yyprevious>0)
  2129. XX            output(yyprevious);
  2130. XX        yylastch=yytext;
  2131. XX# ifdef LEXDEBUG
  2132. XX        if(debug)(void) putchar('\n');
  2133. XX# endif
  2134. XX        }
  2135. XX    }
  2136. XXyyback(p, m)
  2137. XX    int *p;
  2138. XX{
  2139. XXif (p==0) return(0);
  2140. XXwhile (*p)
  2141. XX    {
  2142. XX    if (*p++ == m)
  2143. XX        return(1);
  2144. XX    }
  2145. XXreturn(0);
  2146. XX}
  2147. XX    /* the following are only used in the lex library */
  2148. XXyyinput(){
  2149. XX    return(input());
  2150. XX    }
  2151. XXyyoutput(c)
  2152. XX  int c; {
  2153. XX    output(c);
  2154. XX    }
  2155. XXyyunput(c)
  2156. XX   int c; {
  2157. XX    unput(c);
  2158. XX    }
  2159. SHAR_EOF
  2160. if test 12642 -ne "`wc -c lex.yy.c`"
  2161. then
  2162. echo shar: error transmitting lex.yy.c '(should have been 12642 characters)'
  2163. fi
  2164. #    End of shell archive
  2165. exit 0
  2166.  
  2167.