Shorten names of some files to allow Emacs version numbers to be used
authorChris Hanson <org/chris-hanson/cph>
Mon, 23 Nov 1987 06:37:38 +0000 (06:37 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 23 Nov 1987 06:37:38 +0000 (06:37 +0000)
on ATT file systems.  Add alternative primitive definition macro which
works correctly with Emacs tags tables.

v7/src/microcode/pruxfs.c

index d9f92262a8433d62c28354f741a8e00a959ce93f..eb0bc0f29a28beedd166dafaddf216ad925b54a2 100644 (file)
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.22 1987/07/18 03:04:11 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.23 1987/11/23 06:37:38 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -49,25 +49,25 @@ MIT in each case. */
 /* Looks up in the user's shell environment the value of the 
    variable specified as a string. */
 
-Define_Primitive (Prim_get_environment_variable, 1, "GET-ENVIRONMENT-VARIABLE")
+DEFINE_PRIMITIVE ("GET-ENVIRONMENT-VARIABLE", Prim_get_environment_variable, 1)
 {
   char *variable_value;
   extern char *getenv ();
-  Primitive_1_Arg ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, STRING_P);
-  variable_value = (getenv (Scheme_String_To_C_String (Arg1)));
-  return
+  variable_value = (getenv (Scheme_String_To_C_String (ARG_REF (1))));
+  PRIMITIVE_RETURN
     ((variable_value == NULL)
      ? NIL
      : (C_String_To_Scheme_String (variable_value)));
 }
 
-Define_Primitive (Prim_get_user_name, 0, "CURRENT-USER-NAME")
+DEFINE_PRIMITIVE ("CURRENT-USER-NAME", Prim_get_user_name, 0)
 {
   char *user_name;
   char *getlogin ();
-  Primitive_0_Args ();
+  PRIMITIVE_HEADER (0);
 
   user_name = (getlogin ());
   if (user_name == NULL)
@@ -81,75 +81,75 @@ Define_Primitive (Prim_get_user_name, 0, "CURRENT-USER-NAME")
        error_external_return ();
       user_name = (entry -> pw_name);
     }
-  return (C_String_To_Scheme_String (user_name));
+  PRIMITIVE_RETURN (C_String_To_Scheme_String (user_name));
 }
 
-Define_Primitive (Prim_get_user_home_directory, 1, "GET-USER-HOME-DIRECTORY")
+DEFINE_PRIMITIVE ("GET-USER-HOME-DIRECTORY", Prim_get_user_home_directory, 1)
 {
   struct passwd *entry;
   struct passwd *getpwnam ();
-  Primitive_1_Arg ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, STRING_P);
-  entry = (getpwnam (Scheme_String_To_C_String (Arg1)));
-  return
+  entry = (getpwnam (Scheme_String_To_C_String (ARG_REF (1))));
+  PRIMITIVE_RETURN
     ((entry == NULL)
      ? NIL
      : (C_String_To_Scheme_String (entry -> pw_dir)));
 }
 \f
-Define_Primitive (Prim_current_file_time, 0, "CURRENT-FILE-TIME")
+DEFINE_PRIMITIVE ("CURRENT-FILE-TIME", Prim_current_file_time, 0)
 {
-  Primitive_0_Args ();
+  PRIMITIVE_HEADER (0);
 
-  return (C_Integer_To_Scheme_Integer (time ((long *) 0)));
+  PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (time ((long *) 0)));
 }
 
-Define_Primitive (Prim_file_time_to_string, 1, "FILE-TIME->STRING")
+DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1)
 {
   long clock;
   long temp;
   char *time_string;
-  Primitive_1_Arg ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, INTEGER_P);
-  temp = (Scheme_Integer_To_C_Integer (Arg1, (& clock)));
+  temp = (Scheme_Integer_To_C_Integer ((ARG_REF (1)), (& clock)));
   if (temp != PRIM_DONE)
-    return (temp);
+    PRIMITIVE_RETURN (temp);
   time_string = (ctime (& clock));
   if ((time_string [24]) == '\n')
     (time_string [24]) = '\0';
