Add new OS-dependent mechanism for building the system-call names
authorChris Hanson <org/chris-hanson/cph>
Tue, 4 Oct 1994 21:09:15 +0000 (21:09 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 4 Oct 1994 21:09:15 +0000 (21:09 +0000)
tables that the runtime system uses for detecting and reporting
system-call errors.  This change is upwards compatible with previous
versions of the microcode and also with previous versions of the
runtime system.

v7/src/microcode/boot.c
v7/src/microcode/dostop.c
v7/src/microcode/intern.c
v7/src/microcode/nttop.c
v7/src/microcode/utabmd.scm
v7/src/microcode/uxtop.c
v8/src/microcode/utabmd.scm

index 78a22159c963ef12e83d88fbf0f64638bd253e10..23ec4640da63bdc9146288a0de40cb2d19ac063f 100644 (file)
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: boot.c,v 9.87 1993/11/08 20:38:25 cph Exp $
+$Id: boot.c,v 9.88 1994/10/04 21:07:50 cph Exp $
 
-Copyright (c) 1988-1993 Massachusetts Institute of Technology
+Copyright (c) 1988-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -188,6 +188,40 @@ DEFUN (main_name, (argc, argv),
   termination_init_error ();
 }
 \f
+static SCHEME_OBJECT
+DEFUN (names_to_vector, (length, names),
+       unsigned int length AND
+       unsigned char ** names)
+{
+  SCHEME_OBJECT v = (allocate_marked_vector (TC_VECTOR, length, 1));
+  unsigned int i;
+  for (i = 0; (i < length); i += 1)
+    {
+      VECTOR_SET (v, i, (char_pointer_to_symbol (names [i])));
+    }
+  return (v);
+}
+
+static SCHEME_OBJECT
+DEFUN_VOID (fixed_objects_syscall_names)
+{
+  unsigned int length;
+  unsigned char ** names;
+  extern void EXFUN (OS_syscall_names, (unsigned int *, unsigned char ***));
+  OS_syscall_names ((&length), (&names));
+  return (names_to_vector (length, names));
+}
+
+static SCHEME_OBJECT
+DEFUN_VOID (fixed_objects_syserr_names)
+{
+  unsigned int length;
+  unsigned char ** names;
+  extern void EXFUN (OS_syserr_names, (unsigned int *, unsigned char ***));
+  OS_syserr_names ((&length), (&names));
+  return (names_to_vector (length, names));
+}
+
 SCHEME_OBJECT
 DEFUN_VOID (make_fixed_objects_vector)
 {
@@ -222,6 +256,14 @@ DEFUN_VOID (make_fixed_objects_vector)
   FAST_VECTOR_SET (fixed_objects_vector, Bignum_One, (long_to_bignum (1)));
   FAST_VECTOR_SET (fixed_objects_vector, FIXOBJ_EDWIN_AUTO_SAVE, EMPTY_LIST);
   FAST_VECTOR_SET (fixed_objects_vector, FIXOBJ_FILES_TO_DELETE, EMPTY_LIST);
+  FAST_VECTOR_SET
+    (fixed_objects_vector,
+     FIXOBJ_SYSTEM_CALL_NAMES,
+     (fixed_objects_syscall_names ()));
+  FAST_VECTOR_SET
+    (fixed_objects_vector,
+     FIXOBJ_SYSTEM_CALL_ERRORS,
+     (fixed_objects_syserr_names ()));
 
   (*Free++) = EMPTY_LIST;
   (*Free++) = EMPTY_LIST;
@@ -575,6 +617,18 @@ DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_microcode_identify, 0, 0, 0)
                    ((unsigned char *) STACK_TYPE_STRING)));
   PRIMITIVE_RETURN (Result);
 }
+
+DEFINE_PRIMITIVE ("MICROCODE-SYSTEM-CALL-NAMES", Prim_microcode_syscall_names, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (fixed_objects_syscall_names ());
+}
+
+DEFINE_PRIMITIVE ("MICROCODE-SYSTEM-ERROR-NAMES", Prim_microcode_syserr_names, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (fixed_objects_syserr_names ());
+}
 \f
 DEFINE_PRIMITIVE ("MICROCODE-TABLES-FILENAME", Prim_microcode_tables_filename, 0, 0, 0)
 {
index 9e2dc24bb5a5885c1e253ba9a3d60465c3aa2ad5..c9bab3ae5f3b251accf706094cdaec6a97c62a4a 100644 (file)
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: dostop.c,v 1.7 1993/08/03 08:29:43 gjr Exp $
+$Id: dostop.c,v 1.8 1994/10/04 21:08:20 cph Exp $
 
-Copyright (c) 1992-1993 Massachusetts Institute of Technology
+Copyright (c) 1992-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -210,3 +210,120 @@ void bcopy (const char *s1, char *s2, int n)
     *s2++ = *s1++;
   return;
 }
