mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-15 15:57:13 +00:00
31927cd255
* Compiling for INIT requires an extra include file vs normal. * Compiling for INIT often includes tracing which also requires additional includes
146 lines
4.3 KiB
C
146 lines
4.3 KiB
C
/* $Id: binds.c,v 1.3 1999/05/31 23:35:24 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 "lspglob.h"
|
|
#include "emlglob.h"
|
|
#include "testtooldefs.h"
|
|
#include "bindsdefs.h"
|
|
|
|
/**************************************************
|
|
N_OP_bind(stack_pointer, tos, n1, n2)
|
|
|
|
Entry: BIND opcode[021]
|
|
|
|
1. bind PVAR slot to NIL. (n1 times)
|
|
2. bind PVAR slot to value of slot in Evaluation stack. (n2 times)
|
|
or push TopOfStack to Evaluation stack.
|
|
3. Push [upper word] 1's complement of bind slots
|
|
[lower word] 2word offset from PVar
|
|
|
|
***************************************************/
|
|
|
|
LispPTR *N_OP_bind(register LispPTR *stack_pointer, register LispPTR tos, int byte1, int byte2) {
|
|
register int n1; /* # slots to bind to NIL (0, 0) */
|
|
register int n2; /* # slots to bind to value in stack */
|
|
register LispPTR *ppvar; /* pointer to argued slot in Pvar area */
|
|
register int i; /* temporary for control */
|
|
|
|
#ifdef TRACE
|
|
printPC();
|
|
printf("TRACE: N_OP_bind()\n");
|
|
#endif
|
|
|
|
n1 = byte1 >> 4;
|
|
n2 = byte1 & 0xf;
|
|
ppvar = (LispPTR *)PVar + 1 + byte2;
|
|
|
|
for (i = 0; i < n1; i++) { *--ppvar = NIL_PTR; }
|
|
|
|
if (n2 == 0) {
|
|
*stack_pointer++ = tos; /* push TopOfStack to Evaluation stack */
|
|
} else {
|
|
*--ppvar = tos; /* bind to TopOfStack */
|
|
for (i = 1; i < n2; i++) { *--ppvar = *(--stack_pointer); }
|
|
}
|
|
|
|
i = ~(n1 + n2); /* x: 1's complement of number of bind slots */
|
|
*stack_pointer = (i << 16) | (byte2 << 1);
|
|
return (stack_pointer);
|
|
}
|
|
|
|
/**************************************************
|
|
LispPTR N_OP_unbind(stackpointer)
|
|
|
|
Entry: UNBIND opcode[022]
|
|
|
|
1. pop stackpointer until the slot (num, lastpvar) is found
|
|
(Note: TOPOFSTACK is ignored)
|
|
2. unbind lastpvar slot (set to 0xFFFF). (num times)
|
|
|
|
***************************************************/
|
|
|
|
LispPTR *N_OP_unbind(register LispPTR *stack_pointer) {
|
|
register DLword num; /* number of unbind sot */
|
|
register LispPTR *ppvar; /* pointer to last PVAR slot. */
|
|
register DLword i; /* temporary for control */
|
|
register LispPTR value;
|
|
|
|
#ifdef TRACE
|
|
printPC();
|
|
printf("TRACE: N_OP_unbind()\n");
|
|
#endif
|
|
|
|
/* now, stack_pointer points the latter part in slot */
|
|
for (; !(*--stack_pointer & 0x80000000);)
|
|
; /* scan (until MSB == 1) */
|
|
|
|
value = *stack_pointer;
|
|
num = (DLword) ~(value >> 16);
|
|
ppvar = (LispPTR *)(PVar + 2 + GetLoWord(value));
|
|
value = 0xffffffff;
|
|
for (i = 0; i < num; i++) { *--ppvar = value; }
|
|
return (stack_pointer);
|
|
}
|
|
|
|
/**************************************************
|
|
N_OP_dunbind
|
|
|
|
Entry: DUNBIND opcode[023]
|
|
|
|
1. if TopOfStack is unbound
|
|
unbind num slots from PVar.
|
|
if TopOfStack is bound
|
|
pop CurrentStack until the slot (num, lastpvar) is found.
|
|
unbind num slots from lastpvar.
|
|
2. pop the top of CurrentStackPTR to TopOfStack.
|
|
|
|
***************************************************/
|
|
|
|
LispPTR *N_OP_dunbind(register LispPTR *stack_pointer, register LispPTR tos) {
|
|
register DLword num; /* number of unbind sot */
|
|
register LispPTR *ppvar; /* pointer to last PVAR slot. */
|
|
register DLword i; /* temporary for control */
|
|
register LispPTR value;
|
|
|
|
#ifdef TRACE
|
|
printPC();
|
|
printf("TRACE: N_OP_dunbind()\n");
|
|
#endif
|
|
|
|
if (tos & 0x80000000) {
|
|
/* check MSB bit of High word in tos, 1: unbound, 0: bound */
|
|
|
|
/* tos is unbound */
|
|
num = ~(GetHiWord(tos));
|
|
value = 0xffffffff;
|
|
if (num != 0) {
|
|
ppvar = (LispPTR *)(PVar + 2 + GetLoWord(tos));
|
|
for (i = 0; i < num; ++i) { *--ppvar = value; }
|
|
}
|
|
} else {
|
|
/* tos is bound */
|
|
/* now, stack_pointer points the latter part in slot */
|
|
for (; !((*--stack_pointer) & 0x80000000);)
|
|
;
|
|
/* scan (until MSB == 1) */
|
|
|
|
value = *stack_pointer;
|
|
num = ~(GetHiWord(value));
|
|
ppvar = (LispPTR *)(PVar + 2 + GetLoWord(value));
|
|
value = 0xffffffff;
|
|
for (i = 0; i < num; i++) { *--ppvar = value; }
|
|
}
|
|
|
|
return (stack_pointer);
|
|
}
|