"$Header: vax.c,v 1.6 84/02/29 16:45:23 sklower Exp $";
/* -[Mon Mar 21 19:35:50 1983 by jkf]-
* (c) copyright 1982, Regents of the University of California
* a,b and c are 32 bit 2's complement integers
* calculates x=a*b+c to twice the precision of an int.
* In the vax version, the 30 low bits only are returned
* in *lo,and the next 32 bits of precision are returned in * hi.
* this works since exarith is used either for calculating the sum of
* two 32 bit numbers, (which is at most 33 bits), or
* multiplying a 30 bit number by a 32 bit numbers,
* which has a maximum precision of 62 bits.
* If *phi is 0 or -1 then
* x doesn't need any more than 31 bits plus sign to describe, so we
* place the sign in the high two bits of *lo and return 0 from this
* routine. A non zero return indicates that x requires more than 31 bits
asm(" emul 4(ap),8(ap),12(ap),r2 #r2 = a*b + c to 64 bits");
asm(" extzv $0,$30,r2,*20(ap) #get new lo");
asm(" extv $30,$32,r2,r0 #get new carry");
asm(" beql out # hi = 0, no work necessary");
asm(" movl r0,*16(ap) # save hi");
asm(" mcoml r0,r0 # Is hi = -1 (it'll fit in one word)");
asm(" bneq out # it doesn't");
asm(" bisl2 $0xc0000000,*20(ap) # alter low so that it is ok.");
asm ("emul 4(ap),8(ap),12(ap),r0");
asm ("ediv 16(ap),r0,r2,r0");
asm(" emul 4(ap),8(ap),12(ap),r0");
asm(" ediv 16(ap),r0,*20(ap),*24(ap)");
asm(" callg *8(ap),*4(ap)");
#define _read _$real_read
#define _write _$real_write
#define _read(a,b,c) syscall(READ,a,b,c)
#define _write(a,b,c) syscall(WRITE,a,b,c)
nwritten = write(file, buffer, count);
nwritten == -1 means error
write(file
, buffer
, count
)
if((file
!= 1) || (Vcntlw
->a
.clb
== nil
)) goto top
;
/* since ^w is non nil, we do not want to print to the terminal,
but we must be sure to return a correct value from the write
in case there is no write to ptport
retval
= _write(file
,buffer
,count
);
if(handy
!=nil
&& TYPE(handy
)==PORT
&& handy
->p
->_file
!=1) {
*nread = read(file, buffer, count);
*nread ==0 means eof; nread == -1 means error
Size
= _read(file
,buffer
,count
);
if ((Size
>= 0) || (errno
!= EINTR
)) return(Size
);
if(sigintcnt
> 0) sigcall(SIGINT
);
register double *handy
, *base
;
register struct argent
*argp
;
lispval result
; int type
;
count
= 2 * (((int) np
) - (int) lbot
);
base
= handy
= (double *) alloca(count
);
for(argp
= lbot
; argp
< np
; argp
++) {
while((type
= TYPE(argp
->val
))!=DOUB
&& type
!=INT
)
argp
->val
= (lispval
) errorh2(Vermisc
,"%%machine-polyev:non-real arg",nil
,TRUE
,73,lbot
,argp
->val
);
if(TYPE(argp
->val
)==INT
) {
count
= count
/sizeof(double) - 2;
asm("polyd (r9),r11,8(r9)");
register rot
,val
; /* these must be the first registers */
register struct argent
*mylbot
= lbot
;
if((TYPE(mylbot
->val
) != INT
) || (TYPE(mylbot
[1].val
) != INT
))
nil
,FALSE
,0,mylbot
->val
,mylbot
[1].val
);
rot
= rot
% 32 ; /* bring it down below one byte in size */
asm(" rotl r11,r10,r10 "); /* rotate val by rot and put back in val */
/* new version of showstack,
We will set fp to point where the register fp points.
If we find that the saved pc is somewhere in the routine eval,
then we print the first argument to that eval frame. This is done
by looking one beyond the saved ap.
register struct machframe
*myfp
; register lispval handy
;
int **fp
; /* this must be the first local */
lispval
_qfuncl(),tynames(); /* locations in qfuncl */
extern int plevel
,plength
;
if(TYPE(Vprinlevel
->a
.clb
) == INT
)
plevel
= Vprinlevel
->a
.clb
->i
;
if(TYPE(Vprinlength
->a
.clb
) == INT
)
plength
= Vprinlength
->a
.clb
->i
;
printf("Forms in evaluation:\n");
printf("Backtrace:\n\n");
myfp
= (struct machframe
*) (&fp
+1); /* point to current frame */
if( (myfp
->pc
> eval
&& /* interpreted code */
(myfp
->pc
> Lfuncal
&& /* compiled code */
if(((int) myfp
->ap
[0]) == 1) /* only if arg given */
printr(handy
,stdout
), putchar('\n');
printr((TYPE(handy
)==DTPR
)?handy
->d
.car
:handy
,stdout
);
if(myfp
> myfp
->fp
) break; /* end of frames */
* baktrace will print the names of all functions being evaluated
* from the current one (baktrace) down to the first one.
* currently it only prints the function name. Planned is a
* list of local variables in all stack frames.
* (int:showstack 'stack_pointer)
* nil if at the end of the stack or illegal
* ( expresssion . next_stack_pointer) otherwise
* where expression is something passed to eval
int **fp
; /* must be the first local variable */
register struct machframe
*myfp
;
lispval retval
, Lfuncal(), Ifuncal();
chkarg(1,"int:showstack");
if((TYPE(handy
=lbot
[0].val
) != INT
) && (handy
!= nil
))
error("int:showstack non fixnum arg", FALSE
);
myfp
= (struct machframe
*) (&fp
+1);
myfp
= (struct machframe
*) handy
->i
;
if((int ***)myfp
<= &fp
) error("int:showstack illegal stack value",FALSE
);
if( (myfp
->pc
> eval
&& /* interpreted code */
(myfp
->pc
> Ifuncal
&& /* compiled code */
if(((int) myfp
->ap
[0]) == 1) /* only if arg given */
handy
= (lispval
)(myfp
->ap
[1]); /* arg to eval */
protect(retval
=newdot());
myfp
= 0; /* end of frames */
retval
->d
.cdr
= inewint(myfp
);
myfp
= 0; /* end of frames */
* this code is very similar to ftolsp.
* if it gets revised, so should this.
dothunk(func
,count
,arglist
)
if(errp
->class==F_TO_FORT
)
errp
= Pushframe(F_TO_LISP
,nil
,nil
);
for(; count
> 0; count
--)
np
++->val
= inewint(*arglist
++);
static char fourwords
[] = "0123456789012345";
register struct argent
*mylbot
= lbot
;
chkarg(2,"make-c-thunk");
th
= (struct thunk
*)pinewstr(fourwords
);
th
->count
= mylbot
[1].val
->i
;