mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-17 16:44:00 +00:00
c10d339036
Correct various warning: implicit conversion loses integer precision (30) Correct parameter type declaration error for N_OP_aset1() Ensure that appropriate types and casts are used in aref_switch() Remove requirement for declaring "int new" when using aset_switch() macro
195 lines
7.4 KiB
C
195 lines
7.4 KiB
C
#ifndef MY_H
|
|
#define MY_H 1
|
|
/* @(#) my.h Version 2.15 (2/8/93). copyright venue */
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* M Y . H */
|
|
/* */
|
|
/* */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* (C) Copyright 1989-92 Venue. All Rights Reserved. */
|
|
/* Manufactured in the United States of America. */
|
|
/* */
|
|
/************************************************************************/
|
|
#include <sys/types.h> // for u_char
|
|
#include "version.h" // for BIGVM
|
|
#include "adr68k.h" // for NativeAligned2FromLAddr, NativeAligned4FromLAddr, LAddrFromNative
|
|
#include "arith.h" // for N_ARITH_SWITCH, N_GETNUMBER
|
|
#include "gcdata.h" // for ADDREF, DELREF
|
|
#include "lispemul.h" // for ERROR_EXIT, LispPTR, DLword, SEGMASK, state
|
|
#include "lispmap.h" // for S_POSITIVE, S_CHARACTER, S_NEGATIVE
|
|
#include "lspglob.h"
|
|
#include "lsptypes.h" // for GETBYTE, GETWORD, GetTypeNumber, TYPE_FLOATP
|
|
#include "mkcelldefs.h" // for createcell68k
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* N _ M a k e F l o a t */
|
|
/* */
|
|
/* Get a numeric argument as a floating-point number, converting */
|
|
/* from SMALLP or FIXP, if necessary. */
|
|
/* */
|
|
/************************************************************************/
|
|
#define N_MakeFloat(arg, dest, tos) do { \
|
|
switch (SEGMASK & (LispPTR)(arg)) { \
|
|
case S_POSITIVE: \
|
|
(dest) = (float)(0xFFFF & (LispPTR)(arg)); \
|
|
break; \
|
|
case S_NEGATIVE: \
|
|
(dest) = (float)((int)(0xFFFF0000 | (LispPTR)(arg))); \
|
|
break; \
|
|
default: \
|
|
switch (GetTypeNumber(arg)) { \
|
|
case TYPE_FLOATP: \
|
|
(dest) = *((float *)NativeAligned4FromLAddr(arg)); \
|
|
break; \
|
|
case TYPE_FIXP: \
|
|
(dest) = (float)(*((int *)NativeAligned4FromLAddr(arg))); \
|
|
break; \
|
|
default: ERROR_EXIT(tos); \
|
|
} \
|
|
} \
|
|
} while (0)
|
|
|
|
|
|
|
|
#define N_GetPos(arg, dest, tos) do { \
|
|
if (((arg) & SEGMASK) == S_POSITIVE) \
|
|
(dest) = (arg) & 0xFFFF; \
|
|
else { \
|
|
if (GetTypeNumber(arg) != TYPE_FIXP) ERROR_EXIT(tos); \
|
|
(dest) = *((int *)NativeAligned4FromLAddr(arg)); \
|
|
if ((unsigned)(dest) & 0x80000000) ERROR_EXIT(tos); \
|
|
} \
|
|
} while (0)
|
|
|
|
static inline LispPTR
|
|
aref_switch(unsigned type, LispPTR tos, LispPTR baseL, int index)
|
|
{
|
|
switch (type)
|
|
{
|
|
case 38: /* pointer : 32 bits */
|
|
return(*(((LispPTR *)NativeAligned4FromLAddr(baseL)) + index));
|
|
|
|
case 20: { /* signed : 16 bits */
|
|
DLword result = (GETWORD(((DLword *)NativeAligned2FromLAddr(baseL)) + index));
|
|
if (result & 0x8000) return(result | S_NEGATIVE);
|
|
else return(result | S_POSITIVE);
|
|
}
|
|
|
|
case 67: /* Character : 8 bits */
|
|
return(S_CHARACTER | ((GETBYTE(((char *)NativeAligned2FromLAddr(baseL)) + index)) & 0xFF));
|
|
|
|
case 22: {/* signed : 32 bits */
|
|
int result = *(((int *)NativeAligned4FromLAddr(baseL)) + index);
|
|
N_ARITH_SWITCH(result);
|
|
}
|
|
case 0: /* unsigned : 1 bit per element */
|
|
return(S_POSITIVE | (((GETBYTE(((char *)NativeAligned2FromLAddr(baseL)) + (index >> 3))) >> (7 - (index & 7))) & 1));
|
|
|
|
case 3: /* unsigned : 8 bits per element */
|
|
return(S_POSITIVE | ((GETBYTE(((char *)NativeAligned2FromLAddr(baseL)) + index)) & 0xFF));
|
|
|
|
case 4: /* unsigned : 16 bits per element */
|
|
return(S_POSITIVE | ((GETWORD(((DLword *)NativeAligned2FromLAddr(baseL)) + index)) & 0xFFFF));
|
|
|
|
case 54: /* Float : 32 bits */
|
|
{
|
|
float *cellp = (float *)createcell68k(TYPE_FLOATP);
|
|
*cellp = *(float *)(NativeAligned4FromLAddr(baseL) + index);
|
|
return (LAddrFromNative(cellp));
|
|
}
|
|
|
|
case 68: /* Character : 16 bits */
|
|
return(S_CHARACTER | ((GETWORD(((DLword *)NativeAligned2FromLAddr(baseL)) + index)) & 0xFFFF));
|
|
|
|
case 86: /* XPointer : 32 bits */
|
|
return(*(((LispPTR *)NativeAligned4FromLAddr(baseL)) + index));
|
|
|
|
default: /* Illegal or Unimplemented */
|
|
ERROR_EXIT(tos);
|
|
}/* end switch typenumber */
|
|
}
|
|
|
|
#define aset_switch(type, tos) \
|
|
do { \
|
|
switch (type) { \
|
|
case 38: /* pointer : 32 bits */ \
|
|
GCLOOKUP(*(((LispPTR *)NativeAligned4FromLAddr(base)) + index), DELREF); \
|
|
GCLOOKUP(data, ADDREF); \
|
|
*(((LispPTR *)NativeAligned4FromLAddr(base)) + index) = data; \
|
|
return(data); \
|
|
case 20: { /* signed : 16 bits */ \
|
|
DLword new = data & 0xFFFF; \
|
|
if ((((data & SEGMASK) == S_POSITIVE) && ((data & 0x8000) == 0)) ||\
|
|
(((data & SEGMASK) == S_NEGATIVE) && (data & 0x8000))) \
|
|
GETWORD(((DLword *)NativeAligned2FromLAddr(base)) + index) = new; \
|
|
else ERROR_EXIT(tos); \
|
|
return(data); \
|
|
} \
|
|
case 67: { /* Character : 8 bits */ \
|
|
DLword new = data & 0xFFFF; \
|
|
if ((data & SEGMASK) != S_CHARACTER) ERROR_EXIT(tos); \
|
|
if (new > 0xFF) ERROR_EXIT(tos); \
|
|
GETBYTE(((char *)NativeAligned2FromLAddr(base)) + index) = (u_char)new; \
|
|
return(data); \
|
|
} \
|
|
case 22: { /* signed : 32 bits */ \
|
|
int new; \
|
|
N_GETNUMBER(data, new, doufn); \
|
|
*(((int *)NativeAligned4FromLAddr(base)) + index) = new; \
|
|
return(data); \
|
|
} \
|
|
case 0: { /* unsigned : 1 bit per element */ \
|
|
int new; \
|
|
N_GetPos(data, new, tos); \
|
|
if (new > 1) ERROR_EXIT(tos); \
|
|
if (new) { \
|
|
new = (1 << (7 - (index & 7))); \
|
|
GETBYTE(((u_char *)NativeAligned2FromLAddr(base)) + (index >> 3)) |= (u_char)new; \
|
|
} \
|
|
else { \
|
|
new = 0xFF - (1 << (7 - (index & 7))); \
|
|
GETBYTE(((u_char *)NativeAligned2FromLAddr(base)) + (index >> 3)) &= (u_char)new; \
|
|
} \
|
|
return(data); \
|
|
} \
|
|
case 3: { /* unsigned : 8 bits per element */ \
|
|
int new; \
|
|
N_GetPos(data, new, tos); \
|
|
if (new > 0xFF) ERROR_EXIT(tos); \
|
|
GETBYTE(((char *)NativeAligned2FromLAddr(base)) + index) = (u_char)new; \
|
|
return(data); \
|
|
} \
|
|
case 4: { /* unsigned : 16 bits per element */ \
|
|
int new; \
|
|
N_GetPos(data, new, tos); \
|
|
if (new > 0xFFFF) ERROR_EXIT(tos); \
|
|
GETWORD(((DLword *)NativeAligned2FromLAddr(base)) + index) = (DLword)new; \
|
|
return(data); \
|
|
} \
|
|
case 54: /* Float : 32 bits */ \
|
|
if (GetTypeNumber(data) != TYPE_FLOATP) ERROR_EXIT(tos); \
|
|
*(((int *)NativeAligned4FromLAddr(base)) + index) = *((int *)NativeAligned4FromLAddr(data)); \
|
|
return(data); \
|
|
case 68: {/* Character : 16 bits */ \
|
|
DLword new; \
|
|
if ((data & SEGMASK) != S_CHARACTER) ERROR_EXIT(tos); \
|
|
new = data & 0xFFFF; \
|
|
GETWORD(((DLword *)NativeAligned2FromLAddr(base)) + index) = new; \
|
|
return(data); \
|
|
} \
|
|
case 86: /* XPointer : 32 bits */ \
|
|
*(((LispPTR *)NativeAligned4FromLAddr(base)) + index) = data; \
|
|
return(data); \
|
|
default: /* Illegal or Unimplemented */ \
|
|
ERROR_EXIT(tos); \
|
|
}/* end switch typenumber */ \
|
|
} while (0)
|
|
#endif /* MY_H */
|