mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-15 15:57:13 +00:00
12b431dbd0
These macros aren't actually defined anywhere in our code and aren't used outside of the old support for the Sun I386 hardware.
67 lines
1.7 KiB
C
67 lines
1.7 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 <stdio.h>
|
|
#include "lispemul.h"
|
|
#include "adr68k.h"
|
|
#include "lspglob.h"
|
|
#include "lsptypes.h"
|
|
#include "lispmap.h"
|
|
#include "mkcelldefs.h"
|
|
#include "arith.h"
|
|
#include "medleyfp.h"
|
|
#include "my.h"
|
|
|
|
#include "ubf1defs.h"
|
|
|
|
/************************************************************
|
|
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 */
|
|
{
|
|
register DLword *wordp;
|
|
wordp = createcell68k(TYPE_FLOATP);
|
|
*((int *)wordp) = arg;
|
|
return (LADDR_from_68k(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 */
|
|
{
|
|
register 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 */
|