home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / XLSP21TC.ZIP / XLSPEED.DIF / text0001.txt < prev   
Encoding:
Text File  |  1991-04-14  |  23.4 KB  |  917 lines
  1. diff -c ../xlisp.org/xlftab.c ../xlisp/xlftab.c
  2. *** ../xlisp.org/xlftab.c    Sun May  7 22:25:54 1989
  3. --- ../xlisp/xlftab.c    Wed Apr  5 16:18:28 1989
  4. ***************
  5. *** 11,17 ****
  6.       rmhash(),rmquote(),rmdquote(),rmbquote(),rmcomma(),
  7.       clnew(),clisnew(),clanswer(),
  8.       obisnew(),obclass(),obshow(),
  9. !     rmlpar(),rmrpar(),rmsemi(),
  10.       xeval(),xapply(),xfuncall(),xquote(),xfunction(),xbquote(),
  11.       xlambda(),xset(),xsetq(),xsetf(),xdefun(),xdefmacro(),
  12.       xgensym(),xmakesymbol(),xintern(),
  13. --- 11,17 ----
  14.       rmhash(),rmquote(),rmdquote(),rmbquote(),rmcomma(),
  15.       clnew(),clisnew(),clanswer(),
  16.       obisnew(),obclass(),obshow(),
  17. !     rmlpar(),rmrpar(),rmlbrace(),rmrbrace(),rmsemi(),
  18.       xeval(),xapply(),xfuncall(),xquote(),xfunction(),xbquote(),
  19.       xlambda(),xset(),xsetq(),xsetf(),xdefun(),xdefmacro(),
  20.       xgensym(),xmakesymbol(),xintern(),
  21. ***************
  22. *** 70,76 ****
  23.       xcharp(),xcharint(),xintchar(),
  24.       xmkstrinput(),xmkstroutput(),xgetstroutput(),xgetlstoutput(),
  25.       xgetlambda(),xmacroexpand(),x1macroexpand(),
  26. !     xtrace(),xuntrace();
  27.   
  28.   /* functions specific to xldmem.c */
  29.   LVAL xgc(),xexpand(),xalloc(),xmem();
  30. --- 70,76 ----
  31.       xcharp(),xcharint(),xintchar(),
  32.       xmkstrinput(),xmkstroutput(),xgetstroutput(),xgetlstoutput(),
  33.       xgetlambda(),xmacroexpand(),x1macroexpand(),
  34. !     xtrace(),xuntrace(),xcopyarray();
  35.   
  36.   /* functions specific to xldmem.c */
  37.   LVAL xgc(),xexpand(),xalloc(),xmem();
  38. ***************
  39. *** 90,96 ****
  40.   
  41.   /* the function table */
  42.   FUNDEF funtab[] = {
  43. - 
  44.       /* read macro functions */
  45.   {    NULL,                S, rmhash        }, /*   0 */
  46.   {    NULL,                S, rmquote        }, /*   1 */
  47. --- 90,95 ----
  48. ***************
  49. *** 100,107 ****
  50.   {    NULL,                S, rmlpar        }, /*   5 */
  51.   {    NULL,                S, rmrpar        }, /*   6 */
  52.   {    NULL,                S, rmsemi        }, /*   7 */
  53. ! {    NULL,                S, xnotimp        }, /*   8 */
  54. ! {    NULL,                S, xnotimp        }, /*   9 */
  55.   
  56.       /* methods */
  57.   {    NULL,                S, clnew        }, /*  10 */
  58. --- 99,106 ----
  59.   {    NULL,                S, rmlpar        }, /*   5 */
  60.   {    NULL,                S, rmrpar        }, /*   6 */
  61.   {    NULL,                S, rmsemi        }, /*   7 */
  62. ! {    NULL,                S, rmlbrace        }, /*   8 */
  63. ! {    NULL,                S, rmrbrace        }, /*   9 */
  64.   
  65.       /* methods */
  66.   {    NULL,                S, clnew        }, /*  10 */
  67. ***************
  68. *** 426,432 ****
  69.   {    "SORT",                S, xsort        }, /* 284 */
  70.   
  71.       /* extra table entries */
  72. ! {    NULL,                S, xnotimp        }, /* 285 */
  73.   {    NULL,                S, xnotimp        }, /* 286 */
  74.   {    NULL,                S, xnotimp        }, /* 287 */
  75.   {    NULL,                S, xnotimp        }, /* 288 */
  76. --- 425,431 ----
  77.   {    "SORT",                S, xsort        }, /* 284 */
  78.   
  79.       /* extra table entries */
  80. ! {    "COPY-ARRAY",            S, xcopyarray        }, /* 285 */
  81.   {    NULL,                S, xnotimp        }, /* 286 */
  82.   {    NULL,                S, xnotimp        }, /* 287 */
  83.   {    NULL,                S, xnotimp        }, /* 288 */
  84. ***************
  85. *** 447,453 ****
  86.   
  87.   {0,0,0} /* end of table marker */
  88.   
  89. ! };            
  90.   
  91.   /* xnotimp - function table entries that are currently not implemented */
  92.   LOCAL LVAL xnotimp()
  93. --- 446,452 ----
  94.   
  95.   {0,0,0} /* end of table marker */
  96.   
  97. ! };
  98.   
  99.   /* xnotimp - function table entries that are currently not implemented */
  100.   LOCAL LVAL xnotimp()
  101. diff -c ../xlisp.org/xlglob.c ../xlisp/xlglob.c
  102. *** ../xlisp.org/xlglob.c    Sun May  7 22:25:55 1989
  103. --- ../xlisp/xlglob.c    Wed Apr  5 16:18:28 1989
  104. ***************
  105. *** 22,27 ****
  106. --- 22,28 ----
  107.   LVAL s_1plus=NIL,s_2plus=NIL,s_3plus=NIL;
  108.   LVAL s_1star=NIL,s_2star=NIL,s_3star=NIL;
  109.   LVAL s_minus=NIL,s_printcase=NIL;
  110. + LVAL s_send=NIL,s_sendsuper=NIL;
  111.   
  112.   /* keywords */
  113.   LVAL k_test=NIL,k_tnot=NIL;
  114. diff -c ../xlisp.org/xlimage.c ../xlisp/xlimage.c
  115. *** ../xlisp.org/xlimage.c    Sun May  7 22:25:57 1989
  116. --- ../xlisp/xlimage.c    Wed Apr  5 16:18:28 1989
  117. ***************
  118. *** 22,28 ****
  119.   /* external procedures */
  120.   extern SEGMENT *newsegment();
  121.   extern FILE *osbopen();
  122. ! extern char *malloc();
  123.   
  124.   /* forward declarations */
  125.   OFFTYPE readptr();
  126. --- 22,28 ----
  127.   /* external procedures */
  128.   extern SEGMENT *newsegment();
  129.   extern FILE *osbopen();
  130. ! extern char *xlmalloc();
  131.   
  132.   /* forward declarations */
  133.   OFFTYPE readptr();
  134. ***************
  135. *** 170,176 ****
  136.       case USTREAM:
  137.           p = cviptr(off);
  138.           p->n_type = type;
  139. -         p->n_flags = 0;
  140.           rplaca(p,cviptr(readptr()));
  141.           rplacd(p,cviptr(readptr()));
  142.           off += 2;
  143. --- 170,175 ----
  144. ***************
  145. *** 192,198 ****
  146.           case VECTOR:
  147.           case CLOSURE:
  148.           max = getsize(p);
  149. !         if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
  150.               xlfatal("insufficient memory - vector");
  151.           total += (long)(max * sizeof(LVAL));
  152.           for (i = 0; i < max; ++i)
  153. --- 191,197 ----
  154.           case VECTOR:
  155.           case CLOSURE:
  156.           max = getsize(p);
  157. !         if ((p->n_vdata = (LVAL *)xlmalloc(max * sizeof(LVAL))) == NULL)
  158.               xlfatal("insufficient memory - vector");
  159.           total += (long)(max * sizeof(LVAL));
  160.           for (i = 0; i < max; ++i)
  161. ***************
  162. *** 200,206 ****
  163.           break;
  164.           case STRING:
  165.           max = getslength(p);
  166. !         if ((p->n_string = (unsigned char *)malloc(max)) == NULL)
  167.               xlfatal("insufficient memory - string");
  168.           total += (long)max;
  169.           for (cp = getstring(p); --max >= 0; )
  170. --- 199,205 ----
  171.           break;
  172.           case STRING:
  173.           max = getslength(p);
  174. !         if ((p->n_string = (unsigned char *)xlmalloc(max)) == NULL)
  175.               xlfatal("insufficient memory - string");
  176.           total += (long)max;
  177.           for (cp = getstring(p); --max >= 0; )
  178. ***************
  179. *** 247,257 ****
  180.           case VECTOR:
  181.           case CLOSURE:
  182.           if (p->n_vsize)
  183. !             free(p->n_vdata);
  184.           break;
  185.           case STRING:
  186.           if (getslength(p))
  187. !             free(getstring(p));
  188.           break;
  189.           case STREAM:
  190.           if ((fp = getfile(p)) && (fp != stdin && fp != stdout))
  191. --- 246,256 ----
  192.           case VECTOR:
  193.           case CLOSURE:
  194.           if (p->n_vsize)
  195. !             xlfree(p->n_vdata);
  196.           break;
  197.           case STRING:
  198.           if (getslength(p))
  199. !             xlfree(getstring(p));
  200.           break;
  201.           case STREAM:
  202.           if ((fp = getfile(p)) && (fp != stdin && fp != stdout))
  203. ***************
  204. *** 259,265 ****
  205.           break;
  206.           }
  207.       next = seg->sg_next;
  208. !     free(seg);
  209.       }
  210.   }
  211.   
  212. --- 258,264 ----
  213.           break;
  214.           }
  215.       next = seg->sg_next;
  216. !     xlfree(seg);
  217.       }
  218.   }
  219.   
  220. ***************
  221. *** 302,308 ****
  222.       char *p = (char *)&node->n_info;
  223.       int n = sizeof(union ninfo);
  224.       node->n_type = type;
  225. -     node->n_flags = 0;
  226.       while (--n >= 0)
  227.       *p++ = osbgetc(fp);
  228.   }
  229. --- 301,306 ----
  230. diff -c ../xlisp.org/xlinit.c ../xlisp/xlinit.c
  231. *** ../xlisp.org/xlinit.c    Sun May  7 22:25:59 1989
  232. --- ../xlisp/xlinit.c    Wed Apr  5 16:18:29 1989
  233. ***************
  234. *** 27,32 ****
  235. --- 27,33 ----
  236.   extern LVAL a_fixnum,a_flonum,a_string,a_stream,a_object;
  237.   extern LVAL a_vector,a_closure,a_char,a_ustream;
  238.   extern LVAL s_gcflag,s_gchook;
  239. + extern LVAL s_send,s_sendsuper;
  240.   extern FUNDEF funtab[];
  241.   
  242.   /* xlinit - xlisp initialization routine */
  243. ***************
  244. *** 106,111 ****
  245. --- 107,114 ----
  246.       s_eql    = xlenter("EQL");
  247.       s_ifmt    = xlenter("*INTEGER-FORMAT*");
  248.       s_ffmt    = xlenter("*FLOAT-FORMAT*");
  249. +     s_send    = xlenter("SEND");
  250. +     s_sendsuper = xlenter("SEND-SUPER");
  251.   
  252.       /* symbols set by the read-eval-print loop */
  253.       s_1plus    = xlenter("+");
  254. diff -c ../xlisp.org/xlisp.c ../xlisp/xlisp.c
  255. *** ../xlisp.org/xlisp.c    Sun May  7 22:26:02 1989
  256. --- ../xlisp/xlisp.c    Thu Apr  6 10:06:46 1989
  257. ***************
  258. *** 6,12 ****
  259.   #include "xlisp.h"
  260.   
  261.   /* define the banner line string */
  262. ! #define BANNER    "XLISP version 2.0, Copyright (c) 1988, by David Betz"
  263.   
  264.   /* global variables */
  265.   jmp_buf top_level;
  266. --- 6,12 ----
  267.   #include "xlisp.h"
  268.   
  269.   /* define the banner line string */
  270. ! #define BANNER    "XLISP version 2.0w, Copyright (c) 1988, by David Betz"
  271.   
  272.   /* global variables */
  273.   jmp_buf top_level;
  274. ***************
  275. *** 52,60 ****
  276.           }
  277.   #endif
  278.   
  279.       /* initialize and print the banner line */
  280.       osinit(BANNER);
  281. - 
  282.       /* setup initialization error handler */
  283.       xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  284.       if (setjmp(cntxt.c_jmpbuf))
  285. --- 52,63 ----
  286.           }
  287.   #endif
  288.   
  289. + #ifdef    X11
  290. +     parse_args(&argc,argv);
  291. + #endif
  292. + 
  293.       /* initialize and print the banner line */
  294.       osinit(BANNER);
  295.       /* setup initialization error handler */
  296.       xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  297.       if (setjmp(cntxt.c_jmpbuf))
  298. ***************
  299. *** 61,67 ****
  300.       xlfatal("fatal initialization error");
  301.       if (setjmp(top_level))
  302.       xlfatal("RESTORE not allowed during initialization");
  303. - 
  304.       /* initialize xlisp */
  305.       xlinit();
  306.       xlend(&cntxt);
  307. --- 64,69 ----
  308. diff -c ../xlisp.org/xlisp.h ../xlisp/xlisp.h
  309. *** ../xlisp.org/xlisp.h    Sun May  7 22:26:12 1989
  310. --- ../xlisp/xlisp.h    Wed Apr  5 16:23:51 1989
  311. ***************
  312. *** 4,10 ****
  313.       Permission is granted for unrestricted non-commercial use    */
  314.   
  315.   /* system specific definitions */
  316. ! /* #define UNIX */
  317.   
  318.   #include <stdio.h>
  319.   #include <ctype.h>
  320. --- 4,11 ----
  321.       Permission is granted for unrestricted non-commercial use    */
  322.   
  323.   /* system specific definitions */
  324. ! #define X11
  325. ! /* #define    ADEBUG */
  326.   
  327.   #include <stdio.h>
  328.   #include <ctype.h>
  329. ***************
  330. *** 24,29 ****
  331. --- 25,35 ----
  332.   /* OFFTYPE    number the size of an address (int) */
  333.   
  334.   /* for the BSD 4.3 system.  Might work for AT&T garbage */
  335. + #ifdef    X11
  336. + #define    UNIX
  337. + #define WINDOWS
  338. + #endif
  339. + 
  340.   #ifdef UNIX
  341.   #define NNODES        2000
  342.   #define SAVERESTORE
  343. ***************
  344. *** 82,87 ****
  345. --- 88,105 ----
  346.   #define OFFTYPE        long
  347.   #endif
  348.   
  349. + #ifdef MSW
  350. + #define NNODES        1000
  351. + #define AFMT        "%lx"
  352. + #define OFFTYPE        long
  353. + #define    WINDOWS
  354. + #define    VMEM
  355. + #define    MSC
  356. + #define    xlmalloc    WMalloc
  357. + #define    xlcalloc    WCalloc
  358. + #define    xlfree        WFree
  359. + #endif
  360. + 
  361.   /* for the Mark Williams C compiler - Atari ST */
  362.   #ifdef MWC
  363.   #define AFMT        "%lx"
  364. ***************
  365. *** 148,153 ****
  366. --- 166,176 ----
  367.   #ifndef UCHAR
  368.   #define UCHAR        unsigned char
  369.   #endif
  370. + #ifndef    xlmalloc
  371. + #define    xlmalloc    malloc
  372. + #define    xlcalloc    calloc
  373. + #define    xlfree        free
  374. + #endif
  375.   
  376.   /* useful definitions */
  377.   #define TRUE    1
  378. ***************
  379. *** 160,166 ****
  380.   #include "xldmem.h"
  381.   
  382.   /* program limits */
  383. ! #define STRMAX        100        /* maximum length of a string constant */
  384.   #define HSIZE        199        /* symbol hash table size */
  385.   #define SAMPLE        100        /* control character sample rate */
  386.   
  387. --- 183,189 ----
  388.   #include "xldmem.h"
  389.   
  390.   /* program limits */
  391. ! #define STRMAX        512        /* maximum length of a string constant */
  392.   #define HSIZE        199        /* symbol hash table size */
  393.   #define SAMPLE        100        /* control character sample rate */
  394.   
  395. ***************
  396. *** 173,178 ****
  397. --- 196,203 ----
  398.   #define FT_RMLPAR    5
  399.   #define FT_RMRPAR    6
  400.   #define FT_RMSEMI    7
  401. + #define    FT_RMLBRACE    8
  402. + #define    FT_RMRBRACE    9
  403.   #define FT_CLNEW    10
  404.   #define FT_CLISNEW    11
  405.   #define FT_CLANSWER    12
  406. ***************
  407. *** 179,191 ****
  408.   #define FT_OBISNEW    13
  409.   #define FT_OBCLASS    14
  410.   #define FT_OBSHOW    15
  411. !     
  412.   /* macro to push a value onto the argument stack */
  413.   #define pusharg(x)    {if (xlsp >= xlargstktop) xlargstkoverflow();\
  414. !              *xlsp++ = (x);}
  415.   
  416.   /* macros to protect pointers */
  417. ! #define xlstkcheck(n)    {if (xlstack - (n) < xlstkbase) xlstkoverflow();}
  418.   #define xlsave(n)    {*--xlstack = &n; n = NIL;}
  419.   #define xlprotect(n)    {*--xlstack = &n;}
  420.   
  421. --- 204,216 ----
  422.   #define FT_OBISNEW    13
  423.   #define FT_OBCLASS    14
  424.   #define FT_OBSHOW    15
  425. ! 
  426.   /* macro to push a value onto the argument stack */
  427.   #define pusharg(x)    {if (xlsp >= xlargstktop) xlargstkoverflow();\
  428. !              *(xlsp++) = (x);}
  429.   
  430.   /* macros to protect pointers */
  431. ! #define xlstkcheck(n)    {if ((xlstack - (n)) < xlstkbase) xlstkoverflow();}
  432.   #define xlsave(n)    {*--xlstack = &n; n = NIL;}
  433.   #define xlprotect(n)    {*--xlstack = &n;}
  434.   
  435. ***************
  436. *** 230,235 ****
  437. --- 255,261 ----
  438.   #define ustreamp(x)    ((x) && ntype(x) == USTREAM)
  439.   #define boundp(x)    (getvalue(x) != s_unbound)
  440.   #define fboundp(x)    (getfunction(x) != s_unbound)
  441. + #define    winobjp(x)    ((x) && ntype(x) == WINOBJ)
  442.   
  443.   /* shorthand functions */
  444.   #define consa(x)    cons(x,NIL)
  445. ***************
  446. *** 323,326 ****
  447.   /* error reporting functions (don't *really* return at all) */
  448.   extern LVAL xltoofew();        /* report "too few arguments" error */
  449.   extern LVAL xlbadtype();    /* report "bad argument type" error */
  450. - 
  451. --- 349,351 ----
  452. diff -c ../xlisp.org/xlobj.c ../xlisp/xlobj.c
  453. *** ../xlisp.org/xlobj.c    Sun May  7 22:26:20 1989
  454. --- ../xlisp/xlobj.c    Wed Apr  5 16:18:40 1989
  455. ***************
  456. *** 41,47 ****
  457.   /* xsendsuper - send a message to the superclass of an object */
  458.   LVAL xsendsuper()
  459.   {
  460. !     LVAL env,p;
  461.       for (env = xlenv; env; env = cdr(env))
  462.       if ((p = car(env)) && objectp(car(p)))
  463.           return (sendmsg(car(p),
  464. --- 41,47 ----
  465.   /* xsendsuper - send a message to the superclass of an object */
  466.   LVAL xsendsuper()
  467.   {
  468. !     register LVAL env,p;
  469.       for (env = xlenv; env; env = cdr(env))
  470.       if ((p = car(env)) && objectp(car(p)))
  471.           return (sendmsg(car(p),
  472. ***************
  473. *** 97,104 ****
  474.   int xlobgetvalue(pair,sym,pval)
  475.     LVAL pair,sym,*pval;
  476.   {
  477. !     LVAL cls,names;
  478. !     int ivtotal,n;
  479.   
  480.       /* find the instance or class variable */
  481.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  482. --- 97,104 ----
  483.   int xlobgetvalue(pair,sym,pval)
  484.     LVAL pair,sym,*pval;
  485.   {
  486. !     register LVAL cls,names;
  487. !     register int ivtotal,n;
  488.   
  489.       /* find the instance or class variable */
  490.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  491. ***************
  492. *** 133,140 ****
  493.   int xlobsetvalue(pair,sym,val)
  494.     LVAL pair,sym,val;
  495.   {
  496. !     LVAL cls,names;
  497. !     int ivtotal,n;
  498.   
  499.       /* find the instance or class variable */
  500.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  501. --- 133,140 ----
  502.   int xlobsetvalue(pair,sym,val)
  503.     LVAL pair,sym,val;
  504.   {
  505. !     register LVAL cls,names;
  506. !     register int ivtotal,n;
  507.   
  508.       /* find the instance or class variable */
  509.       for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
  510. ***************
  511. *** 309,315 ****
  512.   LOCAL LVAL sendmsg(obj,cls,sym)
  513.     LVAL obj,cls,sym;
  514.   {
  515. !     LVAL msg,msgcls,method,val,p;
  516.   
  517.       /* look for the message in the class or superclasses */
  518.       for (msgcls = cls; msgcls; ) {
  519. --- 309,316 ----
  520.   LOCAL LVAL sendmsg(obj,cls,sym)
  521.     LVAL obj,cls,sym;
  522.   {
  523. !     LVAL method,val;
  524. !     register LVAL msg,msgcls,p;
  525.   
  526.       /* look for the message in the class or superclasses */
  527.       for (msgcls = cls; msgcls; ) {
  528. ***************
  529. *** 316,322 ****
  530.   
  531.       /* lookup the message in this class */
  532.       for (p = getivar(msgcls,MESSAGES); p; p = cdr(p))
  533. !         if ((msg = car(p)) && car(msg) == sym)
  534.           goto send_message;
  535.   
  536.       /* look in class's superclass */
  537. --- 317,323 ----
  538.   
  539.       /* lookup the message in this class */
  540.       for (p = getivar(msgcls,MESSAGES); p; p = cdr(p))
  541. !         if ((msg = car(p)) ? car(msg) == sym : 0)
  542.           goto send_message;
  543.   
  544.       /* look in class's superclass */
  545. ***************
  546. *** 363,369 ****
  547.   LOCAL LVAL evmethod(obj,msgcls,method)
  548.     LVAL obj,msgcls,method;
  549.   {
  550. !     LVAL oldenv,oldfenv,cptr,name,val;
  551.       CONTEXT cntxt;
  552.   
  553.       /* protect some pointers */
  554. --- 364,370 ----
  555.   LOCAL LVAL evmethod(obj,msgcls,method)
  556.     LVAL obj,msgcls,method;
  557.   {
  558. !     LVAL oldenv,oldfenv,name,cptr,val;
  559.       CONTEXT cntxt;
  560.   
  561.       /* protect some pointers */
  562. ***************
  563. *** 420,428 ****
  564.   
  565.   /* listlength - find the length of a list */
  566.   LOCAL int listlength(list)
  567. !   LVAL list;
  568.   {
  569. !     int len;
  570.       for (len = 0; consp(list); len++)
  571.       list = cdr(list);
  572.       return (len);
  573. --- 421,429 ----
  574.   
  575.   /* listlength - find the length of a list */
  576.   LOCAL int listlength(list)
  577. ! register LVAL list;
  578.   {
  579. !     register int len;
  580.       for (len = 0; consp(list); len++)
  581.       list = cdr(list);
  582.       return (len);
  583. ***************
  584. *** 470,473 ****
  585.       xladdmsg(object,":CLASS",FT_OBCLASS);
  586.       xladdmsg(object,":SHOW",FT_OBSHOW);
  587.   }
  588. - 
  589. --- 471,473 ----
  590. diff -c ../xlisp.org/xlprin.c ../xlisp/xlprin.c
  591. *** ../xlisp.org/xlprin.c    Sun May  7 22:26:23 1989
  592. --- ../xlisp/xlprin.c    Fri May  5 13:35:51 1989
  593. ***************
  594. *** 33,38 ****
  595. --- 33,41 ----
  596.       case FSUBR:
  597.           putsubr(fptr,"FSubr",vptr);
  598.           break;
  599. +     case WINOBJ:
  600. +         putsymbol(fptr,"<Windows object>",flag);
  601. +         break;
  602.       case CONS:
  603.           xlputc(fptr,'(');
  604.           for (nptr = vptr; nptr != NIL; nptr = next) {
  605. diff -c ../xlisp.org/xlread.c ../xlisp/xlread.c
  606. *** ../xlisp.org/xlread.c    Sun May  7 22:26:26 1989
  607. --- ../xlisp/xlread.c    Wed Apr  5 16:18:41 1989
  608. ***************
  609. *** 15,20 ****
  610. --- 15,21 ----
  611.   extern LVAL s_quote,s_function,s_bquote,s_comma,s_comat;
  612.   extern LVAL s_rtable,k_wspace,k_const,k_nmacro,k_tmacro;
  613.   extern LVAL k_sescape,k_mescape;
  614. + extern LVAL s_send, s_sendsuper;
  615.   extern char buf[];
  616.   
  617.   /* external routines */
  618. ***************
  619. *** 29,35 ****
  620.   /* forward declarations */
  621.   FORWARD LVAL callmacro();
  622.   FORWARD LVAL psymbol(),punintern();
  623. ! FORWARD LVAL pnumber(),pquote(),plist(),pvector();
  624.   FORWARD LVAL tentry();
  625.   
  626.   /* xlload - load a file of xlisp expressions */
  627. --- 30,36 ----
  628.   /* forward declarations */
  629.   FORWARD LVAL callmacro();
  630.   FORWARD LVAL psymbol(),punintern();
  631. ! FORWARD LVAL pnumber(),pquote(),plist(),pmessage(),pvector();
  632.   FORWARD LVAL tentry();
  633.   
  634.   /* xlload - load a file of xlisp expressions */
  635. ***************
  636. *** 366,371 ****
  637. --- 367,386 ----
  638.       return (consa(plist(fptr)));
  639.   }
  640.   
  641. + /* rmlbrace - read macro for '{' */
  642. + LVAL rmlbrace()
  643. + {
  644. +     LVAL fptr,mch;
  645. + 
  646. +     /* get the file and macro character */
  647. +     fptr = xlgetfile();
  648. +     mch = xlgachar();
  649. +     xllastarg();
  650. + 
  651. +     /* make the return value */
  652. +     return (consa(pmessage(fptr)));
  653. + }
  654. + 
  655.   /* rmrpar - read macro for ')' */
  656.   LVAL rmrpar()
  657.   {
  658. ***************
  659. *** 372,377 ****
  660. --- 387,398 ----
  661.       xlfail("misplaced right paren");
  662.   }
  663.   
  664. + /* rmbrace - read macro for '}' */
  665. + LVAL rmrbrace()
  666. + {
  667. +     xlfail("misplaced right brace");
  668. + }
  669. + 
  670.   /* rmsemi - read macro for ';' */
  671.   LVAL rmsemi()
  672.   {
  673. ***************
  674. *** 485,490 ****
  675. --- 506,555 ----
  676.       return (val);
  677.   }
  678.   
  679. + /* plist - parse a message */
  680. + LOCAL LVAL pmessage(fptr)
  681. +   LVAL fptr;
  682. + {
  683. +     LVAL val,expr,lastnptr,nptr;
  684. +     LVAL mess = s_send;
  685. + 
  686. +     /* protect some pointers */
  687. +     xlstkcheck(2);
  688. +     xlsave(val);
  689. +     xlsave(expr);
  690. + 
  691. +     if (nextch(fptr) == '+') { /* Look for super class message */
  692. +     mess = s_sendsuper;
  693. +     xlgetc(fptr);
  694. +     }
  695. + 
  696. +     /* keep appending nodes until a closing paren is found */
  697. +     for (lastnptr = NIL; nextch(fptr) != '}'; )
  698. + 
  699. +     /* get the next expression */
  700. +     if (readone(fptr,&expr) == EOF)
  701. +         badeof(fptr);
  702. +     else {
  703. +         nptr = consa(expr);
  704. +         if (lastnptr == NIL)
  705. +         val = nptr;
  706. +         else
  707. +         rplacd(lastnptr,nptr);
  708. +         lastnptr = nptr;
  709. +         }
  710. + 
  711. +     /* skip the closing bracket */
  712. +     xlgetc(fptr);
  713. + 
  714. +     val = cons(mess,val);
  715. + 
  716. +     /* restore the stack */
  717. +     xlpopn(2);
  718. + 
  719. +     /* return successfully */
  720. +     return (val);
  721. + }
  722. + 
  723.   /* pvector - parse a vector */
  724.   LOCAL LVAL pvector(fptr)
  725.     LVAL fptr;
  726. ***************
  727. *** 807,811 ****
  728. --- 872,878 ----
  729.       defmacro('(', k_tmacro,FT_RMLPAR);
  730.       defmacro(')', k_tmacro,FT_RMRPAR);
  731.       defmacro(';', k_tmacro,FT_RMSEMI);
  732. +     defmacro('{', k_tmacro,FT_RMLBRACE);
  733. +     defmacro('}', k_tmacro,FT_RMRBRACE);
  734.   }
  735.   
  736. diff -c ../xlisp.org/xlsym.c ../xlisp/xlsym.c
  737. *** ../xlisp.org/xlsym.c    Sun May  7 22:26:32 1989
  738. --- ../xlisp/xlsym.c    Wed Apr  5 16:18:43 1989
  739. ***************
  740. *** 4,10 ****
  741.       Permission is granted for unrestricted non-commercial use    */
  742.   
  743.   #include "xlisp.h"
  744. ! 
  745.   /* external variables */
  746.   extern LVAL obarray,s_unbound;
  747.   extern LVAL xlenv,xlfenv,xldenv;
  748. --- 4,11 ----
  749.       Permission is granted for unrestricted non-commercial use    */
  750.   
  751.   #include "xlisp.h"
  752. ! #undef HSIZE
  753. ! #define HSIZE 399
  754.   /* external variables */
  755.   extern LVAL obarray,s_unbound;
  756.   extern LVAL xlenv,xlfenv,xldenv;
  757. ***************
  758. *** 16,22 ****
  759.   LVAL xlenter(name)
  760.     char *name;
  761.   {
  762. !     LVAL sym,array;
  763.       int i;
  764.   
  765.       /* check for nil */
  766. --- 17,24 ----
  767.   LVAL xlenter(name)
  768.     char *name;
  769.   {
  770. !     register LVAL sym,array;
  771. !     LVAL sym2;
  772.       int i;
  773.   
  774.       /* check for nil */
  775. ***************
  776. *** 31,44 ****
  777.           return (car(sym));
  778.   
  779.       /* make a new symbol node and link it into the list */
  780. !     xlsave1(sym);
  781. !     sym = consd(getelement(array,i));
  782. !     rplaca(sym,xlmakesym(name));
  783. !     setelement(array,i,sym);
  784.       xlpop();
  785. - 
  786.       /* return the new symbol */
  787. !     return (car(sym));
  788.   }
  789.   
  790.   /* xlmakesym - make a new symbol node */
  791. --- 33,45 ----
  792.           return (car(sym));
  793.   
  794.       /* make a new symbol node and link it into the list */
  795. !     xlsave1(sym2);
  796. !     sym2 = consd(getelement(array,i));
  797. !     rplaca(sym2,xlmakesym(name));
  798. !     setelement(array,i,sym2);
  799.       xlpop();
  800.       /* return the new symbol */
  801. !     return (car(sym2));
  802.   }
  803.   
  804.   /* xlmakesym - make a new symbol node */
  805. ***************
  806. *** 68,74 ****
  807.   
  808.   /* xlxgetvalue - get the value of a symbol */
  809.   LVAL xlxgetvalue(sym)
  810. !   LVAL sym;
  811.   {
  812.       register LVAL fp,ep;
  813.       LVAL val;
  814. --- 69,75 ----
  815.   
  816.   /* xlxgetvalue - get the value of a symbol */
  817.   LVAL xlxgetvalue(sym)
  818. ! register LVAL sym;
  819.   {
  820.       register LVAL fp,ep;
  821.       LVAL val;
  822. ***************
  823. *** 95,101 ****
  824.   
  825.   /* xlsetvalue - set the value of a symbol */
  826.   xlsetvalue(sym,val)
  827. !   LVAL sym,val;
  828.   {
  829.       register LVAL fp,ep;
  830.   
  831. --- 96,103 ----
  832.   
  833.   /* xlsetvalue - set the value of a symbol */
  834.   xlsetvalue(sym,val)
  835. !   register LVAL sym;
  836. !   LVAL val;
  837.   {
  838.       register LVAL fp,ep;
  839.   
  840. ***************
  841. *** 137,143 ****
  842.   
  843.   /* xlxgetfunction - get the functional value of a symbol */
  844.   LVAL xlxgetfunction(sym)
  845. !   LVAL sym;
  846.   {
  847.       register LVAL fp,ep;
  848.   
  849. --- 139,145 ----
  850.   
  851.   /* xlxgetfunction - get the functional value of a symbol */
  852.   LVAL xlxgetfunction(sym)
  853. ! register  LVAL sym;
  854.   {
  855.       register LVAL fp,ep;
  856.   
  857. ***************
  858. *** 192,198 ****
  859.   xlremprop(sym,prp)
  860.     LVAL sym,prp;
  861.   {
  862. !     LVAL last,p;
  863.       last = NIL;
  864.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(last)) {
  865.       if (car(p) == prp)
  866. --- 194,200 ----
  867.   xlremprop(sym,prp)
  868.     LVAL sym,prp;
  869.   {
  870. !     register LVAL last,p;
  871.       last = NIL;
  872.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(last)) {
  873.       if (car(p) == prp)
  874. ***************
  875. *** 208,214 ****
  876.   LOCAL LVAL findprop(sym,prp)
  877.     LVAL sym,prp;
  878.   {
  879. !     LVAL p;
  880.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(cdr(p)))
  881.       if (car(p) == prp)
  882.           return (cdr(p));
  883. --- 210,216 ----
  884.   LOCAL LVAL findprop(sym,prp)
  885.     LVAL sym,prp;
  886.   {
  887. !     register LVAL p;
  888.       for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(cdr(p)))
  889.       if (car(p) == prp)
  890.           return (cdr(p));
  891. ***************
  892. *** 217,226 ****
  893.   
  894.   /* hash - hash a symbol name string */
  895.   int hash(str,len)
  896. !   char *str;
  897.   {
  898. !     int i;
  899. !     for (i = 0; *str; )
  900.       i = (i << 2) ^ *str++;
  901.       i %= len;
  902.       return (i < 0 ? -i : i);
  903. --- 219,228 ----
  904.   
  905.   /* hash - hash a symbol name string */
  906.   int hash(str,len)
  907. ! register char *str;
  908.   {
  909. !     register int i = 0;
  910. !     while (*str)
  911.       i = (i << 2) ^ *str++;
  912.       i %= len;
  913.       return (i < 0 ? -i : i);
  914.  
  915.  
  916.  
  917.