+\f
+static unsigned char * syscall_names_table [] =
+{
+  "ACCEPT",
+  "BIND",
+  "CHDIR",
+  "CHMOD",
+  "CLOSE",
+  "CONNECT",
+  "FCNTL-GETFL",
+  "FCNTL-SETFL",
+  "FORK",
+  "FSTAT",
+  "FTRUNCATE",
+  "GETCWD",
+  "GETHOSTNAME",
+  "GETTIMEOFDAY",
+  "IOCTL-TIOCGPGRP",
+  "IOCTL-TIOCSIGSEND",
+  "KILL",
+  "LINK",
+  "LISTEN",
+  "LOCALTIME",
+  "LSEEK",
+  "MALLOC",
+  "MKDIR",
+  "OPEN",
+  "OPENDIR",
+  "PAUSE",
+  "PIPE",
+  "READ",
+  "READLINK",
+  "REALLOC",
+  "RENAME",
+  "RMDIR",
+  "SELECT",
+  "SETITIMER",
+  "SETPGID",
+  "SIGHOLD",
+  "SIGPROCMASK",
+  "SIGSUSPEND",
+  "SLEEP",
+  "SOCKET",
+  "SYMLINK",
+  "TCDRAIN",
+  "TCFLUSH",
+  "TCGETPGRP",
+  "TCSETPGRP",
+  "TERMINAL-GET-STATE",
+  "TERMINAL-SET-STATE",
+  "TIME",
+  "TIMES",
+  "UNLINK",
+  "UTIME",
+  "VFORK",
+  "WRITE",
+  "STAT",
+  "LSTAT",
+  "MKTIME",
+  "DYNAMIC-LOAD"
+};
+
+void
+OS_syscall_names (unsigned int * length, unsigned char *** names)
+{
+  (*length) = ((sizeof (syscall_names_table)) / (sizeof (unsigned char *)));
+  (*names) = syscall_names_table;
+}
+\f
+static unsigned char * syserr_names_table [] =
+{
+  "UNKNOWN",
+  "ARG-LIST-TOO-LONG",
+  "BAD-ADDRESS",
+  "BAD-FILE-DESCRIPTOR",
+  "BROKEN-PIPE",
+  "DIRECTORY-NOT-EMPTY",
+  "DOMAIN-ERROR",
+  "EXEC-FORMAT-ERROR",
+  "FILE-EXISTS",
+  "FILE-TOO-LARGE",
+  "FILENAME-TOO-LONG",
+  "FUNCTION-NOT-IMPLEMENTED",
+  "IMPROPER-LINK",
+  "INAPPROPRIATE-IO-CONTROL-OPERATION",
+  "INTERRUPTED-FUNCTION-CALL",
+  "INVALID-ARGUMENT",
+  "INVALID-SEEK",
+  "IO-ERROR",
+  "IS-A-DIRECTORY",
+  "NO-CHILD-PROCESSES",
+  "NO-LOCKS-AVAILABLE",
+  "NO-SPACE-LEFT-ON-DEVICE",
+  "NO-SUCH-DEVICE",
+  "NO-SUCH-DEVICE-OR-ADDRESS",
+  "NO-SUCH-FILE-OR-DIRECTORY",
+  "NO-SUCH-PROCESS",
+  "NOT-A-DIRECTORY",
+  "NOT-ENOUGH-SPACE",
+  "OPERATION-NOT-PERMITTED",
+  "PERMISSION-DENIED",
+  "READ-ONLY-FILE-SYSTEM",
+  "RESOURCE-BUSY",
+  "RESOURCE-DEADLOCK-AVOIDED",
+  "RESOURCE-TEMPORARILY-UNAVAILABLE",
+  "RESULT-TOO-LARGE",
+  "TOO-MANY-LINKS",
+  "TOO-MANY-OPEN-FILES",
+  "TOO-MANY-OPEN-FILES"
+};
+
+void
+OS_syserr_names (unsigned int * length, unsigned char *** names)
+{
+  (*length) = ((sizeof (syserr_names_table)) / (sizeof (unsigned char *)));
+  (*names) = syserr_names_table;
+}
index 981590ec3cbb4174ce918ba6471ace30b194b261..cd44f3d2f5a695e8f82b07b82390314cc616e194 100644 (file)
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: intern.c,v 9.53 1992/11/24 23:14:23 gjr Exp $
+$Id: intern.c,v 9.54 1994/10/04 21:09:15 cph Exp $
 
