![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fex3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / lisp|
Return to fex3.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / lisp |
1.1 root 1: static char *sccsid = "@(#)fex3.c 34.2 10/13/80";
2:
3: #include "global.h"
4: #include <vadvise.h>
5:
6: /* chkarg ***************************************************************/
7: /* This insures that there are at least expnum arguments passed to the */
8: /* BCD function that calls this. If there are fewer, nil arguments */
9: /* are pushed onto the name stack and np adjusted accordingly. */
10: #ifdef chkarg
11: #undef chkarg
12: #endif
13: chkarg(expnum,string)
14: int expnum; /* expected number of args */
15: char string[];
16: {
17: register struct argent *work;
18: register r10,r9,r8;
19: register struct argent *lbot, *np;
20: saveonly(1);
21:
22: for(work = np,np = lbot + expnum; work < np; )
23: work++->val = nil;
24: }
25:
26:
27: /*
28: *Ndumplisp -- create executable version of current state of this lisp.
29: */
30: #include "a.out.h"
31:
32: asm(" .globl Dlast")
33: lispval
34: Ndumplisp()
35: {
36: register struct exec *workp;
37: register lispval argptr, temp;
38: register char *fname;
39: extern lispval reborn;
40: struct exec work, old;
41: extern etext;
42: extern int dmpmode,holend,curhbeg,usehole;
43: extern int end;
44: int descrip, des2, count, ax,mode;
45: char tbuf[BUFSIZ];
46: snpand(4);
47:
48:
49: #ifndef UNIXTS
50: vadvise(VA_ANOM);
51: #endif
52:
53: /* dump mode is kept in decimal (which looks like octal in dmpmode)
54: and is changeable via (sstatus dumpmode n) where n is 413 or 410
55: base 10
56: */
57: if(dmpmode == 413) mode = 0413;
58: else mode = 0410;
59:
60: workp = &work;
61: workp->a_magic = mode;
62: if(usehole)
63: workp->a_text = curhbeg & (~PAGRND);
64: else
65: workp->a_text = ((((unsigned) (&holend)) - 1) & (~PAGRND)) + PAGSIZ;
66: #ifndef VMS
67: workp->a_data = (unsigned) sbrk(0) - workp->a_text;
68: #else
69: workp->a_data = ((int)&end) - workp->a_text;
70: #endif
71: workp->a_bss = 0;
72: workp->a_syms = 0;
73: workp->a_entry = (unsigned) gstart();
74: workp->a_trsize = 0;
75: workp->a_drsize = 0;
76:
77: fname = "savedlisp"; /*set defaults*/
78: reborn = CNIL;
79: argptr = lbot->val;
80: if (argptr != nil) {
81: temp = argptr->d.car;
82: if((TYPE(temp))==ATOM)
83: fname = temp->a.pname;
84: }
85: des2 = open(gstab(),0);
86: if(des2 >= 0) {
87: if(read(des2,&old,sizeof(old))>=0)
88: work.a_syms = old.a_syms;
89: }
90: descrip=creat(fname,0777); /*doit!*/
91: if(-1==write(descrip,workp,sizeof(work)))
92: {
93: close(descrip);
94: error("Dumplisp failed",FALSE);
95: }
96: if(mode == 0413) lseek(descrip,PAGSIZ,0);
97: if( -1==write(descrip,0,workp->a_text) ||
98: -1==write(descrip,workp->a_text,workp->a_data) ) {
99: close(descrip);
100: error("Dumplisp failed",FALSE);
101: }
102: if(des2>0 && work.a_syms) {
103: count = old.a_text + old.a_data + sizeof(old);
104: if(-1==lseek(des2,count,0))
105: error("Could not seek to stab",FALSE);
106: asm("Dlast:");
107: for(count = old.a_syms;count > 0; count -=BUFSIZ) {
108: ax = read(des2,tbuf,BUFSIZ);
109: if(ax==0) {
110: printf("Unexpected end of syms",count);
111: fflush(stdout);
112: break;
113: }
114: if(ax > 0)
115: write(descrip,tbuf,ax);
116: else
117: error("Failure to write dumplisp stab",FALSE);
118: }
119: }
120: close(descrip);
121: if(des2>0) close(des2);
122: reborn = 0;
123:
124: #ifndef UNIXTS
125: vadvise(VA_NORM);
126: #endif
127: return(nil);
128: }
129:
130: lispval
131: Nndumplisp()
132: {
133: register struct exec *workp;
134: register lispval argptr, temp;
135: register char *fname;
136: extern lispval reborn;
137: struct exec work, old;
138: extern etext;
139: extern int dmpmode,holend,curhbeg,usehole;
140: int descrip, des2, count, ax,mode;
141: char tbuf[BUFSIZ];
142: snpand(4);
143:
144:
145: #ifndef UNIXTS
146: vadvise(VA_ANOM);
147: #endif
148:
149: /* dump mode is kept in decimal (which looks like octal in dmpmode)
150: and is changeable via (sstatus dumpmode n) where n is 413 or 410
151: base 10
152: */
153: if(dmpmode == 413) mode = 0413;
154: else mode = 0410;
155:
156: workp = &work;
157: workp->a_magic = mode;
158: if(usehole)
159: workp->a_text = curhbeg & (~PAGRND);
160: else
161: workp->a_text = ((((unsigned) (&holend)) - 1) & (~PAGRND)) + PAGSIZ;
162: workp->a_data = (unsigned) sbrk(0) - workp->a_text;
163: workp->a_bss = 0;
164: workp->a_syms = 0;
165: workp->a_entry = (unsigned) gstart();
166: workp->a_trsize = 0;
167: workp->a_drsize = 0;
168:
169: fname = "savedlisp"; /*set defaults*/
170: reborn = CNIL;
171: argptr = lbot->val;
172: if (argptr != nil) {
173: temp = argptr->d.car;
174: if((TYPE(temp))==ATOM)
175: fname = temp->a.pname;
176: }
177: des2 = open(gstab(),0);
178: if(des2 >= 0) {
179: if(read(des2,&old,sizeof(old))>=0)
180: work.a_syms = old.a_syms;
181: }
182: descrip=creat(fname,0777); /*doit!*/
183: if(-1==write(descrip,workp,sizeof(work)))
184: {
185: close(descrip);
186: error("Dumplisp failed",FALSE);
187: }
188: if(mode == 0413) lseek(descrip,PAGSIZ,0);
189: if( -1==write(descrip,0,workp->a_text) ||
190: -1==write(descrip,workp->a_text,workp->a_data) ) {
191: close(descrip);
192: error("Dumplisp failed",FALSE);
193: }
194: if(des2>0 && work.a_syms) {
195: count = old.a_text + old.a_data + (old.a_magic == 0413 ? PAGSIZ
196: : sizeof(old));
197: if(-1==lseek(des2,count,0))
198: error("Could not seek to stab",FALSE);
199: for(count = old.a_syms;count > 0; count -=BUFSIZ) {
200: ax = read(des2,tbuf,(count < BUFSIZ ? count : BUFSIZ));
201: if(ax==0) {
202: printf("Unexpected end of syms",count);
203: fflush(stdout);
204: break;
205: } else if(ax > 0)
206: write(descrip,tbuf,ax);
207: else
208: error("Failure to write dumplisp stab",FALSE);
209: }
210: if(-1 == lseek(des2,
211: (old.a_magic == 0413 ? PAGSIZ : sizeof(old))
212: + old.a_text + old.a_data
213: + old.a_trsize + old.a_drsize + old.a_syms,
214: 0))
215: error(" Could not seek to string table ",FALSE);
216: for( ax = 1 ; ax > 0;) {
217: ax = read(des2,tbuf,BUFSIZ);
218: if(ax > 0)
219: write(descrip,tbuf,ax);
220: else if (ax < 0)
221: error("Error in string table read ",FALSE);
222: }
223: }
224: close(descrip);
225: if(des2>0) close(des2);
226: reborn = 0;
227:
228: #ifndef UNIXTS
229: vadvise(VA_NORM);
230: #endif
231: return(nil);
232: }
233: lispval
234: typred(typ,ptr)
235: int typ;
236: lispval ptr;
237:
238: { int tx;
239: if ((tx = TYPE(ptr)) == typ) return(tatom);
240: if ((tx == INT) && (typ == ATOM)) return(tatom);
241: return(nil);
242: }
243: lispval
244: Nfunction()
245: {
246: register lispval handy;
247:
248: snpand(1);
249: handy = lbot->val->d.car;
250: if(TYPE(handy)==ATOM && handy->a.fnbnd!=nil)
251: return(handy->a.fnbnd);
252: else
253: return(handy);
254: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.