mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-27 20:27:45 +00:00
Reformat all C source files with Clang-format in Google style w/ 100 col width.
This commit is contained in:
Nick Briggs
314
src/eqf.c
Executable file → Normal file
314
src/eqf.c
Executable file → Normal file
@@ -9,10 +9,6 @@ static char *id = "$Id: eqf.c,v 1.3 1999/05/31 23:35:28 sybalsky Exp $ Copyright
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
|
||||
@@ -27,7 +23,6 @@ static char *id = "$Id: eqf.c,v 1.3 1999/05/31 23:35:28 sybalsky Exp $ Copyright
|
||||
|
||||
#include "version.h"
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include "lispemul.h"
|
||||
#include "lspglob.h"
|
||||
@@ -38,7 +33,6 @@ static char *id = "$Id: eqf.c,v 1.3 1999/05/31 23:35:28 sybalsky Exp $ Copyright
|
||||
#include "my.h"
|
||||
#include "arith.h"
|
||||
|
||||
|
||||
/************************************************************
|
||||
op 072 N_OP_eqlop EQL
|
||||
op 0314 N_OP_clequal CL:EQUAL
|
||||
@@ -51,14 +45,14 @@ op 0377 N_OP_eqq CL:=
|
||||
EQ is a strict pointer comparision, equivalent to C's ==
|
||||
|
||||
EQL (common lisp) does no conversions before comparision, but will
|
||||
compare equal FIXPs or equal FLOATPs.
|
||||
compare equal FIXPs or equal FLOATPs.
|
||||
|
||||
CL:= will do a numeric comparison
|
||||
and will compare floats. If given integers, it will convert
|
||||
to floating point first.
|
||||
to floating point first.
|
||||
|
||||
IL:EQUAL is a recursive comparison which will compare 1 = 1.0
|
||||
it work like code with CL:= for the most part
|
||||
it work like code with CL:= for the most part
|
||||
|
||||
CL:EQUAL is a recursive comparision which uses EQL at the leaves
|
||||
|
||||
@@ -69,7 +63,7 @@ number types include:
|
||||
|
||||
SMALLP (immediate with S_POSITIVE or S_NEGATIVE)
|
||||
FIXP (32 bit boxed value, handled in C. Usually canonical, i.e.,
|
||||
will be SMALLP. (IPLUS x 0) will always canonicallize.)
|
||||
will be SMALLP. (IPLUS x 0) will always canonicallize.)
|
||||
FLOATP (32 bit boxed value, handled in C, usually)
|
||||
RATIO (a/b. Always canonical, i.e., b doesn't divide a evenly)
|
||||
COMPLEX (a+bi. Not handled in C)
|
||||
@@ -77,16 +71,13 @@ BIGNUM (integer that can't be represented bigger than 32 bits)
|
||||
|
||||
*/
|
||||
|
||||
#define IF_IMMEDIATE(arg, doit, doitsmall) \
|
||||
switch(SEGMASK & arg) { \
|
||||
case ATOM_OFFSET: doit; \
|
||||
case S_CHARACTER: doit; \
|
||||
case S_POSITIVE: doitsmall; \
|
||||
case S_NEGATIVE: doitsmall; \
|
||||
}
|
||||
|
||||
|
||||
|
||||
#define IF_IMMEDIATE(arg, doit, doitsmall) \
|
||||
switch (SEGMASK & arg) { \
|
||||
case ATOM_OFFSET: doit; \
|
||||
case S_CHARACTER: doit; \
|
||||
case S_POSITIVE: doitsmall; \
|
||||
case S_NEGATIVE: doitsmall; \
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -96,46 +87,46 @@ BIGNUM (integer that can't be represented bigger than 32 bits)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR N_OP_clequal(register int arg1, register int arg2)
|
||||
{
|
||||
register int type;
|
||||
LispPTR N_OP_clequal(register int arg1, register int arg2) {
|
||||
register int type;
|
||||
|
||||
if (arg2 == arg1) return(ATOM_T);
|
||||
IF_IMMEDIATE(arg1, return(NIL), return(NIL));
|
||||
IF_IMMEDIATE(arg2, return(NIL), return(NIL));
|
||||
if (arg2 == arg1) return (ATOM_T);
|
||||
IF_IMMEDIATE(arg1, return (NIL), return (NIL));
|
||||
IF_IMMEDIATE(arg2, return (NIL), return (NIL));
|
||||
|
||||
/* CL:EQUAL is true for two strings that have different Interlisp
|
||||
type numbers; cannot currently handle it here. */
|
||||
/* CL:EQUAL is true for two strings that have different Interlisp
|
||||
type numbers; cannot currently handle it here. */
|
||||
|
||||
/* can return NIL if one is a number and the other isn't */
|
||||
/* can return NIL if one is a number and the other isn't */
|
||||
|
||||
if (IsNumber(arg1)) { if(!IsNumber(arg2)) return(NIL); }
|
||||
else {if (IsNumber(arg2)) {return(NIL);}
|
||||
else ERROR_EXIT(arg2)}
|
||||
if (IsNumber(arg1)) {
|
||||
if (!IsNumber(arg2)) return (NIL);
|
||||
} else {
|
||||
if (IsNumber(arg2)) {
|
||||
return (NIL);
|
||||
} else
|
||||
ERROR_EXIT(arg2)
|
||||
}
|
||||
|
||||
/* now we know both are numbers */
|
||||
/* now we know both are numbers */
|
||||
|
||||
if ((type = GetTypeNumber(arg1)) != (GetTypeNumber(arg2))) return(NIL);
|
||||
if ((type = GetTypeNumber(arg1)) != (GetTypeNumber(arg2))) return (NIL);
|
||||
|
||||
/* now we know both are the same type. Shouldn't see any SMALLPs */
|
||||
/* now we know both are the same type. Shouldn't see any SMALLPs */
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case TYPE_FIXP: if (FIXP_VALUE(arg1) == FIXP_VALUE(arg2))
|
||||
{return(ATOM_T);}
|
||||
return(NIL);
|
||||
|
||||
case TYPE_FLOATP: if(FLOATP_VALUE(arg1) == FLOATP_VALUE(arg2))
|
||||
{return(ATOM_T);}
|
||||
return(NIL);
|
||||
|
||||
default: ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
}/* end N_OP_clequal */
|
||||
switch (type) {
|
||||
case TYPE_FIXP:
|
||||
if (FIXP_VALUE(arg1) == FIXP_VALUE(arg2)) { return (ATOM_T); }
|
||||
return (NIL);
|
||||
|
||||
case TYPE_FLOATP:
|
||||
if (FLOATP_VALUE(arg1) == FLOATP_VALUE(arg2)) { return (ATOM_T); }
|
||||
return (NIL);
|
||||
|
||||
default: ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
} /* end N_OP_clequal */
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -145,41 +136,38 @@ LispPTR N_OP_clequal(register int arg1, register int arg2)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR N_OP_eqlop(register int arg1, register int arg2)
|
||||
{
|
||||
register int type;
|
||||
LispPTR N_OP_eqlop(register int arg1, register int arg2) {
|
||||
register int type;
|
||||
|
||||
if (arg2 == arg1) return(ATOM_T);
|
||||
IF_IMMEDIATE(arg1, return(NIL), return(NIL));
|
||||
IF_IMMEDIATE(arg2, return(NIL), return(NIL));
|
||||
if (arg2 == arg1) return (ATOM_T);
|
||||
IF_IMMEDIATE(arg1, return (NIL), return (NIL));
|
||||
IF_IMMEDIATE(arg2, return (NIL), return (NIL));
|
||||
|
||||
/* EQL is true if EQ or both are numbers, the same type, and EQUAL */
|
||||
/* EQL is true if EQ or both are numbers, the same type, and EQUAL */
|
||||
|
||||
/* can return NIL if one is a number and the other isn't */
|
||||
/* can return NIL if one is a number and the other isn't */
|
||||
|
||||
if ((type = GetTypeNumber(arg1)) != (GetTypeNumber(arg2))) return(NIL);
|
||||
if ((type = GetTypeNumber(arg1)) != (GetTypeNumber(arg2))) return (NIL);
|
||||
|
||||
/* now we know both are the same type. Shouldn't see any SMALLPs */
|
||||
/* now we know both are the same type. Shouldn't see any SMALLPs */
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case TYPE_FIXP: if (FIXP_VALUE(arg1) == FIXP_VALUE(arg2))
|
||||
{return(ATOM_T);}
|
||||
return(NIL);
|
||||
|
||||
case TYPE_FLOATP: if(FLOATP_VALUE(arg1) == FLOATP_VALUE(arg2))
|
||||
{return(ATOM_T);}
|
||||
return(NIL);
|
||||
|
||||
default: if(IsNumber(arg1)) {ERROR_EXIT(arg2); }
|
||||
else return(NIL);
|
||||
|
||||
}
|
||||
|
||||
} /* end N_OP_eqlop */
|
||||
switch (type) {
|
||||
case TYPE_FIXP:
|
||||
if (FIXP_VALUE(arg1) == FIXP_VALUE(arg2)) { return (ATOM_T); }
|
||||
return (NIL);
|
||||
|
||||
case TYPE_FLOATP:
|
||||
if (FLOATP_VALUE(arg1) == FLOATP_VALUE(arg2)) { return (ATOM_T); }
|
||||
return (NIL);
|
||||
|
||||
default:
|
||||
if (IsNumber(arg1)) {
|
||||
ERROR_EXIT(arg2);
|
||||
} else
|
||||
return (NIL);
|
||||
}
|
||||
|
||||
} /* end N_OP_eqlop */
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -189,60 +177,59 @@ LispPTR N_OP_eqlop(register int arg1, register int arg2)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR N_OP_equal(register int arg1, register int arg2)
|
||||
{
|
||||
register int type, type2;
|
||||
LispPTR N_OP_equal(register int arg1, register int arg2) {
|
||||
register int type, type2;
|
||||
|
||||
if (arg2 == arg1) return(ATOM_T);
|
||||
if (arg2 == arg1) return (ATOM_T);
|
||||
|
||||
IF_IMMEDIATE(arg1, return(NIL), goto arg1_small);
|
||||
IF_IMMEDIATE(arg2, return(NIL), goto arg2_small);
|
||||
goto arg2_small;
|
||||
IF_IMMEDIATE(arg1, return (NIL), goto arg1_small);
|
||||
IF_IMMEDIATE(arg2, return (NIL), goto arg2_small);
|
||||
goto arg2_small;
|
||||
|
||||
arg1_small:
|
||||
IF_IMMEDIATE(arg2, return(NIL), return(NIL)); /* arg2 atom or both small */
|
||||
IF_IMMEDIATE(arg2, return (NIL), return (NIL)); /* arg2 atom or both small */
|
||||
|
||||
arg2_small:
|
||||
|
||||
if (IsNumber(arg1)) { if(!IsNumber(arg2)) return(NIL) ;}
|
||||
else {if (IsNumber(arg2)) {return(NIL);}
|
||||
else ERROR_EXIT(arg2)}
|
||||
if (IsNumber(arg1)) {
|
||||
if (!IsNumber(arg2)) return (NIL);
|
||||
} else {
|
||||
if (IsNumber(arg2)) {
|
||||
return (NIL);
|
||||
} else
|
||||
ERROR_EXIT(arg2)
|
||||
}
|
||||
|
||||
/* now we know both are numbers */
|
||||
/* now we know both are numbers */
|
||||
|
||||
type = GetTypeNumber(arg1);
|
||||
type2 = GetTypeNumber(arg2);
|
||||
|
||||
if (type == type2)
|
||||
{
|
||||
switch (GetTypeNumber(arg1))
|
||||
{
|
||||
case TYPE_SMALLP: return(NIL);
|
||||
case TYPE_FIXP: if(FIXP_VALUE(arg1)==FIXP_VALUE(arg2))
|
||||
{return(ATOM_T);}
|
||||
return(NIL);
|
||||
case TYPE_FLOATP: if(FLOATP_VALUE(arg1)==FLOATP_VALUE(arg2))
|
||||
{return(ATOM_T);}
|
||||
return(NIL);
|
||||
default: ERROR_EXIT(arg2);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
if ((type == TYPE_FLOATP) || (type2 == TYPE_FLOATP))
|
||||
{
|
||||
register float f1, f2;
|
||||
N_MakeFloat(arg1, f1, arg2);
|
||||
N_MakeFloat(arg2, f2, arg2);
|
||||
if ((f1 + 0.0) == (f2 + 0.0)) return(ATOM_T);
|
||||
else return(NIL);
|
||||
}
|
||||
else return(NIL); /* neither is float, types are different */
|
||||
|
||||
} /* end N_OP_equal */
|
||||
type = GetTypeNumber(arg1);
|
||||
type2 = GetTypeNumber(arg2);
|
||||
|
||||
if (type == type2) {
|
||||
switch (GetTypeNumber(arg1)) {
|
||||
case TYPE_SMALLP: return (NIL);
|
||||
case TYPE_FIXP:
|
||||
if (FIXP_VALUE(arg1) == FIXP_VALUE(arg2)) { return (ATOM_T); }
|
||||
return (NIL);
|
||||
case TYPE_FLOATP:
|
||||
if (FLOATP_VALUE(arg1) == FLOATP_VALUE(arg2)) { return (ATOM_T); }
|
||||
return (NIL);
|
||||
default: ERROR_EXIT(arg2);
|
||||
}
|
||||
}
|
||||
|
||||
if ((type == TYPE_FLOATP) || (type2 == TYPE_FLOATP)) {
|
||||
register float f1, f2;
|
||||
N_MakeFloat(arg1, f1, arg2);
|
||||
N_MakeFloat(arg2, f2, arg2);
|
||||
if ((f1 + 0.0) == (f2 + 0.0))
|
||||
return (ATOM_T);
|
||||
else
|
||||
return (NIL);
|
||||
} else
|
||||
return (NIL); /* neither is float, types are different */
|
||||
|
||||
} /* end N_OP_equal */
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -254,62 +241,55 @@ arg2_small:
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR N_OP_eqq(register int arg1, register int arg2) /* CL:= opcode 0377 */
|
||||
|
||||
{
|
||||
register int type1, type2;
|
||||
register float f1, f2;
|
||||
|
||||
{
|
||||
register int type1, type2;
|
||||
register float f1, f2;
|
||||
|
||||
if (!((type1 = GetTypeEntry(arg1)) & TT_NUMBERP)) ERROR_EXIT(arg2);
|
||||
if (arg2 == arg1) return(ATOM_T);
|
||||
if (!((type2 = GetTypeEntry(arg2)) & TT_NUMBERP)) ERROR_EXIT(arg2);
|
||||
type1 &= 0x7ff;
|
||||
type2 &= 0x7ff;
|
||||
if (!((type1 = GetTypeEntry(arg1)) & TT_NUMBERP)) ERROR_EXIT(arg2);
|
||||
if (arg2 == arg1) return (ATOM_T);
|
||||
if (!((type2 = GetTypeEntry(arg2)) & TT_NUMBERP)) ERROR_EXIT(arg2);
|
||||
type1 &= 0x7ff;
|
||||
type2 &= 0x7ff;
|
||||
|
||||
switch ( type1 )
|
||||
{
|
||||
case TYPE_SMALLP :
|
||||
switch ( type2 )
|
||||
{
|
||||
case TYPE_SMALLP : return(NIL);
|
||||
case TYPE_FIXP : return(NIL);
|
||||
case TYPE_FLOATP : goto checkfloats;
|
||||
default : ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
case TYPE_FIXP :
|
||||
switch ( type2 )
|
||||
{
|
||||
case TYPE_SMALLP : return(NIL);
|
||||
case TYPE_FIXP :
|
||||
if (FIXP_VALUE(arg1) == FIXP_VALUE(arg2))
|
||||
return(ATOM_T);
|
||||
else return(NIL);
|
||||
case TYPE_FLOATP : goto checkfloats;
|
||||
default : ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
case TYPE_FLOATP :
|
||||
switch ( type2 )
|
||||
{
|
||||
case TYPE_SMALLP : goto checkfloats;
|
||||
case TYPE_FIXP : goto checkfloats;
|
||||
case TYPE_FLOATP : goto checkfloats;
|
||||
default : ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
default : ERROR_EXIT(arg2);
|
||||
switch (type1) {
|
||||
case TYPE_SMALLP:
|
||||
switch (type2) {
|
||||
case TYPE_SMALLP: return (NIL);
|
||||
case TYPE_FIXP: return (NIL);
|
||||
case TYPE_FLOATP: goto checkfloats;
|
||||
default: ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
checkfloats:
|
||||
case TYPE_FIXP:
|
||||
switch (type2) {
|
||||
case TYPE_SMALLP: return (NIL);
|
||||
case TYPE_FIXP:
|
||||
if (FIXP_VALUE(arg1) == FIXP_VALUE(arg2))
|
||||
return (ATOM_T);
|
||||
else
|
||||
return (NIL);
|
||||
case TYPE_FLOATP: goto checkfloats;
|
||||
default: ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
N_MakeFloat(arg1, f1, arg2);
|
||||
N_MakeFloat(arg2, f2, arg2);
|
||||
if (f1 == f2) return(ATOM_T);
|
||||
if ((f1 == -0.0) && (f2 == 0.0)) return(ATOM_T);
|
||||
if ((f1 == 0.0) && (f2 == -0.0)) return(ATOM_T);
|
||||
return(NIL);
|
||||
} /* end N_OP_eqq() */
|
||||
case TYPE_FLOATP:
|
||||
switch (type2) {
|
||||
case TYPE_SMALLP: goto checkfloats;
|
||||
case TYPE_FIXP: goto checkfloats;
|
||||
case TYPE_FLOATP: goto checkfloats;
|
||||
default: ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
default: ERROR_EXIT(arg2);
|
||||
}
|
||||
|
||||
checkfloats:
|
||||
|
||||
N_MakeFloat(arg1, f1, arg2);
|
||||
N_MakeFloat(arg2, f2, arg2);
|
||||
if (f1 == f2) return (ATOM_T);
|
||||
if ((f1 == -0.0) && (f2 == 0.0)) return (ATOM_T);
|
||||
if ((f1 == 0.0) && (f2 == -0.0)) return (ATOM_T);
|
||||
return (NIL);
|
||||
} /* end N_OP_eqq() */
|
||||
|
||||
Reference in New Issue
Block a user