-Copyright (c) 1987-1992 Massachusetts Institute of Technology
+Copyright (c) 1987-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -41,6 +41,8 @@ MIT in each case. */
 /* These are exported to other parts of the system. */
 
 extern SCHEME_OBJECT EXFUN (string_to_symbol, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (char_pointer_to_symbol, (unsigned char *));
+extern SCHEME_OBJECT EXFUN (memory_to_symbol, (long, unsigned char *));
 extern SCHEME_OBJECT EXFUN (find_symbol, (long, unsigned char *));
 \f
 /* Hashing strings */
@@ -131,22 +133,18 @@ DEFUN (link_new_symbol, (symbol, cell),
 SCHEME_OBJECT
 DEFUN (find_symbol, (length, string), long length AND unsigned char * string)
 {
-  fast SCHEME_OBJECT result = (* (find_symbol_internal (length, string)));
+  SCHEME_OBJECT result = (* (find_symbol_internal (length, string)));
   return ((result == EMPTY_LIST) ? SHARP_F : result);
 }
 
-SCHEME_OBJECT
-DEFUN (string_to_symbol, (string), SCHEME_OBJECT string)
+static SCHEME_OBJECT
+DEFUN (make_symbol, (string, cell),
+       SCHEME_OBJECT string AND
+       SCHEME_OBJECT * cell)
 {
-  fast SCHEME_OBJECT * cell =
-    (find_symbol_internal ((STRING_LENGTH (string)),
-                          (STRING_LOC (string, 0))));
-  if ((*cell) != EMPTY_LIST)
-    return (*cell);
   Primitive_GC_If_Needed (2);
   {
-    fast SCHEME_OBJECT symbol =
-      (MAKE_POINTER_OBJECT (TC_UNINTERNED_SYMBOL, Free));
+    SCHEME_OBJECT symbol = (MAKE_POINTER_OBJECT (TC_UNINTERNED_SYMBOL, Free));
     (Free [SYMBOL_NAME]) = string;
     (Free [SYMBOL_GLOBAL_VALUE]) = UNBOUND_OBJECT;
     Free += 2;
@@ -154,16 +152,42 @@ DEFUN (string_to_symbol, (string), SCHEME_OBJECT string)
   }
 }
 
+SCHEME_OBJECT
+DEFUN (memory_to_symbol, (length, string),
+       long length AND
+       unsigned char * string)
+{
+  SCHEME_OBJECT * cell = (find_symbol_internal (length, string));
+  return
+    (((*cell) == EMPTY_LIST)
+     ? (make_symbol ((memory_to_string (length, string)), cell))
+     : (*cell));
+}
+
+SCHEME_OBJECT
+DEFUN (char_pointer_to_symbol, (string), unsigned char * string)
+{
+  return (memory_to_symbol ((strlen (string)), string));
+}
+
+SCHEME_OBJECT
+DEFUN (string_to_symbol, (string), SCHEME_OBJECT string)
+{
+  SCHEME_OBJECT * cell =
+    (find_symbol_internal ((STRING_LENGTH (string)),
+                          (STRING_LOC (string, 0))));
+  return (((*cell) == EMPTY_LIST) ? (make_symbol (string, cell)) : (*cell));
+}
+
 SCHEME_OBJECT
 DEFUN (intern_symbol, (symbol), SCHEME_OBJECT symbol)
 {
-  fast SCHEME_OBJECT name = (FAST_MEMORY_REF (symbol, SYMBOL_NAME));
-  fast SCHEME_OBJECT * cell =
+  SCHEME_OBJECT name = (FAST_MEMORY_REF (symbol, SYMBOL_NAME));
+  SCHEME_OBJECT * cell =
     (find_symbol_internal ((STRING_LENGTH (name)), (STRING_LOC (name, 0))));
-  return
-    (((*cell) != EMPTY_LIST)
-     ? (*cell)
-     : (link_new_symbol (symbol, cell)));
+  return (((*cell) == EMPTY_LIST)
+         ? (link_new_symbol (symbol, cell))
+         : (*cell));
 }
 \f
 DEFINE_PRIMITIVE ("FIND-SYMBOL", Prim_find_symbol, 1, 1,
@@ -175,7 +199,8 @@ Returns the symbol whose name is STRING, or #F if no such symbol exists.")
 
   CHECK_ARG (1, STRING_P);
   string = (ARG_REF (1));
-  PRIMITIVE_RETURN (find_symbol ((STRING_LENGTH (string)), (STRING_LOC (string, 0))));
+  PRIMITIVE_RETURN
+    (find_symbol ((STRING_LENGTH (string)), (STRING_LOC (string, 0))));
 }
 
 DEFINE_PRIMITIVE ("STRING->SYMBOL", Prim_string_to_symbol, 1, 1,
index c2f198056643b8e0066d8dde47fef87c9029a879..0fd18550e892983b24446ab24e515a39a072c06c 100644 (file)
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: nttop.c,v 1.10 1993/09/04 07:08:54 gjr Exp $
+$Id: nttop.c,v 1.11 1994/10/04 21:08:14 cph Exp $
 
-Copyright (c) 1993 Massachusetts Institute of Technology
+Copyright (c) 1993-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -214,3 +214,120 @@ bcopy (const char * s1, char * s2, int n)
     *s2++ = *s1++;
   return;
 }
+\f
+static unsigned char * syscall_names_table [] =
+{
+  "ACCEPT",
+  "BIND",
+  "CHDIR",
+  "CHMOD",
+  "CLOSE",
+  "CONNECT",
+  "FCNTL-GETFL",
+  "FCNTL-SETFL",
+  "FORK",
+  "FSTAT",
+  "FTRUNCATE",
+  "GETCWD",
+  "GETHOSTNAME",
+  "GETTIMEOFDAY",
+  "IOCTL-TIOCGPGRP",
+  "IOCTL-TIOCSIGSEND",
+  "KILL",
+  "LINK",
+  "LISTEN",
+  "LOCALTIME",
+  "LSEEK",
+  "MALLOC",
+  "MKDIR",
+  "OPEN",
+  "OPENDIR",
+  "PAUSE",
+  "PIPE",
+  "READ",
+  "READLINK",
+  "REALLOC",
+  "RENAME",
+  "RMDIR",
+  "SELECT",
+  "SETITIMER",
+  "SETPGID",
+  "SIGHOLD",
+  "SIGPROCMASK",
+  "SIGSUSPEND",
+  "SLEEP",
+  "SOCKET",
+  "SYMLINK",
+  "TCDRAIN",
+  "TCFLUSH",
+  "TCGETPGRP",
+  "TCSETPGRP",
+  "TERMINAL-GET-STATE",
+  "TERMINAL-SET-STATE",
+  "TIME",
+  "TIMES",
+  "UNLINK",
+  "UTIME",
+  "VFORK",
+  "WRITE",
+  "STAT",
+  "LSTAT",
+  "MKTIME",
+  "DYNAMIC-LOAD"
+};
+
+void
+OS_syscall_names (unsigned int * length, unsigned char *** names)
+{
+  (*length) = ((sizeof (syscall_names_table)) / (sizeof (unsigned char *)));
+  (*names) = syscall_names_table;
+}
+\f
+static unsigned char * syserr_names_table [] =
+{
+  "UNKNOWN",
+  "ARG-LIST-TOO-LONG",
+  "BAD-ADDRESS",
+  "BAD-FILE-DESCRIPTOR",
+  "BROKEN-PIPE",
+  "DIRECTORY-NOT-EMPTY",
+  "DOMAIN-ERROR",
+  "EXEC-FORMAT-ERROR",
+  "FILE-EXISTS",
+  "FILE-TOO-LARGE",
+  "FILENAME-TOO-LONG",
+  "FUNCTION-NOT-IMPLEMENTED",
+  "IMPROPER-LINK",
+  "INAPPROPRIATE-IO-CONTROL-OPERATION",
+  "INTERRUPTED-FUNCTION-CALL",
+  "INVALID-ARGUMENT",
+  "INVALID-SEEK",
+  "IO-ERROR",
+  "IS-A-DIRECTORY",
+  "NO-CHILD-PROCESSES",
+  "NO-LOCKS-AVAILABLE",
+  "NO-SPACE-LEFT-ON-DEVICE",
+  "NO-SUCH-DEVICE",
+  "NO-SUCH-DEVICE-OR-ADDRESS",
+  "NO-SUCH-FILE-OR-DIRECTORY",
+  "NO-SUCH-PROCESS",
+  "NOT-A-DIRECTORY",
+  "NOT-ENOUGH-SPACE",
+  "OPERATION-NOT-PERMITTED",
+  "PERMISSION-DENIED",
+  "READ-ONLY-FILE-SYSTEM",
+  "RESOURCE-BUSY",
+  "RESOURCE-DEADLOCK-AVOIDED",
+  "RESOURCE-TEMPORARILY-UNAVAILABLE",
+  "RESULT-TOO-LARGE",
+  "TOO-MANY-LINKS",
+  "TOO-MANY-OPEN-FILES",
+  "TOO-MANY-OPEN-FILES"
+};
+
+void
+OS_syserr_names (unsigned int * length, unsigned char *** names)
+{
+  (*length) = ((sizeof (syserr_names_table)) / (sizeof (unsigned char *)));
+  (*names) = syserr_names_table;
+}
index cdc7bc878d03b8c00eae1c17e5552dff51ab4ead..e853e55fe97e63da4b5517068b57c131bfcb39e6 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: utabmd.scm,v 9.74 1994/03/28 02:15:56 ziggy Exp $
+;;; $Id: utabmd.scm,v 9.75 1994/10/04 21:08:02 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987-1994 Massachusetts Institute of Technology
 ;;;
 \f
 ;;; [] System-call names
 
+(define-macro (ucode-primitive name)
+  (make-primitive-procedure name))
+
 (vector-set! (get-fixed-objects-vector)
             #x09 ;(fixed-objects-vector-slot 'SYSTEM-CALL-NAMES)
-            #(ACCEPT
-              BIND
-              CHDIR
-              CHMOD
-              CLOSE
-              CONNECT
-              FCNTL-GETFL
-              FCNTL-SETFL
-              FORK
-              FSTAT
-              FTRUNCATE
-              GETCWD
-              GETHOSTNAME
-              GETTIMEOFDAY
-              IOCTL-TIOCGPGRP
-              IOCTL-TIOCSIGSEND
-              KILL
-              LINK
-              LISTEN
-              LOCALTIME
-              LSEEK
-              MALLOC
-              MKDIR
-              OPEN
-              OPENDIR
-              PAUSE
-              PIPE
-              READ
-              READLINK
-              REALLOC
-              RENAME
-              RMDIR
-              SELECT
-              SETITIMER
-              SETPGID
-              SIGHOLD
-              SIGPROCMASK
-              SIGSUSPEND
-              SLEEP
-              SOCKET
-              SYMLINK
-              TCDRAIN
-              TCFLUSH
-              TCGETPGRP
-              TCSETPGRP
-              TERMINAL-GET-STATE
-              TERMINAL-SET-STATE
-              TIME
-              TIMES
-              UNLINK
-              UTIME
-              VFORK
-              WRITE
-              STAT
-              LSTAT
-              MKTIME
-              DYNAMIC-LOAD
-              ))
+            (let ((prim (ucode-primitive microcode-system-call-names 0)))
+              (if (implemented-primitive-procedure? prim)
+                  (prim)
+                  ;; For compatibility with older microcodes:
+                  '#(ACCEPT
+                     BIND
+                     CHDIR
+                     CHMOD
+                     CLOSE
+                     CONNECT
+                     FCNTL-GETFL
+                     FCNTL-SETFL
+                     FORK
+                     FSTAT
+                     FTRUNCATE
+                     GETCWD
+                     GETHOSTNAME
+                     GETTIMEOFDAY
+                     IOCTL-TIOCGPGRP
+                     IOCTL-TIOCSIGSEND
+                     KILL
+                     LINK
+                     LISTEN
+                     LOCALTIME
+                     LSEEK
+                     MALLOC
+                     MKDIR
+                     OPEN
+                     OPENDIR
+                     PAUSE
+                     PIPE
+                     READ
+                     READLINK
+                     REALLOC
+                     RENAME
+                     RMDIR
+                     SELECT
+                     SETITIMER
+                     SETPGID
+                     SIGHOLD
+                     SIGPROCMASK
+                     SIGSUSPEND
+                     SLEEP
+                     SOCKET
+                     SYMLINK
+                     TCDRAIN
+                     TCFLUSH
+                     TCGETPGRP
+                     TCSETPGRP
+                     TERMINAL-GET-STATE
+                     TERMINAL-SET-STATE
+                     TIME
+                     TIMES
+                     UNLINK
+                     UTIME
+                     VFORK
+                     WRITE
+                     STAT
+                     LSTAT
+                     MKTIME
+                     DYNAMIC-LOAD))))
 \f
 ;;; [] System-call errors
 
 (vector-set! (get-fixed-objects-vector)
             #x0A ;(fixed-objects-vector-slot 'SYSTEM-CALL-ERRORS)
-            #(UNKNOWN
-              ARG-LIST-TOO-LONG
-              BAD-ADDRESS
-              BAD-FILE-DESCRIPTOR
-              BROKEN-PIPE
-              DIRECTORY-NOT-EMPTY
-              DOMAIN-ERROR
-              EXEC-FORMAT-ERROR
-              FILE-EXISTS
-              FILE-TOO-LARGE
-              FILENAME-TOO-LONG
-              FUNCTION-NOT-IMPLEMENTED
-              IMPROPER-LINK
-              INAPPROPRIATE-IO-CONTROL-OPERATION
-              INTERRUPTED-FUNCTION-CALL
-              INVALID-ARGUMENT
-              INVALID-SEEK
-              IO-ERROR
-              IS-A-DIRECTORY
-              NO-CHILD-PROCESSES
-              NO-LOCKS-AVAILABLE
-              NO-SPACE-LEFT-ON-DEVICE
-              NO-SUCH-DEVICE
-              NO-SUCH-DEVICE-OR-ADDRESS
-              NO-SUCH-FILE-OR-DIRECTORY
-              NO-SUCH-PROCESS
-              NOT-A-DIRECTORY
-              NOT-ENOUGH-SPACE
-              OPERATION-NOT-PERMITTED
-              PERMISSION-DENIED
-              READ-ONLY-FILE-SYSTEM
-              RESOURCE-BUSY
-              RESOURCE-DEADLOCK-AVOIDED
-              RESOURCE-TEMPORARILY-UNAVAILABLE
-              RESULT-TOO-LARGE
-              TOO-MANY-LINKS
-              TOO-MANY-OPEN-FILES
-              TOO-MANY-OPEN-FILES
-              ))
+            (let ((prim (ucode-primitive microcode-system-error-names 0)))
+              (if (implemented-primitive-procedure? prim)
+                  (prim)
+                  ;; For compatibility with older microcodes:
+                  '#(UNKNOWN
+                     ARG-LIST-TOO-LONG
+                     BAD-ADDRESS
+                     BAD-FILE-DESCRIPTOR
+                     BROKEN-PIPE
+                     DIRECTORY-NOT-EMPTY
+                     DOMAIN-ERROR
+                     EXEC-FORMAT-ERROR
+                     FILE-EXISTS
+                     FILE-TOO-LARGE
+                     FILENAME-TOO-LONG
+                     FUNCTION-NOT-IMPLEMENTED
+                     IMPROPER-LINK
+                     INAPPROPRIATE-IO-CONTROL-OPERATION
+                     INTERRUPTED-FUNCTION-CALL
+                     INVALID-ARGUMENT
+                     INVALID-SEEK
+                     IO-ERROR
+                     IS-A-DIRECTORY
+                     NO-CHILD-PROCESSES
+                     NO-LOCKS-AVAILABLE
+                     NO-SPACE-LEFT-ON-DEVICE
+                     NO-SUCH-DEVICE
+                     NO-SUCH-DEVICE-OR-ADDRESS
+                     NO-SUCH-FILE-OR-DIRECTORY
+                     NO-SUCH-PROCESS
+                     NOT-A-DIRECTORY
+                     NOT-ENOUGH-SPACE
+                     OPERATION-NOT-PERMITTED
+                     PERMISSION-DENIED
+                     READ-ONLY-FILE-SYSTEM
+                     RESOURCE-BUSY
+                     RESOURCE-DEADLOCK-AVOIDED
+                     RESOURCE-TEMPORARILY-UNAVAILABLE
+                     RESULT-TOO-LARGE
+                     TOO-MANY-LINKS
+                     TOO-MANY-OPEN-FILES
+                     TOO-MANY-OPEN-FILES))))
 \f
 ;;; [] Identification
 
 
 ;;; This identification string is saved by the system.
 
