From 64dbce6131a79143d6414d226abbc24c2e1a2ff1 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 9 Nov 1993 08:36:04 +0000 Subject: [PATCH] Make the C-back end work without HEAP_IN_LOW_MEMORY. --- v7/src/microcode/bchdmp.c | 5 +- v7/src/microcode/bchgcc.h | 29 ++++++++-- v7/src/microcode/bintopsb.c | 6 +-- v7/src/microcode/cmpgc.h | 69 ++++++++++++++++++------ v7/src/microcode/fasdump.c | 32 ++++++++--- v7/src/microcode/fasload.c | 14 +---- v7/src/microcode/gcloop.c | 19 ++++--- v7/src/microcode/load.c | 14 ++++- v7/src/microcode/psbtobin.c | 103 ++++++++++++++++++++---------------- v7/src/microcode/purify.c | 23 ++++---- v8/src/microcode/bintopsb.c | 6 +-- v8/src/microcode/psbtobin.c | 103 ++++++++++++++++++++---------------- 12 files changed, 264 insertions(+), 159 deletions(-) diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c index 2ddd80412..3248ba5af 100644 --- a/v7/src/microcode/bchdmp.c +++ b/v7/src/microcode/bchdmp.c @@ -1,6 +1,6 @@ /* -*-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 @@ -200,7 +200,8 @@ static Boolean compiled_code_present_p; #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; \ } diff --git a/v7/src/microcode/bchgcc.h b/v7/src/microcode/bchgcc.h index a499f930a..771c042d4 100644 --- a/v7/src/microcode/bchgcc.h +++ b/v7/src/microcode/bchgcc.h @@ -1,6 +1,6 @@ /* -*-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 @@ -387,7 +387,8 @@ do { \ #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; \ } @@ -427,11 +428,31 @@ do { \ } \ } 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) @@ -439,7 +460,7 @@ do { \ { \ 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) diff --git a/v7/src/microcode/bintopsb.c b/v7/src/microcode/bintopsb.c index 980f62722..ad457d92a 100644 --- a/v7/src/microcode/bintopsb.c +++ b/v7/src/microcode/bintopsb.c @@ -1,6 +1,6 @@ /* -*-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 @@ -986,8 +986,8 @@ DEFUN (address_in_pure_space, (addr), SCHEME_OBJECT * addr) { \ 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); \ diff --git a/v7/src/microcode/cmpgc.h b/v7/src/microcode/cmpgc.h index 4e1311b4a..e4471851b 100644 --- a/v7/src/microcode/cmpgc.h +++ b/v7/src/microcode/cmpgc.h @@ -1,6 +1,6 @@ /* -*-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 @@ -108,19 +108,30 @@ else { \ 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) \ { \ @@ -128,9 +139,22 @@ MAKE_POINTER_OBJECT((OBJECT_TYPE(object)), \ \ 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; \ } \ } @@ -139,7 +163,7 @@ MAKE_POINTER_OBJECT((OBJECT_TYPE(object)), \ # 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))) \ @@ -154,17 +178,30 @@ MAKE_POINTER_OBJECT((OBJECT_TYPE(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) /* Manifest and implied types */ diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index a794e351e..d4d75bbcf 100644 --- a/v7/src/microcode/fasdump.c +++ b/v7/src/microcode/fasdump.c @@ -1,6 +1,6 @@ /* -*-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 @@ -119,10 +119,26 @@ static CONST char * dump_file_name = ((char *) 0); *(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) @@ -200,7 +216,7 @@ DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode) 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); } @@ -254,8 +270,8 @@ DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode) 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; diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 753b3bc0e..027a082f5 100644 --- a/v7/src/microcode/fasload.c +++ b/v7/src/microcode/fasload.c @@ -1,6 +1,6 @@ /* -*-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 @@ -420,18 +420,6 @@ static SCHEME_OBJECT * relocate_temp; 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) { diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c index f3d32ce3c..838c2e666 100644 --- a/v7/src/microcode/gcloop.c +++ b/v7/src/microcode/gcloop.c @@ -1,6 +1,6 @@ /* -*-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 @@ -212,10 +212,11 @@ DEFUN (GCLoop, 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); } @@ -252,9 +253,11 @@ DEFUN (GCLoop, 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); } diff --git a/v7/src/microcode/load.c b/v7/src/microcode/load.c index 8e771ed44..fd7caff14 100644 --- a/v7/src/microcode/load.c +++ b/v7/src/microcode/load.c @@ -1,6 +1,6 @@ /* -*-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 @@ -273,6 +273,18 @@ DEFUN_VOID (Read_Header) 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 */ #ifdef BYTE_INVERSION diff --git a/v7/src/microcode/psbtobin.c b/v7/src/microcode/psbtobin.c index 5c2cb3a2a..f850e58ce 100644 --- a/v7/src/microcode/psbtobin.c +++ b/v7/src/microcode/psbtobin.c @@ -1,6 +1,6 @@ /* -*-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 @@ -91,6 +91,49 @@ DEFUN (Write_Data, (Count, From_Where), #ifndef MAKE_LINKAGE_SECTION_HEADER #define MAKE_LINKAGE_SECTION_HEADER(kind,count) 0 +#endif + +/* + 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 static void @@ -117,9 +160,8 @@ DEFUN_VOID (read_a_char) C = getc (portable_file); if (C != '\\') - { OUT (C); - } + C = getc (portable_file); switch (C) { @@ -141,6 +183,7 @@ DEFUN_VOID (read_a_char) "%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); @@ -155,6 +198,7 @@ DEFUN (read_a_char_pointer, (to), SCHEME_OBJECT * to) long len, maxlen; char * str; + VMS_BUG (len = 0); fscanf (portable_file, "%ld", &len); maxlen = (len + 1); /* null terminated */ @@ -176,6 +220,7 @@ DEFUN (read_a_string_internal, (To, maxlen), fast long len; str = ((char *) (&To[STRING_CHARS])); + VMS_BUG (ilen = 0); fscanf (portable_file, "%ld", &ilen); len = ilen; @@ -207,52 +252,11 @@ DEFUN (read_a_string, (To, Slot), 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)); } -/* - 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 - static SCHEME_OBJECT * DEFUN (read_an_integer, (The_Type, To, Slot), int The_Type AND SCHEME_OBJECT * To AND SCHEME_OBJECT * Slot) @@ -264,6 +268,7 @@ DEFUN (read_an_integer, (The_Type, To, Slot), negative = ((getc (portable_file)) == '-'); { long l; + VMS_BUG (l = 0); fscanf (portable_file, "%ld", (&l)); length_in_bits = l; } @@ -393,6 +398,7 @@ DEFUN (read_a_bit_string, (To, Slot), 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))); @@ -576,6 +582,7 @@ DEFUN (Read_External, (N, Table, To), while (Table < Until) { + VMS_BUG (The_Type = 0); fscanf (portable_file, "%2x", &The_Type); switch (The_Type) { @@ -866,6 +873,8 @@ DEFUN (Read_Pointers_and_Relocate, (how_many, to), 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) @@ -1028,6 +1037,7 @@ DEFUN (read_primitives, (how_many, where), while (--how_many >= 0) { + VMS_BUG (arity = 0); fscanf (portable_file, "%ld", &arity); if (arity == ((long) UNKNOWN_PRIMITIVE_ARITY)) primitive_warn = true; @@ -1048,6 +1058,7 @@ DEFUN (read_c_code_blocks, (nreserved, length, area), { long nentries; + VMS_BUG (nentries = 0); fscanf (portable_file, "%ld", &nentries); *area++ = (LONG_TO_FIXNUM (nentries)); area = (read_a_char_pointer (area)); @@ -1058,6 +1069,7 @@ DEFUN (read_c_code_blocks, (nreserved, length, area), #define READ_HEADER_NO_ERROR(string, format, value, flag) do \ { \ + VMS_BUG (value = 0); \ if (fscanf (portable_file, format, &(value)) == EOF) \ { \ (flag) = (false); \ @@ -1072,6 +1084,7 @@ DEFUN (read_c_code_blocks, (nreserved, length, area), #define READ_HEADER(string, format, value) do \ { \ + VMS_BUG (value = 0); \ if (fscanf (portable_file, format, &(value)) == EOF) \ { \ READ_HEADER_FAILURE (string); \ diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c index 415b0bc62..44c007469 100644 --- a/v7/src/microcode/purify.c +++ b/v7/src/microcode/purify.c @@ -1,6 +1,6 @@ /* -*-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 @@ -184,12 +184,12 @@ DEFUN (purifyloop, (Scan, To_Pointer, GC_Mode), 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; @@ -233,10 +233,11 @@ DEFUN (purifyloop, (Scan, To_Pointer, GC_Mode), 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); } diff --git a/v8/src/microcode/bintopsb.c b/v8/src/microcode/bintopsb.c index 980f62722..ad457d92a 100644 --- a/v8/src/microcode/bintopsb.c +++ b/v8/src/microcode/bintopsb.c @@ -1,6 +1,6 @@ /* -*-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 @@ -986,8 +986,8 @@ DEFUN (address_in_pure_space, (addr), SCHEME_OBJECT * addr) { \ 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); \ diff --git a/v8/src/microcode/psbtobin.c b/v8/src/microcode/psbtobin.c index 5c2cb3a2a..f850e58ce 100644 --- a/v8/src/microcode/psbtobin.c +++ b/v8/src/microcode/psbtobin.c @@ -1,6 +1,6 @@ /* -*-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 @@ -91,6 +91,49 @@ DEFUN (Write_Data, (Count, From_Where), #ifndef MAKE_LINKAGE_SECTION_HEADER #define MAKE_LINKAGE_SECTION_HEADER(kind,count) 0 +#endif + +/* + 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 static void @@ -117,9 +160,8 @@ DEFUN_VOID (read_a_char) C = getc (portable_file); if (C != '\\') - { OUT (C); - } + C = getc (portable_file); switch (C) { @@ -141,6 +183,7 @@ DEFUN_VOID (read_a_char) "%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); @@ -155,6 +198,7 @@ DEFUN (read_a_char_pointer, (to), SCHEME_OBJECT * to) long len, maxlen; char * str; + VMS_BUG (len = 0); fscanf (portable_file, "%ld", &len); maxlen = (len + 1); /* null terminated */ @@ -176,6 +220,7 @@ DEFUN (read_a_string_internal, (To, maxlen), fast long len; str = ((char *) (&To[STRING_CHARS])); + VMS_BUG (ilen = 0); fscanf (portable_file, "%ld", &ilen); len = ilen; @@ -207,52 +252,11 @@ DEFUN (read_a_string, (To, Slot), 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)); } -/* - 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 - static SCHEME_OBJECT * DEFUN (read_an_integer, (The_Type, To, Slot), int The_Type AND SCHEME_OBJECT * To AND SCHEME_OBJECT * Slot) @@ -264,6 +268,7 @@ DEFUN (read_an_integer, (The_Type, To, Slot), negative = ((getc (portable_file)) == '-'); { long l; + VMS_BUG (l = 0); fscanf (portable_file, "%ld", (&l)); length_in_bits = l; } @@ -393,6 +398,7 @@ DEFUN (read_a_bit_string, (To, Slot), 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))); @@ -576,6 +582,7 @@ DEFUN (Read_External, (N, Table, To), while (Table < Until) { + VMS_BUG (The_Type = 0); fscanf (portable_file, "%2x", &The_Type); switch (The_Type) { @@ -866,6 +873,8 @@ DEFUN (Read_Pointers_and_Relocate, (how_many, to), 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) @@ -1028,6 +1037,7 @@ DEFUN (read_primitives, (how_many, where), while (--how_many >= 0) { + VMS_BUG (arity = 0); fscanf (portable_file, "%ld", &arity); if (arity == ((long) UNKNOWN_PRIMITIVE_ARITY)) primitive_warn = true; @@ -1048,6 +1058,7 @@ DEFUN (read_c_code_blocks, (nreserved, length, area), { long nentries; + VMS_BUG (nentries = 0); fscanf (portable_file, "%ld", &nentries); *area++ = (LONG_TO_FIXNUM (nentries)); area = (read_a_char_pointer (area)); @@ -1058,6 +1069,7 @@ DEFUN (read_c_code_blocks, (nreserved, length, area), #define READ_HEADER_NO_ERROR(string, format, value, flag) do \ { \ + VMS_BUG (value = 0); \ if (fscanf (portable_file, format, &(value)) == EOF) \ { \ (flag) = (false); \ @@ -1072,6 +1084,7 @@ DEFUN (read_c_code_blocks, (nreserved, length, area), #define READ_HEADER(string, format, value) do \ { \ + VMS_BUG (value = 0); \ if (fscanf (portable_file, format, &(value)) == EOF) \ { \ READ_HEADER_FAILURE (string); \ -- 2.25.1