1
0
mirror of https://github.com/Interlisp/maiko.git synced 2026-03-17 23:32:51 +00:00

Compare commits

...

3 Commits

Author SHA1 Message Date
Larry Masinter
d625665cde WIP still, trying for a fix 2021-05-24 12:26:31 -07:00
Larry Masinter
c0850ddb52 WIP still; now it looks like inlineC.h but it still fails 2021-05-15 16:10:06 -07:00
Larry Masinter
68d4a61bf1 WIP: make variable types in simulate_unbind match OP_unbind 2021-05-15 12:21:06 -07:00
4 changed files with 35 additions and 27 deletions

View File

@@ -17,7 +17,7 @@ XFILES = $(OBJECTDIR)xmkicon.o \
XFLAGS = -DXWINDOW XFLAGS = -DXWINDOW
# OPTFLAGS is normally -O2. # OPTFLAGS is normally -O2.
OPTFLAGS = -O2 -g3 OPTFLAGS = -O0 -g3
DFLAGS = $(XFLAGS) -DRELEASE=351 DFLAGS = $(XFLAGS) -DRELEASE=351
LDFLAGS = -L/usr/X11/lib -lX11 -lc -lm LDFLAGS = -L/usr/X11/lib -lX11 -lc -lm

View File

@@ -78,7 +78,7 @@ typedef struct fnhead {
typedef struct frameex1 { typedef struct frameex1 {
unsigned flags : 3; unsigned flags : 3;
unsigned fast : 1; unsigned fast : 1;
unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ unsigned mvscase : 1; /* was not used, prev: This frame treats N-func */
unsigned incall : 1; unsigned incall : 1;
unsigned validnametable : 1; unsigned validnametable : 1;
/* 0: look for FunctionHeader /* 0: look for FunctionHeader
@@ -109,7 +109,7 @@ typedef struct frameex1 {
typedef struct frameex2 { typedef struct frameex2 {
unsigned flags : 3; unsigned flags : 3;
unsigned fast : 1; unsigned fast : 1;
unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ unsigned mvscase : 1; /* not used, prev: This frame treats N-func */
unsigned incall : 1; unsigned incall : 1;
unsigned validnametable : 1; unsigned validnametable : 1;
/* 0: look for FunctionHeader /* 0: look for FunctionHeader
@@ -200,7 +200,7 @@ typedef struct frameex1 {
/* 0: look for FunctionHeader /* 0: look for FunctionHeader
1: look for NameTable on this FrameEx */ 1: look for NameTable on this FrameEx */
unsigned incall : 1; unsigned incall : 1;
unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ unsigned mvscase : 1; /* not used, prev: This frame treats N-func */
unsigned fast : 1; unsigned fast : 1;
unsigned flags : 3; /* hi word */ unsigned flags : 3; /* hi word */
@@ -235,7 +235,7 @@ typedef struct frameex2 {
/* 0: look for FunctionHeader /* 0: look for FunctionHeader
1: look for NameTable on this FrameEx */ 1: look for NameTable on this FrameEx */
unsigned incall : 1; unsigned incall : 1;
unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ unsigned mvscase : 1; /* not used, prev: This frame treats N-func */
unsigned fast : 1; unsigned fast : 1;
unsigned flags : 3; unsigned flags : 3;

View File

@@ -211,8 +211,13 @@ retry: /* this is retry entry after MAKE_FXCOPY etc */
} else { } else {
if (CURRENTFX->nopush) { if (CURRENTFX->nopush) {
CURRENTFX->nopush = NIL; CURRENTFX->nopush = NIL;
CurrentStackPTR = next68k - 2; if (CURRENTFX->mvscase) {
TopOfStack = *((LispPTR *)CurrentStackPTR); CurrentStackPTR = next68k;
CURRENTFX->mvscase = NIL;
} else {
CurrentStackPTR = next68k - 2;
TopOfStack = *((LispPTR *)CurrentStackPTR);
}
CurrentStackPTR -= 2; CurrentStackPTR -= 2;
} else } else

View File

@@ -69,6 +69,8 @@ newframe:
fnhead = (struct fnhead *)FuncObj; fnhead = (struct fnhead *)FuncObj;
pc = (ByteCode *)PC + 3; /* to skip the miscn opcode we're in now */ pc = (ByteCode *)PC + 3; /* to skip the miscn opcode we're in now */
} else { } else {
unbind_count = 0; /* different frame */
fnhead = (struct fnhead *)Addr68k_from_LADDR(POINTERMASK & SWA_FNHEAD((int)caller->fnheader)); fnhead = (struct fnhead *)Addr68k_from_LADDR(POINTERMASK & SWA_FNHEAD((int)caller->fnheader));
pc = (ByteCode *)fnhead + (caller->pc); pc = (ByteCode *)fnhead + (caller->pc);
} }
@@ -98,9 +100,14 @@ newpc:
/* BUT 3's not enough for big atoms, so add diff between FN op size & MISCN op size */ /* BUT 3's not enough for big atoms, so add diff between FN op size & MISCN op size */
if (caller == immediate_caller) PC = pc + (FN_OPCODE_SIZE - 3); if (caller == immediate_caller) PC = pc + (FN_OPCODE_SIZE - 3);
#endif /* BIGATOMS */ #endif /* BIGATOMS */
else {
else
caller->pc = (UNSIGNED)pc + FN_OPCODE_SIZE - (UNSIGNED)fnhead; caller->pc = (UNSIGNED)pc + FN_OPCODE_SIZE - (UNSIGNED)fnhead;
/* skip over FN opcode when we get there */
prevcaller->fast = 0;
caller->mvscase = 1;
caller->nopush = 1;
}
return (make_value_list(arg_count, args)); return (make_value_list(arg_count, args));
} }
break; break;
@@ -271,26 +278,22 @@ LispPTR make_value_list(int argcount, LispPTR *argarray) {
void simulate_unbind(FX2 *frame, int unbind_count, FX2 *returner) { void simulate_unbind(FX2 *frame, int unbind_count, FX2 *returner) {
int unbind; int unbind;
LispPTR *stackptr = (LispPTR *)(Stackspace + frame->nextblock); LispPTR *stack_pointer = (LispPTR *)(Stackspace + frame->nextblock);
for (unbind = 0; unbind < unbind_count; unbind++) { for (unbind = 0; unbind < unbind_count; unbind++) {
register int value; register int num;
register LispPTR *lastpvar; register LispPTR *ppvar;
int bindnvalues; register int i;
for (; ((int)*--stackptr >= 0);) register LispPTR value;
; /* find the binding mark */
value = (int)*stackptr; for (; (((int)*--(stack_pointer)) >= 0);)
lastpvar = (LispPTR *)((DLword *)frame + FRAMESIZE + 2 + GetLoWord(value)); ;
; value = *stack_pointer;
bindnvalues = (~value) >> 16; num = (~value) >> 16;
for (value = bindnvalues; --value >= 0;) { *--lastpvar = 0xffffffff; } ppvar = (LispPTR *)((DLword *)frame + FRAMESIZE + 2 + GetLoWord(value));
/* This line caused \NSMAIL.READ.HEADING to smash memory, */ for (i = num; --i >= 0;) { *--ppvar = 0xffffffff; }
/* so I removed it 21 Jul 91 --JDS. This was the only */
/* difference between this function and the UNWIND code */
/* in inlineC.h */
/* MAKEFREEBLOCK(stackptr, (DLword *)stackptr-nextblock); */
} }
if (returner) /* if (returner)
returner->fast = 0; /* since we've destroyed contiguity */ returner->fast = 0; since we've destroyed contiguity */
/* in the stack, but that only /* in the stack, but that only
matters if there's a return. */ matters if there's a return. */
} }