From: Chris Hanson Date: Mon, 15 Aug 1988 20:58:52 +0000 (+0000) Subject: Change definition of `DEFINE_PRIMITIVE' macro to include extra fields X-Git-Tag: 20090517-FFI~12614 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c9c5ad9875667720a3357cdde4828555418ec580;p=mit-scheme.git Change definition of `DEFINE_PRIMITIVE' macro to include extra fields for minimum number of arguments and documentation. Add primitive to access the documentation string. The min args slot is currently unused. Change all definitions of primitives to use this macro. The documentation strings should be filled in as time permits. Partially update "sample.c" to reflect this. More work remains to be done. Update "Findprim.c" substantially, to handle these changes. Also change all fixed size tables to be dynamically allocated. Define new macros `EMPTY_LIST', `SHARP_F' and `SHARP_T'. All references to `TRUTH' replaced by `SHARP_T'. Some references to `NIL' changed to the appropriate macro, but many more remain; these should be replaced as time permits. Update several copyright notices to reflect new year. Change name of "primitive.h" to "prims.h". --- diff --git a/v7/src/microcode/bltdef.h b/v7/src/microcode/bltdef.h index 96af84142..52f7cf009 100644 --- a/v7/src/microcode/bltdef.h +++ b/v7/src/microcode/bltdef.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bltdef.h,v 1.1 1987/11/17 07:56:57 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bltdef.h,v 1.2 1988/08/15 20:42:54 cph Rel $ * * Names and arity's of old "built-in" primitives. * The tables here are used by Bintopsb to upgrade binaries. diff --git a/v7/src/microcode/boot.c b/v7/src/microcode/boot.c index 28c2b15d6..566cc49e9 100644 --- a/v7/src/microcode/boot.c +++ b/v7/src/microcode/boot.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.49 1988/07/21 18:41:36 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.50 1988/08/15 20:43:04 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -80,7 +80,7 @@ for details. They are created by defining a macro Command_Line_Args. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "version.h" #include "char.h" #include "string.h" @@ -400,7 +400,7 @@ make_fixed_objects_vector() User_Vector_Set(fixed_objects_vector, OBArray, OB_Array); User_Vector_Set(fixed_objects_vector, Dummy_History, Make_Pointer(UNMARKED_HISTORY_TYPE, Dummy_Hist)); - User_Vector_Set(fixed_objects_vector, State_Space_Tag, TRUTH); + User_Vector_Set(fixed_objects_vector, State_Space_Tag, SHARP_T); User_Vector_Set(fixed_objects_vector, Bignum_One, Fix_To_Big(Make_Unsigned_Fixnum(1))); User_Vector_Set(fixed_objects_vector, Me_Myself, fixed_objects_vector); @@ -703,7 +703,7 @@ gc_death(code, message, scan, free) #define STACK_TYPE_STRING "standard" #endif -DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_Microcode_Identify, 0) +DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_microcode_identify, 0, 0, 0) { extern Pointer make_vector (); fast Pointer Result; @@ -736,7 +736,7 @@ DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_Microcode_Identify, 0) PRIMITIVE_RETURN (Result); } -DEFINE_PRIMITIVE ("MICROCODE-TABLES-FILENAME", Prim_Microcode_Tables_Filename, 0) +DEFINE_PRIMITIVE ("MICROCODE-TABLES-FILENAME", Prim_microcode_tables_filename, 0, 0, 0) { fast char *From, *To; char *Prefix, *Suffix; @@ -781,7 +781,7 @@ DEFINE_PRIMITIVE ("MICROCODE-TABLES-FILENAME", Prim_Microcode_Tables_Filename, 0 PRIMITIVE_RETURN (Result); } -DEFINE_PRIMITIVE ("GET-COMMAND-LINE", Prim_Get_Command_Line, 0) +DEFINE_PRIMITIVE ("GET-COMMAND-LINE", Prim_get_command_line, 0, 0, 0) { fast int i; fast Pointer result; diff --git a/v7/src/microcode/char.c b/v7/src/microcode/char.c index 92fecc917..c4392256d 100644 --- a/v7/src/microcode/char.c +++ b/v7/src/microcode/char.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,12 +30,12 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.25 1988/04/27 18:26:12 mhwu Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.26 1988/08/15 20:43:16 cph Rel $ */ /* Character primitives. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "char.h" #include @@ -69,7 +69,7 @@ arg_ascii_integer (n) return (ascii); } -DEFINE_PRIMITIVE ("MAKE-CHAR", Prim_Make_Char, 2) +DEFINE_PRIMITIVE ("MAKE-CHAR", Prim_make_char, 2, 2, 0) { long bucky_bits, code; PRIMITIVE_HEADER (2); @@ -79,7 +79,7 @@ DEFINE_PRIMITIVE ("MAKE-CHAR", Prim_Make_Char, 2) PRIMITIVE_RETURN (make_char (bucky_bits, code)); } -DEFINE_PRIMITIVE ("CHAR-BITS", Prim_Char_Bits, 1) +DEFINE_PRIMITIVE ("CHAR-BITS", Prim_char_bits, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -87,7 +87,7 @@ DEFINE_PRIMITIVE ("CHAR-BITS", Prim_Char_Bits, 1) PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (char_bits (ARG_REF (1)))); } -DEFINE_PRIMITIVE ("CHAR-CODE", Prim_Char_Code, 1) +DEFINE_PRIMITIVE ("CHAR-CODE", Prim_char_code, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -95,7 +95,7 @@ DEFINE_PRIMITIVE ("CHAR-CODE", Prim_Char_Code, 1) PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (char_code (ARG_REF (1)))); } -DEFINE_PRIMITIVE ("CHAR->INTEGER", Prim_Char_To_Integer, 1) +DEFINE_PRIMITIVE ("CHAR->INTEGER", Prim_char_to_integer, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -103,7 +103,7 @@ DEFINE_PRIMITIVE ("CHAR->INTEGER", Prim_Char_To_Integer, 1) PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM ((ARG_REF (1)) & MASK_EXTNDD_CHAR)); } -DEFINE_PRIMITIVE ("INTEGER->CHAR", Prim_Integer_To_Char, 1) +DEFINE_PRIMITIVE ("INTEGER->CHAR", Prim_integer_to_char, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -128,7 +128,7 @@ char_upcase (c) return ((islower (c)) ? ((c - 'a') + 'A') : c); } -DEFINE_PRIMITIVE ("CHAR-DOWNCASE", Prim_Char_Downcase, 1) +DEFINE_PRIMITIVE ("CHAR-DOWNCASE", Prim_char_downcase, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -138,7 +138,7 @@ DEFINE_PRIMITIVE ("CHAR-DOWNCASE", Prim_Char_Downcase, 1) (char_downcase (char_code (ARG_REF (1)))))); } -DEFINE_PRIMITIVE ("CHAR-UPCASE", Prim_Char_Upcase, 1) +DEFINE_PRIMITIVE ("CHAR-UPCASE", Prim_char_upcase, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -148,21 +148,21 @@ DEFINE_PRIMITIVE ("CHAR-UPCASE", Prim_Char_Upcase, 1) (char_upcase (char_code (ARG_REF (1)))))); } -DEFINE_PRIMITIVE ("ASCII->CHAR", Prim_Ascii_To_Char, 1) +DEFINE_PRIMITIVE ("ASCII->CHAR", Prim_ascii_to_char, 1, 1, 0) { PRIMITIVE_HEADER (1); PRIMITIVE_RETURN (c_char_to_scheme_char (arg_ascii_integer (1))); } -DEFINE_PRIMITIVE ("CHAR->ASCII", Prim_Char_To_Ascii, 1) +DEFINE_PRIMITIVE ("CHAR->ASCII", Prim_char_to_ascii, 1, 1, 0) { PRIMITIVE_HEADER (1); PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (arg_ascii_char (1))); } -DEFINE_PRIMITIVE ("CHAR-ASCII?", Prim_Char_Ascii_P, 1) +DEFINE_PRIMITIVE ("CHAR-ASCII?", Prim_char_ascii_p, 1, 1, 0) { fast Pointer character; PRIMITIVE_HEADER (1); diff --git a/v7/src/microcode/cmpint.h b/v7/src/microcode/cmpint.h index fa97732d8..6a2928d43 100644 --- a/v7/src/microcode/cmpint.h +++ b/v7/src/microcode/cmpint.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpint.h,v 10.1 1987/10/09 18:47:01 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpint.h,v 10.2 1988/08/15 20:43:41 cph Rel $ * * Macros for the interface between compiled code and interpreted code. * diff --git a/v7/src/microcode/comlin.h b/v7/src/microcode/comlin.h index 7f4fc60dc..8ce543265 100644 --- a/v7/src/microcode/comlin.h +++ b/v7/src/microcode/comlin.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comlin.h,v 1.1 1988/02/10 16:06:31 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comlin.h,v 1.2 1988/08/15 20:43:59 cph Rel $ * * This file contains definitions for the scheme command parser. * diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c index 89a0d4330..609c9cfec 100644 --- a/v7/src/microcode/comutl.c +++ b/v7/src/microcode/comutl.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.12 1988/03/21 21:15:35 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.13 1988/08/15 20:44:15 cph Exp $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -35,7 +35,7 @@ MIT in each case. */ /* Compiled Code Utilities */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" extern Pointer *compiled_entry_to_block_address(); @@ -50,8 +50,7 @@ extern void #define COMPILED_CODE_ADDRESS_P(object) \ ((OBJECT_TYPE (object)) == TC_COMPILED_ENTRY) -DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", - Prim_comp_code_address_block, 1) +DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", Prim_comp_code_address_block, 1, 1, 0) { Pointer *address; Primitive_1_Arg (); @@ -61,8 +60,7 @@ DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", PRIMITIVE_RETURN (Make_Pointer (TC_COMPILED_CODE_BLOCK, address)); } -DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->OFFSET", - Prim_comp_code_address_offset, 1) +DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->OFFSET", Prim_comp_code_address_offset, 1, 1, 0) { long offset; Primitive_1_Arg (); @@ -82,14 +80,14 @@ DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->OFFSET", #define STACK_TOP_TO_DATUM() (((long) Stack_Top) & ADDRESS_MASK) -DEFINE_PRIMITIVE("STACK-TOP-ADDRESS", Prim_Stack_Top_Address, 0) +DEFINE_PRIMITIVE ("STACK-TOP-ADDRESS", Prim_stack_top_address, 0, 0, 0) { Primitive_0_Args(); PRIMITIVE_RETURN (MAKE_SIGNED_FIXNUM(STACK_TOP_TO_DATUM())); } -DEFINE_PRIMITIVE("COMPILED-ENTRY-KIND", Prim_Compiled_Entry_Type, 1) +DEFINE_PRIMITIVE ("COMPILED-ENTRY-KIND", Prim_compiled_entry_type, 1, 1, 0) { fast Pointer *temp; Pointer result; @@ -107,7 +105,7 @@ DEFINE_PRIMITIVE("COMPILED-ENTRY-KIND", Prim_Compiled_Entry_Type, 1) PRIMITIVE_RETURN (Make_Pointer(TC_HUNK3, temp)); } -DEFINE_PRIMITIVE("COERCE-TO-COMPILED-PROCEDURE", Prim_Coerce_To_Closure, 2) +DEFINE_PRIMITIVE ("COERCE-TO-COMPILED-PROCEDURE", Prim_coerce_to_closure, 2, 2, 0) { Pointer temp; long value, result; diff --git a/v7/src/microcode/config.h b/v7/src/microcode/config.h index adf0996d4..d58ded715 100644 --- a/v7/src/microcode/config.h +++ b/v7/src/microcode/config.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.37 1988/07/21 18:45:55 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.38 1988/08/15 20:44:24 cph Exp $ * * This file contains the configuration information and the information * given on the command line on Unix. diff --git a/v7/src/microcode/const.h b/v7/src/microcode/const.h index 11e6be05b..5d129bc2c 100644 --- a/v7/src/microcode/const.h +++ b/v7/src/microcode/const.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.28 1988/03/12 16:04:43 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.29 1988/08/15 20:44:34 cph Exp $ * * Named constants used throughout the interpreter * @@ -48,18 +48,21 @@ MIT in each case. */ /* Precomputed typed pointers */ #ifndef b32 /* Safe version */ -#define NIL Make_Non_Pointer(TC_NULL, 0) -#define TRUTH Make_Non_Pointer(TC_TRUE, 0) +#define SHARP_F Make_Non_Pointer(TC_NULL, 0) +#define SHARP_T Make_Non_Pointer(TC_TRUE, 0) #define FIXNUM_ZERO Make_Non_Pointer(TC_FIXNUM, 0) #define BROKEN_HEART_ZERO Make_Non_Pointer(TC_BROKEN_HEART, 0) #else /* 32 bit word */ -#define NIL 0x00000000 -#define TRUTH 0x08000000 +#define SHARP_F 0x00000000 +#define SHARP_T 0x08000000 #define FIXNUM_ZERO 0x1A000000 #define BROKEN_HEART_ZERO 0x22000000 #endif /* b32 */ +#define EMPTY_LIST SHARP_F +#define NIL SHARP_F +#define TRUTH SHARP_T #define NOT_THERE -1 /* Command line parser */ /* Assorted sizes used in various places */ diff --git a/v7/src/microcode/daemon.c b/v7/src/microcode/daemon.c index 2def3dc06..baf9fafbd 100644 --- a/v7/src/microcode/daemon.c +++ b/v7/src/microcode/daemon.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/daemon.c,v 9.25 1987/11/17 08:08:45 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/daemon.c,v 9.26 1988/08/15 20:44:42 cph Rel $ This file contains code for the Garbage Collection daemons. There are currently two daemons, one for closing files which @@ -45,7 +45,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* (CLOSE-LOST-OPEN-FILES file-list) file-list is an assq-like list where the associations are weak @@ -55,15 +55,14 @@ MIT in each case. */ the runtime system for a longer description. */ -Built_In_Primitive(Prim_Close_Lost_Open_Files, 1, "CLOSE-LOST-OPEN-FILES", 0xC7) -Define_Primitive(Prim_Close_Lost_Open_Files, 1, "CLOSE-LOST-OPEN-FILES") +DEFINE_PRIMITIVE ("CLOSE-LOST-OPEN-FILES", Prim_close_lost_open_files, 1, 1, 0) { extern Boolean OS_file_close(); fast Pointer *Smash, Cell, Weak_Cell, Value; long channel_number; Primitive_1_Arg(); - Value = TRUTH; + Value = SHARP_T; for (Smash = Nth_Vector_Loc(Arg1, CONS_CDR), Cell = *Smash; Cell != NIL; @@ -150,8 +149,7 @@ long table_size; See hash.scm in the runtime system for a description. */ -Built_In_Primitive(Prim_Rehash, 2, "REHASH", 0x5C) -Define_Primitive(Prim_Rehash, 2, "REHASH") +DEFINE_PRIMITIVE ("REHASH", Prim_rehash, 2, 2, 0) { long table_size, counter; Pointer *bucket; @@ -170,11 +168,11 @@ Define_Primitive(Prim_Rehash, 2, "REHASH") for (counter = table_size, bucket = Nth_Vector_Loc(Arg1, 1); --counter >= 0; bucket += 1) - { if (Fast_Vector_Ref(*bucket, CONS_CAR) == TRUTH) + { if (Fast_Vector_Ref(*bucket, CONS_CAR) == SHARP_T) splice_and_rehash_bucket(Nth_Vector_Loc(*bucket, CONS_CDR), Arg2, table_size); else rehash_bucket(Nth_Vector_Loc(*bucket, CONS_CDR), Arg2, table_size); } - return TRUTH; + return SHARP_T; } diff --git a/v7/src/microcode/debug.c b/v7/src/microcode/debug.c index b65d0a9cb..f078d51c1 100644 --- a/v7/src/microcode/debug.c +++ b/v7/src/microcode/debug.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,13 +30,13 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/debug.c,v 9.28 1988/02/12 16:50:19 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/debug.c,v 9.29 1988/08/15 20:44:50 cph Exp $ * * Utilities to help with debugging */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "trap.h" #include "lookup.h" @@ -645,13 +645,12 @@ Debug_Printer(Expr) A cheap, built-in printer intended for debugging the interpreter. */ -Built_In_Primitive(Prim_Temp_Printer, 1, "DEBUGGING-PRINTER", 0xB2) -Define_Primitive(Prim_Temp_Printer, 1, "DEBUGGING-PRINTER") +DEFINE_PRIMITIVE ("DEBUGGING-PRINTER", Prim_temp_printer, 1, 1, 0) { Primitive_1_Arg(); Debug_Printer(Arg1); - return TRUTH; + return SHARP_T; } /* Code for interactively setting and clearing the interpreter diff --git a/v7/src/microcode/dmpwrld.c b/v7/src/microcode/dmpwrld.c index 6dfb17168..e3e9c1bea 100644 --- a/v7/src/microcode/dmpwrld.c +++ b/v7/src/microcode/dmpwrld.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.26 1987/12/04 22:15:25 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.27 1988/08/15 20:45:01 cph Exp $ * * This file contains a primitive to dump an executable version of Scheme. * It uses unexec.c from GNU Emacs. @@ -38,7 +38,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #ifndef unix #include "Error: dumpworld.c does not work on non-unix machines." @@ -181,7 +181,7 @@ Restore_Input_Buffer(Buflen) extern Boolean Was_Scheme_Dumped; extern unix_find_pathname(); -DEFINE_PRIMITIVE ("DUMP-WORLD", Prim_Dump_World, 1) +DEFINE_PRIMITIVE ("DUMP-WORLD", Prim_dump_world, 1, 1, 0) { char *fname, path_buffer[FILE_NAME_LENGTH]; Boolean Saved_Dumped_Value, Saved_Photo_Open; @@ -217,7 +217,7 @@ DEFINE_PRIMITIVE ("DUMP-WORLD", Prim_Dump_World, 1) Buflen = Save_Input_Buffer(); Was_Scheme_Dumped = true; - Val = TRUTH; + Val = SHARP_T; OS_Quit(); Pop_Primitive_Frame(1); diff --git a/v7/src/microcode/dump.c b/v7/src/microcode/dump.c index b0f61637c..2713a3cf1 100644 --- a/v7/src/microcode/dump.c +++ b/v7/src/microcode/dump.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dump.c,v 9.27 1988/08/09 02:31:26 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dump.c,v 9.28 1988/08/15 20:45:11 cph Rel $ * * This file contains common code for dumping internal format binary files. */ diff --git a/v7/src/microcode/edwin.h b/v7/src/microcode/edwin.h index 5cb9ccf41..255a3f2a7 100644 --- a/v7/src/microcode/edwin.h +++ b/v7/src/microcode/edwin.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/edwin.h,v 1.1 1987/05/11 17:47:53 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/edwin.h,v 1.2 1988/08/15 20:45:21 cph Rel $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and diff --git a/v7/src/microcode/errors.h b/v7/src/microcode/errors.h index 90a8f0908..7a158182a 100644 --- a/v7/src/microcode/errors.h +++ b/v7/src/microcode/errors.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/errors.h,v 9.30 1988/03/12 16:04:57 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/errors.h,v 9.31 1988/08/15 20:45:29 cph Exp $ * * Error and termination code declarations. * diff --git a/v7/src/microcode/extern.c b/v7/src/microcode/extern.c index dce62ed67..5f0b1be24 100644 --- a/v7/src/microcode/extern.c +++ b/v7/src/microcode/extern.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,10 +30,10 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.c,v 9.25 1987/12/04 22:15:47 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.c,v 9.26 1988/08/15 20:45:38 cph Exp $ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* Mapping between the internal and external representations of primitives and return addresses. @@ -48,7 +48,7 @@ MIT in each case. */ actual address in memory. */ -DEFINE_PRIMITIVE("MAP-CODE-TO-MACHINE-ADDRESS", Prim_Map_Code_To_Address, 2) +DEFINE_PRIMITIVE ("MAP-CODE-TO-MACHINE-ADDRESS", Prim_map_code_to_address, 2, 2, 0) { Pointer result; long tc, number; @@ -95,7 +95,7 @@ DEFINE_PRIMITIVE("MAP-CODE-TO-MACHINE-ADDRESS", Prim_Map_Code_To_Address, 2) for the internal address. */ -DEFINE_PRIMITIVE("MAP-MACHINE-ADDRESS-TO-CODE", Prim_Map_Address_To_Code, 2) +DEFINE_PRIMITIVE ("MAP-MACHINE-ADDRESS-TO-CODE", Prim_map_address_to_code, 2, 2, 0) { long tc, number; Primitive_2_Args(); @@ -122,13 +122,10 @@ DEFINE_PRIMITIVE("MAP-MACHINE-ADDRESS-TO-CODE", Prim_Map_Address_To_Code, 2) PRIMITIVE_RETURN(MAKE_UNSIGNED_FIXNUM(number)); } -/* (PRIMITIVE-PROCEDURE-ARITY PRIMITIVE) - Given the internal representation of a primitive (in CScheme the - internal and external representations are the same), return the - number of arguments it requires. -*/ - -DEFINE_PRIMITIVE("PRIMITIVE-PROCEDURE-ARITY", Prim_Map_Prim_Address_To_Arity, 1) +DEFINE_PRIMITIVE ("PRIMITIVE-PROCEDURE-ARITY", Prim_map_prim_address_to_arity, 1, 1, + "Given the internal representation of PRIMITIVE (in CScheme the +internal and external representations are the same), return the +number of arguments it requires.") { extern long primitive_to_arity(); long answer; @@ -143,6 +140,26 @@ DEFINE_PRIMITIVE("PRIMITIVE-PROCEDURE-ARITY", Prim_Map_Prim_Address_To_Arity, 1) answer = primitive_to_arity(Arg1); PRIMITIVE_RETURN(MAKE_SIGNED_FIXNUM(answer)); } + +DEFINE_PRIMITIVE ("PRIMITIVE-PROCEDURE-DOCUMENTATION", Prim_map_prim_address_to_documentation, 1, 1, + "Given the internal representation of PRIMITIVE (in CScheme the +internal and external representations are the same), return the +number of arguments it requires.") +{ + extern char * primitive_to_documentation (); + char * answer; + Primitive_1_Arg (); + + Arg_1_Type (TC_PRIMITIVE); + + if ((PRIMITIVE_NUMBER (Arg1)) >= (NUMBER_OF_PRIMITIVES ())) + error_bad_range_arg (1); + answer = (primitive_to_documentation (Arg1)); + PRIMITIVE_RETURN + ((answer == ((char *) 0)) + ? SHARP_F + : (C_String_To_Scheme_String (answer))); +} /* (GET-PRIMITIVE-COUNTS) Returns a CONS of the number of primitives defined in this @@ -150,7 +167,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-PROCEDURE-ARITY", Prim_Map_Prim_Address_To_Arity, 1) defined. */ -DEFINE_PRIMITIVE("GET-PRIMITIVE-COUNTS", Prim_Get_Primitive_Counts, 0) +DEFINE_PRIMITIVE ("GET-PRIMITIVE-COUNTS", Prim_get_primitive_counts, 0, 0, 0) { Primitive_0_Args(); @@ -164,7 +181,7 @@ DEFINE_PRIMITIVE("GET-PRIMITIVE-COUNTS", Prim_Get_Primitive_Counts, 0) primitive procedure. It causes an error if the number is out of range. */ -DEFINE_PRIMITIVE("GET-PRIMITIVE-NAME", Prim_Get_Primitive_Name, 1) +DEFINE_PRIMITIVE ("GET-PRIMITIVE-NAME", Prim_get_primitive_name, 1, 1, 0) { extern Pointer primitive_name(); long Number, TC; @@ -193,7 +210,7 @@ DEFINE_PRIMITIVE("GET-PRIMITIVE-NAME", Prim_Get_Primitive_Name, 1) whether the corresponding primitive is implemented or not. */ -DEFINE_PRIMITIVE("GET-PRIMITIVE-ADDRESS", Prim_Get_Primitive_Address, 2) +DEFINE_PRIMITIVE ("GET-PRIMITIVE-ADDRESS", Prim_get_primitive_address, 2, 2, 0) { extern Pointer find_primitive(); Boolean intern_p, allow_p; @@ -208,7 +225,7 @@ DEFINE_PRIMITIVE("GET-PRIMITIVE-ADDRESS", Prim_Get_Primitive_Address, 2) intern_p = false; arity = UNKNOWN_PRIMITIVE_ARITY; } - else if (Arg2 == TRUTH) + else if (Arg2 == SHARP_T) { allow_p = true; intern_p = false; diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h index a22fed956..41ab326bf 100644 --- a/v7/src/microcode/extern.h +++ b/v7/src/microcode/extern.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.29 1987/12/13 21:23:29 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.30 1988/08/15 20:45:47 cph Exp $ * * External declarations. * diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index 1041bbb28..067944d3c 100644 --- a/v7/src/microcode/fasdump.c +++ b/v7/src/microcode/fasdump.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,13 +30,13 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.39 1988/05/10 18:12:45 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.40 1988/08/15 20:45:56 cph Exp $ This file contains code for fasdump and dump-band. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #define In_Fasdump #include "gccode.h" #include "trap.h" @@ -338,7 +338,7 @@ Fasdump_Exit(code) } if (code == PRIM_DONE) { - return (TRUTH); + return (SHARP_T); } else if (code == PRIM_INTERRUPT) { @@ -365,7 +365,7 @@ Fasdump_Exit(code) The code for dumping pure is severely broken and conditionalized out. */ -DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) +DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0) { Pointer Object, File_Name, Flag, *New_Object; Pointer *table_start, *table_end; @@ -385,7 +385,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) Primitive_Error(ERR_ARG_2_BAD_RANGE); } #if false - if ((Flag != NIL) && (Flag != TRUTH)) + if ((Flag != NIL) && (Flag != SHARP_T)) #else if (Flag != NIL) #endif /* false */ @@ -421,7 +421,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) segment. See fasload.c for further information. */ - if (Flag == TRUTH) + if (Flag == SHARP_T) { Pointer *Addr_Of_New_Object; @@ -487,7 +487,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) argument of NIL. */ -DEFINE_PRIMITIVE("DUMP-BAND", Prim_Band_Dump, 2) +DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0) { Pointer Combination, *table_start, *table_end, *saved_free; long table_length; @@ -552,5 +552,5 @@ DEFINE_PRIMITIVE("DUMP-BAND", Prim_Band_Dump, 2) result = (Close_Dump_File() && result); Band_Dump_Exit_Hook(); Free = saved_free; - PRIMITIVE_RETURN(result ? TRUTH : NIL); + PRIMITIVE_RETURN(result ? SHARP_T : NIL); } diff --git a/v7/src/microcode/fasl.h b/v7/src/microcode/fasl.h index a533ed7ef..0d32eaa40 100644 --- a/v7/src/microcode/fasl.h +++ b/v7/src/microcode/fasl.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasl.h,v 9.28 1988/04/25 15:43:08 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasl.h,v 9.29 1988/08/15 20:46:07 cph Rel $ Contains information relating to the format of FASL files. The machine/opsys information is contained in config.h diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 474389a5b..6ea3b2437 100644 --- a/v7/src/microcode/fasload.c +++ b/v7/src/microcode/fasload.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.36 1988/03/21 21:16:04 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.37 1988/08/15 20:46:15 cph Exp $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character @@ -39,7 +39,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "gccode.h" #include "trap.h" #include "load.c" @@ -566,7 +566,7 @@ load_file(from_band_load) definitions in some environment. */ -DEFINE_PRIMITIVE("BINARY-FASLOAD", Prim_Binary_Fasload, 1) +DEFINE_PRIMITIVE ("BINARY-FASLOAD", Prim_binary_fasload, 1, 1, 0) { long result; Primitive_1_Arg(); @@ -600,7 +600,7 @@ static char *reload_band_name = ((char *) NULL); was band loaded (load-band'ed ?), or NIL if the system was fasl'ed. */ -DEFINE_PRIMITIVE("RELOAD-BAND-NAME", Prim_reload_band_name, 0) +DEFINE_PRIMITIVE ("RELOAD-BAND-NAME", Prim_reload_band_name, 0, 0, 0) { Primitive_0_Args(); @@ -632,7 +632,7 @@ compiler_reset_error() however, be any file which can be loaded with BINARY-FASLOAD. */ -DEFINE_PRIMITIVE("LOAD-BAND", Prim_Band_Load, 1) +DEFINE_PRIMITIVE ("LOAD-BAND", Prim_band_load, 1, 1, 0) { extern char *malloc(); extern strcpy(), free(); diff --git a/v7/src/microcode/fft.c b/v7/src/microcode/fft.c index f33cfb251..8a26a482a 100644 --- a/v7/src/microcode/fft.c +++ b/v7/src/microcode/fft.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fft.c,v 9.23 1988/01/07 21:32:15 pas Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fft.c,v 9.24 1988/08/15 20:46:29 cph Exp $ */ /* Fourier Transforms (pas) 1. DFT (FFT), @@ -39,7 +39,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "flonum.h" #include "zones.h" #include @@ -456,7 +456,7 @@ Cube_Space_3D_FFT_In_Scheme_Heap(flag, ndeps, Real_Array, Imag_Array) Arg1=1 --> forward FFT, otherwise backward. */ -Define_Primitive(Prim_Array_FFT, 3, "ARRAY-FFT!") +DEFINE_PRIMITIVE ("ARRAY-FFT!", Prim_array_fft, 3, 3, 0) { long length, power, flag, i; Pointer answer; REAL *f1,*f2,*g1,*g2,*w1,*w2; @@ -498,7 +498,7 @@ Define_Primitive(Prim_Array_FFT, 3, "ARRAY-FFT!") return answer; } -Define_Primitive(Prim_Array_CZT, 5, "ARRAY-CZT") +DEFINE_PRIMITIVE ("ARRAY-CZT", Prim_array_czt, 5, 5, 0) { double phi,rho; long N,M,L; long log2_L,maxMN,smallest_power_of_2_ge(), allocated_cells; @@ -559,7 +559,7 @@ Define_Primitive(Prim_Array_CZT, 5, "ARRAY-CZT") return answer; } -Define_Primitive(Prim_Array_2D_FFT, 5, "ARRAY-2D-FFT!") +DEFINE_PRIMITIVE ("ARRAY-2D-FFT!", Prim_array_2d_fft, 5, 5, 0) { long flag; Pointer answer; REAL *Real_Array, *Imag_Array; @@ -593,7 +593,7 @@ Define_Primitive(Prim_Array_2D_FFT, 5, "ARRAY-2D-FFT!") return answer; } -Define_Primitive(Prim_Array_3D_FFT, 6, "ARRAY-3D-FFT!") +DEFINE_PRIMITIVE ("ARRAY-3D-FFT!", Prim_array_3d_fft, 6, 6, 0) { long flag; Pointer answer; REAL *Real_Array, *Imag_Array; diff --git a/v7/src/microcode/fhooks.c b/v7/src/microcode/fhooks.c index 33b9b0fcf..fcbfa01ac 100644 --- a/v7/src/microcode/fhooks.c +++ b/v7/src/microcode/fhooks.c @@ -30,14 +30,14 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fhooks.c,v 9.27 1988/05/10 15:15:43 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fhooks.c,v 9.28 1988/08/15 20:46:39 cph Exp $ * * This file contains hooks and handles for the new fluid bindings * scheme for multiprocessors. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "trap.h" #include "lookup.h" #include "locks.h" @@ -46,7 +46,7 @@ MIT in each case. */ Executes THUNK, then restores the previous fluid bindings. */ -Define_Primitive(Prim_With_Saved_Fluid_Bindings,1,"WITH-SAVED-FLUID-BINDINGS") +DEFINE_PRIMITIVE ("WITH-SAVED-FLUID-BINDINGS", Prim_with_saved_fluid_bindings, 1, 1, 0) { Primitive_1_Arg(); @@ -199,7 +199,7 @@ new_fluid_binding_restart: value is created in this interpreter's fluid bindings. */ -Define_Primitive(Prim_Add_Fluid_Binding, 3, "ADD-FLUID-BINDING!") +DEFINE_PRIMITIVE ("ADD-FLUID-BINDING!", Prim_add_fluid_binding, 3, 3, 0) { Pointer *cell; Primitive_3_Args(); @@ -238,7 +238,7 @@ Define_Primitive(Prim_Add_Fluid_Binding, 3, "ADD-FLUID-BINDING!") binding must be established in the last frame. */ -Define_Primitive(Prim_Make_Fluid_Binding, 3, "MAKE-FLUID-BINDING!") +DEFINE_PRIMITIVE ("MAKE-FLUID-BINDING!", Prim_make_fluid_binding, 3, 3, 0) { extern Pointer *force_definition(); Pointer *cell; diff --git a/v7/src/microcode/fixnum.c b/v7/src/microcode/fixnum.c index b6f485c98..0dc5f2961 100644 --- a/v7/src/microcode/fixnum.c +++ b/v7/src/microcode/fixnum.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixnum.c,v 9.25 1987/11/17 08:11:05 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixnum.c,v 9.26 1988/08/15 20:46:58 cph Exp $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -38,7 +38,7 @@ MIT in each case. */ that will eventually go away. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #define FIXNUM_PRIMITIVE_1(parameter_1) \ fast long parameter_1; \ @@ -60,47 +60,41 @@ MIT in each case. */ return (Make_Signed_Fixnum (fixnum)); #define BOOLEAN_RESULT(x) \ - return ((x) ? TRUTH : NIL) + return ((x) ? SHARP_T : NIL) /* Predicates */ -Built_In_Primitive (Prim_Zero_Fixnum, 1, "ZERO-FIXNUM?", 0x46) -Define_Primitive (Prim_Zero_Fixnum, 1, "ZERO-FIXNUM?") +DEFINE_PRIMITIVE ("ZERO-FIXNUM?", Prim_zero_fixnum, 1, 1, 0) { FIXNUM_PRIMITIVE_1 (x); BOOLEAN_RESULT ((Get_Integer (Arg1)) == 0); } -Built_In_Primitive (Prim_Negative_Fixnum, 1, "NEGATIVE-FIXNUM?", 0x7F) -Define_Primitive (Prim_Negative_Fixnum, 1, "NEGATIVE-FIXNUM?") +DEFINE_PRIMITIVE ("NEGATIVE-FIXNUM?", Prim_negative_fixnum, 1, 1, 0) { FIXNUM_PRIMITIVE_1 (x); BOOLEAN_RESULT (x < 0); } -Built_In_Primitive (Prim_Positive_Fixnum, 1, "POSITIVE-FIXNUM?", 0x41) -Define_Primitive (Prim_Positive_Fixnum, 1, "POSITIVE-FIXNUM?") +DEFINE_PRIMITIVE ("POSITIVE-FIXNUM?", Prim_positive_fixnum, 1, 1, 0) { FIXNUM_PRIMITIVE_1 (x); BOOLEAN_RESULT (x > 0); } -Built_In_Primitive (Prim_Equal_Fixnum, 2, "EQUAL-FIXNUM?", 0x3F) -Define_Primitive (Prim_Equal_Fixnum, 2, "EQUAL-FIXNUM?") +DEFINE_PRIMITIVE ("EQUAL-FIXNUM?", Prim_equal_fixnum, 2, 2, 0) { FIXNUM_PRIMITIVE_2 (x, y); BOOLEAN_RESULT (x == y); } -Built_In_Primitive (Prim_Less_Fixnum, 2, "LESS-THAN-FIXNUM?", 0x40) -Define_Primitive (Prim_Less_Fixnum, 2, "LESS-THAN-FIXNUM?") +DEFINE_PRIMITIVE ("LESS-THAN-FIXNUM?", Prim_less_fixnum, 2, 2, 0) { FIXNUM_PRIMITIVE_2 (x, y); BOOLEAN_RESULT (x < y); } -Built_In_Primitive (Prim_Greater_Fixnum, 2, "GREATER-THAN-FIXNUM?", 0x81) -Define_Primitive (Prim_Greater_Fixnum, 2, "GREATER-THAN-FIXNUM?") +DEFINE_PRIMITIVE ("GREATER-THAN-FIXNUM?", Prim_greater_fixnum, 2, 2, 0) { FIXNUM_PRIMITIVE_2 (x, y); BOOLEAN_RESULT (x > y); @@ -108,8 +102,7 @@ Define_Primitive (Prim_Greater_Fixnum, 2, "GREATER-THAN-FIXNUM?") /* Operators */ -Built_In_Primitive (Prim_One_Plus_Fixnum, 1, "ONE-PLUS-FIXNUM", 0x42) -Define_Primitive (Prim_One_Plus_Fixnum, 1, "ONE-PLUS-FIXNUM") +DEFINE_PRIMITIVE ("ONE-PLUS-FIXNUM", Prim_one_plus_fixnum, 1, 1, 0) { fast long result; FIXNUM_PRIMITIVE_1 (x); @@ -117,8 +110,7 @@ Define_Primitive (Prim_One_Plus_Fixnum, 1, "ONE-PLUS-FIXNUM") FIXNUM_RESULT (result); } -Built_In_Primitive (Prim_M_1_Plus_Fixnum, 1, "MINUS-ONE-PLUS-FIXNUM", 0x43) -Define_Primitive (Prim_M_1_Plus_Fixnum, 1, "MINUS-ONE-PLUS-FIXNUM") +DEFINE_PRIMITIVE ("MINUS-ONE-PLUS-FIXNUM", Prim_m_1_plus_fixnum, 1, 1, 0) { fast long result; FIXNUM_PRIMITIVE_1 (x); @@ -126,8 +118,7 @@ Define_Primitive (Prim_M_1_Plus_Fixnum, 1, "MINUS-ONE-PLUS-FIXNUM") FIXNUM_RESULT (result); } -Built_In_Primitive (Prim_Plus_Fixnum, 2, "PLUS-FIXNUM", 0x3B) -Define_Primitive (Prim_Plus_Fixnum, 2, "PLUS-FIXNUM") +DEFINE_PRIMITIVE ("PLUS-FIXNUM", Prim_plus_fixnum, 2, 2, 0) { fast long result; FIXNUM_PRIMITIVE_2 (x, y); @@ -135,8 +126,7 @@ Define_Primitive (Prim_Plus_Fixnum, 2, "PLUS-FIXNUM") FIXNUM_RESULT (result); } -Built_In_Primitive (Prim_Minus_Fixnum, 2, "MINUS-FIXNUM", 0x3C) -Define_Primitive (Prim_Minus_Fixnum, 2, "MINUS-FIXNUM") +DEFINE_PRIMITIVE ("MINUS-FIXNUM", Prim_minus_fixnum, 2, 2, 0) { fast long result; FIXNUM_PRIMITIVE_2 (x, y); @@ -144,8 +134,7 @@ Define_Primitive (Prim_Minus_Fixnum, 2, "MINUS-FIXNUM") FIXNUM_RESULT (result); } -Built_In_Primitive (Prim_Multiply_Fixnum, 2, "MULTIPLY-FIXNUM", 0x3D) -Define_Primitive (Prim_Multiply_Fixnum, 2, "MULTIPLY-FIXNUM") +DEFINE_PRIMITIVE ("MULTIPLY-FIXNUM", Prim_multiply_fixnum, 2, 2, 0) { /* Mul, which does the multiplication with overflow handling, is customized for some machines. Therefore, it is in os.c */ @@ -161,8 +150,7 @@ Define_Primitive (Prim_Multiply_Fixnum, 2, "MULTIPLY-FIXNUM") return (result); } -Built_In_Primitive (Prim_Divide_Fixnum, 2, "DIVIDE-FIXNUM", 0x3E) -Define_Primitive (Prim_Divide_Fixnum, 2, "DIVIDE-FIXNUM") +DEFINE_PRIMITIVE ("DIVIDE-FIXNUM", Prim_divide_fixnum, 2, 2, 0) { /* Returns the CONS of quotient and remainder */ fast long quotient; @@ -180,8 +168,7 @@ Define_Primitive (Prim_Divide_Fixnum, 2, "DIVIDE-FIXNUM") return (Make_Pointer (TC_LIST, (Free - 2))); } -Built_In_Primitive (Prim_Gcd_Fixnum, 2, "GCD-FIXNUM", 0x66) -Define_Primitive (Prim_Gcd_Fixnum, 2, "GCD-FIXNUM") +DEFINE_PRIMITIVE ("GCD-FIXNUM", Prim_gcd_fixnum, 2, 2, 0) { fast long z; FIXNUM_PRIMITIVE_2 (x, y); diff --git a/v7/src/microcode/fixobj.h b/v7/src/microcode/fixobj.h index ea2767a5e..3b2de14f1 100644 --- a/v7/src/microcode/fixobj.h +++ b/v7/src/microcode/fixobj.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixobj.h,v 9.25 1987/04/28 16:38:00 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixobj.h,v 9.26 1988/08/15 20:47:07 cph Exp $ * * Declarations of user offsets into the Fixed Objects Vector. * This should correspond to the file UTABMD.SCM diff --git a/v7/src/microcode/flonum.c b/v7/src/microcode/flonum.c index 2103c3e8f..6dd525ebb 100644 --- a/v7/src/microcode/flonum.c +++ b/v7/src/microcode/flonum.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,14 +30,14 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/flonum.c,v 9.24 1987/11/17 08:11:14 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/flonum.c,v 9.25 1988/08/15 20:47:15 cph Exp $ * * This file contains support for floating point arithmetic. Most * of these primitives have been superceded by generic arithmetic. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "flonum.h" #include "zones.h" @@ -50,8 +50,7 @@ MIT in each case. */ appropriate result. */ -Built_In_Primitive(Prim_Plus_Flonum, 2, "PLUS-FLONUM", 0x69) -Define_Primitive(Prim_Plus_Flonum, 2, "PLUS-FLONUM") +DEFINE_PRIMITIVE ("PLUS-FLONUM", Prim_plus_flonum, 2, 2, 0) { Primitive_2_Args(); @@ -61,8 +60,7 @@ Define_Primitive(Prim_Plus_Flonum, 2, "PLUS-FLONUM") Flonum_Result(Get_Float(Arg1) + Get_Float(Arg2)); } -Built_In_Primitive(Prim_Minus_Flonum, 2, "MINUS-FLONUM", 0x6A) -Define_Primitive(Prim_Minus_Flonum, 2, "MINUS-FLONUM") +DEFINE_PRIMITIVE ("MINUS-FLONUM", Prim_minus_flonum, 2, 2, 0) { Primitive_2_Args(); @@ -72,8 +70,7 @@ Define_Primitive(Prim_Minus_Flonum, 2, "MINUS-FLONUM") Flonum_Result(Get_Float(Arg1) - Get_Float(Arg2)); } -Built_In_Primitive(Prim_Multiply_Flonum, 2, "MULTIPLY-FLONUM", 0x6B) -Define_Primitive(Prim_Multiply_Flonum, 2, "MULTIPLY-FLONUM") +DEFINE_PRIMITIVE ("MULTIPLY-FLONUM", Prim_multiply_flonum, 2, 2, 0) { Primitive_2_Args(); @@ -83,8 +80,7 @@ Define_Primitive(Prim_Multiply_Flonum, 2, "MULTIPLY-FLONUM") Flonum_Result(Get_Float(Arg1) * Get_Float(Arg2)); } -Built_In_Primitive(Prim_Divide_Flonum, 2, "DIVIDE-FLONUM", 0x6C) -Define_Primitive(Prim_Divide_Flonum, 2, "DIVIDE-FLONUM") +DEFINE_PRIMITIVE ("DIVIDE-FLONUM", Prim_divide_flonum, 2, 2, 0) { Primitive_2_Args(); @@ -105,8 +101,7 @@ Define_Primitive(Prim_Divide_Flonum, 2, "DIVIDE-FLONUM") true, or a fixnum 0 if it is false. */ -Built_In_Primitive(Prim_Equal_Flonum, 2, "EQUAL-FLONUM?", 0x6D) -Define_Primitive(Prim_Equal_Flonum, 2, "EQUAL-FLONUM?") +DEFINE_PRIMITIVE ("EQUAL-FLONUM?", Prim_equal_flonum, 2, 2, 0) { Primitive_2_Args(); @@ -117,8 +112,7 @@ Define_Primitive(Prim_Equal_Flonum, 2, "EQUAL-FLONUM?") Make_Unsigned_Fixnum(((Get_Float(Arg1)) == (Get_Float(Arg2))) ? 1 : 0); } -Built_In_Primitive(Prim_Greater_Flonum, 2, "GREATER-THAN-FLONUM?", 0xAA) -Define_Primitive(Prim_Greater_Flonum, 2, "GREATER-THAN-FLONUM?") +DEFINE_PRIMITIVE ("GREATER-THAN-FLONUM?", Prim_greater_flonum, 2, 2, 0) { Primitive_2_Args(); @@ -129,8 +123,7 @@ Define_Primitive(Prim_Greater_Flonum, 2, "GREATER-THAN-FLONUM?") Make_Unsigned_Fixnum(((Get_Float(Arg1)) > (Get_Float(Arg2))) ? 1 : 0); } -Built_In_Primitive(Prim_Less_Flonum, 2, "LESS-THAN-FLONUM?", 0x6E) -Define_Primitive(Prim_Less_Flonum, 2, "LESS-THAN-FLONUM?") +DEFINE_PRIMITIVE ("LESS-THAN-FLONUM?", Prim_less_flonum, 2, 2, 0) { Primitive_2_Args(); @@ -149,8 +142,7 @@ Define_Primitive(Prim_Less_Flonum, 2, "LESS-THAN-FLONUM?") not a flonum. Otherwise, they return the appropriate result. */ -Built_In_Primitive(Prim_Sine_Flonum, 1, "SINE-FLONUM", 0x73) -Define_Primitive(Prim_Sine_Flonum, 1, "SINE-FLONUM") +DEFINE_PRIMITIVE ("SINE-FLONUM", Prim_sine_flonum, 1, 1, 0) { extern double sin(); Primitive_1_Arg(); @@ -160,8 +152,7 @@ Define_Primitive(Prim_Sine_Flonum, 1, "SINE-FLONUM") Flonum_Result(sin(Get_Float(Arg1))); } -Built_In_Primitive(Prim_Cosine_Flonum, 1, "COSINE-FLONUM", 0x74) -Define_Primitive(Prim_Cosine_Flonum, 1, "COSINE-FLONUM") +DEFINE_PRIMITIVE ("COSINE-FLONUM", Prim_cosine_flonum, 1, 1, 0) { extern double cos(); Primitive_1_Arg(); @@ -171,8 +162,7 @@ Define_Primitive(Prim_Cosine_Flonum, 1, "COSINE-FLONUM") Flonum_Result(cos(Get_Float(Arg1))); } -Built_In_Primitive(Prim_Arctan_Flonum, 1, "ARCTAN-FLONUM", 0x75) -Define_Primitive(Prim_Arctan_Flonum, 1, "ARCTAN-FLONUM") +DEFINE_PRIMITIVE ("ARCTAN-FLONUM", Prim_arctan_flonum, 1, 1, 0) { extern double atan(); Primitive_1_Arg(); @@ -182,8 +172,7 @@ Define_Primitive(Prim_Arctan_Flonum, 1, "ARCTAN-FLONUM") Flonum_Result(atan(Get_Float(Arg1))); } -Built_In_Primitive(Prim_Exp_Flonum, 1, "EXP-FLONUM", 0x76) -Define_Primitive(Prim_Exp_Flonum, 1, "EXP-FLONUM") +DEFINE_PRIMITIVE ("EXP-FLONUM", Prim_exp_flonum, 1, 1, 0) { extern double exp(); Primitive_1_Arg(); @@ -193,8 +182,7 @@ Define_Primitive(Prim_Exp_Flonum, 1, "EXP-FLONUM") Flonum_Result(exp(Get_Float(Arg1))); } -Built_In_Primitive(Prim_Ln_Flonum, 1, "LN-FLONUM", 0x77) -Define_Primitive(Prim_Ln_Flonum, 1, "LN-FLONUM") +DEFINE_PRIMITIVE ("LN-FLONUM", Prim_ln_flonum, 1, 1, 0) { extern double log(); Primitive_1_Arg(); @@ -206,8 +194,7 @@ Define_Primitive(Prim_Ln_Flonum, 1, "LN-FLONUM") Flonum_Result(log(Get_Float(Arg1))); } -Built_In_Primitive(Prim_Sqrt_Flonum, 1, "SQRT-FLONUM", 0x78) -Define_Primitive(Prim_Sqrt_Flonum, 1, "SQRT-FLONUM") +DEFINE_PRIMITIVE ("SQRT-FLONUM", Prim_sqrt_flonum, 1, 1, 0) { extern double sqrt(); double Arg; @@ -221,8 +208,7 @@ Define_Primitive(Prim_Sqrt_Flonum, 1, "SQRT-FLONUM") Flonum_Result(sqrt(Arg)); } -Built_In_Primitive(Prim_Zero_Flonum, 1, "ZERO-FLONUM?", 0xA7) -Define_Primitive(Prim_Zero_Flonum, 1, "ZERO-FLONUM?") +DEFINE_PRIMITIVE ("ZERO-FLONUM?", Prim_zero_flonum, 1, 1, 0) { Primitive_1_Arg(); @@ -231,8 +217,7 @@ Define_Primitive(Prim_Zero_Flonum, 1, "ZERO-FLONUM?") return Make_Unsigned_Fixnum((Get_Float(Arg1) == 0.0) ? 1 : 0); } -Built_In_Primitive(Prim_Positive_Flonum, 1, "POSITIVE-FLONUM?", 0xA8) -Define_Primitive(Prim_Positive_Flonum, 1, "POSITIVE-FLONUM?") +DEFINE_PRIMITIVE ("POSITIVE-FLONUM?", Prim_positive_flonum, 1, 1, 0) { Primitive_1_Arg(); @@ -241,8 +226,7 @@ Define_Primitive(Prim_Positive_Flonum, 1, "POSITIVE-FLONUM?") return Make_Unsigned_Fixnum((Get_Float(Arg1) > 0.0) ? 1 : 0); } -Built_In_Primitive(Prim_Negative_Flonum, 1, "NEGATIVE-FLONUM?", 0xA9) -Define_Primitive(Prim_Negative_Flonum, 1, "NEGATIVE-FLONUM?") +DEFINE_PRIMITIVE ("NEGATIVE-FLONUM?", Prim_negative_flonum, 1, 1, 0) { Primitive_1_Arg(); @@ -257,8 +241,7 @@ Define_Primitive(Prim_Negative_Flonum, 1, "NEGATIVE-FLONUM?") to be converted to floating point, or if the argument isn't of the correct type, FIXNUM-OR-BIGNUM is returned unchanged. */ -Built_In_Primitive(Prim_Int_To_Float, 1, "COERCE-INTEGER-TO-FLONUM", 0x72) -Define_Primitive(Prim_Int_To_Float, 1, "COERCE-INTEGER-TO-FLONUM") +DEFINE_PRIMITIVE ("COERCE-INTEGER-TO-FLONUM", Prim_int_to_float, 1, 1, 0) { Primitive_1_Arg(); @@ -279,8 +262,7 @@ Define_Primitive(Prim_Int_To_Float, 1, "COERCE-INTEGER-TO-FLONUM") Returns the integer corresponding to FLONUM when truncated. Returns NIL if FLONUM isn't a floating point number */ -Built_In_Primitive(Prim_Truncate_Flonum, 1, "TRUNCATE-FLONUM", 0x70) -Define_Primitive(Prim_Truncate_Flonum, 1, "TRUNCATE-FLONUM") +DEFINE_PRIMITIVE ("TRUNCATE-FLONUM", Prim_truncate_flonum, 1, 1, 0) { fast double A; long Answer; /* Faulty VAX/UNIX C optimizer */ @@ -299,8 +281,7 @@ Define_Primitive(Prim_Truncate_Flonum, 1, "TRUNCATE-FLONUM") Returns the integer found by rounding off FLONUM (upward), if FLONUM is a floating point number. Otherwise returns FLONUM. */ -Built_In_Primitive(Prim_Round_Flonum, 1, "ROUND-FLONUM", 0x71) -Define_Primitive(Prim_Round_Flonum, 1, "ROUND-FLONUM") +DEFINE_PRIMITIVE ("ROUND-FLONUM", Prim_round_flonum, 1, 1, 0) { fast double A; long Answer; /* Faulty VAX/UNIX C optimizer */ diff --git a/v7/src/microcode/future.c b/v7/src/microcode/future.c index 8876a0a8d..f1dfd3b69 100644 --- a/v7/src/microcode/future.c +++ b/v7/src/microcode/future.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,13 +30,13 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/future.c,v 9.25 1987/11/17 08:11:25 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/future.c,v 9.26 1988/08/15 20:47:36 cph Rel $ Support code for futures */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "locks.h" #ifndef COMPILE_FUTURES @@ -63,7 +63,7 @@ and where is #!true if someone wants slot kept for a time. */ -Define_Primitive(Prim_Touch, 1, "TOUCH") +DEFINE_PRIMITIVE ("TOUCH", Prim_touch, 1, 1, 0) { Pointer Result; Primitive_1_Arg(); @@ -72,11 +72,11 @@ Define_Primitive(Prim_Touch, 1, "TOUCH") return Result; } -Define_Primitive(Prim_Future_P, 1, "FUTURE?") +DEFINE_PRIMITIVE ("FUTURE?", Prim_future_p, 1, 1, 0) { Primitive_1_Arg(); - return (Type_Code(Arg1) == TC_FUTURE) ? TRUTH : NIL; + return (Type_Code(Arg1) == TC_FUTURE) ? SHARP_T : NIL; } /* Utility setting routine for use by the various test and set if @@ -120,7 +120,7 @@ Try_Again: . The value returned is either (if the modification takes place) or '() if it does not. */ -Define_Primitive(Prim_Set_Car_If_Eq, 3, "SET-CAR-IF-EQ?!") +DEFINE_PRIMITIVE ("SET-CAR-IF-EQ?!", Prim_set_car_if_eq, 3, 3, 0) { Primitive_3_Args(); @@ -140,7 +140,7 @@ Define_Primitive(Prim_Set_Car_If_Eq, 3, "SET-CAR-IF-EQ?!") . The value returned is either (if the modification takes place) or '() if it does not. */ -Define_Primitive(Prim_Set_Cdr_If_Eq, 3, "SET-CDR-IF-EQ?!") +DEFINE_PRIMITIVE ("SET-CDR-IF-EQ?!", Prim_set_cdr_if_eq, 3, 3, 0) { Primitive_3_Args(); Arg_1_Type(TC_LIST); @@ -160,7 +160,7 @@ Define_Primitive(Prim_Set_Cdr_If_Eq, 3, "SET-CDR-IF-EQ?!") to contain . The value returned is either (if the modification takes place) or '() if it does not. */ -Define_Primitive(Prim_Vector_Set_If_Eq, 4, "VECTOR-SET-IF-EQ?!") +DEFINE_PRIMITIVE ("VECTOR-SET-IF-EQ?!", Prim_vector_set_if_eq, 4, 4, 0) { long Offset; Primitive_4_Args(); @@ -184,7 +184,7 @@ Define_Primitive(Prim_Vector_Set_If_Eq, 4, "VECTOR-SET-IF-EQ?!") contain . The value returned is either (if the modification takes place) or '() if it does not. */ -Define_Primitive(Prim_Set_Cxr_If_Eq, 4, "SET-CXR-IF-EQ?!") +DEFINE_PRIMITIVE ("SET-CXR-IF-EQ?!", Prim_set_cxr_if_eq, 4, 4, 0) { Pointer Arg4; long Offset; @@ -209,7 +209,7 @@ Define_Primitive(Prim_Set_Cxr_If_Eq, 4, "SET-CXR-IF-EQ?!") the equivalent of SYSTEM-VECTOR-REF but works only on future objects and doesn't touch. */ -Define_Primitive(Prim_Future_Ref, 2, "FUTURE-REF") +DEFINE_PRIMITIVE ("FUTURE-REF", Prim_future_ref, 2, 2, 0) { long Offset; Primitive_2_Args(); @@ -226,7 +226,7 @@ Define_Primitive(Prim_Future_Ref, 2, "FUTURE-REF") the equivalent of SYSTEM-VECTOR-SET! but works only on future objects and doesn't touch. */ -Define_Primitive(Prim_Future_Set, 3, "FUTURE-SET!") +DEFINE_PRIMITIVE ("FUTURE-SET!", Prim_future_set, 3, 3, 0) { long Offset; Pointer Result; @@ -246,7 +246,7 @@ Define_Primitive(Prim_Future_Set, 3, "FUTURE-SET!") the equivalent of SYSTEM-VECTOR-SIZE but works only on future objects and doesn't touch. */ -Define_Primitive(Prim_Future_Size, 1, "FUTURE-SIZE") +DEFINE_PRIMITIVE ("FUTURE-SIZE", Prim_future_size, 1, 1, 0) { Primitive_1_Arg(); @@ -263,7 +263,7 @@ Define_Primitive(Prim_Future_Size, 1, "FUTURE-SIZE") Opposite of UNLOCK-FUTURE!. */ -Define_Primitive(Prim_Lock_Future, 1, "LOCK-FUTURE!") +DEFINE_PRIMITIVE ("LOCK-FUTURE!", Prim_lock_future, 1, 1, 0) { Primitive_1_Arg(); @@ -274,9 +274,9 @@ Define_Primitive(Prim_Lock_Future, 1, "LOCK-FUTURE!") while (!(INTERRUPT_PENDING_P(INT_Mask))) { if (Swap_Pointers(Nth_Vector_Loc(Arg1, FUTURE_LOCK), - TRUTH) == NIL) + SHARP_T) == NIL) { - return TRUTH; + return SHARP_T; } else { @@ -290,7 +290,7 @@ Define_Primitive(Prim_Lock_Future, 1, "LOCK-FUTURE!") Clears the lock flag on a locked future object, otherwise nothing. */ -Define_Primitive(Prim_Unlock_Future, 1, "UNLOCK-FUTURE!") +DEFINE_PRIMITIVE ("UNLOCK-FUTURE!", Prim_unlock_future, 1, 1, 0) { Primitive_1_Arg(); @@ -305,14 +305,14 @@ Define_Primitive(Prim_Unlock_Future, 1, "UNLOCK-FUTURE!") else { Vector_Set(Arg1, FUTURE_LOCK, NIL); - return TRUTH; + return SHARP_T; } } /* (FUTURE->VECTOR ) Create a COPY of but with type code vector. */ -Define_Primitive(Prim_Future_To_Vector, 1, "FUTURE->VECTOR") +DEFINE_PRIMITIVE ("FUTURE->VECTOR", Prim_future_to_vector, 1, 1, 0) { Pointer Result; long Size, i; @@ -332,18 +332,18 @@ Define_Primitive(Prim_Future_To_Vector, 1, "FUTURE->VECTOR") return Result; } -Define_Primitive(Prim_Future_Eq, 2, "NON-TOUCHING-EQ?") +DEFINE_PRIMITIVE ("NON-TOUCHING-EQ?", Prim_future_eq, 2, 2, 0) { Primitive_2_Args(); - return ((Arg1==Arg2) ? TRUTH : NIL); + return ((Arg1==Arg2) ? SHARP_T : NIL); } /* MAKE-INITIAL-PROCESS is called to create a small stacklet which * will just call the specified thunk and then end the computation */ -Define_Primitive(Prim_Make_Initial_Process, 1, "MAKE-INITIAL-PROCESS") +DEFINE_PRIMITIVE ("MAKE-INITIAL-PROCESS", Prim_make_initial_process, 1, 1, 0) { Pointer Result; long Useful_Length; @@ -371,7 +371,7 @@ Define_Primitive(Prim_Make_Initial_Process, 1, "MAKE-INITIAL-PROCESS") Primitive_GC_If_Needed(Allocated_Length + 1); Free[STACKLET_LENGTH] = Make_Pointer(TC_MANIFEST_VECTOR, Allocated_Length); - Free[STACKLET_REUSE_FLAG] = TRUTH; + Free[STACKLET_REUSE_FLAG] = SHARP_T; Free[STACKLET_UNUSED_LENGTH] = Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, Waste_Length); Free += (Allocated_Length + 1) - Useful_Length; @@ -414,7 +414,7 @@ Define_Primitive(Prim_Make_Initial_Process, 1, "MAKE-INITIAL-PROCESS") */ -Define_Primitive(Prim_Make_Cheap_Future, 3, "MAKE-CHEAP-FUTURE") +DEFINE_PRIMITIVE ("MAKE-CHEAP-FUTURE", Prim_make_cheap_future, 3, 3, 0) { Pointer The_Future; Pointer IO_Vector, IO_Cons, IO_Hunk3, Empty_Queue, IO_String; @@ -449,7 +449,7 @@ Define_Primitive(Prim_Make_Cheap_Future, 3, "MAKE-CHEAP-FUTURE") *Free++ = NIL; /* Not locked. */ *Free++ = Empty_Queue; /* Put the empty queue here. */ *Free++ = Arg1; /* The process slot. */ - *Free++ = TRUTH; /* Status slot. */ + *Free++ = SHARP_T; /* Status slot. */ *Free++ = Arg2; /* Original code. */ *Free++ = IO_Vector; /* Put the I/O system stuff here. */ *Free++ = NIL; /* Waiting on list. */ diff --git a/v7/src/microcode/futures.h b/v7/src/microcode/futures.h index 4a8bd036c..38c036fa2 100644 --- a/v7/src/microcode/futures.h +++ b/v7/src/microcode/futures.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/futures.h,v 9.23 1987/12/04 22:16:33 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/futures.h,v 9.24 1988/08/15 20:47:48 cph Exp $ * * This file contains macros useful for dealing with futures */ @@ -67,12 +67,12 @@ MIT in each case. */ Vector_Ref((P), FUTURE_VALUE) #define Future_Spliceable(P) \ - ((Vector_Ref((P), FUTURE_IS_DETERMINED) == TRUTH) && \ + ((Vector_Ref((P), FUTURE_IS_DETERMINED) == SHARP_T) && \ (Vector_Ref((P), FUTURE_LOCK) == NIL)) #define Future_Is_Keep_Slot(P) \ ((Vector_Ref((P), FUTURE_IS_DETERMINED) != NIL) && \ - (Vector_Ref((P), FUTURE_IS_DETERMINED) != TRUTH)) + (Vector_Ref((P), FUTURE_IS_DETERMINED) != SHARP_T)) #ifdef COMPILE_FUTURES diff --git a/v7/src/microcode/gc.h b/v7/src/microcode/gc.h index 573d6f019..40aac2a68 100644 --- a/v7/src/microcode/gc.h +++ b/v7/src/microcode/gc.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gc.h,v 9.25 1987/12/04 22:16:46 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gc.h,v 9.26 1988/08/15 20:47:59 cph Exp $ * * Garbage collection related macros of sufficient utility to be * included in all compilations. diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h index ecda67743..47e7d019e 100644 --- a/v7/src/microcode/gccode.h +++ b/v7/src/microcode/gccode.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.38 1988/04/15 16:54:02 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.39 1988/08/15 20:48:07 cph Exp $ * * This file contains the macros for use in code which does GC-like * loops over memory. It is only included in a few files, unlike diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c index 882b76a7e..cf5125eda 100644 --- a/v7/src/microcode/gcloop.c +++ b/v7/src/microcode/gcloop.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.28 1988/03/21 21:16:41 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.29 1988/08/15 20:48:17 cph Exp $ * * This file contains the code for the most primitive part * of garbage collection. diff --git a/v7/src/microcode/gctype.c b/v7/src/microcode/gctype.c index 8d95f3e14..13f1d10bd 100644 --- a/v7/src/microcode/gctype.c +++ b/v7/src/microcode/gctype.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/gctype.c,v 9.28 1988/03/12 16:06:21 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/gctype.c,v 9.29 1988/08/15 20:48:26 cph Rel $ * * This file contains the table which maps between Types and * GC Types. diff --git a/v7/src/microcode/generic.c b/v7/src/microcode/generic.c index 79c699280..c0f8df8be 100644 --- a/v7/src/microcode/generic.c +++ b/v7/src/microcode/generic.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,72 +30,74 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/generic.c,v 9.26 1988/06/05 00:54:47 mhwu Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/generic.c,v 9.27 1988/08/15 20:48:35 cph Exp $ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "bignum.h" #include "flonum.h" #include "zones.h" - /* Complex Number Macros. Should have its own file. */ -#define Real_Part(arg) Vector_Ref((arg), COMPLEX_REAL) -#define Imag_Part(arg) Vector_Ref((arg), COMPLEX_IMAG) +#define REAL_PART(arg) (Vector_Ref ((arg), COMPLEX_REAL)) +#define IMAG_PART(arg) (Vector_Ref ((arg), COMPLEX_IMAG)) -/* Expands ARG twice. Be careful */ -#define Coerce_Real_Part(arg) \ - ((Type_Code((arg)) == TC_COMPLEX) ? Real_Part(arg) : arg) -#define Coerce_Imag_Part(arg) \ - ((Type_Code((arg)) == TC_COMPLEX) ? Imag_Part(arg) : FIXNUM_ZERO) +/* Expands ARG thrice. Be careful */ +#define COERCE_REAL_PART(arg) ((COMPLEX_P (arg)) ? (REAL_PART (arg)) : (arg)) -#define Return_Complex(real, imag) \ - if (basic_zero_p(imag)) \ - return real; \ - else \ - { *Free++ = real; \ - *Free++ = imag; \ - return Make_Pointer(TC_COMPLEX, (Free - 2)); \ - } \ +#define COERCE_IMAG_PART(arg) \ + ((COMPLEX_P (arg)) ? (IMAG_PART (arg)) : FIXNUM_ZERO) +#define RETURN_COMPLEX(real, imag) \ +{ \ + Pointer _real_value = (real); \ + Pointer _imag_value = (imag); \ + \ + if (basic_zero_p (_imag_value)) \ + PRIMITIVE_RETURN (_real_value); \ + else \ + { \ + Primitive_GC_If_Needed (2); \ + (*Free++) = _real_value; \ + (*Free++) = _imag_value; \ + PRIMITIVE_RETURN (Make_Pointer (TC_COMPLEX, (Free - 2))); \ + } \ +} -static Pointer basic_zero_p(Arg) -fast Pointer Arg; +static Pointer +basic_zero_p (number) + fast Pointer number; { - switch (Type_Code(Arg)) - { case TC_FIXNUM: if (Get_Integer(Arg) == 0) return TRUTH; - else return NIL; - case TC_BIG_FLONUM: if (Get_Float(Arg) == 0.0) return TRUTH; - else return NIL; - case TC_BIG_FIXNUM: if (ZERO_BIGNUM(Fetch_Bignum(Arg))) return TRUTH; - else return NIL; - - default: Primitive_Error(ERR_ARG_1_WRONG_TYPE); - } + switch (OBJECT_TYPE (number)) + { + case TC_FIXNUM: + return ((Get_Integer (number)) == 0); + case TC_BIG_FLONUM: + return ((Get_Float (number)) == 0.0); + case TC_BIG_FIXNUM: + return (ZERO_BIGNUM (Fetch_Bignum (number))); + default: + error_wrong_type_arg (1); + } /*NOTREACHED*/ } - -Built_In_Primitive(Prim_Zero, 1, "ZERO?", 0xE6) -Define_Primitive(Prim_Zero, 1, "ZERO?") +DEFINE_PRIMITIVE ("ZERO?", Prim_zero, 1, 1, 0) { Primitive_1_Arg(); Set_Time_Zone(Zone_Math); - if (Type_Code(Arg1) == TC_COMPLEX) - { if (basic_zero_p(Real_Part(Arg1)) == TRUTH) - return basic_zero_p(Imag_Part(Arg1)); - else - return NIL; - } - else - return basic_zero_p(Arg1); + if (COMPLEX_P (Arg1)) + PRIMITIVE_RETURN + ((basic_zero_p (REAL_PART (Arg1))) + ? (BOOLEAN_TO_OBJECT (basic_zero_p (IMAG_PART (Arg1)))) + : SHARP_F); + PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (basic_zero_p (Arg1))); } - Pointer -C_Integer_To_Scheme_Integer(C) +C_Integer_To_Scheme_Integer (C) long C; { fast bigdigit *Answer, *SCAN, *size; @@ -222,41 +224,40 @@ object_to_long (object, type_error, range_error) } } -#define Sign_Check(Normal_Op, Big_Op) \ - Primitive_1_Arg(); \ - Set_Time_Zone(Zone_Math); \ - switch (Type_Code(Arg1)) \ - { case TC_FIXNUM: { long Value; \ - Sign_Extend(Arg1, Value); \ - if (Value Normal_Op 0) return TRUTH; \ - else return NIL; \ - } \ - case TC_BIG_FLONUM: if (Get_Float(Arg1) Normal_Op 0.0) return TRUTH;\ - else return NIL; \ -P2_Sign_Check(Big_Op) - -#define P2_Sign_Check(Big_Op) \ - case TC_BIG_FIXNUM: if ((LEN(Fetch_Bignum(Arg1)) != 0) \ - && Big_Op(Fetch_Bignum(Arg1))) \ - return TRUTH; \ - else return NIL; \ - default: Primitive_Error(ERR_ARG_1_WRONG_TYPE); \ - } - - -Built_In_Primitive(Prim_Positive, 1, "POSITIVE?", 0xE7) -Define_Primitive(Prim_Positive, 1, "POSITIVE?") -{ - Sign_Check(>, POS_BIGNUM); - /*NOTREACHED*/ +#define SIGN_CHECK(Normal_Op, Big_Op) \ +{ \ + Primitive_1_Arg (); \ + \ + Set_Time_Zone (Zone_Math); \ + switch (OBJECT_TYPE (Arg1)) \ + { \ + case TC_FIXNUM: \ + { \ + long Value; \ + \ + Sign_Extend (Arg1, Value); \ + PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (Value Normal_Op 0)); \ + } \ + \ + case TC_BIG_FLONUM: \ + PRIMITIVE_RETURN \ + (BOOLEAN_TO_OBJECT ((Get_Float (Arg1)) Normal_Op (0.0))); \ + \ + case TC_BIG_FIXNUM: \ + PRIMITIVE_RETURN \ + (BOOLEAN_TO_OBJECT (((LEN (Fetch_Bignum (Arg1))) != 0) && \ + (Big_Op (Fetch_Bignum (Arg1))))); \ + \ + default: \ + error_wrong_type_arg (1); \ + } \ } -Built_In_Primitive(Prim_Negative, 1, "NEGATIVE?", 0xE8) -Define_Primitive(Prim_Negative, 1, "NEGATIVE?") -{ - Sign_Check(<, NEG_BIGNUM); - /*NOTREACHED*/ -} +DEFINE_PRIMITIVE ("POSITIVE?", Prim_positive, 1, 1, 0) + SIGN_CHECK (>, POS_BIGNUM) + +DEFINE_PRIMITIVE ("NEGATIVE?", Prim_negative, 1, 1, 0) + SIGN_CHECK (<, NEG_BIGNUM) #define Inc_Dec(Normal_Op, Big_Op, Complex_Op) \ Primitive_1_Arg(); \ @@ -264,8 +265,8 @@ Define_Primitive(Prim_Negative, 1, "NEGATIVE?") switch (Type_Code(Arg1)) \ { case TC_COMPLEX: \ { Primitive_GC_If_Needed(2); \ - *Free++ = Complex_Op(Real_Part(Arg1)); \ - *Free++ = Imag_Part(Arg1); \ + *Free++ = Complex_Op(REAL_PART(Arg1)); \ + *Free++ = IMAG_PART(Arg1); \ return Make_Pointer(TC_COMPLEX, (Free - 2)); \ } \ Inc_Dec_Basic_Cases(Normal_Op, Big_Op) @@ -307,38 +308,36 @@ P3_Inc_Dec(Normal_Op, Big_Op) default: Primitive_Error(ERR_ARG_1_WRONG_TYPE); \ } -Pointer C_One_Plus(Arg1) -fast Pointer Arg1; +Pointer +C_One_Plus (Arg1) + fast Pointer Arg1; { Basic_Inc_Dec(+, plus_signed_bignum); } -Pointer C_One_Minus(Arg1) -fast Pointer Arg1; +Pointer +C_One_Minus (Arg1) + fast Pointer Arg1; { Basic_Inc_Dec(-, minus_signed_bignum); } - -Built_In_Primitive(Prim_One_Plus, 1, "1+", 0xF1) -Define_Primitive(Prim_One_Plus, 1, "1+") +DEFINE_PRIMITIVE ("1+", Prim_one_plus, 1, 1, 0) { Inc_Dec(+, plus_signed_bignum, C_One_Plus); /*NOTREACHED*/ } -Built_In_Primitive(Prim_M_1_Plus, 1, "-1+", 0xF2) -Define_Primitive(Prim_M_1_Plus, 1, "-1+") +DEFINE_PRIMITIVE ("-1+", Prim_m_1_plus, 1, 1, 0) { Inc_Dec(-, minus_signed_bignum, C_One_Minus); /*NOTREACHED*/ } - #define Two_Op_Comparator(GENERAL_OP, BIG_OP) \ Primitive_2_Args(); \ Set_Time_Zone(Zone_Math); \ -Basic_Two_Op_Comparator(GENERAL_OP, BIG_OP) + Basic_Two_Op_Comparator(GENERAL_OP, BIG_OP) #define Basic_Two_Op_Comparator(GENERAL_OP, BIG_OP) \ switch (Type_Code(Arg1)) \ @@ -348,24 +347,23 @@ Basic_Two_Op_Comparator(GENERAL_OP, BIG_OP) { long A, B; \ Sign_Extend(Arg1, A); \ Sign_Extend(Arg2, B); \ - return (A GENERAL_OP B) ? TRUTH : NIL; \ + return (BOOLEAN_TO_OBJECT (A GENERAL_OP B)); \ } \ -P2_Two_Op_Comparator(GENERAL_OP, BIG_OP) + P2_Two_Op_Comparator(GENERAL_OP, BIG_OP) #define P2_Two_Op_Comparator(GENERAL_OP, BIG_OP) \ case TC_BIG_FLONUM: \ { long A; \ Sign_Extend(Arg1, A); \ - return (A GENERAL_OP (Get_Float(Arg2))) ? TRUTH : NIL; \ + return (BOOLEAN_TO_OBJECT (A GENERAL_OP (Get_Float(Arg2)))); \ } \ case TC_BIG_FIXNUM: \ { Pointer Ans = Fix_To_Big(Arg1); \ - return (big_compare(Fetch_Bignum(Ans), \ - Fetch_Bignum(Arg2)) == BIG_OP) ? \ - TRUTH : NIL; \ + return (BOOLEAN_TO_OBJECT (big_compare(Fetch_Bignum(Ans), \ + Fetch_Bignum(Arg2)) == BIG_OP)); \ } \ -P3_Two_Op_Comparator(GENERAL_OP, BIG_OP) - + P3_Two_Op_Comparator(GENERAL_OP, BIG_OP) + #define P3_Two_Op_Comparator(GENERAL_OP, BIG_OP) \ default: \ Primitive_Error(ERR_ARG_2_WRONG_TYPE); \ @@ -376,54 +374,55 @@ P3_Two_Op_Comparator(GENERAL_OP, BIG_OP) { case TC_FIXNUM: \ { long B; \ Sign_Extend(Arg2, B); \ - return (Get_Float(Arg1) GENERAL_OP B) ? TRUTH : NIL; \ + return (BOOLEAN_TO_OBJECT (Get_Float(Arg1) GENERAL_OP B)); \ } \ -P4_Two_Op_Comparator(GENERAL_OP, BIG_OP) + P4_Two_Op_Comparator(GENERAL_OP, BIG_OP) #define P4_Two_Op_Comparator(GENERAL_OP, BIG_OP) \ case TC_BIG_FLONUM: \ - return (Get_Float(Arg1) GENERAL_OP Get_Float(Arg2)) ? \ - TRUTH : NIL; \ + return \ + (BOOLEAN_TO_OBJECT (Get_Float(Arg1) GENERAL_OP \ + Get_Float(Arg2))); \ case TC_BIG_FIXNUM: \ { Pointer A; \ A = Big_To_Float(Arg2); \ if (Type_Code(A) == TC_BIG_FLONUM) \ - return (Get_Float(Arg1) GENERAL_OP Get_Float(A)) ? \ - TRUTH : NIL; \ -P5_Two_Op_Comparator(GENERAL_OP, BIG_OP) + return \ + (BOOLEAN_TO_OBJECT (Get_Float(Arg1) GENERAL_OP \ + Get_Float(A))); \ + P5_Two_Op_Comparator(GENERAL_OP, BIG_OP) #define P5_Two_Op_Comparator(GENERAL_OP, BIG_OP) \ Primitive_Error(ERR_ARG_2_FAILED_COERCION); \ - } \ + } \ default: \ Primitive_Error(ERR_ARG_2_WRONG_TYPE); \ - } \ + } \ } \ case TC_BIG_FIXNUM: \ { switch (Type_Code(Arg2)) \ { case TC_FIXNUM: \ { Pointer Ans = Fix_To_Big(Arg2); \ - return (big_compare(Fetch_Bignum(Arg1), \ - Fetch_Bignum(Ans)) == BIG_OP) ? \ - TRUTH : NIL; \ + return (BOOLEAN_TO_OBJECT (big_compare(Fetch_Bignum(Arg1), \ + Fetch_Bignum(Ans)) == BIG_OP)); \ } \ -P6_Two_Op_Comparator(GENERAL_OP, BIG_OP) + P6_Two_Op_Comparator(GENERAL_OP, BIG_OP) #define P6_Two_Op_Comparator(GENERAL_OP, BIG_OP) \ case TC_BIG_FLONUM: \ { Pointer A = Big_To_Float(Arg1); \ if (Type_Code(A) == TC_BIG_FLONUM) \ - return (Get_Float(A) GENERAL_OP Get_Float(Arg2)) ? \ - TRUTH : NIL; \ + return \ + (BOOLEAN_TO_OBJECT (Get_Float(A) GENERAL_OP \ + Get_Float(Arg2))); \ Primitive_Error(ERR_ARG_1_FAILED_COERCION); \ - } \ -P7_Two_Op_Comparator(GENERAL_OP, BIG_OP) - + } \ + P7_Two_Op_Comparator(GENERAL_OP, BIG_OP) + #define P7_Two_Op_Comparator(GENERAL_OP, BIG_OP) \ case TC_BIG_FIXNUM: \ - return (big_compare(Fetch_Bignum(Arg1), \ - Fetch_Bignum(Arg2)) == BIG_OP) ? \ - TRUTH : NIL; \ + return (BOOLEAN_TO_OBJECT (big_compare(Fetch_Bignum(Arg1), \ + Fetch_Bignum(Arg2)) == BIG_OP)); \ default: \ Primitive_Error(ERR_ARG_2_WRONG_TYPE); \ } \ @@ -431,57 +430,56 @@ P7_Two_Op_Comparator(GENERAL_OP, BIG_OP) default: Primitive_Error(ERR_ARG_1_WRONG_TYPE); \ } -Pointer Basic_Equal_Number(Arg1, Arg2) -fast Pointer Arg1, Arg2; +Pointer +Basic_Equal_Number (Arg1, Arg2) + fast Pointer Arg1, Arg2; { - Basic_Two_Op_Comparator(==, EQUAL); + Basic_Two_Op_Comparator (==, EQUAL); } -Built_In_Primitive(Prim_Equal_Number, 2, "&=", 0xE9) -Define_Primitive(Prim_Equal_Number, 2, "&=") -{ Primitive_2_Args(); - Set_Time_Zone(Zone_Math); +DEFINE_PRIMITIVE ("&=", Prim_equal_number, 2, 2, 0) +{ + Primitive_2_Args (); + Set_Time_Zone (Zone_Math); - if ((Type_Code(Arg1) != TC_COMPLEX) && (Type_Code(Arg2) != TC_COMPLEX)) - Basic_Two_Op_Comparator(==, EQUAL) - else if ((Type_Code(Arg1) != TC_COMPLEX) || (Type_Code(Arg2) != TC_COMPLEX)) - return NIL; - else if (Basic_Equal_Number(Real_Part(Arg1), Real_Part(Arg2)) == TRUTH) - return Basic_Equal_Number(Imag_Part(Arg1), Imag_Part(Arg2)); - else return NIL; - + if ((COMPLEX_P (Arg1)) && (COMPLEX_P (Arg2))) + Basic_Two_Op_Comparator (==, EQUAL) + else if ((COMPLEX_P (Arg1)) || (COMPLEX_P (Arg2))) + PRIMITIVE_RETURN (SHARP_F); + PRIMITIVE_RETURN + (((Basic_Equal_Number ((REAL_PART (Arg1)), (REAL_PART (Arg2)))) == SHARP_T) + ? (Basic_Equal_Number ((IMAG_PART (Arg1)), (IMAG_PART (Arg2)))) + : SHARP_F); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Less, 2, "&<", 0xEA) -Define_Primitive(Prim_Less, 2, "&<") +DEFINE_PRIMITIVE ("&<", Prim_less, 2, 2, 0) { - Two_Op_Comparator(<, TWO_BIGGER); + Two_Op_Comparator (<, TWO_BIGGER); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Greater, 2, "&>", 0xEB) -Define_Primitive(Prim_Greater, 2, "&>") +DEFINE_PRIMITIVE ("&>", Prim_greater, 2, 2, 0) { - Two_Op_Comparator(>, ONE_BIGGER); + Two_Op_Comparator (>, ONE_BIGGER); /*NOTREACHED*/ } #define Two_Op_Operator(GENERAL_OP, BIG_OP, COMPLEX_OP) \ Primitive_2_Args(); \ - Set_Time_Zone(Zone_Math); \ + Set_Time_Zone(Zone_Math); \ \ - if (Type_Code(Arg2) == TC_COMPLEX) goto complex_handler; \ + if ((COMPLEX_P (Arg2))) goto complex_handler; \ \ switch (Type_Code(Arg1)) \ - { case TC_COMPLEX: \ -complex_handler: \ - { fast Pointer real, imag; \ - Primitive_GC_If_Needed(2); \ - real = COMPLEX_OP(Coerce_Real_Part(Arg1), Coerce_Real_Part(Arg2));\ - imag = COMPLEX_OP(Coerce_Imag_Part(Arg1), Coerce_Imag_Part(Arg2));\ - Return_Complex(real, imag); \ - } \ + { \ + case TC_COMPLEX: \ + complex_handler: \ + RETURN_COMPLEX \ + ((COMPLEX_OP ((COERCE_REAL_PART (Arg1)), \ + (COERCE_REAL_PART (Arg2)))), \ + (COMPLEX_OP ((COERCE_IMAG_PART (Arg1)), \ + (COERCE_IMAG_PART (Arg2))))); \ Two_Op_Operator_Basic_Cases(GENERAL_OP, BIG_OP) #define Basic_Two_Op_Operator(GENERAL_OP, BIG_OP) \ @@ -613,23 +611,23 @@ fast Pointer Arg1, Arg2; Basic_Two_Op_Operator(-, minus_signed_bignum); } -Built_In_Primitive(Prim_Plus, 2, "&+", 0xEC) -Define_Primitive(Prim_Plus, 2, "&+") +DEFINE_PRIMITIVE ("&+", Prim_plus, 2, 2, 0) { Two_Op_Operator(+, plus_signed_bignum, basic_plus); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Minus, 2, "&-", 0xED) -Define_Primitive(Prim_Minus, 2, "&-") +DEFINE_PRIMITIVE ("&-", Prim_minus, 2, 2, 0) { Two_Op_Operator(-, minus_signed_bignum, basic_minus); /*NOTREACHED*/ } -static Pointer basic_multiply(Arg1, Arg2) -fast Pointer Arg1, Arg2; -{ extern Pointer Mul(); +static Pointer +basic_multiply (Arg1, Arg2) + fast Pointer Arg1, Arg2; +{ + extern Pointer Mul (); switch (Type_Code(Arg1)) { case TC_FIXNUM: @@ -637,7 +635,7 @@ fast Pointer Arg1, Arg2; { case TC_FIXNUM: { fast Pointer Result; Result = Mul(Arg1, Arg2); - if (Result != NIL) return Result; + if (Result != SHARP_F) return Result; { Pointer Big_Arg1, Big_Arg2; Big_Arg1 = Fix_To_Big(Arg1); Big_Arg2 = Fix_To_Big(Arg2); @@ -653,10 +651,6 @@ fast Pointer Arg1, Arg2; Reduced_Flonum_Result(A * Get_Float(Arg2)); } -/* Prim_Multiply continues on the next page */ - -/* Prim_Multiply, continued */ - case TC_BIG_FIXNUM: { Pointer Big_Arg1 = Fix_To_Big(Arg1); Bignum_Operation(multiply_signed_bignum(Fetch_Bignum(Big_Arg1), @@ -691,11 +685,6 @@ fast Pointer Arg1, Arg2; } /*NOTREACHED*/ } - -/* Prim_Multiply continues on the next page */ - -/* Prim_Multiply, continued */ - case TC_BIG_FIXNUM: { switch (Type_Code(Arg2)) { case TC_FIXNUM: @@ -729,39 +718,33 @@ fast Pointer Arg1, Arg2; } /*NOTREACHED*/ } - - -static Pointer complex_multiply(Arg1, Arg2) -fast Pointer Arg1, Arg2; -{ fast Pointer real, imag; - - Primitive_GC_If_Needed(2); - - real = basic_minus(basic_multiply(Coerce_Real_Part(Arg1), - Coerce_Real_Part(Arg2)), - basic_multiply(Coerce_Imag_Part(Arg1), - Coerce_Imag_Part(Arg2))); - imag = basic_plus(basic_multiply(Coerce_Real_Part(Arg1), - Coerce_Imag_Part(Arg2)), - basic_multiply(Coerce_Real_Part(Arg2), - Coerce_Imag_Part(Arg1))); - Return_Complex(real, imag); +static Pointer +complex_multiply (Arg1, Arg2) + fast Pointer Arg1, Arg2; +{ + RETURN_COMPLEX + ((basic_minus ((basic_multiply ((COERCE_REAL_PART (Arg1)), + (COERCE_REAL_PART (Arg2)))), + (basic_multiply ((COERCE_IMAG_PART (Arg1)), + (COERCE_IMAG_PART (Arg2)))))), + (basic_plus ((basic_multiply ((COERCE_REAL_PART (Arg1)), + (COERCE_IMAG_PART (Arg2)))), + (basic_multiply ((COERCE_REAL_PART (Arg2)), + (COERCE_IMAG_PART (Arg1))))))); } - -Built_In_Primitive(Prim_Multiply, 2, "&*", 0xEE) -Define_Primitive(Prim_Multiply, 2, "&*") -{ /* Mul is machine dependent and lives in os.c */ - Primitive_2_Args(); - Set_Time_Zone(Zone_Math); - - if ((Type_Code(Arg1) == TC_COMPLEX)||(Type_Code(Arg2) == TC_COMPLEX)) - return complex_multiply(Arg1, Arg2); - else - return basic_multiply(Arg1, Arg2); +DEFINE_PRIMITIVE ("&*", Prim_multiply, 2, 2, 0) +{ + /* Mul is machine dependent and lives in "os.c" */ + Primitive_2_Args (); + Set_Time_Zone (Zone_Math); + + PRIMITIVE_RETURN + (((COMPLEX_P (Arg1)) || (COMPLEX_P (Arg2))) + ? (complex_multiply (Arg1, Arg2)) + : (basic_multiply (Arg1, Arg2))); } - static Pointer basic_divide(Arg1, Arg2) fast Pointer Arg1, Arg2; @@ -924,55 +907,46 @@ fast Pointer Arg1, Arg2; /*NOTREACHED*/ } - -static Pointer complex_divide(Arg1, Arg2) -Pointer Arg1, Arg2; +static Pointer +complex_divide (Arg1, Arg2) + Pointer Arg1, Arg2; { - fast Pointer real1, real2, imag1, imag2, real, imag; + fast Pointer real1, real2, imag1, imag2; fast Pointer temp; - - Primitive_GC_If_Needed(2); - - real1 = Coerce_Real_Part(Arg1); - real2 = Coerce_Real_Part(Arg2); - imag1 = Coerce_Imag_Part(Arg1); - imag2 = Coerce_Imag_Part(Arg2); - temp = basic_divide(Make_Non_Pointer(TC_FIXNUM, 1), - basic_plus(basic_multiply(real2, real2), - basic_multiply(imag2, imag2))); - - real = - basic_multiply(basic_plus(basic_multiply(real1, real2), - basic_multiply(imag1, imag2)), - temp); - imag = - basic_multiply(basic_minus(basic_multiply(real2, imag1), - basic_multiply(real1, imag2)), - temp); - Return_Complex(real, imag); + real1 = (COERCE_REAL_PART (Arg1)); + real2 = (COERCE_REAL_PART (Arg2)); + imag1 = (COERCE_IMAG_PART (Arg1)); + imag2 = (COERCE_IMAG_PART (Arg2)); + + temp = (basic_divide ((MAKE_UNSIGNED_FIXNUM (1)), + (basic_plus ((basic_multiply (real2, real2)), + (basic_multiply (imag2, imag2)))))); + RETURN_COMPLEX + ((basic_multiply ((basic_plus ((basic_multiply (real1, real2)), + (basic_multiply (imag1, imag2)))), + temp)), + (basic_multiply ((basic_minus ((basic_multiply (real2, imag1)), + (basic_multiply (real1, imag2)))), + temp))); } -Built_In_Primitive(Prim_Divide, 2, "&/", 0xEF) -Define_Primitive(Prim_Divide, 2, "&/") +DEFINE_PRIMITIVE ("&/", Prim_divide, 2, 2, 0) { - Primitive_2_Args(); - Set_Time_Zone(Zone_Math); + Primitive_2_Args (); - if ((Type_Code(Arg1) == TC_COMPLEX) || (Type_Code(Arg2) == TC_COMPLEX)) - return complex_divide(Arg1, Arg2); - else - return basic_divide(Arg1, Arg2); + Set_Time_Zone (Zone_Math); + PRIMITIVE_RETURN + (((COMPLEX_P (Arg1)) || (COMPLEX_P (Arg2))) + ? (complex_divide (Arg1, Arg2)) + : (basic_divide (Arg1, Arg2))); } - - -Built_In_Primitive(Prim_Integer_Divide, 2, "INTEGER-DIVIDE", 0xF0) -Define_Primitive(Prim_Integer_Divide, 2, "INTEGER-DIVIDE") +DEFINE_PRIMITIVE ("INTEGER-DIVIDE", Prim_integer_divide, 2, 2, 0) { - Primitive_2_Args(); + Primitive_2_Args (); - Set_Time_Zone(Zone_Math); + Set_Time_Zone (Zone_Math); switch (Type_Code(Arg1)) { case TC_FIXNUM: { switch (Type_Code(Arg2)) @@ -1091,43 +1065,37 @@ Lambda(arg) \ Generic_Restriction(Scheme_Sqrt, sqrt, <) Generic_Restriction(Scheme_Ln, log, <=) -Built_In_Primitive(Prim_Sqrt, 1, "SQRT", 0xF7) -Define_Primitive(Prim_Sqrt, 1, "SQRT") +DEFINE_PRIMITIVE ("SQRT", Prim_sqrt, 1, 1, 0) { Generic_Function(Scheme_Sqrt); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Exp, 1, "EXP", 0xF8) -Define_Primitive(Prim_Exp, 1, "EXP") +DEFINE_PRIMITIVE ("EXP", Prim_exp, 1, 1, 0) { Generic_Function(exp); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Ln, 1, "LOG", 0xF9) -Define_Primitive(Prim_Ln, 1, "LOG") +DEFINE_PRIMITIVE ("LOG", Prim_ln, 1, 1, 0) { Generic_Function(Scheme_Ln); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Sine, 1, "SIN", 0xFA) -Define_Primitive(Prim_Sine, 1, "SIN") +DEFINE_PRIMITIVE ("SIN", Prim_sine, 1, 1, 0) { Generic_Function(sin); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Cosine, 1, "COS", 0xFB) -Define_Primitive(Prim_Cosine, 1, "COS") +DEFINE_PRIMITIVE ("COS", Prim_cosine, 1, 1, 0) { Generic_Function(cos); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Arctan, 1, "&ATAN", 0xFC) -Define_Primitive(Prim_Arctan, 1, "&ATAN") +DEFINE_PRIMITIVE ("&ATAN", Prim_arctan, 1, 1, 0) { Generic_Function(atan); /*NOTREACHED*/ @@ -1214,29 +1182,25 @@ ceil(arg) default: Primitive_Error(ERR_ARG_1_WRONG_TYPE); \ } -Built_In_Primitive(Prim_Truncate, 1, "TRUNCATE", 0xF3) -Define_Primitive(Prim_Truncate, 1, "TRUNCATE") +DEFINE_PRIMITIVE ("TRUNCATE", Prim_truncate, 1, 1, 0) { Flonum_To_Integer(Truncate_Mapping); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Round, 1, "ROUND", 0xF4) -Define_Primitive(Prim_Round, 1, "ROUND") +DEFINE_PRIMITIVE ("ROUND", Prim_round, 1, 1, 0) { Flonum_To_Integer(Round_Mapping); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Floor, 1, "FLOOR", 0xF5) -Define_Primitive(Prim_Floor, 1, "FLOOR") +DEFINE_PRIMITIVE ("FLOOR", Prim_floor, 1, 1, 0) { Flonum_To_Integer(Floor_Mapping); /*NOTREACHED*/ } -Built_In_Primitive(Prim_Ceiling, 1, "CEILING", 0xF6) -Define_Primitive(Prim_Ceiling, 1, "CEILING") +DEFINE_PRIMITIVE ("CEILING", Prim_ceiling, 1, 1, 0) { Flonum_To_Integer(Ceiling_Mapping); /*NOTREACHED*/ diff --git a/v7/src/microcode/history.h b/v7/src/microcode/history.h index 8e6bb4db9..5d4cb2a56 100644 --- a/v7/src/microcode/history.h +++ b/v7/src/microcode/history.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/history.h,v 9.23 1987/10/09 16:11:17 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/history.h,v 9.24 1988/08/15 20:48:56 cph Rel $ * * History maintenance data structures and support. * diff --git a/v7/src/microcode/hooks.c b/v7/src/microcode/hooks.c index b20435d32..c715d7083 100644 --- a/v7/src/microcode/hooks.c +++ b/v7/src/microcode/hooks.c @@ -30,14 +30,14 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.31 1988/05/10 15:15:10 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.32 1988/08/15 20:49:05 cph Exp $ * * This file contains various hooks and handles which connect the * primitives with the main interpreter. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "winder.h" #include "history.h" @@ -46,7 +46,7 @@ MIT in each case. */ LIST-OF-ARGUMENTS. FN must be a primitive procedure, compound procedure, or control point. */ -DEFINE_PRIMITIVE ("APPLY", Prim_Apply, 2) +DEFINE_PRIMITIVE ("APPLY", Prim_apply, 2, 2, 0) { fast Pointer scan_list, *scan_stack; fast long number_of_args, i; @@ -194,7 +194,7 @@ DEFINE_PRIMITIVE ("APPLY", Prim_Apply, 2) Free[STACKLET_LENGTH] = \ Make_Non_Pointer(TC_MANIFEST_VECTOR, \ (Stack_Cells + (STACKLET_HEADER_SIZE - 1))); \ - Free[STACKLET_REUSE_FLAG] = TRUTH; \ + Free[STACKLET_REUSE_FLAG] = SHARP_T; \ Free[STACKLET_UNUSED_LENGTH] = \ Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, 0); \ Free += STACKLET_HEADER_SIZE; \ @@ -233,7 +233,7 @@ DEFINE_PRIMITIVE ("APPLY", Prim_Apply, 2) and clears the appropriate reuse flags for copying. */ -DEFINE_PRIMITIVE ("CALL-WITH-CURRENT-CONTINUATION", Prim_Catch, 1) +DEFINE_PRIMITIVE ("CALL-WITH-CURRENT-CONTINUATION", Prim_catch, 1, 1, 0) { Pointer Control_Point; Primitive_1_Arg (); @@ -244,7 +244,7 @@ DEFINE_PRIMITIVE ("CALL-WITH-CURRENT-CONTINUATION", Prim_Catch, 1) /*NOTREACHED*/ } -DEFINE_PRIMITIVE ("NON-REENTRANT-CALL-WITH-CURRENT-CONTINUATION", Prim_Non_Reentrant_Catch, 1) +DEFINE_PRIMITIVE ("NON-REENTRANT-CALL-WITH-CURRENT-CONTINUATION", Prim_non_reentrant_catch, 1, 1, 0) { Pointer Control_Point; Primitive_1_Arg (); @@ -270,7 +270,7 @@ DEFINE_PRIMITIVE ("NON-REENTRANT-CALL-WITH-CURRENT-CONTINUATION", Prim_Non_Reent and previous value of interrupts. Returns the previous value. See MASK_INTERRUPT_ENABLES for more information on interrupts. */ -DEFINE_PRIMITIVE ("ENABLE-INTERRUPTS!", Prim_Enable_Interrupts, 1) +DEFINE_PRIMITIVE ("ENABLE-INTERRUPTS!", Prim_enable_interrupts, 1, 1, 0) { long previous; Primitive_1_Arg (); @@ -285,7 +285,7 @@ DEFINE_PRIMITIVE ("ENABLE-INTERRUPTS!", Prim_Enable_Interrupts, 1) Passes its arguments along to the appropriate Scheme error handler after turning off history, etc. */ -DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_Error_Procedure, 3) +DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_error_procedure, 3, 3, 0) { Primitive_3_Args(); @@ -315,7 +315,7 @@ DEFINE_PRIMITIVE ("ERROR-PROCEDURE", Prim_Error_Procedure, 3) system. See the file UTABCSCM.SCM in the runtime system for the names of the slots in the vector. */ -DEFINE_PRIMITIVE ("GET-FIXED-OBJECTS-VECTOR", Prim_Get_Fixed_Objects_Vector, 0) +DEFINE_PRIMITIVE ("GET-FIXED-OBJECTS-VECTOR", Prim_get_fixed_objects_vector, 0, 0, 0) { Primitive_0_Args (); @@ -333,7 +333,7 @@ DEFINE_PRIMITIVE ("GET-FIXED-OBJECTS-VECTOR", Prim_Get_Fixed_Objects_Vector, 0) #define DELAYED_P(object) ((OBJECT_TYPE (object)) == TC_DELAYED) -DEFINE_PRIMITIVE ("FORCE", Prim_Force, 1) +DEFINE_PRIMITIVE ("FORCE", Prim_force, 1, 1, 0) { fast Pointer thunk; PRIMITIVE_HEADER (1); @@ -342,7 +342,7 @@ DEFINE_PRIMITIVE ("FORCE", Prim_Force, 1) thunk = (ARG_REF (1)); switch (Vector_Ref (thunk, THUNK_SNAPPED)) { - case TRUTH: + case SHARP_T: PRIMITIVE_RETURN (Vector_Ref (thunk, THUNK_VALUE)); case FIXNUM_ZERO: @@ -384,7 +384,7 @@ DEFINE_PRIMITIVE ("FORCE", Prim_Force, 1) variable Current_State_Point is used to find the current state point and no state space is side-effected as the code runs. */ -DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT", Prim_Execute_At_New_Point, 4) +DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT", Prim_execute_at_new_point, 4, 4, 0) { Pointer New_Point, Old_Point; Primitive_4_Args(); @@ -440,7 +440,7 @@ DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT", Prim_Execute_At_New_Point, 4) Otherwise a (actually, THE) immutable space is created and the microcode will track motions in this space. */ -DEFINE_PRIMITIVE ("MAKE-STATE-SPACE", Prim_Make_State_Space, 1) +DEFINE_PRIMITIVE ("MAKE-STATE-SPACE", Prim_make_state_space, 1, 1, 0) { Pointer New_Point; Primitive_1_Arg(); @@ -475,7 +475,7 @@ DEFINE_PRIMITIVE ("MAKE-STATE-SPACE", Prim_Make_State_Space, 1) } } -DEFINE_PRIMITIVE ("CURRENT-DYNAMIC-STATE", Prim_Current_Dynamic_State, 1) +DEFINE_PRIMITIVE ("CURRENT-DYNAMIC-STATE", Prim_current_dynamic_state, 1, 1, 0) { Primitive_1_Arg(); @@ -493,7 +493,7 @@ DEFINE_PRIMITIVE ("CURRENT-DYNAMIC-STATE", Prim_Current_Dynamic_State, 1) PRIMITIVE_RETURN( Vector_Ref(Arg1, STATE_SPACE_NEAREST_POINT)); } -DEFINE_PRIMITIVE ("SET-CURRENT-DYNAMIC-STATE!", Prim_Set_Dynamic_State, 1) +DEFINE_PRIMITIVE ("SET-CURRENT-DYNAMIC-STATE!", Prim_set_dynamic_state, 1, 1, 0) { Pointer State_Space, Result; Primitive_1_Arg(); @@ -522,7 +522,7 @@ DEFINE_PRIMITIVE ("SET-CURRENT-DYNAMIC-STATE!", Prim_Set_Dynamic_State, 1) ENVIRONMENT. This is like Eval, except that it expects its input to be syntaxed into SCode rather than just a list. */ -DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_Scode_Eval, 2) +DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_scode_eval, 2, 2, 0) { Primitive_2_Args(); @@ -538,7 +538,7 @@ DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_Scode_Eval, 2) /* (GET-INTERRUPT-ENABLES) Returns the current interrupt mask. */ -DEFINE_PRIMITIVE ("GET-INTERRUPT-ENABLES", Prim_get_interrupt_enables, 0) +DEFINE_PRIMITIVE ("GET-INTERRUPT-ENABLES", Prim_get_interrupt_enables, 0, 0, 0) { PRIMITIVE_HEADER (0); @@ -550,7 +550,7 @@ DEFINE_PRIMITIVE ("GET-INTERRUPT-ENABLES", Prim_get_interrupt_enables, 0) returns the previous value. See MASK_INTERRUPT_ENABLES for more information on interrupts. */ -DEFINE_PRIMITIVE ("SET-INTERRUPT-ENABLES!", Prim_set_interrupt_enables, 1) +DEFINE_PRIMITIVE ("SET-INTERRUPT-ENABLES!", Prim_set_interrupt_enables, 1, 1, 0) { long previous; PRIMITIVE_HEADER (1); @@ -563,7 +563,7 @@ DEFINE_PRIMITIVE ("SET-INTERRUPT-ENABLES!", Prim_set_interrupt_enables, 1) /* (GET-FLUID-BINDINGS) Gets the microcode fluid-bindings variable. */ -DEFINE_PRIMITIVE ("GET-FLUID-BINDINGS", Prim_get_fluid_bindings, 0) +DEFINE_PRIMITIVE ("GET-FLUID-BINDINGS", Prim_get_fluid_bindings, 0, 0, 0) { PRIMITIVE_HEADER (0); @@ -574,7 +574,7 @@ DEFINE_PRIMITIVE ("GET-FLUID-BINDINGS", Prim_get_fluid_bindings, 0) Sets the microcode fluid-bindings variable. Returns the previous value. */ -DEFINE_PRIMITIVE ("SET-FLUID-BINDINGS!", Prim_set_fluid_bindings, 1) +DEFINE_PRIMITIVE ("SET-FLUID-BINDINGS!", Prim_set_fluid_bindings, 1, 1, 0) { Pointer new_bindings; Pointer old_bindings; @@ -600,7 +600,7 @@ DEFINE_PRIMITIVE ("SET-FLUID-BINDINGS!", Prim_set_fluid_bindings, 1) The longjmp forces the interpreter to recache. */ -DEFINE_PRIMITIVE ("SET-CURRENT-HISTORY!", Prim_Set_Current_History, 1) +DEFINE_PRIMITIVE ("SET-CURRENT-HISTORY!", Prim_set_current_history, 1, 1, 0) { Primitive_1_Arg(); @@ -625,7 +625,7 @@ DEFINE_PRIMITIVE ("SET-CURRENT-HISTORY!", Prim_Set_Current_History, 1) contains the names of the slots in the vector. Returns (bad style to depend on this) the previous fixed objects vector. */ -DEFINE_PRIMITIVE ("SET-FIXED-OBJECTS-VECTOR!", Prim_Set_Fixed_Objects_Vector, 1) +DEFINE_PRIMITIVE ("SET-FIXED-OBJECTS-VECTOR!", Prim_set_fixed_objects_vector, 1, 1, 0) { Pointer Result; Primitive_1_Arg(); @@ -654,7 +654,7 @@ DEFINE_PRIMITIVE ("SET-FIXED-OBJECTS-VECTOR!", Prim_Set_Fixed_Objects_Vector, 1) necessary enter and exit forms to get from the current state to the new state as specified by STATE_POINT. */ -DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_Translate_To_Point, 1) +DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_translate_to_point, 1, 1, 0) { Primitive_1_Arg(); @@ -675,7 +675,7 @@ DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_Translate_To_Point, 1) restored back and collection resumes. The net result is that the THUNK is called with history collection turned off. */ -DEFINE_PRIMITIVE ("WITH-HISTORY-DISABLED", Prim_With_History_Disabled, 1) +DEFINE_PRIMITIVE ("WITH-HISTORY-DISABLED", Prim_with_history_disabled, 1, 1, 0) { Pointer *First_Rib, *Rib, *Second_Rib; Primitive_1_Arg(); @@ -708,7 +708,7 @@ DEFINE_PRIMITIVE ("WITH-HISTORY-DISABLED", Prim_With_History_Disabled, 1) /* Called with a mask and a thunk */ -DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_With_Interrupt_Mask, 2) +DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_with_interrupt_mask, 2, 2, 0) { Pointer mask; Primitive_2_Args(); @@ -732,7 +732,7 @@ DEFINE_PRIMITIVE ("WITH-INTERRUPT-MASK", Prim_With_Interrupt_Mask, 2) /* Called with a mask and a thunk */ -DEFINE_PRIMITIVE ("WITH-INTERRUPTS-REDUCED", Prim_With_Interrupts_Reduced, 2) +DEFINE_PRIMITIVE ("WITH-INTERRUPTS-REDUCED", Prim_with_interrupts_reduced, 2, 2, 0) { Pointer mask; long new_interrupt_mask, old_interrupt_mask; @@ -770,7 +770,7 @@ DEFINE_PRIMITIVE ("WITH-INTERRUPTS-REDUCED", Prim_With_Interrupts_Reduced, 2) arguments. Restores the state of the machine from the control point, and then calls the THUNK in this new state. */ -DEFINE_PRIMITIVE ("WITHIN-CONTROL-POINT", Prim_Within_Control_Point, 2) +DEFINE_PRIMITIVE ("WITHIN-CONTROL-POINT", Prim_within_control_point, 2, 2, 0) { Primitive_2_Args(); diff --git a/v7/src/microcode/hunk.c b/v7/src/microcode/hunk.c index 4d7bd014f..1cf428aaa 100644 --- a/v7/src/microcode/hunk.c +++ b/v7/src/microcode/hunk.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,19 +30,18 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hunk.c,v 9.24 1987/11/17 08:12:44 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hunk.c,v 9.25 1988/08/15 20:49:17 cph Rel $ * * Support for Hunk3s (triples) */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* (HUNK3-CONS FIRST SECOND THIRD) Returns a triple consisting of the specified values. */ -Built_In_Primitive(Prim_Hunk3_Cons, 3, "HUNK3-CONS", 0x28) -Define_Primitive(Prim_Hunk3_Cons, 3, "HUNK3-CONS") +DEFINE_PRIMITIVE ("HUNK3-CONS", Prim_hunk3_cons, 3, 3, 0) { Primitive_3_Args(); @@ -56,8 +55,7 @@ Define_Primitive(Prim_Hunk3_Cons, 3, "HUNK3-CONS") /* (HUNK3-CXR TRIPLE N) Returns the Nth item from the TRIPLE. N must be 0, 1, or 2. */ -Built_In_Primitive(Prim_Hunk3_Cxr, 2, "HUNK3-CXR", 0x29) -Define_Primitive(Prim_Hunk3_Cxr, 2, "HUNK3-CXR") +DEFINE_PRIMITIVE ("HUNK3-CXR", Prim_hunk3_cxr, 2, 2, 0) { long Offset; Primitive_2_Args(); @@ -72,8 +70,7 @@ Define_Primitive(Prim_Hunk3_Cxr, 2, "HUNK3-CXR") Stores VALUE in the Nth item of TRIPLE. N must be 0, 1, or 2. Returns the previous contents. */ -Built_In_Primitive(Prim_Hunk3_Set_Cxr, 3, "HUNK3-SET-CXR!", 0x2A) -Define_Primitive(Prim_Hunk3_Set_Cxr, 3, "HUNK3-SET-CXR!") +DEFINE_PRIMITIVE ("HUNK3-SET-CXR!", Prim_hunk3_set_cxr, 3, 3, 0) { long Offset; Primitive_3_Args(); @@ -90,8 +87,7 @@ Define_Primitive(Prim_Hunk3_Set_Cxr, 3, "HUNK3-SET-CXR!") of triple. For example, this would access the operator slot of a COMBINATION_2_OPERAND SCode item. */ -Built_In_Primitive(Prim_Sys_H3_0, 1, "SYSTEM-HUNK3-CXR0", 0x8E) -Define_Primitive(Prim_Sys_H3_0, 1, "SYSTEM-HUNK3-CXR0") +DEFINE_PRIMITIVE ("SYSTEM-HUNK3-CXR0", Prim_sys_h3_0, 1, 1, 0) { Primitive_1_Arg(); @@ -104,8 +100,7 @@ Define_Primitive(Prim_Sys_H3_0, 1, "SYSTEM-HUNK3-CXR0") of triple. For example, this would access the first operand slot of a COMBINATION_2_OPERAND SCode item. */ -Built_In_Primitive(Prim_Sys_H3_1, 1, "SYSTEM-HUNK3-CXR1", 0x91) -Define_Primitive(Prim_Sys_H3_1, 1, "SYSTEM-HUNK3-CXR1") +DEFINE_PRIMITIVE ("SYSTEM-HUNK3-CXR1", Prim_sys_h3_1, 1, 1, 0) { Primitive_1_Arg(); @@ -118,8 +113,7 @@ Define_Primitive(Prim_Sys_H3_1, 1, "SYSTEM-HUNK3-CXR1") of triple. For example, this would access the second operand slot of a COMBINATION_2_OPERAND SCode item. */ -Built_In_Primitive(Prim_Sys_H3_2, 1, "SYSTEM-HUNK3-CXR2", 0x94) -Define_Primitive(Prim_Sys_H3_2, 1, "SYSTEM-HUNK3-CXR2") +DEFINE_PRIMITIVE ("SYSTEM-HUNK3-CXR2", Prim_sys_h3_2, 1, 1, 0) { Primitive_1_Arg(); @@ -133,8 +127,7 @@ Define_Primitive(Prim_Sys_H3_2, 1, "SYSTEM-HUNK3-CXR2") operator slot of a COMBINATION_2_OPERAND SCode item. Returns the previous contents. */ -Built_In_Primitive(Prim_SH3_Set_0, 2, "SYSTEM-HUNK3-SET-CXR0!", 0x8F) -Define_Primitive(Prim_SH3_Set_0, 2, "SYSTEM-HUNK3-SET-CXR0!") +DEFINE_PRIMITIVE ("SYSTEM-HUNK3-SET-CXR0!", Prim_sh3_set_0, 2, 2, 0) { Primitive_2_Args(); Arg_1_GC_Type(GC_Triple); @@ -149,8 +142,7 @@ Define_Primitive(Prim_SH3_Set_0, 2, "SYSTEM-HUNK3-SET-CXR0!") first operand slot of a COMBINATION_2_OPERAND SCode item. Returns the previous contents. */ -Built_In_Primitive(Prim_SH3_Set_1, 2, "SYSTEM-HUNK3-SET-CXR1!", 0x92) -Define_Primitive(Prim_SH3_Set_1, 2, "SYSTEM-HUNK3-SET-CXR1!") +DEFINE_PRIMITIVE ("SYSTEM-HUNK3-SET-CXR1!", Prim_sh3_set_1, 2, 2, 0) { Primitive_2_Args(); Arg_1_GC_Type(GC_Triple); @@ -165,8 +157,7 @@ Define_Primitive(Prim_SH3_Set_1, 2, "SYSTEM-HUNK3-SET-CXR1!") second operand slot of a COMBINATION_2_OPERAND SCode item. Returns the previous contents. */ -Built_In_Primitive(Prim_SH3_Set_2, 2, "SYSTEM-HUNK3-SET-CXR2!", 0x95) -Define_Primitive(Prim_SH3_Set_2, 2, "SYSTEM-HUNK3-SET-CXR2!") +DEFINE_PRIMITIVE ("SYSTEM-HUNK3-SET-CXR2!", Prim_sh3_set_2, 2, 2, 0) { Primitive_2_Args(); Arg_1_GC_Type(GC_Triple); diff --git a/v7/src/microcode/image.c b/v7/src/microcode/image.c index add9958e1..8d42551db 100644 --- a/v7/src/microcode/image.c +++ b/v7/src/microcode/image.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,10 +30,10 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.c,v 9.26 1988/08/10 05:26:54 pas Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.c,v 9.27 1988/08/15 20:49:26 cph Exp $ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "flonum.h" #include "array.h" #include @@ -41,7 +41,7 @@ MIT in each case. */ /* IMAGE PROCESSING... */ /* (much comes from array.c) */ -Define_Primitive(Prim_Read_Image_From_Ascii_File, 1, "READ-IMAGE-FROM-ASCII-FILE") +DEFINE_PRIMITIVE ("READ-IMAGE-FROM-ASCII-FILE", Prim_read_image_from_ascii_file, 1, 1, 0) { long Length, int_pixel_value1, int_pixel_value2, i, j; long nrows, ncols, array_index; FILE *fopen(), *fp; @@ -104,7 +104,7 @@ Define_Primitive(Prim_Read_Image_From_Ascii_File, 1, "READ-IMAGE-FROM-ASCII-FILE return Result; } -Define_Primitive(Prim_Read_Image_From_Cbin_File, 1, "READ-IMAGE-FROM-CBIN-FILE") +DEFINE_PRIMITIVE ("READ-IMAGE-FROM-CBIN-FILE", Prim_read_image_from_cbin_file, 1, 1, 0) { long Length, i,j; long nrows, ncols, array_index; FILE *fopen(), *fp; @@ -156,7 +156,7 @@ Define_Primitive(Prim_Read_Image_From_Cbin_File, 1, "READ-IMAGE-FROM-CBIN-FILE") We need to use 2bint because on many machines (bobcats included) "putw", and "getw" use 4 byte integers (C int) ---> waste lots of space. */ -Define_Primitive(Prim_Read_Image_From_2bint_File, 1, "READ-IMAGE-FROM-2BINT-FILE") +DEFINE_PRIMITIVE ("READ-IMAGE-FROM-2BINT-FILE", Prim_read_image_from_2bint_file, 1, 1, 0) { long Length, i,j; long nrows, ncols, array_index; FILE *fopen(), *fp; @@ -206,7 +206,7 @@ Define_Primitive(Prim_Read_Image_From_2bint_File, 1, "READ-IMAGE-FROM-2BINT-FILE return Result; } -Define_Primitive(Prim_Write_Image_2bint, 2, "WRITE-IMAGE-2BINT") +DEFINE_PRIMITIVE ("WRITE-IMAGE-2BINT", Prim_write_image_2bint, 2, 2, 0) { long Length, i,j; Pointer Pnrows, Pncols, Prest, Parray; REAL *Array; @@ -244,10 +244,10 @@ Define_Primitive(Prim_Write_Image_2bint, 2, "WRITE-IMAGE-2BINT") } Close_File(fp); /*_________________________________*/ - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } -Define_Primitive(Prim_Read_Image_From_CTSCAN_File, 1, "READ-IMAGE-FROM-CTSCAN-FILE") +DEFINE_PRIMITIVE ("READ-IMAGE-FROM-CTSCAN-FILE", Prim_read_image_from_ctscan_file, 1, 1, 0) { long Length, i,j; long nrows, ncols, array_index; FILE *fopen(), *fp; @@ -339,7 +339,7 @@ Image_Mirror_Upside_Down(Array,nrows,ncols,Temp_Row) } } -Define_Primitive(Prim_Subimage, 5, "SUBIMAGE") +DEFINE_PRIMITIVE ("SUBIMAGE", Prim_subimage, 5, 5, 0) { long Length, new_Length; long i,j; Pointer Pnrows, Pncols, Prest, Parray; @@ -399,7 +399,7 @@ Define_Primitive(Prim_Subimage, 5, "SUBIMAGE") /* The following does not work properly, to be fixed if need. */ -Define_Primitive(Prim_Image_Double_To_Float, 1, "IMAGE-DOUBLE-TO-FLOAT!") +DEFINE_PRIMITIVE ("IMAGE-DOUBLE-TO-FLOAT!", Prim_image_double_to_float, 1, 1, 0) { long Length; long i,j; long nrows, ncols; @@ -446,7 +446,7 @@ Define_Primitive(Prim_Image_Double_To_Float, 1, "IMAGE-DOUBLE-TO-FLOAT!") return Arg1; } -Define_Primitive(Prim_Image_Set_Row, 3, "IMAGE-SET-ROW!") +DEFINE_PRIMITIVE ("IMAGE-SET-ROW!", Prim_image_set_row, 3, 3, 0) { long Length, i,j; Pointer Pnrows, Pncols, Prest, Parray; long nrows, ncols, row_to_set; @@ -476,7 +476,7 @@ Define_Primitive(Prim_Image_Set_Row, 3, "IMAGE-SET-ROW!") return Arg1; } -Define_Primitive(Prim_Image_Set_Column, 3, "IMAGE-SET-COLUMN!") +DEFINE_PRIMITIVE ("IMAGE-SET-COLUMN!", Prim_image_set_column, 3, 3, 0) { long Length, i,j; Pointer Pnrows, Pncols, Prest, Parray; long nrows, ncols, col_to_set; @@ -530,7 +530,7 @@ long nrows, ncols, col_to_set; } } -Define_Primitive(Prim_Image_Laplacian, 1, "IMAGE-LAPLACIAN") +DEFINE_PRIMITIVE ("IMAGE-LAPLACIAN", Prim_image_laplacian, 1, 1, 0) { long nrows, ncols, Length; Pointer Pnrows, Pncols, Prest, Parray; REAL *Array, *To_Here; @@ -597,7 +597,7 @@ C_image_laplacian(array, new_array, nrows, ncols) array[i*ncols+j] - (.25)*(array[i*ncols+(j-1)] + array[i*ncols+(j+1)] + array[(i-1)*ncols+j] + array[(i+1)*ncols+j]); } -Define_Primitive(Prim_Image_Double_By_Interpolation, 1, "IMAGE-DOUBLE-BY-INTERPOLATION") +DEFINE_PRIMITIVE ("IMAGE-DOUBLE-BY-INTERPOLATION", Prim_image_double_by_interpolation, 1, 1, 0) { long nrows, ncols, Length; Pointer Pnrows, Pncols, Prest, Parray; REAL *Array, *To_Here; @@ -681,7 +681,7 @@ C_image_double_by_interpolation(array, new_array, nrows, ncols) } } -Define_Primitive(Prim_Image_Make_Ring, 4, "IMAGE-MAKE-RING") +DEFINE_PRIMITIVE ("IMAGE-MAKE-RING", Prim_image_make_ring, 4, 4, 0) { long Length, i,j; long nrows, ncols; long Min_Cycle, Max_Cycle; @@ -743,7 +743,7 @@ long nrows, ncols, low_cycle, high_cycle; /* Periodic-shift without side-effects for code-simplicity */ -Define_Primitive(Prim_Image_Periodic_Shift, 3, "IMAGE-PERIODIC-SHIFT") +DEFINE_PRIMITIVE ("IMAGE-PERIODIC-SHIFT", Prim_image_periodic_shift, 3, 3, 0) { long Length, i,j; Pointer Pnrows, Pncols, Prest, Parray; long nrows, ncols; @@ -815,7 +815,7 @@ C_Image_Periodic_Shift(Array, New_Array, nrows, ncols, ver_shift, hor_shift) /* Rotations and stuff */ -Define_Primitive(Prim_Image_Transpose, 1, "IMAGE-TRANSPOSE!") +DEFINE_PRIMITIVE ("IMAGE-TRANSPOSE!", Prim_image_transpose, 1, 1, 0) { long Length; Pointer Pnrows, Pncols, Prest, Parray; long nrows, ncols; @@ -855,7 +855,7 @@ Define_Primitive(Prim_Image_Transpose, 1, "IMAGE-TRANSPOSE!") return Arg1; } -Define_Primitive(Prim_Image_Rotate_90clw, 1, "IMAGE-ROTATE-90CLW!") +DEFINE_PRIMITIVE ("IMAGE-ROTATE-90CLW!", Prim_image_rotate_90clw, 1, 1, 0) { long Length; Pointer Pnrows, Pncols, Prest, Parray; long nrows, ncols; @@ -888,7 +888,7 @@ Define_Primitive(Prim_Image_Rotate_90clw, 1, "IMAGE-ROTATE-90CLW!") return Arg1; } -Define_Primitive(Prim_Image_Rotate_90cclw, 1, "IMAGE-ROTATE-90CCLW!") +DEFINE_PRIMITIVE ("IMAGE-ROTATE-90CCLW!", Prim_image_rotate_90cclw, 1, 1, 0) { long Length; Pointer Pnrows, Pncols, Prest, Parray; long nrows, ncols; @@ -921,7 +921,7 @@ Define_Primitive(Prim_Image_Rotate_90cclw, 1, "IMAGE-ROTATE-90CCLW!") return Arg1; } -Define_Primitive(Prim_Image_Mirror, 1, "IMAGE-MIRROR!") +DEFINE_PRIMITIVE ("IMAGE-MIRROR!", Prim_image_mirror, 1, 1, 0) { long Length; Pointer Pnrows, Pncols, Prest, Parray; long nrows, ncols; @@ -1077,7 +1077,7 @@ C_Rotate_90clw_Mirror_Image(Array, Rotated_Array, nrows, ncols) /* -Define_Primitive(Prim_Sample_Periodic_2d_Function, 4, "SAMPLE-PERIODIC-2D-FUNCTION") +DEFINE_PRIMITIVE ("SAMPLE-PERIODIC-2D-FUNCTION", Prim_sample_periodic_2d_function, 4, 4, 0) { long N, i, allocated_cells, Function_Number; REAL Signal_Frequency, Sampling_Frequency, DT, DTi; REAL twopi = 6.28318530717958, twopi_f_dt; @@ -1149,7 +1149,7 @@ Define_Primitive(Prim_Sample_Periodic_2d_Function, 4, "SAMPLE-PERIODIC-2D-FUNCTI (Result)=Sum; \ } -Define_Primitive(Prim_Convolution_Point, 3, "CONVOLUTION-POINT") +DEFINE_PRIMITIVE ("CONVOLUTION-POINT", Prim_convolution_point, 3, 3, 0) { long Length1, Length2, N; REAL *Array1, *Array2; REAL C_Result; @@ -1167,7 +1167,7 @@ Define_Primitive(Prim_Convolution_Point, 3, "CONVOLUTION-POINT") Reduced_Flonum_Result(C_Result); } -Define_Primitive(Prim_Array_Convolution, 2, "ARRAY-CONVOLUTION") +DEFINE_PRIMITIVE ("ARRAY-CONVOLUTION", Prim_array_convolution, 2, 2, 0) { long Endpoint1, Endpoint2, allocated_cells, i; / * ASSUME A SIGNAL FROM INDEX 0 TO ENDPOINT=LENGTH-1 * / long Resulting_Length; @@ -1202,7 +1202,7 @@ Define_Primitive(Prim_Array_Convolution, 2, "ARRAY-CONVOLUTION") /* m_pi = 3.14159265358979323846264338327950288419716939937510; */ /* -Define_Primitive(Prim_Sample_Periodic_Function, 4, "SAMPLE-PERIODIC-FUNCTION") +DEFINE_PRIMITIVE ("SAMPLE-PERIODIC-FUNCTION", Prim_sample_periodic_function, 4, 4, 0) { long N, i, allocated_cells, Function_Number; REAL Signal_Frequency, Sampling_Frequency, DT, DTi; REAL twopi = 6.28318530717958, twopi_f_dt; @@ -1292,7 +1292,7 @@ REAL unit_triangle_wave(t) REAL t; else return( (twopi - t_bar) / pi ); } -Define_Primitive(Prim_Sample_Aperiodic_Function, 3, "SAMPLE-APERIODIC-FUNCTION") +DEFINE_PRIMITIVE ("SAMPLE-APERIODIC-FUNCTION", Prim_sample_aperiodic_function, 3, 3, 0) { long N, i, allocated_cells, Function_Number; REAL Sampling_Frequency, DT, DTi; REAL twopi = 6.28318530717958; @@ -1352,7 +1352,7 @@ Define_Primitive(Prim_Sample_Aperiodic_Function, 3, "SAMPLE-APERIODIC-FUNCTION") return Result; } -Define_Primitive(Prim_Array_Periodic_Downsample, 2, "ARRAY-PERIODIC-DOWNSAMPLE") +DEFINE_PRIMITIVE ("ARRAY-PERIODIC-DOWNSAMPLE", Prim_array_periodic_downsample, 2, 2, 0) { long Length, Pseudo_Length, Sampling_Ratio; REAL *Array, *To_Here; Pointer Result; @@ -1380,7 +1380,7 @@ Define_Primitive(Prim_Array_Periodic_Downsample, 2, "ARRAY-PERIODIC-DOWNSAMPLE") return Result; } -Define_Primitive(Prim_Array_Periodic_Shift, 2, "ARRAY-PERIODIC-SHIFT") +DEFINE_PRIMITIVE ("ARRAY-PERIODIC-SHIFT", Prim_array_periodic_shift, 2, 2, 0) { long Length, Shift; REAL *Array, *To_Here; Pointer Result; @@ -1407,7 +1407,7 @@ Define_Primitive(Prim_Array_Periodic_Shift, 2, "ARRAY-PERIODIC-SHIFT") / * this should really be done in SCHEME using ARRAY-MAP ! * / -Define_Primitive(Prim_Array_Aperiodic_Downsample, 2, "ARRAY-APERIODIC-DOWNSAMPLE") +DEFINE_PRIMITIVE ("ARRAY-APERIODIC-DOWNSAMPLE", Prim_array_aperiodic_downsample, 2, 2, 0) { long Length, New_Length, Sampling_Ratio; REAL *Array, *To_Here; Pointer Result; diff --git a/v7/src/microcode/image.h b/v7/src/microcode/image.h index f725fa30c..9301e839e 100644 --- a/v7/src/microcode/image.h +++ b/v7/src/microcode/image.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.h,v 9.21 1987/01/22 14:27:37 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.h,v 9.22 1988/08/15 20:49:39 cph Rel $ */ extern Image_Fast_Transpose(); /* REAL *Array; long nrows; OPTIMIZATION for square images */ extern Image_Transpose(); /* REAL *Array, *New_Array; long nrows, ncols; */ diff --git a/v7/src/microcode/intercom.c b/v7/src/microcode/intercom.c index 978be6dae..26d80cada 100644 --- a/v7/src/microcode/intercom.c +++ b/v7/src/microcode/intercom.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,14 +30,14 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/intercom.c,v 9.24 1987/12/04 22:16:56 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/intercom.c,v 9.25 1988/08/15 20:49:47 cph Exp $ * * Single-processor simulation of locking, propagating, and * communicating stuff. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "locks.h" #include "zones.h" @@ -62,7 +62,7 @@ MIT in each case. */ processors have begun execution of WORK (or TEST returns false). */ -DEFINE_PRIMITIVE("GLOBAL-INTERRUPT", Prim_Send_Global_Interrupt, 3) +DEFINE_PRIMITIVE ("GLOBAL-INTERRUPT", Prim_send_global_interrupt, 3, 3, 0) { long Saved_Zone, Which_Level; @@ -90,7 +90,7 @@ Global_Int_Part_2(Which_Level, Do_It) return Do_It; } -DEFINE_PRIMITIVE("PUT-WORK", Prim_Put_Work, 1) +DEFINE_PRIMITIVE ("PUT-WORK", Prim_put_work, 1, 1, 0) { Pointer The_Queue, Queue_Tail, New_Entry; Primitive_1_Arg(); @@ -121,10 +121,10 @@ DEFINE_PRIMITIVE("PUT-WORK", Prim_Put_Work, 1) { Vector_Set(Queue_Tail, CONS_CDR, New_Entry); } - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } -DEFINE_PRIMITIVE("PUT-WORK-IN-FRONT", Prim_Put_Work_In_Front, 1) +DEFINE_PRIMITIVE ("PUT-WORK-IN-FRONT", Prim_put_work_in_front, 1, 1, 0) { Pointer The_Queue, Queue_Head, New_Entry; Primitive_1_Arg(); @@ -151,10 +151,10 @@ DEFINE_PRIMITIVE("PUT-WORK-IN-FRONT", Prim_Put_Work_In_Front, 1) { Vector_Set(The_Queue, CONS_CDR, New_Entry); } - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } -DEFINE_PRIMITIVE("DRAIN-WORK-QUEUE!", Prim_Drain_Queue, 0) +DEFINE_PRIMITIVE ("DRAIN-WORK-QUEUE!", Prim_drain_queue, 0, 0, 0) { Pointer The_Queue; Primitive_0_Args(); @@ -166,7 +166,7 @@ DEFINE_PRIMITIVE("DRAIN-WORK-QUEUE!", Prim_Drain_Queue, 0) NIL); } -DEFINE_PRIMITIVE("PEEK-AT-WORK-QUEUE", Prim_Peek_Queue, 0) +DEFINE_PRIMITIVE ("PEEK-AT-WORK-QUEUE", Prim_peek_queue, 0, 0, 0) { Pointer The_Queue, This_Cons, Last_Cons; Primitive_0_Args(); @@ -189,7 +189,7 @@ DEFINE_PRIMITIVE("PEEK-AT-WORK-QUEUE", Prim_Peek_Queue, 0) PRIMITIVE_RETURN(This_Cons); } -DEFINE_PRIMITIVE("GET-WORK", Prim_Get_Work, 1) +DEFINE_PRIMITIVE ("GET-WORK", Prim_get_work, 1, 1, 0) { Pointer Get_Work(); Primitive_1_Arg(); @@ -240,7 +240,7 @@ Pointer Get_Work(Arg1) return (Result); } -DEFINE_PRIMITIVE("AWAIT-SYNCHRONY", Prim_Await_Sync, 1) +DEFINE_PRIMITIVE ("AWAIT-SYNCHRONY", Prim_await_sync, 1, 1, 0) { Primitive_1_Arg(); @@ -249,31 +249,31 @@ DEFINE_PRIMITIVE("AWAIT-SYNCHRONY", Prim_Await_Sync, 1) { Primitive_Error(ERR_ARG_1_BAD_RANGE); } - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } -DEFINE_PRIMITIVE("N-INTERPRETERS", Prim_N_Interps, 0) +DEFINE_PRIMITIVE ("N-INTERPRETERS", Prim_n_interps, 0, 0, 0) { Primitive_0_Args(); PRIMITIVE_RETURN(MAKE_UNSIGNED_FIXNUM(1)); } -DEFINE_PRIMITIVE("MY-PROCESSOR-NUMBER", Prim_My_Proc, 0) +DEFINE_PRIMITIVE ("MY-PROCESSOR-NUMBER", Prim_my_proc, 0, 0, 0) { Primitive_0_Args(); PRIMITIVE_RETURN(MAKE_UNSIGNED_FIXNUM(0)); } -DEFINE_PRIMITIVE("MY-INTERPRETER-NUMBER", Prim_My_Interp_Number, 0) +DEFINE_PRIMITIVE ("MY-INTERPRETER-NUMBER", Prim_my_interp_number, 0, 0, 0) { Primitive_0_Args(); PRIMITIVE_RETURN(MAKE_UNSIGNED_FIXNUM(0)); } -DEFINE_PRIMITIVE("ZERO-ZONES", Prim_Zero_Zones, 0) +DEFINE_PRIMITIVE ("ZERO-ZONES", Prim_zero_zones, 0, 0, 0) { long i; Primitive_0_Args(); @@ -286,18 +286,18 @@ DEFINE_PRIMITIVE("ZERO-ZONES", Prim_Zero_Zones, 0) Old_Time=Sys_Clock(); #endif - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } /* These are really used by GC on a true parallel machine */ -DEFINE_PRIMITIVE("GC-NEEDED?", Prim_GC_Needed, 0) +DEFINE_PRIMITIVE ("GC-NEEDED?", Prim_gc_needed, 0, 0, 0) { Primitive_0_Args(); if ((Free + GC_Space_Needed) >= MemTop) { - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } else { @@ -305,25 +305,25 @@ DEFINE_PRIMITIVE("GC-NEEDED?", Prim_GC_Needed, 0) } } -DEFINE_PRIMITIVE("SLAVE-GC-BEFORE-SYNC", Prim_Slave_Before, 0) +DEFINE_PRIMITIVE ("SLAVE-GC-BEFORE-SYNC", Prim_slave_before, 0, 0, 0) { Primitive_0_Args(); - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } -DEFINE_PRIMITIVE("SLAVE-GC-AFTER-SYNC", Prim_Slave_After, 0) +DEFINE_PRIMITIVE ("SLAVE-GC-AFTER-SYNC", Prim_slave_after, 0, 0, 0) { Primitive_0_Args(); - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } -DEFINE_PRIMITIVE("MASTER-GC-BEFORE-SYNC", Prim_Master_Before, 0) +DEFINE_PRIMITIVE ("MASTER-GC-BEFORE-SYNC", Prim_master_before, 0, 0, 0) { Primitive_0_Args(); - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } /* This primitive caches the Scheme object for the garbage collector @@ -331,7 +331,7 @@ DEFINE_PRIMITIVE("MASTER-GC-BEFORE-SYNC", Prim_Master_Before, 0) expensive search each time. */ -DEFINE_PRIMITIVE("MASTER-GC-LOOP", Prim_Master_GC, 1) +DEFINE_PRIMITIVE ("MASTER-GC-LOOP", Prim_master_gc, 1, 1, 0) { static Pointer gc_prim = NIL; extern Pointer make_primitive(); diff --git a/v7/src/microcode/intern.c b/v7/src/microcode/intern.c index c14c98de2..72f10f8f7 100644 --- a/v7/src/microcode/intern.c +++ b/v7/src/microcode/intern.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,12 +30,12 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intern.c,v 9.44 1987/11/23 05:17:30 cph Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intern.c,v 9.45 1988/08/15 20:49:57 cph Exp $ */ /* Utilities for manipulating symbols. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "trap.h" #include "string.h" @@ -219,7 +219,7 @@ Find_Symbol (scheme_string) Similar to INTERN-CHARACTER-LIST, except this one takes a string instead of a list of ascii values as argument. */ -DEFINE_PRIMITIVE ("STRING->SYMBOL", Prim_String_To_Symbol, 1) +DEFINE_PRIMITIVE ("STRING->SYMBOL", Prim_string_to_symbol, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -235,7 +235,7 @@ DEFINE_PRIMITIVE ("STRING->SYMBOL", Prim_String_To_Symbol, 1) 255. Thus non-printing, lower-case, and special characters can be put into symbols this way. */ -DEFINE_PRIMITIVE ("INTERN-CHARACTER-LIST", Prim_Intern_Character_List, 1) +DEFINE_PRIMITIVE ("INTERN-CHARACTER-LIST", Prim_intern_character_list, 1, 1, 0) { extern Pointer list_to_string(); PRIMITIVE_HEADER (1); @@ -248,7 +248,7 @@ DEFINE_PRIMITIVE ("INTERN-CHARACTER-LIST", Prim_Intern_Character_List, 1) algorithm used for interning symbols. It is intended for use by the reader in creating interned symbols. */ -DEFINE_PRIMITIVE ("STRING-HASH", Prim_String_Hash, 1) +DEFINE_PRIMITIVE ("STRING-HASH", Prim_string_hash, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -256,7 +256,7 @@ DEFINE_PRIMITIVE ("STRING-HASH", Prim_String_Hash, 1) PRIMITIVE_RETURN (Hash (ARG_REF (1))); } -DEFINE_PRIMITIVE ("STRING-HASH-MOD", Prim_string_hash_mod, 2) +DEFINE_PRIMITIVE ("STRING-HASH-MOD", Prim_string_hash_mod, 2, 2, 0) { PRIMITIVE_HEADER (2); @@ -273,7 +273,7 @@ DEFINE_PRIMITIVE ("STRING-HASH-MOD", Prim_string_hash_mod, 2) symbols in Fasload, and is really intended only for that purpose. */ -DEFINE_PRIMITIVE ("CHARACTER-LIST-HASH", Prim_Character_List_Hash, 1) +DEFINE_PRIMITIVE ("CHARACTER-LIST-HASH", Prim_character_list_hash, 1, 1, 0) { fast Pointer char_list; long Length; diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c index 7b23e743e..d3e446790 100644 --- a/v7/src/microcode/interp.c +++ b/v7/src/microcode/interp.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.44 1988/05/05 08:42:47 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.45 1988/08/15 20:50:06 cph Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -1928,7 +1928,7 @@ Primitive_Internal_Apply: GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); if (GC_Daemon_Proc == NIL) { - RESULT_OF_PURIFY (TRUTH); + RESULT_OF_PURIFY (SHARP_T); break; } Store_Expression(NIL); @@ -1942,7 +1942,7 @@ Primitive_Internal_Apply: } case RC_PURIFY_GC_2: - RESULT_OF_PURIFY (TRUTH); + RESULT_OF_PURIFY (SHARP_T); break; case RC_REPEAT_DISPATCH: @@ -2086,7 +2086,7 @@ Primitive_Internal_Apply: /* Interpret(), continued */ case RC_SNAP_NEED_THUNK: - Vector_Set(Fetch_Expression(), THUNK_SNAPPED, TRUTH); + Vector_Set(Fetch_Expression(), THUNK_SNAPPED, SHARP_T); Vector_Set(Fetch_Expression(), THUNK_VALUE, Val); break; diff --git a/v7/src/microcode/interp.h b/v7/src/microcode/interp.h index 5e6061975..63785a947 100644 --- a/v7/src/microcode/interp.h +++ b/v7/src/microcode/interp.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.h,v 9.29 1987/12/23 03:43:31 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.h,v 9.30 1988/08/15 20:50:22 cph Exp $ * * Macros used by the interpreter and some utilities. * diff --git a/v7/src/microcode/intrpt.h b/v7/src/microcode/intrpt.h index 2deef3493..ef4a14e82 100644 --- a/v7/src/microcode/intrpt.h +++ b/v7/src/microcode/intrpt.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intrpt.h,v 1.3 1987/12/13 22:19:36 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intrpt.h,v 1.4 1988/08/15 20:50:33 cph Exp $ * * Interrupt manipulation utilities. */ diff --git a/v7/src/microcode/list.c b/v7/src/microcode/list.c index cda529e1e..24bb957b2 100644 --- a/v7/src/microcode/list.c +++ b/v7/src/microcode/list.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,20 +30,19 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/list.c,v 9.25 1987/11/17 08:13:49 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/list.c,v 9.26 1988/08/15 20:50:44 cph Rel $ * * List creation and manipulation primitives. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* (CONS LEFT RIGHT) Creates a pair with left component LEFT and right component RIGHT. */ -Built_In_Primitive(Prim_Cons, 2, "CONS", 0x20) -Define_Primitive(Prim_Cons, 2, "CONS") +DEFINE_PRIMITIVE ("CONS", Prim_cons, 2, 2, 0) { Primitive_2_Args(); @@ -56,8 +55,7 @@ Define_Primitive(Prim_Cons, 2, "CONS") /* (CDR PAIR) Returns the second element in the pair. */ -Built_In_Primitive(Prim_Cdr, 1, "CDR", 0x22) -Define_Primitive(Prim_Cdr, 1, "CDR") +DEFINE_PRIMITIVE ("CDR", Prim_cdr, 1, 1, 0) { Primitive_1_Arg(); @@ -68,8 +66,7 @@ Define_Primitive(Prim_Cdr, 1, "CDR") /* (CAR PAIR) Returns the first element in the pair. */ -Built_In_Primitive(Prim_Car, 1, "CAR", 0x21) -Define_Primitive(Prim_Car, 1, "CAR") +DEFINE_PRIMITIVE ("CAR", Prim_car, 1, 1, 0) { Primitive_1_Arg(); @@ -85,8 +82,7 @@ Define_Primitive(Prim_Car, 1, "CAR") 11 = CAR 111 = CAAR 100 = CDDR ... */ -Built_In_Primitive(Prim_General_Car_Cdr, 2, "GENERAL-CAR-CDR", 0x27) -Define_Primitive(Prim_General_Car_Cdr, 2, "GENERAL-CAR-CDR") +DEFINE_PRIMITIVE ("GENERAL-CAR-CDR", Prim_general_car_cdr, 2, 2, 0) { fast long CAR_CDR_Pattern; Primitive_2_Args(); @@ -111,8 +107,7 @@ Define_Primitive(Prim_General_Car_Cdr, 2, "GENERAL-CAR-CDR") testing equality. Returns NIL if ITEM is not found, or the tail of the list whose CAAR is ITEM. */ -Built_In_Primitive(Prim_Assq, 2, "ASSQ", 0x5E) -Define_Primitive(Prim_Assq, 2, "ASSQ") +DEFINE_PRIMITIVE ("ASSQ", Prim_assq, 2, 2, 0) { Pointer This_Assoc_Pair, Key; Primitive_2_Args(); @@ -138,8 +133,7 @@ Define_Primitive(Prim_Assq, 2, "ASSQ") Returns the number of items in the list. LENGTH will loop forever if given a circular structure. */ -Built_In_Primitive(Prim_Length, 1, "LENGTH", 0x5D) -Define_Primitive(Prim_Length, 1, "LENGTH") +DEFINE_PRIMITIVE ("LENGTH", Prim_length, 1, 1, 0) { fast long i; Primitive_1_Arg(); @@ -160,8 +154,7 @@ Define_Primitive(Prim_Length, 1, "LENGTH") Searches LIST for ITEM, using EQ? as a test. Returns NIL if it is not found, or the sublist of LIST whose CAR is ITEM. */ -Built_In_Primitive(Prim_Memq, 2, "MEMQ", 0x1C) -Define_Primitive(Prim_Memq, 2, "MEMQ") +DEFINE_PRIMITIVE ("MEMQ", Prim_memq, 2, 2, 0) { fast Pointer Key; Primitive_2_Args(); @@ -184,8 +177,7 @@ Define_Primitive(Prim_Memq, 2, "MEMQ") /* (SET-CAR! PAIR VALUE) Stores VALUE in the CAR of PAIR. Returns the previous CAR of PAIR. */ -Built_In_Primitive(Prim_Set_Car, 2, "SET-CAR!", 0x23) -Define_Primitive(Prim_Set_Car, 2, "SET-CAR!") +DEFINE_PRIMITIVE ("SET-CAR!", Prim_set_car, 2, 2, 0) { Primitive_2_Args(); @@ -197,8 +189,7 @@ Define_Primitive(Prim_Set_Car, 2, "SET-CAR!") /* (SET-CDR! PAIR VALUE) Stores VALUE in the CDR of PAIR. Returns the previous CDR of PAIR. */ -Built_In_Primitive(Prim_Set_Cdr, 2, "SET-CDR!", 0x24) -Define_Primitive(Prim_Set_Cdr, 2, "SET-CDR!") +DEFINE_PRIMITIVE ("SET-CDR!", Prim_set_cdr, 2, 2, 0) { Primitive_2_Args(); @@ -211,14 +202,13 @@ Define_Primitive(Prim_Set_Cdr, 2, "SET-CDR!") Returns #!TRUE if OBJECT has the type-code LIST (ie if it was created by CONS). Returns NIL otherwise. */ -Built_In_Primitive(Prim_Pair, 1, "PAIR?", 0x7E) -Define_Primitive(Prim_Pair, 1, "PAIR?") +DEFINE_PRIMITIVE ("PAIR?", Prim_pair, 1, 1, 0) { Primitive_1_Arg(); Touch_In_Primitive(Arg1, Arg1); if (Type_Code(Arg1) == TC_LIST) - return TRUTH; + return SHARP_T; else return NIL; } @@ -226,14 +216,13 @@ Define_Primitive(Prim_Pair, 1, "PAIR?") /* (SYSTEM-PAIR? OBJECT) Returns #!TRUE if the garbage collector type of OBJECT is PAIR. */ -Built_In_Primitive(Prim_Sys_Pair, 1, "SYSTEM-PAIR?", 0x85) -Define_Primitive(Prim_Sys_Pair, 1, "SYSTEM-PAIR?") +DEFINE_PRIMITIVE ("SYSTEM-PAIR?", Prim_sys_pair, 1, 1, 0) { Primitive_1_Arg(); Touch_In_Primitive(Arg1, Arg1); if (GC_Type_List(Arg1)) - return TRUTH; + return SHARP_T; else return NIL; } @@ -241,8 +230,7 @@ Define_Primitive(Prim_Sys_Pair, 1, "SYSTEM-PAIR?") /* (SYSTEM-PAIR-CAR GC-PAIR) Same as CAR, but for anything of GC type PAIR. */ -Built_In_Primitive(Prim_Sys_Pair_Car, 1, "SYSTEM-PAIR-CAR", 0x86) -Define_Primitive(Prim_Sys_Pair_Car, 1, "SYSTEM-PAIR-CAR") +DEFINE_PRIMITIVE ("SYSTEM-PAIR-CAR", Prim_sys_pair_car, 1, 1, 0) { Primitive_1_Arg(); @@ -253,8 +241,7 @@ Define_Primitive(Prim_Sys_Pair_Car, 1, "SYSTEM-PAIR-CAR") /* (SYSTEM-PAIR-CDR GC-PAIR) Same as CDR, but for anything of GC type PAIR. */ -Built_In_Primitive(Prim_Sys_Pair_Cdr, 1, "SYSTEM-PAIR-CDR", 0x87) -Define_Primitive(Prim_Sys_Pair_Cdr, 1, "SYSTEM-PAIR-CDR") +DEFINE_PRIMITIVE ("SYSTEM-PAIR-CDR", Prim_sys_pair_cdr, 1, 1, 0) { Primitive_1_Arg(); @@ -266,8 +253,7 @@ Define_Primitive(Prim_Sys_Pair_Cdr, 1, "SYSTEM-PAIR-CDR") Like CONS, but returns an object with the specified type code (not limited to type code LIST). */ -Built_In_Primitive(Prim_Sys_Pair_Cons, 3, "SYSTEM-PAIR-CONS", 0x84) -Define_Primitive(Prim_Sys_Pair_Cons, 3, "SYSTEM-PAIR-CONS") +DEFINE_PRIMITIVE ("SYSTEM-PAIR-CONS", Prim_sys_pair_cons, 3, 3, 0) { long Type; Primitive_3_Args(); @@ -291,8 +277,7 @@ Define_Primitive(Prim_Sys_Pair_Cons, 3, "SYSTEM-PAIR-CONS") /* (SYSTEM-PAIR-SET-CAR! GC-PAIR NEW_CAR) Same as SET-CAR!, but for anything of GC type PAIR. */ -Built_In_Primitive(Prim_Sys_Set_Car, 2, "SYSTEM-PAIR-SET-CAR!", 0x88) -Define_Primitive(Prim_Sys_Set_Car, 2, "SYSTEM-PAIR-SET-CAR!") +DEFINE_PRIMITIVE ("SYSTEM-PAIR-SET-CAR!", Prim_sys_set_car, 2, 2, 0) { Primitive_2_Args(); @@ -304,8 +289,7 @@ Define_Primitive(Prim_Sys_Set_Car, 2, "SYSTEM-PAIR-SET-CAR!") /* (SYSTEM-PAIR-SET-CDR! GC-PAIR NEW_CDR) Same as SET-CDR!, but for anything of GC type PAIR. */ -Built_In_Primitive(Prim_Sys_Set_Cdr, 2, "SYSTEM-PAIR-SET-CDR!", 0x89) -Define_Primitive(Prim_Sys_Set_Cdr, 2, "SYSTEM-PAIR-SET-CDR!") +DEFINE_PRIMITIVE ("SYSTEM-PAIR-SET-CDR!", Prim_sys_set_cdr, 2, 2, 0) { Primitive_2_Args(); diff --git a/v7/src/microcode/load.c b/v7/src/microcode/load.c index fff994826..378ed78ab 100644 --- a/v7/src/microcode/load.c +++ b/v7/src/microcode/load.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/load.c,v 9.26 1988/02/10 15:43:53 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/load.c,v 9.27 1988/08/15 20:50:59 cph Rel $ * * This file contains common code for reading internal * format binary files. diff --git a/v7/src/microcode/locks.h b/v7/src/microcode/locks.h index c3fbf41d2..420b039bb 100644 --- a/v7/src/microcode/locks.h +++ b/v7/src/microcode/locks.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/locks.h,v 9.21 1987/01/22 14:28:42 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/locks.h,v 9.22 1988/08/15 20:51:13 cph Exp $ Contains everything needed to lock and unlock parts of the heap, pure/constant space and the like. diff --git a/v7/src/microcode/lookprm.c b/v7/src/microcode/lookprm.c index 0041151ed..568610f38 100644 --- a/v7/src/microcode/lookprm.c +++ b/v7/src/microcode/lookprm.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookprm.c,v 1.1 1988/05/03 21:53:15 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookprm.c,v 1.2 1988/08/15 20:51:21 cph Exp $ * * This file contains environment manipulation primitives. * It makes heavy use of procedures in lookup.c @@ -40,7 +40,7 @@ MIT in each case. */ #include "locks.h" #include "trap.h" #include "lookup.h" -#include "primitive.h" +#include "prims.h" /* NOTE: Although this code has been parallelized, it has not been @@ -98,8 +98,7 @@ do \ (set! ) in . */ -Built_In_Primitive(Prim_Lexical_Assignment, 3, "LEXICAL-ASSIGNMENT", 0x0) -DEFINE_PRIMITIVE("LEXICAL-ASSIGNMENT", Prim_Lexical_Assignment, 3) +DEFINE_PRIMITIVE ("LEXICAL-ASSIGNMENT", Prim_lexical_assignment, 3, 3, 0) { PRIMITIVE_HEADER (3); @@ -114,8 +113,7 @@ DEFINE_PRIMITIVE("LEXICAL-ASSIGNMENT", Prim_Lexical_Assignment, 3) Indistinguishable from evaluating in . */ -Built_In_Primitive(Prim_Lexical_Reference, 2, "LEXICAL-REFERENCE", 0x12) -DEFINE_PRIMITIVE("LEXICAL-REFERENCE", Prim_Lexical_Reference, 2) +DEFINE_PRIMITIVE ("LEXICAL-REFERENCE", Prim_lexical_reference, 2, 2, 0) { PRIMITIVE_HEADER (2); @@ -126,8 +124,7 @@ DEFINE_PRIMITIVE("LEXICAL-REFERENCE", Prim_Lexical_Reference, 2) Identical to LEXICAL_REFERENCE, here for histerical reasons. */ -Built_In_Primitive(Prim_Local_Reference, 2, "LOCAL-REFERENCE", 0x1) -DEFINE_PRIMITIVE("LOCAL-REFERENCE", Prim_Local_Reference, 2) +DEFINE_PRIMITIVE ("LOCAL-REFERENCE", Prim_local_reference, 2, 2, 0) { PRIMITIVE_HEADER (2); @@ -146,8 +143,7 @@ DEFINE_PRIMITIVE("LOCAL-REFERENCE", Prim_Local_Reference, 2) (define ) in . */ -Built_In_Primitive(Prim_Local_Assignment, 3, "LOCAL-ASSIGNMENT", 0x2) -DEFINE_PRIMITIVE("LOCAL-ASSIGNMENT", Prim_Local_Assignment, 3) +DEFINE_PRIMITIVE ("LOCAL-ASSIGNMENT", Prim_local_assignment, 3, 3, 0) { PRIMITIVE_HEADER (3); @@ -162,8 +158,7 @@ DEFINE_PRIMITIVE("LOCAL-ASSIGNMENT", Prim_Local_Assignment, 3) The special form (unassigned? ) is built on top of this. */ -Built_In_Primitive(Prim_Unassigned_Test, 2, "LEXICAL-UNASSIGNED?", 0x18) -DEFINE_PRIMITIVE("LEXICAL-UNASSIGNED?", Prim_Unassigned_Test, 2) +DEFINE_PRIMITIVE ("LEXICAL-UNASSIGNED?", Prim_unassigned_test, 2, 2, 0) { extern long Symbol_Lex_unassigned_p(); PRIMITIVE_HEADER (2); @@ -178,8 +173,7 @@ DEFINE_PRIMITIVE("LEXICAL-UNASSIGNED?", Prim_Unassigned_Test, 2) The special form (unbound? ) is built on top of this. */ -Built_In_Primitive(Prim_Unbound_Test, 2, "LEXICAL-UNBOUND?", 0x33) -DEFINE_PRIMITIVE("LEXICAL-UNBOUND?", Prim_Unbound_Test, 2) +DEFINE_PRIMITIVE ("LEXICAL-UNBOUND?", Prim_unbound_test, 2, 2, 0) { extern long Symbol_Lex_unbound_p(); PRIMITIVE_HEADER (2); @@ -192,9 +186,7 @@ DEFINE_PRIMITIVE("LEXICAL-UNBOUND?", Prim_Unbound_Test, 2) a variable lookup error (unbound or unassigned). */ -Built_In_Primitive(Prim_Unreferenceable_Test, 2, - "LEXICAL-UNREFERENCEABLE?", 0x13) -DEFINE_PRIMITIVE("LEXICAL-UNREFERENCEABLE?", Prim_Unreferenceable_Test, 2) +DEFINE_PRIMITIVE ("LEXICAL-UNREFERENCEABLE?", Prim_unreferenceable_test, 2, 2, 0) { long Result; PRIMITIVE_HEADER (2); @@ -212,7 +204,7 @@ DEFINE_PRIMITIVE("LEXICAL-UNREFERENCEABLE?", Prim_Unreferenceable_Test, 2) case ERR_UNASSIGNED_VARIABLE: case ERR_UNBOUND_VARIABLE: - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); default: signal_error_from_primitive(Result); @@ -297,7 +289,7 @@ error_bad_environment(arg) NOTE: The following code has NOT been parallelized. It needs thinking. */ -DEFINE_PRIMITIVE("ENVIRONMENT-LINK-NAME", Prim_environment_link_name, 3) +DEFINE_PRIMITIVE ("ENVIRONMENT-LINK-NAME", Prim_environment_link_name, 3, 3, 0) { extern Pointer *scan_frame(); extern long compiler_uncache(); @@ -351,7 +343,7 @@ DEFINE_PRIMITIVE("ENVIRONMENT-LINK-NAME", Prim_environment_link_name, 3) TRAP_COMPILER_CACHED_DANGEROUS); trap[1] = cache; Store(cell[0], Make_Pointer(TC_REFERENCE_TRAP, trap)); - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } case TRAP_COMPILER_CACHED: @@ -372,7 +364,7 @@ DEFINE_PRIMITIVE("ENVIRONMENT-LINK-NAME", Prim_environment_link_name, 3) signal_error_from_primitive(result); } Vector_Set(value, TRAP_EXTRA, cache); - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } case TRAP_DANGEROUS: @@ -440,6 +432,6 @@ DEFINE_PRIMITIVE("ENVIRONMENT-LINK-NAME", Prim_environment_link_name, 3) signal_error_from_primitive(ERR_BAD_FRAME); } Store(cell[0], Make_Pointer(TC_REFERENCE_TRAP, trap)); - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(SHARP_T); } } diff --git a/v7/src/microcode/lookup.c b/v7/src/microcode/lookup.c index 3401bdd8e..20ea6be4c 100644 --- a/v7/src/microcode/lookup.c +++ b/v7/src/microcode/lookup.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.c,v 9.39 1988/05/03 19:18:47 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.c,v 9.40 1988/08/15 20:51:32 cph Exp $ * * This file contains symbol lookup and modification routines. See * Hal Abelson for a paper describing and justifying the algorithm. @@ -1219,7 +1219,7 @@ unassigned_p_transform (reference_result) switch (reference_result) { case ERR_UNASSIGNED_VARIABLE: - Val = TRUTH; + Val = SHARP_T; return (PRIM_DONE); case ERR_UNBOUND_VARIABLE: @@ -1261,7 +1261,7 @@ Symbol_Lex_unbound_p( frame, symbol) case ERR_UNBOUND_VARIABLE: { - Val = TRUTH; + Val = SHARP_T; return (PRIM_DONE); } diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c index 1ab24f8ca..e5bd4f7aa 100644 --- a/v7/src/microcode/memmag.c +++ b/v7/src/microcode/memmag.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.34 1988/02/20 19:51:38 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.35 1988/08/15 20:51:50 cph Exp $ */ /* Memory management top level. @@ -45,7 +45,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "gccode.h" /* Imports */ @@ -377,7 +377,7 @@ void GC() have changed. */ -DEFINE_PRIMITIVE("GARBAGE-COLLECT", Prim_Garbage_Collect, 1) +DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0) { extern unsigned long gc_counter; Pointer GC_Daemon_Proc; diff --git a/v7/src/microcode/missing.c b/v7/src/microcode/missing.c index 015c09fb3..ba02e3c41 100644 --- a/v7/src/microcode/missing.c +++ b/v7/src/microcode/missing.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/missing.c,v 9.21 1987/01/22 14:29:02 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/missing.c,v 9.22 1988/08/15 20:52:00 cph Rel $ * This file contains utilities potentially missing from the math library */ diff --git a/v7/src/microcode/mul.c b/v7/src/microcode/mul.c index 3b73de2c2..786e77979 100644 --- a/v7/src/microcode/mul.c +++ b/v7/src/microcode/mul.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/mul.c,v 9.23 1988/06/29 08:01:51 arthur Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/mul.c,v 9.24 1988/08/15 20:52:09 cph Exp $ * * This file contains the portable fixnum multiplication procedure. * Returns NIL if the result does not fit in a fixnum. diff --git a/v7/src/microcode/object.h b/v7/src/microcode/object.h index c9ab3d5d0..bdc4c49ad 100644 --- a/v7/src/microcode/object.h +++ b/v7/src/microcode/object.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/object.h,v 9.28 1988/05/10 17:34:41 cph Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/object.h,v 9.29 1988/08/15 20:52:18 cph Exp $ */ /* This file contains definitions pertaining to the C view of Scheme pointers: widths of fields, extraction macros, pre-computed @@ -92,8 +92,8 @@ MIT in each case. */ #define pointer_type(P) (OBJECT_TYPE (P)) #define pointer_datum(P) (OBJECT_DATUM (P)) -#define Make_Object(TC, D) \ -((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D))) +#define Make_Object(TC, D) \ + ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D))) #ifndef Heap_In_Low_Memory /* Portable version */ @@ -104,9 +104,9 @@ extern Pointer *Memory_Base; /* The "-1" in the value returned is a guarantee that there is one word reserved exclusively for use by the garbage collector. */ -#define Allocate_Heap_Space(space) \ - (Memory_Base = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ - Heap = Memory_Base, \ +#define Allocate_Heap_Space(space) \ + (Memory_Base = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ + Heap = Memory_Base, \ ((Memory_Base + (space)) - 1)) #define Get_Pointer(P) ((Pointer *) (Memory_Base + (OBJECT_DATUM (P)))) @@ -116,8 +116,8 @@ extern Pointer *Memory_Base; typedef long relocation_type; /* Used to relocate pointers on fasload */ -#define Allocate_Heap_Space(space) \ - (Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ +#define Allocate_Heap_Space(space) \ + (Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ ((Heap + (space)) - 1)) #ifdef spectrum @@ -144,7 +144,7 @@ typedef long relocation_type; /* Used to relocate pointers on fasload */ #define Store_Type_Code(P, TC) P = (Make_Object ((TC), (P))) -#define Store_Address(P, A) \ +#define Store_Address(P, A) \ P = (((P) & TYPE_CODE_MASK) | (OBJECT_DATUM ((Pointer) (A)))) #define Address(P) (OBJECT_DATUM (P)) @@ -220,7 +220,7 @@ do \ (target) |= (-1 << ADDRESS_LENGTH); \ } while (0) -#define BOOLEAN_TO_OBJECT(expression) ((expression) ? TRUTH : NIL) +#define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F) #define Make_Broken_Heart(N) (BROKEN_HEART_ZERO + (N)) #define Make_Unsigned_Fixnum(N) (FIXNUM_ZERO + (N)) @@ -228,40 +228,40 @@ do \ #define Get_Float(P) (* ((double *) (Nth_Vector_Loc ((P), 1)))) #define Get_Integer(P) (OBJECT_DATUM (P)) -#define Sign_Extend(P, S) \ -{ \ - (S) = (Get_Integer (P)); \ - if (((S) & FIXNUM_SIGN_BIT) != 0) \ - (S) |= (-1 << ADDRESS_LENGTH); \ +#define Sign_Extend(P, S) \ +{ \ + (S) = (Get_Integer (P)); \ + if (((S) & FIXNUM_SIGN_BIT) != 0) \ + (S) |= (-1 << ADDRESS_LENGTH); \ } -#define Fixnum_Fits(x) \ - ((((x) & SIGN_MASK) == 0) || \ +#define Fixnum_Fits(x) \ + ((((x) & SIGN_MASK) == 0) || \ (((x) & SIGN_MASK) == SIGN_MASK)) #define BYTES_TO_POINTERS(nbytes) \ (((nbytes) + ((sizeof (Pointer)) - 1)) / (sizeof (Pointer))) -#define Is_Constant(address) \ +#define Is_Constant(address) \ (((address) >= Constant_Space) && ((address) < Free_Constant)) -#define Is_Pure(address) \ +#define Is_Pure(address) \ ((Is_Constant (address)) && (Pure_Test (address))) -#define Side_Effect_Impurify(Old_Pointer, Will_Contain) \ -if ((Is_Constant (Get_Pointer (Old_Pointer))) && \ - (GC_Type (Will_Contain) != GC_Non_Pointer) && \ - (! (Is_Constant (Get_Pointer (Will_Contain)))) && \ - (Pure_Test (Get_Pointer (Old_Pointer)))) \ - Primitive_Error (ERR_WRITE_INTO_PURE_SPACE); +#define Side_Effect_Impurify(Old_Pointer, Will_Contain) \ +if ((Is_Constant (Get_Pointer (Old_Pointer))) && \ + (GC_Type (Will_Contain) != GC_Non_Pointer) && \ + (! (Is_Constant (Get_Pointer (Will_Contain)))) && \ + (Pure_Test (Get_Pointer (Old_Pointer)))) \ + Primitive_Error (ERR_WRITE_INTO_PURE_SPACE); \ #ifdef FLOATING_ALIGNMENT -#define FLOATING_BUFFER_SPACE \ - ((FLOATING_ALIGNMENT + 1)/sizeof(Pointer)) +#define FLOATING_BUFFER_SPACE \ + ((FLOATING_ALIGNMENT + 1)/sizeof(Pointer)) -#define HEAP_BUFFER_SPACE \ - (TRAP_MAX_IMMEDIATE + 1 + FLOATING_BUFFER_SPACE) +#define HEAP_BUFFER_SPACE \ + (TRAP_MAX_IMMEDIATE + 1 + FLOATING_BUFFER_SPACE) /* The space is there, find the correct position. */ diff --git a/v7/src/microcode/prim.c b/v7/src/microcode/prim.c index b98ea8eab..01bf5dfcd 100644 --- a/v7/src/microcode/prim.c +++ b/v7/src/microcode/prim.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.c,v 9.30 1988/05/11 17:20:18 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.c,v 9.31 1988/08/15 20:52:46 cph Rel $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -35,14 +35,14 @@ MIT in each case. */ /* The leftovers ... primitives that don't seem to belong elsewhere. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* Low level object manipulation */ /* (PRIMITIVE-OBJECT-TYPE OBJECT) Returns the type code of OBJECT as an unsigned integer. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE", Prim_prim_obj_type, 1) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE", Prim_prim_obj_type, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -52,7 +52,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE", Prim_prim_obj_type, 1) /* (PRIMITIVE-OBJECT-GC-TYPE OBJECT) Returns an unsigned integer indicating the GC type of the object. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-GC-TYPE", Prim_prim_obj_gc_type, 1) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-GC-TYPE", Prim_prim_obj_gc_type, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -63,21 +63,21 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-GC-TYPE", Prim_prim_obj_gc_type, 1) /* (PRIMITIVE-OBJECT-TYPE? TYPE-CODE OBJECT) Return #T if the type code of OBJECT is TYPE-CODE, else #F. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE?", Prim_prim_obj_type_p, 2) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE?", Prim_prim_obj_type_p, 2, 2, 0) { PRIMITIVE_HEADER (2); PRIMITIVE_RETURN (((OBJECT_TYPE (ARG_REF (2))) == (arg_index_integer (1, (MAX_TYPE_CODE + 1)))) - ? TRUTH + ? SHARP_T : NIL); } /* (PRIMITIVE-OBJECT-DATUM OBJECT) Returns the datum part of OBJECT as an unsigned integer. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-DATUM", Prim_prim_obj_datum, 1) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-DATUM", Prim_prim_obj_datum, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -88,7 +88,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-DATUM", Prim_prim_obj_datum, 1) Converts the unsigned integer NUMBER into a fixnum, by creating an object whose type is TC_FIXNUM and whose datum is NUMBER. */ -DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1) +DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1, 1, 0) { fast long datum; PRIMITIVE_HEADER (1); @@ -104,7 +104,7 @@ DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1) /* (PRIMITIVE-OBJECT-SET-TYPE TYPE-CODE OBJECT) Returns a new object with TYPE-CODE and the datum part of OBJECT. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET-TYPE", Prim_prim_obj_set_type, 2) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET-TYPE", Prim_prim_obj_set_type, 2, 2, 0) { PRIMITIVE_HEADER (2); @@ -117,11 +117,11 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET-TYPE", Prim_prim_obj_set_type, 2) Returns #T if the two objects have the same type code and datum. Returns #F otherwise. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-EQ?", Prim_prim_obj_eq_p, 2) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-EQ?", Prim_prim_obj_eq_p, 2, 2, 0) { PRIMITIVE_HEADER (2); - PRIMITIVE_RETURN (((ARG_REF (1)) == (ARG_REF (2))) ? TRUTH : NIL); + PRIMITIVE_RETURN (((ARG_REF (1)) == (ARG_REF (2))) ? SHARP_T : NIL); } /* Low level memory references. @@ -135,7 +135,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-EQ?", Prim_prim_obj_eq_p, 2) Fetches the index'ed slot in object. Performs no type checking on object. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-REF", Prim_prim_obj_ref, 2) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-REF", Prim_prim_obj_ref, 2, 2, 0) { PRIMITIVE_HEADER (2); @@ -146,7 +146,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-REF", Prim_prim_obj_ref, 2) Stores value in the index'ed slot in object. Performs no type checking on object. */ -DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET!", Prim_prim_obj_set, 3) +DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET!", Prim_prim_obj_set, 3, 3, 0) { fast long index; PRIMITIVE_HEADER (3); @@ -159,7 +159,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET!", Prim_prim_obj_set, 3) /* Safe versions of the object manipulators. These touch their arguments, and provide GC safety tests. */ -DEFINE_PRIMITIVE ("OBJECT-TYPE", Prim_object_type, 1) +DEFINE_PRIMITIVE ("OBJECT-TYPE", Prim_object_type, 1, 1, 0) { fast Pointer object; PRIMITIVE_HEADER (1); @@ -168,7 +168,7 @@ DEFINE_PRIMITIVE ("OBJECT-TYPE", Prim_object_type, 1) PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (OBJECT_TYPE (object))); } -DEFINE_PRIMITIVE ("OBJECT-GC-TYPE", Prim_object_gc_type, 1) +DEFINE_PRIMITIVE ("OBJECT-GC-TYPE", Prim_object_gc_type, 1, 1, 0) { fast Pointer object; PRIMITIVE_HEADER (1); @@ -177,7 +177,7 @@ DEFINE_PRIMITIVE ("OBJECT-GC-TYPE", Prim_object_gc_type, 1) PRIMITIVE_RETURN (MAKE_SIGNED_FIXNUM (GC_Type (object))); } -DEFINE_PRIMITIVE ("OBJECT-TYPE?", Prim_object_type_p, 2) +DEFINE_PRIMITIVE ("OBJECT-TYPE?", Prim_object_type_p, 2, 2, 0) { fast Pointer object; PRIMITIVE_HEADER (2); @@ -186,11 +186,11 @@ DEFINE_PRIMITIVE ("OBJECT-TYPE?", Prim_object_type_p, 2) PRIMITIVE_RETURN (((OBJECT_TYPE (object)) == (arg_index_integer (1, (MAX_TYPE_CODE + 1)))) - ? TRUTH + ? SHARP_T : NIL); } -DEFINE_PRIMITIVE ("OBJECT-DATUM", Prim_object_datum, 1) +DEFINE_PRIMITIVE ("OBJECT-DATUM", Prim_object_datum, 1, 1, 0) { fast Pointer object; PRIMITIVE_HEADER (1); @@ -199,7 +199,7 @@ DEFINE_PRIMITIVE ("OBJECT-DATUM", Prim_object_datum, 1) PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (OBJECT_DATUM (object))); } -DEFINE_PRIMITIVE ("OBJECT-SET-TYPE", Prim_object_set_type, 2) +DEFINE_PRIMITIVE ("OBJECT-SET-TYPE", Prim_object_set_type, 2, 2, 0) { fast long type_code; fast Pointer object; @@ -224,7 +224,7 @@ DEFINE_PRIMITIVE ("OBJECT-SET-TYPE", Prim_object_set_type, 2) Returns #F otherwise. Touches both arguments. */ -DEFINE_PRIMITIVE ("EQ?", Prim_eq, 2) +DEFINE_PRIMITIVE ("EQ?", Prim_eq, 2, 2, 0) { fast Pointer object_1; fast Pointer object_2; @@ -232,7 +232,7 @@ DEFINE_PRIMITIVE ("EQ?", Prim_eq, 2) Touch_In_Primitive ((ARG_REF (1)), object_1); Touch_In_Primitive ((ARG_REF (2)), object_2); - PRIMITIVE_RETURN ((object_1 == object_2) ? TRUTH : NIL); + PRIMITIVE_RETURN ((object_1 == object_2) ? SHARP_T : NIL); } /* (NOT OBJECT) @@ -240,13 +240,13 @@ DEFINE_PRIMITIVE ("EQ?", Prim_eq, 2) the primitive known as NOT, NULL?, and FALSE? in Scheme. Touches the argument. */ -DEFINE_PRIMITIVE ("NOT", Prim_not, 1) +DEFINE_PRIMITIVE ("NOT", Prim_not, 1, 1, 0) { fast Pointer object; PRIMITIVE_HEADER (1); Touch_In_Primitive ((ARG_REF (1)), object); - PRIMITIVE_RETURN ((object == NIL) ? TRUTH : NIL); + PRIMITIVE_RETURN ((object == NIL) ? SHARP_T : NIL); } /* Cells */ @@ -254,7 +254,7 @@ DEFINE_PRIMITIVE ("NOT", Prim_not, 1) /* (MAKE-CELL CONTENTS) Creates a cell with contents CONTENTS. */ -DEFINE_PRIMITIVE ("MAKE-CELL", Prim_make_cell, 1) +DEFINE_PRIMITIVE ("MAKE-CELL", Prim_make_cell, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -266,17 +266,17 @@ DEFINE_PRIMITIVE ("MAKE-CELL", Prim_make_cell, 1) /* (CELL? OBJECT) Returns #T if OBJECT is a cell, else #F. */ -DEFINE_PRIMITIVE ("CELL?", Prim_cell_p, 1) +DEFINE_PRIMITIVE ("CELL?", Prim_cell_p, 1, 1, 0) { PRIMITIVE_HEADER (1); - PRIMITIVE_RETURN ((CELL_P (ARG_REF (1))) ? TRUTH : NIL); + PRIMITIVE_RETURN ((CELL_P (ARG_REF (1))) ? SHARP_T : NIL); } /* (CELL-CONTENTS CELL) Returns the contents of the cell CELL. */ -DEFINE_PRIMITIVE ("CELL-CONTENTS", Prim_cell_contents, 1) +DEFINE_PRIMITIVE ("CELL-CONTENTS", Prim_cell_contents, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -287,7 +287,7 @@ DEFINE_PRIMITIVE ("CELL-CONTENTS", Prim_cell_contents, 1) Stores OBJECT as contents of CELL. Returns the previous contents of CELL. */ -DEFINE_PRIMITIVE ("SET-CELL-CONTENTS!", Prim_set_cell_contents, 2) +DEFINE_PRIMITIVE ("SET-CELL-CONTENTS!", Prim_set_cell_contents, 2, 2, 0) { fast Pointer cell; fast Pointer object; diff --git a/v7/src/microcode/prim.h b/v7/src/microcode/prim.h index 64ced3a12..9932780fb 100644 --- a/v7/src/microcode/prim.h +++ b/v7/src/microcode/prim.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.h,v 9.39 1987/12/04 22:18:35 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.h,v 9.40 1988/08/15 20:52:55 cph Rel $ */ /* Primitive declarations. @@ -43,6 +43,7 @@ extern Pointer (*(Primitive_Procedure_Table[]))(); extern int Primitive_Arity_Table[]; extern int Primitive_Count_Table[]; extern char *Primitive_Name_Table[]; +extern char *Primitive_Documentation_Table[]; extern long MAX_PRIMITIVE; #define CHUNK_SIZE 20 /* Grow undefined vector by this much */ diff --git a/v7/src/microcode/prims.h b/v7/src/microcode/prims.h index 67c6d086b..61974b17c 100644 --- a/v7/src/microcode/prims.h +++ b/v7/src/microcode/prims.h @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.32 1987/12/23 03:44:55 cph Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.33 1988/08/15 20:53:04 cph Exp $ */ /* This file contains some macros for defining primitives, for argument type or value checking, and for accessing @@ -38,20 +38,17 @@ MIT in each case. */ /* Definition of primitives. */ -#define Define_Primitive(C_Name, Number_of_args, Scheme_Name) \ -extern Pointer C_Name(); \ -Pointer C_Name() +#define DEFINE_PRIMITIVE(scheme_name, fn_name, min_args, max_args, doc_string) \ +extern Pointer fn_name (); \ +Pointer fn_name () -#define DEFINE_PRIMITIVE(Scheme_Name, C_Name, Number_of_args) \ -extern Pointer C_Name(); \ -Pointer C_Name() +/* Can be used for `max_args' in `DEFINE_PRIMITIVE' to indicate that + the primitive has no upper limit on its arity. */ +#define LEXPR (-1) -/* This is a NOP. - Any primitive declared this way must also be declared - with Define_Primitive. - */ - -#define Built_In_Primitive(C_Name, Number_of_args, Scheme_Name, index) +/* This form is obsolete. Use DEFINE_PRIMITIVE instead. */ +#define Define_Primitive(fn_name, arity, scheme_name) \ + DEFINE_PRIMITIVE (scheme_name, fn_name, arity, arity, 0) #ifdef ENABLE_PRIMITIVE_PROFILING #define primitive_entry_hook() record_primitive_entry (Fetch_Expression ()) diff --git a/v7/src/microcode/primutl.c b/v7/src/microcode/primutl.c index 1b9a05f3e..c7dcc10a1 100644 --- a/v7/src/microcode/primutl.c +++ b/v7/src/microcode/primutl.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/primutl.c,v 9.45 1988/03/24 07:13:17 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/primutl.c,v 9.46 1988/08/15 20:53:13 cph Exp $ * * This file contains the support routines for mapping primitive names * to numbers within the microcode. Primitives are written in C @@ -41,7 +41,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" Pointer Undefined_Primitives = NIL; Pointer Undefined_Primitives_Arity = NIL; @@ -186,6 +186,16 @@ primitive_code_to_arity(number) return (arity); } } + +char * +primitive_code_to_documentation (number) + long number; +{ + return + ((number > MAX_PRIMITIVE) + ? ((char *) 0) + : (Primitive_Documentation_Table [number])); +} /* Externally visible utilities */ @@ -224,6 +234,15 @@ primitive_to_arity(primitive) return (primitive_code_to_arity(PRIMITIVE_NUMBER(primitive))); } +extern char * primitive_to_documentation (); + +char * +primitive_to_documentation (primitive) + Pointer primitive; +{ + return (primitive_code_to_documentation (PRIMITIVE_NUMBER (primitive))); +} + extern long primitive_to_arguments(); /* diff --git a/v7/src/microcode/pruxfs.c b/v7/src/microcode/pruxfs.c index 4a61bca1b..91d0e042a 100644 --- a/v7/src/microcode/pruxfs.c +++ b/v7/src/microcode/pruxfs.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.27 1988/03/02 09:00:38 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.28 1988/08/15 20:57:19 cph Exp $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -35,7 +35,7 @@ MIT in each case. */ /* Simple unix primitives. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "string.h" #include #include @@ -50,7 +50,7 @@ MIT in each case. */ /* Looks up in the user's shell environment the value of the variable specified as a string. */ -DEFINE_PRIMITIVE ("GET-ENVIRONMENT-VARIABLE", Prim_get_environment_variable, 1) +DEFINE_PRIMITIVE ("GET-ENVIRONMENT-VARIABLE", Prim_get_environment_variable, 1, 1, 0) { char *variable_value; extern char *getenv (); @@ -64,7 +64,7 @@ DEFINE_PRIMITIVE ("GET-ENVIRONMENT-VARIABLE", Prim_get_environment_variable, 1) : (C_String_To_Scheme_String (variable_value))); } -DEFINE_PRIMITIVE ("CURRENT-USER-NAME", Prim_get_user_name, 0) +DEFINE_PRIMITIVE ("CURRENT-USER-NAME", Prim_get_user_name, 0, 0, 0) { char *user_name; char *getlogin (); @@ -85,7 +85,7 @@ DEFINE_PRIMITIVE ("CURRENT-USER-NAME", Prim_get_user_name, 0) PRIMITIVE_RETURN (C_String_To_Scheme_String (user_name)); } -DEFINE_PRIMITIVE ("GET-USER-HOME-DIRECTORY", Prim_get_user_home_directory, 1) +DEFINE_PRIMITIVE ("GET-USER-HOME-DIRECTORY", Prim_get_user_home_directory, 1, 1, 0) { struct passwd *entry; struct passwd *getpwnam (); @@ -99,14 +99,14 @@ DEFINE_PRIMITIVE ("GET-USER-HOME-DIRECTORY", Prim_get_user_home_directory, 1) : (C_String_To_Scheme_String (entry -> pw_dir))); } -DEFINE_PRIMITIVE ("CURRENT-FILE-TIME", Prim_current_file_time, 0) +DEFINE_PRIMITIVE ("CURRENT-FILE-TIME", Prim_current_file_time, 0, 0, 0) { PRIMITIVE_HEADER (0); PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (time ((long *) 0))); } -DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1) +DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1, 1, 0) { long clock; long temp; @@ -123,7 +123,7 @@ DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1) PRIMITIVE_RETURN (C_String_To_Scheme_String (time_string)); } -DEFINE_PRIMITIVE ("UID->STRING", Prim_uid_to_string, 1) +DEFINE_PRIMITIVE ("UID->STRING", Prim_uid_to_string, 1, 1, 0) { struct passwd *getpwuid (); void endpwent (); @@ -138,7 +138,7 @@ DEFINE_PRIMITIVE ("UID->STRING", Prim_uid_to_string, 1) PRIMITIVE_RETURN (C_String_To_Scheme_String (entry -> pw_name)); } -DEFINE_PRIMITIVE ("GID->STRING", Prim_gid_to_string, 1) +DEFINE_PRIMITIVE ("GID->STRING", Prim_gid_to_string, 1, 1, 0) { struct group *getgrgid (); void endgrent (); @@ -153,7 +153,7 @@ DEFINE_PRIMITIVE ("GID->STRING", Prim_gid_to_string, 1) PRIMITIVE_RETURN (C_String_To_Scheme_String (entry -> gr_name)); } -DEFINE_PRIMITIVE ("FILE-DIRECTORY?", Prim_file_directory_p, 1) +DEFINE_PRIMITIVE ("FILE-DIRECTORY?", Prim_file_directory_p, 1, 1, 0) { struct stat stat_result; PRIMITIVE_HEADER (1); @@ -162,7 +162,7 @@ DEFINE_PRIMITIVE ("FILE-DIRECTORY?", Prim_file_directory_p, 1) if ((stat ((Scheme_String_To_C_String (ARG_REF (1))), (& stat_result))) < 0) PRIMITIVE_RETURN (NIL); PRIMITIVE_RETURN - ((((stat_result . st_mode) & S_IFMT) == S_IFDIR) ? TRUTH : NIL); + ((((stat_result . st_mode) & S_IFMT) == S_IFDIR) ? SHARP_T : NIL); } /* The following is originally from GNU Emacs. */ @@ -207,7 +207,7 @@ file_symlink_p (filename) #endif /* S_IFLNK */ -DEFINE_PRIMITIVE ("FILE-SYMLINK?", Prim_file_symlink_p, 1) +DEFINE_PRIMITIVE ("FILE-SYMLINK?", Prim_file_symlink_p, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -236,14 +236,17 @@ DEFINE_PRIMITIVE ("FILE-SYMLINK?", Prim_file_symlink_p, 1) The filemodestring stuff was gobbled from GNU Emacs. */ -DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1) +static void filemodestring (); +static void rwx (); +static void setst (); + +DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1, 1, 0) { struct stat stat_result; extern Pointer allocate_marked_vector (); Pointer result; extern Pointer allocate_string (); Pointer modes; - static void filemodestring (); PRIMITIVE_HEADER (1); CHECK_ARG (1, STRING_P); @@ -254,7 +257,7 @@ DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1) switch ((stat_result . st_mode) & S_IFMT) { case S_IFDIR: - User_Vector_Set (result, 0, TRUTH); + User_Vector_Set (result, 0, SHARP_T); break; #ifdef S_IFLNK case S_IFLNK: @@ -326,7 +329,6 @@ filemodestring (s, a) char *a; { extern char file_type_letter (); - extern void rwx (), setst (); (a [0]) = (file_type_letter (s)); /* Aren't there symbolic names for these byte-fields? */ diff --git a/v7/src/microcode/psbmap.h b/v7/src/microcode/psbmap.h index 0a0f97399..29abbc0d0 100644 --- a/v7/src/microcode/psbmap.h +++ b/v7/src/microcode/psbmap.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbmap.h,v 9.26 1988/02/10 15:44:07 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbmap.h,v 9.27 1988/08/15 20:53:22 cph Rel $ * * This file contains macros and declarations for Bintopsb.c * and Psbtobin.c diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c index 3fae22fec..3ab8e4c1f 100644 --- a/v7/src/microcode/purify.c +++ b/v7/src/microcode/purify.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.35 1988/05/12 22:28:29 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.36 1988/08/15 20:53:30 cph Exp $ * * This file contains the code that copies objects into pure * and constant space. @@ -38,7 +38,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "gccode.h" #include "zones.h" @@ -475,7 +475,7 @@ Pointer Info; *New_Object = Make_Non_Pointer(PURE_PART, (Recomputed_Length + 5)); GC(); Set_Pure_Top(); - return (TRUTH); + return (SHARP_T); } /* (PRIMITIVE-PURIFY OBJECT PURE? SAFETY-MARGIN) @@ -498,14 +498,14 @@ Pointer Info; have changed. */ -DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_Primitive_Purify, 3) +DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0) { long Saved_Zone; Pointer Object, Lost_Objects, Purify_Result, Daemon; Primitive_3_Args(); Save_Time_Zone(Zone_Purify); - if ((Arg2 != TRUTH) && (Arg2 != NIL)) + if ((Arg2 != SHARP_T) && (Arg2 != NIL)) Primitive_Error(ERR_ARG_2_WRONG_TYPE); Arg_3_Type(TC_FIXNUM); diff --git a/v7/src/microcode/purutl.c b/v7/src/microcode/purutl.c index b87bf1bf0..929ea5ce2 100644 --- a/v7/src/microcode/purutl.c +++ b/v7/src/microcode/purutl.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,12 +30,12 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.33 1988/03/12 16:07:29 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.34 1988/08/15 20:53:42 cph Exp $ */ /* Pure/Constant space utilities. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "gccode.h" #include "zones.h" @@ -202,8 +202,7 @@ Make_Impure(Object) Remove an object from pure space so it can be side effected. The object is placed in constant space instead. */ -Built_In_Primitive(Prim_Impurify, 1, "PRIMITIVE-IMPURIFY", 0xBD) -Define_Primitive(Prim_Impurify, 1, "PRIMITIVE-IMPURIFY") +DEFINE_PRIMITIVE ("PRIMITIVE-IMPURIFY", Prim_impurify, 1, 1, 0) { Pointer Result; Primitive_1_Arg(); @@ -246,14 +245,13 @@ Pure_Test(Obj_Address) Returns #!TRUE if the object is pure (ie it doesn't point to any other object, or it is in a pure section of the constant space). */ -Built_In_Primitive(Prim_Pure_P, 1, "PURE?", 0xBB) -Define_Primitive(Prim_Pure_P, 1, "PURE?") +DEFINE_PRIMITIVE ("PURE?", Prim_pure_p, 1, 1, 0) { Primitive_1_Arg(); if ((GC_Type_Non_Pointer(Arg1)) || (GC_Type_Special(Arg1))) - return TRUTH; + return SHARP_T; Touch_In_Primitive(Arg1, Arg1); { extern Pointer *compiled_entry_to_block_address(); @@ -264,7 +262,7 @@ Define_Primitive(Prim_Pure_P, 1, "PURE?") ? (compiled_entry_to_block_address(Arg1)) : (Get_Pointer(Arg1))); if (Is_Pure(Obj_Address)) - return TRUTH; + return SHARP_T; } return NIL; } @@ -273,8 +271,7 @@ Define_Primitive(Prim_Pure_P, 1, "PURE?") Returns #!TRUE if the object is in constant space or isn't a pointer. */ -Built_In_Primitive(Prim_Constant_P, 1, "CONSTANT?", 0xBA) -Define_Primitive(Prim_Constant_P, 1, "CONSTANT?") +DEFINE_PRIMITIVE ("CONSTANT?", Prim_constant_p, 1, 1, 0) { Primitive_1_Arg(); @@ -282,14 +279,13 @@ Define_Primitive(Prim_Constant_P, 1, "CONSTANT?") return ((GC_Type_Non_Pointer(Arg1)) || (GC_Type_Special(Arg1)) || (Is_Constant(Get_Pointer(Arg1)))) ? - TRUTH : NIL; + SHARP_T : NIL; } /* (GET-NEXT-CONSTANT) Returns the next free address in constant space. */ -Built_In_Primitive(Prim_Get_Next_Constant, 0, "GET-NEXT-CONSTANT", 0xE4) -Define_Primitive(Prim_Get_Next_Constant, 0, "GET-NEXT-CONSTANT") +DEFINE_PRIMITIVE ("GET-NEXT-CONSTANT", Prim_get_next_constant, 0, 0, 0) { Pointer *Next_Address; diff --git a/v7/src/microcode/regex.c b/v7/src/microcode/regex.c index 2ac010af8..c3efc9a38 100644 --- a/v7/src/microcode/regex.c +++ b/v7/src/microcode/regex.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/regex.c,v 1.6 1987/12/30 21:43:43 jrm Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/regex.c,v 1.7 1988/08/15 20:53:59 cph Exp $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and diff --git a/v7/src/microcode/regex.h b/v7/src/microcode/regex.h index c42cd0b4a..d9a7b4178 100644 --- a/v7/src/microcode/regex.h +++ b/v7/src/microcode/regex.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/regex.h,v 1.1 1987/07/14 03:00:23 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/regex.h,v 1.2 1988/08/15 20:54:12 cph Exp $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and diff --git a/v7/src/microcode/returns.h b/v7/src/microcode/returns.h index 8b3056017..f653f32ea 100644 --- a/v7/src/microcode/returns.h +++ b/v7/src/microcode/returns.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/returns.h,v 9.32 1988/04/27 01:09:19 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/returns.h,v 9.33 1988/08/15 20:54:20 cph Exp $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several diff --git a/v7/src/microcode/rgxprim.c b/v7/src/microcode/rgxprim.c index f84cdf8d4..e31b4b9a1 100644 --- a/v7/src/microcode/rgxprim.c +++ b/v7/src/microcode/rgxprim.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/rgxprim.c,v 1.6 1987/12/09 21:37:43 jrm Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/rgxprim.c,v 1.7 1988/08/15 20:54:28 cph Rel $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -35,7 +35,7 @@ MIT in each case. */ /* Primitives for regular expression matching and search. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "string.h" #include "char.h" #include "edwin.h" @@ -94,7 +94,7 @@ MIT in each case. */ error_external_return (); \ } while (0) -DEFINE_PRIMITIVE ("RE-CHAR-SET-ADJOIN!", Prim_re_char_set_adjoin, 2) +DEFINE_PRIMITIVE ("RE-CHAR-SET-ADJOIN!", Prim_re_char_set_adjoin, 2, 2, 0) { int ascii; PRIMITIVE_HEADER (2); @@ -106,7 +106,7 @@ DEFINE_PRIMITIVE ("RE-CHAR-SET-ADJOIN!", Prim_re_char_set_adjoin, 2) PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("RE-COMPILE-FASTMAP", Prim_re_compile_fastmap, 4) +DEFINE_PRIMITIVE ("RE-COMPILE-FASTMAP", Prim_re_compile_fastmap, 4, 4, 0) { fast Pointer pattern; fast int can_be_null; @@ -178,13 +178,13 @@ DEFINE_PRIMITIVE ("RE-COMPILE-FASTMAP", Prim_re_compile_fastmap, 4) (& (text [match_end])))); \ RE_MATCH_RESULTS (result, (ARG_REF (4))) -DEFINE_PRIMITIVE ("RE-MATCH-SUBSTRING", Prim_re_match_substring, 7) +DEFINE_PRIMITIVE ("RE-MATCH-SUBSTRING", Prim_re_match_substring, 7, 7, 0) { RE_SUBSTRING_PRIMITIVE (re_match); } -DEFINE_PRIMITIVE ("RE-SEARCH-SUBSTRING-FORWARD", Prim_re_search_substr_forward, 7) +DEFINE_PRIMITIVE ("RE-SEARCH-SUBSTRING-FORWARD", Prim_re_search_substr_forward, 7, 7, 0) { RE_SUBSTRING_PRIMITIVE (re_search_forward); } -DEFINE_PRIMITIVE ("RE-SEARCH-SUBSTRING-BACKWARD", Prim_re_search_substr_backward, 7) +DEFINE_PRIMITIVE ("RE-SEARCH-SUBSTRING-BACKWARD", Prim_re_search_substr_backward, 7, 7, 0) { RE_SUBSTRING_PRIMITIVE (re_search_backward); } #define RE_BUFFER_PRIMITIVE(procedure) \ @@ -235,11 +235,11 @@ DEFINE_PRIMITIVE ("RE-SEARCH-SUBSTRING-BACKWARD", Prim_re_search_substr_backward (& (text [match_end])))); \ RE_MATCH_RESULTS (result, (ARG_REF (4))) -DEFINE_PRIMITIVE ("RE-MATCH-BUFFER", Prim_re_match_buffer, 7) +DEFINE_PRIMITIVE ("RE-MATCH-BUFFER", Prim_re_match_buffer, 7, 7, 0) { RE_BUFFER_PRIMITIVE (re_match); } -DEFINE_PRIMITIVE ("RE-SEARCH-BUFFER-FORWARD", Prim_re_search_buffer_forward, 7) +DEFINE_PRIMITIVE ("RE-SEARCH-BUFFER-FORWARD", Prim_re_search_buffer_forward, 7, 7, 0) { RE_BUFFER_PRIMITIVE (re_search_forward); } -DEFINE_PRIMITIVE ("RE-SEARCH-BUFFER-BACKWARD", Prim_re_search_buffer_backward, 7) +DEFINE_PRIMITIVE ("RE-SEARCH-BUFFER-BACKWARD", Prim_re_search_buffer_backward, 7, 7, 0) { RE_BUFFER_PRIMITIVE (re_search_backward); } diff --git a/v7/src/microcode/sample.c b/v7/src/microcode/sample.c index 86ef18573..b6bc561f4 100644 --- a/v7/src/microcode/sample.c +++ b/v7/src/microcode/sample.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,59 +30,61 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sample.c,v 9.21 1987/01/22 14:31:00 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sample.c,v 9.22 1988/08/15 20:54:38 cph Rel $ */ /* This file is intended to help you find out how to write primitives. Many concepts needed to write primitives can be found by looking at actual primitives in the system. Hence this file will often - ask you to look at other files that contain system primitives. -*/ + ask you to look at other files that contain system primitives. */ /* Files that contain primitives must have the following includes - near the top of the file. -*/ + near the top of the file. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* Scheme.h supplies useful macros that are used throughout the - system, and primitive.h supplies macros that are used in defining - primitives. -*/ + system, and prims.h supplies macros that are used in defining + primitives. */ -/* To make a primitive, you must use the macro Define_Primitive - with three arguments, followed by the body of C source code +/* To make a primitive, you must use the macro DEFINE_PRIMITIVE + with six arguments, followed by the body of C source code that you want the primitive to execute. - The three arguments are: - 1. The name you want to give to this body of code (a C procedure - name). - 2. The number of arguments that this scheme primitive should - receive. Note: currently, this must be a number between - 0 and 3 inclusive. Hence primitives can currently take no more - than three arguments. - 3. A string representing the scheme name that you want to identify + The six arguments are: + 1. A string representing the scheme name that you want to identify this primitive with. - - The value returned by the body of code following the Define_Primitive - is the value of the scheme primitive. Note that this must be a - scheme Pointer object (with type tag and datum field), and not an - arbitrary C object. - - As an example, here is a primitive that takes no arguments and always - returns NIL (NIL is defined in scheme.h and identical to the scheme - object #!FALSE. TRUTH is identical to the scheme object #!TRUE -*/ - -Define_Primitive(Prim_Return_Nil, 0, "RETURN-NIL") -{ Primitive_0_Args(); - return NIL; + 2. The name you want to give to this body of code (a C procedure + name). By convention, all such names begin with `Prim_'. + 3. The minimum number of arguments that this scheme primitive + should receive. Currently this is not implemented and should be + the same as the maximum number of arguments (or 0 if the maximum + is the special symbol LEXPR). + 4. The maximum number of arguments that this scheme primitive + should receive. If this primitive will take any number of + arguments, use LEXPR here. + 5. A documentation string, or 0 meaning no documentation. + + The value returned by the body of code following the + DEFINE_PRIMITIVE is the value of the scheme primitive. Note that + this must be a scheme Pointer object (with type tag and datum + field), and not an arbitrary C object. + + As an example, here is a primitive that takes no arguments and + always returns SHARP_F (SHARP_F is defined in scheme.h and + identical to the scheme object #F. SHARP_T is identical to the + scheme object #T). */ + +DEFINE_PRIMITIVE ("RETURN-SHARP-F", Prim_return_sharp_f, 0, 0, 0) +{ + PRIMITIVE_HEADER (0); + + PRIMITIVE_RETURN (SHARP_F); } -/* This will create the primitive return-nil and when a new scheme is - made (with the Makefile properly edited to include this file), - evaluating (make-primitive-procedure 'return-nil) will return a +/* This will create the primitive RETURN-SHARP-F and when a new Scheme + is made (with the Makefile properly edited to include this file), + evaluating (make-primitive-procedure 'return-sharp-f) will return a primitive procedure that when called with no arguments, will return - #!FALSE. -*/ + #F. */ /* Three macros are available for you to access the arguments to the primitives. Primitive_N_Args(), where N is between 0 and 3 @@ -92,12 +94,13 @@ Define_Primitive(Prim_Return_Nil, 0, "RETURN-NIL") code. An important thing to note is that since Primitive_N_Args may allocate variables, its use MUST come before any code in the body of the C procedure. For example, here is a primitive that - takes one argument and returns it. -*/ + takes one argument and returns it. */ -Define_Primitive(Prim_Identity, 1, "IDENTITY") -{ Primitive_1_Arg(); - return Arg1; +DEFINE_PRIMITIVE ("IDENTITY", Prim_identity, 1, 1, 0) +{ + PRIMITIVE_HEADER (1); + + PRIMITIVE_RETURN (ARG_REF (1)); } /* Some primitives may have to allocate space on the heap in order @@ -124,21 +127,24 @@ Define_Primitive(Prim_Identity, 1, "IDENTITY") there for the possible type codes. The following is the equivalent of CONS and takes two arguments and returns the pair which contains both arguments. For further examples on heap allocation, see the - primitives in list.c, hunk.c and vector.c. -*/ + primitives in "list.c", "hunk.c" and "vector.c". */ + +DEFINE_PRIMITIVE ("NEW-CONS", Prim_new_cons, 2, 2, 0) +{ + Pointer * Temp; + PRIMITIVE_HEADER (2); -Define_Primitive(Prim_New_Cons, 2, "NEW-CONS") -{ Pointer *Temp; - Primitive_2_Args(); /* Check to see if there is room in the heap for the pair */ - Primitive_GC_If_Needed(2); + Primitive_GC_If_Needed (2); + /* Store the values in the heap, updating Free as we go along */ Temp = Free; Free += 2; - Temp[CONS_CAR] = Arg1; - Temp[CONS_CDR] = Arg2; + Temp[CONS_CAR] = (ARG_REF (1)); + Temp[CONS_CDR] = (ARG_REF (2)); + /* Return the pair, which points to the location of the car */ - return Make_Pointer(TC_LIST, Temp); + PRIMITIVE_RETURN (Make_Pointer (TC_LIST, Temp)); } /* The following primitive takes three arguments and returns a list @@ -146,34 +152,40 @@ Define_Primitive(Prim_New_Cons, 2, "NEW-CONS") to the next pair. Also, scheme objects are of type Pointer (defined in object.h). Note that the result returned can be held in a temporary variable even before the contents of the - object are stored in heap. -*/ - -Define_Primitive(Prim_Utterly_Random, 3, "WHY-SHOULDNT-THE-NAME-BE-RANDOM?") -{ /* Hold the end result in a temporary variable while we - fill in the list. - */ - Pointer *Result; - Primitive_3_Args(); + object are stored in heap. */ + +DEFINE_PRIMITIVE ("WHY-SHOULDNT-THE-NAME-BE-RANDOM?", Prim_utterly_random, 3, 3, 0) +{ + /* Hold the end result in a temporary variable while we + fill in the list. */ + Pointer * Result; + PRIMITIVE_HEADER (3); + /* Check to see if there is enough space on the heap. */ - Primitive_GC_If_Needed(6); + Primitive_GC_If_Needed (6); Result = Free; - Free[CONS_CAR] = Arg1; + Free[CONS_CAR] = (ARG_REF (1)); + /* Make the CDR of the first pair point to the second pair. */ - Free[CONS_CDR] = Make_Pointer(TC_LIST, Free+2); + Free[CONS_CDR] = (Make_Pointer (TC_LIST, (Free + 2))); + /* Bump it over to the second pair */ Free += 2; - Free[CONS_CAR] = Arg2; + Free[CONS_CAR] = (ARG_REF (2)); + /* Make the CDR of the second pair point to the third pair. */ - Free[CONS_CDR] = Make_Pointer(TC_LIST, Free+2); + Free[CONS_CDR] = (Make_Pointer (TC_LIST, (Free + 2))); + /* Bump it over to the third pair */ Free += 2; - Free[CONS_CAR] = Arg3; + Free[CONS_CAR] = (ARG_REF (3)); + /* Make the last CDR a () to make a "proper" list */ - Free[CONS_CDR] = NIL; + Free[CONS_CDR] = EMPTY_LIST; + /* Bump Free over to the first available location */ Free += 2; - return Make_Pointer(TC_LIST, Result); + PRIMITIVE_RETURN (Make_Pointer (TC_LIST, Result)); } /* Several Macros are supplied to do arithmetic with scheme numbers. @@ -188,28 +200,25 @@ Define_Primitive(Prim_Utterly_Random, 3, "WHY-SHOULDNT-THE-NAME-BE-RANDOM?") that long. Here is a primitive that tries to add 3 to it's argument. Note how scheme errors are performed via Primitive_Error({error-code}). See scheme.h and included files for - the possible error codes. -*/ + the possible error codes. */ -Define_Primitive(Prim_Add_3, 1, "3+") -{ long value; +DEFINE_PRIMITIVE ("3+", Prim_add_3, 1, 1, 0) +{ + long value; int flag; - Primitive_1_Arg(); - flag = Scheme_Integer_To_C_Integer(Arg1, &value); + PRIMITIVE_HEADER (1); + + flag = (Scheme_Integer_To_C_Integer ((ARG_REF (1)), (&value))); if (flag == PRIM_DONE) - return C_Integer_To_Scheme_Integer(value + 3); + PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (value + 3)); /* If flag is not equal to PRIM_DONE, then it is one of two errors. We can signal either error by calling Primitive_Error - with that error code - */ - Primitive_Error(flag); + with that error code. */ + Primitive_Error (flag); } -/* See fixnum.c for more fixnum primitive examples. float.c - gives floating point examples and bignum.c gives bignum - examples (Warning: the bignum code is not trivial). generic.c - gives examples on arithmetic operations that work for - all scheme number types. For efficiency reasons, they do not - always use this convenient interface. - */ - +/* See "fixnum.c" for more fixnum primitive examples. "float.c" gives + floating point examples and "bignum.c" gives bignum examples + (Warning: the bignum code is not trivial). "generic.c" gives + examples on arithmetic operations that work for all scheme number + types. */ diff --git a/v7/src/microcode/scheme.h b/v7/src/microcode/scheme.h index a1f076425..59ee62b98 100644 --- a/v7/src/microcode/scheme.h +++ b/v7/src/microcode/scheme.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/scheme.h,v 9.28 1987/11/23 04:52:01 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/scheme.h,v 9.29 1988/08/15 20:54:47 cph Rel $ * * General declarations for the SCode interpreter. This * file is INCLUDED by others and contains declarations only. diff --git a/v7/src/microcode/scode.h b/v7/src/microcode/scode.h index 243fa65cb..0b37508dd 100644 --- a/v7/src/microcode/scode.h +++ b/v7/src/microcode/scode.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/scode.h,v 9.22 1987/04/03 00:20:19 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/scode.h,v 9.23 1988/08/15 20:54:55 cph Rel $ * * Format of the SCode representation of programs. Each of these * is described in terms of the slots in the data structure. diff --git a/v7/src/microcode/sdata.h b/v7/src/microcode/sdata.h index 6b020e87b..242de87e1 100644 --- a/v7/src/microcode/sdata.h +++ b/v7/src/microcode/sdata.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sdata.h,v 9.29 1988/06/04 23:23:21 mhwu Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sdata.h,v 9.30 1988/08/15 20:55:03 cph Rel $ * * Description of the user data objects. This should parallel the * file SDATA.SCM in the runtime system. diff --git a/v7/src/microcode/stack.h b/v7/src/microcode/stack.h index 6c7182b78..63850f0a7 100644 --- a/v7/src/microcode/stack.h +++ b/v7/src/microcode/stack.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/stack.h,v 9.25 1987/11/20 08:16:13 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/stack.h,v 9.26 1988/08/15 20:55:15 cph Rel $ */ /* This file contains macros for manipulating stacks and stacklets. */ @@ -78,7 +78,7 @@ MIT in each case. */ #define Internal_Terminate_Old_Stacklet() \ { \ - Current_Stacklet[STACKLET_REUSE_FLAG] = TRUTH; \ + Current_Stacklet[STACKLET_REUSE_FLAG] = SHARP_T; \ Current_Stacklet[STACKLET_UNUSED_LENGTH] = \ Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, \ (Stack_Pointer - Stack_Guard)); \ diff --git a/v7/src/microcode/step.c b/v7/src/microcode/step.c index 6921c4c49..0e473da47 100644 --- a/v7/src/microcode/step.c +++ b/v7/src/microcode/step.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,13 +30,13 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/step.c,v 9.24 1987/12/04 22:19:24 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/step.c,v 9.25 1988/08/15 20:55:24 cph Exp $ * * Support for the stepper */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /**********************************/ /* Support of stepping primitives */ @@ -81,7 +81,7 @@ Install_Traps(Hunk3, Return_Hook_Too) APPLY or return. */ -DEFINE_PRIMITIVE("PRIMITIVE-EVAL-STEP", Prim_Eval_Step, 3) +DEFINE_PRIMITIVE ("PRIMITIVE-EVAL-STEP", Prim_eval_step, 3, 3, 0) { Primitive_3_Args(); @@ -103,7 +103,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-EVAL-STEP", Prim_Eval_Step, 3) required before actually building a frame */ -DEFINE_PRIMITIVE("PRIMITIVE-APPLY-STEP", Prim_Apply_Step, 3) +DEFINE_PRIMITIVE ("PRIMITIVE-APPLY-STEP", Prim_apply_step, 3, 3, 0) { Pointer Next_From_Slot, *Next_To_Slot; long Number_Of_Args, i; @@ -150,7 +150,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-APPLY-STEP", Prim_Apply_Step, 3) this is ever changed, be sure to check for COMPILE_STEPPER flag! */ -DEFINE_PRIMITIVE("PRIMITIVE-RETURN-STEP", Prim_Return_Step, 2) +DEFINE_PRIMITIVE ("PRIMITIVE-RETURN-STEP", Prim_return_step, 2, 2, 0) { Pointer Return_Hook; Primitive_2_Args(); diff --git a/v7/src/microcode/storage.c b/v7/src/microcode/storage.c index 176a7ed73..8a2cc3005 100644 --- a/v7/src/microcode/storage.c +++ b/v7/src/microcode/storage.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.42 1988/02/12 16:52:28 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.43 1988/08/15 20:55:32 cph Rel $ This file defines the storage for global variables for the Scheme Interpreter. */ diff --git a/v7/src/microcode/string.c b/v7/src/microcode/string.c index 6f007daf2..bebde9522 100644 --- a/v7/src/microcode/string.c +++ b/v7/src/microcode/string.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,12 +30,12 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 9.30 1988/03/31 21:23:18 jrm Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 9.31 1988/08/15 20:55:43 cph Exp $ */ /* String primitives. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "char.h" #include "string.h" @@ -73,21 +73,21 @@ memory_to_string (nbytes, data) /* Currently the strings used in symbols have type codes in the length field. They should be changed to have just longwords there. */ -DEFINE_PRIMITIVE ("STRING-ALLOCATE", Prim_String_Allocate, 1) +DEFINE_PRIMITIVE ("STRING-ALLOCATE", Prim_string_allocate, 1, 1, 0) { PRIMITIVE_HEADER (1); PRIMITIVE_RETURN (allocate_string (arg_nonnegative_integer (1))); } -DEFINE_PRIMITIVE ("STRING?", Prim_String_P, 1) +DEFINE_PRIMITIVE ("STRING?", Prim_string_p, 1, 1, 0) { PRIMITIVE_HEADER (1); - PRIMITIVE_RETURN ((STRING_P (ARG_REF (1))) ? TRUTH : NIL); + PRIMITIVE_RETURN ((STRING_P (ARG_REF (1))) ? SHARP_T : NIL); } -DEFINE_PRIMITIVE ("STRING-LENGTH", Prim_String_Length, 1) +DEFINE_PRIMITIVE ("STRING-LENGTH", Prim_string_length, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -95,7 +95,7 @@ DEFINE_PRIMITIVE ("STRING-LENGTH", Prim_String_Length, 1) PRIMITIVE_RETURN (Make_Unsigned_Fixnum (string_length (ARG_REF (1)))); } -DEFINE_PRIMITIVE ("STRING-MAXIMUM-LENGTH", Prim_String_Maximum_Length, 1) +DEFINE_PRIMITIVE ("STRING-MAXIMUM-LENGTH", Prim_string_maximum_length, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -104,7 +104,7 @@ DEFINE_PRIMITIVE ("STRING-MAXIMUM-LENGTH", Prim_String_Maximum_Length, 1) (Make_Unsigned_Fixnum ((maximum_string_length (ARG_REF (1))) - 1)); } -DEFINE_PRIMITIVE ("SET-STRING-LENGTH!", Prim_Set_String_Length, 2) +DEFINE_PRIMITIVE ("SET-STRING-LENGTH!", Prim_set_string_length, 2, 2, 0) { fast Pointer string; fast long length; @@ -144,10 +144,10 @@ substring_length_min (start1, end1, start2, end2) \ PRIMITIVE_RETURN (process_result (string_ref (string, index))) -DEFINE_PRIMITIVE ("STRING-REF", Prim_String_Ref, 2) +DEFINE_PRIMITIVE ("STRING-REF", Prim_string_ref, 2, 2, 0) { STRING_REF_BODY (c_char_to_scheme_char); } -DEFINE_PRIMITIVE ("VECTOR-8B-REF", Prim_Vec_8b_Ref, 2) +DEFINE_PRIMITIVE ("VECTOR-8B-REF", Prim_vec_8b_ref, 2, 2, 0) { STRING_REF_BODY (Make_Unsigned_Fixnum); } #define STRING_SET_BODY(get_ascii, process_result) \ @@ -168,10 +168,10 @@ DEFINE_PRIMITIVE ("VECTOR-8B-REF", Prim_Vec_8b_Ref, 2) (*char_pointer) = ascii; \ PRIMITIVE_RETURN (process_result (result)) -DEFINE_PRIMITIVE ("STRING-SET!", Prim_String_Set, 3) +DEFINE_PRIMITIVE ("STRING-SET!", Prim_string_set, 3, 3, 0) { STRING_SET_BODY (arg_ascii_char, c_char_to_scheme_char); } -DEFINE_PRIMITIVE ("VECTOR-8B-SET!", Prim_Vec_8b_Set, 3) +DEFINE_PRIMITIVE ("VECTOR-8B-SET!", Prim_vec_8b_set, 3, 3, 0) { STRING_SET_BODY (arg_ascii_integer, MAKE_UNSIGNED_FIXNUM); } #define SUBSTRING_MOVE_PREFIX() \ @@ -195,7 +195,7 @@ DEFINE_PRIMITIVE ("VECTOR-8B-SET!", Prim_Vec_8b_Set, 3) if (end2 > (string_length (ARG_REF (4)))) \ error_bad_range_arg (3) -DEFINE_PRIMITIVE ("SUBSTRING-MOVE-RIGHT!", Prim_Substring_Move_Right, 5) +DEFINE_PRIMITIVE ("SUBSTRING-MOVE-RIGHT!", Prim_substring_move_right, 5, 5, 0) { SUBSTRING_MOVE_PREFIX (); @@ -206,7 +206,7 @@ DEFINE_PRIMITIVE ("SUBSTRING-MOVE-RIGHT!", Prim_Substring_Move_Right, 5) PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("SUBSTRING-MOVE-LEFT!", Prim_Substring_Move_Left, 5) +DEFINE_PRIMITIVE ("SUBSTRING-MOVE-LEFT!", Prim_substring_move_left, 5, 5, 0) { SUBSTRING_MOVE_PREFIX (); @@ -233,7 +233,7 @@ DEFINE_PRIMITIVE ("SUBSTRING-MOVE-LEFT!", Prim_Substring_Move_Left, 5) if (start > end) \ error_bad_range_arg (2) -DEFINE_PRIMITIVE ("VECTOR-8B-FILL!", Prim_Vec_8b_Fill, 4) +DEFINE_PRIMITIVE ("VECTOR-8B-FILL!", Prim_vec_8b_fill, 4, 4, 0) { VECTOR_8B_SUBSTRING_PREFIX (); @@ -244,7 +244,7 @@ DEFINE_PRIMITIVE ("VECTOR-8B-FILL!", Prim_Vec_8b_Fill, 4) PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("VECTOR-8B-FIND-NEXT-CHAR", Prim_Vec_8b_Find_Next_Char, 4) +DEFINE_PRIMITIVE ("VECTOR-8B-FIND-NEXT-CHAR", Prim_vec_8b_find_next_char, 4, 4, 0) { VECTOR_8B_SUBSTRING_PREFIX (); @@ -258,7 +258,7 @@ DEFINE_PRIMITIVE ("VECTOR-8B-FIND-NEXT-CHAR", Prim_Vec_8b_Find_Next_Char, 4) PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("VECTOR-8B-FIND-PREVIOUS-CHAR", Prim_Vec_8b_Find_Prev_Char, 4) +DEFINE_PRIMITIVE ("VECTOR-8B-FIND-PREVIOUS-CHAR", Prim_vec_8b_find_prev_char, 4, 4, 0) { VECTOR_8B_SUBSTRING_PREFIX (); @@ -269,7 +269,7 @@ DEFINE_PRIMITIVE ("VECTOR-8B-FIND-PREVIOUS-CHAR", Prim_Vec_8b_Find_Prev_Char, 4) PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("VECTOR-8B-FIND-NEXT-CHAR-CI", Prim_Vec_8b_Find_Next_Char_Ci, 4) +DEFINE_PRIMITIVE ("VECTOR-8B-FIND-NEXT-CHAR-CI", Prim_vec_8b_find_next_char_ci, 4, 4, 0) { char char1; VECTOR_8B_SUBSTRING_PREFIX (); @@ -285,7 +285,7 @@ DEFINE_PRIMITIVE ("VECTOR-8B-FIND-NEXT-CHAR-CI", Prim_Vec_8b_Find_Next_Char_Ci, PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("VECTOR-8B-FIND-PREVIOUS-CHAR-CI", Prim_Vec_8b_Find_Prev_Char_Ci, 4) +DEFINE_PRIMITIVE ("VECTOR-8B-FIND-PREVIOUS-CHAR-CI", Prim_vec_8b_find_prev_char_ci, 4, 4, 0) { char char1; VECTOR_8B_SUBSTRING_PREFIX (); @@ -317,7 +317,7 @@ DEFINE_PRIMITIVE ("VECTOR-8B-FIND-PREVIOUS-CHAR-CI", Prim_Vec_8b_Find_Prev_Char_ if ((string_length (ARG_REF (4))) != MAX_ASCII) \ error_bad_range_arg (4) -DEFINE_PRIMITIVE ("SUBSTRING-FIND-NEXT-CHAR-IN-SET", Prim_Find_Next_Char_In_Set, 4) +DEFINE_PRIMITIVE ("SUBSTRING-FIND-NEXT-CHAR-IN-SET", Prim_find_next_char_in_set, 4, 4, 0) { SUBSTR_FIND_CHAR_IN_SET_PREFIX (); @@ -332,7 +332,7 @@ DEFINE_PRIMITIVE ("SUBSTRING-FIND-NEXT-CHAR-IN-SET", Prim_Find_Next_Char_In_Set, PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("SUBSTRING-FIND-PREVIOUS-CHAR-IN-SET", Prim_Find_Prev_Char_In_Set, 4) +DEFINE_PRIMITIVE ("SUBSTRING-FIND-PREVIOUS-CHAR-IN-SET", Prim_find_prev_char_in_set, 4, 4, 0) { SUBSTR_FIND_CHAR_IN_SET_PREFIX (); @@ -377,27 +377,27 @@ DEFINE_PRIMITIVE ("SUBSTRING-FIND-PREVIOUS-CHAR-IN-SET", Prim_Find_Prev_Char_In_ if (length != (end2 - start2)) \ PRIMITIVE_RETURN (NIL); -DEFINE_PRIMITIVE ("SUBSTRING=?", Prim_Substring_Equal, 6) +DEFINE_PRIMITIVE ("SUBSTRING=?", Prim_substring_equal, 6, 6, 0) { SUBSTRING_EQUAL_PREFIX (); while ((length--) > 0) if ((*scan1++) != (*scan2++)) PRIMITIVE_RETURN (NIL); - PRIMITIVE_RETURN (TRUTH); + PRIMITIVE_RETURN (SHARP_T); } -DEFINE_PRIMITIVE ("SUBSTRING-CI=?", Prim_Substring_Ci_Equal, 6) +DEFINE_PRIMITIVE ("SUBSTRING-CI=?", Prim_substring_ci_equal, 6, 6, 0) { SUBSTRING_EQUAL_PREFIX (); while ((length--) > 0) if ((char_upcase (*scan1++)) != (char_upcase (*scan2++))) PRIMITIVE_RETURN (NIL); - PRIMITIVE_RETURN (TRUTH); + PRIMITIVE_RETURN (SHARP_T); } -DEFINE_PRIMITIVE ("SUBSTRING' }; -DEFINE_PRIMITIVE ("STRING->SYNTAX-ENTRY", Prim_String_To_Syntax_Entry, 1) +DEFINE_PRIMITIVE ("STRING->SYNTAX-ENTRY", Prim_string_to_syntax_entry, 1, 1, 0) { long length, c, result; char *scan; @@ -128,7 +128,7 @@ DEFINE_PRIMITIVE ("STRING->SYNTAX-ENTRY", Prim_String_To_Syntax_Entry, 1) PRIMITIVE_RETURN (Make_Unsigned_Fixnum (result)); } -DEFINE_PRIMITIVE ("CHAR->SYNTAX-CODE", Prim_Char_To_Syntax_Code, 2) +DEFINE_PRIMITIVE ("CHAR->SYNTAX-CODE", Prim_char_to_syntax_code, 2, 2, 0) { Primitive_2_Args (); @@ -283,18 +283,18 @@ DEFINE_PRIMITIVE ("CHAR->SYNTAX-CODE", Prim_Char_To_Syntax_Code, 2) /* Quote Parsers */ -DEFINE_PRIMITIVE ("QUOTED-CHAR?", Prim_Quoted_Char_P, 4) +DEFINE_PRIMITIVE ("QUOTED-CHAR?", Prim_quoted_char_p, 4, 4, 0) { NORMAL_INITIALIZATION_BACKWARD (4); RIGHT_QUOTED_P (start, quoted); - PRIMITIVE_RETURN (quoted ? TRUTH : NIL); + PRIMITIVE_RETURN (quoted ? SHARP_T : NIL); } /* This is used in conjunction with `scan-list-backward' to find the beginning of an s-expression. */ -DEFINE_PRIMITIVE ("SCAN-BACKWARD-PREFIX-CHARS", Prim_Scan_Backward_Prefix_Chars, 4) +DEFINE_PRIMITIVE ("SCAN-BACKWARD-PREFIX-CHARS", Prim_scan_backward_prefix_chars, 4, 4, 0) { NORMAL_INITIALIZATION_BACKWARD (4); @@ -310,7 +310,7 @@ DEFINE_PRIMITIVE ("SCAN-BACKWARD-PREFIX-CHARS", Prim_Scan_Backward_Prefix_Chars, /* Word Parsers */ -DEFINE_PRIMITIVE ("SCAN-FORWARD-TO-WORD", Prim_Scan_Forward_To_Word, 4) +DEFINE_PRIMITIVE ("SCAN-FORWARD-TO-WORD", Prim_scan_forward_to_word, 4, 4, 0) { NORMAL_INITIALIZATION_FORWARD (4); @@ -322,7 +322,7 @@ DEFINE_PRIMITIVE ("SCAN-FORWARD-TO-WORD", Prim_Scan_Forward_To_Word, 4) } } -DEFINE_PRIMITIVE ("SCAN-WORD-FORWARD", Prim_Scan_Word_Forward, 4) +DEFINE_PRIMITIVE ("SCAN-WORD-FORWARD", Prim_scan_word_forward, 4, 4, 0) { NORMAL_INITIALIZATION_FORWARD (4); @@ -341,7 +341,7 @@ DEFINE_PRIMITIVE ("SCAN-WORD-FORWARD", Prim_Scan_Word_Forward, 4) } } -DEFINE_PRIMITIVE ("SCAN-WORD-BACKWARD", Prim_Scan_Word_Backward, 4) +DEFINE_PRIMITIVE ("SCAN-WORD-BACKWARD", Prim_scan_word_backward, 4, 4, 0) { NORMAL_INITIALIZATION_BACKWARD (4); @@ -362,7 +362,7 @@ DEFINE_PRIMITIVE ("SCAN-WORD-BACKWARD", Prim_Scan_Word_Backward, 4) /* S-Expression Parsers */ -DEFINE_PRIMITIVE ("SCAN-LIST-FORWARD", Prim_Scan_List_Forward, 7) +DEFINE_PRIMITIVE ("SCAN-LIST-FORWARD", Prim_scan_list_forward, 7, 7, 0) { SCAN_LIST_INITIALIZATION (NORMAL_INITIALIZATION_FORWARD); @@ -486,7 +486,7 @@ DEFINE_PRIMITIVE ("SCAN-LIST-FORWARD", Prim_Scan_List_Forward, 7) } } -DEFINE_PRIMITIVE ("SCAN-LIST-BACKWARD", Prim_Scan_List_Backward, 7) +DEFINE_PRIMITIVE ("SCAN-LIST-BACKWARD", Prim_scan_list_backward, 7, 7, 0) { SCAN_LIST_INITIALIZATION (NORMAL_INITIALIZATION_BACKWARD); @@ -627,7 +627,7 @@ struct levelstruct { char *last, *previous; }; (level -> last) = start; \ } while (0) -DEFINE_PRIMITIVE ("SCAN-SEXPS-FORWARD", Prim_Scan_Sexps_Forward, 7) +DEFINE_PRIMITIVE ("SCAN-SEXPS-FORWARD", Prim_scan_sexps_forward, 7, 7, 0) { long target_depth; Boolean stop_before; @@ -873,7 +873,7 @@ DEFINE_PRIMITIVE ("SCAN-SEXPS-FORWARD", Prim_Scan_Sexps_Forward, 7) (User_Vector_Set(result, 2, ((in_comment == 0) ? NIL : (Make_Unsigned_Fixnum (in_comment))))); - (User_Vector_Set(result, 3, ((quoted == false) ? NIL : TRUTH))); + (User_Vector_Set(result, 3, ((quoted == false) ? NIL : SHARP_T))); (User_Vector_Set(result, 4, (((level -> previous) == NULL) ? NIL : (Make_Unsigned_Fixnum diff --git a/v7/src/microcode/syntax.h b/v7/src/microcode/syntax.h index f887fb3a5..6d71bfd43 100644 --- a/v7/src/microcode/syntax.h +++ b/v7/src/microcode/syntax.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.h,v 1.2 1987/07/14 03:05:41 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.h,v 1.3 1988/08/15 20:56:14 cph Exp $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and diff --git a/v7/src/microcode/sysprim.c b/v7/src/microcode/sysprim.c index 1d71efa3e..b8351fa1c 100644 --- a/v7/src/microcode/sysprim.c +++ b/v7/src/microcode/sysprim.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,18 +30,18 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sysprim.c,v 9.29 1988/07/08 02:26:36 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sysprim.c,v 9.30 1988/08/15 20:56:21 cph Exp $ * * Random system primitives. Most are implemented in terms of * utilities in os.c * */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* Interrupt primitives */ -DEFINE_PRIMITIVE ("CHECK-AND-CLEAN-UP-INPUT-CHANNEL", Prim_Chk_And_Cln_Input_Channel, 2) +DEFINE_PRIMITIVE ("CHECK-AND-CLEAN-UP-INPUT-CHANNEL", Prim_chk_and_cln_input_channel, 2, 2, 0) { extern Boolean OS_Clean_Interrupt_Channel(); PRIMITIVE_HEADER (2); @@ -49,10 +49,10 @@ DEFINE_PRIMITIVE ("CHECK-AND-CLEAN-UP-INPUT-CHANNEL", Prim_Chk_And_Cln_Input_Cha PRIMITIVE_RETURN ((OS_Clean_Interrupt_Channel ((arg_nonnegative_integer (1)), (arg_nonnegative_integer (2)))) - ? TRUTH : NIL); + ? SHARP_T : NIL); } -DEFINE_PRIMITIVE ("GET-NEXT-INTERRUPT-CHARACTER", Prim_Get_Next_Interrupt_Char, 0) +DEFINE_PRIMITIVE ("GET-NEXT-INTERRUPT-CHARACTER", Prim_get_next_interrupt_char, 0, 0, 0) { int result; extern int OS_Get_Next_Interrupt_Character(); @@ -70,21 +70,21 @@ DEFINE_PRIMITIVE ("GET-NEXT-INTERRUPT-CHARACTER", Prim_Get_Next_Interrupt_Char, /* Time primitives */ -DEFINE_PRIMITIVE ("SYSTEM-CLOCK", Prim_System_Clock, 0) +DEFINE_PRIMITIVE ("SYSTEM-CLOCK", Prim_system_clock, 0, 0, 0) { PRIMITIVE_HEADER (0); PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (OS_process_clock ())); } -DEFINE_PRIMITIVE ("REAL-TIME-CLOCK", Prim_real_time_clock, 0) +DEFINE_PRIMITIVE ("REAL-TIME-CLOCK", Prim_real_time_clock, 0, 0, 0) { PRIMITIVE_HEADER (0); PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (OS_real_time_clock ())); } -DEFINE_PRIMITIVE ("SETUP-TIMER-INTERRUPT", Prim_Setup_Timer_Interrupt, 2) +DEFINE_PRIMITIVE ("SETUP-TIMER-INTERRUPT", Prim_setup_timer_interrupt, 2, 2, 0) { extern void Clear_Int_Timer(), Set_Int_Timer(); Primitive_2_Args(); @@ -115,22 +115,22 @@ DEFINE_PRIMITIVE ("SETUP-TIMER-INTERRUPT", Prim_Setup_Timer_Interrupt, 2) result = (OS_Name ()); \ PRIMITIVE_RETURN ((result == -1) ? NIL : (MAKE_UNSIGNED_FIXNUM (result))) -DEFINE_PRIMITIVE ("CURRENT-YEAR", Prim_current_year, 0) +DEFINE_PRIMITIVE ("CURRENT-YEAR", Prim_current_year, 0, 0, 0) { Date_Primitive (OS_Current_Year); } -DEFINE_PRIMITIVE ("CURRENT-MONTH", Prim_current_month, 0) +DEFINE_PRIMITIVE ("CURRENT-MONTH", Prim_current_month, 0, 0, 0) { Date_Primitive (OS_Current_Month); } -DEFINE_PRIMITIVE ("CURRENT-DAY", Prim_current_day, 0) +DEFINE_PRIMITIVE ("CURRENT-DAY", Prim_current_day, 0, 0, 0) { Date_Primitive (OS_Current_Day); } -DEFINE_PRIMITIVE ("CURRENT-HOUR", Prim_current_hour, 0) +DEFINE_PRIMITIVE ("CURRENT-HOUR", Prim_current_hour, 0, 0, 0) { Date_Primitive (OS_Current_Hour); } -DEFINE_PRIMITIVE ("CURRENT-MINUTE", Prim_current_minute, 0) +DEFINE_PRIMITIVE ("CURRENT-MINUTE", Prim_current_minute, 0, 0, 0) { Date_Primitive (OS_Current_Minute); } -DEFINE_PRIMITIVE ("CURRENT-SECOND", Prim_current_second, 0) +DEFINE_PRIMITIVE ("CURRENT-SECOND", Prim_current_second, 0, 0, 0) { Date_Primitive (OS_Current_Second); } /* Pretty random primitives */ @@ -138,7 +138,7 @@ DEFINE_PRIMITIVE ("CURRENT-SECOND", Prim_current_second, 0) /* (EXIT) Halt SCHEME, with no intention of restarting. */ -DEFINE_PRIMITIVE ("EXIT", Prim_Non_Restartable_Exit, 0) +DEFINE_PRIMITIVE ("EXIT", Prim_non_restartable_exit, 0, 0, 0) { PRIMITIVE_HEADER (0); @@ -149,12 +149,12 @@ DEFINE_PRIMITIVE ("EXIT", Prim_Non_Restartable_Exit, 0) Halt Scheme in such a way that it can be restarted. Not all operating systems support this. */ -DEFINE_PRIMITIVE ("HALT", Prim_Restartable_Exit, 0) +DEFINE_PRIMITIVE ("HALT", Prim_restartable_exit, 0, 0, 0) { extern Boolean Restartable_Exit(); PRIMITIVE_HEADER (0); - PRIMITIVE_RETURN (((Restartable_Exit ()) ? TRUTH : NIL)); + PRIMITIVE_RETURN (((Restartable_Exit ()) ? SHARP_T : NIL)); } /* (SET-RUN-LIGHT! OBJECT) @@ -163,7 +163,7 @@ DEFINE_PRIMITIVE ("HALT", Prim_Restartable_Exit, 0) In CScheme, rings the bell. Used by various things to indicate the state of the system. */ -DEFINE_PRIMITIVE ("SET-RUN-LIGHT!", Prim_Set_Run_Light, 1) +DEFINE_PRIMITIVE ("SET-RUN-LIGHT!", Prim_set_run_light, 1, 1, 0) { PRIMITIVE_HEADER (1); @@ -173,25 +173,25 @@ DEFINE_PRIMITIVE ("SET-RUN-LIGHT!", Prim_Set_Run_Light, 1) OS_tty_beep(); OS_Flush_Output_Buffer(); - PRIMITIVE_RETURN (TRUTH); + PRIMITIVE_RETURN (SHARP_T); } #else PRIMITIVE_RETURN (NIL); #endif } -DEFINE_PRIMITIVE ("UNDER-EMACS?", Prim_under_emacs_p, 0) +DEFINE_PRIMITIVE ("UNDER-EMACS?", Prim_under_emacs_p, 0, 0, 0) { extern Boolean OS_Under_Emacs(); PRIMITIVE_HEADER (0); - PRIMITIVE_RETURN (((OS_Under_Emacs ()) ? TRUTH : NIL)); + PRIMITIVE_RETURN (((OS_Under_Emacs ()) ? SHARP_T : NIL)); } #define CONVERT_ADDRESS(address) \ (C_Integer_To_Scheme_Integer ((long) (C_To_Scheme (address)))) -DEFINE_PRIMITIVE ("GC-SPACE-STATUS", Prim_gc_space_status, 0) +DEFINE_PRIMITIVE ("GC-SPACE-STATUS", Prim_gc_space_status, 0, 0, 0) { Pointer * constant_low; Pointer * constant_free; diff --git a/v7/src/microcode/trap.h b/v7/src/microcode/trap.h index 60751bf8e..7f026f7cd 100644 --- a/v7/src/microcode/trap.h +++ b/v7/src/microcode/trap.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/trap.h,v 9.39 1987/10/05 18:36:52 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/trap.h,v 9.40 1988/08/15 20:56:29 cph Rel $ */ /* Kinds of traps: diff --git a/v7/src/microcode/types.h b/v7/src/microcode/types.h index 49d1e612c..01c2fc9db 100644 --- a/v7/src/microcode/types.h +++ b/v7/src/microcode/types.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/types.h,v 9.28 1988/03/12 16:07:56 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/types.h,v 9.29 1988/08/15 20:56:46 cph Rel $ * * Type code definitions, numerical order * diff --git a/v7/src/microcode/usrdef.h b/v7/src/microcode/usrdef.h index bc53cad04..4d6b6c678 100644 --- a/v7/src/microcode/usrdef.h +++ b/v7/src/microcode/usrdef.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/usrdef.h,v 9.36 1987/04/16 02:31:57 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/usrdef.h,v 9.37 1988/08/15 20:57:37 cph Rel $ */ /* Macros and header for usrdef.c and variants. */ @@ -38,7 +38,7 @@ MIT in each case. */ #include "object.h" #include "errors.h" #include "prim.h" -#include "primitive.h" +#include "prims.h" extern void Microcode_Termination(), diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c index bf8d7b895..628d3bc78 100644 --- a/v7/src/microcode/utils.c +++ b/v7/src/microcode/utils.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,12 +30,12 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.37 1988/03/12 16:08:24 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.38 1988/08/15 20:57:46 cph Exp $ */ /* This file contains utilities for interrupts, errors, etc. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #include "flonum.h" #include "winder.h" #include "history.h" diff --git a/v7/src/microcode/vector.c b/v7/src/microcode/vector.c index 5aa0ff860..353643380 100644 --- a/v7/src/microcode/vector.c +++ b/v7/src/microcode/vector.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,13 +30,13 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/vector.c,v 9.30 1987/12/23 03:47:41 cph Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/vector.c,v 9.31 1988/08/15 20:57:57 cph Rel $ */ /* This file contains procedures for handling vectors and conversion back and forth to lists. */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" #define ARG_VECTOR(argument_number) \ ((VECTOR_P (ARG_REF (argument_number))) \ @@ -116,7 +116,7 @@ make_vector (length, contents) return (result); } -DEFINE_PRIMITIVE ("VECTOR-CONS", Prim_Vector_Cons, 2) +DEFINE_PRIMITIVE ("VECTOR-CONS", Prim_vector_cons, 2, 2, 0) { PRIMITIVE_HEADER (2); @@ -124,7 +124,7 @@ DEFINE_PRIMITIVE ("VECTOR-CONS", Prim_Vector_Cons, 2) (make_vector ((arg_nonnegative_integer (1)), (ARG_REF (2)))); } -DEFINE_PRIMITIVE ("VECTOR", Prim_vector, LEXPR) +DEFINE_PRIMITIVE ("VECTOR", Prim_vector, 0, LEXPR, 0) { Pointer result; fast Pointer *argument_scan; @@ -141,14 +141,14 @@ DEFINE_PRIMITIVE ("VECTOR", Prim_vector, LEXPR) PRIMITIVE_RETURN (result); } -DEFINE_PRIMITIVE ("SYSTEM-VECTOR?", Prim_Sys_Vector, 1) +DEFINE_PRIMITIVE ("SYSTEM-VECTOR?", Prim_sys_vector, 1, 1, 0) { fast Pointer object; PRIMITIVE_HEADER (1); object = (ARG_REF (1)); Touch_In_Primitive (object, object); - PRIMITIVE_RETURN ((GC_VECTOR_P (object)) ? TRUTH : NIL); + PRIMITIVE_RETURN ((GC_VECTOR_P (object)) ? SHARP_T : NIL); } #define VECTOR_LENGTH_PRIMITIVE(arg_type, arg_touch) \ @@ -159,10 +159,10 @@ DEFINE_PRIMITIVE ("SYSTEM-VECTOR?", Prim_Sys_Vector, 1) arg_touch (vector); \ PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (VECTOR_LENGTH (vector))) -DEFINE_PRIMITIVE ("VECTOR-LENGTH", Prim_Vector_Size, 1) +DEFINE_PRIMITIVE ("VECTOR-LENGTH", Prim_vector_size, 1, 1, 0) { VECTOR_LENGTH_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); } -DEFINE_PRIMITIVE ("SYSTEM-VECTOR-SIZE", Prim_Sys_Vec_Size, 1) +DEFINE_PRIMITIVE ("SYSTEM-VECTOR-SIZE", Prim_sys_vec_size, 1, 1, 0) { VECTOR_LENGTH_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); } #define VECTOR_REF_PRIMITIVE(arg_type, arg_touch) \ @@ -173,10 +173,10 @@ DEFINE_PRIMITIVE ("SYSTEM-VECTOR-SIZE", Prim_Sys_Vec_Size, 1) arg_touch (vector); \ PRIMITIVE_RETURN (VECTOR_REF (vector, (ARG_VECTOR_INDEX (2, vector)))) -DEFINE_PRIMITIVE ("VECTOR-REF", Prim_Vector_Ref, 2) +DEFINE_PRIMITIVE ("VECTOR-REF", Prim_vector_ref, 2, 2, 0) { VECTOR_REF_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); } -DEFINE_PRIMITIVE ("SYSTEM-VECTOR-REF", Prim_Sys_Vector_Ref, 2) +DEFINE_PRIMITIVE ("SYSTEM-VECTOR-REF", Prim_sys_vector_ref, 2, 2, 0) { VECTOR_REF_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); } #define VECTOR_SET_PRIMITIVE(arg_type, arg_touch) \ @@ -192,10 +192,10 @@ DEFINE_PRIMITIVE ("SYSTEM-VECTOR-REF", Prim_Sys_Vector_Ref, 2) Side_Effect_Impurify (vector, new_value); \ PRIMITIVE_RETURN (Swap_Pointers (locative, new_value)) -DEFINE_PRIMITIVE ("VECTOR-SET!", Prim_Vector_Set, 3) +DEFINE_PRIMITIVE ("VECTOR-SET!", Prim_vector_set, 3, 3, 0) { VECTOR_SET_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); } -DEFINE_PRIMITIVE ("SYSTEM-VECTOR-SET!", Prim_Sys_Vec_Set, 3) +DEFINE_PRIMITIVE ("SYSTEM-VECTOR-SET!", Prim_sys_vec_set, 3, 3, 0) { VECTOR_SET_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); } #define SUBVECTOR_TO_LIST_PRIMITIVE(arg_type, arg_touch) \ @@ -244,10 +244,10 @@ subvector_to_list (vector, start, end) return (result); } -DEFINE_PRIMITIVE ("SUBVECTOR->LIST", Prim_Subvector_To_List, 3) +DEFINE_PRIMITIVE ("SUBVECTOR->LIST", Prim_subvector_to_list, 3, 3, 0) { SUBVECTOR_TO_LIST_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); } -DEFINE_PRIMITIVE ("SYSTEM-SUBVECTOR-TO-LIST", Prim_Sys_Subvector_To_List, 3) +DEFINE_PRIMITIVE ("SYSTEM-SUBVECTOR-TO-LIST", Prim_sys_subvector_to_list, 3, 3, 0) { SUBVECTOR_TO_LIST_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); } static Pointer @@ -276,14 +276,14 @@ list_to_vector (result_type, argument_number) return (Make_Pointer (result_type, result)); } -DEFINE_PRIMITIVE ("LIST->VECTOR", Prim_List_To_Vector, 1) +DEFINE_PRIMITIVE ("LIST->VECTOR", Prim_list_to_vector, 1, 1, 0) { PRIMITIVE_HEADER (1); PRIMITIVE_RETURN (list_to_vector (TC_VECTOR, 1)); } -DEFINE_PRIMITIVE ("SYSTEM-LIST-TO-VECTOR", Prim_Sys_List_To_Vector, 2) +DEFINE_PRIMITIVE ("SYSTEM-LIST-TO-VECTOR", Prim_sys_list_to_vector, 2, 2, 0) { long type_code; PRIMITIVE_HEADER (2); @@ -324,7 +324,7 @@ DEFINE_PRIMITIVE ("SYSTEM-LIST-TO-VECTOR", Prim_Sys_List_To_Vector, 2) if (Is_Pure (Get_Pointer (vector2))) \ Primitive_Error (ERR_WRITE_INTO_PURE_SPACE) -DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-RIGHT!", Prim_subvector_move_right, 5) +DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-RIGHT!", Prim_subvector_move_right, 5, 5, 0) { subvector_move_prefix (); @@ -335,7 +335,7 @@ DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-RIGHT!", Prim_subvector_move_right, 5) PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-LEFT!", Prim_subvector_move_left, 5) +DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-LEFT!", Prim_subvector_move_left, 5, 5, 0) { subvector_move_prefix (); @@ -346,7 +346,7 @@ DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-LEFT!", Prim_subvector_move_left, 5) PRIMITIVE_RETURN (NIL); } -DEFINE_PRIMITIVE ("SUBVECTOR-FILL!", Prim_vector_fill, 4) +DEFINE_PRIMITIVE ("SUBVECTOR-FILL!", Prim_vector_fill, 4, 4, 0) { Pointer vector; long start, end; diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index dec6dc704..1a51ad90e 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.48 1988/08/09 19:29:18 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.49 1988/08/15 20:58:07 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 48 +#define SUBVERSION 49 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v7/src/microcode/winder.h b/v7/src/microcode/winder.h index 267ebf69a..523d56788 100644 --- a/v7/src/microcode/winder.h +++ b/v7/src/microcode/winder.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/winder.h,v 9.22 1987/04/16 02:33:24 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/winder.h,v 9.23 1988/08/15 20:58:36 cph Rel $ Header file for dynamic winder. diff --git a/v7/src/microcode/xdebug.c b/v7/src/microcode/xdebug.c index de2d59810..969b55188 100644 --- a/v7/src/microcode/xdebug.c +++ b/v7/src/microcode/xdebug.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/xdebug.c,v 9.23 1987/11/17 08:21:49 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/xdebug.c,v 9.24 1988/08/15 20:58:44 cph Exp $ * * This file contains primitives to debug the memory management in the * Scheme system. @@ -38,7 +38,7 @@ MIT in each case. */ */ #include "scheme.h" -#include "primitive.h" +#include "prims.h" /* New debugging utilities */ @@ -226,59 +226,59 @@ Print_Memory(Where, How_Many) /* Primitives to give scheme a handle on utilities from DEBUG.C */ -Define_Primitive(Prim_Show_Pure, 0, "SHOW-PURE") +DEFINE_PRIMITIVE ("SHOW-PURE", Prim_show_pure, 0, 0, 0) { Primitive_0_Args(); printf("\n*** Constant & Pure Space: ***\n"); Show_Pure(); - return TRUTH; + return SHARP_T; } -Define_Primitive(Prim_Show_Env, 1, "SHOW-ENV") +DEFINE_PRIMITIVE ("SHOW-ENV", Prim_show_env, 1, 1, 0) { Primitive_1_Arg(); printf("\n*** Environment = 0x%x ***\n", Arg1); Show_Env(Arg1); - return TRUTH; + return SHARP_T; } -Define_Primitive(Prim_Stack_Trace, 0, "STACK-TRACE") +DEFINE_PRIMITIVE ("STACK-TRACE", Prim_stack_trace, 0, 0, 0) { Primitive_0_Args(); printf("\n*** Back Trace: ***\n"); Back_Trace(stdout); - return TRUTH; + return SHARP_T; } -Define_Primitive(Prim_Find_Symbol, 1, "FIND-SYMBOL") +DEFINE_PRIMITIVE ("FIND-SYMBOL", Prim_find_symbol, 1, 1, 0) { Primitive_1_Arg(); Find_Symbol(); - return TRUTH; + return SHARP_T; } /* Primitives to give scheme a handle on utilities on this file. */ -Define_Primitive(Prim_Debug_Flags, 0, "DEBUG-FLAGS") +DEFINE_PRIMITIVE ("DEBUG-FLAGS", Prim_debug_flags, 0, 0, 0) { Primitive_0_Args(); Handle_Debug_Flags(); - return TRUTH; + return SHARP_T; } -Define_Primitive(Prim_Find_Who_Points, 3, "FIND-WHO-POINTS") +DEFINE_PRIMITIVE ("FIND-WHO-POINTS", Prim_find_who_points, 3, 3, 0) { Primitive_3_Args(); return Find_Who_Points(Arg1, Get_Integer(Arg2), Get_Integer(Arg3)); } -Define_Primitive(Prim_Print_Memory, 2, "PRINT-MEMORY") +DEFINE_PRIMITIVE ("PRINT-MEMORY", Prim_print_memory, 2, 2, 0) { Pointer *Base; Primitive_2_Args(); @@ -292,5 +292,5 @@ Define_Primitive(Prim_Print_Memory, 2, "PRINT-MEMORY") Base = Get_Pointer(Arg1); } Print_Memory(Base, Get_Integer(Arg2)); - return TRUTH; + return SHARP_T; } diff --git a/v7/src/microcode/zones.h b/v7/src/microcode/zones.h index a296baa98..6cef8843b 100644 --- a/v7/src/microcode/zones.h +++ b/v7/src/microcode/zones.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/zones.h,v 9.22 1987/07/07 19:57:38 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/zones.h,v 9.23 1988/08/15 20:58:52 cph Rel $ * * Metering stuff. * We break all times into time zones suitable for external analysis. diff --git a/v8/src/microcode/const.h b/v8/src/microcode/const.h index e72248c37..d2fe6008c 100644 --- a/v8/src/microcode/const.h +++ b/v8/src/microcode/const.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.28 1988/03/12 16:04:43 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.29 1988/08/15 20:44:34 cph Exp $ * * Named constants used throughout the interpreter * @@ -48,18 +48,21 @@ MIT in each case. */ /* Precomputed typed pointers */ #ifndef b32 /* Safe version */ -#define NIL Make_Non_Pointer(TC_NULL, 0) -#define TRUTH Make_Non_Pointer(TC_TRUE, 0) +#define SHARP_F Make_Non_Pointer(TC_NULL, 0) +#define SHARP_T Make_Non_Pointer(TC_TRUE, 0) #define FIXNUM_ZERO Make_Non_Pointer(TC_FIXNUM, 0) #define BROKEN_HEART_ZERO Make_Non_Pointer(TC_BROKEN_HEART, 0) #else /* 32 bit word */ -#define NIL 0x00000000 -#define TRUTH 0x08000000 +#define SHARP_F 0x00000000 +#define SHARP_T 0x08000000 #define FIXNUM_ZERO 0x1A000000 #define BROKEN_HEART_ZERO 0x22000000 #endif /* b32 */ +#define EMPTY_LIST SHARP_F +#define NIL SHARP_F +#define TRUTH SHARP_T #define NOT_THERE -1 /* Command line parser */ /* Assorted sizes used in various places */ diff --git a/v8/src/microcode/fasl.h b/v8/src/microcode/fasl.h index 44638062f..9655000dc 100644 --- a/v8/src/microcode/fasl.h +++ b/v8/src/microcode/fasl.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/fasl.h,v 9.28 1988/04/25 15:43:08 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/fasl.h,v 9.29 1988/08/15 20:46:07 cph Rel $ Contains information relating to the format of FASL files. The machine/opsys information is contained in config.h diff --git a/v8/src/microcode/fixobj.h b/v8/src/microcode/fixobj.h index affa4d2a7..498c62857 100644 --- a/v8/src/microcode/fixobj.h +++ b/v8/src/microcode/fixobj.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/fixobj.h,v 9.25 1987/04/28 16:38:00 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/fixobj.h,v 9.26 1988/08/15 20:47:07 cph Exp $ * * Declarations of user offsets into the Fixed Objects Vector. * This should correspond to the file UTABMD.SCM diff --git a/v8/src/microcode/gctype.c b/v8/src/microcode/gctype.c index a6b877269..ab762a0a8 100644 --- a/v8/src/microcode/gctype.c +++ b/v8/src/microcode/gctype.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/gctype.c,v 9.28 1988/03/12 16:06:21 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/gctype.c,v 9.29 1988/08/15 20:48:26 cph Rel $ * * This file contains the table which maps between Types and * GC Types. diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c index 45fcc321e..1ac96e4a8 100644 --- a/v8/src/microcode/interp.c +++ b/v8/src/microcode/interp.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.44 1988/05/05 08:42:47 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.45 1988/08/15 20:50:06 cph Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -1928,7 +1928,7 @@ Primitive_Internal_Apply: GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); if (GC_Daemon_Proc == NIL) { - RESULT_OF_PURIFY (TRUTH); + RESULT_OF_PURIFY (SHARP_T); break; } Store_Expression(NIL); @@ -1942,7 +1942,7 @@ Primitive_Internal_Apply: } case RC_PURIFY_GC_2: - RESULT_OF_PURIFY (TRUTH); + RESULT_OF_PURIFY (SHARP_T); break; case RC_REPEAT_DISPATCH: @@ -2086,7 +2086,7 @@ Primitive_Internal_Apply: /* Interpret(), continued */ case RC_SNAP_NEED_THUNK: - Vector_Set(Fetch_Expression(), THUNK_SNAPPED, TRUTH); + Vector_Set(Fetch_Expression(), THUNK_SNAPPED, SHARP_T); Vector_Set(Fetch_Expression(), THUNK_VALUE, Val); break; diff --git a/v8/src/microcode/lookup.c b/v8/src/microcode/lookup.c index efee37d5a..474d62378 100644 --- a/v8/src/microcode/lookup.c +++ b/v8/src/microcode/lookup.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.c,v 9.39 1988/05/03 19:18:47 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.c,v 9.40 1988/08/15 20:51:32 cph Exp $ * * This file contains symbol lookup and modification routines. See * Hal Abelson for a paper describing and justifying the algorithm. @@ -1219,7 +1219,7 @@ unassigned_p_transform (reference_result) switch (reference_result) { case ERR_UNASSIGNED_VARIABLE: - Val = TRUTH; + Val = SHARP_T; return (PRIM_DONE); case ERR_UNBOUND_VARIABLE: @@ -1261,7 +1261,7 @@ Symbol_Lex_unbound_p( frame, symbol) case ERR_UNBOUND_VARIABLE: { - Val = TRUTH; + Val = SHARP_T; return (PRIM_DONE); } diff --git a/v8/src/microcode/mul.c b/v8/src/microcode/mul.c index 056329ef2..cbaf1198a 100644 --- a/v8/src/microcode/mul.c +++ b/v8/src/microcode/mul.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/mul.c,v 9.23 1988/06/29 08:01:51 arthur Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/mul.c,v 9.24 1988/08/15 20:52:09 cph Exp $ * * This file contains the portable fixnum multiplication procedure. * Returns NIL if the result does not fit in a fixnum. diff --git a/v8/src/microcode/object.h b/v8/src/microcode/object.h index 88d6a7e3b..ccef209f1 100644 --- a/v8/src/microcode/object.h +++ b/v8/src/microcode/object.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/object.h,v 9.28 1988/05/10 17:34:41 cph Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/object.h,v 9.29 1988/08/15 20:52:18 cph Exp $ */ /* This file contains definitions pertaining to the C view of Scheme pointers: widths of fields, extraction macros, pre-computed @@ -92,8 +92,8 @@ MIT in each case. */ #define pointer_type(P) (OBJECT_TYPE (P)) #define pointer_datum(P) (OBJECT_DATUM (P)) -#define Make_Object(TC, D) \ -((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D))) +#define Make_Object(TC, D) \ + ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D))) #ifndef Heap_In_Low_Memory /* Portable version */ @@ -104,9 +104,9 @@ extern Pointer *Memory_Base; /* The "-1" in the value returned is a guarantee that there is one word reserved exclusively for use by the garbage collector. */ -#define Allocate_Heap_Space(space) \ - (Memory_Base = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ - Heap = Memory_Base, \ +#define Allocate_Heap_Space(space) \ + (Memory_Base = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ + Heap = Memory_Base, \ ((Memory_Base + (space)) - 1)) #define Get_Pointer(P) ((Pointer *) (Memory_Base + (OBJECT_DATUM (P)))) @@ -116,8 +116,8 @@ extern Pointer *Memory_Base; typedef long relocation_type; /* Used to relocate pointers on fasload */ -#define Allocate_Heap_Space(space) \ - (Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ +#define Allocate_Heap_Space(space) \ + (Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \ ((Heap + (space)) - 1)) #ifdef spectrum @@ -144,7 +144,7 @@ typedef long relocation_type; /* Used to relocate pointers on fasload */ #define Store_Type_Code(P, TC) P = (Make_Object ((TC), (P))) -#define Store_Address(P, A) \ +#define Store_Address(P, A) \ P = (((P) & TYPE_CODE_MASK) | (OBJECT_DATUM ((Pointer) (A)))) #define Address(P) (OBJECT_DATUM (P)) @@ -220,7 +220,7 @@ do \ (target) |= (-1 << ADDRESS_LENGTH); \ } while (0) -#define BOOLEAN_TO_OBJECT(expression) ((expression) ? TRUTH : NIL) +#define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F) #define Make_Broken_Heart(N) (BROKEN_HEART_ZERO + (N)) #define Make_Unsigned_Fixnum(N) (FIXNUM_ZERO + (N)) @@ -228,40 +228,40 @@ do \ #define Get_Float(P) (* ((double *) (Nth_Vector_Loc ((P), 1)))) #define Get_Integer(P) (OBJECT_DATUM (P)) -#define Sign_Extend(P, S) \ -{ \ - (S) = (Get_Integer (P)); \ - if (((S) & FIXNUM_SIGN_BIT) != 0) \ - (S) |= (-1 << ADDRESS_LENGTH); \ +#define Sign_Extend(P, S) \ +{ \ + (S) = (Get_Integer (P)); \ + if (((S) & FIXNUM_SIGN_BIT) != 0) \ + (S) |= (-1 << ADDRESS_LENGTH); \ } -#define Fixnum_Fits(x) \ - ((((x) & SIGN_MASK) == 0) || \ +#define Fixnum_Fits(x) \ + ((((x) & SIGN_MASK) == 0) || \ (((x) & SIGN_MASK) == SIGN_MASK)) #define BYTES_TO_POINTERS(nbytes) \ (((nbytes) + ((sizeof (Pointer)) - 1)) / (sizeof (Pointer))) -#define Is_Constant(address) \ +#define Is_Constant(address) \ (((address) >= Constant_Space) && ((address) < Free_Constant)) -#define Is_Pure(address) \ +#define Is_Pure(address) \ ((Is_Constant (address)) && (Pure_Test (address))) -#define Side_Effect_Impurify(Old_Pointer, Will_Contain) \ -if ((Is_Constant (Get_Pointer (Old_Pointer))) && \ - (GC_Type (Will_Contain) != GC_Non_Pointer) && \ - (! (Is_Constant (Get_Pointer (Will_Contain)))) && \ - (Pure_Test (Get_Pointer (Old_Pointer)))) \ - Primitive_Error (ERR_WRITE_INTO_PURE_SPACE); +#define Side_Effect_Impurify(Old_Pointer, Will_Contain) \ +if ((Is_Constant (Get_Pointer (Old_Pointer))) && \ + (GC_Type (Will_Contain) != GC_Non_Pointer) && \ + (! (Is_Constant (Get_Pointer (Will_Contain)))) && \ + (Pure_Test (Get_Pointer (Old_Pointer)))) \ + Primitive_Error (ERR_WRITE_INTO_PURE_SPACE); \ #ifdef FLOATING_ALIGNMENT -#define FLOATING_BUFFER_SPACE \ - ((FLOATING_ALIGNMENT + 1)/sizeof(Pointer)) +#define FLOATING_BUFFER_SPACE \ + ((FLOATING_ALIGNMENT + 1)/sizeof(Pointer)) -#define HEAP_BUFFER_SPACE \ - (TRAP_MAX_IMMEDIATE + 1 + FLOATING_BUFFER_SPACE) +#define HEAP_BUFFER_SPACE \ + (TRAP_MAX_IMMEDIATE + 1 + FLOATING_BUFFER_SPACE) /* The space is there, find the correct position. */ diff --git a/v8/src/microcode/psbmap.h b/v8/src/microcode/psbmap.h index f849dfede..4a4628754 100644 --- a/v8/src/microcode/psbmap.h +++ b/v8/src/microcode/psbmap.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbmap.h,v 9.26 1988/02/10 15:44:07 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbmap.h,v 9.27 1988/08/15 20:53:22 cph Rel $ * * This file contains macros and declarations for Bintopsb.c * and Psbtobin.c diff --git a/v8/src/microcode/returns.h b/v8/src/microcode/returns.h index 36f6487ab..add8ae01b 100644 --- a/v8/src/microcode/returns.h +++ b/v8/src/microcode/returns.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/returns.h,v 9.32 1988/04/27 01:09:19 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/returns.h,v 9.33 1988/08/15 20:54:20 cph Exp $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several diff --git a/v8/src/microcode/trap.h b/v8/src/microcode/trap.h index 93a796cb2..65e52be1d 100644 --- a/v8/src/microcode/trap.h +++ b/v8/src/microcode/trap.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/trap.h,v 9.39 1987/10/05 18:36:52 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/trap.h,v 9.40 1988/08/15 20:56:29 cph Rel $ */ /* Kinds of traps: diff --git a/v8/src/microcode/types.h b/v8/src/microcode/types.h index e8de8263d..8968926c3 100644 --- a/v8/src/microcode/types.h +++ b/v8/src/microcode/types.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1988 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/types.h,v 9.28 1988/03/12 16:07:56 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/types.h,v 9.29 1988/08/15 20:56:46 cph Rel $ * * Type code definitions, numerical order * diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index 7bc9c5218..4e2d973df 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.48 1988/08/09 19:29:18 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.49 1988/08/15 20:58:07 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 48 +#define SUBVERSION 49 #endif #ifndef UCODE_TABLES_FILENAME