github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-02-27 17:12:42 +00:00
Code Issues Projects Releases Wiki Activity

Delete code related to NATIVETRAN feature. (#232)

Browse Source 
* Delete code related to NATIVETRAN feature.

This was obsolete work that had been done for generating
native code from the bytecode.

Closes Interlisp/medley#89.

* Remove unused SaveD6.
This commit is contained in:
Bruce Mitchener
2021-01-20 08:57:53 +07:00
committed by GitHub
parent c89b6fd611
commit 0a057dec6b
17 changed files with 19 additions and 1415 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
CMakeLists.txt
View File

@@ -108,7 +108,6 @@ SET(BAD_SRCS
src/imagefile.c
src/keytst.c
src/kbdif.c
src/loader.c
src/lpdual.c
src/lpkit.c
src/lplexyy.c
@@ -367,7 +366,6 @@ SET(MAIKO_HDRS
inc/mvsdefs.h
inc/my.h
inc/MyWindow.h
inc/native.h
inc/nfsfh.h
inc/nfswatch.h
inc/opcodes.h

4
bin/compile-flags
View File

@@ -30,7 +30,6 @@ NOASM If true, suppress any attempt to include assembler
SUN3_OS4_IL
SUN4_OS4_IL
OPDISP
NATIVETRAN
PROFILE
and enables NOASMFNCALL
C_ONLY
@@ -101,9 +100,6 @@ ORG_FILPCORSORBAR If true, you get the pixwin version of cursor changing;
region.
OLD_CURSOR If true, uses the pixwin cursor code (e.g., win_setcursor);
otherwise, uses the direct-write technique.
NATIVETRAN If true, code to support the native-code translator is
included in the emulator. This feature was never released,
and most such code is probably obsolete.
OS4_TYPE4BUG If true, includes the patches around SunOS 4.0.x's failure
to tell you you've got a Type-4 keyboard.
ALLDIRSEARCH CURRENTLY HARD DISABLED IN directory.c; looks like it

14
bin/makefile-tail
View File

@@ -39,7 +39,6 @@
#INSDIR = $(RELDIR)install.$(RELEASENAME)/
CHKDIR = $(RELDIR)checksumdir/
SCRPTDIR = $(RELDIR)scripts/
NATDIR = $(RELDIR)usernative/
# OSARCHDIR is the os/architecture dir, where executables all go.
OSARCHDIR = ../$(OSARCHNAME)/
@@ -893,7 +892,6 @@ $(OBJECTDIR)lpy.tab.o : $(SRCDIR)lpy.tab.c $(REQUIRED-INCS) $(INCDIR)lpdefs.h $
# Installation targets - copyprotect is ON here
# library, sysouts, fonts on release directories not handled here.
# userfiles are separate target explicitly (can make w/o building lde)
# $(NATDIR)native.h $(NATDIR)disp68K.il
################################################################################
prerelease :
@@ -975,18 +973,6 @@ $(SCRPTDIR)medley : $(BINDIR)medley
cp -p $(BINDIR)medley $(SCRPTDIR)medley
chmod 755 $(SCRPTDIR)medley
################################################################################
# Obsolete
################################################################################
$(NATDIR)native.h : $(INCDIR)native.h
rm -f $(NATDIR)native.h
ln -s $(INCDIR)native.h $(NATDIR)native.h
$(NATDIR)disp68K.il : $(SRCDIR)disp68K.il
rm -f $(NATDIR)disp68K.il
ln -s $(SRCDIR)disp68K.il $(NATDIR)disp68K.il
################################################################################
# Miscellaneous targets
# .c.s. should always have -O

5
inc/inlineC.h
View File

@@ -71,9 +71,6 @@
#define SWAP_WORDS(x) (((unsigned int)x << 16) | (((unsigned int)x >> 16) & 0xFFFF))
#define NATIVECHECK \
{if (BCE_CURRENTFX->native) {goto gonative ;} nextop0; }
#define nextop0 {goto nextopcode; }
#define nextop1 {PCMACL += 1; nextop0; }
#define nextop2 {PCMACL += 2; nextop0; }
@@ -375,7 +372,7 @@ register char *buff68k; /* pointer to BUFF */ \
#define CONTEXTSWITCH { EXT; OP_contextsw(); RET; \
/*CHECK_INTERRUPT;*/ CLR_IRQ; \
NATIVE_NEXTOP0; }
nextop0; }
#define NOP { nextop1; }
#define RESLIST(n) { goto op_ufn; }

4
inc/lispemul.h
View File

@@ -535,10 +535,6 @@ DOSTACKOVERFLOW(argnum,bytenum) if it needs hardreturn-cleanup
#define MAXPNCHARS 255 /* Maximum length of PnChars */
#define GET_NATIVE_ADDR(fnobject) \
*((int *) ((UNSIGNED)fnobject + fnobject->startpc - 4))
#define FALSE 0
#define TRUE !FALSE

827
inc/native.h
View File

@@ -1,827 +0,0 @@
#ifndef NATIVE_H
#define NATIVE_H 1
/* $Id: native.h,v 1.2 1999/01/03 02:06:18 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
/************************************************************************/
/* */
/* (C) Copyright 1989-98 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
/* ******
#include "lispemul.h"
#include "emlglob.h"
#include "address.h"
#include "adr68k.h"
#include "stack.h"
#include "lspglob.h"
#include "lsptypes.h"
#include "lispmap.h"
#include "cell.h"
****** */
/* ************************************************************************* */
/* ************** EMULATOR MACROS ************ */
/* ************************************************************************* */
typedef char ByteCode;
typedef unsigned short DLword;
typedef unsigned int LispPTR;
typedef struct consstr {
unsigned cdr_code : 8 ;
unsigned car_field : 24 ;
} ConsCell;
#define CDR_INDIRECT 0
#define CDR_NIL 128
#define CDR_ONPAGE 128
struct state{
DLword *ivar;
DLword *pvar;
};
#define ATOM_T 0114 /* T's AtomIndex Number 114Q */
#define NIL_PTR 0 /* from cell.h 24-mar-87 take */
#define NOBIND_PTR 1
#define FRAMESIZE 10 /* size of frameex1: 10 words */
#define FNHEADSIZE 8 /* size of fnhead: 8 words */
#define GET_NATIVE_ADDR(fnobject) \
*((int *) ((int)fnobject + fnobject->startpc - 4))
#define CALL_NATIVE(defcell, num_args) \
asmgoto(((int *)(GET_NATIVE_ADDR(defcell)))[num_args+(6+2)]);
#define CURRENTFX ((struct frameex1 *)((DLword *) PVar - FRAMESIZE))
#define IVar MachineState.ivar
#define PVar MachineState.pvar
#define GetLongWord(address) (*((int *) (address)))
#define LADDR_from_68k(ptr68k) (((unsigned int)(ptr68k) - (unsigned int)Lisp_world) >>1)
#define Addr68k_from_LADDR(Lisp_addr) (Lisp_world + (Lisp_addr))
#define StkOffset_from_68K(ptr68k)\
(((unsigned int)(ptr68k) - (unsigned int)Stackspace) >>1)
#define Addr68k_from_StkOffset(stkoffset)\
(Stackspace + (stkoffset))
#define POINTER_PAGEBASE(datum) ((datum) & 0x0ffff00)
#define GetDTD(typnum) (DTDspace + ((typnum)<<4))
#define GetTypeEntry(address) *(MDStypetbl + ((((int)address) & 0x0ffff00)>>9))
#define GetTypeNumber(address) ((*(MDStypetbl +((((int)address) & 0x0ffff00)>>9))) & 2047)
#define Listp(address) (GetTypeNumber(address) == TYPE_LISTP)
#define BF_MARK 0x8000
#define BF_MARK32 0x80000000
#define FX_MARK 0xc000
#define FX_MARK_NATIVE 0xc800
#define STK_SAFE 32 /* added with stkmin */
struct fnhead{
DLword stkmin; /* ?? */
short na; /* Numbers of arguments */
short pv; /* ?? */
DLword startpc;
/* head of ByteCodes, DLword offset from stkmin */
unsigned native :1; /* native translated? */
unsigned nil1 :1 ; /* not used */
unsigned argtype : 2; /* ?? */
unsigned nil2 :4 ; /* not used */
unsigned framename : 24; /* index in AtomSpace */
DLword ntsize; /* size of NameTable */
unsigned nlocals :8; /* ?? */
unsigned fvaroffset :8;
/* DLword offset from head of NameTable */
/* NameTable of variable length is following with this structure. */
};
typedef struct frameex1{
unsigned flags :3;
unsigned fast :1;
unsigned native :1; /* This frame treats N-func */
unsigned incall :1;
unsigned validnametable :1;
/* 0: look for FunctionHeader
1: look for NameTable on this FrameEx */
unsigned nopush :1;
unsigned usecount :8;
DLword alink; /* alink pointer (Low addr) */
DLword lofnheader; /* pointer to FunctionHeader (Low addr) */
unsigned hi1fnheader : 8; /* pointer to FunctionHeader (Hi1 addr) */
unsigned hi2fnheader : 8; /* pointer to FunctionHeader (Hi2 addr) */
DLword nextblock; /* pointer to FreeStackBlock */
DLword pc; /* Program counter */
DLword lonametable; /* pointer to NameTable of this FrameEx (Low addr) */
unsigned hi1nametable :8; /* pointer to NameTable of this FrameEx (Hi1 addr) */
unsigned hi2nametable :8; /* pointer to NameTable of this FrameEx (Hi2 addr) */
DLword blink; /* blink pointer (Low addr) */
DLword clink; /* clink pointer (Low addr) */
} FX ;
typedef struct frameex2{
unsigned flags :3;
unsigned fast :1;
unsigned native :1; /* This frame treats N-func */
unsigned incall :1;
unsigned validnametable :1;
/* 0: look for FunctionHeader
1: look for NameTable on this FrameEx */
unsigned nopush :1;
unsigned usecount :8;
DLword alink; /* alink pointer (Low addr) */
LispPTR fnheader; /* pointer to FunctionHeader (swapped) */
DLword nextblock; /* pointer to FreeStackBlock */
DLword pc; /* Program counter */
LispPTR nativera; /* address of native ra */
DLword blink; /* blink pointer (Low addr) */
DLword clink; /* clink pointer (Low addr) */
} FX2 ;
typedef struct basic_frame {
unsigned flags : 3 ;
unsigned nil : 3 ;
unsigned residual :1 ;
unsigned padding : 1 ;
unsigned usecnt : 8 ;
DLword ivar ;
} Bframe ;
/* Structure for DTD */
struct dtd {
DLword dtd_name ;
DLword dtd_size ;
LispPTR dtd_free ;
unsigned unuse :2 ;
unsigned dtd_obsolate :1 ;
unsigned dtd_finalizable :1 ;
unsigned dtd_lockedp : 1 ;
unsigned dtd_hunkp : 1 ;
unsigned dtd_gctype :2 ;
unsigned dtd_descrs : 24;
LispPTR dtd_typespecs ;
LispPTR dtd_ptrs ;
int dtd_oldcnt;
DLword dtd_cnt0 ;
DLword dtd_nextpage ;
DLword dtd_typeentry ;
DLword dtd_supertype ;
};
#define TYPE_SMALLP 1
#define TYPE_FIXP 2
#define TYPE_FLOATP 3
#define TYPE_LITATOM 4
#define TYPE_LISTP 5
#define TYPE_ARRAYP 6
#define TYPE_STRINGP 7
#define TYPE_STACKP 8
#define TYPE_CHARACTERP 9
#define TYPE_VMEMPAGEP 10
#define TYPE_STREAM 11
#define TYPE_BITMAP 12
#define TYPE_COMPILED_CLOSURE 13
#define TYPE_ONED_ARRAY 14
#define TYPE_TWOD_ARRAY 15
#define TYPE_GENERAL_ARRAY 16
typedef struct compiled_closure {
unsigned int nil1 : 8 ;
unsigned int def_ptr : 24; /* function */
unsigned int nil2 : 8 ;
unsigned int env_ptr : 24; /* environment */
} CClosure ;
typedef struct definition_cell {
unsigned ccodep : 1 ;
unsigned fastp : 1 ;
unsigned argtype : 2 ;
unsigned pseudocodep : 1 ;
unsigned nil : 3 ;
unsigned defpointer : 24;
} DefCell ;
#define GetDEFCELL68k(index) ((LispPTR *)Defspace + (index) )
#define GetVALCELL68k(index) ((LispPTR *)Valspace + (index))
#define S_POSITIVE 0xE0000
#define S_NEGATIVE 0xF0000
#define S_CHARACTER 0x70000
/* ************************************************************************* */
/* ************** NATIVE ONLY MACROS ************ */
/* ************************************************************************* */
/************************************************************************/
/* TOP OF STACK OPERATIONS */
/************************************************************************/
#define PUSH(x) {*((LispPTR *) CSTKPTR++) = (LispPTR) x;}
#define PUSH16(x) *((DLword *) CSTKPTR++) = x;
#define PUSH16s(x, y) { PUSH16(x); PUSH16(y); }
#define PUSH_SWAPED(x) { register LispPTR temp;\
temp = x; \
PUSH16(temp); \
PUSH16(swapx(temp)); \
}
#define POP *((LispPTR *) --CSTKPTR)
#define TOS *((LispPTR *) CSTKPTR-1)
#define COPY_TOP TOS
#define SAVE_PUSH_TOP TOS
#define PREV_TOS *((LispPTR *) CSTKPTR-2)
#define GET_POPPED *CSTKPTR
#define GET_POPPED_2 *((LispPTR *) CSTKPTR+1)
#define LSTACK (CSTKPTR - 1)
/************************************************************************/
/* MACROS TO SAVE & RESTORE STATE FOR OP_xx OPCODE ROUTINES */
/* TO CALL OLD STYLE OPCODE ROUTINE */
/************************************************************************/
#define NATIVE_EXT(call_pc) \
{ PC = (ByteCode *) call_pc; \
TopOfStack = POP; \
CurrentStackPTR = (DLword *) (CSTKPTR-1); \
}
#define NATIVE_RET \
{ CSTKPTR = (LispPTR *) CurrentStackPTR + 1; \
PUSH(TopOfStack); \
}
#define CALL_OP_FN(callpc, nextpc, opcodefn) { \
NATIVE_EXT(callpc); \
opcodefn(); \
NATIVE_RET; \
if (nextpc != (unsigned int) PC) { \
QUIT_NATIVE(PC); \
} \
}
/************************************************************************/
/* RETURN TO DISPATCH TO EXECUTE NEW FRAME */
/************************************************************************/
#define NATIVE_CURRENTFX ((struct frameex1 *)((DLword *) PVAR - FRAMESIZE))
#define C_RETURN_TO_DISPATCH \
{ \
asmgoto(&c_ret_to_dispatch); \
}
/************************************************************************/
/* RETURN TO DISPATCH TO EXECUTE OPCODE & RETURN TO NATIVE CODE */
/************************************************************************/
#define BCE(ret_pc) { \
setpc_jmp(ret_pc, &ret_to_unimpl); \
}
/************************************************************************/
/* RETURN TO DISPATCH TO EXECUTE OPCODE & STAY IN EMULATOR */
/************************************************************************/
#define QUIT_NATIVE(ret_pc) \
{ \
setpc_jmp(ret_pc, &ret_to_dispatch); \
}
/************************************************************************/
/* RETURN TO DISPATCH TO EXECUTE FN CALL */
/************************************************************************/
#define RETURN_TO_FN_CALL(ret_pc, golabel) \
{ \
setpc_jmp(ret_pc, &golabel); \
}
/************************************************************************/
/* RETURN TO DISPATCH TO EXECUTE UFN CALL */
/************************************************************************/
#define CALL_UFN(call_pc, opcode) \
{ \
setpc_jmp(call_pc, &ret_to_ufn); \
}
/************************************************************************/
/* RETURN TO DISPATCH TO EXECUTE TIMER INTERRUPT */
/************************************************************************/
#define RETURN_TO_TIMER(call_pc) \
{ \
setpc_jmp(call_pc, &ret_to_timer); \
}
/************************************************************************/
/* STACK OVERFLOW & TIMER CHECKS */
/************************************************************************/
#define STK_MIN(fnobj) ((fnobj->stkmin+STK_SAFE) << 1)
#define STK_END_COMPUTE(stk_end,fnobj) \
( (int)stk_end - STK_MIN(fnobj) )
#define CLR_IRQ \
{Irq_Stk_Check = STK_END_COMPUTE((Irq_Stk_End = (int) EndSTKP), \
FuncObj); \
}
#define STACK_ONLY_CHECK(stkmin) \
{ if ((int) CSTKPTR > (EndSTKP - ((stkmin+STK_SAFE) << 1))){ \
IVar = (DLword *) IVAR; \
PVar = (DLword *) PVAR; \
TopOfStack = POP; \
CurrentStackPTR = (DLword *) (CSTKPTR-1); \
if (do_stackoverflow(0)) { \
printf("REAL STACK OVERFLOW\n"); \
asmgoto(&ret_to_dispatch); \
} \
CSTKPTR = (LispPTR *) CurrentStackPTR + 1; \
PUSH(TopOfStack); \
IVAR = CSTKPTR + entry_pc; \
PVAR = (LispPTR *) PVar; \
} \
}
#define TIMER_STACK_CHECK(pc) \
{ if ( (int) CSTKPTR > Irq_Stk_Check ) {if(pc ==1) {printf("before timer exit\n"); do_brk();} RETURN_TO_TIMER(pc);} }
/************************************************************************/
/* FUNCTION ENTRY SETUP */
/************************************************************************/
/* The code generator must expand this differently, depending on
the number of parameters available to the function.
*/
#define framesetup(x, stkmin, swapped_func_obj) { \
register int NEXTBLOCK; \
{ \
register struct frameex1 *LocFX; \
LocFX = NATIVE_CURRENTFX; \
LocFX->nextblock = NEXTBLOCK = StkOffset_from_68K(IVAR); \
} \
IVar = (DLword *) IVAR ; \
Irq_Stk_Check = ( (int)Irq_Stk_End - ( (stkmin+STK_SAFE) << 1) ); \
\
/* Set up BF */ \
PUSH((BF_MARK << 16) | NEXTBLOCK); \
PUSH((FX_MARK_NATIVE << 16) | StkOffset_from_68K(PVAR)); \
PUSH(swapped_func_obj); \
(DLword *) PVAR = PVar = (DLword *) CSTKPTR = (((DLword *) CSTKPTR) + (FRAMESIZE-4)) ; \
} /* end framesetup */
/************************************************************************/
/* FUNCTION CALL & RETURN */
/************************************************************************/
#define fncall_self(args, pc_assign, newpcval, golabel) { \
NATIVE_CURRENTFX->pc = newpcval; \
IVAR = CSTKPTR - args; \
pc_assign; \
goto golabel; \
} /* end fncall */
#define newdefcell ((struct fnhead *) DATUM68K)
#define fncall_other(args, call_args, pc_assign, currpc, newpcval, atom_index, fn_def_cell_addr_68K, return_label) {\
/* register struct fnhead *newdefcell; */ \
if ( (((DefCell *)fn_def_cell_addr_68K)->ccodep ) && \
( newdefcell = (struct fnhead *)Addr68k_from_LADDR( \
((DefCell *) fn_def_cell_addr_68K)->defpointer))->native) \
{ \
NATIVE_CURRENTFX->pc = newpcval; \
FuncObj = (struct fnhead *)newdefcell; \
IVAR = CSTKPTR - args; \
pc_assign; \
CALL_NATIVE(newdefcell, -call_args); \
}; \
RETURN_TO_FN_CALL(currpc, return_label); \
} /* end fncall */
#define envcall_native(retpcval, args, fncell, native_addr_slot, environment) {\
FuncObj = (struct fnhead *) fncell; \
native_closure_env = environment; \
NATIVE_CURRENTFX->pc = retpcval; \
IVAR = CSTKPTR - args; \
IF (args > 5) {(int) PC = -args; CALL_NATIVE(fncell, -6);} \
CALL_NATIVE(fncell, -args); \
} /* end envcall */
#define returnFX ((struct frameex2 *) DATUM68K)
#define return_op(pcval, swapped_func_obj, ret_result, slow_ret_result) \
{ \
/* *** op_return(pcval,swapped_func_obj); */ \
register DLword alink; \
alink = NATIVE_CURRENTFX->alink; \
if ( alink & 1 ) { slow_ret_result; BCE(pcval); } \
ret_result; /* NOTE: this smashes the BF word if fn called with 0 args */\
CSTKPTR = IVAR + 1; \
returnFX = (struct frameex2 *) \
((DLword *) \
(PVAR = (LispPTR *) Addr68k_from_StkOffset(alink)) \
- FRAMESIZE); \
IVAR = (LispPTR *) Addr68k_from_StkOffset(*((DLword *)returnFX -1)) ; \
IVar = (DLword *) IVAR; \
PVar = (DLword *) PVAR; \
if (returnFX->native) { \
if (returnFX->fnheader == swapped_func_obj) \
{(unsigned int) PC = (unsigned int) returnFX->pc; \
goto switchlabel; \
} \
else \
{register struct fnhead *newfncell; \
newfncell = FuncObj = (struct fnhead *) \
Addr68k_from_LADDR(0x0ffffff & swapx(returnFX->fnheader));\
CALL_NATIVE(newfncell, (unsigned int) returnFX->pc); \
} \
} \
else \
{register struct fnhead *LocFnObj; \
FuncObj = LocFnObj = (struct fnhead *) \
Addr68k_from_LADDR(0x0ffffff & swapx(returnFX->fnheader)); \
Irq_Stk_Check = STK_END_COMPUTE(EndSTKP,LocFnObj); \
if (((int)(CSTKPTR) > Irq_Stk_Check) || (Irq_Stk_End <= 0)) \
RETURN_TO_TIMER(returnFX->pc + (int) FuncObj); \
C_RETURN_TO_DISPATCH; \
} \
} /* return_op end */
/************************************************************************/
/* MACORS FOR OPCODES */
/************************************************************************/
#define MYARGCOUNT \
( ( ( \
( ((NATIVE_CURRENTFX->alink & 1) == 0) \
? (int) ((LispPTR *)NATIVE_CURRENTFX - 1) \
: (int) (Stackspace + NATIVE_CURRENTFX->blink) \
) \
- (int) IVAR) >> 2) )
#define N_OP_CHECKAPPLY(tos, abs_pc) { \
register DefCell *defcell; \
defcell = (DefCell *) GetDEFCELL68k(tos & 0xffff) ; \
if (!( defcell->ccodep && ((tos & 0xffff0000) == 0) && \
( ( defcell->argtype == 0 ) || ( defcell->argtype == 2 ) ) ) ) \
BCE(abs_pc); \
}
#define N_OP_TYPEMASK(n) \
( ( ( ((DLword)GetTypeEntry(TEMPREG = TOS)) & (DLword)n) == 0) \
? NIL_PTR \
: TEMPREG \
)
#define GETBASE_N(ptr, n)\
( *((DLword *)Addr68k_from_LADDR((0xFFFFFF & ptr) + n)))
#define GETBASEPTR_N(ptr, n)\
(0xFFFFFF & *((LispPTR *)Addr68k_from_LADDR((0xFFFFFF & ptr) + n)))
#define N_OP_PUTBASEPTR_N(tos_1, tos, n) \
*((LispPTR *)((DLword *)Addr68k_from_LADDR(0xffffff & tos_1) + n)) = tos;
#define N_OP_PUTBASE_N(tos_1, tos, n, error_label) \
{ \
if ( ((unsigned short)(swapx(TEMPREG = (LispPTR)tos))) != (S_POSITIVE >> 16)) \
goto error_label; \
*((DLword *)Addr68k_from_LADDR(0xffffff & tos_1) + n) = (DLword) TEMPREG; \
}
#define N_OP_GETBITS_N_FD(tos, offset, bit_mask, shift_amount) \
( \
(( ( *((DLword *)Addr68k_from_LADDR(0xFFFFFF & tos) + offset)) \
>> shift_amount ) \
& bit_mask ) \
)
#define N_OP_PUTBITS_N_FD(tos_1, tos, offset, bit_mask, shift_amount, error_label)\
{register LispPTR toscache, base; \
if ( ((unsigned short)(swapx(toscache = (LispPTR)tos))) != (S_POSITIVE >> 16)) \
goto error_label; \
(DLword *) DATUM68K = (DLword *)Addr68k_from_LADDR(base = 0xffffff & tos_1) + offset;\
*((DLword *)DATUM68K )= \
( (toscache << shift_amount) & \
(bit_mask << shift_amount)) | \
(*((DLword *)DATUM68K ) & (~(bit_mask << shift_amount)));\
}
#define N_OP_GETBASEBYTE(tos_1, tos, error_label) \
(( ((TEMPREG = (TOS_CACHE = tos) & 0xffff0000) == S_POSITIVE)\
? (*((char *) Addr68k_from_LADDR(0xffffff & tos_1) + (unsigned short) TOS_CACHE))\
:( (TEMPREG == S_NEGATIVE)\
? (*((char *) Addr68k_from_LADDR(0xffffff & tos_1) + (0xffff0000 | TOS_CACHE)))\
:( ( GetTypeNumber(TOS_CACHE) == TYPE_FIXP )\
? (*((char *) Addr68k_from_LADDR(0xffffff & tos_1) + \
*((int *)Addr68k_from_LADDR(TOS_CACHE))))\
: asmgoto(error_label)\
)\
)\
))
#define N_OP_PUTBASEBYTE(tos_2, tos_1, tos, error_label) \
{register LispPTR toscache, base; \
toscache = tos; \
TEMPREG = tos_1; \
base = 0xffffff & tos_2; \
if( ((0xFFFF0000 & toscache ) != S_POSITIVE) || \
((unsigned short)toscache >= 256)) \
goto error_label; \
switch( (0xFFFF0000 & TEMPREG) ){ \
case S_POSITIVE: \
TEMPREG &= 0x0000FFFF; \
break; \
case S_NEGATIVE: \
TEMPREG |= 0xFFFF0000; \
break; \
default: \
goto error_label; \
} \
*((char*)Addr68k_from_LADDR(0xFFFFFF & base) + TEMPREG) = \
0xFF & toscache; \
}
#define N_OP_CAR(tos, error_label) \
(Listp(TOS_CACHE = tos) \
? ( \
(((ConsCell *) \
(DATUM68K = (LispPTR *)(Addr68k_from_LADDR(TOS_CACHE))))\
->cdr_code == CDR_INDIRECT) \
? ((LispPTR) ( ((ConsCell *) \
Addr68k_from_LADDR( ((ConsCell *)DATUM68K)->car_field))->car_field))\
: ((LispPTR)(((ConsCell *)DATUM68K)->car_field)) \
) \
: ( (TOS_CACHE == NIL_PTR) \
? TOS_CACHE \
: \
( ( TOS_CACHE == ATOM_T) \
? TOS_CACHE \
: asmgoto(error_label) \
) \
) \
)
#define N_OP_CDR(tos, error_label) \
(Listp(TOS_CACHE = tos) \
? ( ((TEMPREG = (LispPTR) \
( ((ConsCell *) \
(DATUM68K = ((LispPTR *)(Addr68k_from_LADDR(TOS_CACHE)))))\
->cdr_code)) == CDR_NIL) \
? (LispPTR) NIL_PTR \
: (LispPTR) ( (TEMPREG > CDR_ONPAGE) \
? \
/* cdr-samepage */ \
(POINTER_PAGEBASE(TOS_CACHE) + \
((TEMPREG & 127) << 1)) \
: (LispPTR) ( (TEMPREG == CDR_INDIRECT) \
? ((LispPTR) cdr (((ConsCell *)DATUM68K)->car_field)) \
: (LispPTR) ((ConsCell *)(Addr68k_from_LADDR \
(POINTER_PAGEBASE(TOS_CACHE) + (TEMPREG << 1))))->car_field\
) \
) \
) \
: (LispPTR) ( (TOS_CACHE == NIL_PTR) ? NIL_PTR : asmgoto(error_label)) \
)
#define N_OP_CDDR(tos, error_label) \
(Listp(TOS_CACHE = tos) \
? ( ((TEMPREG = (LispPTR) \
( ((ConsCell *) \
(DATUM68K = ((LispPTR *)(Addr68k_from_LADDR(TOS_CACHE)))))\
->cdr_code)) == CDR_NIL) \
? (LispPTR) NIL_PTR \
: (LispPTR) ( (TEMPREG > CDR_ONPAGE) \
? \
/* cdr-samepage */ \
(SAME_PAGE_CDR) \
: (LispPTR) ( (TEMPREG == CDR_INDIRECT) \
? N_OP_CDR(cdr(((ConsCell *)DATUM68K)->car_field),error_label)\
: N_OP_CDR( \
((ConsCell *) \
(Addr68k_from_LADDR \
(POINTER_PAGEBASE(TOS_CACHE) + \
(TEMPREG << 1) \
) \
) \
)->car_field \
, error_label) \
) \
) \
) \
: (LispPTR) ( (TOS_CACHE == NIL_PTR) ? NIL_PTR : asmgoto(error_label)) \
)
#define SAME_PAGE_CDR \
/* take CDR of List Cell */ \
( ((TEMPREG = (LispPTR) \
( ((ConsCell *) \
(DATUM68K = (LispPTR *) \
(((int)DATUM68K & 0xfffffe00) | \
(((int) TEMPREG & 127) << 2)) \
)) \
->cdr_code)) == CDR_NIL) \
? (LispPTR) NIL_PTR \
: (LispPTR) ( (TEMPREG > CDR_ONPAGE) \
? /* cdr-samepage */ \
(POINTER_PAGEBASE(TOS_CACHE) + \
((TEMPREG & 127) << 1)) \
: (LispPTR) ( (TEMPREG == CDR_INDIRECT) \
? ((LispPTR) cdr (((ConsCell *)DATUM68K)->car_field)) \
: (LispPTR) ((ConsCell *)(Addr68k_from_LADDR \
(POINTER_PAGEBASE(TOS_CACHE) + (TEMPREG << 1))))->car_field\
) \
) \
)
#define N_OP_FVAR(slot, dl_slot) \
( GetLongWord(Addr68k_from_LADDR(swapx( \
( ( ((DLword *)PVAR)[dl_slot] & 1 ) \
? native_newframe(slot) \
: PVAR[slot] \
)))))
#define N_OP_UNBIND(tos) \
/* {register LispPTR SAVE_TOS = tos; CSTKPTR = (LispPTR *) N_OP_unbind(CSTKPTR); PUSH(SAVE_TOS);} */ \
nop_unbind(tos);
#define N_OP_DUNBIND \
/* { CSTKPTR = (LispPTR *) N_OP_dunbind(CSTKPTR); } THIS MAY NOT WORK */ \
nop_dunbind();
#define N_OP_CLARITHEQUAL(tos_1, tos, error_addr) \
( (((TEMPREG = tos) & 0xfffe0000) == (S_POSITIVE & 0xfffe0000)) \
? ((TEMPREG == tos_1) ? ATOM_T : NIL_PTR) \
: ((((int) DATUM68K = GetTypeNumber(TEMPREG)) == TYPE_FIXP)\
? ((TEMPREG == tos_1) ? ATOM_T : NIL_PTR) \
: (((int) DATUM68K == TYPE_FLOATP) \
? ((TEMPREG == tos_1) ? ATOM_T : NIL_PTR) \
: (N_OP_eqq(tos_1, TEMPREG, error_addr)) \
) \
) \
)
#define N_OP_CLEQUAL_ILEQL(tos_1, tos, error_addr, op_function) \
( (((TOS_CACHE = tos) & 0xfffe0000) <= (S_POSITIVE & 0xfffe0000)) \
? ((TOS_CACHE == tos_1) ? ATOM_T : NIL_PTR) \
:( (((TEMPREG = tos_1) & 0xfffe0000) <= \
(S_POSITIVE & 0xfffe0000)) \
? ((TOS_CACHE == TEMPREG) ? ATOM_T : NIL_PTR) \
: op_function(TEMPREG, TOS_CACHE, error_addr) \
) \
)
#define N_OP_EQUAL(tos_1, tos, error_addr) \
( (((TOS_CACHE = tos) & 0xffff0000) <= S_CHARACTER) \
? ((TOS_CACHE == tos_1) ? ATOM_T : NIL_PTR) \
:( (((TEMPREG = tos_1) & 0xffff0000) <= S_CHARACTER) \
? ((TOS_CACHE == TEMPREG) ? ATOM_T : NIL_PTR) \
: N_OP_equal(TEMPREG, TOS_CACHE, error_addr) \
) \
)
#define N_OP_DTEST(atom_index, exit_pc, opcode) \
{ /* must have stack up to date */ \
register struct dtd *dtd68k ; \
for(dtd68k=(struct dtd *) GetDTD(GetTypeNumber(TOS)); \
atom_index != dtd68k->dtd_name ; \
dtd68k=(struct dtd *) GetDTD(dtd68k->dtd_supertype)) \
{ \
if( dtd68k->dtd_supertype == 0) \
{ \
CALL_UFN(exit_pc, opcode); \
} \
} \
}
#ifdef sun3
/* these take advantage of the Shift Amount Register d5 */
#define NSMALLP_RANGE(x) nop_nsmallp_range(x)
#define SMALLP_UNBOX(x) nop_smallp_unbox(x)
#define SMALL_BOX(x) nop_smallp_box(x)
#else
#define NSMALLP_RANGE(x) (((int)((int)x << 15) >> 15) ^ x)
#define SMALLP_UNBOX(x) ( (int) (x << 15) >> 15)
#define SMALL_BOX(x) (((unsigned int)(x << 15) >> 15) | S_POSITIVE)
#endif
#define NSMALLP(x) (((x) >> 17) ^ 7)
#define MAKE_BOX(type, value) Create_n_Set_Cell(type, value)
#define GET_BOX(type, laddr) (* ((type *) (Addr68k_from_LADDR(laddr))))
#define FIXP_UNBOX(value) \
( NSMALLP((TEMPREG = value)) \
? GET_BOX(int, TEMPREG) \
: SMALLP_UNBOX(TEMPREG) \
)
#define FIXP_UNBOX_UFN(value, errorlabel) \
( NSMALLP((TEMPREG = value)) \
?( (GetTypeNumber(TEMPREG) == TYPE_FIXP) \
?GET_BOX(int, TEMPREG) \
:asmgoto(errorlabel) \
) \
: SMALLP_UNBOX(TEMPREG) \
)
#define FLOATP_UNBOX(value) \
GET_BOX(floatvalue)
#define FIXP_BOX(x) \
( NSMALLP_RANGE((TEMPREG = x)) \
? MAKE_BOX(TYPE_FIXP, TEMPREG) \
: SMALL_BOX(TEMPREG) \
)
#define FLOATP_BOX(x) Create_n_Set_Cell(TYPE_FLOATP, x)
/************************************************************************/
/* EXTERNAL ENTRY POINTS */
/************************************************************************/
extern DLword *Atomspace; /* ATOMSPACE */
extern DLword *Stackspace; /* STACKSPACE*/
extern DLword *Defspace; /* DEFSPACE */
extern DLword *Valspace; /* VALSPACE */
extern DLword *Lisp_world; /* Lisp Start BASE */
extern DLword *MDStypetbl;
extern DLword *DTDspace; /* DTDSPACE */
extern DLword *CurrentStackPTR; /* rhS,S */
extern LispPTR TopOfStack ; /* TOSH(high 16),TOS (lo 16) */
extern LispPTR Scratch_CSTK ;
extern ByteCode *PC; /* Pointer to executing Byte Code */
extern struct state MachineState;
extern struct fnhead *FuncObj; /* Pointer to current ccode obj */
extern int EndSTKP; /* End of Current Frame */
extern int *c_ret_to_dispatch;
extern int *ret_to_dispatch;
extern int *ret_to_unimpl;
extern int *ret_to_timer;
extern int *ret_to_fn0;
extern int *ret_to_fn1;
extern int *ret_to_fn2;
extern int *ret_to_fn3;
extern int *ret_to_fn4;
extern int *ret_to_fnx;
extern int *ret_to_apply;
extern int *ret_to_envcall;
extern int *ret_to_ufn;
extern int Irq_Stk_End;
extern int Irq_Stk_Check;
extern LispPTR native_closure_env;
#endif /* NATIVE_H */

