mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-18 17:07:24 +00:00
63 lines
1.8 KiB
C
63 lines
1.8 KiB
C
/* $Id: ubf1.c,v 1.3 1999/05/31 23:35:44 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
|
|
/* Manufactured in the United States of America. */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
#include "version.h"
|
|
|
|
#include "adr68k.h" // for LAddrFromNative
|
|
#include "arith.h" // for N_ARITH_SWITCH
|
|
#include "lispemul.h" // for state, ERROR_EXIT, DLword, LispPTR
|
|
#include "lspglob.h"
|
|
#include "lsptypes.h" // for TYPE_FLOATP
|
|
#include "mkcelldefs.h" // for createcell68k
|
|
#include "my.h" // for N_MakeFloat
|
|
#include "ubf1defs.h" // for N_OP_ubfloat1
|
|
|
|
/************************************************************
|
|
OP_ubfloat1 -- op 355 == UBFLOAT1
|
|
355/0 BOX
|
|
355/1 UNBOX
|
|
355/2 ABS
|
|
355/3 NEGATE
|
|
355/4 UFIX
|
|
***********************************************************/
|
|
|
|
LispPTR N_OP_ubfloat1(int arg, int alpha) {
|
|
switch (alpha) {
|
|
case 0: /* box */
|
|
{
|
|
DLword *wordp;
|
|
wordp = createcell68k(TYPE_FLOATP);
|
|
*((int *)wordp) = arg;
|
|
return (LAddrFromNative(wordp));
|
|
}
|
|
case 1: /* unbox */
|
|
{
|
|
float dest;
|
|
int ret;
|
|
N_MakeFloat(arg, dest, arg);
|
|
ret = *(int *)&dest;
|
|
return (ret);
|
|
}
|
|
case 2: /* abs */ return (0x7FFFFFFF & arg);
|
|
case 3: /* neg */ return (0x80000000 ^ arg);
|
|
case 4: /* ufix */
|
|
{
|
|
float temp;
|
|
int val;
|
|
temp = *(float *)&arg;
|
|
if ((temp > ((float)0x7fffffff)) || (temp < ((float)0x80000000))) ERROR_EXIT(arg);
|
|
val = (int)temp;
|
|
N_ARITH_SWITCH(val);
|
|
}
|
|
default: ERROR_EXIT(arg);
|
|
} /* end switch */
|
|
} /* end N_OP_ubfloat1() */
|
|
|
|
/* end module */
|