/*===========================================
- The following function partially implement two explode functions,
- explodec and exploden. They only work for atom arguments.
-===========================================*/
int kind
, slashify
; /* 0=explodec 1=exploden */
char ch
, *strb
, strbb
[BUFSIZ
]; /* temporary string buffer */
register lispval last
, handy
;
snpand(4); /* kludge register save mask */
typ
=TYPE(handy
); /* we only work for a few types */
/* put the characters to return in the string buffer strb */
register char *cp
, *out
= strbb
;
if(ctable
[(*cp
)&0177]==VNUM
)
sprintf(strb
, "%d", lbot
->val
->i
);
sprintf(strb
, "%0.16G", lbot
->val
->r
);
for((handy
= lbot
->val
), count
= 12;
(handy
= handy
->CDR
), count
+= 12);
strb
= (char *) alloca(count
);
_strbuf
._flag
= _IOWRT
+_IOSTRG
;
pbignum(lbot
->val
,&_strbuf
);
errorh(Vermisc
,"EXPLODE ARG MUST BE STRING, SYMBOL, FIXNUM, OR FLONUM",nil
,FALSE
,0,handy
);
if( strb
[0] != NULL_CHAR
) /* if there is something to do */
protect(handy
= last
= newdot());
strbuf
[1] = NULL_CHAR
; /* set up for getatom */
for(i
=0; ch
= strb
[i
++]; ) {
case 0: strbuf
[0] = hash
= ch
; /* character explode */
hash
= 177 & hash
; /* cut 1st bit off if any */
last
->car
= (lispval
) getatom(); /* look in oblist */
/* end list with a nil pointer */
else return(nil
); /* return nil if no characters */
/*===========================
- (explodec 'atm) returns (a t m)
- (explodec 234) returns (\2 \3 \4)
-===========================*/
{ return(Lexpldx(0,0)); }
/*===========================
- (exploden 'abc) returns (65 66 67)
- (exploden 123) returns (49 50 51)
-=============================*/
{ return(Lexpldx(1,0)); }
/*===========================
- (explodea "123") returns (\\ \1 \2 \3);
- (explodea 123) returns (\1 \2 \3);
-=============================*/
{ return(Lexpldx(0,1)); }
* (argv) returns how many arguments where on the command line which invoked
* lisp; (argv i) returns the i'th argument made into an atom;
if(TYPE(handy
)==INT
&& handy
->i
>=0 && handy
->i
<Xargc
) {
strcpy(strbuf
,Xargv
[handy
->i
]);
* (chdir <atom>) executes a chdir command
* if successful, return t otherwise returns nil
if(TYPE(handy
)==ATOM
&& (chdir(handy
->pname
)>=0))
/* ==========================================================
- ascii - convert from number to ascii character
- the number is checked so that it is in the range 0-255
- then it is made a character and returned
- =========================================================*/
handy
= lbot
->val
; /* get argument */
if(TYPE(handy
) != INT
) /* insure that it is an integer */
{ error("argument not an integer",FALSE
);
if(handy
->i
< 0 || handy
->i
> 0377) /* insure that it is in range*/
{ error("argument is out of ascii range",FALSE
);
strbuf
[0] = handy
->i
; /* ok value, make into a char */
/* lookup and possibly intern the atom given in strbuf */
return( (lispval
) getatom() );
* boole - maclisp bitwise boolean function
* (boole k x y) where k determines which of 16 possible bitwise
* truth tables may be applied. Common values are 1 (and) 6 (xor) 7 (or)
* the result is mapped over each pair of bits on input
register struct argent
*mynp
;
error("Boole demands at least 3 args",FALSE
);
for(mynp
+= 2; mynp
< np
; mynp
++) {
/* case 5: x = x; break; */
register lispval result
, handy
;
snpand(3); /* fixup entry mask */
if(TYPE(result
)!=INT
) error("Factorial of Non-fixnum. If you want me\
to calculate fact of > 2^30 We will be here till doomsday!.",FALSE
);
protect(result
= newsdot());
for(; itemp
> 1; itemp
--)
if(result
->CDR
) return(result
);
(handy
= newint())->i
= result
->i
;
* fix -- maclisp floating to fixnum conversion
* for the moment, mereley convert floats to ints.
* eventual convert to bignum if too big to fit.
register lispval result
, handy
;
error("innaproriate arg to fix.",FALSE
);
return(inewint((int)handy
->r
));
return(inewint(((int)handy
->r
)-1));
register lispval handy
,result
;
case DOUB
: return(handy
);
case INT
: result
= newdoub();
result
->r
= (double) handy
->i
;
default: error(Vermisc
,"Bad argument to float",nil
,FALSE
,0,handy
);
/* Lbreak ***************************************************************/
/* If first argument is not nil, this is evaluated and printed. Then */
/* error is called with the "breaking" message. */
printr(lbot
->val
,poport
);
register lispval result
, work
, temp
;
register struct argent
*mynp
;
register struct argent
*lbot
, *np
;
lispval quo
, rem
; struct sdot dummy
;
if((typ
=TYPE(result
))==INT
) {
error("First arg to divide neither a bignum nor int.",FALSE
);
if(typ
!= INT
&& typ
!= SDOT
)
error("second arg to Divide neither an sdot nor an int.",FALSE
);
divbig(result
,work
, &quo
, &rem
);
if(rem
==((lispval
) &dummy
))
protect(rem
= inewint(dummy
.I
));
protect(result
= work
= newdot());
(work
->cdr
= newdot())->car
= rem
;
register struct argent
* mynp
= lbot
+AD
;
register lispval work
, result
;
snpand(3); /* fix register mask */
/* (Emuldiv mul1 mult2 add quo) =>
temp = mul1 + mul2 + sext(add);
result = (list temp/quo temp%quo);
to mix C and lisp a bit */
Imuldiv(mynp
[0].val
->i
, mynp
[1].val
->i
, mynp
[2].val
->i
,
mynp
[3].val
->i
, &quo
, &rem
);
protect(result
=newdot());
(result
->car
=inewint(quo
));
work
= result
->cdr
= newdot();
(work
->car
=inewint(rem
));
asm(" emul 4(ap),8(ap),12(ap),r0");
asm(" ediv 16(ap),r0,*20(ap),*24(ap)");