register lispval first
, second
;
register struct argent
*inp
;
snpand(3); /* clobber save mask */
if( (TYPE(first
))!=ATOM
|| (TYPE(second
))!=ATOM
)
error("alphalessp expects atoms");
if(strcmp(first
->pname
,second
->pname
) <= 0)
snpand(1); /* clobber save mask */
handy
-> car
= lbot
->val
;
snpand(1); /* clobber save mask */
return(handy
->i
==0?tatom
:nil
);
return(handy
->r
==0.0?tatom
:nil
);
register lispval handy
; lispval
Ladd();
snpand(1); /* clobber save mask */
return(handy
->i
==1?tatom
:nil
);
return(handy
->r
==1.0?tatom
:nil
);
if(TYPE(handy
)!=INT
|| handy
->i
!=1)
register struct argent
*argp
;
register struct argent
*outarg
;
register struct argent
*handy
;
register struct argent
*lbot
;
register struct argent
*np
;
*outarg
= argp
[-1], outarg
[1] = *argp
++;
outarg
[1] = argp
[-1], *outarg
= *argp
++;
if(Lnegp()==nil
) return(nil
);
register lispval arg1
,arg2
; register handy
= 0;
snpand(3); /* clobber save mask */
if(TYPE(arg1
)==INT
&& TYPE(arg2
)==INT
) {
else error("non-numeric argument",FALSE
);
register lispval arg1
,arg2
; lispval handy
;
struct sdot fake1
, fake2
;
snpand(2); /* clobber save mask */
handy
= arg1
= lbot
->val
;
error("non-numeric argument",FALSE
);
error("non-numeric argument",FALSE
);
if(Lzerop()!=nil
) return(handy
);
divbig(arg1
,arg2
,0,&handy
);
if(handy
==((lispval
)&fake1
))
handy
= inewint(fake1
.I
);
if(handy
==((lispval
)&fake2
))
handy
= inewint(fake2
.I
);
snpand(1); /* fixup entry mask */
snpand(1); /* fixup entry mask */
register lispval arg1
, handy
;
snpand(3); /* clobber save mask */
handy
= inewint(0 - arg1
->i
);
handy
->CDR
= (lispval
) 0;
handy
= subbig(handy
,arg1
);
error("non-numeric argument",FALSE
);
register lispval handy
= np
[-1].val
, work
;
snpand(3); /* clobber save mask */
if(handy
->i
< 0) flag
= TRUE
;
if(handy
->r
< 0) flag
= TRUE
;
for(work
= handy
; work
->CDR
!=(lispval
) 0; work
= work
->CDR
);
if(work
->I
< 0) flag
= TRUE
;
"minusp: Non-(int,real,bignum) arg: ",
register lispval arg1
, handy
;
snpand(3); /* clobber save mask */
if(Lnegp()!=nil
) return(Lminus());
/* 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 frame
*myfp
; register lispval handy
;
int **fp
; /* this must be the first local */
lispval
_qfuncl(),tynames(); /* locations in qfuncl */
printf("Forms in evaluation:\n");
printf("Backtrace:\n\n");
myfp
= (struct frame
*) (&fp
+1); /* point to current frame */
if( (myfp
->pc
> eval
&& /* interpreted code */
(myfp
->pc
> _qfuncl
&& /* compiled code */
printr(handy
,stdout
), putchar('\n');
printr((TYPE(handy
)==DTPR
)?handy
->car
:handy
,stdout
);
if(myfp
> myfp
->fp
) break; /* end of frames */
/* ===========================================================
**** baktrace **** (moved back by kls)
- 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.
-============================================================*/
/*=============================================================
- oblist returns a list of all symbols in the oblist
============================================================*/
headp
= tailp
= newdot(); /* allocate first DTPR */
protect(headp
); /*protect the list from garbage collection*/
for( indx
=0 ; indx
<= HASHTOP
-1 ; indx
++ ) /* though oblist */
for( symb
= hasht
[indx
] ;
symb
!= (struct atom
*) CNIL
;
tailp
->car
= (lispval
) symb
; /* remember this atom */
tailp
= tailp
->cdr
= newdot() ; /* link to next DTPR */
tailp
->cdr
= nil
; /* close the list unfortunately throwing away
* Maclisp setsyntax function:
* c represents character either by fixnum or atom
* s is the atom "macro" or the atom "splicing" (in which case x is the
* macro to be invoked); or nil (meaning don't change syntax of c); or
* (well thats enough for now) if s is a fixnum then we modify the bits
* for c in the readtable.
register struct argent
*mynp
;
register struct argent
*lbot
, *np
;
error("neither fixnum nor atom as char to setsyntax",FALSE
);
if((c
->pname
)[1])error("Only 1 char atoms to setsyntax",FALSE
);
if(s
->i
== VESC
) Xesc
= (char) index
;
else if(s
->i
== VDQ
) Xdqc
= (char) index
;
if(ctable
[index
] == VESC
/* if we changed the current esc */
&& s
->i
!= VESC
/* to something else, pick current */
&& Xesc
== (char) index
) {
else if(ctable
[index
] == VDQ
/* likewise for double quote */
&& Xdqc
== (char) index
) {
else ctable
[index
] = s
->i
;
/* this aux function is used by setsyntax to determine the new current
escape or double quote character. It scans the character table for
the first character with the given class (either VESC or VDQ) and
puts that character in Xesc or Xdqc (whichever is pointed to by
for(i
=0; i
<=127 && ctable
[i
] != cclass
; i
++);
if(i
<=127) *addr
= (char) i
;
while (!feof(port
) && (getc(port
)!='\n') );