home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / zip / language / xlisp_21.zoo / xlspeed.dif < prev    next >
Text File  |  1990-02-28  |  47KB  |  1,853 lines
  1. From sce!mitel!uunet!lll-winken!ames!haven!umd5!jonnyg Tue May 23 15:37:24 EDT 1989
  2. Article: 91 of comp.lang.lisp.x
  3. Path: cognos!sce!mitel!uunet!lll-winken!ames!haven!umd5!jonnyg
  4. From: jonnyg@umd5.umd.edu (Jon Greenblatt)
  5. Newsgroups: comp.lang.lisp.x
  6. Subject: Xlisp2.0 speedups... (Part 1 of 3)
  7. Message-ID: <4912@umd5.umd.edu>
  8. Date: 18 May 89 16:58:56 GMT
  9. Reply-To: jonnyg@umd5.umd.edu (Jon Greenblatt)
  10. Organization: University of Maryland, College Park
  11. Lines: 910
  12.  
  13. The following are changes I have made to xlisp 2.0 source. Most of these
  14. changes produce considerable speed ups. This distribution is very
  15. rough but maybe someone can wade through it and come of with a cleaned
  16. up version of the speed ups. Note this is a striaght context diff so
  17. more than just the speed ups are included, BEWARE! If you are able to
  18. clean up or enhance these speed ups in any way I would apreciate the
  19. feedback.
  20.  
  21.                 JonnyG.
  22.  
  23. diff -c ../xlisp.org/xlbfun.c ../xlisp/xlbfun.c
  24. *** ../xlisp.org/xlbfun.c    Sun May  7 22:25:38 1989
  25. --- ../xlisp/xlbfun.c    Wed Apr  5 16:18:23 1989
  26. ***************
  27. *** 558,563 ****
  28. --- 558,578 ----
  29.       return (val);
  30.   }
  31.   
  32. + LVAL xcopyarray()
  33. + {
  34. +     LVAL src, dest;
  35. +     int num;
  36. +     register int i;
  37. + 
  38. +     src = xlgavector();
  39. +     dest = xlgavector();
  40. +     xllastarg();
  41. +     num = (getsize(src) < getsize(dest)) ? getsize(src) : getsize(dest);
  42. +     for (i = 0; i < num; i++)
  43. +         setelement(dest,i,getelement(src,i));
  44. +     return(dest);
  45. + }
  46. + 
  47.   /* xerror - special form 'error' */
  48.   LVAL xerror()
  49.   {
  50. diff -c ../xlisp.org/xldbug.c ../xlisp/xldbug.c
  51. *** ../xlisp.org/xldbug.c    Sun May  7 22:25:43 1989
  52. --- ../xlisp/xldbug.c    Wed Apr  5 16:18:24 1989
  53. ***************
  54. *** 14,20 ****
  55.   extern char buf[];
  56.   
  57.   /* external routines */
  58. ! extern char *malloc();
  59.   
  60.   /* forward declarations */
  61.   FORWARD LVAL stacktop();
  62. --- 14,20 ----
  63.   extern char buf[];
  64.   
  65.   /* external routines */
  66. ! extern char *xlmalloc();
  67.   
  68.   /* forward declarations */
  69.   FORWARD LVAL stacktop();
  70. diff -c ../xlisp.org/xldmem.c ../xlisp/xldmem.c
  71. *** ../xlisp.org/xldmem.c    Sun May  7 22:25:46 1989
  72. --- ../xlisp/xldmem.c    Wed Apr  5 16:18:25 1989
  73. ***************
  74. *** 6,13 ****
  75.   #include "xlisp.h"
  76.   
  77.   /* node flags */
  78. ! #define MARK    1
  79. ! #define LEFT    2
  80.   
  81.   /* macro to compute the size of a segment */
  82.   #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
  83. --- 6,13 ----
  84.   #include "xlisp.h"
  85.   
  86.   /* node flags */
  87. ! #define MARK    0x20
  88. ! #define LEFT    0x40
  89.   
  90.   /* macro to compute the size of a segment */
  91.   #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
  92. ***************
  93. *** 21,37 ****
  94.   SEGMENT *segs,*lastseg,*fixseg,*charseg;
  95.   int anodes,nsegs,gccalls;
  96.   long nnodes,nfree,total;
  97. ! LVAL fnodes;
  98.   
  99.   /* external procedures */
  100. ! extern char *malloc();
  101. ! extern char *calloc();
  102.   
  103.   /* forward declarations */
  104. ! FORWARD LVAL newnode();
  105.   FORWARD unsigned char *stralloc();
  106.   FORWARD SEGMENT *newsegment();
  107.   
  108.   /* cons - construct a new cons node */
  109.   LVAL cons(x,y)
  110.     LVAL x,y;
  111. --- 21,50 ----
  112.   SEGMENT *segs,*lastseg,*fixseg,*charseg;
  113.   int anodes,nsegs,gccalls;
  114.   long nnodes,nfree,total;
  115. ! LVAL fnodes = NIL;
  116.   
  117.   /* external procedures */
  118. ! extern char *xlmalloc();
  119. ! extern char *xlcalloc();
  120.   
  121.   /* forward declarations */
  122. ! FORWARD LVAL Newnode();
  123.   FORWARD unsigned char *stralloc();
  124.   FORWARD SEGMENT *newsegment();
  125.   
  126. + LVAL _nnode;
  127. + FIXTYPE _tfixed;
  128. + int _tint;
  129. + 
  130. + #define    newnode(type) (((_nnode = fnodes) != NIL) ? \
  131. +             ((fnodes = cdr(_nnode)), \
  132. +              nfree--, \
  133. +              (_nnode->n_type = type), \
  134. +              rplacd(_nnode,NIL), \
  135. +              _nnode) \
  136. +             : (_nnode = Newnode(type)))
  137. + 
  138. + 
  139.   /* cons - construct a new cons node */
  140.   LVAL cons(x,y)
  141.     LVAL x,y;
  142. ***************
  143. *** 129,140 ****
  144.   }
  145.   
  146.   /* cvfixnum - convert an integer to a fixnum node */
  147. ! LVAL cvfixnum(n)
  148.     FIXTYPE n;
  149.   {
  150.       LVAL val;
  151. -     if (n >= SFIXMIN && n <= SFIXMAX)
  152. -     return (&fixseg->sg_nodes[(int)n-SFIXMIN]);
  153.       val = newnode(FIXNUM);
  154.       val->n_fixnum = n;
  155.       return (val);
  156. --- 142,151 ----
  157.   }
  158.   
  159.   /* cvfixnum - convert an integer to a fixnum node */
  160. ! LVAL Cvfixnum(n)
  161.     FIXTYPE n;
  162.   {
  163.       LVAL val;
  164.       val = newnode(FIXNUM);
  165.       val->n_fixnum = n;
  166.       return (val);
  167. ***************
  168. *** 151,157 ****
  169.   }
  170.   
  171.   /* cvchar - convert an integer to a character node */
  172. ! LVAL cvchar(n)
  173.     int n;
  174.   {
  175.       if (n >= CHARMIN && n <= CHARMAX)
  176. --- 162,168 ----
  177.   }
  178.   
  179.   /* cvchar - convert an integer to a character node */
  180. ! LVAL Cvchar(n)
  181.     int n;
  182.   {
  183.       if (n >= CHARMIN && n <= CHARMAX)
  184. ***************
  185. *** 180,185 ****
  186. --- 191,225 ----
  187.       return (val);
  188.   }
  189.   
  190. + #ifdef    WINDOWS
  191. + LVAL newwinobj(size)
  192. + int size;
  193. + {
  194. +     LVAL val;
  195. +     val = newnode(WINOBJ);
  196. +     if (size > 0) {
  197. +         xlprot1(val);
  198. +         if ((val->n_winobj = xldcalloc(1,size)) == NULL) {
  199. +             findmem();
  200. +             if ((val->n_winobj = xldcalloc(1,size)) == NULL)
  201. +                 xlfail("insufficient memory");
  202. +             }
  203. +         xlpop();
  204. +         }
  205. +     else val->n_winobj = NULL;
  206. +     return(val);
  207. + }
  208. + 
  209. + LVAL cvwinobj(p)
  210. + char *p;
  211. +     {
  212. +     LVAL val;
  213. +     val = newnode(WINOBJ);
  214. +     val->n_winobj = p;
  215. +     return(val);
  216. +     }
  217. + #endif
  218. + 
  219.   /* newclosure - allocate and initialize a new closure */
  220.   LVAL newclosure(name,type,env,fenv)
  221.     LVAL name,type,env,fenv;
  222. ***************
  223. *** 204,212 ****
  224.       vect = newnode(VECTOR);
  225.       vect->n_vsize = 0;
  226.       if (bsize = size * sizeof(LVAL)) {
  227. !     if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL) {
  228.           findmem();
  229. !         if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL)
  230.           xlfail("insufficient vector space");
  231.       }
  232.       vect->n_vsize = size;
  233. --- 244,252 ----
  234.       vect = newnode(VECTOR);
  235.       vect->n_vsize = 0;
  236.       if (bsize = size * sizeof(LVAL)) {
  237. !     if ((vect->n_vdata = (LVAL *)xldcalloc(1,bsize)) == NULL) {
  238.           findmem();
  239. !         if ((vect->n_vdata = (LVAL *)xldcalloc(1,bsize)) == NULL)
  240.           xlfail("insufficient vector space");
  241.       }
  242.       vect->n_vsize = size;
  243. ***************
  244. *** 217,223 ****
  245.   }
  246.   
  247.   /* newnode - allocate a new node */
  248. ! LOCAL LVAL newnode(type)
  249.     int type;
  250.   {
  251.       LVAL nnode;
  252. --- 257,263 ----
  253.   }
  254.   
  255.   /* newnode - allocate a new node */
  256. ! LVAL Newnode(type)
  257.     int type;
  258.   {
  259.       LVAL nnode;
  260. ***************
  261. *** 248,256 ****
  262.       unsigned char *sptr;
  263.   
  264.       /* allocate memory for the string copy */
  265. !     if ((sptr = (unsigned char *)malloc(size)) == NULL) {
  266.       gc();  
  267. !     if ((sptr = (unsigned char *)malloc(size)) == NULL)
  268.           xlfail("insufficient string space");
  269.       }
  270.       total += (long)size;
  271. --- 288,296 ----
  272.       unsigned char *sptr;
  273.   
  274.       /* allocate memory for the string copy */
  275. !     if ((sptr = (unsigned char *)xldmalloc(size)) == NULL) {
  276.       gc();  
  277. !     if ((sptr = (unsigned char *)xldmalloc(size)) == NULL)
  278.           xlfail("insufficient string space");
  279.       }
  280.       total += (long)size;
  281. ***************
  282. *** 330,336 ****
  283.     LVAL ptr;
  284.   {
  285.       register LVAL this,prev,tmp;
  286. !     int type,i,n;
  287.   
  288.       /* initialize */
  289.       prev = NIL;
  290. --- 370,376 ----
  291.     LVAL ptr;
  292.   {
  293.       register LVAL this,prev,tmp;
  294. !     register int i,n;
  295.   
  296.       /* initialize */
  297.       prev = NIL;
  298. ***************
  299. *** 340,380 ****
  300.       for (;;) {
  301.   
  302.       /* descend as far as we can */
  303. !     while (!(this->n_flags & MARK))
  304.   
  305.           /* check cons and symbol nodes */
  306. !         if ((type = ntype(this)) == CONS) {
  307. !         if (tmp = car(this)) {
  308. !             this->n_flags |= MARK|LEFT;
  309. !             rplaca(this,prev);
  310. !         }
  311. !         else if (tmp = cdr(this)) {
  312. !             this->n_flags |= MARK;
  313.               rplacd(this,prev);
  314. !         }
  315. !         else {                /* both sides nil */
  316. !             this->n_flags |= MARK;
  317.               break;
  318. !         }
  319. !         prev = this;            /* step down the branch */
  320. !         this = tmp;
  321. !         }
  322. ! 
  323. !         /* mark other node types */
  324.           else {
  325. !         this->n_flags |= MARK;
  326. !         switch (type) {
  327. !         case SYMBOL:
  328. !         case OBJECT:
  329. !         case VECTOR:
  330. !         case CLOSURE:
  331. !             for (i = 0, n = getsize(this); --n >= 0; ++i)
  332. !             if (tmp = getelement(this,i))
  333. !                 mark(tmp);
  334. !             break;
  335. !         }
  336. !         break;
  337. !         }
  338.   
  339.       /* backup to a point where we can continue descending */
  340.       for (;;)
  341. --- 380,409 ----
  342.       for (;;) {
  343.   
  344.       /* descend as far as we can */
  345. !     while (!(this->n_type & MARK))
  346.   
  347.           /* check cons and symbol nodes */
  348. !         if ((i = (this->n_type |= MARK) & TYPEFIELD) == CONS) {
  349. !           if (tmp = car(this)) {
  350. !             this->n_type |= LEFT;
  351. !             rplaca(this,prev);}
  352. !           else if (tmp = cdr(this))
  353.               rplacd(this,prev);
  354. !           else                /* both sides nil */
  355.               break;
  356. !           prev = this;            /* step down the branch */
  357. !           this = tmp;
  358. !           }
  359.           else {
  360. !           if ((i & ARRAY) != 0)
  361. !         for (i = 0, n = getsize(this); i < n;)
  362. !           if (tmp = getelement(this,i++))
  363. !             if ((tmp->n_type & (ARRAY|MARK)) == ARRAY ||
  364. !              tmp->n_type == CONS)
  365. !                 mark(tmp);
  366. !             else tmp->n_type |= MARK;
  367. !           break;
  368. !           }
  369.   
  370.       /* backup to a point where we can continue descending */
  371.       for (;;)
  372. ***************
  373. *** 381,388 ****
  374.   
  375.           /* make sure there is a previous node */
  376.           if (prev) {
  377. !         if (prev->n_flags & LEFT) {    /* came from left side */
  378. !             prev->n_flags &= ~LEFT;
  379.               tmp = car(prev);
  380.               rplaca(prev,this);
  381.               if (this = cdr(prev)) {
  382. --- 410,417 ----
  383.   
  384.           /* make sure there is a previous node */
  385.           if (prev) {
  386. !         if (prev->n_type & LEFT) {    /* came from left side */
  387. !             prev->n_type &= ~LEFT;
  388.               tmp = car(prev);
  389.               rplaca(prev,this);
  390.               if (this = cdr(prev)) {
  391. ***************
  392. *** 399,406 ****
  393.           }
  394.   
  395.           /* no previous node, must be done */
  396. !         else
  397. !         return;
  398.       }
  399.   }
  400.   
  401. --- 428,434 ----
  402.           }
  403.   
  404.           /* no previous node, must be done */
  405. !         else return;
  406.       }
  407.   }
  408.   
  409. ***************
  410. *** 407,434 ****
  411.   /* sweep - sweep all unmarked nodes and add them to the free list */
  412.   LOCAL sweep()
  413.   {
  414. !     SEGMENT *seg;
  415. !     LVAL p;
  416. !     int n;
  417.   
  418. -     /* empty the free list */
  419.       fnodes = NIL;
  420. !     nfree = 0L;
  421.   
  422.       /* add all unmarked nodes */
  423.       for (seg = segs; seg; seg = seg->sg_next) {
  424. !     if (seg == fixseg)     /* don't sweep the fixnum segment */
  425.           continue;
  426. -     else if (seg == charseg) /* don't sweep the character segment */
  427. -         continue;
  428.       p = &seg->sg_nodes[0];
  429. !     for (n = seg->sg_size; --n >= 0; ++p)
  430. !         if (!(p->n_flags & MARK)) {
  431.           switch (ntype(p)) {
  432.           case STRING:
  433.               if (getstring(p) != NULL) {
  434.                   total -= (long)getslength(p);
  435. !                 free(getstring(p));
  436.               }
  437.               break;
  438.           case STREAM:
  439. --- 435,463 ----
  440.   /* sweep - sweep all unmarked nodes and add them to the free list */
  441.   LOCAL sweep()
  442.   {
  443. !     register SEGMENT *seg;
  444. !     register LVAL p;
  445. !     register int n;
  446.   
  447.       fnodes = NIL;
  448. !     nfree = 0l;
  449.   
  450.       /* add all unmarked nodes */
  451.       for (seg = segs; seg; seg = seg->sg_next) {
  452. !     if (seg == fixseg || seg == charseg)
  453. !          /* don't sweep the fixed segments */
  454.           continue;
  455.       p = &seg->sg_nodes[0];
  456. !     for (n = seg->sg_size; --n >= 0;)
  457. !         if (p->n_type & MARK)
  458. !         (p++)->n_type &= ~MARK;
  459. !         else {
  460.           switch (ntype(p)) {
  461.           case STRING:
  462.               if (getstring(p) != NULL) {
  463.                   total -= (long)getslength(p);
  464. !            /* Using getstring here breaks VMEM (JonnyG) */
  465. !                 xldfree(p->n_string);
  466.               }
  467.               break;
  468.           case STREAM:
  469. ***************
  470. *** 435,440 ****
  471. --- 464,474 ----
  472.               if (getfile(p))
  473.                   osclose(getfile(p));
  474.               break;
  475. + #ifdef    WINDOWS
  476. +         case WINOBJ:
  477. +             free_winobj(p);
  478. +             break;
  479. + #endif
  480.           case SYMBOL:
  481.           case OBJECT:
  482.           case VECTOR:
  483. ***************
  484. *** 441,447 ****
  485.           case CLOSURE:
  486.               if (p->n_vsize) {
  487.                   total -= (long) (p->n_vsize * sizeof(LVAL));
  488. !                 free(p->n_vdata);
  489.               }
  490.               break;
  491.           }
  492. --- 475,481 ----
  493.           case CLOSURE:
  494.               if (p->n_vsize) {
  495.                   total -= (long) (p->n_vsize * sizeof(LVAL));
  496. !                 xldfree(p->n_vdata);
  497.               }
  498.               break;
  499.           }
  500. ***************
  501. *** 448,458 ****
  502.           p->n_type = FREE;
  503.           rplaca(p,NIL);
  504.           rplacd(p,fnodes);
  505. !         fnodes = p;
  506. !         nfree += 1L;
  507.           }
  508. -         else
  509. -         p->n_flags &= ~MARK;
  510.       }
  511.   }
  512.   
  513. --- 482,490 ----
  514.           p->n_type = FREE;
  515.           rplaca(p,NIL);
  516.           rplacd(p,fnodes);
  517. !         fnodes = p++;
  518. !         nfree++;
  519.           }
  520.       }
  521.   }
  522.   
  523. ***************
  524. *** 485,491 ****
  525.       SEGMENT *newseg;
  526.   
  527.       /* allocate the new segment */
  528. !     if ((newseg = (SEGMENT *)calloc(1,segsize(n))) == NULL)
  529.       return (NULL);
  530.   
  531.       /* initialize the new segment */
  532. --- 517,524 ----
  533.       SEGMENT *newseg;
  534.   
  535.       /* allocate the new segment */
  536. ! 
  537. !     if ((newseg = (SEGMENT *)xlcalloc(1,segsize(n))) == NULL)
  538.       return (NULL);
  539.   
  540.       /* initialize the new segment */
  541. ***************
  542. *** 666,677 ****
  543.       s_gcflag = s_gchook = NIL;
  544.   
  545.       /* allocate the evaluation stack */
  546. !     if ((xlstkbase = (LVAL **)malloc(EDEPTH * sizeof(LVAL *))) == NULL)
  547.       xlfatal("insufficient memory");
  548.       xlstack = xlstktop = xlstkbase + EDEPTH;
  549.   
  550.       /* allocate the argument stack */
  551. !     if ((xlargstkbase = (LVAL *)malloc(ADEPTH * sizeof(LVAL))) == NULL)
  552.       xlfatal("insufficient memory");
  553.       xlargstktop = xlargstkbase + ADEPTH;
  554.       xlfp = xlsp = xlargstkbase;
  555. --- 699,710 ----
  556.       s_gcflag = s_gchook = NIL;
  557.   
  558.       /* allocate the evaluation stack */
  559. !     if ((xlstkbase = (LVAL **)xlmalloc(EDEPTH * sizeof(LVAL *))) == NULL)
  560.       xlfatal("insufficient memory");
  561.       xlstack = xlstktop = xlstkbase + EDEPTH;
  562.   
  563.       /* allocate the argument stack */
  564. !     if ((xlargstkbase = (LVAL *)xlmalloc(ADEPTH * sizeof(LVAL))) == NULL)
  565.       xlfatal("insufficient memory");
  566.       xlargstktop = xlargstkbase + ADEPTH;
  567.       xlfp = xlsp = xlargstkbase;
  568. diff -c ../xlisp.org/xldmem.h ../xlisp/xldmem.h
  569. *** ../xlisp.org/xldmem.h    Sun May  7 22:25:47 1989
  570. --- ../xlisp/xldmem.h    Wed Apr  5 16:45:38 1989
  571. ***************
  572. *** 13,21 ****
  573.   #define CHARMAX        255
  574.   #define CHARSIZE    256
  575.   
  576. - /* new node access macros */
  577. - #define ntype(x)    ((x)->n_type)
  578. - 
  579.   /* cons access macros */
  580.   #define car(x)        ((x)->n_car)
  581.   #define cdr(x)        ((x)->n_cdr)
  582. --- 13,18 ----
  583. ***************
  584. *** 23,72 ****
  585.   #define rplacd(x,y)    ((x)->n_cdr = (y))
  586.   
  587.   /* symbol access macros */
  588. ! #define getvalue(x)     ((x)->n_vdata[0])
  589. ! #define setvalue(x,v)     ((x)->n_vdata[0] = (v))
  590. ! #define getfunction(x)     ((x)->n_vdata[1])
  591. ! #define setfunction(x,v) ((x)->n_vdata[1] = (v))
  592. ! #define getplist(x)     ((x)->n_vdata[2])
  593. ! #define setplist(x,v)     ((x)->n_vdata[2] = (v))
  594. ! #define getpname(x)     ((x)->n_vdata[3])
  595. ! #define setpname(x,v)     ((x)->n_vdata[3] = (v))
  596.   #define SYMSIZE        4
  597.   
  598.   /* closure access macros */
  599. ! #define getname(x)         ((x)->n_vdata[0])
  600. ! #define setname(x,v)       ((x)->n_vdata[0] = (v))
  601. ! #define gettype(x)        ((x)->n_vdata[1])
  602. ! #define settype(x,v)      ((x)->n_vdata[1] = (v))
  603. ! #define getargs(x)         ((x)->n_vdata[2])
  604. ! #define setargs(x,v)       ((x)->n_vdata[2] = (v))
  605. ! #define getoargs(x)        ((x)->n_vdata[3])
  606. ! #define setoargs(x,v)      ((x)->n_vdata[3] = (v))
  607. ! #define getrest(x)         ((x)->n_vdata[4])
  608. ! #define setrest(x,v)       ((x)->n_vdata[4] = (v))
  609. ! #define getkargs(x)        ((x)->n_vdata[5])
  610. ! #define setkargs(x,v)      ((x)->n_vdata[5] = (v))
  611. ! #define getaargs(x)        ((x)->n_vdata[6])
  612. ! #define setaargs(x,v)      ((x)->n_vdata[6] = (v))
  613. ! #define getbody(x)         ((x)->n_vdata[7])
  614. ! #define setbody(x,v)       ((x)->n_vdata[7] = (v))
  615. ! #define getenv(x)    ((x)->n_vdata[8])
  616. ! #define setenv(x,v)    ((x)->n_vdata[8] = (v))
  617. ! #define getfenv(x)    ((x)->n_vdata[9])
  618. ! #define setfenv(x,v)    ((x)->n_vdata[9] = (v))
  619. ! #define getlambda(x)    ((x)->n_vdata[10])
  620. ! #define setlambda(x,v)    ((x)->n_vdata[10] = (v))
  621.   #define CLOSIZE        11
  622.   
  623.   /* vector access macros */
  624.   #define getsize(x)    ((x)->n_vsize)
  625. ! #define getelement(x,i)    ((x)->n_vdata[i])
  626. ! #define setelement(x,i,v) ((x)->n_vdata[i] = (v))
  627.   
  628.   /* object access macros */
  629. ! #define getclass(x)    ((x)->n_vdata[0])
  630. ! #define getivar(x,i)    ((x)->n_vdata[i+1])
  631. ! #define setivar(x,i,v)    ((x)->n_vdata[i+1] = (v))
  632.   
  633.   /* subr/fsubr access macros */
  634.   #define getsubr(x)    ((x)->n_subr)
  635. --- 20,69 ----
  636.   #define rplacd(x,y)    ((x)->n_cdr = (y))
  637.   
  638.   /* symbol access macros */
  639. ! #define getvalue(x)     (ACESSV(x,0))
  640. ! #define setvalue(x,v)     (ACESSV(x,0) = (v))
  641. ! #define getfunction(x)     (ACESSV(x,1))
  642. ! #define setfunction(x,v) (ACESSV(x,1) = (v))
  643. ! #define getplist(x)     (ACESSV(x,2))
  644. ! #define setplist(x,v)     (ACESSV(x,2) = (v))
  645. ! #define getpname(x)     (ACESSV(x,3))
  646. ! #define setpname(x,v)     (ACESSV(x,3) = (v))
  647.   #define SYMSIZE        4
  648.   
  649.   /* closure access macros */
  650. ! #define getname(x)         (ACESSV(x,0))
  651. ! #define setname(x,v)       (ACESSV(x,0) = (v))
  652. ! #define gettype(x)        (ACESSV(x,1))
  653. ! #define settype(x,v)      (ACESSV(x,1) = (v))
  654. ! #define getargs(x)         (ACESSV(x,2))
  655. ! #define setargs(x,v)       (ACESSV(x,2) = (v))
  656. ! #define getoargs(x)        (ACESSV(x,3))
  657. ! #define setoargs(x,v)      (ACESSV(x,3) = (v))
  658. ! #define getrest(x)         (ACESSV(x,4))
  659. ! #define setrest(x,v)       (ACESSV(x,4) = (v))
  660. ! #define getkargs(x)        (ACESSV(x,5))
  661. ! #define setkargs(x,v)      (ACESSV(x,5) = (v))
  662. ! #define getaargs(x)        (ACESSV(x,6))
  663. ! #define setaargs(x,v)      (ACESSV(x,6) = (v))
  664. ! #define getbody(x)         (ACESSV(x,7))
  665. ! #define setbody(x,v)       (ACESSV(x,7) = (v))
  666. ! #define getenv(x)    (ACESSV(x,8))
  667. ! #define setenv(x,v)    (ACESSV(x,8) = (v))
  668. ! #define getfenv(x)    (ACESSV(x,9))
  669. ! #define setfenv(x,v)    (ACESSV(x,9) = (v))
  670. ! #define getlambda(x)    (ACESSV(x,10))
  671. ! #define setlambda(x,v)    (ACESSV(x,10) = (v))
  672.   #define CLOSIZE        11
  673.   
  674.   /* vector access macros */
  675.   #define getsize(x)    ((x)->n_vsize)
  676. ! #define getelement(x,i)    (ACESSV(x,i))
  677. ! #define setelement(x,i,v) (ACESSV(x,i) = (v))
  678.   
  679.   /* object access macros */
  680. ! #define getclass(x)    (ACESSV(x,0))
  681. ! #define getivar(x,i)    (ACESSV(x,i+1))
  682. ! #define setivar(x,i,v)    (ACESSV(x,i+1) = (v))
  683.   
  684.   /* subr/fsubr access macros */
  685.   #define getsubr(x)    ((x)->n_subr)
  686. ***************
  687. *** 78,84 ****
  688.   #define getchcode(x)    ((x)->n_chcode)
  689.   
  690.   /* string access macros */
  691. ! #define getstring(x)    ((x)->n_string)
  692.   #define getslength(x)    ((x)->n_strlen)
  693.   
  694.   /* file stream access macros */
  695. --- 75,81 ----
  696.   #define getchcode(x)    ((x)->n_chcode)
  697.   
  698.   /* string access macros */
  699. ! #define getstring(x)    (ACESSS((x)->n_string))
  700.   #define getslength(x)    ((x)->n_strlen)
  701.   
  702.   /* file stream access macros */
  703. ***************
  704. *** 93,114 ****
  705.   #define gettail(x)    ((x)->n_cdr)
  706.   #define settail(x,v)    ((x)->n_cdr = (v))
  707.   
  708.   /* node types */
  709.   #define FREE    0
  710.   #define SUBR    1
  711.   #define FSUBR    2
  712.   #define CONS    3
  713. ! #define SYMBOL    4
  714. ! #define FIXNUM    5
  715. ! #define FLONUM    6
  716. ! #define STRING    7
  717. ! #define OBJECT    8
  718. ! #define STREAM    9
  719. ! #define VECTOR    10
  720. ! #define CLOSURE    11
  721. ! #define CHAR    12
  722. ! #define USTREAM    13
  723.   
  724.   /* subr/fsubr node */
  725.   #define n_subr        n_info.n_xsubr.xs_subr
  726.   #define n_offset    n_info.n_xsubr.xs_offset
  727. --- 90,121 ----
  728.   #define gettail(x)    ((x)->n_cdr)
  729.   #define settail(x,v)    ((x)->n_cdr = (v))
  730.   
  731. + #define    getwinobj(x)    (ACESSS((x)->n_winobj))
  732. + #define    setwinobj(x,v)    ((x)->n_winobj = (v))
  733. + 
  734.   /* node types */
  735.   #define FREE    0
  736. + #define SYMBOL    17
  737. + #define OBJECT    18
  738. + #define VECTOR    19
  739. + #define CLOSURE    20
  740.   #define SUBR    1
  741.   #define FSUBR    2
  742.   #define CONS    3
  743. ! #define FIXNUM    4
  744. ! #define FLONUM    5
  745. ! #define STRING    6
  746. ! #define STREAM    7
  747. ! #define CHAR    8
  748. ! #define USTREAM    9
  749. ! #define    WINOBJ    10
  750.   
  751. + #define    ARRAY    16
  752. + #define TYPEFIELD 0x1f
  753. + 
  754. + /* new node access macros */
  755. + #define ntype(x)    ((x)->n_type & TYPEFIELD)
  756. + 
  757.   /* subr/fsubr node */
  758.   #define n_subr        n_info.n_xsubr.xs_subr
  759.   #define n_offset    n_info.n_xsubr.xs_offset
  760. ***************
  761. *** 137,146 ****
  762.   #define n_vsize        n_info.n_xvector.xv_size
  763.   #define n_vdata        n_info.n_xvector.xv_data
  764.   
  765.   /* node structure */
  766.   typedef struct node {
  767.       char n_type;        /* type of node */
  768. -     char n_flags;        /* flag bits */
  769.       union ninfo {         /* value */
  770.       struct xsubr {        /* subr/fsubr node */
  771.           struct node *(*xs_subr)();    /* function pointer */
  772. --- 144,155 ----
  773.   #define n_vsize        n_info.n_xvector.xv_size
  774.   #define n_vdata        n_info.n_xvector.xv_data
  775.   
  776. + /* window/font node */
  777. + #define    n_winobj    n_info.n_xwinobj.xw_ptr
  778. + 
  779.   /* node structure */
  780.   typedef struct node {
  781.       char n_type;        /* type of node */
  782.       union ninfo {         /* value */
  783.       struct xsubr {        /* subr/fsubr node */
  784.           struct node *(*xs_subr)();    /* function pointer */
  785. ***************
  786. *** 171,176 ****
  787. --- 180,188 ----
  788.           int xv_size;        /* vector size */
  789.           struct node **xv_data;    /* vector data */
  790.       } n_xvector;
  791. +     struct xwinobj {    /* window/font object */
  792. +         char *xw_ptr;        /* Generic structure pointer */
  793. +     } n_xwinobj;
  794.       } n_info;
  795.   } *LVAL;
  796.   
  797. ***************
  798. *** 187,195 ****
  799.   extern LVAL cvstring();           /* convert a string */
  800.   extern LVAL cvfile();        /* convert a FILE * to a file */
  801.   extern LVAL cvsubr();        /* convert a function to a subr/fsubr */
  802. ! extern LVAL cvfixnum();           /* convert a fixnum */
  803.   extern LVAL cvflonum();           /* convert a flonum */
  804. ! extern LVAL cvchar();        /* convert a character */
  805.   
  806.   extern LVAL newstring();    /* create a new string */
  807.   extern LVAL newvector();    /* create a new vector */
  808. --- 199,207 ----
  809.   extern LVAL cvstring();           /* convert a string */
  810.   extern LVAL cvfile();        /* convert a FILE * to a file */
  811.   extern LVAL cvsubr();        /* convert a function to a subr/fsubr */
  812. ! extern LVAL Cvfixnum();           /* convert a fixnum */
  813.   extern LVAL cvflonum();           /* convert a flonum */
  814. ! extern LVAL Cvchar();        /* convert a character */
  815.   
  816.   extern LVAL newstring();    /* create a new string */
  817.   extern LVAL newvector();    /* create a new vector */
  818. ***************
  819. *** 196,198 ****
  820. --- 208,249 ----
  821.   extern LVAL newobject();    /* create a new object */
  822.   extern LVAL newclosure();    /* create a new closure */
  823.   extern LVAL newustream();    /* create a new unnamed stream */
  824. + 
  825. + 
  826. + /* Speed ups, reduce function calls for fixed characters and numbers       */
  827. + /* Speed is exeptionaly noticed on machines with large a instruction cache */
  828. + /* No size effects here (JonnyG) */
  829. + 
  830. + extern SEGMENT *fixseg,*charseg;
  831. + extern FIXTYPE _tfixed;
  832. + extern int _tint;
  833. + 
  834. + #define cvfixnum(n) ((_tfixed = n), \
  835. +         ((_tfixed > SFIXMIN && _tfixed < SFIXMAX) ? \
  836. +         &fixseg->sg_nodes[(int)_tfixed-SFIXMIN] : \
  837. +         Cvfixnum(_tfixed)))
  838. + 
  839. + #define cvchar(c) ((_tint = c), \
  840. +         ((_tint >= CHARMIN && _tint <= CHARMIN) ? \
  841. +             &charseg->sg_nodes[_tint-CHARMIN] : \
  842. +         Cvchar(_tint)))
  843. + 
  844. + extern    char *xldmalloc();
  845. + extern    char *xldcalloc();
  846. + 
  847. + #ifdef    VMEM
  848. + 
  849. + extern char *vload();
  850. + 
  851. + extern    unsigned char *vaccess();
  852. + 
  853. + #define    ACESSV(x,i)    (((LVAL *)vaccess((x)->n_vdata))[i])
  854. + #define    ACESSS(x)    (vaccess(x))
  855. + 
  856. + #else
  857. + 
  858. + #define    xlfcalloc    xlcalloc
  859. + #define ACESSV(x,i)    (x)->n_vdata[i]
  860. + #define    ACESSS(x)    x
  861. + 
  862. + #endif
  863. diff -c ../xlisp.org/xlfio.c ../xlisp/xlfio.c
  864. *** ../xlisp.org/xlfio.c    Sun May  7 22:25:52 1989
  865. --- ../xlisp/xlfio.c    Wed Apr  5 16:18:27 1989
  866. ***************
  867. *** 349,355 ****
  868.   
  869.       /* copy the substring into the stream */
  870.       for (i = start; i < end; ++i)
  871. !     xlputc(val,str[i]);
  872.   
  873.       /* restore the stack */
  874.       xlpop();
  875. --- 349,355 ----
  876.   
  877.       /* copy the substring into the stream */
  878.       for (i = start; i < end; ++i)
  879. !     xlputc(val,getstring(string) + i);
  880.   
  881.       /* restore the stack */
  882.       xlpop();
  883. ***************
  884. *** 450,456 ****
  885.   LOCAL LVAL getstroutput(stream)
  886.     LVAL stream;
  887.   {
  888. !     unsigned char *str;
  889.       LVAL next,val;
  890.       int len,ch;
  891.   
  892. --- 450,456 ----
  893.   LOCAL LVAL getstroutput(stream)
  894.     LVAL stream;
  895.   {
  896. !     int i;
  897.       LVAL next,val;
  898.       int len,ch;
  899.   
  900. ***************
  901. *** 462,471 ****
  902.       val = newstring(len + 1);
  903.       
  904.       /* copy the characters into the new string */
  905. !     str = getstring(val);
  906.       while ((ch = xlgetc(stream)) != EOF)
  907. !     *str++ = ch;
  908. !     *str = '\0';
  909.   
  910.       /* return the string */
  911.       return (val);
  912. --- 462,471 ----
  913.       val = newstring(len + 1);
  914.       
  915.       /* copy the characters into the new string */
  916. !     i = 0;
  917.       while ((ch = xlgetc(stream)) != EOF)
  918. !     getstring(val)[i++] = ch;
  919. !     getstring(val)[i] = '\0';
  920.   
  921.       /* return the string */
  922.       return (val);
  923.  
  924.  
  925. From sce!mitel!uunet!lll-winken!ames!haven!umd5!jonnyg Tue May 23 15:37:32 EDT 1989
  926. Article: 92 of comp.lang.lisp.x
  927. Path: cognos!sce!mitel!uunet!lll-winken!ames!haven!umd5!jonnyg
  928. From: jonnyg@umd5.umd.edu (Jon Greenblatt)
  929. Newsgroups: comp.lang.lisp.x
  930. Subject: Xlisp 2.0 speedups (Part 2 of 3)
  931. Message-ID: <4913@umd5.umd.edu>
  932. Date: 18 May 89 16:59:37 GMT
  933. Reply-To: jonnyg@umd5.umd.edu (Jon Greenblatt)
  934. Organization: University of Maryland, College Park
  935. Lines: 913
  936.  
  937. diff -c ../xlisp.org/xlftab.c ../xlisp/xlftab.c
  938. *** ../xlisp.org/xlftab.c    Sun May  7 22:25:54 1989
  939. --- ../xlisp/xlftab.c    Wed Apr  5 16:18:28 1989
  940. ***************
  941. *** 11,17 ****
  942.       rmhash(),rmquote(),rmdquote(),rmbquote(),rmcomma(),
  943.       clnew(),clisnew(),clanswer(),
  944.       obisnew(),obclass(),obshow(),
  945. !     rmlpar(),rmrpar(),rmsemi(),
  946.       xeval(),xapply(),xfuncall(),xquote(),xfunction(),xbquote(),
  947.       xlambda(),xset(),xsetq(),xsetf(),xdefun(),xdefmacro(),
  948.       xgensym(),xmakesymbol(),xintern(),
  949. --- 11,17 ----
  950.       rmhash(),rmquote(),rmdquote(),rmbquote(),rmcomma(),
  951.       clnew(),clisnew(),clanswer(),
  952.       obisnew(),obclass(),obshow(),
  953. !     rmlpar(),rmrpar(),rmlbrace(),rmrbrace(),rmsemi(),
  954.       xeval(),xapply(),xfuncall(),xquote(),xfunction(),xbquote(),
  955.       xlambda(),xset(),xsetq(),xsetf(),xdefun(),xdefmacro(),
  956.       xgensym(),xmakesymbol(),xintern(),
  957. ***************
  958. *** 70,76 ****
  959.       xcharp(),xcharint(),xintchar(),
  960.       xmkstrinput(),xmkstroutput(),xgetstroutput(),xgetlstoutput(),
  961.       xgetlambda(),xmacroexpand(),x1macroexpand(),
  962. !     xtrace(),xuntrace();
  963.   
  964.   /* functions specific to xldmem.c */
  965.   LVAL xgc(),xexpand(),xalloc(),xmem();
  966. --- 70,76 ----
  967.       xcharp(),xcharint(),xintchar(),
  968.       xmkstrinput(),xmkstroutput(),xgetstroutput(),xgetlstoutput(),
  969.       xgetlambda(),xmacroexpand(),x1macroexpand(),
  970. !     xtrace(),xuntrace(),xcopyarray();
  971.   
  972.   /* functions specific to xldmem.c */
  973.   LVAL xgc(),xexpand(),xalloc(),xmem();
  974. ***************
  975. *** 90,96 ****
  976.   
  977.   /* the function table */
  978.   FUNDEF funtab[] = {
  979. - 
  980.       /* read macro functions */
  981.   {    NULL,                S, rmhash        }, /*   0 */
  982.   {    NULL,                S, rmquote        }, /*   1 */
  983. --- 90,95 ----
  984. ***************
  985. *** 100,107 ****
  986.   {    NULL,                S, rmlpar        }, /*   5 */
  987.   {    NULL,                S, rmrpar        }, /*   6 */
  988.   {    NULL,                S, rmsemi        }, /*   7 */
  989. ! {    NULL,                S, xnotimp        }, /*   8 */
  990. ! {    NULL,                S, xnotimp        }, /*   9 */
  991.   
  992.       /* methods */
  993.   {    NULL,                S, clnew        }, /*  10 */
  994. --- 99,106 ----
  995.   {    NULL,                S, rmlpar        }, /*   5 */
  996.   {    NULL,                S, rmrpar        }, /*   6 */
  997.   {    NULL,                S, rmsemi        }, /*   7 */
  998. ! {    NULL,                S, rmlbrace        }, /*   8 */
  999. ! {    NULL,                S, rmrbrace        }, /*   9 */
  1000.   
  1001.       /* methods */
  1002.   {    NULL,                S, clnew        }, /*  10 */
  1003. ***************
  1004. *** 426,432 ****
  1005.   {    "SORT",                S, xsort        }, /* 284 */
  1006.   
  1007.       /* extra table entries */
  1008. ! {    NULL,                S, xnotimp        }, /* 285 */
  1009.   {    NULL,                S, xnotimp        }, /* 286 */
  1010.   {    NULL,                S, xnotimp        }, /* 287 */
  1011.   {    NULL,                S, xnotimp        }, /* 288 */
  1012. --- 425,431 ----
  1013.   {    "SORT",                S, xsort        }, /* 284 */
  1014.   
  1015.       /* extra table entries */
  1016. ! {    "COPY-ARRAY",            S, xcopyarray        }, /* 285 */
  1017.   {    NULL,                S, xnotimp        }, /* 286 */
  1018.   {    NULL,                S, xnotimp        }, /* 287 */
  1019.   {    NULL,                S, xnotimp        }, /* 288 */
  1020. ***************
  1021. *** 447,453 ****
  1022.   
  1023.   {0,0,0} /* end of table marker */
  1024.   
  1025. ! };            
  1026.   
  1027.   /* xnotimp - function table entries that are currently not implemented */
  1028.   LOCAL LVAL xnotimp()
  1029. --- 446,452 ----
  1030.   
  1031.   {0,0,0} /* end of table marker */
  1032.   
  1033. ! };
  1034.   
  1035.   /* xnotimp - function table entries that are currently not implemented */
  1036.   LOCAL LVAL xnotimp()
  1037. diff -c ../xlisp.org/xlglob.c ../xlisp/xlglob.c
  1038. *** ../xlisp.org/xlglob.c    Sun May  7 22:25:55 1989
  1039. --- ../xlisp/xlglob.c    Wed Apr  5 16:18:28 1989
  1040. ***************
  1041. *** 22,27 ****
  1042. --- 22,28 ----
  1043.   LVAL s_1plus=NIL,s_2plus=NIL,s_3plus=NIL;
  1044.   LVAL s_1star=NIL,s_2star=NIL,s_3star=NIL;
  1045.   LVAL s_minus=NIL,s_printcase=NIL;
  1046. + LVAL s_send=NIL,s_sendsuper=NIL;
  1047.   
  1048.   /* keywords */
  1049.   LVAL k_test=NIL,k_tnot=NIL;
  1050. diff -c ../xlisp.org/xlimage.c ../xlisp/xlimage.c
  1051. *** ../xlisp.org/xlimage.c    Sun May  7 22:25:57 1989
  1052. --- ../xlisp/xlimage.c    Wed Apr  5 16:18:28 1989
  1053. ***************
  1054. *** 22,28 ****
  1055.   /* external procedures */
  1056.   extern SEGMENT *newsegment();
  1057.   extern FILE *osbopen();
  1058. ! extern char *malloc();
  1059.   
  1060.   /* forward declarations */
  1061.   OFFTYPE readptr();
  1062. --- 22,28 ----
  1063.   /* external procedures */
  1064.   extern SEGMENT *newsegment();
  1065.   extern FILE *osbopen();
  1066. ! extern char *xlmalloc();
  1067.   
  1068.   /* forward declarations */
  1069.   OFFTYPE readptr();
  1070. ***************
  1071. *** 170,176 ****
  1072.       case USTREAM:
  1073.           p = cviptr(off);
  1074.           p->n_type = type;
  1075. -         p->n_flags = 0;
  1076.           rplaca(p,cviptr(readptr()));
  1077.           rplacd(p,cviptr(readptr()));
  1078.           off += 2;
  1079. --- 170,175 ----
  1080. ***************
  1081. *** 192,198 ****
  1082.           case VECTOR:
  1083.           case CLOSURE:
  1084.           max = getsize(p);
  1085. !         if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
  1086.               xlfatal("insufficient memory - vector");
  1087.           total += (long)(max * sizeof(LVAL));
  1088.           for (i = 0; i < max; ++i)
  1089. --- 191,197 ----
  1090.           case VECTOR:
  1091.           case CLOSURE:
  1092.           max = getsize(p);
  1093. !         if ((p->n_vdata = (LVAL *)xlmalloc(max * sizeof(LVAL))) == NULL)
  1094.               xlfatal("insufficient memory - vector");
  1095.           total += (long)(max * sizeof(LVAL));
  1096.           for (i = 0; i < max; ++i)
  1097. ***************
  1098. *** 200,206 ****
  1099.           break;
  1100.           case STRING:
  1101.           max = getslength(p);
  1102. !         if ((p->n_string = (unsigned char *)malloc(max)) == NULL)
  1103.               xlfatal("insufficient memory - string");
  1104.           total += (long)max;
  1105.           for (cp = getstring(p); --max >= 0; )
  1106. --- 199,205 ----
  1107.           break;
  1108.           case STRING:
  1109.           max = getslength(p);
  1110. !         if ((p->n_string = (unsigned char *)xlmalloc(max)) == NULL)
  1111.               xlfatal("insufficient memory - string");
  1112.           total += (long)max;
  1113.           for (cp = getstring(p); --max >= 0; )
  1114. ***************
  1115. *** 247,257 ****
  1116.           case VECTOR:
  1117.           case CLOSURE:
  1118.           if (p->n_vsize)
  1119. !             free(p->n_vdata);
  1120.           break;
  1121.           case STRING:
  1122.           if (getslength(p))
  1123. !             free(getstring(p));
  1124.           break;
  1125.           case STREAM:
  1126.           if ((fp = getfile(p)) && (fp != stdin && fp != stdout))
  1127. --- 246,256 ----
  1128.           case VECTOR:
  1129.           case CLOSURE:
  1130.           if (p->n_vsize)
  1131. !             xlfree(p->n_vdata);
  1132.           break;
  1133.           case STRING:
  1134.           if (getslength(p))
  1135. !             xlfree(getstring(p));
  1136.           break;
  1137.           case STREAM:
  1138.           if ((fp = getfile(p)) && (fp != stdin && fp != stdout))
  1139. ***************
  1140. *** 259,265 ****
  1141.           break;
  1142.           }
  1143.       next = seg->sg_next;
  1144. !     free(seg);
  1145.       }
  1146.   }
  1147.   
  1148. --- 258,264 ----
  1149.           break;
  1150.           }
  1151.       next = seg->sg_next;
  1152. !     xlfree(seg);
  1153.       }
  1154.   }
  1155.   
  1156. ***************
  1157. *** 302,308 ****
  1158.       char *p = (char *)&node->n_info;
  1159.       int n = sizeof(union ninfo);
  1160.       node->n_type = type;
  1161. -     node->n_flags = 0;
  1162.       while (--n >= 0)
  1163.       *p++ = osbgetc(fp);
  1164.   }
  1165. --- 301,306 ----
  1166. diff -c ../xlisp.org/xlinit.c ../xlisp/xlinit.c
  1167. *** ../xlisp.org/xlinit.c    Sun May  7 22:25:59 1989
  1168. --- ../xlisp/xlinit.c    Wed Apr  5 16:18:29 1989
  1169. ***************
  1170. *** 27,32 ****
  1171. --- 27,33 ----
  1172.   extern LVAL a_fixnum,a_flonum,a_string,a_stream,a_object;
  1173.   extern LVAL a_vector,a_closure,a_char,a_ustream;
  1174.   extern LVAL s_gcflag,s_gchook;
  1175. + extern LVAL s_send,s_sendsuper;
  1176.   extern FUNDEF funtab[];
  1177.   
  1178.   /* xlinit - xlisp initialization routine */
  1179. ***************
  1180. *** 106,111 ****
  1181. --- 107,114 ----
  1182.       s_eql    = xlenter("EQL");
  1183.       s_ifmt    = xlenter("*INTEGER-FORMAT*");
  1184.       s_ffmt    = xlenter("*FLOAT-FORMAT*");
  1185. +     s_send    = xlenter("SEND");
  1186. +     s_sendsuper = xlenter("SEND-SUPER");
  1187.   
  1188.       /* symbols set by the read-eval-print loop */
  1189.       s_1plus    = xlenter("+");
  1190. diff -c ../xlisp.org/xlisp.c ../xlisp/xlisp.c
  1191. *** ../xlisp.org/xlisp.c    Sun May  7 22:26:02 1989
  1192. --- ../xlisp/xlisp.c    Thu Apr  6 10:06:46 1989
  1193. ***************
  1194. *** 6,12 ****
  1195.   #include "xlisp.h"
  1196.   
  1197.   /* define the banner line string */
  1198. ! #define BANNER    "XLISP version 2.0, Copyright (c) 1988, by David Betz"
  1199.   
  1200.   /* global variables */
  1201.   jmp_buf top_level;
  1202. --- 6,12 ----
  1203.   #include "xlisp.h"
  1204.   
  1205.   /* define the banner line string */
  1206. ! #define BANNER    "XLISP version 2.0w, Copyright (c) 1988, by David Betz"
  1207.   
  1208.   /* global variables */
  1209.   jmp_buf top_level;
  1210. ***************
  1211. *** 52,60 ****
  1212.           }
  1213.   #endif
  1214.   
  1215.       /* initialize and print the banner line */
  1216.       osinit(BANNER);
  1217. - 
  1218.       /* setup initialization error handler */
  1219.       xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  1220.       if (setjmp(cntxt.c_jmpbuf))
  1221. --- 52,63 ----
  1222.           }
  1223.   #endif
  1224.   
  1225. + #ifdef    X11
  1226. +     parse_args(&argc,argv);
  1227. + #endif
  1228. + 
  1229.       /* initialize and print the banner line */
  1230.       osinit(BANNER);
  1231.       /* setup initialization error handler */
  1232.       xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  1233.       if (setjmp(cntxt.c_jmpbuf))
  1234. ***************
  1235. *** 61,67 ****
  1236.       xlfatal("fatal initialization error");
  1237.       if (setjmp(top_level))
  1238.       xlfatal("RESTORE not allowed during initialization");
  1239. - 
  1240.       /* initialize xlisp */
  1241.       xlinit();
  1242.       xlend(&cntxt);
  1243. --- 64,69 ----
  1244. diff -c ../xlisp.org/xlisp.h ../xlisp/xlisp.h
  1245. *** ../xlisp.org/xlisp.h    Sun May  7 22:26:12 1989
  1246. --- ../xlisp/xlisp.h    Wed Apr  5 16:23:51 1989
  1247. ***************
  1248. *** 4,10 ****
  1249.       Permission is granted for unrestricted non-commercial use    */
  1250.   
  1251.   /* system specific definitions */
  1252. ! /* #define UNIX */
  1253.   
  1254.   #include <stdio.h>
  1255.   #include <ctype.h>
  1256. --- 4,11 ----
  1257.       Permission is granted for unrestricted non-commercial use    */
  1258.   
  1259.   /* system specific definitions */
  1260. ! #define X11
  1261. ! /* #define    ADEBUG */
  1262.   
  1263.   #include <stdio.h>
  1264.   #include <ctype.h>
  1265. ***************
  1266. *** 24,29 ****
  1267. --- 25,35 ----
  1268.   /* OFFTYPE    number the size of an address (int) */
  1269.   
  1270.   /* for the BSD 4.3 system.  Might work for AT&T garbage */
  1271. + #ifdef    X11
  1272. + #define    UNIX
  1273. + #define WINDOWS
  1274. + #endif
  1275. + 
  1276.   #ifdef UNIX
  1277.   #define NNODES        2000
  1278.   #define SAVERESTORE
  1279. ***************
  1280. *** 82,87 ****
  1281. --- 88,105 ----
  1282.   #define OFFTYPE        long
  1283.   #endif
  1284.   
  1285. + #ifdef MSW
  1286. + #define NNODES        1000
  1287. + #define AFMT        "%lx"
  1288. + #define OFFTYPE        long
  1289. + #define    WINDOWS
  1290. + #define    VMEM
  1291. + #define    MSC
  1292. + #define    xlmalloc    WMalloc
  1293. + #define    xlcalloc    WCalloc
  1294. + #define    xlfree        WFree
  1295. + #endif
  1296. + 
  1297.   /* for the Mark Williams C compiler - Atari ST */
  1298.   #ifdef MWC
  1299.   #define AFMT        "%lx"
  1300. ***************
  1301. *** 148,153 ****
  1302. --- 166,176 ----
  1303.   #ifndef UCHAR
  1304.   #define UCHAR        unsigned char
  1305.   #endif
  1306. + #ifndef    xlmalloc
  1307. + #define    xlmalloc    malloc
  1308. + #define    xlcalloc    calloc
  1309. + #define    xlfree        free
  1310. + #endif
  1311.   
  1312.   /* useful definitions */
  1313.   #define TRUE    1
  1314. ***************
  1315. *** 160,166 ****
  1316.   #include "xldmem.h"
  1317.   
  1318.   /* program limits */
  1319. ! #define STRMAX        100        /* maximum length of a string constant */
  1320.   #define HSIZE        199        /* symbol hash table size */
  1321.   #define SAMPLE        100        /* control character sample rate */
  1322.   
  1323. --- 183,189 ----
  1324.   #include "xldmem.h"
  1325.   
  1326.   /* program limits */
  1327. ! #define STRMAX        512        /* maximum length of a string constant */
  1328.   #define HSIZE        199        /* symbol hash table size */
  1329.   #define SAMPLE        100        /* control character sample rate */
  1330.   
  1331. ***************
  1332. *** 173,178 ****
  1333. --- 196,203 ----
  1334.   #define FT_RMLPAR    5
  1335.   #define FT_RMRPAR    6
  1336.   #define FT_RMSEMI    7
  1337. + #define    FT_RMLBRACE    8
  1338. + #define    FT_RMRBRACE    9
  1339.   #define FT_CLNEW    10
  1340.   #define FT_CLISNEW    11
  1341.   #define FT_CLANSWER    12
  1342. ***************
  1343. *** 179,191 ****
  1344.   #define FT_OBISNEW    13
  1345.   #define FT_OBCLASS    14
  1346.   #define FT_OBSHOW    15
  1347. !     
  1348.   /* macro to push a value onto the argument stack */
  1349.   #define pusharg(x)    {if (xlsp >= xlargstktop) xlargstkoverflow();\
  1350. !              *xlsp++ = (x);}
  1351.   
  1352.   /* macros to protect pointers */
  1353. ! #define xlstkcheck(n)    {if (xlstack - (n) < xlstkbase) xlstkoverflow();}
  1354.   #define xlsave(n)    {*--xlstack = &n; n = NIL;}
  1355.   #define xlprotect(n)    {*--xlstack = &n;}
  1356.   
  1357. --- 204,216 ----
  1358.   #define FT_OBISNEW    13
  1359.   #define FT_OBCLASS    14
  1360.   #define FT_OBSHOW    15
  1361. ! 
  1362.   /* macro to push a value onto the argument stack */
  1363.   #define pusharg(x)    {if (xlsp >= xlargstktop) xlargstkoverflow();\
  1364. !              *(xlsp++) = (x);}
  1365.   
  1366.   /* macros to protect pointers */
  1367. ! #define xlstkcheck(n)    {if ((xlstack - (n)) < xlstkbase) xlstkoverflow();}
  1368.   #define xlsave(n)    {*--xlstack = &n; n = NIL;}
  1369.   #define xlprotect(n)    {*--xlstack = &n;}
  1370.   
  1371. ***************
  1372. *** 230,235 ****
  1373. --- 255,261 ----
  1374.   #define ustreamp(x)    ((x) && ntype(x) == USTREAM)
  1375.   #define boundp(x)    (getvalue(x) != s_unbound)
  1376.   #define fboundp(x)    (getfunction(x) != s_unbound)
  1377. + #define    winobjp(x)    ((x) && ntype(x) == WINOBJ)
  1378.   
  1379.   /* shorthand functions */
  1380.   #define consa(x)    cons(x,NIL)
  1381. ***************
  1382. *** 323,326 ****
  1383.   /* error reporting functions (don't *really* return at all) */
  1384.   extern LVAL xltoofew();        /* report "too few arguments" error */
  1385.   extern LVAL xlbadtype();    /* report "bad argument type" error */
  1386. - 
  1387. --- 349,351 ----
  1388. diff -c ../xlisp.org/xlobj.c ../xlisp/xlobj.c
  1389. *** ../xlisp.org/xlobj.c    Sun May  7 22:26:20 1989
  1390. --- ../xlisp/xlobj.c    Wed Apr  5 16:18:40 1989
  1391. ***************
  1392. *** 41,47 ****
  1393.   /* xsendsuper - send a message to the superclass of an object */
  1394.   LVAL xsendsuper()
  1395.   {
  1396. !     LVAL env,p;
  1397.       for (env = xlenv; env; env = cdr(env))
  1398.       if ((p = car(env)) && objectp(car(p)))
  1399.           return (sendmsg(car(p),
  1400. --- 41,47 ----
  1401.   /* xsendsuper - send a message to the superclass of an object */
  1402.   LVAL xsendsuper()
  1403.   {
  1404. !     register LVAL env,p;
  1405.       for (env = xlenv; env; env = cdr(env))
  1406.       if ((p = car(env)) && objectp(car(p)))
  1407.           return (sendmsg(car(p),
  1408. ***************
  1409. *** 97,104 ****
  1410.   int xlobgetvalue(pair,sym,pval)
  1411.     LVAL pair,sym,*pval;
  1412.   {
  1413. !     LVAL cls,names;
  1414. !     int ivtotal,n;
  1415.   
  1416.       /* find the instance or class variable */
  1417.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  1418. --- 97,104 ----
  1419.   int xlobgetvalue(pair,sym,pval)
  1420.     LVAL pair,sym,*pval;
  1421.   {
  1422. !     register LVAL cls,names;
  1423. !     register int ivtotal,n;
  1424.   
  1425.       /* find the instance or class variable */
  1426.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  1427. ***************
  1428. *** 133,140 ****
  1429.   int xlobsetvalue(pair,sym,val)
  1430.     LVAL pair,sym,val;
  1431.   {
  1432. !     LVAL cls,names;
  1433. !     int ivtotal,n;
  1434.   
  1435.       /* find the instance or class variable */
  1436.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  1437. --- 133,140 ----
  1438.   int xlobsetvalue(pair,sym,val)
  1439.     LVAL pair,sym,val;
  1440.   {
  1441. !     register LVAL cls,names;
  1442. !     register int ivtotal,n;
  1443.   
  1444.       /* find the instance or class variable */
  1445.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  1446. ***************
  1447. *** 309,315 ****
  1448.   LOCAL LVAL sendmsg(obj,cls,sym)
  1449.     LVAL obj,cls,sym;
  1450.   {
  1451. !     LVAL msg,msgcls,method,val,p;
  1452.   
  1453.       /* look for the message in the class or superclasses */
  1454.       for (msgcls = cls; msgcls; ) {
  1455. --- 309,316 ----
  1456.   LOCAL LVAL sendmsg(obj,cls,sym)
  1457.     LVAL obj,cls,sym;
  1458.   {
  1459. !     LVAL method,val;
  1460. !     register LVAL msg,msgcls,p;
  1461.   
  1462.       /* look for the message in the class or superclasses */
  1463.       for (msgcls = cls; msgcls; ) {
  1464. ***************
  1465. *** 316,322 ****
  1466.   
  1467.       /* lookup the message in this class */
  1468.       for (p = getivar(msgcls,MESSAGES); p; p = cdr(p))
  1469. !         if ((msg = car(p)) && car(msg) == sym)
  1470.           goto send_message;
  1471.   
  1472.       /* look in class's superclass */
  1473. --- 317,323 ----
  1474.   
  1475.       /* lookup the message in this class */
  1476.       for (p = getivar(msgcls,MESSAGES); p; p = cdr(p))
  1477. !         if ((msg = car(p)) ? car(msg) == sym : 0)
  1478.           goto send_message;
  1479.   
  1480.       /* look in class's superclass */
  1481. ***************
  1482. *** 363,369 ****
  1483.   LOCAL LVAL evmethod(obj,msgcls,method)
  1484.     LVAL obj,msgcls,method;
  1485.   {
  1486. !     LVAL oldenv,oldfenv,cptr,name,val;
  1487.       CONTEXT cntxt;
  1488.   
  1489.       /* protect some pointers */
  1490. --- 364,370 ----
  1491.   LOCAL LVAL evmethod(obj,msgcls,method)
  1492.     LVAL obj,msgcls,method;
  1493.   {
  1494. !     LVAL oldenv,oldfenv,name,cptr,val;
  1495.       CONTEXT cntxt;
  1496.   
  1497.       /* protect some pointers */
  1498. ***************
  1499. *** 420,428 ****
  1500.   
  1501.   /* listlength - find the length of a list */
  1502.   LOCAL int listlength(list)
  1503. !   LVAL list;
  1504.   {
  1505. !     int len;
  1506.       for (len = 0; consp(list); len++)
  1507.       list = cdr(list);
  1508.       return (len);
  1509. --- 421,429 ----
  1510.   
  1511.   /* listlength - find the length of a list */
  1512.   LOCAL int listlength(list)
  1513. ! register LVAL list;
  1514.   {
  1515. !     register int len;
  1516.       for (len = 0; consp(list); len++)
  1517.       list = cdr(list);
  1518.       return (len);
  1519. ***************
  1520. *** 470,473 ****
  1521.       xladdmsg(object,":CLASS",FT_OBCLASS);
  1522.       xladdmsg(object,":SHOW",FT_OBSHOW);
  1523.   }
  1524. - 
  1525. --- 471,473 ----
  1526. diff -c ../xlisp.org/xlprin.c ../xlisp/xlprin.c
  1527. *** ../xlisp.org/xlprin.c    Sun May  7 22:26:23 1989
  1528. --- ../xlisp/xlprin.c    Fri May  5 13:35:51 1989
  1529. ***************
  1530. *** 33,38 ****
  1531. --- 33,41 ----
  1532.       case FSUBR:
  1533.           putsubr(fptr,"FSubr",vptr);
  1534.           break;
  1535. +     case WINOBJ:
  1536. +         putsymbol(fptr,"<Windows object>",flag);
  1537. +         break;
  1538.       case CONS:
  1539.           xlputc(fptr,'(');
  1540.           for (nptr = vptr; nptr != NIL; nptr = next) {
  1541. diff -c ../xlisp.org/xlread.c ../xlisp/xlread.c
  1542. *** ../xlisp.org/xlread.c    Sun May  7 22:26:26 1989
  1543. --- ../xlisp/xlread.c    Wed Apr  5 16:18:41 1989
  1544. ***************
  1545. *** 15,20 ****
  1546. --- 15,21 ----
  1547.   extern LVAL s_quote,s_function,s_bquote,s_comma,s_comat;
  1548.   extern LVAL s_rtable,k_wspace,k_const,k_nmacro,k_tmacro;
  1549.   extern LVAL k_sescape,k_mescape;
  1550. + extern LVAL s_send, s_sendsuper;
  1551.   extern char buf[];
  1552.   
  1553.   /* external routines */
  1554. ***************
  1555. *** 29,35 ****
  1556.   /* forward declarations */
  1557.   FORWARD LVAL callmacro();
  1558.   FORWARD LVAL psymbol(),punintern();
  1559. ! FORWARD LVAL pnumber(),pquote(),plist(),pvector();
  1560.   FORWARD LVAL tentry();
  1561.   
  1562.   /* xlload - load a file of xlisp expressions */
  1563. --- 30,36 ----
  1564.   /* forward declarations */
  1565.   FORWARD LVAL callmacro();
  1566.   FORWARD LVAL psymbol(),punintern();
  1567. ! FORWARD LVAL pnumber(),pquote(),plist(),pmessage(),pvector();
  1568.   FORWARD LVAL tentry();
  1569.   
  1570.   /* xlload - load a file of xlisp expressions */
  1571. ***************
  1572. *** 366,371 ****
  1573. --- 367,386 ----
  1574.       return (consa(plist(fptr)));
  1575.   }
  1576.   
  1577. + /* rmlbrace - read macro for '{' */
  1578. + LVAL rmlbrace()
  1579. + {
  1580. +     LVAL fptr,mch;
  1581. + 
  1582. +     /* get the file and macro character */
  1583. +     fptr = xlgetfile();
  1584. +     mch = xlgachar();
  1585. +     xllastarg();
  1586. + 
  1587. +     /* make the return value */
  1588. +     return (consa(pmessage(fptr)));
  1589. + }
  1590. + 
  1591.   /* rmrpar - read macro for ')' */
  1592.   LVAL rmrpar()
  1593.   {
  1594. ***************
  1595. *** 372,377 ****
  1596. --- 387,398 ----
  1597.       xlfail("misplaced right paren");
  1598.   }
  1599.   
  1600. + /* rmbrace - read macro for '}' */
  1601. + LVAL rmrbrace()
  1602. + {
  1603. +     xlfail("misplaced right brace");
  1604. + }
  1605. + 
  1606.   /* rmsemi - read macro for ';' */
  1607.   LVAL rmsemi()
  1608.   {
  1609. ***************
  1610. *** 485,490 ****
  1611. --- 506,555 ----
  1612.       return (val);
  1613.   }
  1614.   
  1615. + /* plist - parse a message */
  1616. + LOCAL LVAL pmessage(fptr)
  1617. +   LVAL fptr;
  1618. + {
  1619. +     LVAL val,expr,lastnptr,nptr;
  1620. +     LVAL mess = s_send;
  1621. + 
  1622. +     /* protect some pointers */
  1623. +     xlstkcheck(2);
  1624. +     xlsave(val);
  1625. +     xlsave(expr);
  1626. + 
  1627. +     if (nextch(fptr) == '+') { /* Look for super class message */
  1628. +     mess = s_sendsuper;
  1629. +     xlgetc(fptr);
  1630. +     }
  1631. + 
  1632. +     /* keep appending nodes until a closing paren is found */
  1633. +     for (lastnptr = NIL; nextch(fptr) != '}'; )
  1634. + 
  1635. +     /* get the next expression */
  1636. +     if (readone(fptr,&expr) == EOF)
  1637. +         badeof(fptr);
  1638. +     else {
  1639. +         nptr = consa(expr);
  1640. +         if (lastnptr == NIL)
  1641. +         val = nptr;
  1642. +         else
  1643. +         rplacd(lastnptr,nptr);
  1644. +         lastnptr = nptr;
  1645. +         }
  1646. + 
  1647. +     /* skip the closing bracket */
  1648. +     xlgetc(fptr);
  1649. + 
  1650. +     val = cons(mess,val);
  1651. + 
  1652. +     /* restore the stack */
  1653. +     xlpopn(2);
  1654. + 
  1655. +     /* return successfully */
  1656. +     return (val);
  1657. + }
  1658. + 
  1659.   /* pvector - parse a vector */
  1660.   LOCAL LVAL pvector(fptr)
  1661.     LVAL fptr;
  1662. ***************
  1663. *** 807,811 ****
  1664. --- 872,878 ----
  1665.       defmacro('(', k_tmacro,FT_RMLPAR);
  1666.       defmacro(')', k_tmacro,FT_RMRPAR);
  1667.       defmacro(';', k_tmacro,FT_RMSEMI);
  1668. +     defmacro('{', k_tmacro,FT_RMLBRACE);
  1669. +     defmacro('}', k_tmacro,FT_RMRBRACE);
  1670.   }
  1671.   
  1672. diff -c ../xlisp.org/xlsym.c ../xlisp/xlsym.c
  1673. *** ../xlisp.org/xlsym.c    Sun May  7 22:26:32 1989
  1674. --- ../xlisp/xlsym.c    Wed Apr  5 16:18:43 1989
  1675. ***************
  1676. *** 4,10 ****
  1677.       Permission is granted for unrestricted non-commercial use    */
  1678.   
  1679.   #include "xlisp.h"
  1680. ! 
  1681.   /* external variables */
  1682.   extern LVAL obarray,s_unbound;
  1683.   extern LVAL xlenv,xlfenv,xldenv;
  1684. --- 4,11 ----
  1685.       Permission is granted for unrestricted non-commercial use    */
  1686.   
  1687.   #include "xlisp.h"
  1688. ! #undef HSIZE
  1689. ! #define HSIZE 399
  1690.   /* external variables */
  1691.   extern LVAL obarray,s_unbound;
  1692.   extern LVAL xlenv,xlfenv,xldenv;
  1693. ***************
  1694. *** 16,22 ****
  1695.   LVAL xlenter(name)
  1696.     char *name;
  1697.   {
  1698. !     LVAL sym,array;
  1699.       int i;
  1700.   
  1701.       /* check for nil */
  1702. --- 17,24 ----
  1703.   LVAL xlenter(name)
  1704.     char *name;
  1705.   {
  1706. !     register LVAL sym,array;
  1707. !     LVAL sym2;
  1708.       int i;
  1709.   
  1710.       /* check for nil */
  1711. ***************
  1712. *** 31,44 ****
  1713.           return (car(sym));
  1714.   
  1715.       /* make a new symbol node and link it into the list */
  1716. !     xlsave1(sym);
  1717. !     sym = consd(getelement(array,i));
  1718. !     rplaca(sym,xlmakesym(name));
  1719. !     setelement(array,i,sym);
  1720.       xlpop();
  1721. - 
  1722.       /* return the new symbol */
  1723. !     return (car(sym));
  1724.   }
  1725.   
  1726.   /* xlmakesym - make a new symbol node */
  1727. --- 33,45 ----
  1728.           return (car(sym));
  1729.   
  1730.       /* make a new symbol node and link it into the list */
  1731. !     xlsave1(sym2);
  1732. !     sym2 = consd(getelement(array,i));
  1733. !     rplaca(sym2,xlmakesym(name));
  1734. !     setelement(array,i,sym2);
  1735.       xlpop();
  1736.       /* return the new symbol */
  1737. !     return (car(sym2));
  1738.   }
  1739.   
  1740.   /* xlmakesym - make a new symbol node */
  1741. ***************
  1742. *** 68,74 ****
  1743.   
  1744.   /* xlxgetvalue - get the value of a symbol */
  1745.   LVAL xlxgetvalue(sym)
  1746. !   LVAL sym;
  1747.   {
  1748.       register LVAL fp,ep;
  1749.       LVAL val;
  1750. --- 69,75 ----
  1751.   
  1752.   /* xlxgetvalue - get the value of a symbol */
  1753.   LVAL xlxgetvalue(sym)
  1754. ! register LVAL sym;
  1755.   {
  1756.       register LVAL fp,ep;
  1757.       LVAL val;
  1758. ***************
  1759. *** 95,101 ****
  1760.   
  1761.   /* xlsetvalue - set the value of a symbol */
  1762.   xlsetvalue(sym,val)
  1763. !   LVAL sym,val;
  1764.   {
  1765.       register LVAL fp,ep;
  1766.   
  1767. --- 96,103 ----
  1768.   
  1769.   /* xlsetvalue - set the value of a symbol */
  1770.   xlsetvalue(sym,val)
  1771. !   register LVAL sym;
  1772. !   LVAL val;
  1773.   {
  1774.       register LVAL fp,ep;
  1775.   
  1776. ***************
  1777. *** 137,143 ****
  1778.   
  1779.   /* xlxgetfunction - get the functional value of a symbol */
  1780.   LVAL xlxgetfunction(sym)
  1781. !   LVAL sym;
  1782.   {
  1783.       register LVAL fp,ep;
  1784.   
  1785. --- 139,145 ----
  1786.   
  1787.   /* xlxgetfunction - get the functional value of a symbol */
  1788.   LVAL xlxgetfunction(sym)
  1789. ! register  LVAL sym;
  1790.   {
  1791.       register LVAL fp,ep;
  1792.   
  1793. ***************
  1794. *** 192,198 ****
  1795.   xlremprop(sym,prp)
  1796.     LVAL sym,prp;
  1797.   {
  1798. !     LVAL last,p;
  1799.       last = NIL;
  1800.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(last)) {
  1801.       if (car(p) == prp)
  1802. --- 194,200 ----
  1803.   xlremprop(sym,prp)
  1804.     LVAL sym,prp;
  1805.   {
  1806. !     register LVAL last,p;
  1807.       last = NIL;
  1808.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(last)) {
  1809.       if (car(p) == prp)
  1810. ***************
  1811. *** 208,214 ****
  1812.   LOCAL LVAL findprop(sym,prp)
  1813.     LVAL sym,prp;
  1814.   {
  1815. !     LVAL p;
  1816.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(cdr(p)))
  1817.       if (car(p) == prp)
  1818.           return (cdr(p));
  1819. --- 210,216 ----
  1820.   LOCAL LVAL findprop(sym,prp)
  1821.     LVAL sym,prp;
  1822.   {
  1823. !     register LVAL p;
  1824.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(cdr(p)))
  1825.       if (car(p) == prp)
  1826.           return (cdr(p));
  1827. ***************
  1828. *** 217,226 ****
  1829.   
  1830.   /* hash - hash a symbol name string */
  1831.   int hash(str,len)
  1832. !   char *str;
  1833.   {
  1834. !     int i;
  1835. !     for (i = 0; *str; )
  1836.       i = (i << 2) ^ *str++;
  1837.       i %= len;
  1838.       return (i < 0 ? -i : i);
  1839. --- 219,228 ----
  1840.   
  1841.   /* hash - hash a symbol name string */
  1842.   int hash(str,len)
  1843. ! register char *str;
  1844.   {
  1845. !     register int i = 0;
  1846. !     while (*str)
  1847.       i = (i << 2) ^ *str++;
  1848.       i %= len;
  1849.       return (i < 0 ? -i : i);
  1850.  
  1851.  
  1852.  
  1853.