Initial revision
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Tue, 5 May 1992 06:55:13 +0000 (06:55 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Tue, 5 May 1992 06:55:13 +0000 (06:55 +0000)
32 files changed:
v7/src/microcode/dosasutl.asm [new file with mode: 0644]
v7/src/microcode/dosconio.c [new file with mode: 0644]
v7/src/microcode/dosenv.c [new file with mode: 0644]
v7/src/microcode/dosexcp.c [new file with mode: 0644]
v7/src/microcode/dosexcp.h [new file with mode: 0644]
v7/src/microcode/dosfg.c [new file with mode: 0644]
v7/src/microcode/dosfile.c [new file with mode: 0644]
v7/src/microcode/dosfs.c [new file with mode: 0644]
v7/src/microcode/dosinsn.h [new file with mode: 0644]
v7/src/microcode/dosio.c [new file with mode: 0644]
v7/src/microcode/dosio.h [new file with mode: 0644]
v7/src/microcode/doskbd.c [new file with mode: 0644]
v7/src/microcode/doskbd.h [new file with mode: 0644]
v7/src/microcode/doskbutl.asm [new file with mode: 0644]
v7/src/microcode/dosscan.h [new file with mode: 0644]
v7/src/microcode/dosselec.h [new file with mode: 0644]
v7/src/microcode/dossig.c [new file with mode: 0644]
v7/src/microcode/dossys.c [new file with mode: 0644]
v7/src/microcode/dossys.h [new file with mode: 0644]
v7/src/microcode/dosterm.h [new file with mode: 0644]
v7/src/microcode/dostop.c [new file with mode: 0644]
v7/src/microcode/dostop.h [new file with mode: 0644]
v7/src/microcode/dostrap.c [new file with mode: 0644]
v7/src/microcode/dostrap.h [new file with mode: 0644]
v7/src/microcode/dostterm.c [new file with mode: 0644]
v7/src/microcode/dostty.c [new file with mode: 0644]
v7/src/microcode/dosutil.c [new file with mode: 0644]
v7/src/microcode/dosutil.h [new file with mode: 0644]
v7/src/microcode/dosxcutl.asm [new file with mode: 0644]
v7/src/microcode/msdos.h [new file with mode: 0644]
v7/src/microcode/prdosenv.c [new file with mode: 0644]
v7/src/microcode/prdosfs.c [new file with mode: 0644]

diff --git a/v7/src/microcode/dosasutl.asm b/v7/src/microcode/dosasutl.asm
new file mode 100644 (file)
index 0000000..e3147c8
--- /dev/null
@@ -0,0 +1,98 @@
+;;; -*-Midas-*-
+;;;
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosasutl.asm,v 1.1 1992/05/05 06:55:13 jinx Exp $
+;;;
+;;;    Copyright (c) 1992 Massachusetts Institute of Technology
+;;;
+;;;    This material was developed by the Scheme project at the
+;;;    Massachusetts Institute of Technology, Department of
+;;;    Electrical Engineering and Computer Science.  Permission to
+;;;    copy this software, to redistribute it, and to use it for any
+;;;    purpose is granted, subject to the following restrictions and
+;;;    understandings.
+;;;
+;;;    1. Any copy made of this software must include this copyright
+;;;    notice in full.
+;;;
+;;;    2. Users of this software agree to make their best efforts (a)
+;;;    to return to the MIT Scheme project any improvements or
+;;;    extensions that they make, so that these may be included in
+;;;    future releases; and (b) to inform MIT of noteworthy uses of
+;;;    this software.
+;;;
+;;;    3. All materials developed as a consequence of the use of this
+;;;    software shall duly acknowledge such use, in accordance with
+;;;    the usual standards of acknowledging credit in academic
+;;;    research.
+;;;
+;;;    4. MIT has made no warrantee or representation that the
+;;;    operation of this software will be error-free, and MIT is
+;;;    under no obligation to provide any services, by way of
+;;;    maintenance, update, or otherwise.
+;;;
+;;;    5. In conjunction with products arising from the use of this
+;;;    material, there shall be no use of the name of the
+;;;    Massachusetts Institute of Technology nor of any adaptation
+;;;    thereof in any advertising, promotional, or sales literature
+;;;    without prior written consent from MIT in each case.
+;;;
+
+.386
+.model small
+       .code
+\f
+       public  _getCS
+_getCS:
+       xor     eax,eax                 ; clear eax
+       mov     ax,cs                   ; copy code segment descriptor
+       ret
+
+       public  _getSS
+_getSS:
+       xor     eax,eax                 ; clear eax
+       mov     ax,ss                   ; copy code segment descriptor
+       ret
+
+;;     Frame on entry to farcpy
+
+;;24   size
+;;20   src_sel
+;;16   src_off
+;;12   dst_sel
+;;8    dst_off
+;;4    ret add
+;;0    previous ebp
+
+       public  _farcpy
+_farcpy:
+       push    ebp
+       mov     ebp,esp
+       push    ebx
+       push    ds
+       push    es
+
+       mov     eax,12[ebp]
+       mov     ds,ax                   ; dst sel
+       mov     eax,20[ebp]
+       mov     es,ax                   ; src sel
+       mov     edx,8[ebp]              ; dst off
+       mov     ecx,16[ebp]             ; src off
+       mov     eax,24[ebp]             ; count
+       jmp     enter_loop
+
+farcpy_loop:
+       mov     bl,es:[ecx]
+       mov     ds:[edx],bl
+       inc     ecx
+       inc     edx
+
+enter_loop:
+       dec     eax
+       jge     farcpy_loop
+
+       pop     es
+       pop     ds
+       pop     ebx
+       pop     ebp
+       ret
+end
diff --git a/v7/src/microcode/dosconio.c b/v7/src/microcode/dosconio.c
new file mode 100644 (file)
index 0000000..73a98ef
--- /dev/null
@@ -0,0 +1,465 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosconio.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* Console I/O supplement */
+
+#include "scheme.h"
+#include "prims.h"
+#include "msdos.h"
+#include "dosio.h"
+#include "dosscan.h"
+#include "dossys.h"
+#include "intrpt.h"
+
+/* This is really not set up to include Scheme level headers, so we
+   fake them here. */
+extern long
+  IntCode,             /* Interrupts requesting */
+  IntEnb;              /* Interrupts enabled */
+
+#ifdef __STDC__
+#define fileno(fp)     ((fp)->_file)
+#endif
+
+\f
+#define CONIO_BUFFER_SIZE      (1024)
+#define TYPEAHEAD_BUFFER_SIZE  (1024)
+
+#define System_Error_Reset()           \
+  (errno = 0)
+
+#define System_Error_Return(err)       \
+{                                      \
+  errno = err;                         \
+  return -1;                           \
+}
+
+/* Characters are kept in the typeahead_buffer before read is called,
+   in the key_buffer before return is pressed, and in the line_buffer
+   before the line is read.
+ */
+typedef        struct conin_buffer_struct
+{
+  unsigned char buffer[CONIO_BUFFER_SIZE];
+  size_t length;
+} conio_buffer_t;
+
+typedef struct typeahead_buffer_struct
+{
+  unsigned char buffer[TYPEAHEAD_BUFFER_SIZE];
+  size_t length;
+} typeahead_buffer_t;
+
+static conio_buffer_t line_buffer, key_buffer;
+static typeahead_buffer_t typeahead_buffer;
+
+\f
+static int max_scancode_conversion_length = 0;
+static unsigned char * keyboard_scancode_table[] = DEFAULT_SCANCODE_CONVERSIONS;
+
+/* This is a kludge to save 200 bytes or so of memory; sigh! */
+#ifndef ULONG_BIT
+#define ULONG_BIT              (sizeof(unsigned long)*CHAR_BIT)
+#endif
+#define MALLOCED_TABLE_SIZE    \
+  ((KEYBOARD_SCANCODE_TABLE_SIZE+(ULONG_BIT-1))/ULONG_BIT)
+
+static unsigned long scancode_malloced_table[MALLOCED_TABLE_SIZE] = {0,};
+
+#define Scancode_To_Malloced_Table_Word(s)     ((s)/ULONG_BIT)
+#define Scancode_To_Malloced_Table_Word_Bit(s) ((s)%ULONG_BIT)
+
+#define Scancode_Malloced_p(s)                                         \
+  (scancode_malloced_table[Scancode_To_Malloced_Table_Word(s)] &       \
+   (1 << Scancode_To_Malloced_Table_Word_Bit(s)))
+
+#define Scancode_Malloced(s)                                           \
+  (scancode_malloced_table[Scancode_To_Malloced_Table_Word(s)] |=      \
+   (1 << Scancode_To_Malloced_Table_Word_Bit(s)))
+
+#define Scancode_Malloced_Not(s)                                       \
+  (scancode_malloced_table[Scancode_To_Malloced_Table_Word(s)] &=      \
+   (~(1 << Scancode_To_Malloced_Table_Word_Bit(s))))
+
+/* End of Kludge */
+
+#define Max(a, b) (((a) > (b)) ? (a) : (b))
+
+#define Typeahead_Buffer_Remaining()   \
+  (TYPEAHEAD_BUFFER_SIZE - typeahead_buffer.length)
+
+#define Typeahead_Buffer_Available_p() \
+  (Typeahead_Buffer_Remaining() >= max_scancode_conversion_length)
+
+static void
+DEFUN (map_keyboard_scancode, (scancode), unsigned char scancode)
+{ extern int signal_keyboard_character_interrupt(unsigned char);
+
+  if (scancode < KEYBOARD_SCANCODE_TABLE_SIZE)
+  {
+    int len;
+    unsigned char * conversion = keyboard_scancode_table[scancode];
+    if (conversion == NO_CONVERSION)
+      return;
+
+    len = ((conversion == CTRL_AT) ? 1 : strlen (conversion));
+    
+    if (len <= (Typeahead_Buffer_Remaining ()))
+    { /* Copy conversion string into typeahead buffer, worrying about
+        interrupt characters along the way. */
+      while (--len >= 0)
+      {
+       if ((signal_keyboard_character_interrupt (*conversion)) == 0)
+         typeahead_buffer.buffer[typeahead_buffer.length++] = *conversion++;
+      }
+    }
+  }
+  return;
+}
+
+static void
+DEFUN_VOID (recompute_max_scancode_conversion_length)
+{
+  int i, length;
+  max_scancode_conversion_length = 0;
+
+  for (i = 0; i < KEYBOARD_SCANCODE_TABLE_SIZE; i++)
+  { 
+    unsigned char * conversion = keyboard_scancode_table[i];
+    if (conversion == NO_CONVERSION)
+      length = 0;
+    else if (conversion == CTRL_AT)
+      length = 1;
+    else
+      length = strlen (conversion);
+    max_scancode_conversion_length 
+      = Max (length, max_scancode_conversion_length);
+  }
+  return;
+}
+
+static void
+DEFUN_VOID (initialize_scancode_table)
+{
+  recompute_max_scancode_conversion_length ();
+}
+
+DEFINE_PRIMITIVE ("KEYBOARD-GET-CONVERSION", Prim_keyboard_get_conversion,
+                 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  {
+    long scancode = arg_integer(1);
+
+    if ((scancode < 0) || (scancode >= KEYBOARD_SCANCODE_TABLE_SIZE))
+      error_bad_range_arg(1);
+    else
+    {
+      unsigned char * conversion = keyboard_scancode_table[scancode];
+      if (conversion == NO_CONVERSION)
+       PRIMITIVE_RETURN (SHARP_F);
+      else if (conversion == CTRL_AT)
+       PRIMITIVE_RETURN (memory_to_string (1, "\0"));
+      else
+       PRIMITIVE_RETURN (char_pointer_to_string (conversion));
+    }
+  }
+}
+
+DEFINE_PRIMITIVE ("KEYBOARD-SET-CONVERSION!", Prim_keyboard_set_conversion,
+                 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  {
+    int scancode = arg_integer (1);
+    SCHEME_OBJECT scheme_conversion = ARG_REF (2);
+
+    if ((scancode < 0) || (scancode >= KEYBOARD_SCANCODE_TABLE_SIZE))
+      error_bad_range_arg(1);
+    else
+    { 
+      int len;
+      if ((scheme_conversion != SHARP_F)
+         && (!STRING_P (scheme_conversion)))
+       error_wrong_type_arg (2);
+      if ((scheme_conversion == SHARP_F)
+         || ((len = (STRING_LENGTH (scheme_conversion)))
+             == 0))
+      {
+       if (Scancode_Malloced_p (scancode))
+         DOS_free (keyboard_scancode_table[scancode]);
+       keyboard_scancode_table[scancode] = NO_CONVERSION;
+       Scancode_Malloced_Not (scancode);
+      }
+      else if ((len == 1)
+              && ((STRING_REF (scheme_conversion, 0)) == '\0'))
+      {
+       if (Scancode_Malloced_p (scancode))
+         DOS_free (keyboard_scancode_table[scancode]);
+       keyboard_scancode_table[scancode] = CTRL_AT;
+       Scancode_Malloced_Not (scancode);
+      }
+      else
+      {
+       int i;
+       unsigned char * old_conversion
+         = keyboard_scancode_table[scancode];
+       unsigned char * conversion, * scheme;
+
+       conversion = (DOS_malloc (len + 1));
+       if (conversion == 0)
+         error_system_call (ENOMEM, syscall_malloc);
+       if (Scancode_Malloced_p (scancode))
+         DOS_free (old_conversion);
+       keyboard_scancode_table[scancode] = conversion;
+       Scancode_Malloced (scancode);
+       for (i = 0, scheme = (STRING_LOC (scheme_conversion, 0));
+            i <= len;
+            i ++)
+         *conversion++ = *scheme++;
+       *conversion = '\0';
+      }
+      recompute_max_scancode_conversion_length ();
+      PRIMITIVE_RETURN (UNSPECIFIC);
+    }
+  }
+}
+\f
+static void
+DEFUN_VOID (consume_typeahead)
+{
+  extern int signal_keyboard_character_interrupt(unsigned char);
+  unsigned char character;
+
+  while ( (Typeahead_Buffer_Available_p()) &&
+         (dos_poll_keyboard_character(&character)) )
+  { 
+    if (character == '\0') /* Extended scancode */
+    { 
+      dos_poll_keyboard_character(&character);
+      map_keyboard_scancode(character);
+    }
+    else if (signal_keyboard_character_interrupt(character) == 0)
+      typeahead_buffer.buffer[typeahead_buffer.length++] = character;
+    else
+      break;
+  }
+  return;
+}
+
+static int
+DEFUN_VOID (typeahead_available_p)
+{
+  consume_typeahead();
+  return !(typeahead_buffer.length == 0);
+}
+
+static unsigned char
+DEFUN_VOID (get_typeahead_character)
+{ unsigned char result;
+  
+  if (typeahead_buffer.length == 0)
+    return '\0';
+  else
+  { int i;
+    result = typeahead_buffer.buffer[0];
+    for (i = 1; i < typeahead_buffer.length; i++)
+      typeahead_buffer.buffer[i - 1] = typeahead_buffer.buffer[i];
+    typeahead_buffer.length--;
+    return result;
+  }
+}
+
+DEFINE_PRIMITIVE ("CONSUME-TYPEAHEAD", Prim_consume_typeahead, 0, 0,
+  "Suck up DOS typeahead.")
+{
+
+  PRIMITIVE_HEADER(0);
+  consume_typeahead();
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+\f
+static void
+DEFUN (key_buffer_insert_self, (c), unsigned char c)
+{
+  static unsigned char crlf[] = {CARRIAGE_RETURN, LINEFEED};
+
+  if (key_buffer.length != CONIO_BUFFER_SIZE)
+  {
+    key_buffer.buffer[key_buffer.length++] = c;
+    ( (c == LINEFEED)
+      ? dos_console_write(crlf, sizeof(crlf))
+      : dos_console_write(&c, 1) );
+  }
+  return;
+}  
+
+static void
+DEFUN_VOID (key_buffer_erase_character)
+{
+  static char erase[] = {BACKSPACE, SPACE, BACKSPACE};
+
+  if (key_buffer.length != 0)
+  {
+    key_buffer.length -= 1;
+    dos_console_write(erase, sizeof(erase));
+  }
+  return;
+}
+
+static void
+DEFUN_VOID(key_buffer_to_line_buffer)
+{ register size_t i = 0;
+  register size_t j = 0;
+
+  while ((i < key_buffer.length)&&(line_buffer.length != CONIO_BUFFER_SIZE))
+    line_buffer.buffer[line_buffer.length++] = key_buffer.buffer[i++];
+  while (i < key_buffer.length)
+    key_buffer.buffer[j++] = key_buffer.buffer[i++];
+  key_buffer.length = j;
+
+  return;
+}
+
+\f
+
+void
+DEFUN_VOID (flush_conio_buffers)
+{
+  line_buffer.length = 0;
+  key_buffer.length = 0;
+  typeahead_buffer.length = 0;
+  return;
+}
+
+void
+DEFUN_VOID (DOS_initialize_conio)
+{ void initialize_keyboard_interrupt_table(void);
+
+  flush_conio_buffers();
+  initialize_keyboard_interrupt_table();
+  initialize_scancode_table();
+
+  return;
+}
+
+
+static int
+DEFUN(empty_line_buffer, (buffer, nbytes), char * buffer AND size_t nbytes)
+{ register size_t i, j;
+  
+  for (i = 0; ((i < line_buffer.length)&&(i < nbytes)); i++)
+    *buffer++ = line_buffer.buffer[i];
+  nbytes = i;
+  for (j = 0; i < line_buffer.length; i++, j++)
+    line_buffer.buffer[j] = line_buffer.buffer[i];
+  line_buffer.length -= nbytes;
+  return nbytes;
+}
+
+\f
+static void
+DEFUN (buffered_key_command, (c), unsigned char c)
+{
+  switch(c)
+  { 
+    case CARRIAGE_RETURN:
+    case LINEFEED:
+      key_buffer_insert_self(LINEFEED);
+      key_buffer_to_line_buffer();
+      break;
+    case DELETE:
+    case BACKSPACE: /* Backspace */
+      if (key_buffer.length != 0)
+       key_buffer_erase_character();
+      break;
+    default:
+      key_buffer_insert_self(c);
+      break;
+  }
+  return;
+}
+
+static void
+DEFUN (non_buffered_key_command, (c), unsigned char c)
+{
+  if (line_buffer.length == CONIO_BUFFER_SIZE) return;
+  if ((!DOS_keyboard_intercepted_p)
+      && (c == BACKSPACE))
+    c = DELETE;
+
+  line_buffer.buffer[line_buffer.length++] = c;
+  return;
+}
+\f
+long
+DEFUN(console_read, (buffer, nbytes, buffered_p, blocking_p),
+      char * buffer AND unsigned nbytes AND int buffered_p AND int blocking_p)
+{ 
+  System_Error_Reset();
+  do
+  { /* Get all pending characters into the buffer */
+    while (typeahead_available_p())
+    { 
+      if (buffered_p)
+       buffered_key_command(get_typeahead_character());
+      else /* Non buffered channel, in CScheme, also no echo. */
+       non_buffered_key_command(get_typeahead_character());
+    } /* End WHILE */
+    /* Test for pending interrupts here: */
+    if (pending_interrupts_p())
+    { if (INTERRUPT_QUEUED_P(INT_Character))
+       flush_conio_buffers();
+      System_Error_Return(EINTR);
+    }
+    /* Return if we buffered up a line, or channel is not buffered */
+    if (line_buffer.length != 0)
+      return empty_line_buffer(buffer, nbytes);
+  } while (blocking_p);        /* Keep reading for blocking channel. */
+  /* This means there is nothing available, don't block */
+  System_Error_Return(ERRNO_NONBLOCK);
+}
+       
+\f
+extern int EXFUN
+ (text_write, (int fd AND CONST unsigned char * buffer AND size_t nbytes));
+
+void
+DEFUN (console_write_string, (string), void * string)
+{
+  text_write(fileno(stdout), string, strlen((char *) string));
+  return;
+}
diff --git a/v7/src/microcode/dosenv.c b/v7/src/microcode/dosenv.c
new file mode 100644 (file)
index 0000000..a9f4752
--- /dev/null
@@ -0,0 +1,217 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosenv.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "osenv.h"
+#include <stdlib.h>
+\f
+void
+DEFUN (OS_current_time, (buffer), struct time_structure * buffer)
+{
+  time_t t;
+  struct tm * ts;
+  STD_UINT_SYSTEM_CALL (syscall_time, t, (DOS_time (0)));
+  STD_PTR_SYSTEM_CALL (syscall_localtime, ts, (DOS_localtime (&t)));
+  (buffer -> year) = ((ts -> tm_year) + 1900);
+  (buffer -> month) = ((ts -> tm_mon) + 1);
+  (buffer -> day) = (ts -> tm_mday);
+  (buffer -> hour) = (ts -> tm_hour);
+  (buffer -> minute) = (ts -> tm_min);
+  (buffer -> second) = (ts -> tm_sec);
+  {
+    /* In localtime() encoding, 0 is Sunday; in ours, it's Monday. */
+    int wday = (ts -> tm_wday);
+    (buffer -> day_of_week) = ((wday == 0) ? 6 : (wday - 1));
+  }
+}
+
+clock_t
+DEFUN_VOID (OS_process_clock)
+{
+  /* This must not signal an error in normal use. */
+  /* Return answer in milliseconds, was in 1/100th seconds */
+  return (clock()*((clock_t) (1000/CLOCKS_PER_SEC)));
+}
+
+\f
+
+clock_t
+DEFUN_VOID (OS_real_time_clock)
+{
+  return (clock()*((clock_t) (1000/CLOCKS_PER_SEC)));
+}
+
+
+\f
+/* Timer adjustments */
+#define PC_TIMER_TICKS_PER_SECOND      (18.2)
+/* This should work out to about 55 */
+#define PC_MILLISECONDS_PER_TIMER_TICK  \
+  ((long) ((1000.0/PC_TIMER_TICKS_PER_SECOND)+0.5))
+
+static unsigned long
+DEFUN (ms_to_ticks, (clocks), clock_t clocks)
+{ ldiv_t ticks;
+  unsigned long result;
+
+  ticks = ldiv((long) clocks, PC_MILLISECONDS_PER_TIMER_TICK);
+
+  result = ((ticks.rem >= (PC_MILLISECONDS_PER_TIMER_TICK/2)) ?
+           (ticks.quot + 1) : (ticks.quot));
+  return (result == 0) ? 1 : result;  
+}
+  
+void
+DEFUN (OS_process_timer_set, (first, interval),
+       clock_t first AND
+       clock_t interval)
+{ extern volatile unsigned long scm_itimer_counter, scm_itimer_reload;
+  /* Convert granularity to 1/18.2 seconds */
+
+  scm_itimer_counter = ms_to_ticks(first);
+  scm_itimer_reload  = ms_to_ticks(interval);
+  
+  return;  
+}
+
+void
+DEFUN_VOID (OS_process_timer_clear)
+{
+  scm_itimer_reload = scm_itimer_counter = 0;
+  return;
+}
+
+void
+DEFUN (OS_real_timer_set, (first, interval),
+       clock_t first AND
+       clock_t interval)
+{
+  OS_process_timer_set (first, interval);
+}
+
+void
+DEFUN_VOID (OS_real_timer_clear)
+{
+  OS_process_timer_clear();
+  return;
+}
+
+void
+DEFUN_VOID (DOS_initialize_environment)
+{
+  return;
+}
+\f
+static size_t current_dir_path_size = 0;
+static char * current_dir_path = 0;
+
+CONST char *
+DEFUN_VOID (OS_working_dir_pathname)
+{
+  if (current_dir_path) {
+    return (current_dir_path);
+  }
+  if (current_dir_path_size == 0)
+    {
+      current_dir_path = (DOS_malloc (1024));
+      if (current_dir_path == 0)
+       error_system_call (ENOMEM, syscall_malloc);
+      current_dir_path_size = 1024;
+    }
+  while (1)
+    {
+      if ((DOS_getcwd (current_dir_path, current_dir_path_size)) != 0)
+      { strlwr(current_dir_path);
+       return (current_dir_path);
+      }
+#ifdef ERANGE
+      if (errno != ERANGE)
+       error_system_call (errno, syscall_getcwd);
+#endif      
+      current_dir_path_size *= 2;
+      {
+       char * new_current_dir_path =
+         (DOS_realloc (current_dir_path, current_dir_path_size));
+       if (new_current_dir_path == 0)
+         /* ANSI C requires `path' to be unchanged -- we may have to
+            discard it for systems that don't behave thus. */
+         error_system_call (ENOMEM, syscall_realloc);
+       current_dir_path = new_current_dir_path;
+      }
+    }
+}
+
+void
+DEFUN (OS_set_working_dir_pathname, (name), char * name)
+{ char filename[128], drive[3];
+  int drive_number;
+  size_t name_size = strlen (name);
+  
+  drive_number = dos_split_filename(name, drive, filename);
+  dos_set_default_drive(drive_number);
+  STD_VOID_SYSTEM_CALL (syscall_chdir, (DOS_chdir (filename)));
+
+  while (1) {
+    if (name_size < current_dir_path_size) {
+      strcpy(current_dir_path, name);
+      return;
+    } 
+    current_dir_path_size *= 2;
+    {
+      char * new_current_dir_path =
+       (DOS_realloc (current_dir_path, current_dir_path_size));
+      if (new_current_dir_path == 0)
+       error_system_call (ENOMEM, syscall_realloc);
+      current_dir_path = new_current_dir_path;
+    }
+  }
+}
+
+CONST char *
+DEFUN (OS_get_environment_variable, (name), CONST char * name)
+{
+  return (DOS_getenv (name));
+}
+
+CONST char *
+DEFUN_VOID (OS_current_user_name)
+{
+  return ("dos");
+}
+
+CONST char *
+DEFUN_VOID (OS_current_user_home_directory)
+{
+  return ("c:\\");
+}
diff --git a/v7/src/microcode/dosexcp.c b/v7/src/microcode/dosexcp.c
new file mode 100644 (file)
index 0000000..b41349c
--- /dev/null
@@ -0,0 +1,331 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosexcp.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <dos.h>
+#include "dossys.h"
+#include "dosinsn.h"
+#include "dosexcp.h"
+\f
+/* It would be nice to be able to use something akin to Zortech's int_intercept
+   to get control of trap handlers, but Zortech does not provide that ability.
+   In fact, it shadows the exception numbers with DOS interrupts (for compatibility),
+   but does not map the traps to an accessible region.
+   In the meantime, exceptions are only caught under DPMI.
+*/
+
+#if 0
+
+#include <int.h>
+
+static unsigned long *
+DEFUN (store_trap_data, (trap_stack_ptr, intno, code, pd), 
+       unsigned long ** trap_stack_ptr 
+       AND unsigned char intno AND unsigned char code
+       AND struct INT_DATA * pd)
+{
+  unsigned long 
+    * trap_stack,
+    * trapped_stack;
+  
+  union
+  { 
+    unsigned long long_value;
+    struct
+    { 
+      unsigned char code;
+      unsigned char ss_is_ds;
+      unsigned char intno;
+      unsigned char padding;
+    } byte_values;
+  } code_word;
+
+  trap_stack = (* trap_stack_ptr);
+  trapped_stack = ((unsigned long) pd->regs.oldstack_off);
+
+  code_word.byte_values.code = code;
+  code_word.byte_values.intno = intno;
+  code_word.byte_values.ss_is_ds = (pd->oldstack_seg == pd->sregs.ds);
+  code_word.byte_values.padding = 0;
+
+  *--trap_stack = code_word.long_value;
+  *--trap_stack = pd->regs.e.eax;
+  *--trap_stack = pd->regs.e.ecx;
+  *--trap_stack = pd->regs.e.edx;
+  *--trap_stack = pd->regs.e.ebx;
+
+  /* The following checks whether there was a ring change when the
+     interrupt was taken.  If there was, the old SP is pushed on the
+     exception trap frame which lives on the stack of the new
+     privilege level, otherwise the trap frame was pushed on the 
+     interrupted stack, which is shared by the low-level handler.
+     Compare the PL of the two PCs.
+   */
+  *--trap_stack = (((pd->regs.sregs.cs & 0x3) == (trapped_stack[3] & 0x3))
+                   ? (trapped_stack + 5)
+                  : (trapped_stack[5]));       /* esp */
+  *--trap_stack = trapped_stack[0];            /* ebp */
+  *--trap_stack = pd->regs.e.esi;
+  *--trap_stack = pd->regs.e.edi;
+  *--trap_stack = trapped_stack[2];            /* eip */
+  *--trap_stack = pd->regs.e.flags;
+  (* trap_stack_ptr) = trap_stack;
+  return (trapped_stack + 2);
+}
+\f
+static int
+DEFUN (dosx_trap_handler, (intno, pd), 
+       unsigned char intno AND struct INT_DATA * pd)
+{
+  extern void asm_trap_handler ();
+  extern unsigned long
+    * asm_trap_stack,
+    * asm_trap_stack_limit,
+    * asm_trap_stack_base;
+  unsigned long * pc_loc;
+  int code;
+
+  code = 0;
+  if (asm_trap_stack <= asm_trap_stack_limit)
+  {
+    /* Lose badly.  Too many nested traps. */
+    asm_trap_stack = asm_trap_stack_base;
+    code = 1;
+  }
+  pc_loc = store_trap_data (&asm_trap_stack, intno, code, pd);
+  (* pc_loc) = ((unsigned long) asm_trap_handler);
+  return (0);
+}
+
+#define DEFINE_TRAP_HANDLER(name,intno)                \
+extern int EXFUN (name, (struct INT_DATA *));  \
+int                                            \
+DEFUN (name, (pd), struct INT_DATA * pd)       \
+{                                              \
+  return (dosx_trap_handler (intno, pd));      \
+}
+
+DEFINE_TRAP_HANDLER (handle_integer_divide_by_0, DOS_INTVECT_DIVIDE_BY_0)
+DEFINE_TRAP_HANDLER (handle_overflow, DOS_INTVECT_OVERFLOW)
+DEFINE_TRAP_HANDLER (handle_bounds_check, DOS_INTVECT_PRINT_SCREEN)
+DEFINE_TRAP_HANDLER (handle_invalid_opcode, DOS_INVALID_OPCODE)
+/* And many more friends. */
+
+#endif /* 0 */
+\f
+int
+DPMI_get_exception_vector (unsigned exception,
+                          unsigned short * cs_selector,
+                          unsigned * code_offset)
+{
+  union REGS regs1, regs2;
+
+  if (exception > 0x1f)
+  {
+    errno = EINVAL;
+    return (DOS_FAILURE);
+  }
+  regs1.e.eax = 0x202;
+  regs1.e.ebx = exception;
+  int86 (0x31, &regs1, &regs2);
+  if ((regs2.e.flags & 1) != 0)
+  {
+    errno = EINVAL;
+    return (DOS_FAILURE);
+  }
+  * cs_selector = regs2.x.cx;
+  * code_offset = regs2.e.edx;
+  return (DOS_SUCCESS);
+}
+
+int
+DPMI_set_exception_vector (unsigned exception,
+                          unsigned short cs_selector,
+                          unsigned code_offset)
+{
+  union REGS regs;
+  struct SREGS sregs;
+  
+  if (exception > 0x1f)
+  {
+    errno = EINVAL;
+    return (DOS_FAILURE);
+  }
+  segread (& sregs);
+  regs.e.eax = 0x203;
+  regs.e.ebx = exception;
+  regs.e.ecx = cs_selector;
+  regs.e.edx = code_offset;
+#ifdef _DOSEXCP_DEBUG
+  if (exception == DOS_EXCP_General_protection)
+  {
+    printf ("About to do int86x for excp %d.\n", DOS_EXCP_General_protection);
+    printf ("sregs.ds = 0x%04x; sregs.es = 0x%04x; sregs.fs = 0x%04x\n",
+            sregs.ds, sregs.es, sregs.fs);
+    printf ("sregs.gs = 0x%04x; sregs.ss = 0x%04x; sregs.cs = 0x%04x\n",
+            sregs.gs, sregs.ss, sregs.cs);
+    printf ("regs.e.eax = 0x%08x; regs.e.ebx = 0x%08x; regs.e.ecx = 0x%08x\n",
+            regs.e.eax, regs.e.ebx, regs.e.ecx);
+    printf ("regs.e.edx = 0x%08x\n", regs.e.edx);
+    fflush (stdout);
+    sleep (1);
+  }
+#endif
+  int86x (0x31, &regs, &regs, &sregs);
+  if ((regs.e.flags & 1) != 0)
+  {
+    errno = EINVAL;
+    return (DOS_FAILURE);
+  }
+  return (DOS_SUCCESS);
+}
+\f
+static void *
+make_DPMI_exception_trampoline (unsigned exception,
+                               void ((*funcptr)
+                                     (unsigned,
+                                      unsigned,
+                                      struct sigcontext *)),
+                               void * stack)
+{
+  void DPMI_exception_method (void);
+  void DPMI_GP_exception_method (void);
+  void * trampoline;
+  int size;
+  INSN_DECLS();
+
+  size = ((exception == DOS_EXCP_General_protection) ? 8 : 6);
+  trampoline = (malloc (TRAMP_SIZE (size)));
+  if (trampoline == ((void *) NULL))
+  {
+    errno = ENOMEM;
+    return ((void *) NULL);
+  }
+  
+  INIT_INSNS (trampoline);
+
+  PUSH_INSN (exception);
+  PUSH_INSN (getDS ());
+#if 0
+  PUSH_INSN (getCS ());
+#else
+  PUSH_INSN (0);               /* Use same CS and near calls and returns */
+#endif
+  PUSH_INSN (funcptr);
+  PUSH_INSN (getDS ());                /* Assumed to be on Heap if not null! */
+  PUSH_INSN (stack);
+  if (exception == DOS_EXCP_General_protection)
+  {
+    unsigned short previous_cs;
+    unsigned previous_eip;
+    
+    if ((DPMI_get_exception_vector (exception, & previous_cs, & previous_eip))
+       != DOS_SUCCESS)
+    {
+      free (trampoline);
+      errno = EACCES;
+      return ((void *) NULL);
+    }
+#ifdef _DOSEXCP_DEBUG
+    printf ("Previous CS = 0x%04x; Previous EIP = 0x%08x\n",
+           previous_cs, previous_eip);
+    printf ("Current CS = 0x%04x; Current SS = 0x%04x; Current DS = 0x%04x\n",
+           (getCS ()), (getSS ()), (getDS ()));
+    fflush (stdout);
+#endif
+    PUSH_INSN (previous_cs);
+    PUSH_INSN (previous_eip);
+    JMP_INSN (DPMI_GP_exception_method);
+  }
+  else
+    JMP_INSN (DPMI_exception_method);
+
+  HLT_INSNS (size);
+
+  return (trampoline);
+}
+
+int
+DPMI_set_exception_handler (unsigned exception,
+                           void ((*funcptr)
+                                 (unsigned,
+                                  unsigned,
+                                  struct sigcontext *)),
+                           void * stack)
+{
+  void * handler;
+  
+  if (exception > 0x1f)
+  {
+    errno = EINVAL;
+    return (DOS_FAILURE);
+  }
+  handler = (make_DPMI_exception_trampoline (exception, funcptr, stack));
+  if ((handler == ((void *) NULL))
+      || ((DPMI_set_exception_vector (exception,
+                                     (getCS ()),
+                                     ((unsigned) handler)))
+         != DOS_SUCCESS))
+  {
+    int saved_errno = errno;
+
+    if (handler != ((void *) NULL))
+      free (handler);
+    errno = saved_errno;
+    return (DOS_FAILURE);
+  }
+  return (DOS_SUCCESS);
+}
+
+/* This assumes that it is undoing the effects of DPMI_set_exception_handler */
+
+int
+DPMI_restore_exception_handler (unsigned exception,
+                               unsigned short cs_selector,
+                               unsigned code_offset)
+{
+  unsigned short current_cs;
+  unsigned current_eip;
+  
+  if (((DPMI_get_exception_vector (exception, & current_cs, & current_eip))
+       != DOS_SUCCESS)
+      || ((DPMI_set_exception_vector (exception, cs_selector, code_offset))
+         != DOS_SUCCESS))
+    return (DOS_FAILURE);
+  free ((void *) current_eip);
+  return (DOS_SUCCESS);
+}
diff --git a/v7/src/microcode/dosexcp.h b/v7/src/microcode/dosexcp.h
new file mode 100644 (file)
index 0000000..e186e32
--- /dev/null
@@ -0,0 +1,106 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosexcp.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef _DOSEXCP_H_
+#  define _DOSEXCP_H_
+\f
+#define NUM_DOS_EXCP                                   18
+
+#define DOS_INVALID_TRAP                               -1
+
+#define DOS_EXCP_Integer_divide_by_zero                        0
+#define DOS_EXCP_Debug_exception                       1
+#define DOS_EXCP_Non_maskable_interrupt                        2
+#define DOS_EXCP_Breakpoint                            3
+#define DOS_EXCP_Integer_overflow                      4
+#define DOS_EXCP_Bounds_check                          5
+#define DOS_EXCP_Invalid_opcode                                6
+#define DOS_EXCP_Numeric_co_processor_not_available    7
+#define DOS_EXCP_Double_fault                          8
+#define DOS_EXCP_Numeric_co_processor_segment_overrun  9
+  /* ^ can only occur on an FP-less chip (386 or 486SX). */
+#define DOS_EXCP_Invalid_TSS                           10
+#define DOS_EXCP_Segment_not_present                   11
+#define DOS_EXCP_Stack_exception                       12
+#define DOS_EXCP_General_protection                    13
+#define DOS_EXCP_Page_Fault                            14
+  /* 15 is reserved by Intel. */
+#define DOS_EXCP_Floating_point_exception              16
+#define DOS_EXCP_Alignment_check                       17
+  /* 18-31 are reserved by Intel. */
+
+struct sigcontext
+{
+  unsigned sc_eax;
+  unsigned sc_ecx;
+  unsigned sc_edx;
+  unsigned sc_ebx;
+  unsigned sc_esp;
+  unsigned sc_ebp;
+  unsigned sc_esi;
+  unsigned sc_edi;
+  unsigned sc_eip;
+  unsigned sc_eflags;
+  unsigned sc_cs;
+  unsigned sc_ss;
+  unsigned sc_ds;
+  unsigned sc_es;
+  unsigned sc_fs;
+  unsigned sc_gs;
+};
+
+extern int
+  DPMI_get_exception_vector (unsigned exception,
+                            unsigned short * cs_selector,
+                            unsigned * code_offset);
+
+extern int
+  DPMI_set_exception_vector (unsigned exception,
+                            unsigned short cs_selector,
+                            unsigned code_offset);
+
+extern int
+  DPMI_set_exception_handler (unsigned exception,
+                             void (*funcptr) (unsigned,
+                                              unsigned,
+                                              struct sigcontext *),
+                             void * stack);
+
+extern int
+  DPMI_restore_exception_handler (unsigned exception,
+                                 unsigned short cs_selector,
+                                 unsigned code_offset);
+                                 
+
+#endif /* _DOSEXCP_H_ */
diff --git a/v7/src/microcode/dosfg.c b/v7/src/microcode/dosfg.c
new file mode 100644 (file)
index 0000000..60662ef
--- /dev/null
@@ -0,0 +1,411 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosfg.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* Zortech 'Flash Graphics' primitives */
+
+#include "scheme.h"
+#include "prims.h"
+#include <fg.h>
+\f
+#define ARG_FG_COORD   arg_nonnegative_integer
+
+/* Internal state to emulate Starbase behaviour */
+typedef struct fg_state_struct
+{
+  fg_color_t color;
+  fg_color_t background;
+  fg_coord_t x;
+  fg_coord_t y;
+  fg_box_t clip;
+  int mode;
+  int line_type;
+  int mask;
+  int rotation;
+} fg_state_t;
+
+static fg_state_t current;
+
+/* This makes sure that the variables will not be changed unless
+   both args are of the right type.
+ */
+
+#define Get_Scheme_Coordinates(xp, x, yp, y)           \
+do                                                     \
+{ fg_coord_t _tmp_x, _tmp_y;                           \
+  _tmp_x = (ARG_FG_COORD(xp));                         \
+  _tmp_y = (ARG_FG_COORD(yp));                         \
+  (x) = _tmp_x, (y) = _tmp_y;                          \
+} while (0)
+
+\f
+DEFINE_PRIMITIVE ("FG-OPEN", Prim_fg_open, 0, 0,
+"Initializes the graphics display.")
+{
+  PRIMITIVE_HEADER (0);
+  {
+    if (fg_init() != 0)
+    {
+      current.color    = FG_WHITE;
+      current.background= FG_BLACK;
+      current.line_type        = FG_LINE_SOLID;
+      current.mode     = FG_MODE_SET;
+      current.rotation = FG_ROT0;
+      current.mask     = (int) (~0);
+      current.x        = (fg_coord_t) 0;
+      current.y        = (fg_coord_t) 0;
+      
+      fg_box_cpy(current.clip, fg.displaybox);
+#if 0      
+      { int i;
+       for (i=1000000L; i > 0; i--);
+      }
+#endif      
+      PRIMITIVE_RETURN (SHARP_T);
+    }
+    else
+      PRIMITIVE_RETURN (SHARP_F);
+  }
+}
+
+DEFINE_PRIMITIVE ("FG-CLOSE", Prim_fg_close, 0, 0,
+"Closes the graphics device.")
+{
+  PRIMITIVE_HEADER (0);
+  fg_term();
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-CLEAR", Prim_fg_clear, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  fg_fillbox(current.background, current.mode, current.mask, fg.displaybox);
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-DRAW-POINT", Prim_fg_draw_point, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  { 
+    Get_Scheme_Coordinates(1, current.x, 2, current.y);
+
+    if (fg_pt_inbox(current.clip, current.x, current.y))
+      fg_drawdot(current.color, current.mode, current.mask,
+                current.x, current.y);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+\f
+DEFINE_PRIMITIVE ("FG-MOVE-CURSOR", Prim_fg_move_cursor, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  {     
+    Get_Scheme_Coordinates(1, current.x, 2, current.y);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-DRAG-CURSOR", Prim_fg_drag_cursor, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  { fg_coord_t x, y;
+    fg_line_t line, cline;
+
+    Get_Scheme_Coordinates(1, x, 2, y);
+
+    fg_make_line(line, current.x, current.y, x, y);
+    (void) fg_lineclip(current.clip, line, cline);
+    fg_drawline(current.color, current.mode, current.mask,
+               current.line_type, cline);
+    current.x = x, current.y = y;
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-DRAW-LINE", Prim_fg_draw_line, 4, 4, 0)
+{
+  PRIMITIVE_HEADER (4);
+  { fg_coord_t x, y;
+    fg_line_t line, cline;
+
+    Get_Scheme_Coordinates(1, x, 2, y);
+    Get_Scheme_Coordinates(3, current.x, 4, current.y);
+
+    fg_make_line(line, x, y, current.x, current.y);
+    (void) fg_lineclip(current.clip, line, cline);
+    fg_drawline(current.color, current.mode, current.mask,
+               current.line_type, cline);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+\f
+DEFINE_PRIMITIVE ("FG-SET-LINE-STYLE", Prim_fg_set_line_style, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  current.line_type = (int) arg_index_integer(1, FG_LINE_MAX);
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-SET-DRAWING-MODE", Prim_fg_set_drawing_mode, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  { int mode = (int) arg_index_integer(1, 2);
+    
+    current.mode = (mode == 0) ? FG_MODE_SET : FG_MODE_XOR;
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-DEVICE-COORDINATES", Prim_fg_device_coordinates, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  { SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 4, true));
+
+    VECTOR_SET (result, 0, long_to_integer(fg.displaybox[FG_X1]));
+    VECTOR_SET (result, 1, long_to_integer(fg.displaybox[FG_Y1]));
+    VECTOR_SET (result, 2, long_to_integer(fg.displaybox[FG_X2])); 
+    VECTOR_SET (result, 3, long_to_integer(fg.displaybox[FG_Y2]));
+
+    PRIMITIVE_RETURN (result);
+  }
+}
+
+DEFINE_PRIMITIVE ("FG-RESET-CLIP-RECTANGLE", Prim_fg_reset_clip_rectangle,
+                 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  {
+    fg_box_cpy(current.clip, fg.displaybox);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-SET-CLIP-RECTANGLE", Prim_fg_set_clip_rectangle, 4, 4, 0)
+{
+  PRIMITIVE_HEADER (4);
+  { fg_coord_t x1, y1, x2, y2;
+    
+    Get_Scheme_Coordinates(1, x1, 2, y1);
+    Get_Scheme_Coordinates(1, x2, 2, y2);
+
+    if (fg_pt_inbox(fg.displaybox, x1, y1) == 0)
+      error_bad_range_arg(1);
+    if (fg_pt_inbox(fg.displaybox, x1, y1) == 0)
+      error_bad_range_arg(3);
+    
+    current.clip[FG_X1] = x1;
+    current.clip[FG_Y1] = y1;
+    current.clip[FG_X2] = x2;
+    current.clip[FG_Y2] = y2;
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+\f
+DEFINE_PRIMITIVE ("FG-DRAW-TEXT", Prim_fg_draw_text, 3, 3,
+  "(FG-DRAW-TEXT DEVICE X Y STRING)")
+{
+  PRIMITIVE_HEADER (3);
+  {
+    fg_coord_t x, y;
+    unsigned char * string = STRING_ARG(3);
+
+    Get_Scheme_Coordinates(1, x, 2, y);
+    fg_puts(current.color, current.mode, current.mask,
+           current.rotation, x, y, string, current.clip);
+  }    
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-SET-TEXT-ROTATION", Prim_fg_set_text_rotation, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  {
+    long angle = ((long) (arg_real_number (1))) % 360;
+    int path_style = FG_ROT0;
+
+    if ((angle > 315) || (angle <=  45))
+      path_style = FG_ROT0;
+    else if ((angle > 45) && (angle <= 135))
+      path_style = FG_ROT90;
+    else if ((angle > 135) && (angle <= 225))
+      path_style = FG_ROT180;
+    else if ((angle > 225) && (angle <= 315))
+      path_style = FG_ROT270;
+    
+    current.rotation = path_style;
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+\f
+DEFINE_PRIMITIVE ("FG-COLOR-MAP-SIZE", Prim_fg_color_map_size, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (long_to_integer (fg.ncolormap));
+}
+
+DEFINE_PRIMITIVE ("FG-DEFINE-COLOR", Prim_fg_define_color, 4, 4,
+  "(FG-DEFINE-COLOR COLOR-INDEX RED GREEN BLUE)")
+{
+  PRIMITIVE_HEADER (4);
+  {
+    fg_color_t index, r, g, b;
+    
+    index = arg_index_integer(1, fg.ncolormap);
+    r = arg_real_number(2);
+    g = arg_real_number(3);
+    b = arg_real_number(4);
+
+    fg_setpalette(index, r, g, b);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("FG-SET-LINE-COLOR", Prim_fg_set_line_color, 2, 2,
+  "(FG-SET-LINE-COLOR COLOR-INDEX)")
+{
+  PRIMITIVE_HEADER (1);
+  current.color = arg_index_integer(1, fg.ncolormap);
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+\f
+#if 0
+/* Graphics Screen Dump */
+
+static void print_graphics ();
+
+UNDEFINE_PRIMITIVE ("FG-WRITE-IMAGE-FILE", Prim_fg_write_image_file, 3, 3,
+  "(FG-WRITE-IMAGE-FILE DEVICE FILENAME INVERT?)\n\
+Write a file containing an image of the DEVICE's screen, in a format\n\
+suitable for printing on an HP laserjet printer.\n\
+If INVERT? is not #F, invert black and white in the output.")
+{
+  PRIMITIVE_HEADER (3);
+  print_graphics ((SB_DEVICE_ARG (1)), (STRING_ARG (2)), (BOOLEAN_ARG (3)));
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+static char rasres[] = "\033*t100R";
+static char rastop[] = "\033&l2E";
+static char raslft[] = "\033&a2L";
+static char rasbeg[] = "\033*r0A";
+static char raslen[] = "\033*b96W";
+static char rasend[] = "\033*rB";
+
+static int
+inquire_cmap_mask (fildes)
+     int fildes;
+{
+  int cmap_size = (inquire_cmap_size (fildes));
+  return
+    (((cmap_size >= 0) && (cmap_size < 8))
+     ? ((1 << cmap_size) - 1)
+     : (-1));
+}
+
+static int
+open_dumpfile (dumpname)
+  char * dumpname;
+{
+  int dumpfile = (creat (dumpname, 0666));
+  if (dumpfile == (-1))
+    {
+      fprintf (stderr, "\nunable to create graphics dump file.");
+      fflush (stderr);
+      error_external_return ();
+    }
+  dumpfile = (open (dumpname, OUTINDEV));
+  if (dumpfile == (-1))
+    {
+      fprintf (stderr, "\nunable to open graphics dump file.");
+      fflush (stderr);
+      error_external_return ();
+    }
+  return (dumpfile);
+}
+\f
+static void
+print_graphics (descriptor, dumpname, inverse_p)
+     int descriptor;
+     char * dumpname;
+     int inverse_p;
+{
+  int dumpfile = (open_dumpfile (dumpname));
+  write (dumpfile, rasres, (strlen (rasres)));
+  write (dumpfile, rastop, (strlen (rastop)));
+  write (dumpfile, raslft, (strlen (raslft)));
+  write (dumpfile, rasbeg, (strlen (rasbeg)));
+  {
+    fast unsigned char mask = (inquire_cmap_mask (descriptor));
+    int col;
+    for (col = (1024 - 16); (col >= 0); col = (col - 16))
+      {
+       unsigned char pixdata [(16 * 768)];
+       {
+         fast unsigned char * p = (& (pixdata [0]));
+         fast unsigned char * pe = (& (pixdata [sizeof (pixdata)]));
+         while (p < pe)
+           (*p++) = '\0';
+       }
+       dcblock_read (descriptor, col, 0, 16, 768, pixdata, 0);
+       {
+         int x;
+         for (x = (16 - 1); (x >= 0); x -= 1)
+           {
+             unsigned char rasdata [96];
+             fast unsigned char * p = (& (pixdata [x]));
+             fast unsigned char * r = rasdata;
+             int n;
+             for (n = 0; (n < 96); n += 1)
+               {
+                 fast unsigned char c = 0;
+                 int nn;
+                 for (nn = 0; (nn < 8); nn += 1)
+                   {
+                     c <<= 1;
+                     if (((* p) & mask) != 0)
+                       c |= 1;
+                     p += 16;
+                   }
+                 (*r++) = (inverse_p ? (~ c) : c);
+               }
+             write (dumpfile, raslen, (strlen (raslen)));
+             write (dumpfile, rasdata, 96);
+           }
+       }
+      }
+  }
+  write (dumpfile, rasend, (strlen (rasend)));
+  close (dumpfile);
+  return;
+}
+#endif
diff --git a/v7/src/microcode/dosfile.c b/v7/src/microcode/dosfile.c
new file mode 100644 (file)
index 0000000..24ada86
--- /dev/null
@@ -0,0 +1,183 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosfile.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "osfile.h"
+#include "dosio.h"
+
+extern void EXFUN (terminal_open, (Tchannel channel));
+\f
+static enum channel_type
+DEFUN (fd_channel_type, (fd), int fd)
+{
+  struct stat stat_buf;
+  if ((DOS_fstat (fd, (&stat_buf))) < 0)
+    return (channel_type_unknown);
+  {
+    mode_t type = ((stat_buf . st_mode) & S_IFMT);
+    return
+      ((type == S_IFREG) ? channel_type_file
+       : (type == S_IFCHR)
+       ? ((isatty (fd))
+         ? channel_type_terminal
+         : channel_type_character_device)
+#ifdef S_IFIFO
+       : (type == S_IFIFO) ? channel_type_fifo
+#endif
+#ifdef S_IFBLK
+       : (type == S_IFBLK) ? channel_type_block_device
+#endif
+       : (type == S_IFDIR) ? channel_type_directory
+       : channel_type_unknown);
+  }
+}
+
+Tchannel
+DEFUN (OS_open_fd, (fd), int fd)
+{
+  enum channel_type type = (fd_channel_type (fd));
+  Tchannel channel;
+  MAKE_CHANNEL (fd, type, channel =);
+
+  /* Like Unix, all terminals initialize to cooked mode. */
+  if (type == channel_type_terminal) CHANNEL_COOKED(channel) = 1;
+
+  return (channel);
+}
+
+static Tchannel
+DEFUN (open_file, (filename, oflag), CONST char * filename AND int oflag)
+{
+  int fd;
+  STD_UINT_SYSTEM_CALL
+    (syscall_open, fd, (DOS_open (filename, oflag, MODE_REG)));
+  return (OS_open_fd (fd));
+}
+
+#define DEFUN_OPEN_FILE(name, oflag)                                   \
+Tchannel                                                               \
+DEFUN (name, (filename), CONST char * filename)                                \
+{                                                                      \
+  return (open_file (filename, oflag));                                        \
+}
+
+DEFUN_OPEN_FILE (OS_open_input_file, O_RDONLY)
+DEFUN_OPEN_FILE (OS_open_output_file, (O_WRONLY | O_CREAT | O_TRUNC))
+DEFUN_OPEN_FILE (OS_open_io_file, (O_RDWR | O_CREAT))
+
+#ifdef HAVE_APPEND
+
+DEFUN_OPEN_FILE (OS_open_append_file, (O_WRONLY | O_CREAT | O_APPEND))
+
+#else
+
+Tchannel
+DEFUN (OS_open_append_file, (filename), CONST char * filename)
+{
+  error_unimplemented_primitive ();
+  return (0);
+}
+
+#endif
+\f
+static Tchannel
+DEFUN (make_load_channel, (fd), int fd)
+{
+  enum channel_type type = (fd_channel_type (fd));
+  if ((type == channel_type_terminal)
+      || (type == channel_type_directory)
+      || (type == channel_type_unknown))
+    return (NO_CHANNEL);
+  MAKE_CHANNEL (fd, type, return);
+}
+
+Tchannel
+DEFUN (OS_open_load_file, (filename), CONST char * filename)
+{
+  while (1)
+    {
+      int fd = (DOS_open (filename, O_RDONLY, MODE_REG));
+      if (fd >= 0)
+       return (make_load_channel (fd));
+      if (errno != EINTR)
+       return (NO_CHANNEL);
+    }
+}
+
+Tchannel
+DEFUN (OS_open_dump_file, (filename), CONST char * filename)
+{
+  while (1)
+    {
+      int fd = (DOS_open (filename, (O_WRONLY | O_CREAT | O_TRUNC), MODE_REG));
+      if (fd >= 0)
+       return (make_load_channel (fd));
+      if (errno != EINTR)
+       return (NO_CHANNEL);
+    }
+}
+
+off_t
+DEFUN (OS_file_length, (channel), Tchannel channel)
+{
+  struct stat stat_buf;
+  STD_VOID_SYSTEM_CALL
+    (syscall_fstat, (DOS_fstat ((CHANNEL_DESCRIPTOR (channel)), (&stat_buf))));
+  return (stat_buf . st_size);
+}
+
+off_t
+DEFUN (OS_file_position, (channel), Tchannel channel)
+{
+  off_t result;
+  STD_UINT_SYSTEM_CALL
+    (syscall_lseek,
+     result,
+     (DOS_lseek ((CHANNEL_DESCRIPTOR (channel)), 0L, SEEK_CUR)));
+  return (result);
+}
+
+void
+DEFUN (OS_file_set_position, (channel, position),
+       Tchannel channel AND
+       off_t position)
+{
+  off_t result;
+  STD_UINT_SYSTEM_CALL
+    (syscall_lseek,
+     result,
+     (DOS_lseek ((CHANNEL_DESCRIPTOR (channel)), position, SEEK_SET)));
+  if (result != position)
+    error_external_return ();
+}
diff --git a/v7/src/microcode/dosfs.c b/v7/src/microcode/dosfs.c
new file mode 100644 (file)
index 0000000..61bebba
--- /dev/null
@@ -0,0 +1,278 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosfs.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "osfs.h"
+\f
+int
+DEFUN (DOS_read_file_status, (name, s),
+       CONST char * name AND
+       struct stat * s)
+{ char filename[128];
+
+  dos_pathname_as_filename(name, filename);
+  
+  while ((stat (filename, s)) < 0)
+    {
+      if (errno == EINTR)
+       continue;
+      if ((errno == ENOENT) || (errno == ENOTDIR))
+       return (0);
+      error_system_call (errno, syscall_lstat);
+    }
+  return (1);
+}
+
+enum file_existence
+DEFUN (OS_file_existence_test, (name), char * name)
+{
+  struct stat s;
+  char filename[128];
+  dos_pathname_as_filename(name, filename);
+  
+  return
+    (((DOS_stat (filename, (&s))) < 0)
+     ? file_doesnt_exist : file_does_exist);
+}
+
+int
+DEFUN (OS_file_access, (name, mode), CONST char * name AND unsigned int mode)
+{
+  char filename[128];
+  dos_pathname_as_filename(name, filename);
+  return ((DOS_access (filename, mode)) == 0);
+}
+
+int
+DEFUN (OS_file_directory_p, (name), char * name)
+{      
+  struct stat s;
+  char filename[128];
+  dos_pathname_as_filename(name, filename);
+  return (((DOS_stat (filename, (&s))) == 0) &&
+         (((s . st_mode) & S_IFMT) == S_IFDIR));
+}
+
+CONST char *
+DEFUN (OS_file_soft_link_p, (name), CONST char * name)
+{
+  return (0);
+}
+
+void
+DEFUN (OS_file_remove, (name), CONST char * name)
+{
+  STD_VOID_SYSTEM_CALL (syscall_unlink, (DOS_unlink (name)));
+}
+
+void
+DEFUN (OS_file_remove_link, (name), CONST char * name)
+{
+  struct stat s;
+  if ( (DOS_stat (name, (&s)) == 0) &&
+       (((s . st_mode) & S_IFMT) == S_IFREG) )
+   DOS_unlink (name);
+  return;
+}
+
+void
+DEFUN (OS_file_link_hard, (from_name, to_name),
+       CONST char * from_name AND
+       CONST char * to_name)
+{
+  error_unimplemented_primitive ();
+}
+
+void
+DEFUN (OS_file_link_soft, (from_name, to_name),
+       CONST char * from_name AND
+       CONST char * to_name)
+{
+  error_unimplemented_primitive ();
+}
+\f
+void
+DEFUN (OS_file_rename, (from_name, to_name),
+       CONST char * from_name AND
+       CONST char * to_name)
+{
+  if ((rename (from_name, to_name)) != 0)
+    error_system_call (errno, syscall_rename);
+}
+
+void
+DEFUN (OS_directory_make, (name), CONST char * name)
+{
+  STD_VOID_SYSTEM_CALL (syscall_mkdir, (DOS_mkdir (name)));
+}
+\f
+/* This is such that directory open does not return the first file */
+typedef struct DIR_struct
+{ struct FIND *entry;
+  char pathname[13];
+} DIR;
+
+#define Get_Directory_Entry_Name(entry, pathname)              \
+  (strcpy(pathname, (entry)->name), strlwr(pathname))
+
+int OS_directory_index;
+
+static DIR ** directory_pointers;
+static unsigned int n_directory_pointers;
+
+void
+DEFUN_VOID (DOS_initialize_directory_reader)
+{
+  directory_pointers = 0;
+  n_directory_pointers = 0;
+  OS_directory_index = (-1);
+}
+
+static unsigned int
+DEFUN (allocate_directory_pointer, (pointer), DIR * pointer)
+{
+  if (n_directory_pointers == 0)
+    {
+      DIR ** pointers = ((DIR **) (DOS_malloc ((sizeof (DIR *)) * 4)));
+      if (pointers == 0)
+       error_system_call (ENOMEM, syscall_malloc);
+      directory_pointers = pointers;
+      n_directory_pointers = 4;
+      {
+       DIR ** scan = directory_pointers;
+       DIR ** end = (scan + n_directory_pointers);
+       (*scan++) = pointer;
+       while (scan < end)
+         (*scan++) = 0;
+      }
+      return (0);
+    }
+  {
+    DIR ** scan = directory_pointers;
+    DIR ** end = (scan + n_directory_pointers);
+    while (scan < end)
+      if ((*scan++) == 0)
+       {
+         (*--scan) = pointer;
+         return (scan - directory_pointers);
+       }
+  }
+  {
+    unsigned int result = n_directory_pointers;
+    unsigned int n_pointers = (2 * n_directory_pointers);
+    DIR ** pointers =
+      ((DIR **)
+       (DOS_realloc (((PTR) directory_pointers),
+                   ((sizeof (DIR *)) * n_pointers))));
+    if (pointers == 0)
+      error_system_call (ENOMEM, syscall_realloc);
+    {
+      DIR ** scan = (pointers + result);
+      DIR ** end = (pointers + n_pointers);
+      (*scan++) = pointer;
+      while (scan < end)
+       (*scan++) = 0;
+    }
+    directory_pointers = pointers;
+    n_directory_pointers = n_pointers;
+    return (result);
+  }
+}
+
+#define REFERENCE_DIRECTORY(index) (directory_pointers[(index)])
+#define DEALLOCATE_DIRECTORY(index) ((directory_pointers[(index)]) = 0)
+
+int
+DEFUN (OS_directory_valid_p, (index), long index)
+{
+  return
+    ((0 <= index)
+     && (index < n_directory_pointers)
+     && ((REFERENCE_DIRECTORY (index)) != 0));
+}
+\f
+unsigned int
+DEFUN (OS_directory_open, (name), CONST char * name)
+{ 
+  char filename[128], searchname[128];
+  struct FIND *entry;
+  DIR * pointer = malloc(sizeof(DIR));
+  
+  if (pointer == 0)
+    error_system_call (ENOMEM, syscall_malloc);
+
+  if (dos_pathname_as_filename(name, filename))
+    sprintf(searchname, "%s*.*", filename);
+  else
+    sprintf(searchname, "%s\\*.*", filename);
+
+  if ((entry = findfirst(searchname, FA_DIREC)) == 0)
+    error_system_call (errno, syscall_opendir);
+  
+  pointer->entry = entry;
+  return (allocate_directory_pointer (pointer));
+}
+
+CONST char *
+DEFUN (OS_directory_read, (index), unsigned int index)
+{ DIR * pointer = REFERENCE_DIRECTORY (index);
+  if (pointer->entry == 0)
+    return 0;
+
+  Get_Directory_Entry_Name(pointer->entry, pointer->pathname);
+  pointer->entry = findnext();
+  return (pointer -> pathname);
+}
+
+CONST char *
+DEFUN (OS_directory_read_matching, (index, prefix),
+       unsigned int index AND
+       CONST char * prefix)
+{
+  error_unimplemented_primitive ();
+  return (0);
+}
+
+void
+DEFUN (OS_directory_close, (index), unsigned int index)
+{ DIR * pointer = REFERENCE_DIRECTORY (index);
+
+  free(pointer);
+  DEALLOCATE_DIRECTORY (index);
+}
+
+
diff --git a/v7/src/microcode/dosinsn.h b/v7/src/microcode/dosinsn.h
new file mode 100644 (file)
index 0000000..286e0ee
--- /dev/null
@@ -0,0 +1,93 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosinsn.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef _DOSINSN_H_
+#  define _DOSINSN_H_
+\f
+extern unsigned short getCS (void);
+extern unsigned short getDS (void);
+extern unsigned short getSS (void);
+extern void farcpy (unsigned dst_off, unsigned dst_sel,
+                   unsigned src_off, unsigned src_sel,
+                   unsigned size);
+
+#define TRAMP_SIZE(npush)      (4 * ((3 + (7 + (5 * npush))) / 4))
+
+#define INSN_DECLS()                                   \
+  unsigned short getCS (void);                         \
+  unsigned char * startptr;                            \
+  unsigned char * byteptr;                             \
+  unsigned short * wordptr;                            \
+  unsigned long * dwordptr
+
+#define INIT_INSNS(store)                              \
+do {                                                   \
+  startptr = ((unsigned char *) (store));              \
+  byteptr = startptr;                                  \
+} while (0)
+
+#define PUSH_INSN(value)                               \
+do {                                                   \
+  *byteptr++ = 0x68;                                   \
+  dwordptr = ((unsigned long *) byteptr);              \
+  *dwordptr++ = ((unsigned long) (value));             \
+  byteptr = ((unsigned char *) dwordptr);              \
+} while (0)
+
+#define JMP_INSN(value)                                        \
+do {                                                   \
+  *byteptr++ = 0xea;                                   \
+  dwordptr = ((unsigned long *) byteptr);              \
+  *dwordptr++ = ((unsigned long) (value));             \
+  wordptr = ((unsigned short *) dwordptr);             \
+  *wordptr++ = (getCS ());                             \
+  byteptr = ((unsigned char *) wordptr);               \
+} while (0)
+
+#define FRET_INSN()                                    \
+do {                                                   \
+  *byteptr++ = 0xcb;                                   \
+} while (0)
+
+/* pad with HLT to end (on dword bdry.) */
+
+#define HLT_INSNS(npush)                               \
+do {                                                   \
+  unsigned char * endptr =                             \
+    (startptr + (TRAMP_SIZE (npush)));                 \
+  while (byteptr < endptr)                             \
+    *byteptr++ = 0xf4;                                 \
+} while (0)
+
+#endif /* _DOSINSN_H_ */
diff --git a/v7/src/microcode/dosio.c b/v7/src/microcode/dosio.c
new file mode 100644 (file)
index 0000000..7429946
--- /dev/null
@@ -0,0 +1,498 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosio.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "dosio.h"
+#include "osterm.h"
+
+#ifdef __STDC__
+#define fileno(fp)     ((fp)->_file)
+#endif
+\f
+size_t OS_channel_table_size;
+struct channel * channel_table;
+
+unsigned int OS_channels_registered;
+
+static void
+DEFUN_VOID (DOS_channel_close_all)
+{
+  Tchannel channel;
+  for (channel = 0; (channel < OS_channel_table_size); channel += 1)
+    if (CHANNEL_OPEN_P (channel))
+      OS_channel_close_noerror (channel);
+}
+
+void
+DEFUN_VOID (DOS_initialize_channels)
+{
+  OS_channel_table_size = (DOS_SC_OPEN_MAX ());
+  channel_table =
+    (DOS_malloc (OS_channel_table_size * (sizeof (struct channel))));
+  if (channel_table == 0)
+    {
+      fprintf (stderr, "\nUnable to allocate channel table.\n");
+      fflush (stderr);
+      termination_init_error ();
+    }
+  {
+    Tchannel channel;
+    for (channel = 0; (channel < OS_channel_table_size); channel += 1)
+      MARK_CHANNEL_CLOSED (channel);
+  }
+  add_reload_cleanup (DOS_channel_close_all);
+  OS_channels_registered = 0;
+}
+
+void
+DEFUN_VOID (DOS_reset_channels)
+{
+  DOS_free (channel_table);
+  channel_table = 0;
+  OS_channel_table_size = 0;
+}
+
+Tchannel
+DEFUN_VOID (channel_allocate)
+{
+  Tchannel channel = 0;
+  while (1)
+    {
+      if (channel == OS_channel_table_size)
+       error_out_of_channels ();
+      if (CHANNEL_CLOSED_P (channel))
+       return (channel);
+      channel += 1;
+    }
+}
+\f
+int
+DEFUN (OS_channel_open_p, (channel), Tchannel channel)
+{
+  return (CHANNEL_OPEN_P (channel));
+}
+
+void
+DEFUN (OS_channel_close, (channel), Tchannel channel)
+{
+  if (! (CHANNEL_INTERNAL (channel)))
+    {
+      if (CHANNEL_REGISTERED (channel))
+       OS_channel_unregister (channel);
+      STD_VOID_SYSTEM_CALL
+       (syscall_close, (DOS_close (CHANNEL_DESCRIPTOR (channel))));
+      MARK_CHANNEL_CLOSED (channel);
+    }
+}
+
+void
+DEFUN (OS_channel_close_noerror, (channel), Tchannel channel)
+{
+  if (! (CHANNEL_INTERNAL (channel)))
+    {
+      if (CHANNEL_REGISTERED (channel))
+       OS_channel_unregister (channel);
+      DOS_close (CHANNEL_DESCRIPTOR (channel));
+      MARK_CHANNEL_CLOSED (channel);
+    }
+}
+
+static void
+DEFUN (channel_close_on_abort_1, (cp), PTR cp)
+{
+  OS_channel_close (* ((Tchannel *) cp));
+}
+
+void
+DEFUN (OS_channel_close_on_abort, (channel), Tchannel channel)
+{
+  Tchannel * cp = (dstack_alloc (sizeof (Tchannel)));
+  (*cp) = (channel);
+  transaction_record_action (tat_abort, channel_close_on_abort_1, cp);
+}
+
+enum channel_type
+DEFUN (OS_channel_type, (channel), Tchannel channel)
+{
+  return (CHANNEL_TYPE (channel));
+}
+\f
+void
+DEFUN (OS_terminal_flush_input, (channel), Tchannel channel)
+{ extern void EXFUN (flush_conio_buffers, (void));
+
+  if ((CHANNEL_DESCRIPTOR (channel)) == (fileno (stdin)))
+    flush_conio_buffers();
+  return;
+}
+
+void
+DEFUN (OS_terminal_flush_output, (channel), Tchannel channel)
+{
+  return;
+}
+
+void
+DEFUN (OS_terminal_drain_output, (channel), Tchannel channel)
+{
+  return;
+}
+
+DEFUN (dos_channel_read, (channel, buffer, nbytes),
+       Tchannel channel AND PTR buffer AND size_t nbytes)
+{
+  if (nbytes == 0)
+    return 0;
+  else if (CHANNEL_DESCRIPTOR (channel) == fileno(stdin))
+    return console_read(buffer, nbytes, 
+                       CHANNEL_BUFFERED(channel), CHANNEL_BLOCKING_P(channel));
+  else
+    return DOS_read ((CHANNEL_DESCRIPTOR (channel)), buffer, nbytes);
+}
+
+long
+DEFUN (OS_channel_read, (channel, buffer, nbytes),
+       Tchannel channel AND PTR buffer AND size_t nbytes)
+{
+  while (1)
+  {
+    long scr = dos_channel_read(channel, buffer, nbytes);    
+    if (scr < 0)
+    {
+      if (errno == ERRNO_NONBLOCK)
+       return -1;
+      DOS_prim_check_errno (syscall_read);
+      continue;
+    }
+    else if (scr > nbytes)
+      error_external_return ();
+    else
+      return (scr);
+  }
+}
+\f
+static int
+DEFUN (dos_write, (fd, buffer, nbytes),
+       int fd AND CONST unsigned char * buffer AND size_t nbytes)
+{
+  return ( (fd == fileno(stdout))
+          ? dos_console_write(buffer, nbytes)
+          : write(fd, buffer, nbytes) );
+}
+
+#define Syscall_Write(fd, buffer, size, so_far)                \
+do                                                     \
+{ size_t _size = (size);                               \
+  int _written;                                                \
+  _written = dos_write((fd), (buffer), (_size));       \
+  if (_size != _written)                               \
+    return ((_written < 0) ? -1 : (so_far) + _written); \
+} while (0)
+
+long
+DEFUN (text_write, (fd, buffer, nbytes),
+       int fd AND CONST unsigned char * buffer AND size_t nbytes)
+{ /* Map LF to CR/LF */
+  static CONST unsigned char crlf[] = {CARRIAGE_RETURN, LINEFEED};
+  CONST unsigned char *start;
+  size_t i;
+
+  for (i=0, start=buffer; i < nbytes; start = &buffer[i])
+  { size_t len;
+
+    while ((i < nbytes)&&(buffer[i] != LINEFEED)) i++;
+    len = (&buffer[i] - start);
+
+    Syscall_Write(fd, start, len, (i - len));
+
+    if ((i < nbytes)&&(buffer[i] == LINEFEED))
+    { /* We are sitting on a linefeed. Write out CRLF */
+      /* This backs out incorrectly if only CR is written out */
+      Syscall_Write(fd, crlf, sizeof(crlf), i);
+      i = i + 1; /* Skip over special character */
+    }
+  }
+
+  return nbytes;
+}
+
+#undef Syscall_Write
+
+long
+DEFUN (OS_channel_write, (channel, buffer, nbytes),
+       Tchannel channel AND CONST PTR buffer AND size_t nbytes)
+{
+  if (nbytes == 0) return (0);
+
+  while (1)
+  { int fd, scr;
+
+    fd = CHANNEL_DESCRIPTOR(channel);
+    scr = ((CHANNEL_COOKED(channel))
+          ? text_write(fd, buffer, nbytes)
+          : dos_write(fd, buffer, nbytes));
+             
+    if (scr < 0)
+    {
+      DOS_prim_check_errno (syscall_write);
+      continue;
+    }
+
+    if (scr > nbytes)
+      error_external_return ();
+    return scr;
+  }
+}
+
+\f
+size_t
+DEFUN (OS_channel_read_load_file, (channel, buffer, nbytes),
+       Tchannel channel AND PTR buffer AND size_t nbytes)
+{
+  int scr;
+  scr = (DOS_read ((CHANNEL_DESCRIPTOR (channel)), buffer, nbytes));
+  return ((scr < 0) ? 0 : scr);
+}
+
+size_t
+DEFUN (OS_channel_write_dump_file, (channel, buffer, nbytes),
+       Tchannel channel AND CONST PTR buffer AND size_t nbytes)
+{
+  int scr = (DOS_write ((CHANNEL_DESCRIPTOR (channel)), buffer, nbytes));
+  return ((scr < 0) ? 0 : scr);
+}
+
+void
+DEFUN (OS_channel_write_string, (channel, string),
+       Tchannel channel AND
+       CONST char * string)
+{
+  unsigned long length = (strlen (string));
+  if ((OS_channel_write (channel, string, length)) != length)
+    error_external_return ();
+}
+
+void
+DEFUN (OS_make_pipe, (readerp, writerp),
+       Tchannel * readerp AND
+       Tchannel * writerp)
+{
+  return;
+}
+\f
+int
+DEFUN (OS_channel_nonblocking_p, (channel), Tchannel channel)
+{
+  return (CHANNEL_NONBLOCKING (channel));
+}
+
+void
+DEFUN (OS_channel_nonblocking, (channel), Tchannel channel)
+{
+  (CHANNEL_NONBLOCKING (channel)) = 1;
+  return;
+}
+
+void
+DEFUN (OS_channel_blocking, (channel), Tchannel channel)
+{
+  (CHANNEL_NONBLOCKING (channel)) = 0;
+}
+
+int
+DEFUN (OS_terminal_buffered_p, (channel), Tchannel channel)
+{
+  return (CHANNEL_BUFFERED(channel));
+}
+
+void
+DEFUN (OS_terminal_buffered, (channel), Tchannel channel)
+{
+  CHANNEL_BUFFERED(channel) = 1;
+}
+
+void
+DEFUN (OS_terminal_nonbuffered, (channel), Tchannel channel)
+{
+  CHANNEL_BUFFERED(channel) = 0;
+}
+
+int
+DEFUN (OS_terminal_cooked_output_p, (channel), Tchannel channel)
+{
+  return (CHANNEL_COOKED(channel));
+}
+
+void
+DEFUN (OS_terminal_cooked_output, (channel), Tchannel channel)
+{
+  CHANNEL_COOKED(channel) = 1;
+}
+
+void
+DEFUN (OS_terminal_raw_output, (channel), Tchannel channel)
+{
+  CHANNEL_COOKED(channel) = 0;
+}
+\f
+unsigned int
+DEFUN (arg_baud_index, (argument), unsigned int argument)
+{
+  return (arg_index_integer (argument, 1));
+}
+
+unsigned long
+DEFUN (OS_terminal_get_ispeed, (channel), Tchannel channel)
+{
+  return (0);
+}
+
+unsigned long
+DEFUN (OS_terminal_get_ospeed, (channel), Tchannel channel)
+{
+  return (0);
+}
+
+unsigned int
+DEFUN (OS_baud_index_to_rate, (index), unsigned int index)
+{
+  return (9600);
+}
+
+int
+DEFUN (OS_baud_rate_to_index, (rate), unsigned int rate)
+{
+  return ((rate == 9600) ? 0 : -1);
+}
+
+unsigned int
+DEFUN_VOID (OS_terminal_state_size)
+{
+  return (3);
+}
+
+void
+DEFUN (OS_terminal_get_state, (channel, state_ptr),
+       Tchannel channel AND PTR state_ptr)
+{
+  unsigned char *statep = (unsigned char *) state_ptr;
+
+  *statep++ = CHANNEL_NONBLOCKING(channel);
+  *statep++ = CHANNEL_BUFFERED(channel);
+  *statep   = CHANNEL_COOKED(channel);
+  
+  return;
+}
+
+void
+DEFUN (OS_terminal_set_state, (channel, state_ptr),
+       Tchannel channel AND PTR state_ptr)
+{
+  unsigned char *statep = (unsigned char *) state_ptr;
+
+  CHANNEL_NONBLOCKING(channel) = *statep++;
+  CHANNEL_BUFFERED(channel)    = *statep++;
+  CHANNEL_COOKED(channel)      = *statep;
+  
+  return;
+}
+
+#ifndef FALSE
+#  define FALSE 0
+#endif
+
+int
+DEFUN_VOID (OS_job_control_p)
+{
+  return (FALSE);
+}
+
+int
+DEFUN_VOID (OS_have_ptys_p)
+{
+  return (FALSE);
+}
+\f
+int
+DEFUN (OS_channel_registered_p, (channel), Tchannel channel)
+{
+  return (CHANNEL_REGISTERED (channel));
+}
+
+void
+DEFUN (OS_channel_register, (channel), Tchannel channel)
+{
+  error_unimplemented_primitive ();
+}
+
+void
+DEFUN (OS_channel_unregister, (channel), Tchannel channel)
+{
+  if (CHANNEL_REGISTERED (channel))
+    {
+      OS_channels_registered -= 1;
+      (CHANNEL_REGISTERED (channel)) = 0;
+    }
+}
+
+\f
+/* No SELECT in DOS */
+long
+DEFUN (OS_channel_select_then_read, (channel, buffer, nbytes),
+       Tchannel channel AND
+       PTR buffer AND
+       size_t nbytes)
+{ /* We can't really select amonst channels in DOS, but still need
+     to keep track of whether the read was interrupted. */
+  while (1)
+  {
+    long scr = dos_channel_read(channel, buffer, nbytes);
+
+    if (scr < 0)
+    {
+      if (errno == ERRNO_NONBLOCK)
+       return -1;
+      else if (errno == EINTR)
+       return -4;
+      else
+      { DOS_prim_check_errno (syscall_read);
+       continue;
+      }
+    }
+    else if (scr > nbytes)
+      error_external_return ();
+    else
+      return (scr);
+  }
+}
diff --git a/v7/src/microcode/dosio.h b/v7/src/microcode/dosio.h
new file mode 100644 (file)
index 0000000..7d77e99
--- /dev/null
@@ -0,0 +1,88 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosio.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef SCM_UXIO_H
+#define SCM_UXIO_H
+
+#include "osio.h"
+
+struct channel
+{
+  int descriptor;
+  enum channel_type type;
+  unsigned int internal : 1;
+  unsigned int nonblocking : 1;
+  unsigned int registered : 1;
+  unsigned int buffered : 1;
+  unsigned int cooked : 1;
+};
+
+#define MARK_CHANNEL_CLOSED(channel) ((CHANNEL_DESCRIPTOR (channel)) = (-1))
+#define CHANNEL_CLOSED_P(channel) ((CHANNEL_DESCRIPTOR (channel)) < 0)
+#define CHANNEL_OPEN_P(channel) ((CHANNEL_DESCRIPTOR (channel)) >= 0)
+#define CHANNEL_DESCRIPTOR(channel) ((channel_table [(channel)]) . descriptor)
+#define CHANNEL_TYPE(channel) ((channel_table [(channel)]) . type)
+#define CHANNEL_INTERNAL(channel) ((channel_table [(channel)]) . internal)
+#define CHANNEL_NONBLOCKING(channel)                                   \
+  ((channel_table [(channel)]) . nonblocking)
+#define CHANNEL_BLOCKING_P(channel)                                    \
+  (!CHANNEL_NONBLOCKING(channel))
+#define CHANNEL_REGISTERED(channel) ((channel_table [(channel)]) . registered)
+#define CHANNEL_BUFFERED(channel) ((channel_table [(channel)]) . buffered)
+#define CHANNEL_COOKED(channel) ((channel_table [(channel)]) . cooked)
+
+#define MAKE_CHANNEL(descriptor, type, receiver)                       \
+{                                                                      \
+  Tchannel MAKE_CHANNEL_temp = (channel_allocate ());                  \
+  (CHANNEL_DESCRIPTOR (MAKE_CHANNEL_temp)) = (descriptor);             \
+  (CHANNEL_TYPE (MAKE_CHANNEL_temp)) = (type);                         \
+  (CHANNEL_INTERNAL (MAKE_CHANNEL_temp)) = 0;                          \
+  (CHANNEL_NONBLOCKING (MAKE_CHANNEL_temp)) = 0;                       \
+  (CHANNEL_REGISTERED (MAKE_CHANNEL_temp)) = 0;                                \
+  (CHANNEL_BUFFERED (MAKE_CHANNEL_temp)) = 1;                          \
+  (CHANNEL_COOKED (MAKE_CHANNEL_temp)) = 0;                            \
+  receiver (MAKE_CHANNEL_temp);                                                \
+}
+
+extern struct channel * channel_table;
+extern Tchannel EXFUN (channel_allocate, (void));
+
+#define BACKSPACE              '\b'
+#define SPACE                  ' '
+#define CARRIAGE_RETURN                '\r'
+#define LINEFEED               '\n'
+#define CNTRL_Z                        '\032'
+#define DELETE                 '\177'
+
+#endif /* SCM_UXIO_H */
diff --git a/v7/src/microcode/doskbd.c b/v7/src/microcode/doskbd.c
new file mode 100644 (file)
index 0000000..41d545d
--- /dev/null
@@ -0,0 +1,1294 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/doskbd.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <bios.h>
+#include <dos.h>
+#include <int.h>
+#include "msdos.h"
+
+#ifdef getDS
+#undef getDS
+#endif
+
+#include "dossys.h"
+#include "dosinsn.h"
+#include "doskbd.h"
+
+#ifndef ELOOP
+#  define ELOOP 2000
+#endif
+
+#ifndef EFAULT
+#  define EFAULT 2001
+#endif
+\f
+/* Tables mapping scan codes to ASCII characters.
+   Entries with NULL (\0) should not be mapped by the
+   Scheme keyboard ISR.  Let the default handler map them.
+ */
+
+static unsigned char
+shifted_scan_code_to_ascii[] =
+{ 
+       '\0',           /* 0 */
+       '\033',         /* 1 */
+       '!',            /* 2 */
+       '@',            /* 3 */
+       '#',            /* 4 */
+       '$',            /* 5 */
+       '%',            /* 6 */
+       '^',            /* 7 */
+       '&',            /* 8 */
+       '*',            /* 9 */
+       '(',            /* 10 */
+       ')',            /* 11 */
+       '_',            /* 12 */
+       '+',            /* 13 */
+       '\177',         /* 14 */
+       '\t',           /* 15 */
+       'Q',            /* 16 */
+       'W',            /* 17 */
+       'E',            /* 18 */
+       'R',            /* 19 */
+       'T',            /* 20 */
+       'Y',            /* 21 */
+       'U',            /* 22 */
+       'I',            /* 23 */
+       'O',            /* 24 */
+       'P',            /* 25 */
+       '{',            /* 26 */
+       '}',            /* 27 */
+       '\r',           /* 28 */
+       '\0',           /* 29 */
+       'A',            /* 30 */
+       'S',            /* 31 */
+       'D',            /* 32 */
+       'F',            /* 33 */
+       'G',            /* 34 */
+       'H',            /* 35 */
+       'J',            /* 36 */
+       'K',            /* 37 */
+       'L',            /* 38 */
+       ':',            /* 39 */
+       '\"',           /* 40 */
+       '~',            /* 41 */
+       '\0',           /* 42 */
+       '|',            /* 43 */
+       'Z',            /* 44 */
+       'X',            /* 45 */
+       'C',            /* 46 */
+       'V',            /* 47 */
+       'B',            /* 48 */
+       'N',            /* 49 */
+       'M',            /* 50 */
+       '<',            /* 51 */
+       '>',            /* 52 */
+       '?',            /* 53 */
+       '\0',           /* 54 */
+       '\0',           /* 55 */
+       '\0',           /* 56 */
+       ' '             /* 57 */
+  };
+\f    
+static unsigned char
+unshifted_scan_code_to_ascii[] =
+{
+       '\0',           /* 0 */
+       '\033',         /* 1 */
+       '1',            /* 2 */
+       '2',            /* 3 */
+       '3',            /* 4 */
+       '4',            /* 5 */
+       '5',            /* 6 */
+       '6',            /* 7 */
+       '7',            /* 8 */
+       '8',            /* 9 */
+       '9',            /* 10 */
+       '0',            /* 11 */
+       '-',            /* 12 */
+       '=',            /* 13 */
+       '\177',         /* 14 */
+       '\t',           /* 15 */
+       'q',            /* 16 */
+       'w',            /* 17 */
+       'e',            /* 18 */
+       'r',            /* 19 */
+       't',            /* 20 */
+       'y',            /* 21 */
+       'u',            /* 22 */
+       'i',            /* 23 */
+       'o',            /* 24 */
+       '\0',           /* 25 */        /* M-p does not work, somehow. */
+       '[',            /* 26 */
+       ']',            /* 27 */
+       '\r',           /* 28 */
+       '\0',           /* 29 */
+       'a',            /* 30 */
+       's',            /* 31 */
+       'd',            /* 32 */
+       'f',            /* 33 */
+       'g',            /* 34 */
+       'h',            /* 35 */
+       'j',            /* 36 */
+       'k',            /* 37 */
+       'l',            /* 38 */
+       ';',            /* 39 */
+       '\'',           /* 40 */
+       '`',            /* 41 */
+       '\0',           /* 42 */
+       '\\',           /* 43 */
+       'z',            /* 44 */
+       'x',            /* 45 */
+       'c',            /* 46 */
+       'v',            /* 47 */
+       'b',            /* 48 */
+       'n',            /* 49 */
+       'm',            /* 50 */
+       ',',            /* 51 */
+       '.',            /* 52 */
+       '/',            /* 53 */
+       '\0',           /* 54 */
+       '\0',           /* 55 */
+       '\0',           /* 56 */
+       ' '             /* 57 */
+  };
+
+static unsigned char modifier_mask = 0x4f;
+\f
+union RM_address
+{
+  unsigned fp;
+  struct
+    {
+      unsigned short off;
+      unsigned short seg;
+    } x;
+};
+
+dos_boolean
+under_QEMM_386_p (void)
+{
+  unsigned int i;
+  union REGS iregs, oregs;
+
+  iregs.h.al = 0x01;
+  iregs.x.bx = 0x5145;
+  iregs.x.cx = 0x4d4d;
+  iregs.x.dx = 0x3432;
+
+  for (i = 0xc0; i <= 0xff; i++)
+  {
+    iregs.h.ah = i;
+    int86 (0x2f, &iregs, &oregs);
+    if (oregs.x.bx == 0x4f4b)
+      return (dos_true);
+  }
+  return (dos_false);
+}
+
+dos_boolean
+under_DPMI_p (void)
+{
+  union REGS regs;
+  
+  regs.e.eax = 0x1686;
+  int86 (0x2f, &regs, &regs);
+  return (regs.x.ax == 0);
+}
+
+static void
+normalize_RM_address (union RM_address * addr)
+{
+  if (addr->x.off > 0xf)
+  {
+    addr->x.seg += (addr->x.off >> 4);
+    addr->x.off = (addr->x.off & 0xf);
+  }
+  return;
+}
+
+/*
+   We would like to use Zortech's int_intercept with the following
+   routine under DOSX (or Phar Lap).
+
+   Unfortunately, it does not work under QEMM386 or under MS Windows 3.1.
+   The real-mode call-back routine is apparently just plain broken.
+
+   In addition, bypassing DOSX under DPMI 0.9 and using DPMI's
+   real-mode call backs does not work consistently, and the keyboard
+   interrupt happens only in real mode since we are capturing the
+   interrupt DOS uses to tell the BIOS that a scan code has arrived
+   after doing the handshake with the keyboard device itself.
+
+   Thus, under DPMI, we install our own hard-coded real-mode keyboard
+   driver and don't bother with a protected mode handler.  All the
+   code is here in case it can be turned on in the future, perhaps for
+   a different DOS Extender or a new version of DPMI.
+
+   Apparently telling DOSX to install a protected mode handler and
+   making it reflect real mode interrupts to protected mode does not
+   work consistently under QEMM386 either, thus we are now installing
+   a real-mode handler no matter what, although using different
+   mechanisms under DPMI and not DPMI.
+ */
+\f
+#define DOSX_USE_INT_INTERCEPT
+#define DOSX_RM_HANDLER_UNTOUCHED
+#define DOSX_PM_HANDLER_UNTOUCHED
+/* #define DOSX_RM_HANDLER_REAL */
+#define DPMI_RM_HANDLER_REAL
+#define DPMI_PM_HANDLER_UNTOUCHED
+
+#ifdef DOSX_USE_INT_INTERCEPT
+
+#define PC_KBD_ALT_MASK                        0x8
+#define PC_KBD_CTRL_MASK               0x4
+#define PC_KBD_SHIFT_MASK              0x3
+#define PC_KBD_CAPSL_MASK              0x40
+
+#define DOS_HOOK_TRANSLATE_KEYSTROKE   0x4f
+#define DOS_KBD_FUNC_RECORD_KEYSTROKE  0x5
+
+int
+bios_keyboard_handler(struct INT_DATA *pd)
+{
+  unsigned char scan_code, chord, ascii;
+  union REGS regs;
+
+  if (pd->regs.h.ah != DOS_HOOK_TRANSLATE_KEYSTROKE)
+    return (INTERRUPT_CHAIN_NEXT);
+
+  scan_code = (pd->regs.h.al);
+  if (scan_code >= (sizeof (shifted_scan_code_to_ascii)))
+    return (INTERRUPT_CHAIN_NEXT);
+
+  chord = ((bioskey (_KEYBRD_SHIFTSTATUS)) & modifier_mask);
+
+  if ((chord == 0) || (chord == PC_KBD_ALT_MASK))
+    ascii = ((int) unshifted_scan_code_to_ascii[scan_code]);
+  else
+    ascii = ((int) shifted_scan_code_to_ascii[scan_code]);
+
+  if (ascii == '\0')
+    return INTERRUPT_CHAIN_NEXT;       
+  if ((chord & PC_KBD_CTRL_MASK) != 0)
+  {
+    ascii &= ~0x60;                    /* Controlify */
+  }
+  if (chord & PC_KBD_ALT_MASK)
+    ascii |= 0x80;                     /* Metafy */
+
+  /* Insert metafied char in bios buffer. */
+  regs.h.ah = DOS_KBD_FUNC_RECORD_KEYSTROKE;
+  regs.h.ch = scan_code;
+  regs.h.cl = ascii;
+  int86 (DOS_INTVECT_KEYBOARD_REQUEST, &regs, &regs);
+
+  pd->regs.e.flags &= ~1;              /* clear CF, scan code ignored! */
+  return (INTERRUPT_RETURN);
+}
+#endif /* DOSX_USE_INT_INTERCEPT */
+\f
+static void
+DPMI_PM_getvector (unsigned vecnum, unsigned * eip, unsigned * cs)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x204;
+  regs.h.bl = (vecnum & 0xff);
+  int86 (0x31, &regs, &regs);
+  * eip = regs.e.edx;
+  * cs = ((unsigned) regs.x.cx);
+  return;
+}
+
+static int
+DPMI_PM_setvector (unsigned vecnum, unsigned eip, unsigned cs)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x205;
+  regs.h.bl = (vecnum & 0xff);
+  regs.e.edx = eip;
+  regs.x.cx = ((unsigned short) cs);
+  int86 (0x31, &regs, &regs);
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+
+static void
+DPMI_RM_getvector (unsigned vecnum, unsigned short * ip, unsigned short * cs)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x200;
+  regs.h.bl = (vecnum & 0xff);
+  int86 (0x31, &regs, &regs);
+  * ip = regs.x.dx;
+  * cs = regs.x.cx;
+  return;
+}
+
+static int
+DPMI_RM_setvector (unsigned vecnum, unsigned short ip, unsigned short cs)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x201;
+  regs.h.bl = (vecnum & 0xff);
+  regs.x.cx = cs;
+  regs.x.dx = ip;
+  int86 (0x31, &regs, &regs);
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+\f
+#ifdef DPMI_RM_HANDLER_PROTECTED
+
+struct DPMI_RM_REGS
+{
+  unsigned long edi;           /* 0 */
+  unsigned long esi;           /* 4 */
+  unsigned long ebp;           /* 8 */
+  unsigned long esp;           /* 12 */
+  unsigned long ebx;           /* 16 */
+  unsigned long edx;           /* 20 */
+  unsigned long ecx;           /* 24 */
+  unsigned long eax;           /* 28 */
+  unsigned short flags;                /* 30 */
+  unsigned short es;           /* 32 */
+  unsigned short ds;           /* 34 */
+  unsigned short fs;           /* 36 */
+  unsigned short gs;           /* 38 */
+  unsigned short ip;           /* 40 */
+  unsigned short cs;           /* 42 */
+  unsigned short sp;           /* 44 */
+  unsigned short ss;           /* 48 */
+  unsigned short pad;          /* 50 */
+  unsigned long old_vector_ip; /* 52 */
+  unsigned long old_vector_cs; /* 56 */
+};
+
+static int
+DPMI_allocate_RM_call_back (unsigned short * cb_ip,
+                           unsigned short * cb_cs,
+                           unsigned eip, unsigned cs,
+                           unsigned RM_regs, unsigned ds)
+{
+  union REGS regs;
+  struct SREGS sregs;
+  
+  segread (& sregs);
+  regs.x.ax = 0x303;
+  regs.e.esi = eip;
+  sregs.ds = cs;
+  regs.e.edi = RM_regs;
+  sregs.es = ds;
+
+  int86x (0x31, &regs, &regs, &sregs);
+  * cb_ip = regs.x.dx;
+  * cb_cs = regs.x.cx;
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+
+static int
+DPMI_free_RM_call_back (unsigned short cb_ip, unsigned short cb_cs)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x304;
+  regs.x.cx = cb_cs;
+  regs.x.dx = cb_ip;
+  int86 (0x31, &regs, &regs);
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+
+#endif /* DPMI_RM_HANDLER_PROTECTED */
+\f
+#ifdef DPMI_RM_HANDLER_REAL
+
+static int
+DPMI_allocate_DOS_block (unsigned short size,
+                        unsigned short * rm_seg,
+                        unsigned short * pm_sel)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x100;
+  regs.x.bx = ((((unsigned) size) + 15) >> 4); /* paragraphs */
+  int86 (0x31, & regs, & regs);
+  * rm_seg = regs.x.ax;
+  * pm_sel = regs.x.dx;
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+
+static int
+DPMI_free_DOS_block (unsigned short selector)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x101;
+  regs.x.dx = selector;
+  int86 (0x31, & regs, & regs);
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+
+#endif /* DPMI_RM_HANDLER_REAL */
+
+#ifdef DOSX_RM_HANDLER_REAL
+
+static int
+DOSX_allocate_DOS_block (unsigned short size,
+                        unsigned short * rm_seg)
+{
+  union REGS regs;
+#if 0
+  
+  regs.x.ax = 0x25c0;
+  regs.x.bx = ((((unsigned) size) + 15) >> 4); /* paragraphs */
+  int86 (0x21, & regs, & regs);
+  if ((regs.e.flags & 1) == 0)
+  {
+    * rm_seg = regs.x.ax;
+    return (DOS_SUCCESS);
+  }
+  if (regs.x.ax == 0x8)
+    errno = ENOMEM;
+  else
+    errno = EFAULT;
+  return (DOS_FAILURE);
+
+#else /* not 0 */
+
+  regs.h.ah = 0x48;
+  regs.x.bx = ((((unsigned) size) + 15) >> 4); /* paragraphs */
+  int86 (0x21, & regs, & regs);
+  * rm_seg = regs.x.ax;
+  if ((regs.e.flags & 1) != 0)
+  {
+    errno = ENOMEM;
+    return (DOS_FAILURE);
+  }
+  return (DOS_SUCCESS);
+
+#endif /* 0 */
+}
+
+static int
+DOSX_free_DOS_block (unsigned short seg)
+{
+  union REGS regs;
+#if 0
+  
+  regs.x.ax = 0x25c1;
+  regs.x.cx = seg;
+  int86 (0x21, & regs, & regs);
+
+#else /* not 0 */
+
+  struct SREGS sregs;
+
+  regs.h.ah = 0x49;
+  segread (&sregs);
+  sregs.es = seg;
+  int86x (0x21, & regs, & regs, & sregs);
+
+#endif /* 0 */
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+
+#endif /* DOSX_RM_HANDLER_REAL */
+\f
+#ifndef DOSX_PM_HANDLER_UNTOUCHED
+
+static void
+DOSX_PM_getvector (unsigned vecnum, unsigned * eip, unsigned * cs)
+{
+  union REGS regs;
+  struct SREGS sregs;
+  
+  regs.x.ax = 0x2502;
+  regs.h.cl = (vecnum & 0xff);
+  segread (&sregs);
+  int86x (0x21, &regs, &regs, &sregs);
+  * eip = regs.e.ebx;
+  * cs = ((unsigned) sregs.es);
+  return;
+}
+
+static void
+DOSX_installvector (unsigned vecnum, unsigned eip, unsigned cs)
+{
+  union REGS regs;
+  struct SREGS sregs;
+  
+  regs.x.ax = 0x2506;
+  regs.h.cl = (vecnum & 0xff);
+  regs.e.edx = eip;
+  segread (&sregs);
+  sregs.ds = cs;
+  int86x (0x21, &regs, &regs, &sregs);
+  return;
+}
+
+static void
+DOSX_restore_vector (unsigned vecnum, unsigned eip,
+                    unsigned cs, unsigned rmode)
+{
+  union REGS regs;
+  struct SREGS sregs;
+  
+  segread (&sregs);
+  sregs.ds = cs;
+  regs.e.edx = eip;
+  regs.e.ebx = rmode;
+  regs.x.ax = 0x2507;
+  regs.h.cl = (vecnum & 0xff);
+  int86x (0x21, &regs, &regs, &sregs);
+  return;
+}
+
+#endif /* DOSX_PM_HANDLER_UNTOUCHED */
+\f
+#ifndef DOSX_RM_HANDLER_UNTOUCHED
+
+static void
+DOSX_RM_getvector (unsigned vecnum, unsigned * vector)
+{
+  union REGS regs;
+
+  regs.x.ax = 0x2503;
+  regs.h.cl = (vecnum & 0xff);
+  int86 (0x21, &regs, &regs);
+  * vector = regs.e.ebx;
+  return;
+}
+
+static int
+DOSX_RM_setvector (unsigned vecnum, unsigned rm_address)
+{
+  union REGS regs;
+  
+  regs.x.ax = 0x2505;
+  regs.h.cl = (vecnum & 0xff);
+  regs.e.ebx = rm_address;
+  int86 (0x31, &regs, &regs);
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+
+#if 0
+static int
+DOSX_convert_PM_to_RM_address (unsigned short sel, unsigned offset,
+                              unsigned length, unsigned * rm_address)
+{
+  union REGS regs;
+  struct SREGS sregs;
+
+  segread (&sregs);
+  sregs.es = sel;
+  regs.e.ebx = offset;
+  regs.e.ecx = length;
+  regs.e.eax = 0x250F;
+  int86x (0x21, &regs, &regs, &sregs);
+  * rm_address = regs.e.ecx;
+  return (((regs.e.flags & 1) == 0) ? DOS_SUCCESS : DOS_FAILURE);
+}
+#endif /* 0 */
+
+#endif /* DOSX_RM_HANDLER_UNTOUCHED */
+\f
+static unsigned 
+  old_PM_vector_eip, 
+  old_PM_vector_cs;
+
+static union RM_address old_RM_vector;
+
+static void
+  * scheme_PM_vector = ((void *) NULL),
+  * scheme_RM_vector = ((void *) NULL);
+
+#if (!defined (DOSX_PM_HANDLER_UNTOUCHED)) || (!defined (DPMI_PM_HANDLER_UNTOUCHED))
+static void *
+make_PM_trampoline (void (* hook) (void))
+{
+  void * trampoline;
+  INSN_DECLS ();
+
+  trampoline = (malloc (TRAMP_SIZE (6)));
+  if (trampoline != ((void *) NULL))
+  {
+    INIT_INSNS (trampoline);
+    PUSH_INSN (old_PM_vector_cs);
+    PUSH_INSN (old_PM_vector_eip);
+    PUSH_INSN (& modifier_mask);
+    PUSH_INSN (unshifted_scan_code_to_ascii);
+    PUSH_INSN (shifted_scan_code_to_ascii);
+    PUSH_INSN (getDS ());
+    JMP_INSN (hook);
+    HLT_INSNS (6);
+  }
+  return (trampoline);
+}
+#endif /* !DOSX_PM_HANDLER_UNTOUCHED || !DPMI_PM_HANDLER_UNTOUCHED */
+
+#ifdef DPMI_RM_HANDLER_PROTECTED
+static void *
+make_RM_trampoline (void (* hook) (void))
+{
+  void * trampoline;
+  INSN_DECLS ();
+
+  trampoline = (malloc (TRAMP_SIZE (6)));
+  if (trampoline != ((void *) NULL))
+  {
+    INIT_INSNS (trampoline);
+    PUSH_INSN (old_RM_vector.x.seg);
+    PUSH_INSN (old_RM_vector.x.off);
+    PUSH_INSN (& modifier_mask);
+    PUSH_INSN (unshifted_scan_code_to_ascii);
+    PUSH_INSN (shifted_scan_code_to_ascii);
+    PUSH_INSN (getDS ());
+    JMP_INSN (hook);
+    HLT_INSNS (6);
+  }
+  return (trampoline);
+}
+#endif /* DPMI_RM_HANDLER_PROTECTED */
+\f
+#ifdef DPMI_RM_HANDLER_PROTECTED
+  static union RM_address DPMI_RM_call_back;
+  static void * DPMI_RM_regs = ((void *) NULL);
+#endif /* DPMI_RM_HANDLER_PROTECTED */
+
+#ifdef DPMI_RM_HANDLER_REAL
+  static unsigned short DPMI_RM_selector = 0;
+#endif /* DPMI_RM_HANDLER_REAL */
+
+static int
+DPMI_restore_kbd_hook (void)
+{
+#ifdef DPMI_RM_HANDLER_REAL
+  if (DPMI_RM_selector != 0)
+  {
+    if (((DPMI_RM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                            old_RM_vector.x.off,
+                            old_RM_vector.x.seg))
+        != DOS_SUCCESS)
+       || ((DPMI_free_DOS_block (DPMI_RM_selector)) != DOS_SUCCESS))
+    {
+      errno = EACCES;
+      return (DOS_FAILURE);
+    }
+    DPMI_RM_selector = 0;
+    free (scheme_RM_vector);
+    scheme_RM_vector = ((void *) NULL);
+  }
+#endif /* #ifdef DPMI_RM_HANDLER_REAL */
+
+#ifdef DPMI_RM_HANDLER_PROTECTED
+  if (scheme_RM_vector != ((void *) NULL))
+  {
+    if (((DPMI_RM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                            old_RM_vector.x.off,
+                            old_RM_vector.x.seg))
+        != DOS_SUCCESS)
+       || ((DPMI_free_RM_call_back (DPMI_RM_call_back.x.off,
+                                    DPMI_RM_call_back.x.seg))
+           != DOS_SUCCESS))
+    {
+      errno = EACCES;
+      return (DOS_FAILURE);
+    }
+    free (DPMI_RM_regs);
+    free (scheme_RM_vector);
+    scheme_RM_vector = ((void *) NULL);
+  }
+#endif /* DPMI_RM_HANDLER_PROTECTED */
+
+#ifndef DPMI_PM_HANDLER_UNTOUCHED
+  if (scheme_PM_vector != ((void *) NULL))
+  {
+    if ((DPMI_PM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                           old_PM_vector_eip,
+                           old_PM_vector_cs))
+       != DOS_SUCCESS)
+    {
+      errno = EACCES;
+      return (DOS_FAILURE);
+    }
+    free (scheme_PM_vector);
+    scheme_PM_vector = ((void *) NULL);
+  }
+#endif /* DPMI_PM_HANDLER_UNTOUCHED */
+
+  return (DOS_SUCCESS);
+}
+\f
+#if defined(DPMI_RM_HANDLER_REAL) || defined(DOSX_RM_HANDLER_REAL)
+
+unsigned char RM_handler_pattern[] =
+{
+                       /*  chain:                                      */
+0x9d,                  /* 0    popf                                    */
+0xea,0,0,0,0,          /* 1    jmpf    next_in_chain                   */
+                       /*  kbd_isr:                                    */
+0x9c,                  /* 6    pushf                                   */
+0x80,0xfc,0x4f,                /* 7    cmp     ah,4fh                          */
+0x75,0xf4,             /* a    jne     chain                           */
+0x3c,0x39,             /* c    cmp     al,39h                          */
+0x77,0xf0,             /* e    ja      chain                           */
+0x53,                  /* 10   push    bx      ; Preserve bx           */
+0x50,                  /* 11   push    ax      ; Preserve scan code    */
+0xb4,2,                        /* 12   mov     ah,2h                           */
+0xcd,0x16,             /* 14   int     16h     ; Get modifier bits     */
+0x2e,0x22,6,0xf4,0,    /* 16   and     al,cs:modifier mask             */
+0x5b,                  /* 1b   pop     bx      ; Get scan code         */
+0x53,                  /* 1c   push    bx                              */
+0x81,0xe3,0x3f,0,      /* 1d   and     bx,3fh  ; Drop fncn             */
+0x3c,8,                        /* 21   cmp     al,8h   ; Only meta bit set?    */
+0x74,0xb,              /* 23   je      do_unshifted                    */
+0x3c,0,                        /* 25   cmp     al,0    ; No modifier bits set? */
+0x74,7,                        /* 27   je      do_unshifted                    */
+                       /*  do_shifted:                                 */
+0x2e,0x8a,0x9f,0x80,0, /* 29   mov     bl,cs:shifted_table[bx]         */
+0xeb,5,                        /* 2e   jmp     merge                           */
+                       /*  do_unshifted:                               */
+0x2e,0x8a,0x9f,0xba,0, /* 30   mov     bl,cs:unshifted_table[bx]       */
+                       /*  merge:                                      */
+0x80,0xfb,0,           /* 35   cmp     bl,0    ; No translation?       */
+0x74,0x2b,             /* 38   je      abort_translation               */
+0x0f,0xba,0xe0,2,      /* 3a   bt      al,2h   ; Control set?          */
+0x73,3,                        /* 3e   jnc     after_ctrl                      */
+0x80,0xe3,0x9f,                /* 40   and     bl,09fh ; controlify            */
+                       /*  after_ctrl:                                 */
+0x0f,0xba,0xe0,3,      /* 43   bt      al,3h   ; Alt set?              */
+0x73,3,                        /* 47   jnc     after_meta                      */
+0x80,0xcb,0x80,                /* 49   or      bl,080h ; metify                */
+                       /*  after_meta:                                 */
+0x58,                  /* 4c   pop     ax                              */
+0x51,                  /* 4d   push    cx      ; Preserve cx           */
+0x50,                  /* 4e   push    ax                              */
+0x8a,0xe8,             /* 4f   mov     ch,al   ; Scan code             */
+0x8a,0xcb,             /* 51   mov     cl,bl   ; ASCII value           */
+0xb4,5,                        /* 53   mov     ah,05h  ; fcn. number           */
+0xcd,0x16,             /* 55   int     16h     ; Record keystroke      */
+0x58,                  /* 57   pop     ax      ; Restore registers     */
+0x59,                  /* 58   pop     cx                              */
+0x5b,                  /* 59   pop     bx                              */
+0x55,                  /* 5a   push    bp                              */
+0x8b,0xec,             /* 5b   mov     bp,sp                           */
+0x80,0x66,8,0xfe,      /* 5d   and     8[bp],0feh  ; clc iret's flags  */
+0x5d,                  /* 61   pop     bp                              */
+0x9d,                  /* 62   popf                                    */
+0xf8,                  /* 63   clc                                     */
+0xcf,                  /* 64   iret                                    */
+                       /*  abort_translation:                          */
+0x58,                  /* 65   pop     ax                              */
+0x5b,                  /* 66   pop     bx                              */
+0xeb,0x97              /* 67   jmp     chain                           */
+                       /* 69   PAD                                     */
+};
+\f
+#define PATTERN_SIZE           0x69
+#define PADDED_PATTERN_SIZE    0x80
+#define PATTERN_CHAIN_OFFSET   2
+#define PATTERN_START_OFFSET   6
+#define RM_ISR_TABLE_SIZE      0x3a
+#define RM_ISR_TOTAL_SIZE                                      \
+  (PADDED_PATTERN_SIZE + (2 * RM_ISR_TABLE_SIZE) + 1)
+#define RM_ISR_MASK_OFFSET     (RM_ISR_TOTAL_SIZE - 1)
+
+static void *
+make_RM_handler (void)
+{
+  unsigned char * copy;
+  unsigned short * wordptr;
+
+  if (((sizeof (RM_handler_pattern)) != PATTERN_SIZE)
+      || ((sizeof (shifted_scan_code_to_ascii)) != RM_ISR_TABLE_SIZE)
+      || ((sizeof (unshifted_scan_code_to_ascii)) != RM_ISR_TABLE_SIZE)
+      || (RM_ISR_MASK_OFFSET != 0xf4))
+  {
+    fprintf (stderr, "make_RM_handler: Inconsistent sizes!\n");
+    fprintf (stderr, "    PATTERN_SIZE = %d\n", PATTERN_SIZE);
+    fprintf (stderr, "and (sizeof (RM_handler_pattern)) = %d\n",
+            (sizeof (RM_handler_pattern)));
+    fprintf (stderr, "    RM_ISR_TABLE_SIZE = %d\n",
+            RM_ISR_TABLE_SIZE);
+
+    fprintf (stderr, "and (sizeof (shifted_scan_code_to_ascii)) = %d\n",
+            (sizeof (shifted_scan_code_to_ascii)));
+    fprintf (stderr, "and (sizeof (unshifted_scan_code_to_ascii)) = %d\n",
+            (sizeof (unshifted_scan_code_to_ascii)));
+    fprintf (stderr, "    RM_ISR_MASK_OFFSET  = 0x%x <> 0xf4",
+            RM_ISR_MASK_OFFSET);
+    errno = EFAULT;
+    return ((void *) NULL);
+  }
+
+  copy = ((unsigned char *) (malloc (RM_ISR_TOTAL_SIZE)));
+  if (copy == ((unsigned char *) NULL))
+    return ((void *) NULL);
+
+  memcpy (copy, RM_handler_pattern, (sizeof (RM_handler_pattern)));
+  memcpy ((copy + PADDED_PATTERN_SIZE),
+         shifted_scan_code_to_ascii,
+         RM_ISR_TABLE_SIZE);
+  memcpy ((copy + PADDED_PATTERN_SIZE + RM_ISR_TABLE_SIZE),
+         unshifted_scan_code_to_ascii,
+         RM_ISR_TABLE_SIZE);
+
+  wordptr = ((unsigned short *) (copy + PATTERN_CHAIN_OFFSET));
+  * wordptr++ = old_RM_vector.x.off;
+  * wordptr = old_RM_vector.x.seg;
+  * (copy + RM_ISR_MASK_OFFSET) = modifier_mask;
+
+  return ((void *) copy);
+}
+
+#endif /* DPMI_RM_HANDLER_REAL || DOSX_RM_HANDLER_REAL */
+\f
+static int
+DPMI_install_kbd_hook (void)
+{
+#ifndef DPMI_PM_HANDLER_UNTOUCHED
+
+  DPMI_PM_getvector (DOS_INTVECT_SYSTEM_SERVICES,
+                    & old_PM_vector_eip,
+                    & old_PM_vector_cs);
+
+  {
+    extern void DPMI_PM_scheme_system_isr (void);
+    void * PM_trampoline;
+
+    PM_trampoline = (make_PM_trampoline (DPMI_PM_scheme_system_isr));
+    if (PM_trampoline == ((void *) NULL))
+    {
+      errno = ENOMEM;
+      return (DOS_FAILURE);
+    }
+    if ((DPMI_PM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                           ((unsigned) PM_trampoline),
+                           (getCS ())))
+       != DOS_SUCCESS)
+    {
+      errno = EACCES;
+      free (PM_trampoline);
+      return (DOS_FAILURE);
+    }
+    scheme_PM_vector = PM_trampoline;
+  }
+
+#endif /* DPMI_PM_HANDLER_UNTOUCHED */
+\f
+#ifndef DPMI_RM_HANDLER_UNTOUCHED
+
+  DPMI_RM_getvector (DOS_INTVECT_SYSTEM_SERVICES,
+                    & old_RM_vector.x.off,
+                    & old_RM_vector.x.seg);
+
+#  ifdef DPMI_RM_HANDLER_PROTECTED
+
+  {
+    extern void DPMI_RM_scheme_system_isr (void);
+    struct DPMI_RM_REGS * RM_regs;
+    union RM_address RM_call_back;
+    void * RM_trampoline;
+
+    RM_regs = ((struct DPMI_RM_REGS *)
+              (malloc (sizeof (struct DPMI_RM_REGS))));
+    if (RM_regs == ((struct DPMI_RM_REGS *) NULL))
+    {
+      DPMI_restore_kbd_hook ();
+      errno = ENOMEM;
+      return (DOS_FAILURE);
+    }
+
+    RM_regs->ss = 0;
+    RM_regs->sp = 0;
+    RM_regs->old_vector_ip = (old_RM_vector.x.off);
+    RM_regs->old_vector_cs = (old_RM_vector.x.seg);
+
+    RM_trampoline = (make_RM_trampoline (DPMI_RM_scheme_system_isr));
+    if (RM_trampoline == ((void *) NULL))
+    {
+      free (RM_regs);
+      DPMI_restore_kbd_hook ();
+      errno = ENOMEM;
+      return (DOS_FAILURE);
+    }
+
+    if (((DPMI_allocate_RM_call_back (& RM_call_back.x.off,
+                                     & RM_call_back.x.seg,
+                                     ((unsigned) RM_trampoline),
+                                     ((unsigned) (getCS ())),
+                                     ((unsigned) RM_regs),
+                                     ((unsigned) (getDS ()))))
+        != DOS_SUCCESS)
+       || ((DPMI_RM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                               RM_call_back.x.off,
+                               RM_call_back.x.seg))
+           != DOS_SUCCESS))
+    {
+      free (RM_trampoline);
+      free (RM_regs);
+      DPMI_restore_kbd_hook ();
+      errno = EACCES;
+      return (DOS_FAILURE);
+    }
+    scheme_RM_vector = RM_trampoline;
+    DPMI_RM_regs = ((void *) RM_regs);
+    DPMI_RM_call_back = RM_call_back;
+  }
+
+#  else  /* not DPMI_RM_HANDLER_PROTECTED = DPMI_RM_HANDLER_REAL */
+\f
+  {
+    void * RM_handler;
+    unsigned short real_mode_segment;
+    unsigned short prot_mode_selector;
+
+    RM_handler = (make_RM_handler ());
+    if (RM_handler == ((void *) NULL))
+    {
+      int saved_errno = errno;
+
+      DPMI_restore_kbd_hook ();
+      errno = saved_errno;
+      return (DOS_FAILURE);
+    }
+
+    if ((DPMI_allocate_DOS_block (RM_ISR_TOTAL_SIZE,
+                                 & real_mode_segment,
+                                 & prot_mode_selector))
+       != DOS_SUCCESS)
+    {
+      free (RM_handler);
+      DPMI_restore_kbd_hook ();
+      errno = ENOMEM;
+      return (DOS_FAILURE);
+    }
+
+    farcpy (0, prot_mode_selector,
+           ((unsigned) RM_handler), (getDS ()),
+           RM_ISR_TOTAL_SIZE);
+
+    if ((DPMI_RM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                           PATTERN_START_OFFSET,
+                           real_mode_segment))
+       != DOS_SUCCESS)
+    {
+      DPMI_free_DOS_block (prot_mode_selector);
+      free (RM_handler);
+      DPMI_restore_kbd_hook ();
+      errno = EACCES;
+      return (DOS_FAILURE);
+    }
+
+    DPMI_RM_selector = prot_mode_selector;
+    scheme_RM_vector = RM_handler;             /* Kludge! */
+  }
+
+#  endif /* not DPMI_RM_HANDLER_PROTECTED */
+#endif /* DPMI_RM_HANDLER_UNTOUCHED */
+  return (DOS_SUCCESS);
+}
+\f
+#ifdef DOSX_RM_HANDLER_REAL
+  static unsigned short DOSX_RM_segment = 0;
+#endif /* DOSX_RM_HANDLER_REAL */
+#ifdef DOSX_USE_INT_INTERCEPT
+  static unsigned char kludge;
+#endif /* DOSX_USE_INT_INTERCEPT */
+
+static int
+DOSX_install_kbd_hook (void)
+{
+#ifdef DOSX_USE_INT_INTERCEPT
+
+  int_intercept (DOS_INTVECT_SYSTEM_SERVICES, 
+                 bios_keyboard_handler, 
+                 256);
+
+  scheme_PM_vector = ((void *) & kludge);
+
+#else /* not DOSX_USE_INT_INTERCEPT */
+#ifndef DOSX_PM_HANDLER_UNTOUCHED
+  if (!under_QEMM_386_p ())
+  {
+    extern void DOSX_scheme_system_isr (void);
+    void * trampoline;
+
+    DOSX_PM_getvector (DOS_INTVECT_SYSTEM_SERVICES,
+                      & old_PM_vector_eip,
+                      & old_PM_vector_cs);
+    DOSX_RM_getvector (DOS_INTVECT_SYSTEM_SERVICES,
+                      & old_RM_vector.fp);
+
+    trampoline = (make_PM_trampoline (DOSX_scheme_system_isr));
+    if (trampoline == ((void *) NULL))
+      return (DOS_FAILURE);
+
+    DOSX_installvector (DOS_INTVECT_SYSTEM_SERVICES,
+                       ((unsigned) trampoline),
+                       ((unsigned) (getCS ())));
+
+    scheme_PM_vector = trampoline;
+  }
+#endif /* DOSX_PM_HANDLER_UNTOUCHED */
+
+#ifdef DOSX_RM_HANDLER_REAL
+  {
+    void * RM_handler;
+    union RM_address new_handler;
+
+    DOSX_RM_getvector (DOS_INTVECT_SYSTEM_SERVICES,
+                      ((unsigned *) & old_RM_vector));
+
+    RM_handler = (make_RM_handler ());
+    if (RM_handler == ((void *) NULL))
+      return (DOS_FAILURE);
+
+#if 0
+
+    if ((DOSX_convert_PM_to_RM_address ((getDS ()), ((unsigned) RM_handler),
+                                       RM_ISR_TOTAL_SIZE,
+                                       ((unsigned *) & new_handler)))
+       != DOS_SUCCESS)
+    {
+      int saved_errno = errno;
+
+      fflush (stdout);
+      free (RM_handler);
+      errno = saved_errno;
+      return (DOS_FAILURE);
+    }
+    
+    if ((new_handler.x.off & 0xf) != 0)
+    {
+      fflush (stdout);
+      free (RM_handler);
+      errno = EFAULT;
+      return (DOS_FAILURE);
+    }
+
+    normalize_RM_address (& new_handler);
+
+    if ((DOSX_RM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                           ((unsigned) new_handler)))
+       != DOS_SUCCESS)
+    {
+      fflush (stdout);
+      free (RM_handler);
+      errno = EFAULT;
+      return (DOS_FAILURE);
+    }
+
+#else /* not 0 */
+    
+#if 0
+    printf ("Allocating DOS block.\n");
+#endif
+    if ((DOSX_allocate_DOS_block (RM_ISR_TOTAL_SIZE, &new_handler.x.seg))
+       != DOS_SUCCESS)
+    {
+      int saved_errno = errno;
+
+#if 0
+      printf ("Failed allocating DOS block.\n");
+#endif
+      free (RM_handler);
+      errno = saved_errno;
+      return (DOS_FAILURE);
+    }
+    new_handler.x.off = 0;
+
+#if 0
+    printf ("Allocated DOS memory.\n");
+#endif
+
+    /* This assumes that the bottom 1 Mb of memory is mapped to the DOS
+       memory, so it can be accessed directly.
+     */
+
+    memcpy (((void *) ((unsigned long) new_handler.x.seg << 4)),
+           RM_handler,
+           RM_ISR_TOTAL_SIZE);
+
+#if 0
+    printf ("memcpy'd.\n");
+#endif
+
+    if ((DOSX_RM_setvector (DOS_INTVECT_SYSTEM_SERVICES, new_handler.fp))
+       != DOS_SUCCESS)
+    {
+#if 0
+      printf ("Failed to install real mode handler.\n");
+#endif
+
+      DOSX_free_DOS_block (new_handler.x.seg);
+      fflush (stdout);
+      free (RM_handler);
+      errno = EFAULT;
+      return (DOS_FAILURE);
+    }
+    DOSX_RM_segment = new_handler.x.seg;
+
+#if 0
+    printf ("Installed real mode handler.\n");
+#endif
+
+#endif /* 0 */
+
+    scheme_RM_vector = RM_handler;
+  }
+
+#endif /* DOSX_PM_HANDLER_UNTOUCHED */
+#endif /* DOSX_USE_INT_INTERCEPT */
+  return (DOS_SUCCESS);
+}
+\f
+static int
+DOSX_restore_kbd_hook (void)
+{
+#ifdef DOSX_USE_INT_INTERCEPT
+
+  (void) int_restore (DOS_INTVECT_SYSTEM_SERVICES);
+  scheme_PM_vector = ((void *) NULL);
+  
+#else /* not DOSX_USE_INT_INTERCEPT */
+#ifndef DOSX_PM_HANDLER_UNTOUCHED
+
+  DOSX_restore_vector (DOS_INTVECT_SYSTEM_SERVICES,
+                      old_PM_vector_eip, 
+                      old_PM_vector_cs,
+                      old_RM_vector.fp);
+
+  free (scheme_PM_vector);
+  scheme_PM_vector = ((void *) NULL);
+
+#endif /* DOSX_PM_HANDLER_UNTOUCHED */
+
+#ifdef DOSX_RM_HANDLER_REAL
+
+  if ((DOSX_RM_setvector (DOS_INTVECT_SYSTEM_SERVICES,
+                         ((unsigned) old_RM_vector)))
+      != DOS_SUCCESS)
+    return (DOS_FAILURE);
+
+#if 1
+
+  if ((DOSX_free_DOS_block (DOSX_RM_segment)) != DOS_SUCCESS)
+    return (DOS_FAILURE);
+  DOSX_RM_segment = 0;
+
+#endif /* 1 */
+
+  free (scheme_RM_vector);
+  scheme_RM_vector = ((void *) NULL);
+
+#endif /* DOSX_RM_HANDLER_REAL */
+#endif /* DOSX_USE_INT_INTERCEPT */
+  return (DOS_SUCCESS);
+}
+\f
+int
+dos_install_kbd_hook (void)
+{
+  if (scheme_PM_vector != ((void *) NULL))
+  {
+    errno = ELOOP;
+    return (DOS_FAILURE);
+  }
+  if (under_DPMI_p ())
+    return (DPMI_install_kbd_hook ());
+  else
+    return (DOSX_install_kbd_hook ());
+}
+
+int
+dos_restore_kbd_hook (void)
+{
+  if ((scheme_PM_vector == ((void *) NULL))
+      && (scheme_RM_vector == ((void *) NULL)))
+    return (DOS_SUCCESS);
+  else if (!under_DPMI_p ())
+  {
+    if ((DOSX_restore_kbd_hook ()) != DOS_SUCCESS)
+      return (DOS_FAILURE);
+  }
+  else if ((DPMI_restore_kbd_hook ()) != DOS_SUCCESS)
+    return (DOS_FAILURE);
+
+  if (scheme_PM_vector != ((void *) NULL))
+  {
+    free (scheme_PM_vector);
+    scheme_PM_vector = ((void *) NULL);
+  }
+  if (scheme_RM_vector != ((void *) NULL))
+  {
+    free (scheme_RM_vector);
+    scheme_RM_vector = ((void *) NULL);
+  }
+  return (DOS_SUCCESS);
+}
+
+unsigned char
+dos_set_kbd_modifier_mask (unsigned char new_mask)
+{
+  unsigned char old_mask = modifier_mask;
+
+  modifier_mask = new_mask;
+
+#ifdef DPMI_RM_HANDLER_REAL
+
+  if (DPMI_RM_selector != 0)
+    farcpy (RM_ISR_MASK_OFFSET, DPMI_RM_selector, 
+           ((unsigned) (& modifier_mask)), (getDS ()),
+           1);
+
+#endif /* DPMI_RM_HANDLER_REAL */
+
+#ifdef DOSX_RM_HANDLER_REAL
+
+  if (DOSX_RM_segment != 0)
+    (* ((unsigned char *)
+       ((((unsigned long) DOSX_RM_segment) << 4) + RM_ISR_MASK_OFFSET)))
+      = modifier_mask;
+
+#endif /* DOSX_RM_HANDLER_REAL */
+
+  return (old_mask);
+}
diff --git a/v7/src/microcode/doskbd.h b/v7/src/microcode/doskbd.h
new file mode 100644 (file)
index 0000000..6df68a2
--- /dev/null
@@ -0,0 +1,43 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/doskbd.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef _DOSKBD_H
+#  define _DOSKBD_H
+
+extern dos_boolean under_DPMI_p (void);
+extern int dos_install_kbd_hook (void);
+extern int dos_restore_kbd_hook (void);
+extern unsigned char dos_set_kbd_modifier_mask (unsigned char new_mask);
+
+#endif /* _DOSKBD_H */
diff --git a/v7/src/microcode/doskbutl.asm b/v7/src/microcode/doskbutl.asm
new file mode 100644 (file)
index 0000000..7a94c7a
--- /dev/null
@@ -0,0 +1,221 @@
+;;; -*-Midas-*-
+;;;
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/doskbutl.asm,v 1.1 1992/05/05 06:55:13 jinx Exp $
+;;;
+;;;    Copyright (c) 1992 Massachusetts Institute of Technology
+;;;
+;;;    This material was developed by the Scheme project at the
+;;;    Massachusetts Institute of Technology, Department of
+;;;    Electrical Engineering and Computer Science.  Permission to
+;;;    copy this software, to redistribute it, and to use it for any
+;;;    purpose is granted, subject to the following restrictions and
+;;;    understandings.
+;;;
+;;;    1. Any copy made of this software must include this copyright
+;;;    notice in full.
+;;;
+;;;    2. Users of this software agree to make their best efforts (a)
+;;;    to return to the MIT Scheme project any improvements or
+;;;    extensions that they make, so that these may be included in
+;;;    future releases; and (b) to inform MIT of noteworthy uses of
+;;;    this software.
+;;;
+;;;    3. All materials developed as a consequence of the use of this
+;;;    software shall duly acknowledge such use, in accordance with
+;;;    the usual standards of acknowledging credit in academic
+;;;    research.
+;;;
+;;;    4. MIT has made no warrantee or representation that the
+;;;    operation of this software will be error-free, and MIT is
+;;;    under no obligation to provide any services, by way of
+;;;    maintenance, update, or otherwise.
+;;;
+;;;    5. In conjunction with products arising from the use of this
+;;;    material, there shall be no use of the name of the
+;;;    Massachusetts Institute of Technology nor of any adaptation
+;;;    thereof in any advertising, promotional, or sales literature
+;;;    without prior written consent from MIT in each case.
+;;;
+
+.386
+.model small
+       .code
+\f
+;;     Stack on entry to _DOSX_scheme_system_isr
+;;
+;;32   IRETD EFLAGS
+;;28   IRETD CS
+;;24   IRETD EIP
+;;20   CS for next handler in chain
+;;16   EIP for next handler in chain
+;;12    address of modifier mask
+;;8    offset for unshifted table
+;;4    offset for shifted table
+;;0    DS for scan_code to ascii tables
+
+       public _DOSX_scheme_system_isr
+       public _DPMI_PM_scheme_system_isr
+
+_DOSX_scheme_system_isr:
+_DPMI_PM_scheme_system_isr:
+       pushfd
+       call    scheme_system_isr
+       jnc     DOSX_scheme_system_dismiss
+
+;; Chain to next handler (flags unmodified)
+       popfd
+       lea     esp,16[esp]
+;      ret     far
+       db      0cbh
+
+;; Dismiss/finish interrupt (update flags)
+
+DOSX_scheme_system_dismiss:
+       push    eax
+       mov     eax,4[esp]              ;updated flags
+       mov     40[esp],eax             ;flags to restore
+       pop     eax
+       popfd
+       lea     esp,24[esp]
+       iretd           
+\f
+;;     Stack on entry to _DPMI_scheme_system_isr
+;;
+;;20   CS for next (real mode) handler in chain
+;;16   IP for next (real mode) handler in chain
+;;12    address of modifier mask
+;;8    offset for unshifted table
+;;4    offset for shifted table
+;;0    DS for scan_code to ascii tables
+
+       public _DPMI_RM_scheme_system_isr
+_DPMI_RM_scheme_system_isr:
+       mov     eax,es:28[edi]          ; real mode eax
+       xor     edx,edx
+       mov     dx,es:32[edi]           ; real mode flags
+       push    edx
+       call    scheme_system_isr
+       jnc     DPMI_scheme_system_dismiss
+
+;; Chain to next real mode handler (flags unmodified)
+       lea     esp,4[esp]              ; drop flags
+       mov     eax,16[esp]             ; real mode IP (padded to dword)
+       mov     es:42[edi],ax
+       mov     eax,20[esp]             ; real mode CS (padded to dword)
+       mov     es:44[edi],ax
+       lea     esp,24[esp]             ; pop args
+       iret                            ; tell DPMI we're done
+
+;; Dismiss/finish interrupt in real mode (update flags, simulate RM iret)
+
+DPMI_scheme_system_dismiss:
+       pop     eax                     ; updated flags
+       mov     es:32[edi],ax
+       mov     ax,ds:[esi]             ; real mode IRET ip
+       mov     es:42[edi],ax
+       mov     ax,ds:2[esi]            ; real mode IRET cs
+       mov     es:44[edi],ax
+       add     word ptr es:46[edi],6   ; bump real mode sp
+       lea     esp,24[esp]             ; pop args
+       iret                            ; tell DPMI we're done  
+\f
+;;     Stack on entry to scheme_system_isr
+;;
+;;24    address of modifier mask
+;;20   offset for unshifted table
+;;16   offset for shifted table
+;;12   DS for scan_code to ascii tables
+;;8    Flags to restore/modify
+;;4    EIP for low-level hook (DPMI or DOSX)
+;;0    Old ebp [pushed on entry]
+;;
+;;     Arguments:
+;; AL = scan code
+;; AH = 4fh
+;; CF set
+;;
+;;     Return:
+;; AL = scan code
+;; CF clear if scan code should be ignored (interrupt dismissed).
+
+chain_to_next_handler:
+       stc                             ; set the carry flag
+       ret
+
+scheme_system_isr:
+       cmp     ah,4fh
+       jne     chain_to_next_handler
+       cmp     al,39h
+        ja      chain_to_next_handler
+
+;; process a keystroke
+
+       push    ebp
+       mov     ebp,esp
+        push    eax             ; Preserve accross interrupt
+
+        mov     ah,2h           ; Get shift bits
+        int     16h             ; Return in AL
+        
+        push    ecx
+        push    edx             ; Preserve regs
+        push    es
+
+        mov     edx,12[ebp]      ; Segment selector
+        push    edx
+        pop     es
+       
+        mov     edx,24[ebp]     ; Modifier mask address
+        and     al,es:[edx]     ; Ignore modifiers
+        push    eax             ; Save result
+        
+        mov     ecx,-4[ebp]     ; Scan code + function number
+        and     ecx,3fh         ; Only scan code
+        mov     edx,20[ebp]     ; Unshifted table offset
+        and     eax,47h         ; Shift, ctrl, and CAPS-LOCK mask
+        cmp     al,0
+        je      index_into_table
+        mov     edx,16[ebp]      ; Shifted table offset
+\f
+index_into_table:
+        mov     al,es:[edx] [ecx]  ; Get ASCII value
+        pop     edx             ; Masked modifier bits
+        cmp     al,0            ; Null entries mean chain
+        je      abort_translation
+
+        bt      edx,2           ; Control set?
+        jnc     after_control
+        and     al,09fh         ; Clear bits 6 and 5
+
+after_control:
+        bt      edx,3           ; Alt set?
+        jnc     after_meta
+        or      al,080h         ; Set bit 8
+
+after_meta:
+        mov     ecx,-4[ebp]     ; Get scan code
+       mov     ch,cl
+        mov     cl,al           ; Transfer ASCII value
+        
+        mov     ah,5h           ; Insert keystroke
+        int     16h             ; CH = scan code, CL = ASCII
+                                ; returns AL = 0h if win, 1h if buffer full
+
+       and     byte ptr 8[ebp],0feh    ; clear interrupt carry flag
+        pop     es
+        pop     edx
+        pop     ecx
+       pop     eax
+       pop     ebp
+       clc                             ; clear our carry flag
+       ret
+
+abort_translation:
+        pop     es
+        pop     edx
+        pop     ecx
+       pop     eax
+       pop     ebp
+       stc                             ; set carry flag
+       ret
+end
diff --git a/v7/src/microcode/dosscan.h b/v7/src/microcode/dosscan.h
new file mode 100644 (file)
index 0000000..0332640
--- /dev/null
@@ -0,0 +1,359 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosscan.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* Scan code conversion table for DOS */
+
+#ifndef SCM_DOSSCAN_INCLUDE
+#define SCM_DOSSCAN_INCLUDE
+
+#define Metafy(c)      ((unsigned char) (((unsigned char) (c))+128))
+/* This had better get uppercase characters */ 
+#define Controlify(c)  ((unsigned char) (((unsigned char) (c))-64))
+
+#define NO_CONVERSION  ((unsigned char *) ((void *) 0))
+
+unsigned char CTRL_AT[] = { '\0' };
+unsigned char META_a[] = {Metafy('a'), '\0'};
+unsigned char META_b[] = {Metafy('b'), '\0'};
+unsigned char META_c[] = {Metafy('c'), '\0'};
+unsigned char META_d[] = {Metafy('d'), '\0'};
+unsigned char META_e[] = {Metafy('e'), '\0'};
+unsigned char META_f[] = {Metafy('f'), '\0'};
+unsigned char META_g[] = {Metafy('g'), '\0'};
+unsigned char META_h[] = {Metafy('h'), '\0'};
+unsigned char META_i[] = {Metafy('i'), '\0'};
+unsigned char META_j[] = {Metafy('j'), '\0'};
+unsigned char META_k[] = {Metafy('k'), '\0'};
+unsigned char META_l[] = {Metafy('l'), '\0'};
+unsigned char META_m[] = {Metafy('m'), '\0'};
+unsigned char META_n[] = {Metafy('n'), '\0'};
+unsigned char META_o[] = {Metafy('o'), '\0'};
+unsigned char META_p[] = {Metafy('p'), '\0'};
+unsigned char META_q[] = {Metafy('q'), '\0'};
+unsigned char META_r[] = {Metafy('r'), '\0'};
+unsigned char META_s[] = {Metafy('s'), '\0'};
+unsigned char META_t[] = {Metafy('t'), '\0'};
+unsigned char META_u[] = {Metafy('u'), '\0'};
+unsigned char META_v[] = {Metafy('v'), '\0'};
+unsigned char META_w[] = {Metafy('w'), '\0'};
+unsigned char META_x[] = {Metafy('x'), '\0'};
+unsigned char META_y[] = {Metafy('y'), '\0'};
+unsigned char META_z[] = {Metafy('z'), '\0'};
+unsigned char META_1[] = {Metafy('1'), '\0'};
+unsigned char META_2[] = {Metafy('2'), '\0'};
+unsigned char META_3[] = {Metafy('3'), '\0'};
+unsigned char META_4[] = {Metafy('4'), '\0'};
+unsigned char META_5[] = {Metafy('5'), '\0'};
+unsigned char META_6[] = {Metafy('6'), '\0'};
+unsigned char META_7[] = {Metafy('7'), '\0'};
+unsigned char META_8[] = {Metafy('8'), '\0'};
+unsigned char META_9[] = {Metafy('9'), '\0'};
+unsigned char META_0[] = {Metafy('0'), '\0'};
+unsigned char META_DASH[] = {Metafy('-'), '\0'};
+unsigned char META_EQUAL[] = {Metafy('='), '\0'};
+unsigned char META_RET[] = {Metafy('\r'), '\0'};
+unsigned char META_TAB[] = {Metafy('\t'), '\0'};
+unsigned char META_LBROK[] = {Metafy('['), '\0'};
+unsigned char META_RBROK[] = {Metafy(']'), '\0'};
+unsigned char META_BACK[] = {Metafy('\\'), '\0'};
+unsigned char META_SEMI[] = {Metafy(';'), '\0'};
+unsigned char META_RQUOTE[] = {Metafy('\''), '\0'};
+unsigned char META_COMMA[] = {Metafy(','), '\0'};
+unsigned char META_DOT[] = {Metafy('.'), '\0'};
+unsigned char META_SLASH[] = {Metafy('/'), '\0'};
+unsigned char META_LQUOTE[] = {Metafy('`'), '\0'};
+unsigned char META_PLUS[] = {Metafy('+'), '\0'};
+
+#define DEFAULT_SCANCODE_CONVERSIONS                           \
+{                                                              \
+/* 0 */                NO_CONVERSION,                                  \
+/* 1 */                NO_CONVERSION,                                  \
+/* 2 */                NO_CONVERSION,                                  \
+/* 3 */                CTRL_AT,                                        \
+/* 4 */                NO_CONVERSION,                                  \
+/* 5 */                NO_CONVERSION,                                  \
+/* 6 */                NO_CONVERSION,                                  \
+/* 7 */                NO_CONVERSION,                                  \
+/* 8 */                NO_CONVERSION,                                  \
+/* 9 */                NO_CONVERSION,                                  \
+/* 10 */       NO_CONVERSION,                                  \
+/* 11 */       NO_CONVERSION,                                  \
+/* 12 */       NO_CONVERSION,                                  \
+/* 13 */       NO_CONVERSION,                                  \
+/* 14 */       NO_CONVERSION,                                  \
+/* 15 */       NO_CONVERSION,                                  \
+/* 16 */       META_q,                                         \
+/* 17 */       META_w,                                         \
+/* 18 */       META_e,                                         \
+/* 19 */       META_r,                                         \
+/* 20 */       META_t,                                         \
+/* 21 */       META_y,                                         \
+/* 22 */       META_u,                                         \
+/* 23 */       META_i,                                         \
+/* 24 */       META_o,                                         \
+/* 25 */       META_p,                                         \
+/* 26 */       META_LBROK,                                     \
+/* 27 */       META_RBROK,                                     \
+/* 28 */       META_RET,                                       \
+/* 29 */       NO_CONVERSION,                                  \
+/* 30 */       META_a,                                         \
+/* 31 */       META_s,                                         \
+/* 32 */       META_d,                                         \
+/* 33 */       META_f,                                         \
+/* 34 */       META_g,                                         \
+/* 35 */       META_h,                                         \
+/* 36 */       META_j,                                         \
+/* 37 */       META_k,                                         \
+/* 38 */       META_l,                                         \
+/* 39 */       META_SEMI,                                      \
+/* 40 */       META_RQUOTE,                                    \
+/* 41 */       META_LQUOTE,                                    \
+/* 42 */       NO_CONVERSION,                                  \
+/* 43 */       META_BACK,                                      \
+/* 44 */       META_z,                                         \
+/* 45 */       META_x,                                         \
+/* 46 */       META_c,                                         \
+/* 47 */       META_v,                                         \
+/* 48 */       META_b,                                         \
+/* 49 */       META_n,                                         \
+/* 50 */       META_m,                                         \
+/* 51 */       META_COMMA,                                     \
+/* 52 */       META_DOT,                                       \
+/* 53 */       META_SLASH,                                     \
+/* 54 */       NO_CONVERSION,                                  \
+/* 55 */       META_PLUS,                                      \
+/* 56 */       NO_CONVERSION,                                  \
+/* 57 */       NO_CONVERSION,                                  \
+/* 58 */       NO_CONVERSION,                                  \
+/* 59 */       "(proceed)\r",                                  \
+/* 60 */       NO_CONVERSION,                                  \
+/* 61 */       NO_CONVERSION,                                  \
+/* 62 */       NO_CONVERSION,                                  \
+/* 63 */       NO_CONVERSION,                                  \
+/* 64 */       NO_CONVERSION,                                  \
+/* 65 */       NO_CONVERSION,                                  \
+/* 66 */       NO_CONVERSION,                                  \
+/* 67 */       NO_CONVERSION,                                  \
+/* 68 */       NO_CONVERSION,                                  \
+/* 69 */       NO_CONVERSION,                                  \
+/* 70 */       NO_CONVERSION,                                  \
+/* 71 */       NO_CONVERSION,                                  \
+/* 72 */       NO_CONVERSION,                                  \
+/* 73 */       NO_CONVERSION,                                  \
+/* 74 */       META_SLASH,                                     \
+/* 75 */       NO_CONVERSION,                                  \
+/* 76 */       NO_CONVERSION,                                  \
+/* 77 */       NO_CONVERSION,                                  \
+/* 78 */       NO_CONVERSION,                                  \
+/* 79 */       NO_CONVERSION,                                  \
+/* 80 */       NO_CONVERSION,                                  \
+/* 81 */       NO_CONVERSION,                                  \
+/* 82 */       NO_CONVERSION,                                  \
+/* 83 */       NO_CONVERSION,                                  \
+/* 84 */       NO_CONVERSION,                                  \
+/* 85 */       NO_CONVERSION,                                  \
+/* 86 */       NO_CONVERSION,                                  \
+/* 87 */       NO_CONVERSION,                                  \
+/* 88 */       NO_CONVERSION,                                  \
+/* 89 */       NO_CONVERSION,                                  \
+/* 90 */       NO_CONVERSION,                                  \
+/* 91 */       NO_CONVERSION,                                  \
+/* 92 */       NO_CONVERSION,                                  \
+/* 93 */       NO_CONVERSION,                                  \
+/* 94 */       NO_CONVERSION,                                  \
+/* 95 */       NO_CONVERSION,                                  \
+/* 96 */       NO_CONVERSION,                                  \
+/* 97 */       NO_CONVERSION,                                  \
+/* 98 */       NO_CONVERSION,                                  \
+/* 99 */       NO_CONVERSION,                                  \
+/* 100 */      NO_CONVERSION,                                  \
+/* 101 */      NO_CONVERSION,                                  \
+/* 102 */      NO_CONVERSION,                                  \
+/* 103 */      NO_CONVERSION,                                  \
+/* 104 */      NO_CONVERSION,                                  \
+/* 105 */      NO_CONVERSION,                                  \
+/* 106 */      NO_CONVERSION,                                  \
+/* 107 */      NO_CONVERSION,                                  \
+/* 108 */      NO_CONVERSION,                                  \
+/* 109 */      NO_CONVERSION,                                  \
+/* 110 */      NO_CONVERSION,                                  \
+/* 111 */      NO_CONVERSION,                                  \
+/* 112 */      NO_CONVERSION,                                  \
+/* 113 */      NO_CONVERSION,                                  \
+/* 114 */      NO_CONVERSION,                                  \
+/* 115 */      NO_CONVERSION,                                  \
+/* 116 */      NO_CONVERSION,                                  \
+/* 117 */      NO_CONVERSION,                                  \
+/* 118 */      NO_CONVERSION,                                  \
+/* 119 */      NO_CONVERSION,                                  \
+/* 120 */      META_1,                                         \
+/* 121 */      META_2,                                         \
+/* 122 */      META_3,                                         \
+/* 123 */      META_4,                                         \
+/* 124 */      META_5,                                         \
+/* 125 */      META_6,                                         \
+/* 126 */      META_7,                                         \
+/* 127 */      META_8,                                         \
+/* 128 */      META_9,                                         \
+/* 129 */      META_0,                                         \
+/* 130 */      META_DASH,                                      \
+/* 131 */      META_EQUAL,                                     \
+/* 132 */      NO_CONVERSION,                                  \
+/* 133 */      NO_CONVERSION,                                  \
+/* 134 */      NO_CONVERSION,                                  \
+/* 135 */      NO_CONVERSION,                                  \
+/* 136 */      NO_CONVERSION,                                  \
+/* 137 */      NO_CONVERSION,                                  \
+/* 138 */      NO_CONVERSION,                                  \
+/* 139 */      NO_CONVERSION,                                  \
+/* 140 */      NO_CONVERSION,                                  \
+/* 141 */      NO_CONVERSION,                                  \
+/* 142 */      NO_CONVERSION,                                  \
+/* 143 */      NO_CONVERSION,                                  \
+/* 144 */      NO_CONVERSION,                                  \
+/* 145 */      NO_CONVERSION,                                  \
+/* 146 */      NO_CONVERSION,                                  \
+/* 147 */      NO_CONVERSION,                                  \
+/* 148 */      NO_CONVERSION,                                  \
+/* 149 */      NO_CONVERSION,                                  \
+/* 150 */      NO_CONVERSION,                                  \
+/* 151 */      NO_CONVERSION,                                  \
+/* 152 */      NO_CONVERSION,                                  \
+/* 153 */      NO_CONVERSION,                                  \
+/* 154 */      NO_CONVERSION,                                  \
+/* 155 */      NO_CONVERSION,                                  \
+/* 156 */      NO_CONVERSION,                                  \
+/* 157 */      NO_CONVERSION,                                  \
+/* 158 */      NO_CONVERSION,                                  \
+/* 159 */      NO_CONVERSION,                                  \
+/* 160 */      NO_CONVERSION,                                  \
+/* 161 */      NO_CONVERSION,                                  \
+/* 162 */      NO_CONVERSION,                                  \
+/* 163 */      NO_CONVERSION,                                  \
+/* 164 */      META_DASH,                                      \
+/* 165 */      META_TAB,                                       \
+/* 166 */      META_RET,                                       \
+/* 167 */      NO_CONVERSION,                                  \
+/* 168 */      NO_CONVERSION,                                  \
+/* 169 */      NO_CONVERSION,                                  \
+/* 170 */      NO_CONVERSION,                                  \
+/* 171 */      NO_CONVERSION,                                  \
+/* 172 */      NO_CONVERSION,                                  \
+/* 173 */      NO_CONVERSION,                                  \
+/* 174 */      NO_CONVERSION,                                  \
+/* 175 */      NO_CONVERSION,                                  \
+/* 176 */      NO_CONVERSION,                                  \
+/* 177 */      NO_CONVERSION,                                  \
+/* 178 */      NO_CONVERSION,                                  \
+/* 179 */      NO_CONVERSION,                                  \
+/* 180 */      NO_CONVERSION,                                  \
+/* 181 */      NO_CONVERSION,                                  \
+/* 182 */      NO_CONVERSION,                                  \
+/* 183 */      NO_CONVERSION,                                  \
+/* 184 */      NO_CONVERSION,                                  \
+/* 185 */      NO_CONVERSION,                                  \
+/* 186 */      NO_CONVERSION,                                  \
+/* 187 */      NO_CONVERSION,                                  \
+/* 188 */      NO_CONVERSION,                                  \
+/* 189 */      NO_CONVERSION,                                  \
+/* 190 */      NO_CONVERSION,                                  \
+/* 191 */      NO_CONVERSION,                                  \
+/* 192 */      NO_CONVERSION,                                  \
+/* 193 */      NO_CONVERSION,                                  \
+/* 194 */      NO_CONVERSION,                                  \
+/* 195 */      NO_CONVERSION,                                  \
+/* 196 */      NO_CONVERSION,                                  \
+/* 197 */      NO_CONVERSION,                                  \
+/* 198 */      NO_CONVERSION,                                  \
+/* 199 */      NO_CONVERSION,                                  \
+/* 200 */      NO_CONVERSION,                                  \
+/* 201 */      NO_CONVERSION,                                  \
+/* 202 */      NO_CONVERSION,                                  \
+/* 203 */      NO_CONVERSION,                                  \
+/* 204 */      NO_CONVERSION,                                  \
+/* 205 */      NO_CONVERSION,                                  \
+/* 206 */      NO_CONVERSION,                                  \
+/* 207 */      NO_CONVERSION,                                  \
+/* 208 */      NO_CONVERSION,                                  \
+/* 209 */      NO_CONVERSION,                                  \
+/* 210 */      NO_CONVERSION,                                  \
+/* 211 */      NO_CONVERSION,                                  \
+/* 212 */      NO_CONVERSION,                                  \
+/* 213 */      NO_CONVERSION,                                  \
+/* 214 */      NO_CONVERSION,                                  \
+/* 215 */      NO_CONVERSION,                                  \
+/* 216 */      NO_CONVERSION,                                  \
+/* 217 */      NO_CONVERSION,                                  \
+/* 218 */      NO_CONVERSION,                                  \
+/* 219 */      NO_CONVERSION,                                  \
+/* 220 */      NO_CONVERSION,                                  \
+/* 221 */      NO_CONVERSION,                                  \
+/* 222 */      NO_CONVERSION,                                  \
+/* 223 */      NO_CONVERSION,                                  \
+/* 224 */      NO_CONVERSION,                                  \
+/* 225 */      NO_CONVERSION,                                  \
+/* 226 */      NO_CONVERSION,                                  \
+/* 227 */      NO_CONVERSION,                                  \
+/* 228 */      NO_CONVERSION,                                  \
+/* 229 */      NO_CONVERSION,                                  \
+/* 230 */      NO_CONVERSION,                                  \
+/* 231 */      NO_CONVERSION,                                  \
+/* 232 */      NO_CONVERSION,                                  \
+/* 233 */      NO_CONVERSION,                                  \
+/* 234 */      NO_CONVERSION,                                  \
+/* 235 */      NO_CONVERSION,                                  \
+/* 236 */      NO_CONVERSION,                                  \
+/* 237 */      NO_CONVERSION,                                  \
+/* 238 */      NO_CONVERSION,                                  \
+/* 239 */      NO_CONVERSION,                                  \
+/* 240 */      NO_CONVERSION,                                  \
+/* 241 */      NO_CONVERSION,                                  \
+/* 242 */      NO_CONVERSION,                                  \
+/* 243 */      NO_CONVERSION,                                  \
+/* 244 */      NO_CONVERSION,                                  \
+/* 245 */      NO_CONVERSION,                                  \
+/* 246 */      NO_CONVERSION,                                  \
+/* 247 */      NO_CONVERSION,                                  \
+/* 248 */      NO_CONVERSION,                                  \
+/* 249 */      NO_CONVERSION,                                  \
+/* 250 */      NO_CONVERSION,                                  \
+/* 251 */      NO_CONVERSION,                                  \
+/* 252 */      NO_CONVERSION,                                  \
+/* 253 */      NO_CONVERSION,                                  \
+/* 254 */      NO_CONVERSION,                                  \
+/* 255 */      NO_CONVERSION                                   \
+}
+
+#define KEYBOARD_SCANCODE_TABLE_SIZE   (256)
+#endif
diff --git a/v7/src/microcode/dosselec.h b/v7/src/microcode/dosselec.h
new file mode 100644 (file)
index 0000000..bce034d
--- /dev/null
@@ -0,0 +1,50 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosselec.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef SCM_DOSSELECT_H
+#define SCM_DOSSELECT_H
+
+enum select_input
+{
+  select_input_argument,
+  select_input_other,
+  select_input_none,
+  select_input_process_status,
+  select_input_interrupt
+};
+
+extern CONST int DOS_have_select_p;
+extern enum select_input EXFUN (DOS_select_input, (int fd, int blockp));
+
+#endif /* SCM_DOSSELECT_H */
diff --git a/v7/src/microcode/dossig.c b/v7/src/microcode/dossig.c
new file mode 100644 (file)
index 0000000..061d6f4
--- /dev/null
@@ -0,0 +1,880 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dossig.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "config.h"
+#include <signal.h>
+#include <int.h>
+#include "ossig.h"
+#include "osctty.h"
+#include "ostty.h"
+#include "critsec.h"
+#include <bios.h>
+#include "dossys.h"
+#include "dosexcp.h"
+#include "doskbd.h"
+\f
+/* Signal Manipulation */
+
+static Tsignal_handler
+DEFUN (current_handler, (signo), int signo)
+{
+  Tsignal_handler result = (DOS_signal (signo, SIG_IGN));
+  if (result != SIG_IGN)
+    DOS_signal (signo, result);
+  return (result);
+}
+
+#define INSTALL_HANDLER DOS_signal
+#define NEED_HANDLER_TRANSACTION
+
+#define ENTER_HANDLER(signo)
+#define ABORT_HANDLER DOS_signal
+#define EXIT_HANDLER DOS_signal
+
+/* These could be implemented, at least under DPMI by examining
+   and setting the virtual interrupt state.
+ */
+
+void
+DEFUN_VOID (preserve_signal_mask)
+{
+}
+
+void
+DEFUN_VOID (block_signals)
+{
+}
+
+void
+DEFUN_VOID (unblock_signals)
+{
+}
+\f
+/* Signal Descriptors */
+
+enum dfl_action { dfl_terminate, dfl_ignore, dfl_stop };
+
+struct signal_descriptor
+{
+  int signo;
+  CONST char * name;
+  enum dfl_action action;
+  int flags;
+};
+
+/* `flags' bits */
+#define NOIGNORE 1
+#define NOBLOCK 2
+#define NOCATCH 4
+#define CORE_DUMP 8
+
+static struct signal_descriptor * signal_descriptors;
+static unsigned int signal_descriptors_length;
+static unsigned int signal_descriptors_limit;
+
+static void
+DEFUN (defsignal, (signo, name, action, flags),
+       int signo AND
+       CONST char * name AND
+       enum dfl_action action AND
+       int flags)
+{
+  if (signo == 0)
+    return;
+  if (signal_descriptors_length == signal_descriptors_limit)
+    {
+      signal_descriptors_limit += 8;
+      signal_descriptors =
+       (DOS_realloc (signal_descriptors,
+                    (signal_descriptors_limit *
+                     (sizeof (struct signal_descriptor)))));
+      if (signal_descriptors == 0)
+       {
+         fprintf (stderr, "\nUnable to grow signal definitions table.\n");
+         fflush (stderr);
+         termination_init_error ();
+       }
+    }
+  {
+    struct signal_descriptor * sd =
+      (signal_descriptors + (signal_descriptors_length++));
+    (sd -> signo) = signo;
+    (sd -> name) = name;
+    (sd -> action) = action;
+    (sd -> flags) = flags;
+  }
+}
+
+static struct signal_descriptor *
+DEFUN (find_signal_descriptor, (signo), int signo)
+{
+  struct signal_descriptor * scan = signal_descriptors;
+  struct signal_descriptor * end = (scan + signal_descriptors_length);
+  for (; (scan < end); scan += 1)
+    if ((scan -> signo) == signo)
+      return (scan);
+  return (0);
+}
+
+CONST char *
+DEFUN (find_signal_name, (signo), int signo)
+{
+  static char buffer [32];
+  struct signal_descriptor * descriptor = (find_signal_descriptor (signo));
+  if (descriptor != 0)
+    return (descriptor -> name);
+  sprintf (buffer, "unknown signal %d", signo);
+  return ((CONST char *) buffer);
+}
+\f
+#define OS_SPECIFIC_SIGNALS()
+
+#if (SIGABRT == SIGIOT)
+#undef SIGABRT
+#define SIGABRT 0
+#endif
+
+static void
+DEFUN_VOID (initialize_signal_descriptors)
+{
+  signal_descriptors_length = 0;
+  signal_descriptors_limit = 32;
+  signal_descriptors =
+    (DOS_malloc (signal_descriptors_limit *
+                (sizeof (struct signal_descriptor))));
+  if (signal_descriptors == 0)
+    {
+      fprintf (stderr, "\nUnable to allocate signal definitions table.\n");
+      fflush (stderr);
+      termination_init_error ();
+    }
+
+  defsignal (SIGINT, "SIGINT",         dfl_terminate,  0);
+  defsignal (SIGILL, "SIGILL",         dfl_terminate,  CORE_DUMP);
+  defsignal (SIGFPE, "SIGFPE",         dfl_terminate,  CORE_DUMP);
+  defsignal (SIGSEGV, "SIGSEGV",       dfl_terminate,  CORE_DUMP);
+  defsignal (SIGTERM, "SIGTERM",       dfl_terminate,  0);
+  defsignal (SIGABRT, "SIGABRT",       dfl_terminate,  CORE_DUMP);
+
+  OS_SPECIFIC_SIGNALS ();
+}
+\f
+/* Signal Handlers */
+
+struct handler_record
+{
+  int signo;
+  Tsignal_handler handler;
+};
+
+#define DEFUN_STD_HANDLER(name, statement)                             \
+static Tsignal_handler_result                                          \
+DEFUN (name, (signo), int signo)                                       \
+{                                                                      \
+  int STD_HANDLER_abortp;                                              \
+  ENTER_HANDLER (signo);                                               \
+  STD_HANDLER_abortp = (enter_interruption_extent ());                 \
+  transaction_begin ();                                                        \
+  {                                                                    \
+    struct handler_record * record =                                   \
+      (dstack_alloc (sizeof (struct handler_record)));                 \
+    (record -> signo) = signo;                                         \
+    (record -> handler) = 0;                                           \
+    transaction_record_action (tat_abort, ta_abort_handler, record);   \
+  }                                                                    \
+  statement;                                                           \
+  if (STD_HANDLER_abortp)                                              \
+    {                                                                  \
+      transaction_abort ();                                            \
+      exit_interruption_extent ();                                     \
+    }                                                                  \
+  transaction_commit ();                                               \
+  EXIT_HANDLER (signo, name);                                          \
+  SIGNAL_HANDLER_RETURN ();                                            \
+}
+
+static void
+DEFUN (ta_abort_handler, (ap), PTR ap)
+{
+  ABORT_HANDLER ((((struct handler_record *) ap) -> signo),
+                (((struct handler_record *) ap) -> handler));
+}
+\f
+#define CONTROL_B_INTERRUPT_CHAR 'B'
+#define CONTROL_G_INTERRUPT_CHAR 'G'
+#define CONTROL_U_INTERRUPT_CHAR 'U'
+#define CONTROL_X_INTERRUPT_CHAR 'X'
+#define GENERAL_INTERRUPT_CHAR  '!'
+#define NO_INTERRUPT_CHAR       '0'
+
+static void
+DEFUN (echo_keyboard_interrupt, (c, dc), cc_t c AND cc_t dc)
+{
+  c &= 0177;
+  if (c == ALERT_CHAR)
+    putc (c, stdout);
+  else if (c < '\040')
+    {
+      putc ('^', stdout);
+      putc ((c + '@'), stdout);
+    }
+  else if (c == '\177')
+    fputs ("^?", stdout);
+  else
+    putc (c, stdout);
+  fflush (stdout);
+}
+
+DEFUN_STD_HANDLER (sighnd_control_g,
+  { 
+    tty_set_next_interrupt_char (CONTROL_G_INTERRUPT_CHAR);
+  })
+    
+DEFUN_STD_HANDLER (sighnd_control_c,
+  { 
+    tty_set_next_interrupt_char (GENERAL_INTERRUPT_CHAR);
+  })
+
+/* Keyboard interrupt */
+#define KB_INT_TABLE_SIZE              ((256) + 1)
+
+#define CONTROL_B                      '\002'
+#define CONTROL_C                      '\003'
+#define CONTROL_G                      '\007'
+#define CONTROL_U                      '\025'
+#define CONTROL_X                      '\030'
+
+#define CONTROL_B_ENABLE               (0x1)
+#define CONTROL_G_ENABLE               (0x2)
+#define CONTROL_U_ENABLE               (0x4)
+#define CONTROL_X_ENABLE               (0x8)
+#define GENERAL_INTERRUPT_ENABLE       (0x10)
+
+/* This is a table and also a null terminated string. */
+unsigned char keyboard_interrupt_table[KB_INT_TABLE_SIZE];
+static unsigned char keyboard_interrupt_enables;
+
+void
+DEFUN (OS_ctty_get_interrupt_enables, (mask), Tinterrupt_enables * mask)
+{
+  *mask = (Tinterrupt_enables) keyboard_interrupt_enables;
+  return;
+}
+
+void 
+DEFUN (OS_ctty_set_interrupt_enables, (mask), Tinterrupt_enables * mask)
+{
+  keyboard_interrupt_enables = *mask;
+  return;
+}
+\f
+/* This is a temporary kludge. */
+
+#define NUM_INT_CHANNELS 5
+static cc_t int_chars[NUM_INT_CHANNELS];
+static cc_t int_handlers[NUM_INT_CHANNELS];
+
+static void
+DEFUN_VOID (update_interrupt_characters)
+{
+  int i;
+
+  for (i = 0; i < KB_INT_TABLE_SIZE; i++)
+    keyboard_interrupt_table[i] = NO_INTERRUPT_CHAR;
+
+  for (i = 0; i < NUM_INT_CHANNELS; i++)
+  {
+    unsigned char handler;
+
+    switch (int_handlers[i])
+    {
+      case interrupt_handler_control_b:
+        handler = CONTROL_B_INTERRUPT_CHAR;
+       break;
+
+      case interrupt_handler_control_g:
+        handler = CONTROL_G_INTERRUPT_CHAR;
+       break;
+
+      case interrupt_handler_control_u:
+        handler = CONTROL_U_INTERRUPT_CHAR;
+       break;
+
+      case interrupt_handler_control_x:
+        handler = CONTROL_X_INTERRUPT_CHAR;
+       break;
+
+      case interrupt_handler_interactive:
+        handler = GENERAL_INTERRUPT_CHAR;
+       break;
+
+      default:
+        handler = NO_INTERRUPT_CHAR;
+       break;
+    }
+    keyboard_interrupt_table[(int) (int_chars[i])] = handler;
+  }
+  return;
+}
+
+unsigned int
+DEFUN_VOID (OS_ctty_num_int_chars)
+{
+  return (NUM_INT_CHANNELS);
+}
+
+cc_t *
+DEFUN_VOID (OS_ctty_get_int_chars)
+{
+  return (&int_chars[0]);
+}
+
+void
+DEFUN (OS_ctty_set_int_chars, (new_int_chars), cc_t * new_int_chars)
+{
+  int i;
+
+  for (i = 0; i < NUM_INT_CHANNELS; i++)
+    int_chars[i] = new_int_chars[i];
+  update_interrupt_characters ();
+  return;
+}
+
+cc_t *
+DEFUN_VOID (OS_ctty_get_int_char_handlers)
+{
+  return (&int_handlers[0]);
+}
+
+void
+DEFUN (OS_ctty_set_int_char_handlers, (new_int_handlers),
+       cc_t * new_int_handlers)
+{
+  int i;
+
+  for (i = 0; i < NUM_INT_CHANNELS; i++)
+    int_handlers[i] = new_int_handlers[i];
+  update_interrupt_characters ();
+  return;
+}
+\f
+void
+DEFUN_VOID (initialize_keyboard_interrupt_table)
+{
+  /* Set up default interrupt characters */
+  int_chars[0] = CONTROL_B;
+  int_handlers[0] = ((unsigned char) interrupt_handler_control_b);
+  int_chars[1] = CONTROL_G;
+  int_handlers[1] = ((unsigned char) interrupt_handler_control_g);
+  int_chars[2] = CONTROL_U;
+  int_handlers[2] = ((unsigned char) interrupt_handler_control_u);
+  int_chars[3] = CONTROL_X;
+  int_handlers[3] = ((unsigned char) interrupt_handler_control_x);
+  int_chars[4] = CONTROL_C;
+  int_handlers[4] = ((unsigned char) interrupt_handler_interactive);
+  update_interrupt_characters ();
+  keyboard_interrupt_enables =
+    (CONTROL_B_ENABLE | CONTROL_G_ENABLE | CONTROL_U_ENABLE |
+     CONTROL_X_ENABLE | GENERAL_INTERRUPT_ENABLE);
+  return;
+}
+
+int
+DEFUN (signal_keyboard_character_interrupt, (c), unsigned char c)
+{
+  if ((c >= 0) && (c < KB_INT_TABLE_SIZE))
+  { int interrupt_char = keyboard_interrupt_table[c];
+    int interrupt_p;
+
+#define Request_Interrupt_If_Enabled(mask)                     \
+  ( interrupt_p =                                              \
+      ( (keyboard_interrupt_enables&(mask))                    \
+       ? tty_set_next_interrupt_char (interrupt_char), 1 : 0 ))
+    
+    switch (interrupt_char)
+    { 
+      case CONTROL_B_INTERRUPT_CHAR:
+       Request_Interrupt_If_Enabled(CONTROL_B_ENABLE); break;
+      case CONTROL_G_INTERRUPT_CHAR:
+       Request_Interrupt_If_Enabled(CONTROL_G_ENABLE); break;
+      case CONTROL_U_INTERRUPT_CHAR:
+       Request_Interrupt_If_Enabled(CONTROL_U_ENABLE); break;
+      case CONTROL_X_INTERRUPT_CHAR:
+       Request_Interrupt_If_Enabled(CONTROL_X_ENABLE); break;
+      case GENERAL_INTERRUPT_CHAR:
+       Request_Interrupt_If_Enabled(GENERAL_INTERRUPT_ENABLE); break;
+      default:
+       interrupt_p = 0;
+    }
+    return interrupt_p;
+  }
+  return 0;
+}      
+
+\f
+static void
+DEFUN_VOID (print_interrupt_help)
+{ 
+  console_write_string("Choices are:\n");
+  console_write_string("C-G interrupt: G, g, ^G (abort to top level)\n");
+  console_write_string("C-X interrupt: X, x, ^x (abort)\n");
+  console_write_string("C-B interrupt: B, b, ^B (break)\n");
+  console_write_string("C-U interrupt: U, u, ^U (up)\n");
+
+  return;
+}
+  
+cc_t
+DEFUN (OS_tty_map_interrupt_char, (int_char), cc_t int_char)
+{
+  if ((int_char == CONTROL_B_INTERRUPT_CHAR) ||
+      (int_char == CONTROL_G_INTERRUPT_CHAR) ||
+      (int_char == CONTROL_X_INTERRUPT_CHAR) ||
+      (int_char == CONTROL_U_INTERRUPT_CHAR) )
+    return int_char;
+  
+  while (1)
+  { unsigned char response;
+
+    console_write_string
+      ("\nKeyboard interrupt, type character (? for help): ");
+    
+    response = dos_get_keyboard_character();
+    dos_console_write_character(response);
+    
+    switch (response)
+    { case 'b':
+      case 'B':
+      case CONTROL_B:
+       return CONTROL_B_INTERRUPT_CHAR;
+      case 'g':
+      case 'G':
+      case CONTROL_G:
+       return CONTROL_G_INTERRUPT_CHAR;
+      case 'u':
+      case 'U':
+      case CONTROL_U:
+       return CONTROL_U_INTERRUPT_CHAR;
+      case 'x':
+      case 'X':
+      case CONTROL_X:
+       return CONTROL_X_INTERRUPT_CHAR;
+      case '?':
+       print_interrupt_help();
+       break;
+      default:
+      { char temp[128];
+       sprintf(temp, "\nIllegal interrupt character: [%c]\n", response);
+       console_write_string(temp);
+       print_interrupt_help();
+       break;
+      }
+    } /* End CASE */
+ }    /* End WHILE */
+}
+\f  
+void
+DEFUN (stop_signal_default, (signo), int signo)
+{
+  return;
+}
+
+void EXFUN ((*stop_signal_hook), (int signo));
+
+#define IF_POSIX_SIGNALS(code) do {} while (0)
+
+DEFUN_STD_HANDLER (sighnd_stop, {})
+
+void
+DEFUN_VOID (OS_restartable_exit)
+{
+  stop_signal_default (SIGTSTP);
+}
+
+
+#ifdef HAVE_ITIMER
+
+DEFUN_STD_HANDLER (sighnd_timer,
+  {
+    request_timer_interrupt ();
+  })
+
+#else /* not HAVE_ITIMER */
+
+extern void EXFUN (reschedule_alarm, (void));
+
+DEFUN_STD_HANDLER (sighnd_timer,
+  {
+    /* reschedule_alarm ();
+       request_timer_interrupt ();
+     */
+  })
+
+#endif /* HAVE_ITIMER */
+\f
+DEFUN_STD_HANDLER (sighnd_save_then_terminate,
+  (request_suspend_interrupt ()))
+
+#ifndef SIGNUP
+#define SIGHUP 999
+#endif
+
+DEFUN_STD_HANDLER (sighnd_terminate,
+  (termination_signal
+   ((! (option_emacs_subprocess && (signo == SIGHUP)))
+    ? (find_signal_name (signo))
+    : 0)))
+
+#define VOID ((struct sigcontext *) 0)
+
+DEFUN_STD_HANDLER (sighnd_fpe,
+  {
+    if (executing_scheme_primitive_p ())
+      error_floating_point_exception ();
+    trap_handler ("floating-point exception signal", signo, VOID, VOID);
+  })
+
+DEFUN_STD_HANDLER (sighnd_hardware_trap,
+  (trap_handler ("hardware fault signal", signo, VOID, VOID)))
+
+DEFUN_STD_HANDLER (sighnd_software_trap,
+  (trap_handler ("system software fault signal", signo, VOID, VOID)))
+
+
+/* When a child process terminates, it becomes a zombie until its
+   parent process calls one of the wait() routines to obtain the
+   child's termination status.  The SIGCHLD handler must always call
+   wait() or waitpid() to permit the child process's resources to be
+   freed. */
+
+/* On systems with waitpid() (i.e. those that support WNOHANG) we must
+   loop until there are no more processes, because some of those
+   systems may deliver only one SIGCHLD when more than one child
+   terminates.  Systems without waitpid() (e.g. _SYSV) typically
+   provide queuing of SIGCHLD such that one SIGCHLD is delivered for
+   every child that terminates.  Systems that provide neither
+   waitpid() nor queuing are so losing that we can't win, in which
+   case we just hope that child terminations don't happen too close to
+   one another to cause problems. */
+
+void EXFUN ((*subprocess_death_hook), (pid_t pid, wait_status_t * status));
+
+#define WAITPID(status) (DOS_wait (status))
+#define BREAK break
+
+DEFUN_STD_HANDLER (sighnd_dead_subprocess,
+  {
+  })
+\f
+/* PC specific low-level interrupt hooks */
+/* Control-Break Interrupt */
+int
+DEFUN (control_break_handler, (pd), struct INT_DATA *pd)
+{
+  tty_set_next_interrupt_char (CONTROL_G_INTERRUPT_CHAR);
+  return INTERRUPT_RETURN;
+}
+
+/* Interval timer */
+
+/* Scheme timer emulation; DOS does not have an ITIMER like unix. */
+/* Zero means timer is not set. */
+
+volatile unsigned long scm_itimer_counter = 0;
+volatile unsigned long scm_itimer_reload = 0;
+
+int 
+DEFUN (bios_timer_handler, (pd), struct INT_DATA *pd)
+{ 
+  if (scm_itimer_reload != 0)
+  { if (--scm_itimer_counter == 0)
+    { 
+      scm_itimer_counter = scm_itimer_reload;
+      request_timer_interrupt();
+    }
+  }
+  return (INTERRUPT_CHAIN_NEXT);
+}
+\f
+static Boolean
+  dos_interrupts_initialized_p = false,
+  ctrl_c_check_flag = true;
+
+dos_boolean DOS_keyboard_intercepted_p = false;
+
+#define NUM_DOS_INTVECT                (MAX_DOS_INTVECT + 1)
+#define NUM_DOS_HANDLERS       (NUM_DOS_INTVECT + NUM_DOS_EXCP)
+static int EXFUN ((* (dos_interrupt_restoration[NUM_DOS_HANDLERS])), 
+                  (unsigned));
+
+static void
+DEFUN (dos_record_interrupt_interception, (intno, restorer),
+       unsigned intno AND int ((*restorer) (unsigned)))
+{
+  dos_interrupt_restoration[intno] = restorer;
+  return;
+}
+
+static int
+DEFUN (scm_int_restore, (iv), unsigned iv)
+{
+  int_restore (iv);
+  return (DOS_SUCCESS);                /* A big lie. */
+}
+
+static int 
+DEFUN (scm_int_intercept, (iv, proc, stack),
+       unsigned iv AND int (*proc)(struct INT_DATA *) AND unsigned stack)
+{
+  if ((int_intercept (iv, proc, stack)) != 0)
+    return (DOS_FAILURE);
+    
+  dos_record_interrupt_interception (iv, scm_int_restore);
+  return (DOS_SUCCESS);
+}
+
+static void
+DEFUN_VOID (DOS_initialize_interrupts)
+{
+  int iv;
+  
+  ctrl_c_check_flag = (dos_set_ctrl_c_check_flag (0));
+  
+  for (iv = (NUM_DOS_HANDLERS - 1); iv >= 0; iv--)
+    dos_interrupt_restoration[iv] = ((int (*) (unsigned)) NULL);
+
+  dos_interrupts_initialized_p = true;
+  return;
+} 
+\f
+static char i386_exceptions_to_handle[] =
+{
+  DOS_EXCP_Integer_divide_by_zero,
+  DOS_EXCP_Debug_exception,
+  DOS_EXCP_Breakpoint,
+  DOS_EXCP_Integer_overflow,
+  DOS_EXCP_Bounds_check,
+  DOS_EXCP_Invalid_opcode,
+  DOS_EXCP_Numeric_co_processor_not_available,
+  DOS_EXCP_Numeric_co_processor_segment_overrun,
+  DOS_EXCP_Invalid_TSS,
+  DOS_EXCP_Segment_not_present,
+  DOS_EXCP_Stack_exception,
+  DOS_EXCP_General_protection,
+  DOS_EXCP_Page_Fault,
+  DOS_EXCP_Floating_point_exception,
+  DOS_EXCP_Alignment_check,
+  DOS_INVALID_TRAP
+};
+
+static short old_excp_handler_cs[NUM_DOS_EXCP];
+static unsigned old_excp_handler_eip[NUM_DOS_EXCP];
+static void * stack_exception_fault_stack = ((void *) NULL);
+
+#define STACK_EXCEPTION_STACK_SIZE     2048
+
+static int
+DEFUN (DPMI_restore_handler, (iv), unsigned iv)
+{
+  unsigned excp = (iv - NUM_DOS_INTVECT);
+
+  if ((DPMI_restore_exception_handler (excp,
+                                      old_excp_handler_cs[excp],
+                                      old_excp_handler_eip[excp]))
+      != DOS_SUCCESS)
+    return (DOS_FAILURE);
+  if (excp == DOS_EXCP_Stack_exception)
+  {
+    free (stack_exception_fault_stack);
+    stack_exception_fault_stack = ((void *) NULL);
+  }
+  return (DOS_SUCCESS);
+}
+\f
+static void
+DEFUN (exception_handler, (trapno, trapcode, scp),
+       unsigned trapno AND unsigned trapcode AND struct sigcontext * scp)
+{
+  trap_handler ("hardware exception", ((int) trapno), trapcode, scp);
+  /*NOTREACHED*/
+}
+
+static void
+DEFUN_VOID (DPMI_install_exception_handlers)
+{
+  int i;
+
+  for (i = 0; dos_true ; i++)
+  {
+    int excp = ((int) i386_exceptions_to_handle[i]);
+
+    if (excp == DOS_INVALID_TRAP)
+      break;
+    if ((DPMI_get_exception_vector (((unsigned) excp),
+                                   & old_excp_handler_cs[excp],
+                                   & old_excp_handler_eip[excp]))
+       != DOS_SUCCESS)
+      continue;
+    if (excp == DOS_EXCP_Stack_exception)
+    {
+      char * stack;
+
+      stack = ((char *) (malloc (STACK_EXCEPTION_STACK_SIZE)));
+      if (stack == ((char *) NULL))
+       continue;
+      if ((DPMI_set_exception_handler (((unsigned) excp),
+                                      exception_handler,
+                                      ((void *)
+                                       (stack 
+                                         + STACK_EXCEPTION_STACK_SIZE))))
+         != DOS_SUCCESS)
+      {
+       free (stack);
+       continue;
+      }
+      stack_exception_fault_stack = ((void *) stack);
+    }
+    else if ((DPMI_set_exception_handler (((unsigned) excp),
+                                         exception_handler,
+                                         ((void *) NULL)))
+            != DOS_SUCCESS)
+      continue;
+    dos_record_interrupt_interception ((excp + NUM_DOS_INTVECT),
+                                      DPMI_restore_handler);
+  }
+  fflush (stdout);
+  return;
+}
+\f
+/* No lambda! foo. */
+
+static int
+DEFUN (DOS_restore_keyboard, (intno), unsigned intno)
+{
+  if ((dos_restore_kbd_hook ()) != DOS_SUCCESS)
+    return (DOS_FAILURE);
+  DOS_keyboard_intercepted_p = false;
+  return (DOS_SUCCESS);
+}     
+
+static void
+DEFUN_VOID (DOS_install_interrupts)
+{
+  scm_int_intercept (DOS_INTVECT_USER_TIMER_TICK, 
+                     bios_timer_handler, 
+                     256);
+  if ((dos_install_kbd_hook ()) == DOS_SUCCESS)
+  {
+    dos_record_interrupt_interception (DOS_INTVECT_SYSTEM_SERVICES,
+                                      DOS_restore_keyboard);
+    DOS_keyboard_intercepted_p = true;    
+  }
+  if (under_DPMI_p ())
+    DPMI_install_exception_handlers ();
+  else
+    scm_int_intercept (DOS_INTVECT_KB_CTRL_BREAK,
+                      control_break_handler,
+                      256);
+  return;
+}
+
+void
+DEFUN_VOID (DOS_restore_interrupts)
+{
+  int iv;
+
+  if (dos_interrupts_initialized_p)
+  {
+    for (iv = (NUM_DOS_HANDLERS - 1); iv >= 0; iv--)
+      if ((dos_interrupt_restoration[iv]) != ((int (*) (unsigned)) NULL))
+      {
+       (void) ((dos_interrupt_restoration[iv]) (iv));
+       dos_interrupt_restoration[iv] = ((int (*) (unsigned)) NULL);
+      }
+    dos_interrupts_initialized_p = false;
+  }
+  dos_set_ctrl_c_check_flag (ctrl_c_check_flag);
+  return;
+}
+\f
+/* Signal Bindings */
+
+static void
+DEFUN (bind_handler, (signo, handler),
+       int signo AND
+       Tsignal_handler handler)
+{
+  if ((signo != 0)
+      && ((handler != ((Tsignal_handler) sighnd_stop)))
+      && ((current_handler (signo)) == SIG_DFL))
+    INSTALL_HANDLER (signo, handler);
+}
+
+void
+DEFUN_VOID (DOS_initialize_signals)
+{
+  stop_signal_hook = 0;
+  subprocess_death_hook = 0;
+  initialize_signal_descriptors ();
+  bind_handler (SIGINT,                sighnd_control_c);
+  bind_handler (SIGTERM,       sighnd_control_g);
+  bind_handler (SIGFPE,                sighnd_fpe);
+  if ((isatty (STDIN_FILENO)) || option_emacs_subprocess)
+    {
+      bind_handler (SIGILL,    sighnd_hardware_trap);
+      bind_handler (SIGSEGV,   sighnd_hardware_trap);
+      bind_handler (SIGABRT,   sighnd_software_trap);
+    }
+  {
+    struct signal_descriptor * scan = signal_descriptors;
+    struct signal_descriptor * end = (scan + signal_descriptors_length);
+    while (scan < end)
+      {
+       if (((scan -> flags) & NOCATCH) == 0)
+         switch (scan -> action)
+           {
+           case dfl_terminate:
+             bind_handler ((scan -> signo), sighnd_terminate);
+             break;
+           case dfl_stop:
+             bind_handler ((scan -> signo), sighnd_stop);
+             break;
+           }
+       scan += 1;
+      }
+  }
+  DOS_initialize_interrupts();
+  DOS_install_interrupts();
+}
diff --git a/v7/src/microcode/dossys.c b/v7/src/microcode/dossys.c
new file mode 100644 (file)
index 0000000..5f0f19f
--- /dev/null
@@ -0,0 +1,368 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dossys.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include <dos.h>
+#include <stdio.h>
+#include "dossys.h"
+\f
+int dos_keyboard_input_available_p(void)
+{
+  union REGS inregs, outregs;
+  
+  inregs.h.ah = 0x0B;
+  intdos(&inregs, &outregs);
+  
+  return (outregs.h.al != 0);
+}
+
+unsigned char dos_get_keyboard_character(void)
+{
+  union REGS inregs, outregs;
+  
+  inregs.h.ah = 0x07;
+  intdos(&inregs, &outregs);
+  
+  return (unsigned char) (outregs.h.al);
+}
+
+int dos_poll_keyboard_character(unsigned char *result)
+{
+  union REGS inregs, outregs;
+  
+  inregs.h.ah = 0x06;
+  inregs.h.dl = 0xFF;
+  intdos(&inregs, &outregs);
+  
+  *result = (unsigned char) (outregs.h.al);
+  return ((outregs.x.flags & 0x40) == 0);
+}
+
+void dos_console_write_character(unsigned char character)
+{
+  union REGS inregs, outregs;
+  
+  inregs.h.ah = 0x06;
+  inregs.h.dl = character;
+  
+  intdos(&inregs, &outregs);
+  return;
+}
+
+int dos_console_write(void * vbuffer, size_t nsize)
+{ union REGS inregs, outregs;
+  unsigned char *buffer = vbuffer;
+  int i;  
+  
+  for (inregs.h.ah = 0x06, i=0; i < nsize; i++)
+  { inregs.h.dl = buffer[i];
+    intdos(&inregs, &outregs);
+  }
+  return nsize;
+}
+
+\f
+/* DOS I/O functions using handles */
+
+handle_t dos_open_file_with_handle(unsigned char * name, int mode)
+{
+  union REGS inregs, outregs;
+  struct SREGS segregs;
+  
+  inregs.e.edx = (unsigned long) name;
+  segread(&segregs);
+
+  inregs.h.ah = 0x3D;
+  inregs.h.al = mode;
+  intdosx(&inregs, &outregs, &segregs);
+  printf("Returning from DOS\n");
+  return (outregs.x.cflag) ? DOS_FAILURE : (unsigned int) outregs.x.ax;
+}
+
+int dos_close_file_with_handle(handle_t handle)
+{
+  union REGS inregs, outregs;
+  
+  inregs.x.bx = handle;
+  inregs.h.al = 0x3E;
+  intdos(&inregs, &outregs);
+  
+  return (outregs.x.cflag) ? DOS_FAILURE : DOS_SUCCESS;
+}
+
+int dos_read_file_with_handle(handle_t handle, void * buffer, size_t nbytes)
+{
+  union REGS inregs, outregs;
+  struct SREGS segregs;
+  
+  inregs.x.bx = handle;  
+  inregs.e.edx = (unsigned long) buffer;
+  inregs.e.ecx = nbytes;
+
+  segread(&segregs);
+
+  inregs.h.ah = 0x3F;
+  intdosx(&inregs, &outregs, &segregs);
+  
+  return (outregs.x.cflag) ? DOS_FAILURE : outregs.e.eax;
+}
+
+int dos_write_file_with_handle(handle_t handle, void * buffer, size_t nbytes)
+{
+  union REGS inregs, outregs;
+  struct SREGS segregs;
+  
+  inregs.x.bx = handle;
+  inregs.e.edx = (unsigned long) buffer;
+  inregs.e.ecx = nbytes;
+  
+  segread(&segregs);
+
+  inregs.h.ah = 0x40;
+  intdosx(&inregs, &outregs, &segregs);
+  
+  return (outregs.x.cflag) ? DOS_FAILURE : outregs.e.eax;
+}
+  
+int dos_get_device_status_with_handle(handle_t handle)
+{ 
+  union REGS inregs, outregs;
+  
+  inregs.x.bx = handle;
+  inregs.x.ax = 0x4400;
+  intdos(&inregs, &outregs);
+  
+  return (outregs.x.cflag) ? DOS_FAILURE : (unsigned int) outregs.x.dx;
+}
+  
+int dos_set_device_status_with_handle(handle_t handle, int mode)
+{ int original_mode;
+  union REGS inregs, outregs;
+  
+  original_mode = dos_get_device_status_with_handle(handle);
+  if (original_mode == DOS_FAILURE) return DOS_FAILURE;
+
+  inregs.x.dx = mode;
+  inregs.x.bx = handle;
+  inregs.x.ax = 0x4401;
+  intdos(&inregs, &outregs);
+  return (outregs.x.cflag) ? DOS_FAILURE : original_mode;
+}  
+
+\f
+
+void dos_get_version(version_t *version_number)
+{
+  union REGS inregs, outregs;
+
+  /* Use old style version number because we may be running below DOS 5.0 */
+  inregs.h.al = 0x01;
+  inregs.h.ah = 0x30;
+  intdos(&inregs, &outregs);
+  version_number -> major = outregs.h.al;
+  version_number -> minor = outregs.h.ah;
+
+  if ((version_number -> major) >= 5)
+  { /* Get the real version. */
+    inregs.x.ax = 0x3306;
+    intdos(&inregs, &outregs);
+    version_number -> major = outregs.h.bl;
+    version_number -> minor = outregs.h.bh;
+  }
+  return;
+}
+
+void dos_reset_drive(void)
+{
+  union REGS inregs, outregs;
+  
+  inregs.h.al = 0x0d;
+  intdos(&inregs, &outregs);
+  
+  return;
+}
+
+int dos_set_verify_flag(int verify_p)
+{ union REGS inregs, outregs;
+  int old_flag;
+  
+  inregs.h.ah = 0x54;
+  intdos(&inregs, &outregs);
+  old_flag = outregs.h.al;
+  
+  inregs.h.al = (verify_p) ? 1 : 0;
+  inregs.h.ah = 0x2E;
+  intdos(&inregs, &outregs);
+  
+  return old_flag;
+}
+
+int dos_set_ctrl_c_check_flag(int check_p)
+{ union REGS inregs, outregs;
+  int old_flag;
+  
+  inregs.x.ax = 0x3300;
+  intdos(&inregs, &outregs);
+  old_flag = outregs.h.dl;
+  
+  inregs.h.dl = (check_p) ? 1 : 0;
+  inregs.x.ax = 0x3301;
+  intdos(&inregs, &outregs);
+  
+  return old_flag;
+}
+
+int dos_rename_file(const char *old, const char *new)
+{
+  union REGS inregs, outregs;
+  struct SREGS segregs;
+  
+  inregs.e.edx = (unsigned long) old;
+  inregs.e.edi = (unsigned long) new;
+  segread(&segregs);
+  segregs.es = segregs.ds;
+
+  inregs.h.ah = 0x56;
+  intdosx(&inregs, &outregs, &segregs);
+  
+  if (outregs.x.cflag)
+    return DOS_FAILURE;
+  else
+    return DOS_SUCCESS;
+}
+
+int dos_get_machine_name(char *name)
+{
+  union REGS inregs, outregs;
+  struct SREGS segregs;
+  
+  inregs.e.edx = (unsigned long) name;
+  segregs.ds = getDS();
+
+  inregs.x.ax = 0x5E00;
+  intdosx(&inregs, &outregs, &segregs);
+  
+  if ((outregs.x.cflag) || (outregs.h.ch == 0))
+    return DOS_FAILURE;
+  else
+    return outregs.h.cl;
+}
+
+int dos_drive_letter_to_number(char letter)
+{
+  if (letter == '\0')
+    return 0;
+  else if ((letter >= 'a')&&(letter <= 'z'))
+    return ((letter - 'a') + 1);
+  else if ((letter >= 'A')&&(letter <= 'Z'))
+    return ((letter - 'A') + 1);
+  else
+    return -1;
+}
+
+char dos_drive_number_to_letter(int number)
+{
+  if ((number >= 1)&&(number <= 26))
+    return ('A' + (number - 1));
+  else
+    return '\0';
+}
+
+int dos_set_default_drive(int drive_number)
+{
+  union REGS inregs, outregs;
+  
+  if (drive_number > 0)
+  {    
+    inregs.h.dl = drive_number - 1;
+    inregs.h.ah = 0x0E;
+    intdos(&inregs, &outregs);
+  }
+  return DOS_SUCCESS;
+}
+    
+int dos_get_default_drive(int drive_number)
+{
+  union REGS inregs, outregs;
+  
+  inregs.h.ah = 0x19;
+  intdos(&inregs, &outregs);
+  
+  return outregs.h.al + 1;
+}
+
+\f
+dos_boolean 
+dos_pathname_as_filename(char * name, char * buffer)
+{ /* Returns whether directory encountered is top level */
+  unsigned int end_index = strlen(name) - 1;
+
+  /* The runtime system comes down with a name that has a back slash
+     at the end.  This will choke DOS.
+   */
+  strcpy(buffer, name);
+  if ((end_index >= 0) && (buffer[end_index] == '\\'))
+  { /* Name is indeed a directory */
+    if (end_index == 0) /* if only one char, name is top */
+      return dos_true;
+    else
+    { if (buffer[end_index-1] == ':') /* Preceded by drive letter, top */
+      { return dos_true; }
+      else
+      { buffer[end_index] = '\0';
+       return dos_false;
+      }
+    }
+  }
+  else
+  { return dos_false; }
+}
+
+int dos_split_filename(char * name, char * device, char * filename)
+{ 
+  unsigned start;
+  int drive_number;
+  
+  if ((strlen(name) >= 2) && (name[1] == ':'))
+  { device[0] = name[0], device[1] = name[1], device[2] = '\0';
+    drive_number = dos_drive_letter_to_number(name[0]);
+    start = 2;
+  }
+  else
+  { device[0] = '\0';
+    drive_number = 0;
+    start = 0;
+  }
+  dos_pathname_as_filename(&name[start], filename);
+  return drive_number;
+}
diff --git a/v7/src/microcode/dossys.h b/v7/src/microcode/dossys.h
new file mode 100644 (file)
index 0000000..8a29bea
--- /dev/null
@@ -0,0 +1,167 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dossys.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef SCM_DOSSYS_H
+#define SCM_DOSSYS_H
+\f
+#define DOS_SUCCESS    (0)
+#define DOS_FAILURE    (-1)
+#define dos_boolean    int
+#define dos_true       (1)
+#define dos_false      (0)
+
+typedef struct version_struct
+{
+  unsigned char major;
+  unsigned char minor;
+} version_t;
+
+typedef int handle_t;
+
+/* Console Character I/O */
+extern int dos_keyboard_input_available_p(void);
+extern unsigned char dos_get_keyboard_character(void);
+extern int dos_poll_keyboard_character(unsigned char *result);
+extern void dos_console_write_character(unsigned char character);
+extern int dos_console_write(void * vbuffer, size_t nsize);
+
+/* Handle I/O */
+extern handle_t dos_open_file_with_handle(unsigned char * name, int mode);
+extern int dos_close_file_with_handle(handle_t handle);
+extern int dos_read_file_with_handle
+           (handle_t handle, void * buffer, size_t nbytes);
+extern int dos_write_file_with_handle
+           (handle_t handle, void * buffer, size_t nbytes);
+extern int dos_get_device_status_with_handle(handle_t handle);
+extern int dos_set_device_status_with_handle(handle_t handle, int mode);
+
+/* Misc */
+extern void dos_get_version(version_t * version_number);
+extern void dos_reset_drive(void);
+extern int dos_set_verify_flag(int verify_p);
+extern int dos_set_ctrl_c_check_flag(int check_p);
+extern int dos_rename_file(const char *old, const char *new);
+extern int dos_get_machine_name(char *name);
+extern int dos_drive_letter_to_number(char letter);
+extern char dos_drive_number_to_letter(int number);
+extern int dos_get_default_drive(int drive_number);
+extern int dos_set_default_drive(int drive_number);
+extern int dos_pathname_as_filename(char * name, char * buffer);
+extern int dos_split_filename(char * name, char * device, char * filename);
+
+/* Keyboard control */
+
+extern dos_boolean DOS_keyboard_intercepted_p;
+extern int dos_restore_kbd_hook (void);
+extern int dos_install_kbd_hook (void);
+extern unsigned char dos_set_kbd_modifier_mask (unsigned char);
+
+/* DOS Interrupt Vectors */
+#define DOS_INTVECT_DIVIDE_BY_0                (0x00)
+#define DOS_INTVECT_SINGLE_STEP                (0x01)
+#define DOS_INTVECT_NMI                        (0x02)
+#define DOS_INTVECT_BREAKPOINT         (0x03)
+#define DOS_INTVECT_OVERFLOW           (0x04)
+#define DOS_INTVECT_PRINT_SCREEN       (0x05)
+#define DOS_INTVECT_INVALID_OPCODE     (0x06)
+#define DOS_INTVECT_RESERVED_1         (0x07)
+#define DOS_INTVECT_SYSTEM_TIMER       (0x08)
+#define DOS_INTVECT_KEYBOARD_EVENT     (0x09)
+#define DOS_INTVECT_IRQ2               (0x0A)
+#define DOS_INTVECT_IRQ3               (0x0B)
+#define DOS_INTVECT_IRQ4               (0x0C)
+#define DOS_INTVECT_IRQ5               (0x0D)
+#define DOS_INTVECT_DISKETTE_EVENT     (0x0E)
+#define DOS_INTVECT_IRQ7               (0x0F)
+#define DOS_INTVECT_VIDEO              (0x10)
+#define DOS_INTVECT_EQUIPMENT          (0x11)
+#define DOS_INTVECT_MEMORY_SIZE                (0x12)
+#define DOS_INTVECT_DISK_REQUEST       (0x13)
+#define DOS_INTVECT_COMMUNICATIONS     (0x14)
+#define DOS_INTVECT_SYSTEM_SERVICES    (0x15)
+#define DOS_INTVECT_KEYBOARD_REQUEST   (0x16)
+#define DOS_INTVECT_PRINTER_REQUEST    (0x17)
+#define DOS_INTVECT_IBM_BASIC          (0x18)
+#define DOS_INTVECT_BOOTSTRAP          (0x19)
+#define DOS_INTVECT_SYSTEM_TIMER_2     (0x1A)
+#define DOS_INTVECT_KB_CTRL_BREAK      (0x1B)
+#define DOS_INTVECT_USER_TIMER_TICK    (0x1C)
+#define DOS_INTVECT_VIDEO_PARAMETERS   (0x1D)
+#define DOS_INTVECT_DISKETTE_PARAMETERS        (0x1E)
+#define DOS_INTVECT_GRAPHICS_CHARACTERS        (0x1F)
+#define DOS_INTVECT_PROGRAM_TERMINATE  (0x20)
+#define DOS_INTVECT_DOS_REQUEST                (0x21)
+#define DOS_INTVECT_TERMINATE_ADDRESS  (0x22)
+#define DOS_INTVECT_DOS_CTRL_BREAK     (0x23)
+#define DOS_INTVECT_CRITICAL_ERROR     (0x24)
+#define DOS_INTVECT_ABS_DISK_READ      (0x25)
+#define DOS_INTVECT_ABS_DISK_WRITE     (0x26)
+#define DOS_INTVECT_TSR                        (0x27)
+#define DOS_INTVECT_DOS_IDLE           (0x28)
+#define DOS_INTVECT_DOS_TTY            (0x29)
+#define DOS_INTVECT_MS_NET             (0x2A)
+#define DOS_INTVECT_DOS_INTERNAL_1     (0x2B)
+#define DOS_INTVECT_DOS_INTERNAL_2     (0x2C)
+#define DOS_INTVECT_DOS_INTERNAL_3     (0x2D)
+#define DOS_INTVECT_BATCH_EXEC         (0x2E)
+#define DOS_INTVECT_MULTIPLEX          (0x2F)
+#define DOS_INTVECT_CPM_JUMP_1         (0x30)
+#define DOS_INTVECT_CPM_JUMP_2         (0x31)
+#define DOS_INTVECT_RESERVED_2         (0x32)
+#define DOS_INTVECT_MS_MOUSE           (0x33)
+/* Non consecutive */
+#define DOS_INTVECT_DISKETTE_REQUEST   (0x40)
+#define DOS_INTVECT_FIXED_DISK_1_PARAM (0x41)
+#define DOS_INTVECT_EGA_GRAPHICS_CHARS (0x43)
+#define DOS_INTVECT_FIXED_DISK_2_PARAM (0x46)
+#define DOS_INTVECT_USER_ALARM         (0x4A)
+#define DOS_INTVECT_PROGRAM_USE_1      (0x60)
+#define DOS_INTVECT_PROGRAM_USE_2      (0x61)
+#define DOS_INTVECT_PROGRAM_USE_3      (0x62)
+#define DOS_INTVECT_PROGRAM_USE_4      (0x63)
+#define DOS_INTVECT_PROGRAM_USE_5      (0x64)
+#define DOS_INTVECT_PROGRAM_USE_6      (0x65)
+#define DOS_INTVECT_PROGRAM_USE_7      (0x66)
+#define DOS_INTVECT_EMS_REQUEST                (0x67)
+#define DOS_INTVECT_REAL_TIME_CLOCK    (0x70)
+#define DOS_INTVECT_IRQ2_REDIRECT      (0x72)
+#define DOS_INTVECT_IRQ11              (0x73)
+#define DOS_INTVECT_IBM_MOUSE_EVENT    (0x74)
+#define DOS_INTVECT_COPROCESSOR_ERROR  (0x75)
+#define DOS_INTVECT_HARD_DISK_EVENT    (0x76)
+#define DOS_INTVECT_IRQ15              (0x77)
+
+#define MAX_DOS_INTVECT                        (0xFF)
+
+#endif /* SCM_DOSSYS_H */
diff --git a/v7/src/microcode/dosterm.h b/v7/src/microcode/dosterm.h
new file mode 100644 (file)
index 0000000..c81230f
--- /dev/null
@@ -0,0 +1,40 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosterm.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef SCM_UXTERM_H
+#define SCM_UXTERM_H
+
+#include "osterm.h"
+
+#endif /* SCM_UXTERM_H */
diff --git a/v7/src/microcode/dostop.c b/v7/src/microcode/dostop.c
new file mode 100644 (file)
index 0000000..7ca41ee
--- /dev/null
@@ -0,0 +1,191 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dostop.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "dostop.h"
+#include "osctty.h"
+#include "dosutil.h"
+#include "errors.h"
+#include "option.h"
+
+extern void EXFUN (DOS_initialize_channels, (void));
+extern void EXFUN (DOS_initialize_ctty, (int interactive));
+extern void EXFUN (DOS_initialize_directory_reader, (void));
+extern void EXFUN (DOS_initialize_environment, (void));
+extern void EXFUN (DOS_initialize_processes, (void));
+extern void EXFUN (DOS_initialize_signals, (void));
+extern void EXFUN (DOS_initialize_terminals, (void));
+extern void EXFUN (DOS_initialize_trap_recovery, (void));
+extern void EXFUN (DOS_initialize_conio, (void));
+extern void EXFUN (DOS_initialize_tty, (void));
+extern void EXFUN (DOS_initialize_userio, (void));
+
+extern void EXFUN (DOS_reset_channels, (void));
+extern void EXFUN (DOS_reset_processes, (void));
+extern void EXFUN (DOS_reset_terminals, (void));
+extern void EXFUN (execute_reload_cleanups, (void));
+
+extern void EXFUN (DOS_ctty_save_external_state, (void));
+extern void EXFUN (DOS_ctty_save_internal_state, (void));
+extern void EXFUN (DOS_ctty_restore_internal_state, (void));
+extern void EXFUN (DOS_ctty_restore_external_state, (void));
+
+/* reset_interruptable_extent */
+
+extern CONST char * OS_Name;
+extern CONST char * OS_Variant;
+\f
+static int interactive;
+
+int
+DEFUN_VOID (OS_under_emacs_p)
+{
+  return (option_emacs_subprocess);
+}
+
+void
+DEFUN_VOID (OS_initialize)
+{
+  dstack_initialize ();
+  transaction_initialize ();
+  interactive = 1;
+  
+  DOS_initialize_channels ();
+  DOS_initialize_environment ();
+  DOS_initialize_tty ();
+  DOS_initialize_trap_recovery ();
+  DOS_initialize_signals ();
+  DOS_initialize_directory_reader ();
+  DOS_initialize_conio();
+  OS_Name = SYSTEM_NAME;
+  OS_Variant = SYSTEM_VARIANT;
+
+  { version_t version_number;
+
+    dos_get_version(&version_number);
+    fprintf (stdout, "MIT Scheme running under %s %d.%d 386/486\n",
+                    OS_Variant,
+                    (int) version_number.major, (int) version_number.minor);
+    /* To make our compiler vendors happy. */             
+    fprintf(stdout,
+           "Copyright (c) 1990, 1991, 1992 Massachusetts Institute of Technology\n");
+  }
+
+  fputs ("", stdout);
+  fflush (stdout);
+}
+
+void
+DEFUN_VOID (OS_reset)
+{
+  /*
+    There should really be a reset for each initialize above,
+    but the rest seem innocuous.
+   */
+
+  DOS_reset_channels ();
+  execute_reload_cleanups ();
+}
+\f
+void
+DEFUN (OS_quit, (code, abnormal_p), int code AND int abnormal_p)
+{
+  fflush (stdout);
+  fputs ("\nScheme has terminated abnormally!\n", stdout);
+  OS_restore_external_state ();
+}
+
+\f
+static enum syserr_names
+DEFUN (error_code_to_syserr, (code), int code)
+{
+  switch (code)
+    {
+    case E2BIG:                return (syserr_arg_list_too_long);
+    case EACCES:       return (syserr_permission_denied);
+    default:           return (syserr_unknown);
+    }
+}
+
+static int
+DEFUN (syserr_to_error_code, (syserr), enum syserr_names syserr)
+{
+  switch (syserr)
+    {
+    case syserr_arg_list_too_long:                     return (E2BIG);
+    case syserr_permission_denied:                     return (EACCES);
+    default: return (0);
+    }
+}
+
+void
+DEFUN (error_system_call, (code, name), int code AND enum syscall_names name)
+{
+  extern unsigned int syscall_error_code;
+  extern unsigned int syscall_error_name;
+  syscall_error_code = ((unsigned int) (error_code_to_syserr (code)));
+  syscall_error_name = ((unsigned int) name);
+  signal_error_from_primitive (ERR_IN_SYSTEM_CALL);
+}
+
+CONST char *
+DEFUN (OS_error_code_to_message, (syserr), unsigned int syserr)
+{
+  extern char * sys_errlist [];
+  extern int sys_nerr;
+  int code = (syserr_to_error_code ((enum syserr_names) syserr));
+  return (((code > 0) && (code <= sys_nerr)) ? (sys_errlist [code]) : 0);
+}
+
+void
+DEFUN (DOS_prim_check_errno, (name), enum syscall_names name)
+{
+  if (errno != EINTR)
+    error_system_call (errno, name);
+  deliver_pending_interrupts();
+}
+
+void OS_restore_external_state (void)
+{ extern void DOS_restore_interrupts(void);
+
+  DOS_restore_interrupts();
+  return;
+}
+
+void bcopy (const char *s1, char *s2, int n)
+{
+  while (n-- > 0)
+    *s2++ = *s1++;
+  return;
+}
diff --git a/v7/src/microcode/dostop.h b/v7/src/microcode/dostop.h
new file mode 100644 (file)
index 0000000..c1a0c61
--- /dev/null
@@ -0,0 +1,40 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dostop.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef SCM_DOSTOP_H
+#define SCM_DOSTOP_H
+
+#include "ostop.h"
+
+#endif /* SCM_DOSTOP_H */
diff --git a/v7/src/microcode/dostrap.c b/v7/src/microcode/dostrap.c
new file mode 100644 (file)
index 0000000..323721d
--- /dev/null
@@ -0,0 +1,884 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dostrap.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "scheme.h"
+#include "os.h"
+#include "msdos.h"
+#include "dostrap.h"
+#include "dosexcp.h"
+
+extern void EXFUN (DOS_initialize_trap_recovery, (void));
+CONST char * EXFUN (find_trap_name, (int trapno));
+extern PTR initial_C_stack_pointer;
+\f
+static enum trap_state trap_state;
+static enum trap_state user_trap_state;
+
+static enum trap_state saved_trap_state;
+static int saved_trapno;
+static SIGINFO_T saved_info;
+static struct FULL_SIGCONTEXT * saved_scp;
+
+static unsigned short
+  initial_C_ss = 0,
+  initial_C_ds = 0,
+  initial_C_cs = 0;
+
+static void EXFUN (initialize_dos_trap_codes, (void));
+static void EXFUN
+  (continue_from_trap,
+   (int trapno, SIGINFO_T info, struct FULL_SIGCONTEXT * scp));
+
+void
+DEFUN_VOID (DOS_initialize_trap_recovery)
+{
+  extern unsigned short getSS (void);
+
+  initial_C_ss = (getSS ());
+  initial_C_ds = (getDS ());
+  initial_C_cs = (getCS ());
+  trap_state = trap_state_recover;
+  user_trap_state = trap_state_recover;
+  initialize_dos_trap_codes ();
+}
+
+enum trap_state
+DEFUN (OS_set_trap_state, (state), enum trap_state state)
+{
+  enum trap_state old_trap_state = user_trap_state;
+  user_trap_state = state;
+  trap_state = state;
+  return (old_trap_state);
+}
+
+static void
+DEFUN_VOID (trap_normal_termination)
+{
+  trap_state = trap_state_exitting_soft;
+  termination_trap ();
+}
+
+static void
+DEFUN_VOID (trap_immediate_termination)
+{
+  trap_state = trap_state_exitting_hard;
+  OS_restore_external_state ();
+  exit (1);
+}
+
+static void
+DEFUN_VOID (trap_recover)
+{
+  if (WITHIN_CRITICAL_SECTION_P ())
+    {
+      CLEAR_CRITICAL_SECTION_HOOK ();
+      EXIT_CRITICAL_SECTION ({});
+    }
+  reset_interruptable_extent ();
+  continue_from_trap (saved_trapno, saved_info, saved_scp);
+}
+\f
+void
+DEFUN (trap_handler, (message, trapno, info, scp),
+       CONST char * message AND
+       int trapno AND
+       SIGINFO_T info AND
+       struct FULL_SIGCONTEXT * scp)
+{
+  int code = ((SIGINFO_VALID_P (info)) ? (SIGINFO_CODE (info)) : 0);
+  Boolean constant_space_broken = (!(CONSTANT_SPACE_SEALED ()));
+  enum trap_state old_trap_state = trap_state;
+
+  if (old_trap_state == trap_state_exitting_hard)
+  {
+    _exit (1);
+  }
+  else if (old_trap_state == trap_state_exitting_soft)
+  {
+    trap_immediate_termination ();
+  }
+  trap_state = trap_state_trapped;
+  if (WITHIN_CRITICAL_SECTION_P ())
+  {
+    fprintf (stdout,
+            "\n>> A %s has occurred within critical section \"%s\".\n",
+            message, (CRITICAL_SECTION_NAME ()));
+    fprintf (stdout, ">> [exception %d (%s), code %d = 0x%x]\n",
+            trapno, (find_trap_name (trapno)), code, code);
+  }
+  else if (constant_space_broken || (old_trap_state != trap_state_recover))
+  {
+    fprintf (stdout, "\n>> A %s (%d) has occurred.\n", message, trapno);
+    fprintf (stdout, ">> [exception %d (%s), code %d = 0x%x]\n",
+            trapno, (find_trap_name (trapno)), code, code);
+  }
+  if (constant_space_broken)
+  {
+    fputs (">> Constant space has been overwritten.\n", stdout);
+    fputs (">> Probably a runaway recursion has overflowed the stack.\n",
+          stdout);
+  }
+  fflush (stdout);
+
+  switch (old_trap_state)
+  {
+  case trap_state_trapped:
+    if ((saved_trap_state == trap_state_recover) ||
+       (saved_trap_state == trap_state_query))
+    {
+      fputs (">> The trap occurred while processing an earlier trap.\n",
+            stdout);
+      fprintf (stdout,
+              ">> [The earlier trap raised exception %d (%s), code %d.]\n",
+              saved_trapno,
+              (find_trap_name (saved_trapno)),
+              ((SIGINFO_VALID_P (saved_info))
+               ? (SIGINFO_CODE (saved_info))
+               : 0));
+      fputs (((WITHIN_CRITICAL_SECTION_P ())
+             ? ">> Successful recovery is extremely unlikely.\n"
+             : ">> Successful recovery is unlikely.\n"),
+            stdout);
+      break;
+    }
+    else
+      trap_immediate_termination ();
+  case trap_state_recover:
+    if ((WITHIN_CRITICAL_SECTION_P ()) || constant_space_broken)
+    {
+      fputs (">> Successful recovery is unlikely.\n", stdout);
+      break;
+    }
+    else
+    {
+      saved_trap_state = old_trap_state;
+      saved_trapno = trapno;
+      saved_info = info;
+      saved_scp = scp;
+      trap_recover ();
+    }
+  case trap_state_exit:
+    termination_trap ();
+  }
+
+  fflush (stdout);
+  saved_trap_state = old_trap_state;
+  saved_trapno = trapno;
+  saved_info = info;
+  saved_scp = scp;
+    
+  while (1)
+  {
+    char option;
+    static CONST char * trap_query_choices[] =
+    {
+      "I = terminate immediately",
+      "N = terminate normally",
+      "R = attempt recovery",
+      "Q = terminate normally",
+      0
+      };
+    option = (userio_choose_option
+             ("Choose one of the following actions:",
+              "Action -> ",
+              trap_query_choices));
+    switch (option)
+    {
+      case 'I':
+        trap_immediate_termination ();
+      case '\0':
+        /* Error in IO. Assume everything scrod. */
+      case 'N':
+      case 'Q':
+        trap_normal_termination ();
+      case 'R':
+        trap_recover ();
+    }
+  }
+}
+\f
+#define STATE_UNKNOWN          (LONG_TO_UNSIGNED_FIXNUM (0))
+#define STATE_PRIMITIVE                (LONG_TO_UNSIGNED_FIXNUM (1))
+#define STATE_COMPILED_CODE    (LONG_TO_UNSIGNED_FIXNUM (2))
+#define STATE_PROBABLY_COMPILED        (LONG_TO_UNSIGNED_FIXNUM (3))
+
+struct trap_recovery_info
+{
+  SCHEME_OBJECT state;
+  SCHEME_OBJECT pc_info_1;
+  SCHEME_OBJECT pc_info_2;
+  SCHEME_OBJECT extra_trap_info;
+};
+
+static struct trap_recovery_info dummy_recovery_info =
+{
+  STATE_UNKNOWN,
+  SHARP_F,
+  SHARP_F,
+  SHARP_F
+};
+
+struct dos_trap_code_desc
+{
+  int trapno;
+  unsigned long code_mask;
+  unsigned long code_value;
+  char *name;
+};
+
+static struct dos_trap_code_desc dos_trap_codes [64];
+
+#define DECLARE_DOS_TRAP_CODE(s, m, v, n)                              \
+{                                                                      \
+  ((dos_trap_codes [i]) . trapno) = (s);                               \
+  ((dos_trap_codes [i]) . code_mask) = (m);                            \
+  ((dos_trap_codes [i]) . code_value) = (v);                           \
+  ((dos_trap_codes [i]) . name) = (n);                                 \
+  i += 1;                                                              \
+}
+
+static SCHEME_OBJECT
+DEFUN (find_trap_code_name, (trapno, info, scp),
+       int trapno AND
+       SIGINFO_T info AND
+       struct FULL_SIGCONTEXT * scp)
+{
+  unsigned long code = 0;
+  char * name = 0;
+  if (SIGINFO_VALID_P (info))
+    {
+      code = (SIGINFO_CODE (info));
+      {
+       struct dos_trap_code_desc * entry = (& (dos_trap_codes [0]));
+       while ((entry -> trapno) != DOS_INVALID_TRAP)
+         if (((entry -> trapno) == trapno)
+             && (((entry -> code_mask) & code) == (entry -> code_value)))
+         {
+           name = (entry -> name);
+           break;
+         }
+         else
+           entry += 1;
+      }
+    }
+  return (cons ((long_to_integer ((long) code)),
+               ((name == 0) ? SHARP_F
+                : (char_pointer_to_string ((unsigned char *) name)))));
+}
+\f
+static void
+DEFUN_VOID (initialize_dos_trap_codes)
+{
+  unsigned int i = 0;
+
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Integer_divide_by_zero,
+                        0, 0,
+                        "Integer divide by zero");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Debug_exception,
+                        0, 0,
+                        "Debug exception");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Non_maskable_interrupt,
+                        0, 0,
+                        "Non-maskable interrupt");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Breakpoint,
+                        0, 0,
+                        "Breakpoint");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Integer_overflow,
+                        0, 0,
+                        "Integer overflow");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Bounds_check,
+                        0, 0,
+                        "Bounds check");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Invalid_opcode,
+                        0, 0,
+                        "Invalid opcode");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Numeric_co_processor_not_available,
+                        0, 0,
+                        "Numeric co-processor not available");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Double_fault,
+                        0, 0,
+                        "Double fault");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Numeric_co_processor_segment_overrun,
+                        0, 0,
+                        "Numeric co-processor segment overrun");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Invalid_TSS,
+                        0, 0,
+                        "Invalid TSS");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Segment_not_present,
+                        0, 0,
+                        "Segment not present");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Stack_exception,
+                        0, 0,
+                        "Stack exception");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_General_protection,
+                        0, 0,
+                        "General protection");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Page_Fault,
+                        0, 0,
+                        "Page Fault");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Floating_point_exception,
+                        0, 0,
+                        "Floating-point exception");
+  DECLARE_DOS_TRAP_CODE (DOS_EXCP_Alignment_check,
+                        0, 0,
+                        "Alignment check");
+  DECLARE_DOS_TRAP_CODE (DOS_INVALID_TRAP, 0, 0, ((char *) 0));
+  return;
+}
+
+static CONST char *
+trap_names[NUM_DOS_EXCP] =
+{
+  "Integer divide by zero",
+  "Debugging trap",
+  "NMI interrupt",
+  "Breakpoint exception",
+  "INTO -- integer overflow",
+  "BOUND -- range exceeded",
+  "UD -- invalid opcode",
+  "NM -- 387 not available",
+  "DF -- double fault",
+  "387 segment overrun",
+  "TS -- invalid TSS",
+  "NP -- segment not present",
+  "SS -- stack fault",
+  "GP -- general protection",
+  "PF -- page fault",
+  ((CONST char *) NULL),
+  "MF -- floating-point error",
+  "AC -- alignment check"
+};
+
+CONST char *
+DEFUN (find_trap_name, (trapno), int trapno)
+{
+  static char buffer [64], * name;
+  if ((trapno >= 0) &&
+      (trapno < ((sizeof (trap_names)) / (sizeof (char *)))))
+  {
+    name = trap_names[trapno];
+    if ((name != ((char *) NULL))
+        && (name[0] != '\0'))
+      return ((CONST char *) name);
+  }
+  sprintf (buffer, "unknown exception %d", trapno);
+  return ((CONST char *) buffer);
+}
+\f
+static void
+DEFUN (setup_trap_frame, (trapno, info, scp, trinfo, new_stack_pointer),
+       int trapno AND
+       SIGINFO_T info AND
+       struct FULL_SIGCONTEXT * scp AND
+       struct trap_recovery_info * trinfo AND
+       SCHEME_OBJECT * new_stack_pointer)
+{
+  SCHEME_OBJECT handler;
+  SCHEME_OBJECT trap_name, trap_code;
+  int stack_recovered_p = (new_stack_pointer != 0);
+  long saved_mask = (FETCH_INTERRUPT_MASK ());
+  SET_INTERRUPT_MASK (0);      /* To prevent GC for now. */
+  if ((! (Valid_Fixed_Obj_Vector ())) ||
+      ((handler = (Get_Fixed_Obj_Slot (Trap_Handler))) == SHARP_F))
+    {
+      fprintf (stderr, "There is no trap handler for recovery!\n");
+      fflush (stderr);
+      termination_trap ();
+    }
+  if (Free > MemTop)
+    Request_GC (0);
+
+  trap_name =
+    ((trapno <= 0)
+     ? SHARP_F
+     : (char_pointer_to_string
+       ((unsigned char *) (find_trap_name (trapno)))));
+  trap_code = (find_trap_code_name (trapno, info, scp));
+  if (!stack_recovered_p)
+    {
+      Initialize_Stack ();
+     Will_Push (CONTINUATION_SIZE);
+      Store_Return (RC_END_OF_COMPUTATION);
+      Store_Expression (SHARP_F);
+      Save_Cont ();
+     Pushed ();
+    }
+  else
+    Stack_Pointer = new_stack_pointer;
+ Will_Push (7 + CONTINUATION_SIZE);
+  STACK_PUSH (trinfo -> extra_trap_info);
+  STACK_PUSH (trinfo -> pc_info_2);
+  STACK_PUSH (trinfo -> pc_info_1);
+  STACK_PUSH (trinfo -> state);
+  STACK_PUSH (BOOLEAN_TO_OBJECT (stack_recovered_p));
+  STACK_PUSH (trap_code);
+  STACK_PUSH (trap_name);
+  Store_Return (RC_HARDWARE_TRAP);
+  Store_Expression (long_to_integer (trapno));
+  Save_Cont ();
+ Pushed ();
+  if (stack_recovered_p
+      /* This may want to do it in other cases, but this may be enough. */
+      && (trinfo->state == STATE_COMPILED_CODE))
+    Stop_History ();
+
+  History = (Make_Dummy_History ());
+ Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
+  STACK_PUSH (trap_name);
+  STACK_PUSH (handler);
+  STACK_PUSH (STACK_FRAME_HEADER + 1);
+ Pushed ();
+  SET_INTERRUPT_MASK (saved_mask);
+  abort_to_interpreter (PRIM_APPLY);
+}
+\f
+/* DOS_INVALID_TRAP is an invalid trap, it means a user requested reset. */
+
+void
+DEFUN (hard_reset, (scp), struct FULL_SIGCONTEXT * scp)
+{
+  continue_from_trap (DOS_INVALID_TRAP, 0, scp);
+}
+
+/* Called synchronously. */
+
+void
+DEFUN_VOID (soft_reset)
+{
+  struct trap_recovery_info trinfo;
+  SCHEME_OBJECT * new_stack_pointer =
+    (((Stack_Pointer <= Stack_Top) && (Stack_Pointer > Stack_Guard))
+     ? Stack_Pointer
+     : 0);
+  if ((Regs[REGBLOCK_PRIMITIVE]) != SHARP_F)
+    {
+      (trinfo . state) = STATE_PRIMITIVE;
+      (trinfo . pc_info_1) = (Regs[REGBLOCK_PRIMITIVE]);
+      (trinfo . pc_info_2) =
+       (LONG_TO_UNSIGNED_FIXNUM (Regs[REGBLOCK_LEXPR_ACTUALS]));
+      (trinfo . extra_trap_info) = SHARP_F;
+    }
+  else
+    {
+      (trinfo . state) = STATE_UNKNOWN;
+      (trinfo . pc_info_1) = SHARP_F;
+      (trinfo . pc_info_2) = SHARP_F;
+      (trinfo . extra_trap_info) = SHARP_F;
+    }
+  if ((Free >= Heap_Top) || (Free < Heap_Bottom))
+    /* Let's hope this works. */
+    Free = MemTop;
+  setup_trap_frame (DOS_INVALID_TRAP, 0, 0, (&trinfo), new_stack_pointer);
+}
+
+#if !defined(HAVE_SIGCONTEXT) || !defined(HAS_COMPILER_SUPPORT) || defined(USE_STACKLETS)
+
+static void
+DEFUN (continue_from_trap, (trapno, info, scp),
+       int trapno AND
+       SIGINFO_T info AND
+       struct FULL_SIGCONTEXT * scp)
+{
+  if (Free < MemTop)
+    Free = MemTop;
+  setup_trap_frame (trapno, info, scp, (&dummy_recovery_info), 0);
+}
+
+#else /* HAVE_SIGCONTEXT and HAS_COMPILER_SUPPORT and not USE_STACKLETS */
+\f
+/* Heuristic recovery from processor traps/exceptions.
+
+   continue_from_trap attempts to:
+
+   1) validate the trap information (pc and sp);
+   2) determine whether compiled code was executing, a primitive was
+      executing, or execution was in the interpreter;
+   3) guess what C global state is still valid; and
+   4) set up a recovery frame for the interpreter so that debuggers can
+      display more information. */
+
+#include "gccode.h"
+
+#define SCHEME_ALIGNMENT_MASK          ((sizeof (long)) - 1)
+#define STACK_ALIGNMENT_MASK           SCHEME_ALIGNMENT_MASK
+#define FREE_PARANOIA_MARGIN           0x100
+
+/* PCs must be aligned according to this. */
+
+#define PC_ALIGNMENT_MASK              ((1 << PC_ZERO_BITS) - 1)
+
+/* But they may have bits that can be masked by this. */
+
+#ifndef PC_VALUE_MASK
+#define PC_VALUE_MASK                  (~0)
+#endif
+
+#define C_STACK_SIZE                   0x01000000
+
+#ifdef HAS_COMPILER_SUPPORT
+#define ALLOW_ONLY_C 0
+#else
+#define ALLOW_ONLY_C 1
+#define PLAUSIBLE_CC_BLOCK_P(block)    0
+#endif
+
+static SCHEME_OBJECT * EXFUN
+  (find_block_address, (char * pc_value, SCHEME_OBJECT * area_start));
+
+#if 0
+#define get_etext() (&etext)
+#else
+/* For now */
+#define get_etext() (Heap_Bottom)
+#endif
+
+static void
+DEFUN (continue_from_trap, (trapno, info, scp),
+       int trapno AND
+       SIGINFO_T info AND
+       struct FULL_SIGCONTEXT * scp)
+{
+  int pc_in_C;
+  int pc_in_heap;
+  int pc_in_constant_space;
+  int pc_in_scheme;
+  int pc_in_hyper_space;
+  int scheme_sp_valid;
+  long C_sp;
+  long scheme_sp;
+  long the_pc;
+  SCHEME_OBJECT * new_stack_pointer;
+  SCHEME_OBJECT * xtra_info;
+  struct trap_recovery_info trinfo;
+
+  if (scp == ((struct FULL_SIGCONTEXT *) NULL))
+  {
+    if (Free < MemTop)
+      Free = MemTop;
+    setup_trap_frame (trapno, info, scp, (&dummy_recovery_info), 0);
+    /*NOTREACHED*/
+  }
+
+  C_sp = (FULL_SIGCONTEXT_SP (scp));
+  scheme_sp = (FULL_SIGCONTEXT_SCHSP (scp));
+  the_pc = ((FULL_SIGCONTEXT_PC (scp)) & PC_VALUE_MASK);
+
+#if FALSE
+  fprintf (stderr, "\ncontinue_from_trap:");
+  fprintf (stderr, "\tpc = 0x%08lx\n", the_pc);
+  fprintf (stderr, "\tCsp = 0x%08lx\n", C_sp);
+  fprintf (stderr, "\tssp = 0x%08lx\n", scheme_sp);
+  fprintf (stderr, "\tesp = 0x%08lx\n", Ext_Stack_Pointer);
+#endif
+
+  if (((the_pc & PC_ALIGNMENT_MASK) != 0)
+      || (scp->sc_cs != initial_C_cs))
+  {
+    pc_in_C = 0;
+    pc_in_heap = 0;
+    pc_in_constant_space = 0;
+    pc_in_scheme = 0;
+    pc_in_hyper_space = 1;
+  }
+  else
+  {
+    pc_in_C = (the_pc <= ((long) (get_etext ())));
+    pc_in_heap =
+      ((the_pc < ((long) Heap_Top)) && (the_pc >= ((long) Heap_Bottom)));
+    pc_in_constant_space =
+      ((the_pc < ((long) Constant_Top)) &&
+       (the_pc >= ((long) Constant_Space)));
+    pc_in_scheme = (pc_in_heap || pc_in_constant_space);
+    pc_in_hyper_space = ((!pc_in_C) && (!pc_in_scheme));
+  }
+
+  scheme_sp_valid =
+    (pc_in_scheme
+     && ((scp->sc_ss & 0xffff) == (scp->sc_ds & 0xffff))
+     && ((scp->sc_ds & 0xffff) == (initial_C_ds & 0xffff))
+     && ((scheme_sp < ((long) Stack_Top)) &&
+        (scheme_sp >= ((long) Absolute_Stack_Base)) &&
+        ((scheme_sp & STACK_ALIGNMENT_MASK) == 0)));
+
+  new_stack_pointer =
+    (scheme_sp_valid
+     ? ((SCHEME_OBJECT *) scheme_sp)
+     : ((pc_in_C
+       && ((scp->sc_ss & 0xffff) == (initial_C_ss & 0xffff))
+       && (Stack_Pointer < Stack_Top)
+       && (Stack_Pointer > Absolute_Stack_Base))
+        ? Stack_Pointer
+        : ((SCHEME_OBJECT *) 0)));
+
+  if (pc_in_hyper_space || (pc_in_scheme && ALLOW_ONLY_C))
+  {
+    /* In hyper space. */
+    (trinfo . state) = STATE_UNKNOWN;
+    (trinfo . pc_info_1) = SHARP_F;
+    (trinfo . pc_info_2) = SHARP_F;
+    new_stack_pointer = 0;
+    if ((Free < MemTop) ||
+       (Free >= Heap_Top) ||
+       ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
+      Free = MemTop;
+  }
+  else if (pc_in_scheme)
+  {
+    /* In compiled code. */
+    SCHEME_OBJECT * block_addr;
+    SCHEME_OBJECT * maybe_free;
+    block_addr =
+      (find_block_address (((PTR) the_pc),
+                          (pc_in_heap ? Heap_Bottom : Constant_Space)));
+    if (block_addr == 0)
+    {
+      (trinfo . state) = STATE_PROBABLY_COMPILED;
+      (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (the_pc));
+      (trinfo . pc_info_2) = SHARP_F;
+      if ((Free < MemTop) ||
+         (Free >= Heap_Top) ||
+         ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
+       Free = MemTop;
+    }
+    else
+    {
+      (trinfo . state) = STATE_COMPILED_CODE;
+      (trinfo . pc_info_1) =
+       (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr));
+      (trinfo . pc_info_2) =
+       (LONG_TO_UNSIGNED_FIXNUM (the_pc - ((long) block_addr)));
+#ifdef HAVE_FULL_SIGCONTEXT
+      maybe_free = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_RFREE (scp)));
+      if (((((unsigned long) maybe_free) & SCHEME_ALIGNMENT_MASK) == 0)
+         && (maybe_free >= Heap_Bottom) && (maybe_free < Heap_Top))
+       Free = (maybe_free + FREE_PARANOIA_MARGIN);
+      else
+#endif
+      {
+       if ((Free < MemTop) || (Free >= Heap_Top)
+           || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
+         Free = MemTop;
+      }
+    }
+  }
+  else
+  {
+    /* In the interpreter, a primitive, or a compiled code utility. */
+
+    SCHEME_OBJECT primitive = (Regs[REGBLOCK_PRIMITIVE]);
+
+    if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE)
+    {
+      (trinfo . state) = STATE_UNKNOWN;
+      (trinfo . pc_info_1) = SHARP_F;
+      (trinfo . pc_info_2) = SHARP_F;
+      new_stack_pointer = 0;
+    }
+    else
+    {
+      long primitive_address =
+       ((long) (Primitive_Procedure_Table[OBJECT_DATUM (primitive)]));
+      (trinfo . state) = STATE_PRIMITIVE;
+      (trinfo . pc_info_1) = primitive;
+      (trinfo . pc_info_2) =
+       (LONG_TO_UNSIGNED_FIXNUM (Regs[REGBLOCK_LEXPR_ACTUALS]));
+    }
+    if ((new_stack_pointer == 0)
+       || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)
+       || ((Free < Heap_Bottom) || (Free >= Heap_Top))
+       || ((Free < MemTop) && ((Free + FREE_PARANOIA_MARGIN) >= MemTop)))
+      Free = MemTop;
+    else if ((Free + FREE_PARANOIA_MARGIN) < MemTop)
+      Free +=  FREE_PARANOIA_MARGIN;
+  }
+  xtra_info = Free;
+  Free += (1 + 2 + PROCESSOR_NREGS);
+  (trinfo . extra_trap_info) =
+    (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, xtra_info));
+  (*xtra_info++) =
+    (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (2 + PROCESSOR_NREGS)));
+  (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
+  (*xtra_info++) = ((SCHEME_OBJECT) C_sp);
+  {
+    int counter = FULL_SIGCONTEXT_NREGS;
+    int * regs = (FULL_SIGCONTEXT_FIRST_REG (scp));
+    while ((counter--) > 0)
+      (*xtra_info++) = ((SCHEME_OBJECT) (*regs++));
+  }
+  /* We assume that regs,sp,pc is the order in the processor.
+     Scheme can always fix this. */
+  if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 0)
+    (*xtra_info++) = ((SCHEME_OBJECT) C_sp);
+  if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 1)
+    (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
+  setup_trap_frame (trapno, info, scp, (&trinfo), new_stack_pointer);
+}
+\f
+/* Find the compiled code block in area which contains `pc_value'.
+   This attempts to be more efficient than `find_block_address_in_area'.
+   If the pointer is in the heap, it can actually do twice as
+   much work, but it is expected to pay off on the average. */
+
+static SCHEME_OBJECT * EXFUN
+  (find_block_address_in_area, (char * pc_value, SCHEME_OBJECT * area_start));
+
+#define MINIMUM_SCAN_RANGE             2048
+
+static SCHEME_OBJECT *
+DEFUN (find_block_address, (pc_value, area_start),
+       char * pc_value AND
+       SCHEME_OBJECT * area_start)
+{
+  if (area_start == Constant_Space)
+    {
+      extern SCHEME_OBJECT * EXFUN
+       (find_constant_space_block, (SCHEME_OBJECT *));
+      SCHEME_OBJECT * constant_block =
+       (find_constant_space_block
+        ((SCHEME_OBJECT *)
+         (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK)));
+      return
+       ((constant_block == 0)
+        ? 0
+        : (find_block_address_in_area (pc_value, constant_block)));
+    }
+  {
+    SCHEME_OBJECT * nearest_word =
+      ((SCHEME_OBJECT *)
+       (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK));
+    long maximum_distance = (nearest_word - area_start);
+    long distance = maximum_distance;
+    while ((distance / 2) > MINIMUM_SCAN_RANGE)
+      distance = (distance / 2);
+    while ((distance * 2) < maximum_distance)
+      {
+       SCHEME_OBJECT * block =
+         (find_block_address_in_area (pc_value, (nearest_word - distance)));
+       if (block != 0)
+         return (block);
+       distance *= 2;
+      }
+  }
+  return (find_block_address_in_area (pc_value, area_start));
+}
+\f
+/*
+  Find the compiled code block in area which contains `pc_value',
+  by scanning sequentially the complete area.
+  For the time being, skip over manifest closures and linkage sections. */
+
+static SCHEME_OBJECT *
+DEFUN (find_block_address_in_area, (pc_value, area_start),
+       char * pc_value AND
+       SCHEME_OBJECT * area_start)
+{
+  SCHEME_OBJECT * first_valid = area_start;
+  SCHEME_OBJECT * area = area_start;
+  while (((char *) area) < pc_value)
+    {
+      SCHEME_OBJECT object = (*area);
+      switch (OBJECT_TYPE (object))
+       {
+       case TC_LINKAGE_SECTION:
+         {
+           switch (READ_LINKAGE_KIND (object))
+           {
+             case OPERATOR_LINKAGE_KIND:
+             case GLOBAL_OPERATOR_LINKAGE_KIND:
+             {
+               long count = (READ_OPERATOR_LINKAGE_COUNT (object));
+               area = ((END_OPERATOR_LINKAGE_AREA (area, count)) + 1);
+               break;
+             }
+
+             default:
+#if FALSE
+             {
+               gc_death (TERM_EXIT,
+                         "find_block_address: Unknown compiler linkage kind.",
+                         area, NULL);
+               /*NOTREACHED*/
+             }
+#else
+             /* Fall through, no reason to crash here. */
+#endif
+             case REFERENCE_LINKAGE_KIND:
+             case ASSIGNMENT_LINKAGE_KIND:
+               area += ((READ_CACHE_LINKAGE_COUNT (object)) + 1);
+               break;
+
+           }
+           break;
+         }
+       case TC_MANIFEST_CLOSURE:
+         {
+           area += 1;
+           {
+             long count = (MANIFEST_CLOSURE_COUNT (area));
+             area = ((MANIFEST_CLOSURE_END (area, count)) + 1);
+           }
+           break;
+         }
+       case TC_MANIFEST_NM_VECTOR:
+         {
+           long count = (OBJECT_DATUM (object));
+           if (((char *) (area + (count + 1))) < pc_value)
+             {
+               area += (count + 1);
+               first_valid = area;
+               break;
+             }
+           {
+             SCHEME_OBJECT * block = (area - 1);
+             return
+               (((area == first_valid) ||
+                 ((OBJECT_TYPE (*block)) != TC_MANIFEST_VECTOR) ||
+                 ((OBJECT_DATUM (*block)) < (count + 1)) ||
+                 (! (PLAUSIBLE_CC_BLOCK_P (block))))
+                ? 0
+                : block);
+           }
+         }
+       default:
+         {
+           area += 1;
+           break;
+         }
+       }
+    }
+  return (0);
+}
+
+#endif /* HAVE_SIGCONTEXT and HAS_COMPILER_SUPPORT and not USE_STACKLETS */
+
diff --git a/v7/src/microcode/dostrap.h b/v7/src/microcode/dostrap.h
new file mode 100644 (file)
index 0000000..26c0660
--- /dev/null
@@ -0,0 +1,95 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dostrap.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef SCM_DOSTRAP_H
+#define SCM_DOSTRAP_H
+\f
+#ifndef SIGINFO_T
+#define SIGINFO_T unsigned
+#define SIGINFO_VALID_P(info) (1)
+#define SIGINFO_CODE(info) (info)
+#endif
+
+/* EIP not included here, not a "register", except on the Vax.
+   8 General registers.
+   6 Segment registers.
+   1 Flags   register.
+ */
+
+#define HAVE_SIGCONTEXT
+#define HAVE_FULL_SIGCONTEXT
+#define PROCESSOR_NREGS                        (8 + 6 + 1)
+#define FULL_SIGCONTEXT_NREGS          PROCESSOR_NREGS
+
+#define SIGCONTEXT                     sigcontext
+#define SIGCONTEXT_SP(scp)             ((scp)->sc_esp)
+#define SIGCONTEXT_PC(scp)             ((scp)->sc_eip)
+
+#define FULL_SIGCONTEXT                        SIGCONTEXT
+#define FULL_SIGCONTEXT_SP             SIGCONTEXT_SP
+#define FULL_SIGCONTEXT_PC             SIGCONTEXT_PC
+#define FULL_SIGCONTEXT_RFREE(scp)     ((scp)->sc_edi)
+#define FULL_SIGCONTEXT_FIRST_REG(scp) (& (scp->sc_eax))
+#define FULL_SIGCONTEXT_SCHSP          FULL_SIGCONTEXT_SP
+
+#define DECLARE_FULL_SIGCONTEXT(name)                                  \
+  struct FULL_SIGCONTEXT * name
+
+#define INITIALIZE_FULL_SIGCONTEXT(partial, full)                      \
+  ((full) = ((struct FULL_SIGCONTEXT *) (partial)))
+
+#define INVALID_TRAP                   -1
+\f
+enum trap_state
+{
+  trap_state_trapped,
+  trap_state_exit,
+  trap_state_suspend,
+  trap_state_query,
+  trap_state_recover,
+  trap_state_exitting_soft,
+  trap_state_exitting_hard
+};
+
+extern enum trap_state EXFUN (OS_set_trap_state, (enum trap_state state));
+extern void EXFUN
+  (trap_handler,
+   (CONST char * message,
+    int signo,
+    SIGINFO_T info,
+    struct FULL_SIGCONTEXT * scp));
+extern void EXFUN (hard_reset, (struct FULL_SIGCONTEXT * scp));
+extern void EXFUN (soft_reset, (void));
+
+#endif /* SCM_DOSTRAP_H */
diff --git a/v7/src/microcode/dostterm.c b/v7/src/microcode/dostterm.c
new file mode 100644 (file)
index 0000000..0528fb5
--- /dev/null
@@ -0,0 +1,104 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dostterm.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* termcap(3) interface for Scheme -- Only a subset needed for DOS. */
+
+#include "scheme.h"
+#include "prims.h"
+#include "osterm.h"
+
+extern char * EXFUN (tparam, (char *, char*, int, int, ...));
+extern char * EXFUN (tgoto, (char *, int, int));
+extern int EXFUN (tputs, (char *, int, void (*) (int)));
+extern char * BC;
+extern char * UP;
+extern char PC;
+extern short ospeed;
+
+#ifndef TERMCAP_BUFFER_SIZE
+#define TERMCAP_BUFFER_SIZE 2048
+#endif
+
+static char tputs_output [TERMCAP_BUFFER_SIZE];
+static char * tputs_output_scan;
+
+static void
+DEFUN (tputs_write_char, (c), int c)
+{
+  (*tputs_output_scan++) = c;
+  return;
+}
+\f
+DEFINE_PRIMITIVE ("TERMCAP-PARAM-STRING", Prim_termcap_param_string, 5, 5, 0)
+{
+  PRIMITIVE_HEADER (5);
+  {
+    char * s =
+      (tparam ((STRING_ARG (1)), 0, 0,
+              (arg_nonnegative_integer (2)),
+              (arg_nonnegative_integer (3)),
+              (arg_nonnegative_integer (4)),
+              (arg_nonnegative_integer (5))));
+    SCHEME_OBJECT result = (char_pointer_to_string ((unsigned char *) s));
+    free (s);
+    PRIMITIVE_RETURN (result);
+  }
+}
+
+DEFINE_PRIMITIVE ("TERMCAP-GOTO-STRING", Prim_termcap_goto_string, 5, 5, 0)
+{
+  PRIMITIVE_HEADER (5);
+  {
+    BC = (((ARG_REF (4)) == SHARP_F) ? 0 : (STRING_ARG (4)));
+    UP = (((ARG_REF (5)) == SHARP_F) ? 0 : (STRING_ARG (5)));
+    PRIMITIVE_RETURN
+      (char_pointer_to_string
+       ((unsigned char *)
+       (tgoto ((STRING_ARG (1)),
+               (arg_nonnegative_integer (2)),
+               (arg_nonnegative_integer (3))))));
+  }
+}
+
+DEFINE_PRIMITIVE ("TERMCAP-PAD-STRING", Prim_termcap_pad_string, 4, 4, 0)
+{
+  PRIMITIVE_HEADER (4);
+  ospeed = (arg_baud_index (3));
+  PC = (((ARG_REF (4)) == SHARP_F) ? '\0' : ((STRING_ARG (4)) [0]));
+  tputs_output_scan = tputs_output;
+  tputs ((STRING_ARG (1)), (arg_nonnegative_integer (2)), tputs_write_char);
+  PRIMITIVE_RETURN
+    (memory_to_string ((tputs_output_scan - tputs_output),
+                      ((unsigned char *) tputs_output)));
+}
diff --git a/v7/src/microcode/dostty.c b/v7/src/microcode/dostty.c
new file mode 100644 (file)
index 0000000..c509097
--- /dev/null
@@ -0,0 +1,161 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dostty.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "ostty.h"
+#include "osenv.h"
+#include "dosio.h"
+#include "dosterm.h"
+\f
+/* Standard Input and Output */
+
+static Tchannel input_channel;
+static Tchannel output_channel;
+static int tty_x_size;
+static int tty_y_size;
+static char * tty_command_beep;
+static char * tty_command_clear;
+
+Tchannel
+DEFUN_VOID (OS_tty_input_channel)
+{
+  return (input_channel);
+}
+
+Tchannel
+DEFUN_VOID (OS_tty_output_channel)
+{
+  return (output_channel);
+}
+
+unsigned int
+DEFUN_VOID (OS_tty_x_size)
+{
+  return (tty_x_size);
+}
+
+unsigned int
+DEFUN_VOID (OS_tty_y_size)
+{
+  return (tty_y_size);
+}
+
+CONST char *
+DEFUN_VOID (OS_tty_command_beep)
+{
+  return (tty_command_beep);
+}
+
+CONST char *
+DEFUN_VOID (OS_tty_command_clear)
+{
+  return (tty_command_clear);
+}
+\f
+#ifndef TERMCAP_BUFFER_SIZE
+#define TERMCAP_BUFFER_SIZE 0
+#endif
+
+#ifndef DEFAULT_TTY_X_SIZE
+#define DEFAULT_TTY_X_SIZE 80
+#endif
+
+#ifndef DEFAULT_TTY_Y_SIZE
+#define DEFAULT_TTY_Y_SIZE 25
+#endif
+
+static int
+DEFUN (getenv_integer, (var, default_val), char * var AND int default_val)
+{
+  CONST char * value = (DOS_getenv(var));
+  return ((value == NULL) ? default_val : (atoi(value)));
+}
+
+void
+DEFUN_VOID (DOS_initialize_tty)
+{
+  extern Tchannel EXFUN (OS_open_fd, (int fd));
+  input_channel = (OS_open_fd (STDIN_FILENO));
+  (CHANNEL_INTERNAL (input_channel)) = 1;
+  output_channel = (OS_open_fd (STDOUT_FILENO));
+  (CHANNEL_INTERNAL (output_channel)) = 1;
+  tty_x_size = (-1);
+  tty_y_size = (-1);
+  tty_command_beep = ALERT_STRING;
+  tty_command_clear = 0;
+  /* Figure out the size of the terminal.  First ask the operating
+     system, if it has an appropriate system call.  Then try the
+     environment variables COLUMNS and LINES.  Then try termcap.
+     Finally, use the default.  */
+  tty_x_size = getenv_integer("COLUMNS", DEFAULT_TTY_X_SIZE);
+  tty_y_size = getenv_integer("LINES", DEFAULT_TTY_Y_SIZE);
+
+  if (tty_command_clear == 0)
+    tty_command_clear = "\033[2J";
+}
+
+\f
+/* Fake TERMCAP capability */
+short ospeed;
+char PC;
+
+int tputs (string, nlines, outfun)
+     register char *string;
+     int nlines;
+     register int (*outfun) ();
+{
+  register int padcount = 0;
+
+  if (string == (char *) 0)
+    return;
+  while (*string >= '0' && *string <= '9')
+    {
+      padcount += *string++ - '0';
+      padcount *= 10;
+    }
+  if (*string == '.')
+    {
+      string++;
+      padcount += *string++ - '0';
+    }
+  if (*string == '*')
+    {
+      string++;
+      padcount *= nlines;
+    }
+  while (*string)
+    (*outfun) (*string++);
+
+  return 0;
+}
diff --git a/v7/src/microcode/dosutil.c b/v7/src/microcode/dosutil.c
new file mode 100644 (file)
index 0000000..215b4e7
--- /dev/null
@@ -0,0 +1,223 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosutil.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#include "msdos.h"
+#include "dosutil.h"
+#include <ctype.h>
+\f
+static CONST char *
+DEFUN (char_description_brief, (c), unsigned char c)
+{
+  static char buffer [5];
+  switch (c)
+    {
+    case ' ': return ("SPC");
+    case '\t': return ("TAB");
+    case '\r': return ("RET");
+    case '\n': return ("LFD");
+    case '\033': return ("ESC");
+    case '\177': return ("DEL");
+    default:
+      if (c < ' ')
+       {
+         (buffer[0]) = '^';
+         (buffer[1]) = (c + '@');
+         (buffer[2]) = '\0';
+       }
+      else if (c < '\177')
+       {
+         (buffer[0]) = c;
+         (buffer[1]) = '\0';
+       }
+      else
+       {
+         (buffer[0]) = '\\';
+         (buffer[1]) = (c >> 6);
+         (buffer[2]) = ((c >> 3) & 7);
+         (buffer[3]) = (c & 7);
+         (buffer[4]) = '\0';
+       }
+      return (buffer);
+    }
+}
+
+CONST char *
+DEFUN (char_description, (c, long_p), unsigned char c AND int long_p)
+{
+  static char buffer [64];
+  CONST char * description = (char_description_brief (c));
+  if (long_p)
+    {
+      int meta = (c >= 0200);
+      int cc = (c & 0177);
+      int control = (cc < 0040);
+      if (meta || control)
+       {
+         sprintf (buffer, "`%s' (%s%s%c)",
+                  description,
+                  (meta ? "meta-" : ""),
+                  (control ? "control-" : ""),
+                  (control ? (cc + 0100) : cc));
+         return (buffer);
+       }
+    }
+  sprintf (buffer, "`%s'", description);
+  return (buffer);
+}
+\f
+void
+DEFUN_VOID (DOS_initialize_userio)
+{
+  return;
+}
+
+static void
+DEFUN (restore_input_state, (ap), PTR ap)
+{
+  return;
+}
+
+void
+DEFUN_VOID (userio_buffered_input)
+{
+  return;
+}
+
+char
+DEFUN_VOID (userio_read_char)
+{
+  char c;
+  while (1)
+    {
+      int nread;
+
+      errno = 0;
+      nread = (DOS_read (STDIN_FILENO, (&c), 1));
+      if (nread == 1)
+       break;
+      if (errno != EINTR)
+       {
+         c = '\0';
+         break;
+       }
+    }
+  return (c);
+}
+
+char
+DEFUN_VOID (userio_read_char_raw)
+{
+  transaction_begin ();
+  {
+    char c = (userio_read_char ());
+    transaction_commit ();
+    return (c);
+  }
+}
+\f
+char
+DEFUN (userio_choose_option, (herald, prompt, choices),
+       CONST char * herald AND
+       CONST char * prompt AND
+       CONST char ** choices)
+{
+  while (1)
+    {
+      fputs (herald, stdout);
+      putc ('\n', stdout);
+      {
+       CONST char ** scan = choices;
+       while (1)
+         {
+           CONST char * choice = (*scan++);
+           if (choice == 0)
+             break;
+           fprintf (stdout, "  %s\n", choice);
+         }
+      }
+      fputs (prompt, stdout);
+      fflush (stdout);
+      {
+       char command = (userio_read_char_raw ());
+       if ((command == '\0') && (errno != 0))
+         return (command);
+       putc ('\n', stdout);
+       fflush (stdout);
+       if (islower (command))
+         command = (toupper (command));
+       {
+         CONST char ** scan = choices;
+         while (1)
+           {
+             CONST char * choice = (*scan++);
+             if (choice == 0)
+               break;
+             {
+               char option = (*choice);
+               if (islower (option))
+                 option = (toupper (option));
+               if (command == option)
+                 return (option);
+             }
+           }
+       }
+      }
+    }
+}
+
+int
+DEFUN (userio_confirm, (prompt), CONST char * prompt)
+{
+  while (1)
+    {
+      fputs (prompt, stdout);
+      fflush (stdout);
+      switch (userio_read_char_raw ())
+       {
+       case 'y':
+       case 'Y':
+         return (1);
+       case 'n':
+       case 'N':
+         return (0);
+       case '\0':
+         if (errno != 0)
+         {
+           /* IO problems, assume everything scrod. */
+           fprintf (stderr, "Problems reading keyboard input -- exiting.\n");
+           termination_eof ();
+         }
+       }
+    }
+}
diff --git a/v7/src/microcode/dosutil.h b/v7/src/microcode/dosutil.h
new file mode 100644 (file)
index 0000000..508bc8f
--- /dev/null
@@ -0,0 +1,49 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosutil.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+#ifndef SCM_UXUTIL_H
+#define SCM_UXUTIL_H
+
+#include "os.h"
+
+extern CONST char * EXFUN (char_description, (unsigned char c, int long_p));
+extern void EXFUN (userio_buffered_input, (void));
+extern char EXFUN (userio_read_char, (void));
+extern char EXFUN (userio_read_char_raw, (void));
+extern char EXFUN
+  (userio_choose_option,
+   (CONST char * herald, CONST char * prompt, CONST char ** choices));
+extern int EXFUN (userio_confirm, (CONST char * prompt));
+
+#endif /* SCM_UXUTIL_H */
diff --git a/v7/src/microcode/dosxcutl.asm b/v7/src/microcode/dosxcutl.asm
new file mode 100644 (file)
index 0000000..d9532a7
--- /dev/null
@@ -0,0 +1,369 @@
+;;; -*-Midas-*-
+;;;
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dosxcutl.asm,v 1.1 1992/05/05 06:55:13 jinx Exp $
+;;;
+;;;    Copyright (c) 1992 Massachusetts Institute of Technology
+;;;
+;;;    This material was developed by the Scheme project at the
+;;;    Massachusetts Institute of Technology, Department of
+;;;    Electrical Engineering and Computer Science.  Permission to
+;;;    copy this software, to redistribute it, and to use it for any
+;;;    purpose is granted, subject to the following restrictions and
+;;;    understandings.
+;;;
+;;;    1. Any copy made of this software must include this copyright
+;;;    notice in full.
+;;;
+;;;    2. Users of this software agree to make their best efforts (a)
+;;;    to return to the MIT Scheme project any improvements or
+;;;    extensions that they make, so that these may be included in
+;;;    future releases; and (b) to inform MIT of noteworthy uses of
+;;;    this software.
+;;;
+;;;    3. All materials developed as a consequence of the use of this
+;;;    software shall duly acknowledge such use, in accordance with
+;;;    the usual standards of acknowledging credit in academic
+;;;    research.
+;;;
+;;;    4. MIT has made no warrantee or representation that the
+;;;    operation of this software will be error-free, and MIT is
+;;;    under no obligation to provide any services, by way of
+;;;    maintenance, update, or otherwise.
+;;;
+;;;    5. In conjunction with products arising from the use of this
+;;;    material, there shall be no use of the name of the
+;;;    Massachusetts Institute of Technology nor of any adaptation
+;;;    thereof in any advertising, promotional, or sales literature
+;;;    without prior written consent from MIT in each case.
+;;;
+
+.386
+.model small
+       .code
+\f
+       public _DPMI_GP_exception_method
+_DPMI_GP_exception_method:
+       cmp     40[esp],080000000h
+       je      DPMI_exception_method_merge
+       lea     esp,32[esp]             ; pop args
+;      jmpf    -32[esp]                ; invoke previous handler
+       db      0ffh
+       db      06ch
+       db      024h
+       db      0e0h
+
+DPMI_exception_method_merge:
+       lea     esp,8[esp]              ; pop previous handler
+       ;; fall through
+
+;;     frame on entry to DPMI_exception_method
+;;     
+;;28   trapped SS
+;;24   trapped ESP
+;;20   trapped EFLAGS
+;;16   trapped CS
+;;12   trapped EIP
+;;8    TRAP error code
+;;4    DPMI return hook CS
+;;0    DPMI return hook EIP
+;; <Above this is a standard DPMI exception frame>
+;;20   TRAP number
+;;16   C handler DS
+;;12   C handler CS    
+;;8    C handler EIP
+;;4    trap handling SS
+;;0    trap handling ESP
+;; <old ebp goes here>
+;;
+;; This code assumes that the trapped ESP is valid.
+;; It will push from it.
+;; Thus this code cannot be used for a stack fault exception.
+
+       public _DPMI_exception_method
+_DPMI_exception_method:
+       push    ebp
+       mov     ebp,esp
+       push    es
+       push    eax
+       push    ecx
+       push    edx
+       push    ebx
+
+       mov     eax,4[ebp+4]            ; trap frame SS
+       mov     ecx,0[ebp+4]            ; trap frame ESP
+       xor     ebx,ebx
+       mov     ebx,28[ebp+28]          ; trapped SS
+       mov     edx,24[ebp+28]          ; trapped ESP
+       cmp     ecx,0
+       jne     set_up_trap_frame
+       mov     ecx,edx                 ; Use the trapped stack
+       mov     eax,ebx                 ; to build the trap frame
+\f
+set_up_trap_frame:
+       push    eax
+       pop     es
+
+       sub     ecx,4                   ; push trapped SS
+       mov     es:[ecx],ebx
+       
+       sub     ecx,4                   ; push trapped ESP
+       mov     es:[ecx],edx
+       
+       sub     ecx,4                   ; push trapped EFLAGS
+       mov     eax,20[ebp+28]
+       mov     es:[ecx],eax
+
+       sub     ecx,4                   ; push trapped CS
+       xor     eax,eax
+       mov     ax,16[ebp+28]
+       mov     es:[ecx],eax
+
+       sub     ecx,4                   ; push trapped EIP
+       mov     eax,12[ebp+28]
+       mov     es:[ecx],eax
+
+       sub     ecx,4                   ; push trap code
+       mov     eax,8[ebp+28]
+       mov     es:[ecx],eax
+
+       sub     ecx,4                   ; push trap number
+       mov     eax,20[ebp+4]
+       mov     es:[ecx],eax
+
+       sub     ecx,4                   ; push funcptr DS
+       mov     eax,16[ebp+4]
+       mov     es:[ecx],eax
+
+       sub     ecx,4                   ; push funcptr CS
+       mov     eax,12[ebp+4]
+       mov     es:[ecx],eax
+
+       sub     ecx,4                   ; push funcptr EIP
+       mov     eax,8[ebp+4]
+       mov     es:[ecx],eax
+
+       mov     28[ebp+28],es           ; store hook SS
+       mov     24[ebp+28],ecx          ; store hook ESP
+
+       mov     16[ebp+28],cs           ; replace trapped CS
+       jmp     DPMI_obtain_hook_pc
+
+DPMI_after_obtain_hook_pc:
+       pop     eax                     ; PC of obtain_pc
+       mov     12[ebp+28],eax          ; replace trapped EIP
+
+       pop     ebx
+       pop     edx
+       pop     ecx
+       pop     eax
+       pop     es
+       pop     ebp
+        lea     esp,24[esp]            ; pop args
+
+;       The assembler does not assemble the following instruction correctly.
+;      ret     far                     ; resume thread
+        db      0cbh
+\f
+;;     Kludge to obtain the offset of DPMI_exception_method_hook
+       
+DPMI_obtain_hook_pc:
+       call    DPMI_after_obtain_hook_pc
+
+;;     Intercepted trap frame:
+;;     
+;;36   trapped SS
+;;32   trapped ESP     <Typically a pointer to offset 40>
+;;28   trapped EFLAGS
+;;24   trapped CS
+;;20   trapped EIP
+;;16   trap code
+;;12   trap number
+;;8    C function DS
+;;4    C function CS
+;;0    C function EIP
+
+       public DPMI_exception_method_hook
+DPMI_exception_method_hook:
+       push    ebp                     ; preserve trapped ebp
+       mov     ebp,esp
+       push    gs                      ; -4
+       push    fs                      ; -8
+       push    es                      ; -12
+       push    ds                      ; -16
+       push    36[ebp+4]               ; -20 trapped ss
+       push    24[ebp+4]               ; -24 trapped cs
+       push    28[ebp+4]               ; -28 trapped eflags
+       push    20[ebp+4]               ; -32 trapped eip
+       push    edi                     ; -36
+       push    esi                     ; -40
+       push    [ebp]                   ; -44 trapped ebp
+       push    32[ebp+4]               ; -48 trapped esp
+       push    ebx                     ; -52
+       push    edx                     ; -56
+       push    ecx                     ; -60
+       push    eax                     ; -64
+       push    esp                     ; sigcontext ptr
+       push    16[ebp+4]               ; trap code
+       push    12[ebp+4]               ; trap number
+
+       mov     ds,8[ebp+4]             ; DS of handler
+       mov     edx,4[ebp+4]            ; CS of handler
+       mov     eax,0[ebp+4]            ; EIP of handler
+       cmp     edx,0                   ; test CS of handler
+       jne     DPMI_use_far_call
+       call    eax                     ; Invoke handler
+       jmp     DPMI_continue_after_exception
+
+DPMI_after_continuation_setup:
+;;     Build far RET frame on stack
+
+       push    edx                     ; CS of handler
+       push    eax                     ; EIP of handler
+
+;      ret     far                     ; Invoke handler
+        db      0cbh
+\f
+DPMI_use_far_call:
+       push    cs                      ; Simulate a far call
+       call    DPMI_after_continuation_setup
+
+DPMI_continue_after_exception:
+;;
+;;     If the handler returns, update machine state and `return' to
+;;     the trapped code.
+;;
+       add     esp,12                  ; pop args to C handler
+
+       mov     eax,-48[ebp]            ; update esp
+       mov     32[ebp+4],eax
+       mov     eax,-44[ebp]            ; update ebp
+       mov     [ebp],eax
+       mov     eax,-32[ebp]            ; update eip
+       mov     20[ebp+4],eax
+       mov     eax,-28[ebp]            ; update eflags
+       mov     28[ebp+4],eax
+       mov     eax,-24[ebp]            ; update cs
+       mov     24[ebp+4],eax
+       mov     eax,-20[ebp]            ; update ss
+       mov     36[ebp+4],eax
+
+       pop     eax
+       pop     ecx
+       pop     edx
+       pop     ebx
+       add     esp,8                   ; ignore esp and ebp
+       pop     esi
+       pop     edi
+       add     esp,16                  ; ignore eip, eflags, cs, ss
+       pop     ds
+       pop     es
+       pop     fs
+       pop     gs
+
+;;     If this were part of the OS, the following instructions would
+;;     do what we want, assuming that we were running at a higher
+;;     privilege level than the interrupted task.  We need a
+;;     `return-to-outer-level' IRETD that restores ESP and SS in
+;;     addition to EIP, CS, and EFLAGS.
+;;
+;;     However, the architecture does not allow us to specify that
+;;     explicitly, and in all likelihood an IRETD will be taken to
+;;     mean a `return-to-samel-level' IRETD, which will not pop and
+;;     update SS and ESP!
+;;
+;;     pop     ebp
+;;     lea     esp,20[esp]             ; bump past trap info
+;;     iretd                           ; I wish
+;;     
+;;     The only way to correctly emulate it is to construct a piece
+;;     of code that contains an explicit far jump to the return
+;;     CS:EIP after loading EFLAGS, SS, and ESP from the stack.
+;;     Unfortunately we can't conveniently create such a thunk here,
+;;     since we don't have a pair of selectors representing a code
+;;     segment and a writable data segment with the same base and
+;;     limit.
+;;
+;;     Instead what this code will do is check whether the stack would
+;;     not change (same SS and offset to immediately above the frame).
+;;     If so, after moving the data around, we'll just do a far return.
+;;
+;;     Otherwise, we will build a far return frame on the target stack,
+;;     switch stacks, and do a far return.
+;;
+;;     This will only work if the target stack is reasonable (and is
+;;     big enough for a few words).  This is particularly not true in
+;;     the case of a stack fault, but we would expect the returning
+;;     handler to have changed the stack to a valid one in that case
+;;     -- not a valid assumption.
+;;
+;;     In addition, the stack comparison assumes that different selectors
+;;     mean different stacks, which is also not a valid assumption.
+;;     particularly since 32-bit programs often have different SS and DS
+;;     selectors mapping over the same linear range.
+;;     The code also assumes that even if the selectors are the same,
+;;     the target range is either identical to the default,
+;;     or non-overlapping.
+\f
+       push    eax                     ; -4
+       mov     ax,ss
+       cmp     ax,36[ebp+4]
+       jne     DPMI_different_stacks
+       lea     eax,40[ebp+4]
+       cmp     eax,32[ebp+4]
+       jne     DPMI_different_stacks
+
+;;     Easy case:  The target stack is what we would return to trivially.
+;;     Overwrite SS and ESP with CS and EIP, restore flags, and do a far
+;;     return.
+
+       mov     eax,24[ebp+4]           ; Move CS
+       mov     36[ebp+4],eax
+       mov     eax,20[ebp+4]           ; Move EIP
+       mov     32[ebp+4],eax
+       pop     eax
+       pop     ebp
+       lea     esp,28[ebp]             ; Pop trap info and old CS and EIP
+       popfd                           ; Restore eflags
+;
+;       The assembler does not assemble the following instruction correctly.
+;      ret     far                     ; resume thread
+        db      0cbh
+       
+DPMI_different_stacks:
+       push    edx                     ; -8  Scratch regs
+       push    ds                      ; -12 These two must be contiguous
+       push    ecx                     ; -16  for LDS instruction below!
+       mov     ds,36[ebp+4]            ; target stack SS
+       mov     ecx,32[ebp+4]           ; target stack ESP
+
+       sub     ecx,4                   ; push target CS
+       mov     eax,24[ebp+4]
+       mov     [ecx],eax
+
+       sub     ecx,4                   ; push target EIP
+       mov     eax,20[ebp+4]
+       mov     [ecx],eax
+
+       sub     ecx,4                   ; push target EFLAGS
+       mov     eax,28[ebp+4]
+       mov     [ecx],eax
+;;
+;;     Switch stacks
+;;
+       mov     dx,ss                   ; Preserve current stack
+       mov     ax,ds
+       mov     ss,ax                   ; This instruction locks
+       mov     esp,ecx                 ;  interrupts around this one!
+       mov     ds,dx
+       mov     ecx,ebp
+
+       mov     ebp,[ecx]               ; Restore regs
+       mov     eax,-4[ecx]
+       mov     edx,-8[ecx]
+       lds     ecx,-16[ecx]
+       popfd
+
+;      ret     far                     ; resume thread
+        db      0cbh
+
+end
diff --git a/v7/src/microcode/msdos.h b/v7/src/microcode/msdos.h
new file mode 100644 (file)
index 0000000..c14342e
--- /dev/null
@@ -0,0 +1,530 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/msdos.h,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* Unix system include file */
+
+#ifndef SCM_DOS_H
+#define SCM_DOS_H
+
+#define SYSTEM_NAME "dos"
+#define SYSTEM_VARIANT "MS-DOS"
+
+#include <sys/types.h>
+#include <sys/times.h>
+#include <dos.h>
+#include <io.h>
+#include <conio.h>
+#include <sys/stat.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <direct.h>
+#include <signal.h>
+#include <errno.h>
+/* We fake these for console I/O in DOS */
+#ifndef ESTALE
+#define ESTALE         1997
+#endif
+#ifndef ERRNO_NONBLOCK
+#define ERRNO_NONBLOCK 1998
+#endif
+#ifndef EINTR
+#define EINTR          1999
+#endif
+
+#include "oscond.h"
+#include "ansidecl.h"
+#include "posixtype.h"
+
+#include "intext.h"
+#include "dstack.h"
+#include "osscheme.h"
+#include "dossys.h"
+\f
+enum syscall_names
+{
+  syscall_accept,
+  syscall_bind,
+  syscall_chdir,
+  syscall_chmod,
+  syscall_close,
+  syscall_connect,
+  syscall_fcntl_GETFL,
+  syscall_fcntl_SETFL,
+  syscall_fork,
+  syscall_fstat,
+  syscall_ftruncate,
+  syscall_getcwd,
+  syscall_gethostname,
+  syscall_gettimeofday,
+  syscall_ioctl_TIOCGPGRP,
+  syscall_ioctl_TIOCSIGSEND,
+  syscall_kill,
+  syscall_link,
+  syscall_listen,
+  syscall_localtime,
+  syscall_lseek,
+  syscall_lstat,    
+  syscall_malloc,
+  syscall_mkdir,
+  syscall_open,
+  syscall_opendir,
+  syscall_pause,
+  syscall_pipe,
+  syscall_read,
+  syscall_readlink,
+  syscall_realloc,
+  syscall_rename,
+  syscall_select,
+  syscall_setitimer,
+  syscall_setpgid,
+  syscall_sighold,
+  syscall_sigprocmask,
+  syscall_sigsuspend,
+  syscall_sleep,
+  syscall_socket,
+  syscall_symlink,
+  syscall_tcdrain,
+  syscall_tcflush,
+  syscall_tcgetpgrp,
+  syscall_tcsetpgrp,
+  syscall_terminal_get_state,
+  syscall_terminal_set_state,
+  syscall_time,
+  syscall_times,
+  syscall_unlink,
+  syscall_utime,
+  syscall_vfork,
+  syscall_write
+};
+
+enum syserr_names
+{
+  syserr_unknown,
+  syserr_arg_list_too_long,
+  syserr_bad_address,
+  syserr_bad_file_descriptor,
+  syserr_broken_pipe,
+  syserr_directory_not_empty,
+  syserr_domain_error,
+  syserr_exec_format_error,
+  syserr_file_exists,
+  syserr_file_too_large,
+  syserr_filename_too_long,
+  syserr_function_not_implemented,
+  syserr_improper_link,
+  syserr_inappropriate_io_control_operation,
+  syserr_interrupted_function_call,
+  syserr_invalid_argument,
+  syserr_invalid_seek,
+  syserr_io_error,
+  syserr_is_a_directory,
+  syserr_no_child_processes,
+  syserr_no_locks_available,
+  syserr_no_space_left_on_device,
+  syserr_no_such_device,
+  syserr_no_such_device_or_address,
+  syserr_no_such_file_or_directory,
+  syserr_no_such_process,
+  syserr_not_a_directory,
+  syserr_not_enough_space,
+  syserr_operation_not_permitted,
+  syserr_permission_denied,
+  syserr_read_only_file_system,
+  syserr_resource_busy,
+  syserr_resource_deadlock_avoided,
+  syserr_resource_temporarily_unavailable,
+  syserr_result_too_large,
+  syserr_too_many_links,
+  syserr_too_many_open_files,
+  syserr_too_many_open_files_in_system
+};
+
+extern void EXFUN (error_system_call, (int code, enum syscall_names name));
+\f
+
+#include <limits.h>
+#include <time.h>
+#include <termio.h>
+
+#define HAVE_MKDIR
+#define HAVE_RMDIR
+#define HAVE_GETCWD
+
+/* #define HAVE_DUP2 */
+/* #define HAVE_FCNTL */
+#define VOID_SIGNAL_HANDLERS
+
+#include <sys/dir.h>
+\f
+typedef void Tsignal_handler_result;
+#define SIGNAL_HANDLER_RETURN() return
+
+typedef Tsignal_handler_result (*Tsignal_handler) ();
+
+#ifndef SIG_ERR
+#define SIG_ERR ((Tsignal_handler) (-1))
+#endif
+
+#if !defined(SIGCHLD) && defined(SIGCLD)
+#define SIGCHLD SIGCLD
+#endif
+#if !defined(SIGABRT) && defined(SIGIOT)
+#define SIGABRT SIGIOT
+#endif
+
+/* Crufty, but it will work here. */
+#ifndef ENOSYS
+#define ENOSYS 0
+#endif
+
+#ifdef UNION_WAIT_STATUS
+
+typedef union wait wait_status_t;
+
+#ifndef WEXITSTATUS
+#define WEXITSTATUS(_X) ((_X) . w_retcode)
+#endif
+
+#ifndef WTERMSIG
+#define WTERMSIG(_X) ((_X) . w_termsig)
+#endif
+
+#ifndef WSTOPSIG
+#define WSTOPSIG(_X) ((_X) . w_stopsig)
+#endif
+
+#else /* not UNION_WAIT_STATUS */
+
+typedef int wait_status_t;
+
+#ifndef WIFEXITED
+#define WIFEXITED(_X) (((_X) & 0377) == 0)
+#endif
+
+#ifndef WIFSTOPPED
+#define WIFSTOPPED(_X) (((_X) & 0377) == 0177)
+#endif
+
+#ifndef WIFSIGNALED
+#define WIFSIGNALED(_X) ((((_X) & 0377) != 0) && (((_X) & 0377) != 0177))
+#endif
+
+#ifndef WEXITSTATUS
+#define WEXITSTATUS(_X) (((_X) >> 8) & 0377)
+#endif
+
+#ifndef WTERMSIG
+#define WTERMSIG(_X) ((_X) & 0177)
+#endif
+
+#ifndef WSTOPSIG
+#define WSTOPSIG(_X) (((_X) >> 8) & 0377)
+#endif
+
+#endif /* UNION_WAIT_STATUS */
+\f
+/* Provide null defaults for all the signals we're likely to use so we
+   aren't continually testing to see if they're defined. */
+
+#ifndef SIGLOST
+#define SIGLOST 0
+#endif
+#ifndef SIGWINCH
+#define SIGWINCH 0
+#endif
+#ifndef SIGURG
+#define SIGURG 0
+#endif
+#ifndef SIGIO
+#define SIGIO 0
+#endif
+#ifndef SIGUSR1
+#define SIGUSR1 0
+#endif
+#ifndef SIGUSR2
+#define SIGUSR2 0
+#endif
+#ifndef SIGVTALRM
+#define SIGVTALRM 0
+#endif
+#ifndef SIGABRT
+#define SIGABRT 0
+#endif
+#ifndef SIGPWR
+#define SIGPWR 0
+#endif
+#ifndef SIGPROF
+#define SIGPROF 0
+#endif
+#ifndef SIGSTOP
+#define SIGSTOP 0
+#endif
+#ifndef SIGTSTP
+#define SIGTSTP 0
+#endif
+#ifndef SIGCONT
+#define SIGCONT 0
+#endif
+#ifndef SIGCHLD
+#define SIGCHLD 0
+#endif
+#ifndef SIGTTIN
+#define SIGTTIN 0
+#endif
+#ifndef SIGTTOU
+#define SIGTTOU 0
+#endif
+\f
+/* constants for access() */
+#ifndef R_OK
+#define R_OK 4
+#define W_OK 2
+#define X_OK 1
+#define F_OK 0
+#endif
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN 128
+#endif
+
+#ifdef __STDC__
+#define ALERT_CHAR '\a'
+#define ALERT_STRING "\a"
+#else
+#define ALERT_CHAR '\007'
+#define ALERT_STRING "\007"
+#endif
+
+#ifndef STDIN_FILENO
+#define STDIN_FILENO 0
+#define STDOUT_FILENO 1
+#define STDERR_FILENO 2
+#endif
+
+/* constants for open() and fcntl() */
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#define O_WRONLY 1
+#define O_RDWR 2
+#endif
+
+/* mode bit definitions for open(), creat(), and chmod() */
+#ifndef S_IRWXU
+#define S_IRWXU 0700
+#define S_IRWXG 0070
+#define S_IRWXO 0007
+#endif
+
+#ifndef S_IRUSR
+#define S_IRUSR 0400
+#define S_IWUSR 0200
+#define S_IXUSR 0100
+#define S_IRGRP 0040
+#define S_IWGRP 0020
+#define S_IXGRP 0010
+#define S_IROTH 0004
+#define S_IWOTH 0002
+#define S_IXOTH 0001
+#endif
+
+#define MODE_REG (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
+#define MODE_DIR (MODE_REG | S_IXUSR | S_IXGRP | S_IXOTH)
+
+/* constants for lseek() */
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+\f
+#ifndef DECL_GETLOGIN
+extern char * EXFUN (getlogin, (void));
+#endif
+
+#define DOS_abort abort
+#define DOS_access access
+#define DOS_alarm alarm
+#define DOS_chdir chdir
+#define DOS_chmod chmod
+#define DOS_close close
+#define DOS_ctime ctime
+#define DOS_dup dup
+#define DOS_free free
+#define DOS_fstat fstat
+#define DOS_getcwd getcwd
+#define DOS_getenv getenv
+#define DOS_getegid getegid
+#define DOS_geteuid geteuid
+#define DOS_getgrgid getgrgid
+#define DOS_gethostname gethostname
+#define DOS_getlogin getlogin
+#define DOS_getpid getpid
+#define DOS_getpwnam getpwnam
+#define DOS_getpwuid getpwuid
+#define DOS_ioctl ioctl
+#define DOS_link link
+#define DOS_localtime localtime
+#define DOS_lseek lseek
+#define DOS_malloc malloc
+#define DOS_mknod mknod
+#define DOS_pause pause
+#define DOS_pipe pipe
+#define DOS_read read
+#define DOS_realloc realloc
+#define DOS_signal signal
+#define DOS_sleep sleep
+#define DOS_stat stat
+#define DOS_system system
+#define DOS_time time
+#define DOS_unlink unlink
+#define DOS_write write
+#define DOS_wait wait
+
+extern PTR EXFUN (malloc, (unsigned int size));
+extern PTR EXFUN (realloc, (PTR ptr, unsigned int size));
+extern int EXFUN (gethostname, (char * name, unsigned int size));
+
+#ifdef HAVE_FCNTL
+#define DOS_fcntl fcntl
+#endif
+
+#ifdef HAVE_TRUNCATE
+#define DOS_ftruncate ftruncate
+#define DOS_truncate truncate
+#endif
+
+#ifdef HAVE_VFORK
+#define DOS_vfork vfork
+#else
+#define DOS_vfork fork
+#endif
+
+#ifdef HAVE_SYMBOLIC_LINKS
+#define DOS_lstat lstat
+#define DOS_readlink readlink
+#define DOS_symlink symlink
+#else
+#define DOS_lstat stat
+#endif
+\f
+extern void EXFUN (DOS_prim_check_errno, (enum syscall_names name));
+
+#define STD_VOID_SYSTEM_CALL(name, expression)                         \
+{                                                                      \
+  while ((expression) < 0)                                             \
+      error_system_call (errno, (name));                               \
+}
+
+#define STD_UINT_SYSTEM_CALL(name, result, expression)                 \
+{                                                                      \
+  while (((result) = (expression)) < 0)                                        \
+      error_system_call (errno, (name));                               \
+}
+
+#define STD_PTR_SYSTEM_CALL(name, result, expression)                  \
+{                                                                      \
+  while (((result) = (expression)) == 0)                               \
+      error_system_call (errno, (name));                               \
+}
+\f
+#ifdef HAVE_GETTIMEOFDAY
+#define DOS_gettimeofday gettimeofday
+#endif
+#ifdef HAVE_ITIMER
+#define DOS_setitimer setitimer
+#endif
+#ifdef HAVE_RMDIR
+#define DOS_rmdir rmdir
+#endif
+#ifdef HAVE_TIMES
+#define DOS_times times
+#endif
+
+#ifdef HAVE_DUMB_OPEN
+extern int EXFUN (DOS_open, (CONST char * name, int oflag, mode_t mode));
+#else
+#define DOS_open open
+#endif
+
+#ifdef HAVE_GETCWD
+#define DOS_getcwd getcwd
+#else
+#define EMULATE_GETCWD
+#define HAVE_GETCWD
+extern char * EXFUN (DOS_getcwd, (char * buffer, size_t length));
+#endif
+
+#ifdef HAVE_MKDIR
+#define DOS_mkdir mkdir
+#else
+#define EMULATE_MKDIR
+#define HAVE_MKDIR
+extern int EXFUN (DOS_mkdir, (CONST char * name, mode_t mode));
+#endif
+
+#ifdef HAVE_RENAME
+#define DOS_rename rename
+#else
+#define DOS_rename dos_rename_file
+
+#ifdef HAVE_WAITPID
+#define DOS_waitpid waitpid
+#else /* not HAVE_WAITPID */
+#ifdef HAVE_WAIT3
+#define EMULATE_WAITPID
+#define HAVE_WAITPID
+extern int EXFUN
+  (DOS_waitpid, (pid_t pid, wait_status_t * stat_loc, int options));
+#endif /* HAVE_WAIT3 */
+#endif /* HAVE_WAITPID */
+
+#ifndef WUNTRACED
+#define WUNTRACED 0
+#endif
+
+#ifdef HAVE_SELECT
+#define DOS_select select
+#endif /* HAVE_SELECT */
+
+#ifdef _NFILE
+#define DOS_SC_OPEN_MAX() _NFILE
+#else
+#define DOS_SC_OPEN_MAX() 16
+#endif
+
+/* Doesn't really go anywhere */
+#define INTERRUPT_CHAIN_NEXT   0
+#define INTERRUPT_RETURN       1
+
+extern void EXFUN (console_write_string, (void * string));
diff --git a/v7/src/microcode/prdosenv.c b/v7/src/microcode/prdosenv.c
new file mode 100644 (file)
index 0000000..d22501b
--- /dev/null
@@ -0,0 +1,131 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/prdosenv.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* Unix-specific process-environment primitives. */
+/* DOS imitation */
+
+#include "scheme.h"
+#include "prims.h"
+#include "msdos.h"
+\f
+DEFINE_PRIMITIVE ("CURRENT-FILE-TIME", Prim_current_file_time, 0, 0,
+  "Return the current file system time stamp.\n\
+This is an integer whose units are in seconds.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (long_to_integer (DOS_time (NULL)));
+}
+
+DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1, 1,
+  "Convert a file system time stamp into a date/time string.")
+{
+  PRIMITIVE_HEADER (1);
+  CHECK_ARG (1, INTEGER_P);
+  {
+    time_t clock = (arg_integer (1));
+    char * time_string = (DOS_ctime (&clock));
+    (time_string[24]) = '\0';
+    PRIMITIVE_RETURN (char_pointer_to_string ((unsigned char *) time_string));
+  }
+}
+
+DEFINE_PRIMITIVE ("GET-USER-HOME-DIRECTORY", Prim_get_user_home_directory, 1, 1,
+  "Return the file name of a given user's home directory.\n\
+The user name argument must be a string.\n\
+If no such user is known, #F is returned.")
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN (char_pointer_to_string ((unsigned char *) "c:\\"));
+}
+
+DEFINE_PRIMITIVE ("UID->STRING", Prim_uid_to_string, 1, 1,
+  "Return the user name corresponding to UID.\n\
+If the argument is not a known user ID, #F is returned.")
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN (SHARP_F);
+}
+
+DEFINE_PRIMITIVE ("GID->STRING", Prim_gid_to_string, 1, 1,
+  "Return the group name corresponding to GID.\n\
+If the argument is not a known group ID, #F is returned.")
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN (SHARP_F);
+}
+
+DEFINE_PRIMITIVE ("CURRENT-UID", Prim_current_uid, 0, 0,
+  "Return Scheme's effective UID.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (long_to_integer (0));
+}
+
+DEFINE_PRIMITIVE ("CURRENT-GID", Prim_current_gid, 0, 0,
+  "Return Scheme's effective GID.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (long_to_integer (0));
+}
+\f
+DEFINE_PRIMITIVE ("SYSTEM", Prim_system, 1, 1,
+  "Invoke sh (the Bourne shell) on the string argument.\n\
+Wait until the shell terminates, returning its exit status as an integer.")
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN (long_to_integer (-1));
+}
+
+DEFINE_PRIMITIVE ("UNIX-ENVIRONMENT", Prim_unix_environment_alist, 0, 0,
+  "Copy the unix environment and return it as a vector of strings.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (SHARP_F);
+}
+
+DEFINE_PRIMITIVE ("FULL-HOSTNAME", Prim_full_hostname, 0, 0,
+  "Returns the full hostname (including domain if available) as a string.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN
+    (char_pointer_to_string ((unsigned char *) "PC"));
+}
+
+DEFINE_PRIMITIVE ("HOSTNAME", Prim_hostname, 0, 0,
+  "Returns the hostname of the machine as a string.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN
+    (char_pointer_to_string ((unsigned char *) "IBMPC"));
+}
diff --git a/v7/src/microcode/prdosfs.c b/v7/src/microcode/prdosfs.c
new file mode 100644 (file)
index 0000000..83b9556
--- /dev/null
@@ -0,0 +1,396 @@
+/* -*-C-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/prdosfs.c,v 1.1 1992/05/05 06:55:13 jinx Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. */
+
+/* Unix-specific file-system primitives. */
+/* DOS Immitation */
+
+#include "scheme.h"
+#include "prims.h"
+#include "msdos.h"
+#include "osfs.h"
+
+extern int EXFUN
+  (DOS_read_file_status, (CONST char * filename, struct stat * s));
+
+static SCHEME_OBJECT EXFUN (file_attributes_internal, (struct stat * s));
+static void EXFUN (file_mode_string, (struct stat * s, char * a));
+static char EXFUN (file_type_letter, (struct stat * s));
+static void EXFUN (rwx, (unsigned short bits, char * chars));
+static SCHEME_OBJECT EXFUN (file_touch, (CONST char * filename));
+static void EXFUN (protect_fd, (int fd));
+
+#ifndef FILE_TOUCH_OPEN_TRIES
+#define FILE_TOUCH_OPEN_TRIES 5
+#endif
+\f
+DEFINE_PRIMITIVE ("FILE-MODES", Prim_file_modes, 1, 1,
+  "Return mode bits of FILE, as an integer.")
+{
+  struct stat stat_result;
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN
+    ((DOS_read_file_status ((STRING_ARG (1)), (&stat_result)))
+     ? (LONG_TO_UNSIGNED_FIXNUM ((stat_result . st_mode) & 07777))
+     : SHARP_F);
+}
+
+DEFINE_PRIMITIVE ("SET-FILE-MODES!", Prim_set_file_modes, 2, 2,
+  "Set the mode bits of FILE to MODE.")
+{
+  PRIMITIVE_HEADER (2);
+  if ((DOS_chmod ((STRING_ARG (1)), (arg_index_integer (2, 010000)))) < 0)
+    error_system_call (errno, syscall_chmod);
+  PRIMITIVE_RETURN (SHARP_F);
+}
+
+DEFINE_PRIMITIVE ("FILE-MOD-TIME", Prim_file_mod_time, 1, 1, 0)
+{
+  struct stat s;
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN
+    ((DOS_read_file_status ((STRING_ARG (1)), (&s)))
+     ? (long_to_integer (s . st_mtime))
+     : SHARP_F);
+}
+
+DEFINE_PRIMITIVE ("FILE-MOD-TIME-INDIRECT", Prim_file_mod_time_indirect, 1, 1, 0)
+{
+  struct stat s;
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN
+    ((DOS_read_file_status ((STRING_ARG (1)), (&s)))
+     ? (long_to_integer (s . st_mtime))
+     : SHARP_F);
+}
+\f
+/* Returns a vector of 10 items:
+
+   0 = #T iff the file is a directory,
+       string (name linked to) for symbolic link,
+       #F for all other files.
+   1 = number of links to the file
+   2 = user id, as an unsigned integer
+   3 = group id, as an unsigned integer
+   4 = last access time of the file
+   5 = last modification time of the file
+   6 = last change time of the file
+   7 = size of the file in bytes
+   8 = mode string for the file
+   9 = inode number of the file
+
+   The file_mode_string stuff was gobbled from GNU Emacs. */
+
+#define FILE_ATTRIBUTES_PRIMITIVE(stat_syscall)                                \
+{                                                                      \
+  struct stat s;                                                       \
+  PRIMITIVE_HEADER (1);                                                        \
+  PRIMITIVE_RETURN                                                     \
+    ((stat_syscall ((STRING_ARG (1)), (&s)))                           \
+     ? (file_attributes_internal (&s))                                 \
+     : SHARP_F);                                                       \
+}
+
+DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1, 1,
+  "Given a file name, return attribute information about the file.\n\
+If the file exists and its status information is accessible, the result\n\
+is a vector of 10 items (see the reference manual for details).  Otherwise\n\
+the result is #F.")
+     FILE_ATTRIBUTES_PRIMITIVE (DOS_read_file_status)
+
+DEFINE_PRIMITIVE ("FILE-ATTRIBUTES-INDIRECT", Prim_file_attributes_indirect, 1, 1,
+  "Like FILE-ATTRIBUTES but indirect through symbolic links.")
+     FILE_ATTRIBUTES_PRIMITIVE (DOS_read_file_status)
+
+static SCHEME_OBJECT
+DEFUN (file_attributes_internal, (s), struct stat * s)
+{
+  SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 10, true));
+  SCHEME_OBJECT modes = (allocate_string (10));
+  switch ((s -> st_mode) & S_IFMT)
+    {
+    case S_IFDIR:
+      VECTOR_SET (result, 0, SHARP_T);
+      break;
+#ifdef S_IFLNK
+    case S_IFLNK:
+      VECTOR_SET (result, 0,
+                 (char_pointer_to_string
+                  ((unsigned char *)
+                   (OS_file_soft_link_p
+                    ((CONST char *) (STRING_LOC ((ARG_REF (1)), 0)))))));
+      break;
+#endif
+    default:
+      VECTOR_SET (result, 0, SHARP_F);
+      break;
+    }
+  VECTOR_SET (result, 1, (long_to_integer (s -> st_nlink)));
+  VECTOR_SET (result, 2, (long_to_integer (s -> st_uid)));
+  VECTOR_SET (result, 3, (long_to_integer (s -> st_gid)));
+  VECTOR_SET (result, 4, (long_to_integer (s -> st_atime)));
+  VECTOR_SET (result, 5, (long_to_integer (s -> st_mtime)));
+  VECTOR_SET (result, 6, (long_to_integer (s -> st_ctime)));
+  VECTOR_SET (result, 7, (long_to_integer (s -> st_size)));
+  file_mode_string (s, ((char *) (STRING_LOC (modes, 0))));
+  VECTOR_SET (result, 8, modes);
+  VECTOR_SET (result, 9, (long_to_integer (s -> st_ino)));
+  return (result);
+}
+\f
+/* file_mode_string - set file attribute data
+
+   File_mode_string converts the data in the st_mode field of file
+   status block `s' to a 10 character attribute string, which it
+   stores in the block that `a' points to.
+
+   This attribute string is modelled after the string produced by the
+   Berkeley ls.
+
+   As usual under Unix, the elements of the string are numbered from
+   0.  Their meanings are:
+
+   0   File type.  'd' for directory, 'c' for character special, 'b'
+       for block special, 'm' for multiplex, 'l' for symbolic link,
+       's' for socket, 'p' for fifo, '-' for any other file type
+   1   'r' if the owner may read, '-' otherwise.
+   2   'w' if the owner may write, '-' otherwise.
+   3   'x' if the owner may execute, 's' if the file is set-user-id,
+       '-' otherwise.  'S' if the file is set-user-id, but the
+       execute bit isn't set.  (sys V `feature' which helps to catch
+       screw case.)
+   4   'r' if group members may read, '-' otherwise.
+   5   'w' if group members may write, '-' otherwise.
+   6   'x' if group members may execute, 's' if the file is
+       set-group-id, '-' otherwise.  'S' if it is set-group-id but
+       not executable.
+   7   'r' if any user may read, '-' otherwise.
+   8   'w' if any user may write, '-' otherwise.
+   9   'x' if any user may execute, 't' if the file is "sticky" (will
+       be retained in swap space after execution), '-' otherwise. */
+
+static void
+DEFUN (file_mode_string, (s, a), struct stat * s AND char * a)
+{
+  (a[0]) = (file_type_letter (s));
+  rwx ((((s -> st_mode) & 0700) << 0), (& (a [1])));
+  rwx ((((s -> st_mode) & 0070) << 3), (& (a [4])));
+  rwx ((((s -> st_mode) & 0007) << 6), (& (a [7])));
+#ifdef S_ISUID
+  if (((s -> st_mode) & S_ISUID) != 0)
+    (a[3]) = (((a[3]) == 'x') ? 's' : 'S');
+#endif
+#ifdef S_ISGID
+  if (((s -> st_mode) & S_ISGID) != 0)
+    (a[6]) = (((a [6]) == 'x') ? 's' : 'S');
+#endif
+#ifdef S_ISVTX
+  if (((s -> st_mode) & S_ISVTX) != 0)
+    (a[9]) = (((a [9]) == 'x') ? 't' : 'T');
+#endif
+}
+\f
+static char
+DEFUN (file_type_letter, (s), struct stat * s)
+{
+  switch ((s -> st_mode) & S_IFMT)
+    {
+    case S_IFDIR:
+      return ('d');
+    case S_IFCHR:
+      return ('c');
+    case S_IFBLK:
+      return ('b');
+#ifdef S_IFLNK
+    case S_IFLNK:
+      return ('l');
+#endif
+#ifdef S_IFMPC
+/* These do not seem to exist */
+    case S_IFMPC:
+    case S_IFMPB:
+      return ('m');
+#endif
+#ifdef S_IFSOCK
+    case S_IFSOCK:
+      return ('s');
+#endif
+#ifdef S_IFIFO
+    case S_IFIFO:
+      return ('p');
+#endif
+#ifdef S_IFNWK /* hp-ux hack */
+    case S_IFNWK:
+      return ('n');
+#endif
+    default:
+      return ('-');
+    }
+}
+
+static void
+DEFUN (rwx, (bits, chars), unsigned short bits AND char * chars)
+{
+  (chars[0]) = (((bits & S_IREAD) != 0)  ? 'r' : '-');
+  (chars[1]) = (((bits & S_IWRITE) != 0) ? 'w' : '-');
+  (chars[2]) = (((bits & S_IEXEC) != 0)  ? 'x' : '-');
+}
+\f
+DEFINE_PRIMITIVE ("FILE-TOUCH", Prim_file_touch, 1, 1,
+  "Given a file name, change the times of the file to the current time.\n\
+If the file does not exist, create it.\n\
+Both the access time and modification time are changed.\n\
+Return #F if the file existed and its time was modified.\n\
+Otherwise the file did not exist and it was created.")
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN (file_touch ((CONST char *) (STRING_ARG (1))));
+}
+
+static SCHEME_OBJECT
+DEFUN (file_touch, (filename), CONST char * filename)
+{
+  int fd;
+  transaction_begin ();
+  {
+    unsigned int count = 0;
+    while (1)
+      {
+       count += 1;
+       /* Use O_EXCL to prevent overwriting existing file. */
+       fd = (DOS_open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
+       if (fd >= 0)
+         {
+           protect_fd (fd);
+           transaction_commit ();
+           return (SHARP_T);
+         }
+       if (errno == EEXIST)
+         {
+           fd = (DOS_open (filename, O_RDWR, MODE_REG));
+           if (fd >= 0)
+             {
+               protect_fd (fd);
+               break;
+             }
+           else if ((errno == ENOENT) || (errno == ESTALE))
+             continue;
+         }
+       if (count >= FILE_TOUCH_OPEN_TRIES)
+         error_system_call (errno, syscall_open);
+      }
+  }
+  {
+    struct stat file_status;
+    STD_VOID_SYSTEM_CALL (syscall_fstat, (DOS_fstat (fd, (&file_status))));
+    if (((file_status . st_mode) & S_IFMT) != S_IFREG)
+      error_bad_range_arg (1);
+    /* CASE 3: file length of 0 needs special treatment. */
+    if ((file_status . st_size) == 0)
+      {
+       char buf [1];
+       (buf[0]) = '\0';
+       STD_VOID_SYSTEM_CALL (syscall_write, (DOS_write (fd, buf, 1)));
+#ifdef HAVE_TRUNCATE
+       STD_VOID_SYSTEM_CALL (syscall_ftruncate, (DOS_ftruncate (fd, 0)));
+       transaction_commit ();
+#else /* not HAVE_TRUNCATE */
+       transaction_commit ();
+       fd = (DOS_open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
+       if (fd >= 0)
+         STD_VOID_SYSTEM_CALL (syscall_close, (DOS_close (fd)));
+#endif /* HAVE_TRUNCATE */
+       return (SHARP_F);
+      }
+  }
+  /* CASE 4: read, then write back the first byte in the file. */
+  {
+    char buf [1];
+    int scr;
+    STD_UINT_SYSTEM_CALL (syscall_read, scr, (DOS_read (fd, buf, 1)));
+    if (scr > 0)
+      {
+       STD_VOID_SYSTEM_CALL (syscall_lseek, (DOS_lseek (fd, 0, SEEK_SET)));
+       STD_VOID_SYSTEM_CALL (syscall_write, (DOS_write (fd, buf, 1)));
+      }
+  }
+  transaction_commit ();
+  return (SHARP_F);
+}
+
+static void
+DEFUN (protect_fd_close, (ap), PTR ap)
+{
+  DOS_close (* ((int *) ap));
+}
+
+static void
+DEFUN (protect_fd, (fd), int fd)
+{
+  int * p = (dstack_alloc (sizeof (int)));
+  (*p) = fd;
+  transaction_record_action (tat_always, protect_fd_close, p);
+}
+\f
+DEFINE_PRIMITIVE ("SET-FILE-TIMES!", Prim_set_file_times, 3, 3,
+  "Change the access and modification times of FILE.\n\
+The second and third arguments are the respective times;\n\
+they are integers are the times in seconds since 00:00:00 GMT, Jan. 1, 1970\n\
+The file must exist and you must be the owner (or superuser).")
+{
+  PRIMITIVE_HEADER (3);
+  {
+    time_t times[2];
+    
+    times[0] = (time_t) arg_integer (2);
+    times[1] = (time_t) arg_integer (3);
+    STD_VOID_SYSTEM_CALL(syscall_utime, (utime ((STRING_ARG (1)), &times)));
+    PRIMITIVE_RETURN (SHARP_F);
+  }
+}
+
+DEFINE_PRIMITIVE ("FILE-EQ?", Prim_file_eq_p, 2, 2,
+  "True iff the two file arguments are the same file.")
+{
+  PRIMITIVE_HEADER (2);
+  {
+    struct stat s1;
+    struct stat s2;
+    PRIMITIVE_RETURN
+      (BOOLEAN_TO_OBJECT
+       ((DOS_read_file_status ((STRING_ARG (1)), (&s1)))
+       && (DOS_read_file_status ((STRING_ARG (2)), (&s2)))
+       && ((s1 . st_dev) == (s2 . st_dev))
+       && ((s1 . st_ino) == (s2 . st_ino))));
+  }
+}