13
inc/stack.h
View File

@@ -26,7 +26,6 @@
#define BF_MARK 0x8000u
#define BF_MARK32 0x80000000
#define FX_MARK 0xc000u
#define FX_MARK_NATIVE 0xc800u
#define STK_GUARD 7
#define STK_FX 6
@@ -60,7 +59,7 @@ typedef struct fnhead{
short pv; /* ?? */
DLword startpc;
/* head of ByteCodes, DLword offset from stkmin */
unsigned native : 1; /* native translated? */
unsigned nil4 : 1; /* not used, prev: native translated? */
unsigned byteswapped : 1; /* code was reswapped. */
unsigned argtype : 2; /* ?? */
#ifdef BIGVM
@@ -81,7 +80,7 @@ typedef struct fnhead{
typedef struct frameex1{
unsigned flags :3;
unsigned fast :1;
unsigned native :1; /* This frame treats N-func */
unsigned nil2 :1; /* not used, prev: This frame treats N-func */
unsigned incall :1;
unsigned validnametable :1;
/* 0: look for FunctionHeader
@@ -112,7 +111,7 @@ typedef struct frameex1{
typedef struct frameex2{
unsigned flags :3;
unsigned fast :1;
unsigned native :1; /* This frame treats N-func */
unsigned nil2 :1; /* not used, prev: This frame treats N-func */
unsigned incall :1;
unsigned validnametable :1;
/* 0: look for FunctionHeader
@@ -195,7 +194,7 @@ typedef struct fnhead
#endif /* BIGVM */
unsigned argtype : 2; /* ?? */
unsigned byteswapped : 1; /* code was reswapped. */
unsigned native : 1; /* native translated? */
unsigned nil4 : 1; /* not used, prev: native translated? */
unsigned fvaroffset : 8;
/* DLword offset from head of NameTable */
unsigned nlocals :8; /* ?? */
@@ -212,7 +211,7 @@ typedef struct frameex1{
/* 0: look for FunctionHeader
1: look for NameTable on this FrameEx */
unsigned incall :1;
unsigned native :1; /* This frame treats N-func */
unsigned nil2 :1; /* not used, prev: This frame treats N-func */
unsigned fast :1;
unsigned flags :3; /* hi word */
@@ -247,7 +246,7 @@ typedef struct frameex2{
/* 0: look for FunctionHeader
1: look for NameTable on this FrameEx */
unsigned incall :1;
unsigned native :1; /* This frame treats N-func */
unsigned nil2 :1; /* not used, prev: This frame treats N-func */
unsigned fast :1;
unsigned flags :3;

4
inc/subrs.h
View File

@@ -73,7 +73,7 @@
#define sb_DORECLAIM 0134
#define sb_DUMMY_135Q 0135
#define sb_NATIVE_MEMORY_REFERENCE 0136
#define sb_OLD_COMPILE_LOAD_NATIVE 0137
#define sb_OLD_COMPILE_LOAD_NATIVE 0137 /* obsolete */
#define sb_DISABLEGC 0140
#define sb_COM_SETFILEINFO 0147
@@ -96,7 +96,7 @@
#define sb_MONITOR_CONTROL 0200
#define sb_GET_NATIVE_ADDR_FROM_LISP_PTR 0203
#define sb_GET_LISP_PTR_FROM_NATIVE_ADDR 0204
#define sb_LOAD_NATIVE_FILE 0205
#define sb_LOAD_NATIVE_FILE 0205 /* obsolete */
#define sb_SUSPEND_LISP 0206
#define sb_NEW_BLTCHAR 0207
#define sb_COLOR_INIT 0210

45
inc/tos1defs.h
View File

@@ -79,49 +79,4 @@
#define NRET { RET; nextop0; }
#define RET_FROM_NATIVE \
{ \
POP; \
PCMACL += 1; \
table = optable; \
}
#ifdef NATIVETRAN
#define NATIVE_NEXTOP0 { \
if (BCE_CURRENTFX->native) { RET_TO_NATIVE; } \
nextop0; \
}
#else
#define NATIVE_NEXTOP0 nextop0
#endif
#define CALL_NATIVE(defcell, num_args) \
{ \
setivar_pvar_jmp(CSTKPTR + num_args, PVAR, \
((int *)(GET_NATIVE_ADDR(defcell)))[num_args+(6+2)]); \
}
#define CALL_NATIVE2(defcell, num_args) \
{ \
setivar_pvar_jmp(CSTKPTR + num_args, PVAR, \
((int *)(GET_NATIVE_ADDR(defcell))) \
[(num_args <= -6) ? ((6+2)-6) : (num_args+(6+2))]); \
}
#define RET_TO_NATIVE { \
register int native_addr; \
register struct fnhead *LocFuncObj = FuncObj; \
if (native_addr = \
((int *)(GET_NATIVE_ADDR(LocFuncObj))) \
[((UNSIGNED) PCMAC - (UNSIGNED) LocFuncObj)+(6+2)]) \
{ \
HARD_PUSH(TOPOFSTACK); \
setivar_pvar_jmp(IVAR, PVAR, native_addr); \
}; \
nextop0; \
}
#endif /* TOS1DEFS_H */

89
inc/tosfns.h
View File

@@ -47,43 +47,12 @@
#ifdef NATIVETRAN
#define FN_CALL_NATIVE_CHECK(fncell, args, extra_code) \
{ \
if (fncell->native) \
{ \
extra_code; \
FuncObj = fncell; \
HARD_PUSH(TOPOFSTACK); \
CALL_NATIVE(fncell, args); \
} \
}
#define FN_CALL_NATIVE_CHECK2(fncell, args, extra_code) \
{ \
if (fncell->native) \
{ \
extra_code; \
(UNSIGNED) PC = args; \
FuncObj = fncell; \
HARD_PUSH(TOPOFSTACK); \
CALL_NATIVE2(fncell, args); \
} \
}
#define ASM_LABEL_OF_FN_COMMON asm_label_op_fn_common()
#else
#ifdef GCC386
#define ASM_LABEL_OF_FN_COMMON asm("fn_common:");
#else
#define ASM_LABEL_OF_FN_COMMON
#endif /* GCC386 */
#define FN_CALL_NATIVE_CHECK(fncell, args, extra_code)
#define FN_CALL_NATIVE_CHECK2(fncell, args, extra_code)
#endif /* NATIVETRAN */
/************************************************************************/
@@ -229,57 +198,6 @@
#if (defined(SUN3_OS3_OR_OS4_IL) && !(defined(NOASMFNCALL)) )
#ifdef NATIVETRAN
#define OPFN(x, num_args_fn, fn_xna_args, fn_native) \
{ /* asm inlines for fn call (much care put into keeping optimizer \
from moving things around). */ \
fn_section1(); \
fn_section2(); \
num_args_fn(); \
fn_native_test(); \
fn_section3(); \
fn_xna_args(); \
fn_section4(); \
fast1_dispatcher(); /* nextop0 don't work here */ \
fn_native(); \
fn_section5(); \
/* asm code jumps here when not ccodep */ \
{ fn_atom_index = Get_AtomNo_PCMAC1; \
fn_defcell = (DefCell *) GetDEFCELL68k(fn_atom_index); \
fn_num_args = x; \
fn_opcode_size = FN_OPCODE_SIZE; \
fn_apply = 0; \
goto op_fn_common; \
} \
}
#define OPFNX \
{ /* asm inlines for fn call (much care put into keeping optimizer \
from moving things around. */ \
fnx_section1(); \
fn_section2(); \
fnx_args(); \
fn_native_test(); \
fn_section3(); \
fnx_xna(); \
fn_section4(); \
fast1_dispatcher(); /* nextop0 don't work here */ \
fnx_native(); \
fn_section5(); \
fn_atom_index = Get_AtomNo_PCMAC2; \
fn_defcell = (DefCell *) GetDEFCELL68k(fn_atom_index); \
fn_num_args = Get_BYTE_PCMAC1; \
fn_opcode_size = FNX_OPCODE_SIZE; \
fn_apply = 0; \
goto op_fn_common; \
/* *** these carefully arranged to satisfy optimizer */ \
label1: fast1_dispatcher(); \
label2: to_native_label(); \
\
}
#else
#define OPFN(x, num_args_fn, fn_xna_args, fn_native) \
{ /* asm inlines for fn call (much care put into keeping optimizer \
from moving things around). */ \
@@ -323,9 +241,6 @@ label1: fast1_dispatcher(); \
\
}
#endif /* NATIVETRAN */
#else
#define OPFN(argcount, num_args_fn, fn_xna_args, fn_native) \
@@ -347,7 +262,6 @@ label1: fast1_dispatcher(); \
} \
LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR((defcell_word &= POINTERMASK));\
BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + FN_OPCODE_SIZE;\
FN_CALL_NATIVE_CHECK(LOCFNCELL,-argcount,{}); \
FN_STACK_CHECK; \
{register UNSIGNED newivar; \
newivar = (UNSIGNED) (IVARL = (DLword *)(CSTKPTR-argcount+1)); \
@@ -415,7 +329,6 @@ label1: fast1_dispatcher(); \
} \
LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR(defcell->defpointer); \
BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + FNX_OPCODE_SIZE;\
FN_CALL_NATIVE_CHECK2(LOCFNCELL, - num_args, {}); \
FN_STACK_CHECK; \
{register UNSIGNED newivar; \
newivar = (UNSIGNED)(IVARL = (DLword *)(CSTKPTR-num_args+1)); \
@@ -551,7 +464,6 @@ op_fn_common: \
- (UNSIGNED)FuncObj) + fn_opcode_size; \
FNTPRINT(("Saving PC = 0%o (0x%x).\n", \
BCE_CURRENTFX->pc, PCMAC+fn_opcode_size)); \
FN_CALL_NATIVE_CHECK2(LOCFNCELL, -fn_num_args, N_APPLY_POP_PUSH_TEST) \
FN_STACK_CHECK; \
APPLY_POP_PUSH_TEST; \
{register UNSIGNED newivar; \
@@ -622,7 +534,6 @@ op_fn_common: \
FNCHECKER(if (quick_stack_check()) printf("In ENVCALL.\n")); \
N_GETNUMBER(GET_TOS_2, num_args, op_ufn); \
BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + 1;\
FN_CALL_NATIVE_CHECK2(LOCFNCELL, -num_args, N_ENVCALL_POP_TEST); \
FN_STACK_CHECK; \
CSTKPTRL -= 2; \
{register UNSIGNED newivar; \

18
inc/tosret.h
View File

@@ -27,15 +27,6 @@
/* */
/************************************************************************/
#ifdef NATIVETRAN
#define RETD6 SaveD6 = 0x100
#define RET_CHECK_NATIVE(x) if(x ->native) { RET_TO_NATIVE; }
#else
#define RETD6
#define RET_CHECK_NATIVE(x)
#endif
#if ((defined(ISC) || defined(SUN3_OS3_OR_OS4_IL)) && !(defined(NOASMFNCALL)) )
/* JDS 22 May 96 CSTKPTR >- Irq... was just >, but got overflows with last
@@ -45,9 +36,8 @@
EXT; if(slowreturn()) goto stackoverflow_help; RET; \
Irq_Stk_Check = STK_END_COMPUTE(EndSTKP,FuncObj); \
if (((UNSIGNED)(CSTKPTR) >= Irq_Stk_Check) || (Irq_Stk_End <= 0)) \
{ RETD6; goto check_interrupt; } \
{ goto check_interrupt; } \
Irq_Stk_End = (UNSIGNED) EndSTKP; \
RET_CHECK_NATIVE(BCE_CURRENTFX); \
}
#else
@@ -62,9 +52,8 @@
if (alink & 1) { EXT; if(slowreturn()) goto stackoverflow_help; RET; \
Irq_Stk_Check = STK_END_COMPUTE(EndSTKP,FuncObj); \
if (((UNSIGNED)(CSTKPTR) >= Irq_Stk_Check) || (Irq_Stk_End <= 0)) \
{ RETD6; goto check_interrupt; } \
{ goto check_interrupt; } \
Irq_Stk_End = (UNSIGNED) EndSTKP; \
RET_CHECK_NATIVE(BCE_CURRENTFX); \
goto retxit; \
}; \
CSTKPTRL = (LispPTR *) IVAR; \
@@ -81,9 +70,8 @@
Irq_Stk_Check = STK_END_COMPUTE(EndSTKP,FuncObj); \
FNCHECKER(if (quick_stack_check()) printf("In RETURN.\n")); \
if (((UNSIGNED)(CSTKPTR) >= Irq_Stk_Check) || (Irq_Stk_End <= 0)) \
{ RETD6; goto check_interrupt; } \
{ goto check_interrupt; } \
Irq_Stk_End = (UNSIGNED) EndSTKP; \
RET_CHECK_NATIVE(returnFX); \
retxit: {} \
} /* OPRETURN end */

1
inc/version.h
View File

@@ -186,7 +186,6 @@ error Must specify RELEASE to build Medley.
#undef SUN3_OS4_IL
#undef SUN4_OS4_IL
#undef OPDISP
#undef NATIVETRAN
#undef PROFILE
#define NOASMFNCALL 1
#endif

21
src/dspSPARC.il
View File

@@ -131,27 +131,6 @@ done: ! else done;
nop
.end
/*
***************************************************************
Special Native Code Jump Routine.
***************************************************************
*/
.inline _asmgoto,4
jmp %o0
nop
.end
/* THIS IS WRONG! asmcall(label) is supposed to do a direct call there... this is just a jump. Used by emulator<->native interface */
.inline _asmcall,4
jmp %o0
nop
.end
/*
***************************************************************
Arithmetic Opcode Helpers

210
src/loader.c
View File

@@ -1,210 +0,0 @@
/* $Id: loader.c,v 1.2 1999/01/03 02:07:16 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 "sys/exec.h" /* choose one you like */
#include <stdio.h>
#include "lispemul.h"
#include "adr68k.h"
#include "lsptypes.h"
#include "lispmap.h"
#include "lspglob.h"
#include "arith.h"
char *sbrk();
unsigned getpagesize(), getpid();
char *malloc();
#define roundup(a, b) ((((unsigned)(a) + (b)-1) / (b)) * (b))
/* A macro to convert a Lisp String to a C string */
#define LispStringToCString(Lisp, C) \
{ \
LispPTR *naddress; \
char *base; \
int length; \
int offset; \
naddress = (LispPTR *)(Addr68k_from_LADDR(Lisp)); \
base = (char *)(Addr68k_from_LADDR(((OneDArray *)naddress)->base)); \
offset = (int)(((OneDArray *)naddress)->offset); \
length = ((OneDArray *)naddress)->totalsize; \
strncpy(C, base + offset, length); \
C[length] = '\0'; \
}
int dynamic_load_code(LispPTR *args)
/* args[0]: LispPTR to file name.
args[1]: native addr of where to load the code
returns: List(load_addr, entry_point, length)
*/
{
char file_name[512];
int load_address;
int entry_point;
LispStringToCString(args[0], file_name);
N_GETNUMBER(args[1], load_address, return_error);
return (load_native_object(load_address, file_name));
return_error:
printf("error in dynamic load: 0x%x\n", args[1]);
return (NIL_PTR);
}
load_native_object(unsigned load_address, char *dynamic_file)
{
int load_length, entry_point;
typedef char *charstrptr;
typedef charstrptr charstrlist[2];
charstrlist p;
int fd, asize, i;
struct exec hdr;
fd = open(dynamic_file, 0);
if (fd == -1) return (0);
if (read(fd, &hdr, sizeof hdr) == -1) return (0);
load_length = hdr.a_text + hdr.a_data;
#ifdef DEBUG
printf("Load Size: %x, Header Rec Size %x\n", load_length, sizeof hdr);
printf("Data Size: %x, Text Size %x\n", hdr.a_data, hdr.a_text);
#endif
if (read(fd, load_address, load_length) == -1) return (0);
entry_point = (int)((CFuncPTR)asmcall(load_address));
{
register int r0, r1, r2;
ARITH_SWITCH((int)load_address, r0);
ARITH_SWITCH((int)entry_point, r1);
ARITH_SWITCH(load_length, r2);
return (N_OP_cons(r0, N_OP_cons(r1, N_OP_cons(r2, NIL_PTR))));
}
}
/* **** system call subr, living in sb_OLD_COMPILE_LOAD_NATIVE slot *** */
int do_system_call(LispPTR arg)
{
char cmd_str[512];
register int result;
register int lisp_result;
LispStringToCString(arg, cmd_str);
#ifdef DEBUG
printf(":: %s \n", cmd_str);
#endif
int_block();
result = system(cmd_str);
int_unblock();
ARITH_SWITCH(result, lisp_result);
return (lisp_result);
}
/* ****** stuff below is old & should be removed when the subr is *** */
int dynamic_load(char *host_file, char *dynamic_file, unsigned load_address, unsigned needs_compile, unsigned needs_link,
unsigned do_load)
{
int result = 0;
char fnamec[80], fnameo[80], fnameil[80], cc_str[255], ld_str[255];
unsigned pagsiz = getpagesize();
host_file = "lisp"; /* TEMPORARY ********** */
printf("loading: %s into %s \n", dynamic_file, host_file);
if (load_address == 0) load_address = roundup(sbrk(0), pagsiz);
sprintf(fnamec, "%s.c", dynamic_file);
sprintf(fnameo, "%s.o", dynamic_file);
sprintf(fnameil, "%s.il", dynamic_file);
sprintf(cc_str,
"/bin/cc -pipe -c %s -o %s %s -O -I/users/krivacic/maiko/inc "
"/users/krivacic/maiko/src/disp68K.il",
fnamec, fnameo, fnameil);
sprintf(ld_str, "/bin/ld -N -s -Ttext %x -A /users/krivacic/maiko/bin/%s -o %s %s -lc",
load_address, host_file, dynamic_file, fnameo);
if (needs_compile) {
result = exec_command(cc_str);
if (result) return (0);
}
if (needs_link) {
result = exec_command(ld_str);
if (result) return (0);
}
if (do_load) {
char rm_str[200];
result = load_object(load_address, dynamic_file);
sprintf(rm_str, "/bin/rm %s %s %s %s", fnamec, fnameil, fnameo, dynamic_file);
/* *** exec_command(rm_str); *** */
}
TopOfStack = result;
return (result);
} /*dynamic_load */
int exec_command(char *cmd_str)
{
typedef char *charstrptr;
typedef charstrptr charstrlist[21];
charstrlist p;
char ws[21][80];
int i, ii, cmd_length;
int_block();
i = system(cmd_str);
int_unblock();
return (i);
} /*exec_command */
int load_object(unsigned load_address, char *dynamic_file)
{
int load_length, entry_point;
typedef char *charstrptr;
typedef charstrptr charstrlist[2];
charstrlist p;
int fd, asize, i;
struct exec hdr;
char *addr2;
unsigned pagsiz = getpagesize();
fd = open(dynamic_file, 0);
if (fd == -1) return (0);
if (read(fd, &hdr, sizeof hdr) == -1) return (0);
asize = roundup(hdr.a_text + hdr.a_data + hdr.a_bss, pagsiz) + pagsiz;
#ifdef DEBUG
printf("Load Size: %x, Header Rec Size %x\n", asize, sizeof hdr);
printf("Data Size: %x, Text Size %x\n", hdr.a_data, hdr.a_text);
#endif
addr2 = sbrk(asize);
addr2 = (char *)roundup(addr2, pagsiz);
if (load_address != (unsigned)addr2) { return (NIL_PTR); }
load_length = hdr.a_text + hdr.a_data;
read(fd, addr2, load_length);
entry_point = (int)((CFuncPTR)asmcall(addr2));
{
register int r0, r1, r2;
#ifdef DEBUG
printf("Values 0x%x & 0x%x\n", entry_point, load_length);
#endif
ARITH_SWITCH((int)addr2, r0);
ARITH_SWITCH((int)entry_point, r1);
ARITH_SWITCH(load_length, r2);
#ifdef DEBUG
printf("Returning 0x%x & 0x%x\n", r1, r2);
#endif
return (N_OP_cons(r0, N_OP_cons(r1, N_OP_cons(r2))));
}
}

38
src/subr.c
View File

@@ -77,10 +77,6 @@ extern LispPTR *PENDINGINTERRUPT68k;
*/
/***********************************************************/
#ifdef NATIVETRAN
extern int *c_ret_to_dispatch;
extern int *ret_to_dispatch;
#endif
extern LispPTR Uraid_mess;
LispPTR subr_lisperror(); /* 0377 */
@@ -429,19 +425,8 @@ void OP_subrcall(int subr_no, int argnum) {
break;
}
#ifdef NATIVETRAN
case 02: /* get an emulator address */
{
register UNSIGNED iarg;
if (argnum != 2) goto ret_nil;
switch (args[1] & 0xffff) {
case 00: iarg = (UNSIGNED)&c_ret_to_dispatch; break;
case 01: iarg = (UNSIGNED)&ret_to_dispatch; break;
}
ARITH_SWITCH(iarg, TopOfStack);
break;
}
#endif
/* case 02: Used to be get an emulator address for
* defunct NATIVETRAN feature. */
}
break;
@@ -449,15 +434,6 @@ void OP_subrcall(int subr_no, int argnum) {
TopOfStack = NIL_PTR;
break;
#ifdef NATIVETRAN
/* old load native (should be superseded) */
case sb_OLD_COMPILE_LOAD_NATIVE:
POP_SUBR_ARGS;
{
TopOfStack = do_system_call(args[0]);
break;
};
#endif
case sb_DISABLEGC:
POP_SUBR_ARGS;
disablegc1(NIL);
@@ -482,16 +458,6 @@ void OP_subrcall(int subr_no, int argnum) {
break;
};
#ifdef NATIVETRAN
case sb_LOAD_NATIVE_FILE:
POP_SUBR_ARGS;
/* to become OBSOLETE */
{
TopOfStack = dynamic_load_code(args);
break;
}
#endif
case sb_DSK_GETFILENAME:
POP_SUBR_ARGS;
TopOfStack = DSK_getfilename(args);

1
src/testtool.c
View File

@@ -1196,7 +1196,6 @@ void all_stack_dump(DLword start, DLword end, DLword silent)
print(get_framename((struct frameex1 *)stkptr));
printf(" [");
if (((FX *)stkptr)->fast) printf("fast,");
if (((FX *)stkptr)->native) printf("native,");
if (((FX *)stkptr)->incall) printf("incall,");
if (((FX *)stkptr)->validnametable) printf("V,");
if (((FX *)stkptr)->nopush) printf("nopush,");

138
src/xc.c
View File

@@ -211,16 +211,6 @@ void dispatch(void) {
register struct state *stateptrcache = MState;
#undef MState
#define MState stateptrcache
#endif
#if (defined(I386) || defined(ISC))
int SaveD6;
#else
#ifdef OPDISP
#ifndef DOS
register int SaveD6;
#endif
#endif
#endif
/* OP_FN_COMMON arguments */
@@ -264,7 +254,6 @@ void dispatch(void) {
asm volatile("fldcw WORD PTR CODE32:FP_noint"); /* Turn off FP interrupts */
goto nextopcode;
#else
SaveD6 = 0;
goto setup_table;
#endif /* ISC */
@@ -345,66 +334,24 @@ nextopcode:
case 007:
CASE007:
UNWIND(Get_BYTE_PCMAC1, Get_BYTE_PCMAC2);
#ifdef NATIVETRAN
ret_to_fn0:
asm("_ret_to_fn0:");
asm(" .globl _ret_to_fn0");
RET_FROM_NATIVE;
#endif
case 010:
CASE010:
FN0;
#ifdef NATIVETRAN
ret_to_fn1:
asm("_ret_to_fn1:");
asm(" .globl _ret_to_fn1");
RET_FROM_NATIVE;
#endif
case 011:
CASE011:
FN1;
#ifdef NATIVETRAN
ret_to_fn2:
asm("_ret_to_fn2:");
asm(" .globl _ret_to_fn2");
RET_FROM_NATIVE;
#endif
case 012:
CASE012:
FN2;
#ifdef NATIVETRAN
ret_to_fn3:
asm("_ret_to_fn3:");
asm(" .globl _ret_to_fn3");
RET_FROM_NATIVE;
#endif
case 013:
CASE013:
FN3;
#ifdef NATIVETRAN
ret_to_fn4:
asm("_ret_to_fn4:");
asm(" .globl _ret_to_fn4");
RET_FROM_NATIVE;
#endif
case 014:
CASE014:
FN4;
#ifdef NATIVETRAN
ret_to_fnx:
asm("_ret_to_fnx:");
asm(" .globl _ret_to_fnx");
RET_FROM_NATIVE;
#endif
case 015:
CASE015:
FNX;
#ifdef NATIVETRAN
ret_to_apply:
asm("_ret_to_apply:");
asm(" .globl _ret_to_apply");
RET_FROM_NATIVE;
#endif
case 016:
CASE016:
APPLY;
@@ -494,12 +441,6 @@ nextopcode:
case 054:
CASE054:
EVAL;
#ifdef NATIVETRAN
ret_to_envcall:
asm("_ret_to_envcall:");
asm(" .globl _ret_to_envcall");
RET_FROM_NATIVE;
#endif
case 055:
CASE055:
ENVCALL;
@@ -752,7 +693,7 @@ nextopcode:
EXT;
OP_subrcall(Get_BYTE_PCMAC1, Get_BYTE_PCMAC2);
RET;
NATIVE_NEXTOP0;
nextop0;
};
case 0176:
CASE176 : { CONTEXTSWITCH; }
@@ -1027,7 +968,9 @@ nextopcode:
case 0327:
CASE327:
QUOTIENT /* QUOTIENT */
case 0330 : CASE330 : IPLUS2; /* IPLUS2 only while PLUS has no float */
case 0330:
CASE330:
IPLUS2; /* IPLUS2 only while PLUS has no float */
case 0331:
CASE331:
IDIFFERENCE; /* IDIFFERENCE only while no float */
@@ -1183,83 +1126,14 @@ nextopcode:
} /* switch */
#ifdef NATIVETRAN
/************************************************************************/
/* NATIVE CODE INTERFACE */
/************************************************************************/
/* FORIEGN -> DISPATCH */
/* Return to current frame ext */
c_ret_to_dispatch:
asm(" .globl _c_ret_to_dispatch");
asm("_c_ret_to_dispatch:");
PCMACL = (ByteCode *)FuncObj + BCE_CURRENTFX->pc;
goto ret_to_dispatch; /* assume optimizer will remove */
/* NATIVE -> DISPATCH */
/* Return to current frame ext */
ret_to_dispatch:
asm(" .globl _ret_to_dispatch");
asm("_ret_to_dispatch:");
RET_FROM_NATIVE;
nextop0;
/* NATIVE -> DISPATCH */
/* Execute opcode in current frame ext */
ret_to_unimpl:
asm(" .globl _ret_to_unimpl");
asm("_ret_to_unimpl:");
SaveD6 = 0x100;
/* HACK. Reg. d6 is set to dispatch to native_check */
/* so need to do switch instead of dispatch! */
RET_FROM_NATIVE;
goto nextopcode;
/* NATIVE -> UFN(PC) */
ret_to_ufn:
asm(" .globl _ret_to_ufn");
asm("_ret_to_ufn:");
RET_FROM_NATIVE;
goto op_ufn;
/* DISPATCH -> NATIVE? */
/* Return to current frame ext? */
native_check:
SaveD6 = 0;
NATIVE_NEXTOP0;
/* NATIVE -> TIMER */
/* Return to Execute timer interrupt */
ret_to_timer:
asm("_ret_to_timer:");
asm(" .globl _ret_to_timer");
SaveD6 = 0x100;
RET_FROM_NATIVE;
goto check_interrupt; /* assume optimizer will remove */
#else
native_check:
#ifndef DOS
#ifdef OPDISP
SaveD6 = 0x000;
#endif
#endif /* DOS */
goto nextopcode;
#endif
/************************************************************************/
/* TIMER INTERRUPT CHECK ROUTINE */
/************************************************************************/
check_interrupt:
#if (defined(NATIVETRAN) || defined(SUN3_OS3_OR_OS4_IL) || defined(I386) || defined(ISC))
#if (defined(SUN3_OS3_OR_OS4_IL) || defined(I386) || defined(ISC))
asm_label_check_interrupt();
#endif
@@ -1456,8 +1330,6 @@ PopNextop2:
#ifdef OPDISP
setup_table:
#ifndef ISC
SaveD6 = 0;
{
int i;
for (i = 0; i < 256; i++) { table[i] = (InstPtr)op_ufn; };