![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to 68k.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / franz / 68k|
Return to 68k.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / franz / 68k |
1.1 root 1: #include "global.h"
2: #include <signal.h>
3:
4:
5: mmuladd(a,b,c,m)
6: long a,b,c,m;
7: {
8: long work[2]; char err;
9: emul(a,b,c,work);
10: ediv(work,m,err);
11: return(work[0]);
12: }
13: /*mmuladd (a, b, c, m)
14: int a, b, c, m;
15: {
16: asm ("emul 4(ap),8(ap),12(ap),r0");
17: asm ("ediv 16(ap),r0,r2,r0");
18: }
19:
20: Imuldiv() {
21: asm(" emul 4(ap),8(ap),12(ap),r0");
22: asm(" ediv 16(ap),r0,*20(ap),*24(ap)");
23: }*/
24:
25: Imuldiv(p1,p2,add,dv,quo,rem)
26: long p1, p2, add, dv;
27: long *quo, *rem;
28: {
29: long work[2]; char err;
30:
31: emul(p1,p2,add,work);
32: *quo = ediv(work,dv, &err);
33: *rem = *work;
34: }
35: /*C library -- write
36: nwritten = write(file, buffer, count);
37: nwritten == -1 means error
38: */
39: write(file, buffer, count)
40: char *buffer;
41: {
42: register lispval handy;
43: int retval;
44: if((file != 1) || (Vcntlw->a.clb == nil)) goto top;
45: /* since ^w is non nil, we do not want to print to the terminal,
46: but we must be sure to return a correct value from the write
47: in case there is no write to ptport
48: */
49: retval = count;
50: goto skipit;
51:
52: top:
53:
54: retval = _write(file,buffer,count);
55:
56: skipit:
57: if(file==1) {
58: handy = Vptport->a.clb;
59: if(handy!=nil && TYPE(handy)==PORT && handy->p->_file!=1) {
60: fflush(handy->p);
61: file = handy->p->_file;
62: goto top;
63: }
64: }
65: return(retval);
66: }
67:
68: /*
69: # C library -- read
70:
71: # nread = read(file, buffer, count);
72: #
73: # nread ==0 means eof; nread == -1 means error
74: */
75: #include <errno.h>
76: read(file,buffer,count)
77: {
78: extern int errno;
79: register int Size;
80: again:
81:
82: Size = _read(file,buffer,count);
83: if ((Size >= 0) || (errno != EINTR)) return(Size);
84: if(sigintcnt > 0) sigcall(SIGINT);
85: goto again;
86: }
87:
88: lispval
89: Lpolyev()
90: {
91: register int count;
92: register double *handy, *base;
93: register struct argent *argp;
94: lispval result; int type;
95: char *alloca();
96:
97: count = 2 * (((int) np) - (int) lbot);
98: if(count == 0)
99: return(inewint(0));
100: if(count == 8)
101: return(lbot->val);
102: base = handy = (double *) alloca(count);
103: for(argp = lbot; argp < np; argp++) {
104: while((type = TYPE(argp->val))!=DOUB && type!=INT)
105: argp->val = (lispval) errorh2(Vermisc,"%%machine-polyev:non-real arg",nil,TRUE,73,lbot,argp->val);
106: if(TYPE(argp->val)==INT) {
107: *handy++ = argp->val->i;
108: } else
109: *handy++ = argp->val->r;
110: }
111: count = count/sizeof(double) - 2;
112: /* asm("polyd (r9),r11,8(r9)");
113: asm("movd r0,(r9)");*/
114: result = newdoub();
115: result->r = *base;
116: return(result);
117: }
118:
119: lispval
120: Lrot()
121: {
122: register rot,val; /* these must be the first registers */
123: register struct argent *mylbot = lbot;
124:
125: chkarg(2,"rot");
126: if((TYPE(mylbot->val) != INT) || (TYPE(mylbot[1].val) != INT))
127: errorh2(Vermisc,
128: "Non ints to rot",
129: nil,FALSE,0,mylbot->val,mylbot[1].val);
130: val = mylbot[0].val->i;
131: rot = mylbot[1].val->i;
132: rot = rot % 32 ; /* bring it down below one byte in size */
133: if(rot < 0) {
134: rot = -rot;
135: {asm("roll d7,d6");}
136: } else {asm("rorl d7,d6");}
137: return( inewint(val));
138: }
139:
140: myfrexp() { error("myfrexp called", FALSE);}
141: #if os_unisoft
142: syscall() { error("vsyscall called", FALSE);}
143: #endif
144:
145: #include "structs.h"
146: prunei(what)
147: register lispval what;
148: {
149: extern struct types int_str;
150: int gstart();
151: if(((long)what) > ((long) gstart)) {
152: --(int_items->i);
153: what->i = (long) int_str.next_free;
154: int_str.next_free = (char *) what;
155: }
156: }
157: #include "68kframe.h"
158: /* new version of showstack,
159: We will set fp to point where the register fp points.
160: If we find that the saved pc is somewhere in the routine eval,
161: then we print the first argument to that eval frame. This is done
162: by looking on the stack.
163: */
164: lispval
165: Lshostk()
166: { lispval isho();
167: return(isho(1));
168: }
169: static lispval
170: isho(f)
171: int f;
172: {
173: register struct frame *myfp; register lispval handy;
174: int **fp; /* this must be the first local */
175: int virgin=1;
176: lispval linterp(), Ifuncal();
177: lispval _qfuncl(),tynames(); /* locations in qfuncl */
178: extern int plevel,plength;
179:
180: if(TYPE(Vprinlevel->a.clb) == INT)
181: {
182: plevel = Vprinlevel->a.clb->i;
183: }
184: else plevel = -1;
185: if(TYPE(Vprinlength->a.clb) == INT)
186: {
187: plength = Vprinlength->a.clb->i;
188: }
189: else plength = -1;
190:
191: if(f==1)
192: printf("Forms in evaluation:\n");
193: else
194: printf("Backtrace:\n\n");
195:
196: myfp = (struct frame *) (&fp +1); /* point to current frame */
197:
198: while(TRUE)
199: {
200: if( (myfp->pc > eval && /* interpreted code */
201: myfp->pc < popnames)
202: ||
203: (myfp->pc > Ifuncal && /* compiled code */
204: myfp->pc < Lfuncal) )
205: {
206: { handy = (myfp->fp->ap[0]);
207: if(f==1)
208: printr(handy,stdout), putchar('\n');
209: else {
210: if(virgin)
211: virgin = 0;
212: else
213: printf(" -- ");
214: printr((TYPE(handy)==DTPR)?handy->d.car:handy,stdout);
215: }
216: }
217:
218: }
219:
220: if(myfp > myfp->fp) break; /* end of frames */
221: else myfp = myfp->fp;
222: }
223: putchar('\n');
224: return(nil);
225: }
226:
227: /*
228: *
229: * (baktrace)
230: *
231: * baktrace will print the names of all functions being evaluated
232: * from the current one (baktrace) down to the first one.
233: * currently it only prints the function name. Planned is a
234: * list of local variables in all stack frames.
235: * written by jkf.
236: *
237: */
238: lispval
239: Lbaktrace()
240: {
241: isho(0);
242: }
243:
244: /*
245: * (int:showstack 'stack_pointer)
246: * return
247: * nil if at the end of the stack or illegal
248: * ( expresssion . next_stack_pointer) otherwise
249: * where expression is something passed to eval
250: * very vax specific
251: */
252: lispval
253: LIshowstack()
254: {
255: int **fp; /* must be the first local variable */
256: register lispval handy;
257: register struct frame *myfp;
258: lispval retval, Ifuncal();
259: Savestack(2);
260:
261: chkarg(1,"int:showstack");
262:
263: if((TYPE(handy=lbot[0].val) != INT) && (handy != nil))
264: error("int:showstack non fixnum arg", FALSE);
265:
266: if(handy == nil)
267: myfp = (struct frame *) (&fp +1);
268: else
269: myfp = (struct frame *) handy->i;
270:
271: if((int ***)myfp <= &fp) error("int:showstack illegal stack value",FALSE);
272: while(myfp > 0)
273: {
274: if( (myfp->pc > eval && /* interpreted code */
275: myfp->pc < popnames)
276: ||
277: (myfp->pc > Ifuncal && /* compiled code */
278: myfp->pc < Lfuncal) )
279: {
280: {
281: handy = (lispval)(myfp->fp->ap[0]); /* arg to eval */
282:
283: protect(retval=newdot());
284: retval->d.car = handy;
285: if(myfp > myfp->fp)
286: myfp = 0; /* end of frames */
287: else
288: myfp = myfp->fp;
289: retval->d.cdr = inewint(myfp);
290: return(retval);
291: }
292: }
293: if(myfp > myfp->fp)
294: myfp = 0; /* end of frames */
295: else
296: myfp = myfp->fp;
297:
298: }
299: return(nil);
300: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.