![[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] / 3BSD / cmd / lisp|
Return to fex3.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
1.1 root 1: #include "global.h"
2:
3: /* chkarg ***************************************************************/
4: /* This insures that there are at least expnum arguments passed to the */
5: /* BCD function that calls this. If there are fewer, nil arguments */
6: /* are pushed onto the name stack and np adjusted accordingly. */
7: chkarg(expnum)
8: int expnum; /* expected number of args */
9: {
10: register struct argent *work;
11: register r10,r9,r8;
12: register struct argent *lbot, *np;
13: saveonly(1);
14:
15: for(work = np,np = lbot + expnum; work < np; )
16: work++->val = nil;
17:
18: }
19:
20:
21: /*
22: *Ndumplisp -- create executable version of current state of this lisp.
23: */
24: #include <a.out.h>
25:
26: asm(" .globl Dlast")
27: lispval
28: Ndumplisp()
29: {
30: register struct exec *workp;
31: register lispval argptr, temp;
32: register char *fname;
33: extern lispval reborn;
34: struct exec work, old;
35: extern etext;
36: extern int dmpmode;
37: int descrip, des2, count, ax,mode;
38: char tbuf[BUFSIZ];
39: snpand(4);
40:
41: /* dump mode is kept in decimal (which looks like octal in dmpmode)
42: and is changeable via (sstatus dumpmode n) where n is 413 or 410
43: base 10
44: */
45: if(dmpmode == 413) mode = 0413;
46: else mode = 0410;
47:
48: workp = &work;
49: workp->a_magic = mode;
50: workp->a_text = ((((unsigned) (&etext)) - 1) & (~PAGRND)) + PAGSIZ;
51: workp->a_data = (unsigned) sbrk(0) - workp->a_text;
52: workp->a_bss = 0;
53: workp->a_syms = 0;
54: workp->a_entry = (unsigned) gstart();
55: workp->a_trsize = 0;
56: workp->a_drsize = 0;
57:
58: fname = "savedlisp"; /*set defaults*/
59: reborn = CNIL;
60: argptr = lbot->val;
61: if (argptr != nil) {
62: temp = argptr->car;
63: if((TYPE(temp))==ATOM)
64: fname = temp->pname;
65: }
66: des2 = open(gstab(),0);
67: if(des2 >= 0) {
68: if(read(des2,&old,sizeof(old))>=0)
69: work.a_syms = old.a_syms;
70: }
71: descrip=creat(fname,0777); /*doit!*/
72: if(-1==write(descrip,workp,sizeof(work)))
73: {
74: close(descrip);
75: error("Dumplisp failed",FALSE);
76: }
77: if(mode == 0413) lseek(descrip,PAGSIZ,0);
78: if( -1==write(descrip,0,workp->a_text) ||
79: -1==write(descrip,workp->a_text,workp->a_data) ) {
80: close(descrip);
81: error("Dumplisp failed",FALSE);
82: }
83: if(des2>0 && work.a_syms) {
84: count = old.a_text + old.a_data + sizeof(old);
85: if(-1==lseek(des2,count,0))
86: error("Could not seek to stab",FALSE);
87: asm("Dlast:");
88: for(count = old.a_syms;count > 0; count -=BUFSIZ) {
89: ax = read(des2,tbuf,BUFSIZ);
90: if(ax==0) {
91: printf("Unexpected end of syms",count);
92: fflush(stdout);
93: break;
94: }
95: if(ax > 0)
96: write(descrip,tbuf,ax);
97: else
98: error("Failure to write dumplisp stab",FALSE);
99: }
100: }
101: close(descrip);
102: if(des2>0) close(des2);
103: reborn = 0;
104: return(nil);
105: }
106: lispval
107: typred(typ,ptr)
108: int typ;
109: lispval ptr;
110:
111: { int tx;
112: if ((tx = TYPE(ptr)) == typ) return(tatom);
113: if ((tx == INT) && (typ == ATOM)) return(tatom);
114: return(nil);
115: }
116: lispval
117: Nfunction()
118: {
119: register lispval handy;
120:
121: snpand(1);
122: handy = lbot->val->car;
123: if(TYPE(handy)==ATOM && handy->fnbnd!=nil)
124: return(handy->fnbnd);
125: else
126: return(handy);
127: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.