-"$Id: utabmd.scm,v 9.74 1994/03/28 02:15:56 ziggy Exp $"
+"$Id: utabmd.scm,v 9.75 1994/10/04 21:08:02 cph Exp $"
index 9570e8136625805890d66216d04620dbb009565b..89c151ecac5edc13cc09ecb6e09b26d0a617fc8d 100644 (file)
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: uxtop.c,v 1.12 1993/11/09 19:06:14 gjr Exp $
+$Id: uxtop.c,v 1.13 1994/10/04 21:07:22 cph Exp $
 
-Copyright (c) 1990-1993 Massachusetts Institute of Technology
+Copyright (c) 1990-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -303,3 +303,120 @@ DEFUN (OS_error_code_to_message, (syserr), unsigned int syserr)
   int code = (syserr_to_error_code ((enum syserr_names) syserr));
   return (((code > 0) && (code <= sys_nerr)) ? (sys_errlist [code]) : 0);
 }
+\f
+static unsigned char * syscall_names_table [] =
+{
+  "ACCEPT",
+  "BIND",
+  "CHDIR",
+  "CHMOD",
+  "CLOSE",
+  "CONNECT",
+  "FCNTL-GETFL",
+  "FCNTL-SETFL",
+  "FORK",
+  "FSTAT",
+  "FTRUNCATE",
+  "GETCWD",
+  "GETHOSTNAME",
+  "GETTIMEOFDAY",
+  "IOCTL-TIOCGPGRP",
+  "IOCTL-TIOCSIGSEND",
+  "KILL",
+  "LINK",
+  "LISTEN",
+  "LOCALTIME",
+  "LSEEK",
+  "MALLOC",
+  "MKDIR",
+  "OPEN",
+  "OPENDIR",
+  "PAUSE",
+  "PIPE",
+  "READ",
+  "READLINK",
+  "REALLOC",
+  "RENAME",
+  "RMDIR",
+  "SELECT",
+  "SETITIMER",
+  "SETPGID",
+  "SIGHOLD",
+  "SIGPROCMASK",
+  "SIGSUSPEND",
+  "SLEEP",
+  "SOCKET",
+  "SYMLINK",
+  "TCDRAIN",
+  "TCFLUSH",
+  "TCGETPGRP",
+  "TCSETPGRP",
+  "TERMINAL-GET-STATE",
+  "TERMINAL-SET-STATE",
+  "TIME",
+  "TIMES",
+  "UNLINK",
+  "UTIME",
+  "VFORK",
+  "WRITE",
+  "STAT",
+  "LSTAT",
+  "MKTIME",
+  "DYNAMIC-LOAD"
+};
+
+void
+OS_syscall_names (unsigned int * length, unsigned char *** names)
+{
+  (*length) = ((sizeof (syscall_names_table)) / (sizeof (unsigned char *)));
+  (*names) = syscall_names_table;
+}
+\f
+static unsigned char * syserr_names_table [] =
+{
+  "UNKNOWN",
+  "ARG-LIST-TOO-LONG",
+  "BAD-ADDRESS",
+  "BAD-FILE-DESCRIPTOR",
+  "BROKEN-PIPE",
+  "DIRECTORY-NOT-EMPTY",
+  "DOMAIN-ERROR",
+  "EXEC-FORMAT-ERROR",
+  "FILE-EXISTS",
+  "FILE-TOO-LARGE",
+  "FILENAME-TOO-LONG",
+  "FUNCTION-NOT-IMPLEMENTED",
+  "IMPROPER-LINK",
+  "INAPPROPRIATE-IO-CONTROL-OPERATION",
+  "INTERRUPTED-FUNCTION-CALL",
+  "INVALID-ARGUMENT",
+  "INVALID-SEEK",
+  "IO-ERROR",
+  "IS-A-DIRECTORY",
+  "NO-CHILD-PROCESSES",
+  "NO-LOCKS-AVAILABLE",
+  "NO-SPACE-LEFT-ON-DEVICE",
+  "NO-SUCH-DEVICE",
+  "NO-SUCH-DEVICE-OR-ADDRESS",
+  "NO-SUCH-FILE-OR-DIRECTORY",
+  "NO-SUCH-PROCESS",
+  "NOT-A-DIRECTORY",
+  "NOT-ENOUGH-SPACE",
+  "OPERATION-NOT-PERMITTED",
+  "PERMISSION-DENIED",
+  "READ-ONLY-FILE-SYSTEM",
+  "RESOURCE-BUSY",
+  "RESOURCE-DEADLOCK-AVOIDED",
+  "RESOURCE-TEMPORARILY-UNAVAILABLE",
+  "RESULT-TOO-LARGE",
+  "TOO-MANY-LINKS",
+  "TOO-MANY-OPEN-FILES",
+  "TOO-MANY-OPEN-FILES"
+};
+
+void
+OS_syserr_names (unsigned int * length, unsigned char *** names)
+{
+  (*length) = ((sizeof (syserr_names_table)) / (sizeof (unsigned char *)));
+  (*names) = syserr_names_table;
+}
index cdc7bc878d03b8c00eae1c17e5552dff51ab4ead..e853e55fe97e63da4b5517068b57c131bfcb39e6 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: utabmd.scm,v 9.74 1994/03/28 02:15:56 ziggy Exp $
+;;; $Id: utabmd.scm,v 9.75 1994/10/04 21:08:02 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987-1994 Massachusetts Institute of Technology
 ;;;
 \f
 ;;; [] System-call names
 
