Interlisp.maiko/src/binds.c

/* $Id: binds.c,v 1.3 1999/05/31 23:35:24 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
static char *id = "$Id: binds.c,v 1.3 1999/05/31 23:35:24 sybalsky Exp $ Copyright (C) Venue";

/************************************************************************/
/*									*/
/*	(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 "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);
}