1 /* xldmem - xlisp dynamic memory management routines */
2 /* Copyright (c) 1985, by David Michael Betz
3 All Rights Reserved
4 Permission is granted for unrestricted non-commercial use
5
6 * HISTORY
7 * 28-Apr-03 Mazzoni
8 * eliminate some compiler warnings
9 * 14-Apr-88 Dannenberg
10 * Call free method when an EXTERN node is garbage collected
11 */
12
13
14 // #define DEBUG_MEM 1
15
16 #include "stdlib.h"
17 #include "string.h"
18 #include "limits.h"
19 #include "xlisp.h"
20
21 #ifdef WIN32
22 #include "malloc.h" // defines alloca()
23 #endif
24
25 /* node flags */
26 #define MARK 1
27 #define LEFT 2
28
29 /* macro to compute the size of a segment */
30 #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
31
32
33 #ifdef DEBUG_INPUT
34 extern FILE *debug_input_fp;
35 #endif
36
37 /* variables local to xldmem.c and xlimage.c */
38 SEGMENT *segs,*lastseg,*fixseg,*charseg;
39 int anodes,nsegs,gccalls;
40 long nnodes,nfree,total;
41 LVAL fnodes;
42
43 #ifdef DEBUG_MEM
44 long xldmem_trace = 0; /* debugging */
45 #endif
46
47 /* forward declarations */
48 FORWARD LOCAL void findmem(void);
49 FORWARD LVAL newnode(int type);
50 FORWARD LOCAL unsigned char *stralloc(int size);
51 FORWARD LOCAL int addseg(void);
52 FORWARD void mark(LVAL ptr);
53 FORWARD LOCAL void sweep(void);
54
55 extern void freeimage(void);
56
57 #ifdef DEBUG_GC
58 static long dbg_gc_n = 0; /* counts save operations */
59 long dbg_gc_count = 0; /* says when to stop */
60 LVAL *dbg_gc_addr = NULL; /* says what we're looking for */
61
dbg_gc_xlsave(LVAL * n)62 void dbg_gc_xlsave(LVAL *n)
63 {
64 dbg_gc_n++;
65 if (n == dbg_gc_addr) {
66 printf("dbg_gc_xlsave: %x at count %d\n",
67 dbg_gc_addr, dbg_gc_n);
68 }
69 if (dbg_gc_count == dbg_gc_n) {
70 printf("dbg_gc_xlsave: reached %d\n",
71 dbg_gc_count);
72 }
73 }
74
75
76 #endif
77
78
79 /* cons - construct a new cons node */
cons(LVAL x,LVAL y)80 LVAL cons(LVAL x, LVAL y)
81 {
82 LVAL nnode;
83 /* get a free node */
84 if ((nnode = fnodes) == NIL) {
85 xlstkcheck(2);
86 xlprotect(x);
87 xlprotect(y);
88 findmem();
89 if ((nnode = fnodes) == NIL)
90 xlabort("insufficient node space");
91 xlpop();
92 xlpop();
93 }
94
95 /* unlink the node from the free list */
96 fnodes = cdr(nnode);
97 --nfree;
98
99 /* initialize the new node */
100 nnode->n_type = CONS;
101 rplaca(nnode,x);
102 rplacd(nnode,y);
103
104 /* return the new node */
105 return (nnode);
106 }
107
108 /* cvstring - convert a string to a string node */
cvstring(const char * str)109 LVAL cvstring(const char *str)
110 {
111 LVAL val;
112 xlsave1(val);
113 size_t len = strlen(str) + 1;
114 if (len > 0x7FFFFFFF) {
115 xlfail("string too long");
116 }
117 val = newnode(STRING);
118 val->n_strlen = (int) len;
119 val->n_string = stralloc(getslength(val));
120 strcpy((char *) getstring(val), str);
121 xlpop();
122 return (val);
123 }
124
125 /* new_string - allocate and initialize a new string */
new_string(int size)126 LVAL new_string(int size)
127 {
128 LVAL val;
129 xlsave1(val);
130 val = newnode(STRING);
131 val->n_strlen = size;
132 val->n_string = stralloc(getslength(val));
133 strcpy((char *) getstring(val),"");
134 xlpop();
135 return (val);
136 }
137
138 /* cvsymbol - convert a string to a symbol */
cvsymbol(const char * pname)139 LVAL cvsymbol(const char *pname)
140 {
141 /* pname points to a global buffer space. This is ok unless you have
142 * a gc hook that writes things and therefore uses the buffer. Then
143 * if newvector causes a GC, pname is overwritten before cvstring is
144 * called and the symbol will have the wrong name!
145 * The bug is fixed by copying pname to the stack.
146 */
147 LVAL val;
148 size_t len = strlen(pname) + 1; /* don't forget the terminating zero */
149 if (len > 0x7FFFFFFF) { /* how much can we put on stack? */
150 xlfail("string too long");
151 }
152 char *local_pname_copy = (char *) alloca(len);
153 memcpy(local_pname_copy, pname, len);
154 xlsave1(val);
155 val = newvector(SYMSIZE);
156 val->n_type = SYMBOL;
157 setvalue(val,s_unbound);
158 setfunction(val,s_unbound);
159 setpname(val,cvstring(local_pname_copy));
160 xlpop();
161 return (val);
162 }
163
164 /* cvsubr - convert a function to a subr or fsubr */
cvsubr(LVAL (* fcn)(void),int type,int offset)165 LVAL cvsubr(LVAL (*fcn)(void), int type, int offset)
166 {
167 LVAL val;
168 val = newnode(type);
169 val->n_subr = fcn;
170 val->n_offset = offset;
171 return (val);
172 }
173
174 /* cvfile - convert a file pointer to a stream */
cvfile(FILE * fp)175 LVAL cvfile(FILE *fp)
176 {
177 LVAL val;
178 val = newnode(STREAM);
179 setfile(val,fp);
180 setsavech(val,'\0');
181 return (val);
182 }
183
184 /* cvfixnum - convert an integer to a fixnum node */
cvfixnum(FIXTYPE n)185 LVAL cvfixnum(FIXTYPE n)
186 {
187 LVAL val;
188 if (n >= SFIXMIN && n <= SFIXMAX)
189 return (&fixseg->sg_nodes[(int)n-SFIXMIN]);
190 val = newnode(FIXNUM);
191 val->n_fixnum = n;
192 return (val);
193 }
194
195 /* cvflonum - convert a floating point number to a flonum node */
cvflonum(FLOTYPE n)196 LVAL cvflonum(FLOTYPE n)
197 {
198 LVAL val;
199 val = newnode(FLONUM);
200 val->n_flonum = n;
201 return (val);
202 }
203
204 /* cvchar - convert an integer to a character node */
cvchar(int n)205 LVAL cvchar(int n)
206 {
207 if (n >= CHARMIN && n <= CHARMAX)
208 return (&charseg->sg_nodes[n-CHARMIN]);
209 xlerror("character code out of range",cvfixnum((FIXTYPE)n));
210 return NIL; /* won't reach this line */
211 }
212
213 /* newustream - create a new unnamed stream */
newustream(void)214 LVAL newustream(void)
215 {
216 LVAL val;
217 val = newnode(USTREAM);
218 sethead(val,NIL);
219 settail(val,NIL);
220 return (val);
221 }
222
223 /* newobject - allocate and initialize a new object */
newobject(LVAL cls,int size)224 LVAL newobject(LVAL cls, int size)
225 {
226 LVAL val;
227 val = newvector(size+1);
228 val->n_type = OBJECT;
229 setelement(val,0,cls);
230 return (val);
231 }
232
233 /* newclosure - allocate and initialize a new closure */
newclosure(LVAL name,LVAL type,LVAL env,LVAL fenv)234 LVAL newclosure(LVAL name, LVAL type, LVAL env, LVAL fenv)
235 {
236 LVAL val;
237 val = newvector(CLOSIZE);
238 val->n_type = CLOSURE;
239 setname(val,name);
240 settype(val,type);
241 setenv(val,env);
242 setfenv(val,fenv);
243 return (val);
244 }
245
246 /* newvector - allocate and initialize a new vector node */
newvector(int size)247 LVAL newvector(int size)
248 {
249 LVAL vect;
250 int bsize;
251 xlsave1(vect);
252 vect = newnode(VECTOR);
253 vect->n_vsize = 0;
254 if (size < 0) xlfail("negative vector size requested");
255 if (size > INT_MAX / sizeof(LVAL))
256 xlfail("too large vector size requested");
257 if ((bsize = size * sizeof(LVAL))) {
258 if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL) {
259 findmem();
260 if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL)
261 xlfail("insufficient vector space");
262 }
263 vect->n_vsize = size;
264 total += (long) bsize;
265 }
266 xlpop();
267 return (vect);
268 }
269
270 /* newnode - allocate a new node */
newnode(int type)271 LVAL newnode(int type)
272 {
273 LVAL nnode;
274
275 /* get a free node */
276 if ((nnode = fnodes) == NIL) {
277 findmem();
278 if ((nnode = fnodes) == NIL)
279 xlabort("insufficient node space");
280 }
281
282 /* unlink the node from the free list */
283 fnodes = cdr(nnode);
284 nfree -= 1L;
285
286 /* initialize the new node */
287 nnode->n_type = type;
288 rplacd(nnode,NIL);
289
290 /* return the new node */
291 return (nnode);
292 }
293
294 /* stralloc - allocate memory for a string adding a byte for the terminator */
stralloc(int size)295 LOCAL unsigned char *stralloc(int size)
296 {
297 unsigned char *sptr;
298
299 /* allocate memory for the string copy */
300 if ((sptr = (unsigned char *)malloc(size)) == NULL) {
301 gc();
302 if ((sptr = (unsigned char *)malloc(size)) == NULL)
303 xlfail("insufficient string space");
304 }
305 total += (long)size;
306
307 /* return the new string memory */
308 return (sptr);
309 }
310
311 /* findmem - find more memory by collecting then expanding */
findmem(void)312 LOCAL void findmem(void)
313 {
314 gc();
315 if (nfree < (long)anodes)
316 addseg();
317 }
318
319 /* gc - garbage collect (only called here and in xlimage.c) */
gc(void)320 void gc(void)
321 {
322 register LVAL **p,*ap,tmp;
323 char buf[STRMAX+1];
324 LVAL *newfp,fun;
325 extern LVAL profile_fixnum;
326
327 /* print the start of the gc message */
328 if (s_gcflag && getvalue(s_gcflag)) {
329 sprintf(buf,"[ gc: total %ld, ",nnodes);
330 stdputstr(buf);
331 }
332
333 /* mark the fixnum used by profiler */
334 if (!null(profile_fixnum)) mark(profile_fixnum);
335
336 /* mark the obarray, the argument list and the current environment */
337 if (obarray)
338 mark(obarray);
339 if (xlenv)
340 mark(xlenv);
341 if (xlfenv)
342 mark(xlfenv);
343 if (xldenv)
344 mark(xldenv);
345
346 /* mark the evaluation stack */
347 for (p = xlstack; p < xlstktop; ++p)
348 if ((tmp = **p))
349 mark(tmp);
350
351 /* mark the argument stack */
352 for (ap = xlargstkbase; ap < xlsp; ++ap)
353 if ((tmp = *ap))
354 mark(tmp);
355
356 /* sweep memory collecting all unmarked nodes */
357 sweep();
358
359 /* count the gc call */
360 ++gccalls;
361
362 /* call the *gc-hook* if necessary */
363 if (s_gchook && (fun = getvalue(s_gchook))) {
364 newfp = xlsp;
365 pusharg(cvfixnum((FIXTYPE)(newfp - xlfp)));
366 pusharg(fun);
367 pusharg(cvfixnum((FIXTYPE)2));
368 pusharg(cvfixnum((FIXTYPE)nnodes));
369 pusharg(cvfixnum((FIXTYPE)nfree));
370 xlfp = newfp;
371 xlapply(2);
372 }
373
374 /* print the end of the gc message */
375 if (s_gcflag && getvalue(s_gcflag)) {
376 sprintf(buf,"%ld free", nfree);
377 stdputstr(buf);
378 /* print additional info (e.g. sound blocks in Nyquist) */
379 print_local_gc_info();
380 stdputstr(" ]\n");
381 stdflush(); /* output in a timely fashion so user sees progress */
382 }
383 #ifdef DEBUG_INPUT
384 if (debug_input_fp) {
385 int c = getc(debug_input_fp);
386 ungetc(c, debug_input_fp);
387 }
388 #endif
389 }
390
391 /* mark - mark all accessible nodes */
mark(LVAL ptr)392 void mark(LVAL ptr)
393 {
394 register LVAL this,prev,tmp;
395 int type,i,n;
396
397 /* initialize */
398 prev = NIL;
399 this = ptr;
400
401 /* mark this list */
402 for (;;) {
403
404 /* descend as far as we can */
405 while (!(this->n_flags & MARK))
406
407 /* check cons and symbol nodes */
408 if (((type = ntype(this))) == CONS || type == USTREAM) {
409 if ((tmp = car(this))) {
410 this->n_flags |= MARK|LEFT;
411 rplaca(this,prev);
412 }
413 else if ((tmp = cdr(this))) {
414 this->n_flags |= MARK;
415 rplacd(this,prev);
416 }
417 else { /* both sides nil */
418 this->n_flags |= MARK;
419 break;
420 }
421 prev = this; /* step down the branch */
422 this = tmp;
423 }
424
425 /* mark other node types */
426 else {
427 this->n_flags |= MARK;
428 switch (type) {
429 case SYMBOL:
430 case OBJECT:
431 case VECTOR:
432 case CLOSURE:
433 for (i = 0, n = getsize(this); --n >= 0; ++i)
434 if ((tmp = getelement(this,i)))
435 mark(tmp);
436 break;
437 case EXTERN:
438 if (getdesc(this)->mark_meth) { (*(getdesc(this)->mark_meth))(getinst(this));
439 }
440 }
441 break;
442 }
443
444 /* backup to a point where we can continue descending */
445 for (;;)
446
447 /* make sure there is a previous node */
448 if (prev) {
449 if (prev->n_flags & LEFT) { /* came from left side */
450 prev->n_flags &= ~LEFT;
451 tmp = car(prev);
452 rplaca(prev,this);
453 if ((this = cdr(prev))) {
454 rplacd(prev,tmp);
455 break;
456 }
457 }
458 else { /* came from right side */
459 tmp = cdr(prev);
460 rplacd(prev,this);
461 }
462 this = prev; /* step back up the branch */
463 prev = tmp;
464 }
465
466 /* no previous node, must be done */
467 else
468 return;
469 }
470 }
471
472 /* sweep - sweep all unmarked nodes and add them to the free list */
sweep(void)473 LOCAL void sweep(void)
474 {
475 SEGMENT *seg;
476 LVAL p;
477 int n;
478
479 /* empty the free list */
480 fnodes = NIL;
481 nfree = 0L;
482
483 /* add all unmarked nodes */
484 for (seg = segs; seg; seg = seg->sg_next) {
485 if (seg == fixseg) /* don't sweep the fixnum segment */
486 continue;
487 else if (seg == charseg) /* don't sweep the character segment */
488 continue;
489 p = &seg->sg_nodes[0];
490 for (n = seg->sg_size; --n >= 0; ++p) {
491 #ifdef DEBUG_MEM
492 if (xldmem_trace &&
493 ntype(p) == EXTERN &&
494 xldmem_trace == getinst(p)) {
495 printf("sweep: EXTERN node %p is %smarked, points to %p\n",
496 p, (p->n_flags & MARK ? "" : "un"), getinst(p));
497 }
498 #endif
499 if (!(p->n_flags & MARK)) {
500 switch (ntype(p)) {
501 case STRING:
502 if (getstring(p) != NULL) {
503 total -= (long)getslength(p);
504 free(getstring(p));
505 }
506 break;
507 case STREAM:
508 if (getfile(p))
509 osclose(getfile(p));
510 break;
511 case SYMBOL:
512 case OBJECT:
513 case VECTOR:
514 case CLOSURE:
515 if (p->n_vsize) {
516 total -= (long) (p->n_vsize * sizeof(LVAL));
517 free((void *) p->n_vdata);
518 }
519 break;
520 case EXTERN:
521 /* printf("GC about to free %x\n", p);
522 * fflush(stdout);
523 */
524 if (getdesc(p)) { (*(getdesc(p)->free_meth))(getinst(p));
525 }
526 break;
527 }
528 p->n_type = FREE_NODE;
529 rplaca(p,NIL);
530 rplacd(p,fnodes);
531 fnodes = p;
532 nfree += 1L;
533 } else {
534 #ifdef DEBUG_MEM
535 /* added to find why sample blocks are not being freed - who's got them? */
536 if (ntype(p) == EXTERN && strcmp(getdesc(p)->type_name, "SOUND") == 0) {
537 long snd_list_len(void *);
538 printf("gc found but did not free extern %p sound_type %p list len %ld\n",
539 p, getinst(p), snd_list_len(getinst(p)));
540 }
541 #endif
542 p->n_flags &= ~MARK;
543 }
544 }
545 }
546 }
547
548 /* addseg - add a segment to the available memory */
addseg(void)549 LOCAL int addseg(void)
550 {
551 SEGMENT *newseg;
552 LVAL p;
553 int n;
554
555 /* allocate the new segment */
556 if (anodes == 0 || (newseg = newsegment(anodes)) == NULL)
557 return (FALSE);
558
559 /* add each new node to the free list */
560 p = &newseg->sg_nodes[0];
561 for (n = anodes; --n >= 0; ++p) {
562 rplacd(p,fnodes);
563 fnodes = p;
564 }
565
566 /* return successfully */
567 return (TRUE);
568 }
569
570 /* newsegment - create a new segment (only called here and in xlimage.c) */
newsegment(int n)571 SEGMENT *newsegment(int n)
572 {
573 SEGMENT *newseg;
574
575 /* allocate the new segment */
576 if ((newseg = (SEGMENT *)calloc(1,segsize(n))) == NULL)
577 return (NULL);
578
579 /* initialize the new segment */
580 newseg->sg_size = n;
581 newseg->sg_next = NULL;
582 if (segs)
583 lastseg->sg_next = newseg;
584 else
585 segs = newseg;
586 lastseg = newseg;
587
588 /* update the statistics */
589 total += (long)segsize(n);
590 nnodes += (long)n;
591 nfree += (long)n;
592 ++nsegs;
593
594 /* return the new segment */
595 return (newseg);
596 }
597
598 /* stats - print memory statistics */
stats(void)599 LOCAL void stats(void)
600 {
601 sprintf(buf,"Nodes: %ld\n",nnodes); stdputstr(buf);
602 sprintf(buf,"Free nodes: %ld\n",nfree); stdputstr(buf);
603 sprintf(buf,"Segments: %d\n",nsegs); stdputstr(buf);
604 sprintf(buf,"Allocate: %d\n",anodes); stdputstr(buf);
605 sprintf(buf,"Total: %ld\n",total); stdputstr(buf);
606 sprintf(buf,"Collections: %d\n",gccalls); stdputstr(buf);
607 }
608
609 /* xgc - xlisp function to force garbage collection */
xgc(void)610 LVAL xgc(void)
611 {
612 /* make sure there aren't any arguments */
613 xllastarg();
614
615 /* garbage collect */
616 gc();
617
618 /* return nil */
619 return (NIL);
620 }
621
622 /* xexpand - xlisp function to force memory expansion */
xexpand(void)623 LVAL xexpand(void)
624 {
625 LVAL num;
626 int n,i;
627
628 /* get the new number to allocate */
629 if (moreargs()) {
630 num = xlgafixnum();
631 n = (int) getfixnum(num);
632 }
633 else
634 n = 1;
635 xllastarg();
636
637 /* allocate more segments */
638 for (i = 0; i < n; i++)
639 if (!addseg())
640 break;
641
642 /* return the number of segments added */
643 return (cvfixnum((FIXTYPE)i));
644 }
645
646 /* xalloc - xlisp function to set the number of nodes to allocate */
xalloc(void)647 LVAL xalloc(void)
648 {
649 int n,oldn;
650 LVAL num;
651
652 /* get the new number to allocate */
653 num = xlgafixnum();
654 n = (int) getfixnum(num);
655
656 /* make sure there aren't any more arguments */
657 xllastarg();
658
659 /* set the new number of nodes to allocate */
660 oldn = anodes;
661 anodes = n;
662
663 /* return the old number */
664 return (cvfixnum((FIXTYPE)oldn));
665 }
666
667 /* xmem - xlisp function to print memory statistics */
xmem(void)668 LVAL xmem(void)
669 {
670 /* allow one argument for compatiblity with common lisp */
671 if (moreargs()) xlgetarg();
672 xllastarg();
673
674 /* print the statistics */
675 stats();
676
677 /* return nil */
678 return (NIL);
679 }
680
681 /* xinfo - show information on control-t */
xinfo()682 LVAL xinfo()
683 {
684 char buf[80];
685
686 sprintf(buf,"\n[ Free: %d, GC calls: %d, Total: %d",
687 (int)nfree, (int)gccalls, (int)total);
688 stdputstr(buf);
689 print_local_gc_info();
690 stdputstr("]\n");
691 return NULL;
692 }
693
694
695 #ifdef SAVERESTORE
696 /* xsave - save the memory image */
xsave(void)697 LVAL xsave(void)
698 {
699 unsigned char *name;
700
701 /* get the file name, verbose flag and print flag */
702 name = getstring(xlgetfname());
703 xllastarg();
704
705 /* save the memory image */
706 return (xlisave((char *) name) ? s_true : NIL);
707 }
708
709 /* xrestore - restore a saved memory image */
xrestore(void)710 LVAL xrestore(void)
711 {
712 extern jmp_buf top_level;
713 unsigned char *name;
714
715 /* get the file name, verbose flag and print flag */
716 name = getstring(xlgetfname());
717 xllastarg();
718
719 /* restore the saved memory image */
720 if (!xlirestore((char *) name))
721 return (NIL);
722
723 /* return directly to the top level */
724 stdputstr("[ returning to the top level ]\n");
725 _longjmp(top_level,1);
726 }
727 #endif
728
729 static unsigned char registered_xlmshutdown = 0;
730 static void xlmshutdown(void);
731
732 /* xlminit - initialize the dynamic memory module */
xlminit(void)733 void xlminit(void)
734 {
735 LVAL p;
736 int i;
737
738 /* initialize our internal variables */
739 segs = lastseg = NULL;
740 nnodes = nfree = total = 0L;
741 nsegs = gccalls = 0;
742 anodes = NNODES;
743 fnodes = NIL;
744
745 /* allocate the fixnum segment */
746 if ((fixseg = newsegment(SFIXSIZE)) == NULL)
747 xlfatal("insufficient memory");
748
749 /* initialize the fixnum segment */
750 p = &fixseg->sg_nodes[0];
751 for (i = SFIXMIN; i <= SFIXMAX; ++i) {
752 p->n_type = FIXNUM;
753 p->n_fixnum = i;
754 ++p;
755 }
756
757 /* allocate the character segment */
758 if ((charseg = newsegment(CHARSIZE)) == NULL)
759 xlfatal("insufficient memory");
760
761 /* initialize the character segment */
762 p = &charseg->sg_nodes[0];
763 for (i = CHARMIN; i <= CHARMAX; ++i) {
764 p->n_type = CHAR;
765 p->n_chcode = i;
766 ++p;
767 }
768
769 /* initialize structures that are marked by the collector */
770 obarray = xlenv = xlfenv = xldenv = NIL;
771 s_gcflag = s_gchook = NIL;
772
773 /* allocate the evaluation stack */
774 if ((xlstkbase = (LVAL **)malloc(EDEPTH * sizeof(LVAL *))) == NULL)
775 xlfatal("insufficient memory");
776 xlstack = xlstktop = xlstkbase + EDEPTH;
777
778 /* allocate the argument stack */
779 if ((xlargstkbase = (LVAL *)malloc(ADEPTH * sizeof(LVAL))) == NULL)
780 xlfatal("insufficient memory");
781 // printf("ADEPTH is %d\n", ADEPTH);
782 xlargstktop = xlargstkbase + ADEPTH;
783 xlfp = xlsp = xlargstkbase;
784 *xlsp++ = NIL;
785
786 /* Guarantee graceful cleanup of memory */
787 if (!registered_xlmshutdown) {
788 atexit(xlmshutdown);
789 registered_xlmshutdown = 1;
790 }
791 }
792
xlmshutdown(void)793 static void xlmshutdown(void)
794 {
795 /* This function deallocates all memory used by xlisp. Should it
796 become non-static, allowing the client to shut down and init
797 again for a "hard" restart? */
798
799 /* Free all lisp objects, and free the free-store */
800 freeimage();
801
802 /* Free the stacks */
803 free(xlstkbase);
804 xlstkbase = NULL;
805 free(xlargstkbase);
806 xlargstkbase = NULL;
807 }
808