+(define-macro (ucode-primitive name)
+  (make-primitive-procedure name))
+
 (vector-set! (get-fixed-objects-vector)
             #x09 ;(fixed-objects-vector-slot 'SYSTEM-CALL-NAMES)
-            #(ACCEPT
-              BIND
-              CHDIR
-              CHMOD
-              CLOSE
-              CONNECT
-              FCNTL-GETFL
-              FCNTL-SETFL
-              FORK
-              FSTAT
-              FTRUNCATE
-              GETCWD
-              GETHOSTNAME
-              GETTIMEOFDAY
-              IOCTL-TIOCGPGRP
-              IOCTL-TIOCSIGSEND
-              KILL
-              LINK
-              LISTEN
-              LOCALTIME
-              LSEEK
-              MALLOC
-              MKDIR
-              OPEN
-              OPENDIR
-              PAUSE
-              PIPE
-              READ
-              READLINK
-              REALLOC
-              RENAME
-              RMDIR
-              SELECT
-              SETITIMER
-              SETPGID
-              SIGHOLD
-              SIGPROCMASK
-              SIGSUSPEND
-              SLEEP
-              SOCKET
-              SYMLINK
-              TCDRAIN
-              TCFLUSH
-              TCGETPGRP
-              TCSETPGRP
-              TERMINAL-GET-STATE
-              TERMINAL-SET-STATE
-              TIME
-              TIMES
-              UNLINK
-              UTIME
-              VFORK
-              WRITE
-              STAT
-              LSTAT
-              MKTIME
-              DYNAMIC-LOAD
-              ))
+            (let ((prim (ucode-primitive microcode-system-call-names 0)))
+              (if (implemented-primitive-procedure? prim)
+                  (prim)
+                  ;; For compatibility with older microcodes:
+                  '#(ACCEPT
+                     BIND
+                     CHDIR
+                     CHMOD
+                     CLOSE
+                     CONNECT
+                     FCNTL-GETFL
+                     FCNTL-SETFL
+                     FORK
+                     FSTAT
+                     FTRUNCATE
+                     GETCWD
+                     GETHOSTNAME
+                     GETTIMEOFDAY
+                     IOCTL-TIOCGPGRP
+                     IOCTL-TIOCSIGSEND
+                     KILL
+                     LINK
+                     LISTEN
+                     LOCALTIME
+                     LSEEK
+                     MALLOC
+                     MKDIR
+                     OPEN
+                     OPENDIR
+                     PAUSE
+                     PIPE
+                     READ
+                     READLINK
+                     REALLOC
+                     RENAME
+                     RMDIR
+                     SELECT
+                     SETITIMER
+                     SETPGID
+                     SIGHOLD
+                     SIGPROCMASK
+                     SIGSUSPEND
+                     SLEEP
+                     SOCKET
+                     SYMLINK
+                     TCDRAIN
+                     TCFLUSH
+                     TCGETPGRP
+                     TCSETPGRP
+                     TERMINAL-GET-STATE
+                     TERMINAL-SET-STATE
+                     TIME
+                     TIMES
+                     UNLINK
+                     UTIME
+                     VFORK
+                     WRITE
+                     STAT
+                     LSTAT
+                     MKTIME
+                     DYNAMIC-LOAD))))
 \f
 ;;; [] System-call errors
 
 (vector-set! (get-fixed-objects-vector)
             #x0A ;(fixed-objects-vector-slot 'SYSTEM-CALL-ERRORS)
-            #(UNKNOWN
-              ARG-LIST-TOO-LONG
-              BAD-ADDRESS
-              BAD-FILE-DESCRIPTOR
-              BROKEN-PIPE
-              DIRECTORY-NOT-EMPTY
-              DOMAIN-ERROR
-              EXEC-FORMAT-ERROR
-              FILE-EXISTS
-              FILE-TOO-LARGE
-              FILENAME-TOO-LONG
-              FUNCTION-NOT-IMPLEMENTED
-              IMPROPER-LINK
-              INAPPROPRIATE-IO-CONTROL-OPERATION
-              INTERRUPTED-FUNCTION-CALL
-              INVALID-ARGUMENT
-              INVALID-SEEK
-              IO-ERROR
-              IS-A-DIRECTORY
-              NO-CHILD-PROCESSES
-              NO-LOCKS-AVAILABLE
-              NO-SPACE-LEFT-ON-DEVICE
-              NO-SUCH-DEVICE
-              NO-SUCH-DEVICE-OR-ADDRESS
-              NO-SUCH-FILE-OR-DIRECTORY
-              NO-SUCH-PROCESS
-              NOT-A-DIRECTORY
-              NOT-ENOUGH-SPACE
-              OPERATION-NOT-PERMITTED
-              PERMISSION-DENIED
-              READ-ONLY-FILE-SYSTEM
-              RESOURCE-BUSY
-              RESOURCE-DEADLOCK-AVOIDED
-              RESOURCE-TEMPORARILY-UNAVAILABLE
-              RESULT-TOO-LARGE
-              TOO-MANY-LINKS
-              TOO-MANY-OPEN-FILES
-              TOO-MANY-OPEN-FILES
-              ))
+            (let ((prim (ucode-primitive microcode-system-error-names 0)))
+              (if (implemented-primitive-procedure? prim)
+                  (prim)
+                  ;; For compatibility with older microcodes:
+                  '#(UNKNOWN
+                     ARG-LIST-TOO-LONG
+                     BAD-ADDRESS
+                     BAD-FILE-DESCRIPTOR
+                     BROKEN-PIPE
+                     DIRECTORY-NOT-EMPTY
+                     DOMAIN-ERROR
+                     EXEC-FORMAT-ERROR
+                     FILE-EXISTS
+                     FILE-TOO-LARGE
+                     FILENAME-TOO-LONG
+                     FUNCTION-NOT-IMPLEMENTED
+                     IMPROPER-LINK
+                     INAPPROPRIATE-IO-CONTROL-OPERATION
+                     INTERRUPTED-FUNCTION-CALL
+                     INVALID-ARGUMENT
+                     INVALID-SEEK
+                     IO-ERROR
+                     IS-A-DIRECTORY
+                     NO-CHILD-PROCESSES
+                     NO-LOCKS-AVAILABLE
+                     NO-SPACE-LEFT-ON-DEVICE
+                     NO-SUCH-DEVICE
+                     NO-SUCH-DEVICE-OR-ADDRESS
+                     NO-SUCH-FILE-OR-DIRECTORY
+                     NO-SUCH-PROCESS
+                     NOT-A-DIRECTORY
+                     NOT-ENOUGH-SPACE
+                     OPERATION-NOT-PERMITTED
+                     PERMISSION-DENIED
+                     READ-ONLY-FILE-SYSTEM
+                     RESOURCE-BUSY
+                     RESOURCE-DEADLOCK-AVOIDED
+                     RESOURCE-TEMPORARILY-UNAVAILABLE
+                     RESULT-TOO-LARGE
+                     TOO-MANY-LINKS
+                     TOO-MANY-OPEN-FILES
+                     TOO-MANY-OPEN-FILES))))
 \f
 ;;; [] Identification
 
 
 ;;; This identification string is saved by the system.
 
-"$Id: utabmd.scm,v 9.74 1994/03/28 02:15:56 ziggy Exp $"
+"$Id: utabmd.scm,v 9.75 1994/10/04 21:08:02 cph Exp $"