-  return (C_String_To_Scheme_String (time_string));
+  PRIMITIVE_RETURN (C_String_To_Scheme_String (time_string));
 }
 
-Define_Primitive (Prim_uid_to_string, 1, "UID->STRING")
+DEFINE_PRIMITIVE ("UID->STRING", Prim_uid_to_string, 1)
 {
   struct passwd *getpwuid ();
   void endpwent ();
   struct passwd *entry;
-  Primitive_1_Args ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, FIXNUM_P);
-  entry = (getpwuid (UNSIGNED_FIXNUM_VALUE (Arg1)));
+  entry = (getpwuid (arg_nonnegative_integer (1)));
   endpwent ();
   if (entry == NULL)
     error_bad_range_arg (1);
-  return (C_String_To_Scheme_String (entry -> pw_name));
+  PRIMITIVE_RETURN (C_String_To_Scheme_String (entry -> pw_name));
 }
 
-Define_Primitive (Prim_gid_to_string, 1, "GID->STRING")
+DEFINE_PRIMITIVE ("GID->STRING", Prim_gid_to_string, 1)
 {
   struct group *getgrgid ();
   void endgrent ();
   struct group *entry;
-  Primitive_1_Args ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, FIXNUM_P);
-  entry = (getgrgid (UNSIGNED_FIXNUM_VALUE (Arg1)));
+  entry = (getgrgid (arg_nonnegative_integer (1)));
   endgrent ();
   if (entry == NULL)
     error_bad_range_arg (1);
-  return (C_String_To_Scheme_String (entry -> gr_name));
+  PRIMITIVE_RETURN (C_String_To_Scheme_String (entry -> gr_name));
 }
 \f
 /* Returns a vector of 9 items:
@@ -167,21 +167,21 @@ Define_Primitive (Prim_gid_to_string, 1, "GID->STRING")
 
    The filemodestring stuff was gobbled from GNU Emacs. */
 
-Define_Primitive (Prim_file_attributes, 1, "FILE-ATTRIBUTES")
+DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1)
 {
   struct stat stat_result;
+  extern Pointer allocate_marked_vector ();
   Pointer result;
+  extern Pointer allocate_string ();
+  Pointer modes;
   static void filemodestring ();
-  char modes[11];
-  Primitive_1_Arg ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, STRING_P);
-  if ((stat ((Scheme_String_To_C_String (Arg1)), (& stat_result))) < 0)
-    return (NIL);
-  Primitive_GC_If_Needed (10);
-  result = (Make_Pointer (TC_VECTOR, Free));
-  (*Free++) = (Make_Non_Pointer (TC_MANIFEST_VECTOR, 9));
-  Free += 9;
+  if ((stat ((Scheme_String_To_C_String (ARG_REF (1))), (& stat_result))) < 0)
+    PRIMITIVE_RETURN (NIL);
+  result = (allocate_marked_vector (TC_VECTOR, 9, true));
+  modes = (allocate_string (10));
   User_Vector_Set
     (result, 0,
      ((((stat_result . st_mode) & S_IFMT) == S_IFDIR) ? TRUTH : NIL));
@@ -196,11 +196,10 @@ Define_Primitive (Prim_file_attributes, 1, "FILE-ATTRIBUTES")
     (result, 6, (C_Integer_To_Scheme_Integer (stat_result . st_ctime)));
   User_Vector_Set
     (result, 7, (C_Integer_To_Scheme_Integer (stat_result . st_size)));
-  filemodestring ((& stat_result), modes);
-  (modes [10]) = '\0';
-  User_Vector_Set (result, 8, (C_String_To_Scheme_String (modes)));
+  filemodestring ((& stat_result), (string_pointer (modes, 0)));
+  User_Vector_Set (result, 8, modes);
   User_Vector_Set (result, 9, (MAKE_UNSIGNED_FIXNUM (stat_result . st_ino)));
-  return (result);
+  PRIMITIVE_RETURN (result);
 }
 \f
 /* filemodestring - set file attribute data