home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / XLSP21TC.ZIP / XLSPEED.DIF / text0000.txt < prev    next >
Encoding:
Text File  |  1991-04-14  |  23.8 KB  |  913 lines
  1. The following are changes I have made to xlisp 2.0 source. Most of these
  2. changes produce considerable speed ups. This distribution is very
  3. rough but maybe someone can wade through it and come of with a cleaned
  4. up version of the speed ups. Note this is a striaght context diff so
  5. more than just the speed ups are included, BEWARE! If you are able to
  6. clean up or enhance these speed ups in any way I would apreciate the
  7. feedback.
  8.  
  9.                 JonnyG.
  10.  
  11. diff -c ../xlisp.org/xlbfun.c ../xlisp/xlbfun.c
  12. *** ../xlisp.org/xlbfun.c    Sun May  7 22:25:38 1989
  13. --- ../xlisp/xlbfun.c    Wed Apr  5 16:18:23 1989
  14. ***************
  15. *** 558,563 ****
  16. --- 558,578 ----
  17.       return (val);
  18.   }
  19.   
  20. + LVAL xcopyarray()
  21. + {
  22. +     LVAL src, dest;
  23. +     int num;
  24. +     register int i;
  25. + 
  26. +     src = xlgavector();
  27. +     dest = xlgavector();
  28. +     xllastarg();
  29. +     num = (getsize(src) < getsize(dest)) ? getsize(src) : getsize(dest);
  30. +     for (i = 0; i < num; i++)
  31. +         setelement(dest,i,getelement(src,i));
  32. +     return(dest);
  33. + }
  34. + 
  35.   /* xerror - special form 'error' */
  36.   LVAL xerror()
  37.   {
  38. diff -c ../xlisp.org/xldbug.c ../xlisp/xldbug.c
  39. *** ../xlisp.org/xldbug.c    Sun May  7 22:25:43 1989
  40. --- ../xlisp/xldbug.c    Wed Apr  5 16:18:24 1989
  41. ***************
  42. *** 14,20 ****
  43.   extern char buf[];
  44.   
  45.   /* external routines */
  46. ! extern char *malloc();
  47.   
  48.   /* forward declarations */
  49.   FORWARD LVAL stacktop();
  50. --- 14,20 ----
  51.   extern char buf[];
  52.   
  53.   /* external routines */
  54. ! extern char *xlmalloc();
  55.   
  56.   /* forward declarations */
  57.   FORWARD LVAL stacktop();
  58. diff -c ../xlisp.org/xldmem.c ../xlisp/xldmem.c
  59. *** ../xlisp.org/xldmem.c    Sun May  7 22:25:46 1989
  60. --- ../xlisp/xldmem.c    Wed Apr  5 16:18:25 1989
  61. ***************
  62. *** 6,13 ****
  63.   #include "xlisp.h"
  64.   
  65.   /* node flags */
  66. ! #define MARK    1
  67. ! #define LEFT    2
  68.   
  69.   /* macro to compute the size of a segment */
  70.   #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
  71. --- 6,13 ----
  72.   #include "xlisp.h"
  73.   
  74.   /* node flags */
  75. ! #define MARK    0x20
  76. ! #define LEFT    0x40
  77.   
  78.   /* macro to compute the size of a segment */
  79.   #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
  80. ***************
  81. *** 21,37 ****
  82.   SEGMENT *segs,*lastseg,*fixseg,*charseg;
  83.   int anodes,nsegs,gccalls;
  84.   long nnodes,nfree,total;
  85. ! LVAL fnodes;
  86.   
  87.   /* external procedures */
  88. ! extern char *malloc();
  89. ! extern char *calloc();
  90.   
  91.   /* forward declarations */
  92. ! FORWARD LVAL newnode();
  93.   FORWARD unsigned char *stralloc();
  94.   FORWARD SEGMENT *newsegment();
  95.   
  96.   /* cons - construct a new cons node */
  97.   LVAL cons(x,y)
  98.     LVAL x,y;
  99. --- 21,50 ----
  100.   SEGMENT *segs,*lastseg,*fixseg,*charseg;
  101.   int anodes,nsegs,gccalls;
  102.   long nnodes,nfree,total;
  103. ! LVAL fnodes = NIL;
  104.   
  105.   /* external procedures */
  106. ! extern char *xlmalloc();
  107. ! extern char *xlcalloc();
  108.   
  109.   /* forward declarations */
  110. ! FORWARD LVAL Newnode();
  111.   FORWARD unsigned char *stralloc();
  112.   FORWARD SEGMENT *newsegment();
  113.   
  114. + LVAL _nnode;
  115. + FIXTYPE _tfixed;
  116. + int _tint;
  117. + 
  118. + #define    newnode(type) (((_nnode = fnodes) != NIL) ? \
  119. +             ((fnodes = cdr(_nnode)), \
  120. +              nfree--, \
  121. +              (_nnode->n_type = type), \
  122. +              rplacd(_nnode,NIL), \
  123. +              _nnode) \
  124. +             : (_nnode = Newnode(type)))
  125. + 
  126. + 
  127.   /* cons - construct a new cons node */
  128.   LVAL cons(x,y)
  129.     LVAL x,y;
  130. ***************
  131. *** 129,140 ****
  132.   }
  133.   
  134.   /* cvfixnum - convert an integer to a fixnum node */
  135. ! LVAL cvfixnum(n)
  136.     FIXTYPE n;
  137.   {
  138.       LVAL val;
  139. -     if (n >= SFIXMIN && n <= SFIXMAX)
  140. -     return (&fixseg->sg_nodes[(int)n-SFIXMIN]);
  141.       val = newnode(FIXNUM);
  142.       val->n_fixnum = n;
  143.       return (val);
  144. --- 142,151 ----
  145.   }
  146.   
  147.   /* cvfixnum - convert an integer to a fixnum node */
  148. ! LVAL Cvfixnum(n)
  149.     FIXTYPE n;
  150.   {
  151.       LVAL val;
  152.       val = newnode(FIXNUM);
  153.       val->n_fixnum = n;
  154.       return (val);
  155. ***************
  156. *** 151,157 ****
  157.   }
  158.   
  159.   /* cvchar - convert an integer to a character node */
  160. ! LVAL cvchar(n)
  161.     int n;
  162.   {
  163.       if (n >= CHARMIN && n <= CHARMAX)
  164. --- 162,168 ----
  165.   }
  166.   
  167.   /* cvchar - convert an integer to a character node */
  168. ! LVAL Cvchar(n)
  169.     int n;
  170.   {
  171.       if (n >= CHARMIN && n <= CHARMAX)
  172. ***************
  173. *** 180,185 ****
  174. --- 191,225 ----
  175.       return (val);
  176.   }
  177.   
  178. + #ifdef    WINDOWS
  179. + LVAL newwinobj(size)
  180. + int size;
  181. + {
  182. +     LVAL val;
  183. +     val = newnode(WINOBJ);
  184. +     if (size > 0) {
  185. +         xlprot1(val);
  186. +         if ((val->n_winobj = xldcalloc(1,size)) == NULL) {
  187. +             findmem();
  188. +             if ((val->n_winobj = xldcalloc(1,size)) == NULL)
  189. +                 xlfail("insufficient memory");
  190. +             }
  191. +         xlpop();
  192. +         }
  193. +     else val->n_winobj = NULL;
  194. +     return(val);
  195. + }
  196. + 
  197. + LVAL cvwinobj(p)
  198. + char *p;
  199. +     {
  200. +     LVAL val;
  201. +     val = newnode(WINOBJ);
  202. +     val->n_winobj = p;
  203. +     return(val);
  204. +     }
  205. + #endif
  206. + 
  207.   /* newclosure - allocate and initialize a new closure */
  208.   LVAL newclosure(name,type,env,fenv)
  209.     LVAL name,type,env,fenv;
  210. ***************
  211. *** 204,212 ****
  212.       vect = newnode(VECTOR);
  213.       vect->n_vsize = 0;
  214.       if (bsize = size * sizeof(LVAL)) {
  215. !     if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL) {
  216.           findmem();
  217. !         if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL)
  218.           xlfail("insufficient vector space");
  219.       }
  220.       vect->n_vsize = size;
  221. --- 244,252 ----
  222.       vect = newnode(VECTOR);
  223.       vect->n_vsize = 0;
  224.       if (bsize = size * sizeof(LVAL)) {
  225. !     if ((vect->n_vdata = (LVAL *)xldcalloc(1,bsize)) == NULL) {
  226.           findmem();
  227. !         if ((vect->n_vdata = (LVAL *)xldcalloc(1,bsize)) == NULL)
  228.           xlfail("insufficient vector space");
  229.       }
  230.       vect->n_vsize = size;
  231. ***************
  232. *** 217,223 ****
  233.   }
  234.   
  235.   /* newnode - allocate a new node */
  236. ! LOCAL LVAL newnode(type)
  237.     int type;
  238.   {
  239.       LVAL nnode;
  240. --- 257,263 ----
  241.   }
  242.   
  243.   /* newnode - allocate a new node */
  244. ! LVAL Newnode(type)
  245.     int type;
  246.   {
  247.       LVAL nnode;
  248. ***************
  249. *** 248,256 ****
  250.       unsigned char *sptr;
  251.   
  252.       /* allocate memory for the string copy */
  253. !     if ((sptr = (unsigned char *)malloc(size)) == NULL) {
  254.       gc();  
  255. !     if ((sptr = (unsigned char *)malloc(size)) == NULL)
  256.           xlfail("insufficient string space");
  257.       }
  258.       total += (long)size;
  259. --- 288,296 ----
  260.       unsigned char *sptr;
  261.   
  262.       /* allocate memory for the string copy */
  263. !     if ((sptr = (unsigned char *)xldmalloc(size)) == NULL) {
  264.       gc();  
  265. !     if ((sptr = (unsigned char *)xldmalloc(size)) == NULL)
  266.           xlfail("insufficient string space");
  267.       }
  268.       total += (long)size;
  269. ***************
  270. *** 330,336 ****
  271.     LVAL ptr;
  272.   {
  273.       register LVAL this,prev,tmp;
  274. !     int type,i,n;
  275.   
  276.       /* initialize */
  277.       prev = NIL;
  278. --- 370,376 ----
  279.     LVAL ptr;
  280.   {
  281.       register LVAL this,prev,tmp;
  282. !     register int i,n;
  283.   
  284.       /* initialize */
  285.       prev = NIL;
  286. ***************
  287. *** 340,380 ****
  288.       for (;;) {
  289.   
  290.       /* descend as far as we can */
  291. !     while (!(this->n_flags & MARK))
  292.   
  293.           /* check cons and symbol nodes */
  294. !         if ((type = ntype(this)) == CONS) {
  295. !         if (tmp = car(this)) {
  296. !             this->n_flags |= MARK|LEFT;
  297. !             rplaca(this,prev);
  298. !         }
  299. !         else if (tmp = cdr(this)) {
  300. !             this->n_flags |= MARK;
  301.               rplacd(this,prev);
  302. !         }
  303. !         else {                /* both sides nil */
  304. !             this->n_flags |= MARK;
  305.               break;
  306. !         }
  307. !         prev = this;            /* step down the branch */
  308. !         this = tmp;
  309. !         }
  310. ! 
  311. !         /* mark other node types */
  312.           else {
  313. !         this->n_flags |= MARK;
  314. !         switch (type) {
  315. !         case SYMBOL:
  316. !         case OBJECT:
  317. !         case VECTOR:
  318. !         case CLOSURE:
  319. !             for (i = 0, n = getsize(this); --n >= 0; ++i)
  320. !             if (tmp = getelement(this,i))
  321. !                 mark(tmp);
  322. !             break;
  323. !         }
  324. !         break;
  325. !         }
  326.   
  327.       /* backup to a point where we can continue descending */
  328.       for (;;)
  329. --- 380,409 ----
  330.       for (;;) {
  331.   
  332.       /* descend as far as we can */
  333. !     while (!(this->n_type & MARK))
  334.   
  335.           /* check cons and symbol nodes */
  336. !         if ((i = (this->n_type |= MARK) & TYPEFIELD) == CONS) {
  337. !           if (tmp = car(this)) {
  338. !             this->n_type |= LEFT;
  339. !             rplaca(this,prev);}
  340. !           else if (tmp = cdr(this))
  341.               rplacd(this,prev);
  342. !           else                /* both sides nil */
  343.               break;
  344. !           prev = this;            /* step down the branch */
  345. !           this = tmp;
  346. !           }
  347.           else {
  348. !           if ((i & ARRAY) != 0)
  349. !         for (i = 0, n = getsize(this); i < n;)
  350. !           if (tmp = getelement(this,i++))
  351. !             if ((tmp->n_type & (ARRAY|MARK)) == ARRAY ||
  352. !              tmp->n_type == CONS)
  353. !                 mark(tmp);
  354. !             else tmp->n_type |= MARK;
  355. !           break;
  356. !           }
  357.   
  358.       /* backup to a point where we can continue descending */
  359.       for (;;)
  360. ***************
  361. *** 381,388 ****
  362.   
  363.           /* make sure there is a previous node */
  364.           if (prev) {
  365. !         if (prev->n_flags & LEFT) {    /* came from left side */
  366. !             prev->n_flags &= ~LEFT;
  367.               tmp = car(prev);
  368.               rplaca(prev,this);
  369.               if (this = cdr(prev)) {
  370. --- 410,417 ----
  371.   
  372.           /* make sure there is a previous node */
  373.           if (prev) {
  374. !         if (prev->n_type & LEFT) {    /* came from left side */
  375. !             prev->n_type &= ~LEFT;
  376.               tmp = car(prev);
  377.               rplaca(prev,this);
  378.               if (this = cdr(prev)) {
  379. ***************
  380. *** 399,406 ****
  381.           }
  382.   
  383.           /* no previous node, must be done */
  384. !         else
  385. !         return;
  386.       }
  387.   }
  388.   
  389. --- 428,434 ----
  390.           }
  391.   
  392.           /* no previous node, must be done */
  393. !         else return;
  394.       }
  395.   }
  396.   
  397. ***************
  398. *** 407,434 ****
  399.   /* sweep - sweep all unmarked nodes and add them to the free list */
  400.   LOCAL sweep()
  401.   {
  402. !     SEGMENT *seg;
  403. !     LVAL p;
  404. !     int n;
  405.   
  406. -     /* empty the free list */
  407.       fnodes = NIL;
  408. !     nfree = 0L;
  409.   
  410.       /* add all unmarked nodes */
  411.       for (seg = segs; seg; seg = seg->sg_next) {
  412. !     if (seg == fixseg)     /* don't sweep the fixnum segment */
  413.           continue;
  414. -     else if (seg == charseg) /* don't sweep the character segment */
  415. -         continue;
  416.       p = &seg->sg_nodes[0];
  417. !     for (n = seg->sg_size; --n >= 0; ++p)
  418. !         if (!(p->n_flags & MARK)) {
  419.           switch (ntype(p)) {
  420.           case STRING:
  421.               if (getstring(p) != NULL) {
  422.                   total -= (long)getslength(p);
  423. !                 free(getstring(p));
  424.               }
  425.               break;
  426.           case STREAM:
  427. --- 435,463 ----
  428.   /* sweep - sweep all unmarked nodes and add them to the free list */
  429.   LOCAL sweep()
  430.   {
  431. !     register SEGMENT *seg;
  432. !     register LVAL p;
  433. !     register int n;
  434.   
  435.       fnodes = NIL;
  436. !     nfree = 0l;
  437.   
  438.       /* add all unmarked nodes */
  439.       for (seg = segs; seg; seg = seg->sg_next) {
  440. !     if (seg == fixseg || seg == charseg)
  441. !          /* don't sweep the fixed segments */
  442.           continue;
  443.       p = &seg->sg_nodes[0];
  444. !     for (n = seg->sg_size; --n >= 0;)
  445. !         if (p->n_type & MARK)
  446. !         (p++)->n_type &= ~MARK;
  447. !         else {
  448.           switch (ntype(p)) {
  449.           case STRING:
  450.               if (getstring(p) != NULL) {
  451.                   total -= (long)getslength(p);
  452. !            /* Using getstring here breaks VMEM (JonnyG) */
  453. !                 xldfree(p->n_string);
  454.               }
  455.               break;
  456.           case STREAM:
  457. ***************
  458. *** 435,440 ****
  459. --- 464,474 ----
  460.               if (getfile(p))
  461.                   osclose(getfile(p));
  462.               break;
  463. + #ifdef    WINDOWS
  464. +         case WINOBJ:
  465. +             free_winobj(p);
  466. +             break;
  467. + #endif
  468.           case SYMBOL:
  469.           case OBJECT:
  470.           case VECTOR:
  471. ***************
  472. *** 441,447 ****
  473.           case CLOSURE:
  474.               if (p->n_vsize) {
  475.                   total -= (long) (p->n_vsize * sizeof(LVAL));
  476. !                 free(p->n_vdata);
  477.               }
  478.               break;
  479.           }
  480. --- 475,481 ----
  481.           case CLOSURE:
  482.               if (p->n_vsize) {
  483.                   total -= (long) (p->n_vsize * sizeof(LVAL));
  484. !                 xldfree(p->n_vdata);
  485.               }
  486.               break;
  487.           }
  488. ***************
  489. *** 448,458 ****
  490.           p->n_type = FREE;
  491.           rplaca(p,NIL);
  492.           rplacd(p,fnodes);
  493. !         fnodes = p;
  494. !         nfree += 1L;
  495.           }
  496. -         else
  497. -         p->n_flags &= ~MARK;
  498.       }
  499.   }
  500.   
  501. --- 482,490 ----
  502.           p->n_type = FREE;
  503.           rplaca(p,NIL);
  504.           rplacd(p,fnodes);
  505. !         fnodes = p++;
  506. !         nfree++;
  507.           }
  508.       }
  509.   }
  510.   
  511. ***************
  512. *** 485,491 ****
  513.       SEGMENT *newseg;
  514.   
  515.       /* allocate the new segment */
  516. !     if ((newseg = (SEGMENT *)calloc(1,segsize(n))) == NULL)
  517.       return (NULL);
  518.   
  519.       /* initialize the new segment */
  520. --- 517,524 ----
  521.       SEGMENT *newseg;
  522.   
  523.       /* allocate the new segment */
  524. ! 
  525. !     if ((newseg = (SEGMENT *)xlcalloc(1,segsize(n))) == NULL)
  526.       return (NULL);
  527.   
  528.       /* initialize the new segment */
  529. ***************
  530. *** 666,677 ****
  531.       s_gcflag = s_gchook = NIL;
  532.   
  533.       /* allocate the evaluation stack */
  534. !     if ((xlstkbase = (LVAL **)malloc(EDEPTH * sizeof(LVAL *))) == NULL)
  535.       xlfatal("insufficient memory");
  536.       xlstack = xlstktop = xlstkbase + EDEPTH;
  537.   
  538.       /* allocate the argument stack */
  539. !     if ((xlargstkbase = (LVAL *)malloc(ADEPTH * sizeof(LVAL))) == NULL)
  540.       xlfatal("insufficient memory");
  541.       xlargstktop = xlargstkbase + ADEPTH;
  542.       xlfp = xlsp = xlargstkbase;
  543. --- 699,710 ----
  544.       s_gcflag = s_gchook = NIL;
  545.   
  546.       /* allocate the evaluation stack */
  547. !     if ((xlstkbase = (LVAL **)xlmalloc(EDEPTH * sizeof(LVAL *))) == NULL)
  548.       xlfatal("insufficient memory");
  549.       xlstack = xlstktop = xlstkbase + EDEPTH;
  550.   
  551.       /* allocate the argument stack */
  552. !     if ((xlargstkbase = (LVAL *)xlmalloc(ADEPTH * sizeof(LVAL))) == NULL)
  553.       xlfatal("insufficient memory");
  554.       xlargstktop = xlargstkbase + ADEPTH;
  555.       xlfp = xlsp = xlargstkbase;
  556. diff -c ../xlisp.org/xldmem.h ../xlisp/xldmem.h
  557. *** ../xlisp.org/xldmem.h    Sun May  7 22:25:47 1989
  558. --- ../xlisp/xldmem.h    Wed Apr  5 16:45:38 1989
  559. ***************
  560. *** 13,21 ****
  561.   #define CHARMAX        255
  562.   #define CHARSIZE    256
  563.   
  564. - /* new node access macros */
  565. - #define ntype(x)    ((x)->n_type)
  566. - 
  567.   /* cons access macros */
  568.   #define car(x)        ((x)->n_car)
  569.   #define cdr(x)        ((x)->n_cdr)
  570. --- 13,18 ----
  571. ***************
  572. *** 23,72 ****
  573.   #define rplacd(x,y)    ((x)->n_cdr = (y))
  574.   
  575.   /* symbol access macros */
  576. ! #define getvalue(x)     ((x)->n_vdata[0])
  577. ! #define setvalue(x,v)     ((x)->n_vdata[0] = (v))
  578. ! #define getfunction(x)     ((x)->n_vdata[1])
  579. ! #define setfunction(x,v) ((x)->n_vdata[1] = (v))
  580. ! #define getplist(x)     ((x)->n_vdata[2])
  581. ! #define setplist(x,v)     ((x)->n_vdata[2] = (v))
  582. ! #define getpname(x)     ((x)->n_vdata[3])
  583. ! #define setpname(x,v)     ((x)->n_vdata[3] = (v))
  584.   #define SYMSIZE        4
  585.   
  586.   /* closure access macros */
  587. ! #define getname(x)         ((x)->n_vdata[0])
  588. ! #define setname(x,v)       ((x)->n_vdata[0] = (v))
  589. ! #define gettype(x)        ((x)->n_vdata[1])
  590. ! #define settype(x,v)      ((x)->n_vdata[1] = (v))
  591. ! #define getargs(x)         ((x)->n_vdata[2])
  592. ! #define setargs(x,v)       ((x)->n_vdata[2] = (v))
  593. ! #define getoargs(x)        ((x)->n_vdata[3])
  594. ! #define setoargs(x,v)      ((x)->n_vdata[3] = (v))
  595. ! #define getrest(x)         ((x)->n_vdata[4])
  596. ! #define setrest(x,v)       ((x)->n_vdata[4] = (v))
  597. ! #define getkargs(x)        ((x)->n_vdata[5])
  598. ! #define setkargs(x,v)      ((x)->n_vdata[5] = (v))
  599. ! #define getaargs(x)        ((x)->n_vdata[6])
  600. ! #define setaargs(x,v)      ((x)->n_vdata[6] = (v))
  601. ! #define getbody(x)         ((x)->n_vdata[7])
  602. ! #define setbody(x,v)       ((x)->n_vdata[7] = (v))
  603. ! #define getenv(x)    ((x)->n_vdata[8])
  604. ! #define setenv(x,v)    ((x)->n_vdata[8] = (v))
  605. ! #define getfenv(x)    ((x)->n_vdata[9])
  606. ! #define setfenv(x,v)    ((x)->n_vdata[9] = (v))
  607. ! #define getlambda(x)    ((x)->n_vdata[10])
  608. ! #define setlambda(x,v)    ((x)->n_vdata[10] = (v))
  609.   #define CLOSIZE        11
  610.   
  611.   /* vector access macros */
  612.   #define getsize(x)    ((x)->n_vsize)
  613. ! #define getelement(x,i)    ((x)->n_vdata[i])
  614. ! #define setelement(x,i,v) ((x)->n_vdata[i] = (v))
  615.   
  616.   /* object access macros */
  617. ! #define getclass(x)    ((x)->n_vdata[0])
  618. ! #define getivar(x,i)    ((x)->n_vdata[i+1])
  619. ! #define setivar(x,i,v)    ((x)->n_vdata[i+1] = (v))
  620.   
  621.   /* subr/fsubr access macros */
  622.   #define getsubr(x)    ((x)->n_subr)
  623. --- 20,69 ----
  624.   #define rplacd(x,y)    ((x)->n_cdr = (y))
  625.   
  626.   /* symbol access macros */
  627. ! #define getvalue(x)     (ACESSV(x,0))
  628. ! #define setvalue(x,v)     (ACESSV(x,0) = (v))
  629. ! #define getfunction(x)     (ACESSV(x,1))
  630. ! #define setfunction(x,v) (ACESSV(x,1) = (v))
  631. ! #define getplist(x)     (ACESSV(x,2))
  632. ! #define setplist(x,v)     (ACESSV(x,2) = (v))
  633. ! #define getpname(x)     (ACESSV(x,3))
  634. ! #define setpname(x,v)     (ACESSV(x,3) = (v))
  635.   #define SYMSIZE        4
  636.   
  637.   /* closure access macros */
  638. ! #define getname(x)         (ACESSV(x,0))
  639. ! #define setname(x,v)       (ACESSV(x,0) = (v))
  640. ! #define gettype(x)        (ACESSV(x,1))
  641. ! #define settype(x,v)      (ACESSV(x,1) = (v))
  642. ! #define getargs(x)         (ACESSV(x,2))
  643. ! #define setargs(x,v)       (ACESSV(x,2) = (v))
  644. ! #define getoargs(x)        (ACESSV(x,3))
  645. ! #define setoargs(x,v)      (ACESSV(x,3) = (v))
  646. ! #define getrest(x)         (ACESSV(x,4))
  647. ! #define setrest(x,v)       (ACESSV(x,4) = (v))
  648. ! #define getkargs(x)        (ACESSV(x,5))
  649. ! #define setkargs(x,v)      (ACESSV(x,5) = (v))
  650. ! #define getaargs(x)        (ACESSV(x,6))
  651. ! #define setaargs(x,v)      (ACESSV(x,6) = (v))
  652. ! #define getbody(x)         (ACESSV(x,7))
  653. ! #define setbody(x,v)       (ACESSV(x,7) = (v))
  654. ! #define getenv(x)    (ACESSV(x,8))
  655. ! #define setenv(x,v)    (ACESSV(x,8) = (v))
  656. ! #define getfenv(x)    (ACESSV(x,9))
  657. ! #define setfenv(x,v)    (ACESSV(x,9) = (v))
  658. ! #define getlambda(x)    (ACESSV(x,10))
  659. ! #define setlambda(x,v)    (ACESSV(x,10) = (v))
  660.   #define CLOSIZE        11
  661.   
  662.   /* vector access macros */
  663.   #define getsize(x)    ((x)->n_vsize)
  664. ! #define getelement(x,i)    (ACESSV(x,i))
  665. ! #define setelement(x,i,v) (ACESSV(x,i) = (v))
  666.   
  667.   /* object access macros */
  668. ! #define getclass(x)    (ACESSV(x,0))
  669. ! #define getivar(x,i)    (ACESSV(x,i+1))
  670. ! #define setivar(x,i,v)    (ACESSV(x,i+1) = (v))
  671.   
  672.   /* subr/fsubr access macros */
  673.   #define getsubr(x)    ((x)->n_subr)
  674. ***************
  675. *** 78,84 ****
  676.   #define getchcode(x)    ((x)->n_chcode)
  677.   
  678.   /* string access macros */
  679. ! #define getstring(x)    ((x)->n_string)
  680.   #define getslength(x)    ((x)->n_strlen)
  681.   
  682.   /* file stream access macros */
  683. --- 75,81 ----
  684.   #define getchcode(x)    ((x)->n_chcode)
  685.   
  686.   /* string access macros */
  687. ! #define getstring(x)    (ACESSS((x)->n_string))
  688.   #define getslength(x)    ((x)->n_strlen)
  689.   
  690.   /* file stream access macros */
  691. ***************
  692. *** 93,114 ****
  693.   #define gettail(x)    ((x)->n_cdr)
  694.   #define settail(x,v)    ((x)->n_cdr = (v))
  695.   
  696.   /* node types */
  697.   #define FREE    0
  698.   #define SUBR    1
  699.   #define FSUBR    2
  700.   #define CONS    3
  701. ! #define SYMBOL    4
  702. ! #define FIXNUM    5
  703. ! #define FLONUM    6
  704. ! #define STRING    7
  705. ! #define OBJECT    8
  706. ! #define STREAM    9
  707. ! #define VECTOR    10
  708. ! #define CLOSURE    11
  709. ! #define CHAR    12
  710. ! #define USTREAM    13
  711.   
  712.   /* subr/fsubr node */
  713.   #define n_subr        n_info.n_xsubr.xs_subr
  714.   #define n_offset    n_info.n_xsubr.xs_offset
  715. --- 90,121 ----
  716.   #define gettail(x)    ((x)->n_cdr)
  717.   #define settail(x,v)    ((x)->n_cdr = (v))
  718.   
  719. + #define    getwinobj(x)    (ACESSS((x)->n_winobj))
  720. + #define    setwinobj(x,v)    ((x)->n_winobj = (v))
  721. + 
  722.   /* node types */
  723.   #define FREE    0
  724. + #define SYMBOL    17
  725. + #define OBJECT    18
  726. + #define VECTOR    19
  727. + #define CLOSURE    20
  728.   #define SUBR    1
  729.   #define FSUBR    2
  730.   #define CONS    3
  731. ! #define FIXNUM    4
  732. ! #define FLONUM    5
  733. ! #define STRING    6
  734. ! #define STREAM    7
  735. ! #define CHAR    8
  736. ! #define USTREAM    9
  737. ! #define    WINOBJ    10
  738.   
  739. + #define    ARRAY    16
  740. + #define TYPEFIELD 0x1f
  741. + 
  742. + /* new node access macros */
  743. + #define ntype(x)    ((x)->n_type & TYPEFIELD)
  744. + 
  745.   /* subr/fsubr node */
  746.   #define n_subr        n_info.n_xsubr.xs_subr
  747.   #define n_offset    n_info.n_xsubr.xs_offset
  748. ***************
  749. *** 137,146 ****
  750.   #define n_vsize        n_info.n_xvector.xv_size
  751.   #define n_vdata        n_info.n_xvector.xv_data
  752.   
  753.   /* node structure */
  754.   typedef struct node {
  755.       char n_type;        /* type of node */
  756. -     char n_flags;        /* flag bits */
  757.       union ninfo {         /* value */
  758.       struct xsubr {        /* subr/fsubr node */
  759.           struct node *(*xs_subr)();    /* function pointer */
  760. --- 144,155 ----
  761.   #define n_vsize        n_info.n_xvector.xv_size
  762.   #define n_vdata        n_info.n_xvector.xv_data
  763.   
  764. + /* window/font node */
  765. + #define    n_winobj    n_info.n_xwinobj.xw_ptr
  766. + 
  767.   /* node structure */
  768.   typedef struct node {
  769.       char n_type;        /* type of node */
  770.       union ninfo {         /* value */
  771.       struct xsubr {        /* subr/fsubr node */
  772.           struct node *(*xs_subr)();    /* function pointer */
  773. ***************
  774. *** 171,176 ****
  775. --- 180,188 ----
  776.           int xv_size;        /* vector size */
  777.           struct node **xv_data;    /* vector data */
  778.       } n_xvector;
  779. +     struct xwinobj {    /* window/font object */
  780. +         char *xw_ptr;        /* Generic structure pointer */
  781. +     } n_xwinobj;
  782.       } n_info;
  783.   } *LVAL;
  784.   
  785. ***************
  786. *** 187,195 ****
  787.   extern LVAL cvstring();           /* convert a string */
  788.   extern LVAL cvfile();        /* convert a FILE * to a file */
  789.   extern LVAL cvsubr();        /* convert a function to a subr/fsubr */
  790. ! extern LVAL cvfixnum();           /* convert a fixnum */
  791.   extern LVAL cvflonum();           /* convert a flonum */
  792. ! extern LVAL cvchar();        /* convert a character */
  793.   
  794.   extern LVAL newstring();    /* create a new string */
  795.   extern LVAL newvector();    /* create a new vector */
  796. --- 199,207 ----
  797.   extern LVAL cvstring();           /* convert a string */
  798.   extern LVAL cvfile();        /* convert a FILE * to a file */
  799.   extern LVAL cvsubr();        /* convert a function to a subr/fsubr */
  800. ! extern LVAL Cvfixnum();           /* convert a fixnum */
  801.   extern LVAL cvflonum();           /* convert a flonum */
  802. ! extern LVAL Cvchar();        /* convert a character */
  803.   
  804.   extern LVAL newstring();    /* create a new string */
  805.   extern LVAL newvector();    /* create a new vector */
  806. ***************
  807. *** 196,198 ****
  808. --- 208,249 ----
  809.   extern LVAL newobject();    /* create a new object */
  810.   extern LVAL newclosure();    /* create a new closure */
  811.   extern LVAL newustream();    /* create a new unnamed stream */
  812. + 
  813. + 
  814. + /* Speed ups, reduce function calls for fixed characters and numbers       */
  815. + /* Speed is exeptionaly noticed on machines with large a instruction cache */
  816. + /* No size effects here (JonnyG) */
  817. + 
  818. + extern SEGMENT *fixseg,*charseg;
  819. + extern FIXTYPE _tfixed;
  820. + extern int _tint;
  821. + 
  822. + #define cvfixnum(n) ((_tfixed = n), \
  823. +         ((_tfixed > SFIXMIN && _tfixed < SFIXMAX) ? \
  824. +         &fixseg->sg_nodes[(int)_tfixed-SFIXMIN] : \
  825. +         Cvfixnum(_tfixed)))
  826. + 
  827. + #define cvchar(c) ((_tint = c), \
  828. +         ((_tint >= CHARMIN && _tint <= CHARMIN) ? \
  829. +             &charseg->sg_nodes[_tint-CHARMIN] : \
  830. +         Cvchar(_tint)))
  831. + 
  832. + extern    char *xldmalloc();
  833. + extern    char *xldcalloc();
  834. + 
  835. + #ifdef    VMEM
  836. + 
  837. + extern char *vload();
  838. + 
  839. + extern    unsigned char *vaccess();
  840. + 
  841. + #define    ACESSV(x,i)    (((LVAL *)vaccess((x)->n_vdata))[i])
  842. + #define    ACESSS(x)    (vaccess(x))
  843. + 
  844. + #else
  845. + 
  846. + #define    xlfcalloc    xlcalloc
  847. + #define ACESSV(x,i)    (x)->n_vdata[i]
  848. + #define    ACESSS(x)    x
  849. + 
  850. + #endif
  851. diff -c ../xlisp.org/xlfio.c ../xlisp/xlfio.c
  852. *** ../xlisp.org/xlfio.c    Sun May  7 22:25:52 1989
  853. --- ../xlisp/xlfio.c    Wed Apr  5 16:18:27 1989
  854. ***************
  855. *** 349,355 ****
  856.   
  857.       /* copy the substring into the stream */
  858.       for (i = start; i < end; ++i)
  859. !     xlputc(val,str[i]);
  860.   
  861.       /* restore the stack */
  862.       xlpop();
  863. --- 349,355 ----
  864.   
  865.       /* copy the substring into the stream */
  866.       for (i = start; i < end; ++i)
  867. !     xlputc(val,getstring(string) + i);
  868.   
  869.       /* restore the stack */
  870.       xlpop();
  871. ***************
  872. *** 450,456 ****
  873.   LOCAL LVAL getstroutput(stream)
  874.     LVAL stream;
  875.   {
  876. !     unsigned char *str;
  877.       LVAL next,val;
  878.       int len,ch;
  879.   
  880. --- 450,456 ----
  881.   LOCAL LVAL getstroutput(stream)
  882.     LVAL stream;
  883.   {
  884. !     int i;
  885.       LVAL next,val;
  886.       int len,ch;
  887.   
  888. ***************
  889. *** 462,471 ****
  890.       val = newstring(len + 1);
  891.       
  892.       /* copy the characters into the new string */
  893. !     str = getstring(val);
  894.       while ((ch = xlgetc(stream)) != EOF)
  895. !     *str++ = ch;
  896. !     *str = '\0';
  897.   
  898.       /* return the string */
  899.       return (val);
  900. --- 462,471 ----
  901.       val = newstring(len + 1);
  902.       
  903.       /* copy the characters into the new string */
  904. !     i = 0;
  905.       while ((ch = xlgetc(stream)) != EOF)
  906. !     getstring(val)[i++] = ch;
  907. !     getstring(val)[i] = '\0';
  908.   
  909.       /* return the string */
  910.       return (val);
  911.  
  912.  
  913.