/* -*-C-*-
-$Id: bchdmp.c,v 9.74 1993/11/04 04:03:27 gjr Exp $
+$Id: bchdmp.c,v 9.75 1993/11/09 08:33:14 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
#define fasdump_typeless_end() \
{ \
- (* (SCHEME_ADDR_TO_ADDR (Temp))) = (MAKE_BROKEN_HEART (New_Address)); \
+ (* (SCHEME_ADDR_TO_ADDR (Temp))) \
+ = (MAKE_BROKEN_HEART ((SCHEME_OBJECT *) New_Address)); \
(* Scan) = (ADDR_TO_SCHEME_ADDR (New_Address)); \
continue; \
}
/* -*-C-*-
-$Id: bchgcc.h,v 9.55 1993/10/14 19:13:10 gjr Exp $
+$Id: bchgcc.h,v 9.56 1993/11/09 08:30:39 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
#define relocate_typeless_end() \
{ \
- (* (SCHEME_ADDR_TO_ADDR (Temp))) = (MAKE_BROKEN_HEART (New_Address)); \
+ (* (SCHEME_ADDR_TO_ADDR (Temp))) \
+ = (MAKE_BROKEN_HEART ((SCHEME_OBJECT *) (New_Address))); \
(* Scan) = (ADDR_TO_SCHEME_ADDR (New_Address)); \
continue; \
}
} \
} while (0)
+#define relocate_raw_compiled_entry(in_gc_p) do \
+{ \
+ Old = (SCHEME_ADDR_TO_ADDR (Temp)); \
+ if (Old < low_heap) \
+ continue; \
+ Compiled_BH (in_gc_p, continue); \
+ { \
+ SCHEME_OBJECT *Saved_Old = Old; \
+ \
+ New_Address = (MAKE_BROKEN_HEART (To_Address)); \
+ copy_vector (NULL); \
+ * Saved_Old = New_Address; \
+ Temp = (RELOCATE_COMPILED_RAW_ADDRESS \
+ (Temp, \
+ (OBJECT_ADDRESS (New_Address)), \
+ Saved_Old)); \
+ continue; \
+ } \
+} while (0)
+
#define relocate_linked_operator(in_gc_p) do \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
- relocate_compiled_entry (in_gc_p); \
+ relocate_raw_compiled_entry (in_gc_p); \
BCH_STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
} while (0)
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
- relocate_compiled_entry (in_gc_p); \
+ relocate_raw_compiled_entry (in_gc_p); \
BCH_STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
} while (0)
/* -*-C-*-
-$Id: bintopsb.c,v 9.60 1993/11/07 02:12:56 gjr Exp $
+$Id: bintopsb.c,v 9.61 1993/11/09 08:36:04 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
{ \
long the_datum; \
\
- Old_Address = (SCHEME_ADDR_TO_ADDR (ptr)); \
- the_datum = (ADDRESS_TO_DATUM (Old_Address)); \
+ the_datum = (SCHEME_ADDR_TO_OLD_DATUM (ptr)); \
+ Old_Address = (DATUM_TO_ADDRESS (the_datum)); \
if ((the_datum >= Heap_Base) && (the_datum < Dumped_Heap_Top)) \
Action (HEAP_CODE, Heap_Relocation, Free, \
Scn, Objects, Free_Objects); \
/* -*-C-*-
-$Id: cmpgc.h,v 1.24 1993/06/24 03:58:48 gjr Exp $
+$Id: cmpgc.h,v 1.25 1993/11/09 08:31:11 gjr Exp $
Copyright (c) 1989-1993 Massachusetts Institute of Technology
{ \
offset_word = (COMPILED_ENTRY_OFFSET_WORD(var)); \
var = ((SCHEME_OBJECT *) \
- (((char *) (var)) - \
- ((long) (OFFSET_WORD_TO_BYTE_OFFSET(offset_word))))); \
- } while (OFFSET_WORD_CONTINUATION_P(offset_word)); \
+ (((char *) (var)) \
+ - ((long) (OFFSET_WORD_TO_BYTE_OFFSET(offset_word))))); \
+ } while (OFFSET_WORD_CONTINUATION_P (offset_word)); \
}
+#define RELOCATE_COMPILED_INTERNAL(addr, new_block, old_block) \
+ ((SCHEME_OBJECT *) \
+ (((char *) new_block) \
+ + (((char *) (addr)) - ((char *) old_block))))
+
+#define RELOCATE_COMPILED_RAW_ADDRESS(addr, new_block, old_block) \
+ (ADDR_TO_SCHEME_ADDR \
+ (RELOCATE_COMPILED_INTERNAL ((SCHEME_ADDR_TO_ADDR (Temp)), \
+ new_block, old_block)))
+
#define RELOCATE_COMPILED_ADDRESS(object, new_block, old_block) \
-((SCHEME_OBJECT *) (((char *) new_block) + \
- (((char *) (OBJECT_ADDRESS(object))) - \
- ((char *) old_block))))
+ ((SCHEME_OBJECT *) \
+ (RELOCATE_COMPILED_INTERNAL ((OBJECT_ADDRESS (object)), \
+ new_block, old_block)))
#define RELOCATE_COMPILED(object, new_block, old_block) \
-MAKE_POINTER_OBJECT((OBJECT_TYPE(object)), \
- (RELOCATE_COMPILED_ADDRESS(object, new_block, old_block)))
+MAKE_POINTER_OBJECT ((OBJECT_TYPE (object)), \
+ (RELOCATE_COMPILED_ADDRESS (object, new_block, \
+ old_block)))
#define Compiled_BH(In_GC, then_what) \
{ \
\
Get_Compiled_Block (Old, Old); \
COMPILED_CODE_PRE_TEST (then_what) \
- if (BROKEN_HEART_P (*Old)) \
+ if (BROKEN_HEART_P (* Old)) \
+ { \
+ Temp = (RELOCATE_COMPILED (Temp, (OBJECT_ADDRESS (* Old)), Old)); \
+ then_what; \
+ } \
+}
+
+#define RAW_COMPILED_BH(In_GC, then_what) \
+{ \
+ Get_Compiled_Block (Old, Old); \
+ COMPILED_CODE_PRE_TEST (then_what) \
+ if (BROKEN_HEART_P (* Old)) \
{ \
- Temp = (RELOCATE_COMPILED (Temp, (OBJECT_ADDRESS (*Old)), Old)); \
+ Temp = (RELOCATE_COMPILED_RAW_ADDRESS (Temp, \
+ (OBJECT_ADDRESS (* Old)), \
+ Old)); \
then_what; \
} \
}
# define AUTOCLOBBER_BUMP(Old, To) do \
{ \
- if (OBJECT_TYPE(*Old) == TC_MANIFEST_VECTOR) \
+ if ((OBJECT_TYPE (* Old)) == TC_MANIFEST_VECTOR) \
{ \
*To = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, \
((PAGE_SIZE / (sizeof (SCHEME_OBJECT))) \
#endif
-#define Transport_Compiled() \
+#define Transport_Compiled() do \
{ \
- SCHEME_OBJECT *Saved_Old = Old; \
+ SCHEME_OBJECT * Saved_Old = Old; \
\
- Real_Transport_Vector(); \
+ Real_Transport_Vector (); \
AUTOCLOBBER_BUMP (Saved_Old, To); \
*Saved_Old = New_Address; \
Temp = (RELOCATE_COMPILED (Temp, \
(OBJECT_ADDRESS (New_Address)), \
Saved_Old)); \
-}
+} while (0)
+
+#define TRANSPORT_RAW_COMPILED() do \
+{ \
+ SCHEME_OBJECT * Saved_Old = Old; \
+ \
+ Real_Transport_Vector (); \
+ AUTOCLOBBER_BUMP (Saved_Old, To); \
+ *Saved_Old = New_Address; \
+ Temp = (RELOCATE_COMPILED_RAW_ADDRESS \
+ (Temp, \
+ (OBJECT_ADDRESS (New_Address)), \
+ Saved_Old)); \
+} while (0)
\f
/* Manifest and implied types */
/* -*-C-*-
-$Id: fasdump.c,v 9.58 1993/11/04 04:03:07 gjr Exp $
+$Id: fasdump.c,v 9.59 1993/11/09 08:32:41 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
*(To - 1) = SHARP_F; \
}
-#define Dump_Compiled_Entry(label) \
-{ \
- Dump_Pointer (Fasdump_Setup_Pointer (Fasdump_Transport_Compiled (), \
- Compiled_BH (false, goto label))); \
+#define FASDUMP_TRANSPORT_RAW_COMPILED() \
+{ \
+ TRANSPORT_RAW_COMPILED (); \
+ if ((mode == 2) && ((OBJECT_TYPE (*(To - 1))) == TC_ENVIRONMENT)) \
+ *(To - 1) = SHARP_F; \
+}
+
+#define Dump_Compiled_Entry(label) \
+{ \
+ Dump_Pointer \
+ (Fasdump_Setup_Pointer (Fasdump_Transport_Compiled (), \
+ Compiled_BH (false, goto label))); \
+}
+
+#define DUMP_RAW_COMPILED_ENTRY(label) \
+{ \
+ DUMP_RAW_POINTER \
+ (Fasdump_Setup_Pointer (FASDUMP_TRANSPORT_RAW_COMPILED (), \
+ RAW_COMPILED_BH (false, \
+ goto label))); \
}
/* Should be big enough for the largest fixed size object (a Quad)
Scan = ((SCHEME_OBJECT *) (word_ptr));
word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr));
EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan);
- Dump_Compiled_Entry (after_closure);
+ DUMP_RAW_COMPILED_ENTRY (after_closure);
after_closure:
STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan);
}
Scan = ((SCHEME_OBJECT *) (word_ptr));
word_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
- Dump_Compiled_Entry (after_operator);
- after_operator:
+ DUMP_RAW_COMPILED_ENTRY (after_operator);
+ after_operator:
STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
}
Scan = end_scan;
/* -*-C-*-
-$Id: fasload.c,v 9.77 1993/11/08 06:53:53 gjr Exp $
+$Id: fasload.c,v 9.78 1993/11/09 08:34:16 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
block of memory.
*/
-#ifdef HEAP_IN_LOW_MEMORY
-
-#define SCHEME_ADDR_TO_OLD_DATUM(addr) \
- (ADDRESS_TO_DATUM (SCHEME_ADDR_TO_ADDR ((SCHEME_OBJECT *) (addr))))
-
-#else /* not HEAP_IN_LOW_MEMORY */
-
-#define SCHEME_ADDR_TO_OLD_DATUM(addr) \
- (((SCHEME_OBJECT *) (addr)) - ((SCHEME_OBJECT *) dumped_memory_base))
-
-#endif /* HEAP_IN_LOW_MEMORY */
-
static long
DEFUN (primitive_dumped_number, (datum), unsigned long datum)
{
/* -*-C-*-
-$Id: gcloop.c,v 9.43 1993/10/14 19:22:37 gjr Exp $
+$Id: gcloop.c,v 9.44 1993/11/09 08:31:48 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
Scan = ((SCHEME_OBJECT *) word_ptr);
word_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
- GC_Pointer (Setup_Internal (true,
- Transport_Compiled (),
- Compiled_BH(true,
- goto next_operator)));
+ GC_RAW_POINTER (Setup_Internal
+ (true,
+ TRANSPORT_RAW_COMPILED (),
+ RAW_COMPILED_BH (true,
+ goto next_operator)));
next_operator:
STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
}
Scan = ((SCHEME_OBJECT *) (word_ptr));
word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr));
EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan);
- GC_Pointer(Setup_Internal(true,
- Transport_Compiled(),
- Compiled_BH(true, goto next_closure)));
+ GC_RAW_POINTER (Setup_Internal
+ (true,
+ TRANSPORT_RAW_COMPILED (),
+ RAW_COMPILED_BH (true,
+ goto next_closure)));
next_closure:
STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan);
}
/* -*-C-*-
-$Id: load.c,v 9.35 1993/11/08 06:34:30 gjr Exp $
+$Id: load.c,v 9.36 1993/11/09 08:34:52 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
return (FASL_FILE_TOO_SHORT);
return (initialize_variables_from_fasl_header (&header[0]));
}
+
+#ifdef HEAP_IN_LOW_MEMORY
+
+#define SCHEME_ADDR_TO_OLD_DATUM(addr) \
+ (ADDRESS_TO_DATUM (SCHEME_ADDR_TO_ADDR ((SCHEME_OBJECT *) (addr))))
+
+#else /* not HEAP_IN_LOW_MEMORY */
+
+#define SCHEME_ADDR_TO_OLD_DATUM(addr) \
+ (((SCHEME_OBJECT *) (addr)) - ((SCHEME_OBJECT *) dumped_memory_base))
+
+#endif /* HEAP_IN_LOW_MEMORY */
\f
#ifdef BYTE_INVERSION
/* -*-C-*-
-$Id: psbtobin.c,v 9.52 1993/11/07 04:10:00 gjr Exp $
+$Id: psbtobin.c,v 9.53 1993/11/09 08:33:42 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
#ifndef MAKE_LINKAGE_SECTION_HEADER
#define MAKE_LINKAGE_SECTION_HEADER(kind,count) 0
+#endif
+\f
+/*
+ The following two lines appears by courtesy of your friendly
+ VMS C compiler and runtime library.
+
+ Bug in version 4 VMS scanf.
+ */
+
+#ifndef vms
+
+#define VMS_BUG(stmt)
+
+#define read_hex_digit(var) \
+{ \
+ VMS_BUG (var = 0); \
+ fscanf (portable_file, "%1lx", &var); \
+}
+
+#else
+
+#define VMS_BUG(stmt) stmt
+
+#define read_hex_digit (var) \
+{ \
+ var = (read_hex_digit_procedure ()); \
+}
+
+long
+read_hex_digit_procedure ()
+{
+ long digit;
+ int c;
+
+ while ((c = fgetc (portable_file)) == ' ')
+ {};
+ digit = ((c >= 'a') ? (c - 'a' + 10)
+ : ((c >= 'A') ? (c - 'A' + 10)
+ : ((c >= '0') ? (c - '0')
+ : fprintf (stderr, "Losing big: %d\n", c))));
+ return (digit);
+}
+
#endif
\f
static void
C = getc (portable_file);
if (C != '\\')
- {
OUT (C);
- }
+
C = getc (portable_file);
switch (C)
{
"%s: File is not Portable. Character Code Found.\n",
program_name);
}
+ VMS_BUG (Code = 0);
fscanf (portable_file, "%ld", &Code);
getc (portable_file); /* Space */
OUT (Code);
long len, maxlen;
char * str;
+ VMS_BUG (len = 0);
fscanf (portable_file, "%ld", &len);
maxlen = (len + 1); /* null terminated */
fast long len;
str = ((char *) (&To[STRING_CHARS]));
+ VMS_BUG (ilen = 0);
fscanf (portable_file, "%ld", &ilen);
len = ilen;
long maxlen;
*Slot = (MAKE_POINTER_OBJECT (TC_CHARACTER_STRING, To));
+ VMS_BUG (maxlen = 0);
fscanf (portable_file, "%ld", &maxlen);
return (read_a_string_internal (To, maxlen));
}
\f
-/*
- The following two lines appears by courtesy of your friendly
- VMS C compiler and runtime library.
-
- Bug in version 4 VMS scanf.
- */
-
-#ifndef vms
-
-#define VMS_BUG(stmt)
-
-#define read_hex_digit(var) \
-{ \
- fscanf (portable_file, "%1lx", &var); \
-}
-
-#else
-
-#define VMS_BUG(stmt) stmt
-
-#define read_hex_digit (var) \
-{ \
- var = (read_hex_digit_procedure ()); \
-}
-
-long
-read_hex_digit_procedure ()
-{
- long digit;
- int c;
-
- while ((c = fgetc (portable_file)) == ' ')
- {};
- digit = ((c >= 'a') ? (c - 'a' + 10)
- : ((c >= 'A') ? (c - 'A' + 10)
- : ((c >= '0') ? (c - '0')
- : fprintf (stderr, "Losing big: %d\n", c))));
- return (digit);
-}
-
-#endif
-\f
static SCHEME_OBJECT *
DEFUN (read_an_integer, (The_Type, To, Slot),
int The_Type AND SCHEME_OBJECT * To AND SCHEME_OBJECT * Slot)
negative = ((getc (portable_file)) == '-');
{
long l;
+ VMS_BUG (l = 0);
fscanf (portable_file, "%ld", (&l));
length_in_bits = l;
}
long size_in_bits, size_in_words;
SCHEME_OBJECT the_bit_string;
+ VMS_BUG (size_in_bits = 0);
fscanf (portable_file, "%ld", &size_in_bits);
size_in_words = (1 + (BIT_STRING_LENGTH_TO_GC_LENGTH (size_in_bits)));
while (Table < Until)
{
+ VMS_BUG (The_Type = 0);
fscanf (portable_file, "%2x", &The_Type);
switch (The_Type)
{
SCHEME_OBJECT * temp, * entry_addr;
long base_type, base_datum;
+ VMS_BUG (base_type = 0);
+ VMS_BUG (base_datum = 0);
fscanf (portable_file, "%02x %lx", &base_type, &base_datum);
temp = (Relocate (base_datum));
if (c_compiled_p)
while (--how_many >= 0)
{
+ VMS_BUG (arity = 0);
fscanf (portable_file, "%ld", &arity);
if (arity == ((long) UNKNOWN_PRIMITIVE_ARITY))
primitive_warn = true;
{
long nentries;
+ VMS_BUG (nentries = 0);
fscanf (portable_file, "%ld", &nentries);
*area++ = (LONG_TO_FIXNUM (nentries));
area = (read_a_char_pointer (area));
\f
#define READ_HEADER_NO_ERROR(string, format, value, flag) do \
{ \
+ VMS_BUG (value = 0); \
if (fscanf (portable_file, format, &(value)) == EOF) \
{ \
(flag) = (false); \
#define READ_HEADER(string, format, value) do \
{ \
+ VMS_BUG (value = 0); \
if (fscanf (portable_file, format, &(value)) == EOF) \
{ \
READ_HEADER_FAILURE (string); \
/* -*-C-*-
-$Id: purify.c,v 9.52 1993/10/14 19:14:00 gjr Exp $
+$Id: purify.c,v 9.53 1993/11/09 08:32:15 gjr Exp $
Copyright (c) 1988-1993 Massachusetts Institute of Technology
Scan = ((SCHEME_OBJECT *) word_ptr);
word_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
- Purify_Pointer (Setup_Internal
- (false,
- Transport_Compiled (),
- Compiled_BH (false,
- goto next_operator)));
- next_operator:
+ PURIFY_RAW_POINTER (Setup_Internal
+ (false,
+ TRANSPORT_RAW_COMPILED (),
+ RAW_COMPILED_BH (false,
+ goto next_operator)));
+ next_operator:
STORE_OPERATOR_LINKAGE_ADDRESS(Temp, Scan);
}
Scan = end_scan;
Scan = ((SCHEME_OBJECT *) (word_ptr));
word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr));
EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan);
- Purify_Pointer(Setup_Internal(false,
- Transport_Compiled(),
- Compiled_BH(false,
- goto next_closure)));
+ PURIFY_RAW_POINTER (Setup_Internal
+ (false,
+ TRANSPORT_RAW_COMPILED (),
+ RAW_COMPILED_BH (false,
+ goto next_closure)));
next_closure:
STORE_CLOSURE_ENTRY_ADDRESS(Temp, Scan);
}
/* -*-C-*-
-$Id: bintopsb.c,v 9.60 1993/11/07 02:12:56 gjr Exp $
+$Id: bintopsb.c,v 9.61 1993/11/09 08:36:04 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
{ \
long the_datum; \
\
- Old_Address = (SCHEME_ADDR_TO_ADDR (ptr)); \
- the_datum = (ADDRESS_TO_DATUM (Old_Address)); \
+ the_datum = (SCHEME_ADDR_TO_OLD_DATUM (ptr)); \
+ Old_Address = (DATUM_TO_ADDRESS (the_datum)); \
if ((the_datum >= Heap_Base) && (the_datum < Dumped_Heap_Top)) \
Action (HEAP_CODE, Heap_Relocation, Free, \
Scn, Objects, Free_Objects); \
/* -*-C-*-
-$Id: psbtobin.c,v 9.52 1993/11/07 04:10:00 gjr Exp $
+$Id: psbtobin.c,v 9.53 1993/11/09 08:33:42 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
#ifndef MAKE_LINKAGE_SECTION_HEADER
#define MAKE_LINKAGE_SECTION_HEADER(kind,count) 0
+#endif
+\f
+/*
+ The following two lines appears by courtesy of your friendly
+ VMS C compiler and runtime library.
+
+ Bug in version 4 VMS scanf.
+ */
+
+#ifndef vms
+
+#define VMS_BUG(stmt)
+
+#define read_hex_digit(var) \
+{ \
+ VMS_BUG (var = 0); \
+ fscanf (portable_file, "%1lx", &var); \
+}
+
+#else
+
+#define VMS_BUG(stmt) stmt
+
+#define read_hex_digit (var) \
+{ \
+ var = (read_hex_digit_procedure ()); \
+}
+
+long
+read_hex_digit_procedure ()
+{
+ long digit;
+ int c;
+
+ while ((c = fgetc (portable_file)) == ' ')
+ {};
+ digit = ((c >= 'a') ? (c - 'a' + 10)
+ : ((c >= 'A') ? (c - 'A' + 10)
+ : ((c >= '0') ? (c - '0')
+ : fprintf (stderr, "Losing big: %d\n", c))));
+ return (digit);
+}
+
#endif
\f
static void
C = getc (portable_file);
if (C != '\\')
- {
OUT (C);
- }
+
C = getc (portable_file);
switch (C)
{
"%s: File is not Portable. Character Code Found.\n",
program_name);
}
+ VMS_BUG (Code = 0);
fscanf (portable_file, "%ld", &Code);
getc (portable_file); /* Space */
OUT (Code);
long len, maxlen;
char * str;
+ VMS_BUG (len = 0);
fscanf (portable_file, "%ld", &len);
maxlen = (len + 1); /* null terminated */
fast long len;
str = ((char *) (&To[STRING_CHARS]));
+ VMS_BUG (ilen = 0);
fscanf (portable_file, "%ld", &ilen);
len = ilen;
long maxlen;
*Slot = (MAKE_POINTER_OBJECT (TC_CHARACTER_STRING, To));
+ VMS_BUG (maxlen = 0);
fscanf (portable_file, "%ld", &maxlen);
return (read_a_string_internal (To, maxlen));
}
\f
-/*
- The following two lines appears by courtesy of your friendly
- VMS C compiler and runtime library.
-
- Bug in version 4 VMS scanf.
- */
-
-#ifndef vms
-
-#define VMS_BUG(stmt)
-
-#define read_hex_digit(var) \
-{ \
- fscanf (portable_file, "%1lx", &var); \
-}
-
-#else
-
-#define VMS_BUG(stmt) stmt
-
-#define read_hex_digit (var) \
-{ \
- var = (read_hex_digit_procedure ()); \
-}
-
-long
-read_hex_digit_procedure ()
-{
- long digit;
- int c;
-
- while ((c = fgetc (portable_file)) == ' ')
- {};
- digit = ((c >= 'a') ? (c - 'a' + 10)
- : ((c >= 'A') ? (c - 'A' + 10)
- : ((c >= '0') ? (c - '0')
- : fprintf (stderr, "Losing big: %d\n", c))));
- return (digit);
-}
-
-#endif
-\f
static SCHEME_OBJECT *
DEFUN (read_an_integer, (The_Type, To, Slot),
int The_Type AND SCHEME_OBJECT * To AND SCHEME_OBJECT * Slot)
negative = ((getc (portable_file)) == '-');
{
long l;
+ VMS_BUG (l = 0);
fscanf (portable_file, "%ld", (&l));
length_in_bits = l;
}
long size_in_bits, size_in_words;
SCHEME_OBJECT the_bit_string;
+ VMS_BUG (size_in_bits = 0);
fscanf (portable_file, "%ld", &size_in_bits);
size_in_words = (1 + (BIT_STRING_LENGTH_TO_GC_LENGTH (size_in_bits)));
while (Table < Until)
{
+ VMS_BUG (The_Type = 0);
fscanf (portable_file, "%2x", &The_Type);
switch (The_Type)
{
SCHEME_OBJECT * temp, * entry_addr;
long base_type, base_datum;
+ VMS_BUG (base_type = 0);
+ VMS_BUG (base_datum = 0);
fscanf (portable_file, "%02x %lx", &base_type, &base_datum);
temp = (Relocate (base_datum));
if (c_compiled_p)
while (--how_many >= 0)
{
+ VMS_BUG (arity = 0);
fscanf (portable_file, "%ld", &arity);
if (arity == ((long) UNKNOWN_PRIMITIVE_ARITY))
primitive_warn = true;
{
long nentries;
+ VMS_BUG (nentries = 0);
fscanf (portable_file, "%ld", &nentries);
*area++ = (LONG_TO_FIXNUM (nentries));
area = (read_a_char_pointer (area));
\f
#define READ_HEADER_NO_ERROR(string, format, value, flag) do \
{ \
+ VMS_BUG (value = 0); \
if (fscanf (portable_file, format, &(value)) == EOF) \
{ \
(flag) = (false); \
#define READ_HEADER(string, format, value) do \
{ \
+ VMS_BUG (value = 0); \
if (fscanf (portable_file, format, &(value)) == EOF) \
{ \
READ_HEADER_FAILURE (string); \
projects / mit-scheme.git / commitdiff