/* -*-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
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.
/* -*-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
*/
\f
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "version.h"
#include "char.h"
#include "string.h"
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);
#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;
PRIMITIVE_RETURN (Result);
}
\f
-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;
PRIMITIVE_RETURN (Result);
}
\f
-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;
/* -*-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
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 <ctype.h>
\f
return (ascii);
}
\f
-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);
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);
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);
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);
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);
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);
(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);
(char_upcase (char_code (ARG_REF (1))))));
}
\f
-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);
/* -*-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
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.
*
/* -*-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
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.
*
/* -*-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
/* Compiled Code Utilities */
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
extern Pointer
*compiled_entry_to_block_address();
#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 ();
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 ();
#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;
PRIMITIVE_RETURN (Make_Pointer(TC_HUNK3, temp));
}
\f
-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;
/* -*-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
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.
/* -*-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
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
*
/* 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 */
\f
/* Assorted sizes used in various places */
/* -*-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
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
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
\f
/* (CLOSE-LOST-OPEN-FILES file-list)
file-list is an assq-like list where the associations are weak
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;
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;
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;
}
/* -*-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
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"
\f
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;
}
\f
/* Code for interactively setting and clearing the interpreter
/* -*-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
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.
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
\f
#ifndef unix
#include "Error: dumpworld.c does not work on non-unix machines."
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;
Buflen = Save_Input_Buffer();
Was_Scheme_Dumped = true;
- Val = TRUTH;
+ Val = SHARP_T;
OS_Quit();
Pop_Primitive_Frame(1);
/* -*-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
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.
*/
/* -*-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
/* -*-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
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.
*
/* -*-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
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"
\f
/* Mapping between the internal and external representations of
primitives and return addresses.
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;
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();
PRIMITIVE_RETURN(MAKE_UNSIGNED_FIXNUM(number));
}
\f
-/* (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;
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)));
+}
\f
/* (GET-PRIMITIVE-COUNTS)
Returns a CONS of the number of primitives defined in this
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();
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;
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;
intern_p = false;
arity = UNKNOWN_PRIMITIVE_ARITY;
}
- else if (Arg2 == TRUTH)
+ else if (Arg2 == SHARP_T)
{
allow_p = true;
intern_p = false;
/* -*-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
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.
*
/* -*-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
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"
}
if (code == PRIM_DONE)
{
- return (TRUTH);
+ return (SHARP_T);
}
else if (code == PRIM_INTERRUPT)
{
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;
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 */
segment. See fasload.c for further information.
*/
- if (Flag == TRUTH)
+ if (Flag == SHARP_T)
{
Pointer *Addr_Of_New_Object;
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;
result = (Close_Dump_File() && result);
Band_Dump_Exit_Hook();
Free = saved_free;
- PRIMITIVE_RETURN(result ? TRUTH : NIL);
+ PRIMITIVE_RETURN(result ? SHARP_T : NIL);
}
/* -*-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
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
/* -*-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
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
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "gccode.h"
#include "trap.h"
#include "load.c"
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();
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();
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();
/* -*-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
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),
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "flonum.h"
#include "zones.h"
#include <math.h>
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;
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;
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;
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;
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"
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();
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();
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;
/* -*-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
that will eventually go away. */
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
\f
#define FIXNUM_PRIMITIVE_1(parameter_1) \
fast long parameter_1; \
return (Make_Signed_Fixnum (fixnum));
#define BOOLEAN_RESULT(x) \
- return ((x) ? TRUTH : NIL)
+ return ((x) ? SHARP_T : NIL)
\f
/* 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);
\f
/* 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);
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);
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);
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);
FIXNUM_RESULT (result);
}
\f
-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 */
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;
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);
/* -*-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
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
/* -*-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
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"
\f
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();
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();
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();
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();
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();
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();
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();
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();
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();
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();
Flonum_Result(atan(Get_Float(Arg1)));
}
\f
-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();
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();
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;
Flonum_Result(sqrt(Arg));
}
\f
-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();
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();
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();
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();
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 */
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 */
/* -*-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
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"
\f
#ifndef COMPILE_FUTURES
*/
-Define_Primitive(Prim_Touch, 1, "TOUCH")
+DEFINE_PRIMITIVE ("TOUCH", Prim_touch, 1, 1, 0)
{
Pointer Result;
Primitive_1_Arg();
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;
}
\f
/* Utility setting routine for use by the various test and set if
<Old Value>. The value returned is either <CONS Cell> (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();
<Old Value>. The value returned is either <CONS Cell> (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);
to contain <Old Value>. The value returned is either <Vector> (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();
contain <Old Value>. The value returned is either <Triple> (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;
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();
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;
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();
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();
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
{
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();
else
{
Vector_Set(Arg1, FUTURE_LOCK, NIL);
- return TRUTH;
+ return SHARP_T;
}
}
\f
/* (FUTURE->VECTOR <Future>)
Create a COPY of <future> 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;
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);
}
\f
/* 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;
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;
*/
-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;
*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. */
/* -*-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
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
*/
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
/* -*-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
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.
/* -*-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
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
/* -*-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
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.
/* -*-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
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.
/* -*-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
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"
\f
-
/* 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))); \
+ } \
+}
\f
-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;
}
}
\f
-#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)
\f
#define Inc_Dec(Normal_Op, Big_Op, Complex_Op) \
Primitive_1_Arg(); \
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)
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*/
}
-
\f
#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)) \
{ 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)
-\f
+ 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); \
{ 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)
\f
#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)
-\f
+ } \
+ 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); \
} \
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*/
}
\f
#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) \
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*/
}
\f
-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:
{ 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);
Reduced_Flonum_Result(A * Get_Float(Arg2));
}
-/* Prim_Multiply continues on the next page */
-\f
-/* Prim_Multiply, continued */
-
case TC_BIG_FIXNUM:
{ Pointer Big_Arg1 = Fix_To_Big(Arg1);
Bignum_Operation(multiply_signed_bignum(Fetch_Bignum(Big_Arg1),
}
/*NOTREACHED*/
}
-
-/* Prim_Multiply continues on the next page */
-\f
-/* Prim_Multiply, continued */
-
case TC_BIG_FIXNUM:
{ switch (Type_Code(Arg2))
{ case TC_FIXNUM:
}
/*NOTREACHED*/
}
-
\f
-
-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)));
}
-
\f
static Pointer basic_divide(Arg1, Arg2)
fast Pointer Arg1, Arg2;
/*NOTREACHED*/
}
\f
-
-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)));
}
-
-
\f
-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))
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*/
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*/
/* -*-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
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.
*
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"
\f
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;
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; \
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 ();
/*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 ();
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 ();
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();
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 ();
#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);
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:
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();
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();
}
}
\f
-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();
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();
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();
/* (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);
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);
/* (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);
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;
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();
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();
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();
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();
\f
/* 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();
/* 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;
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();
/* -*-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
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();
/* (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();
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();
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();
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();
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();
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);
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);
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);
/* -*-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
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 <math.h>
/* 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;
return Result;
}
\f
-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;
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;
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;
}
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;
}
}
-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;
/* 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;
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;
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;
}
}
-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;
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;
}
}
-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;
/* 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;
/* 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;
return Arg1;
}
\f
-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;
return Arg1;
}
\f
-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;
return Arg1;
}
\f
-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;
/*
\f
-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;
(Result)=Sum; \
}
\f
-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;
Reduced_Flonum_Result(C_Result);
}
\f
-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;
/* 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;
else return( (twopi - t_bar) / pi );
}
\f
-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;
return Result;
}
\f
-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;
return Result;
}
\f
-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;
\f
/ * 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;
/* -*-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
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; */
/* -*-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
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.
*/
\f
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "locks.h"
#include "zones.h"
processors have begun execution of WORK (or TEST returns false).
*/
\f
-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;
return Do_It;
}
\f
-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();
{
Vector_Set(Queue_Tail, CONS_CDR, New_Entry);
}
- PRIMITIVE_RETURN(TRUTH);
+ PRIMITIVE_RETURN(SHARP_T);
}
\f
-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();
{
Vector_Set(The_Queue, CONS_CDR, New_Entry);
}
- PRIMITIVE_RETURN(TRUTH);
+ PRIMITIVE_RETURN(SHARP_T);
}
\f
-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();
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();
PRIMITIVE_RETURN(This_Cons);
}
\f
-DEFINE_PRIMITIVE("GET-WORK", Prim_Get_Work, 1)
+DEFINE_PRIMITIVE ("GET-WORK", Prim_get_work, 1, 1, 0)
{
Pointer Get_Work();
Primitive_1_Arg();
return (Result);
}
\f
-DEFINE_PRIMITIVE("AWAIT-SYNCHRONY", Prim_Await_Sync, 1)
+DEFINE_PRIMITIVE ("AWAIT-SYNCHRONY", Prim_await_sync, 1, 1, 0)
{
Primitive_1_Arg();
{
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();
Old_Time=Sys_Clock();
#endif
- PRIMITIVE_RETURN(TRUTH);
+ PRIMITIVE_RETURN(SHARP_T);
}
\f
/* 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
{
}
}
-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
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();
/* -*-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
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"
\f
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);
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);
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);
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);
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;
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
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);
}
case RC_PURIFY_GC_2:
- RESULT_OF_PURIFY (TRUTH);
+ RESULT_OF_PURIFY (SHARP_T);
break;
case RC_REPEAT_DISPATCH:
/* 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;
/* -*-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
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.
*
/* -*-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
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.
*/
/* -*-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
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"
\f
/* (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();
/* (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();
/* (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();
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();
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();
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();
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();
/* (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();
/* (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();
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;
}
/* (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;
}
/* (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();
/* (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();
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();
/* (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();
/* (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();
/* -*-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
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.
/* -*-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
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.
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
#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
(set! <symbol> <value>) in <environment>.
*/
-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);
Indistinguishable from evaluating <symbol> in <environment>.
*/
-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);
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);
(define <symbol> <value>) in <environment>.
*/
-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);
The special form (unassigned? <symbol>) 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);
The special form (unbound? <symbol>) 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);
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);
case ERR_UNASSIGNED_VARIABLE:
case ERR_UNBOUND_VARIABLE:
- PRIMITIVE_RETURN(TRUTH);
+ PRIMITIVE_RETURN(SHARP_T);
default:
signal_error_from_primitive(Result);
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();
TRAP_COMPILER_CACHED_DANGEROUS);
trap[1] = cache;
Store(cell[0], Make_Pointer(TC_REFERENCE_TRAP, trap));
- PRIMITIVE_RETURN(TRUTH);
+ PRIMITIVE_RETURN(SHARP_T);
}
\f
case TRAP_COMPILER_CACHED:
signal_error_from_primitive(result);
}
Vector_Set(value, TRAP_EXTRA, cache);
- PRIMITIVE_RETURN(TRUTH);
+ PRIMITIVE_RETURN(SHARP_T);
}
case TRAP_DANGEROUS:
signal_error_from_primitive(ERR_BAD_FRAME);
}
Store(cell[0], Make_Pointer(TC_REFERENCE_TRAP, trap));
- PRIMITIVE_RETURN(TRUTH);
+ PRIMITIVE_RETURN(SHARP_T);
}
}
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.
switch (reference_result)
{
case ERR_UNASSIGNED_VARIABLE:
- Val = TRUTH;
+ Val = SHARP_T;
return (PRIM_DONE);
case ERR_UNBOUND_VARIABLE:
case ERR_UNBOUND_VARIABLE:
{
- Val = TRUTH;
+ Val = SHARP_T;
return (PRIM_DONE);
}
/* -*-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
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.
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "gccode.h"
/* Imports */
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;
/* -*-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
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
*/
/* -*-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
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.
/* -*-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
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
#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)))
\f
#ifndef Heap_In_Low_Memory /* Portable version */
/* 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))))
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
#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))
(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))
#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); \
\f
#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. */
/* -*-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
/* The leftovers ... primitives that don't seem to belong elsewhere. */
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
\f
/* 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);
/* (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);
/* (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);
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);
/* (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);
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);
}
\f
/* Low level memory references.
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);
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);
/* 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);
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);
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);
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);
PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (OBJECT_DATUM (object)));
}
\f
-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;
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;
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)
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);
}
\f
/* Cells */
/* (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);
/* (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);
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;
/* -*-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
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 $ */
\f
/*
Primitive declarations.
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 */
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
\f
/* 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 ())
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
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
\f
Pointer Undefined_Primitives = NIL;
Pointer Undefined_Primitives_Arity = NIL;
return (arity);
}
}
+
+char *
+primitive_code_to_documentation (number)
+ long number;
+{
+ return
+ ((number > MAX_PRIMITIVE)
+ ? ((char *) 0)
+ : (Primitive_Documentation_Table [number]));
+}
\f
/* Externally visible utilities */
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();
/*
/* -*-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
/* Simple unix primitives. */
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "string.h"
#include <pwd.h>
#include <grp.h>
/* 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 ();
: (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 ();
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 ();
: (C_String_To_Scheme_String (entry -> pw_dir)));
}
\f
-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;
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 ();
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 ();
PRIMITIVE_RETURN (C_String_To_Scheme_String (entry -> gr_name));
}
\f
-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);
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);
}
\f
/* The following is originally from GNU Emacs. */
#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);
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);
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:
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? */
/* -*-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
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
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.
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "gccode.h"
#include "zones.h"
*New_Object = Make_Non_Pointer(PURE_PART, (Recomputed_Length + 5));
GC();
Set_Pure_Top();
- return (TRUTH);
+ return (SHARP_T);
}
\f
/* (PRIMITIVE-PURIFY OBJECT PURE? SAFETY-MARGIN)
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);
/* -*-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
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"
\f
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();
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();
? (compiled_entry_to_block_address(Arg1))
: (Get_Pointer(Arg1)));
if (Is_Pure(Obj_Address))
- return TRUTH;
+ return SHARP_T;
}
return NIL;
}
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();
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;
/* -*-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
/* -*-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
/* -*-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
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
/* -*-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
/* 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"
error_external_return (); \
} while (0)
\f
-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);
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;
(& (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); }
\f
#define RE_BUFFER_PRIMITIVE(procedure) \
(& (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); }
/* -*-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
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 $ */
\f
/* 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
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
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
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.
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. */
/* -*-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
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.
/* -*-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
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.
/* -*-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
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.
/* -*-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
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. */
\f
#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)); \
/* -*-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
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"
\f
/**********************************/
/* Support of stepping primitives */
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();
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;
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();
/* -*-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
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. */
/* -*-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
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"
\f
/* 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);
}
\f
-DEFINE_PRIMITIVE ("STRING-LENGTH", Prim_String_Length, 1)
+DEFINE_PRIMITIVE ("STRING-LENGTH", Prim_string_length, 1, 1, 0)
{
PRIMITIVE_HEADER (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);
(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;
\
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) \
(*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); }
\f
#define SUBSTRING_MOVE_PREFIX() \
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 ();
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 ();
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 ();
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 ();
PRIMITIVE_RETURN (NIL);
}
\f
-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 ();
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 ();
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 ();
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 ();
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 ();
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);
}
\f
-DEFINE_PRIMITIVE ("SUBSTRING<?", Prim_Substring_Less, 6)
+DEFINE_PRIMITIVE ("SUBSTRING<?", Prim_substring_less, 6, 6, 0)
{
long length, length1, length2;
SUBSTRING_COMPARE_PREFIX (start1, start2);
} \
PRIMITIVE_RETURN (NIL)
-DEFINE_PRIMITIVE ("SUBSTRING-UPCASE!", Prim_Substring_Upcase, 3)
+DEFINE_PRIMITIVE ("SUBSTRING-UPCASE!", Prim_substring_upcase, 3, 3, 0)
{ SUBSTRING_MODIFIER (char_upcase); }
-DEFINE_PRIMITIVE ("SUBSTRING-DOWNCASE!", Prim_Substring_Downcase, 3)
+DEFINE_PRIMITIVE ("SUBSTRING-DOWNCASE!", Prim_substring_downcase, 3, 3, 0)
{ SUBSTRING_MODIFIER (char_downcase); }
\f
#define SUBSTRING_MATCH_PREFIX(index1, index2) \
length = (substring_length_min (start1, end1, start2, end2)); \
unmatched = length;
-DEFINE_PRIMITIVE ("SUBSTRING-MATCH-FORWARD", Prim_Match_Forward, 6)
+DEFINE_PRIMITIVE ("SUBSTRING-MATCH-FORWARD", Prim_match_forward, 6, 6, 0)
{
SUBSTRING_MATCH_PREFIX (start1, start2);
PRIMITIVE_RETURN (Make_Unsigned_Fixnum (length));
}
-DEFINE_PRIMITIVE ("SUBSTRING-MATCH-FORWARD-CI", Prim_Match_Forward_Ci, 6)
+DEFINE_PRIMITIVE ("SUBSTRING-MATCH-FORWARD-CI", Prim_match_forward_ci, 6, 6, 0)
{
SUBSTRING_MATCH_PREFIX (start1, start2);
PRIMITIVE_RETURN (Make_Unsigned_Fixnum (length));
}
-DEFINE_PRIMITIVE ("SUBSTRING-MATCH-BACKWARD", Prim_Match_Backward, 6)
+DEFINE_PRIMITIVE ("SUBSTRING-MATCH-BACKWARD", Prim_match_backward, 6, 6, 0)
{
SUBSTRING_MATCH_PREFIX (end1, end2);
PRIMITIVE_RETURN (Make_Unsigned_Fixnum (length));
}
-DEFINE_PRIMITIVE ("SUBSTRING-MATCH-BACKWARD-CI", Prim_Match_Backward_Ci, 6)
+DEFINE_PRIMITIVE ("SUBSTRING-MATCH-BACKWARD-CI", Prim_match_backward_ci, 6, 6, 0)
{
SUBSTRING_MATCH_PREFIX (end1, end2);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.c,v 1.8 1987/12/01 16:34:04 jrm Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.c,v 1.9 1988/08/15 20:56:02 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
Translated from GNU Emacs. */
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
#include "char.h"
#include "string.h"
#include "edwin.h"
' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>'
};
\f
-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;
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 ();
\f
/* 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);
\f
/* 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);
}
}
-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);
}
}
-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);
\f
/* 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);
}
}
\f
-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);
(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;
(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
/* -*-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
/* -*-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
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"
\f
/* 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);
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();
\f
/* 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();
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); }
\f
/* Pretty random primitives */
/* (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);
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)
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);
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));
}
\f
#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;
/* -*-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
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 $ */
\f
/* Kinds of traps:
/* -*-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
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
*
/* -*-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
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. */
#include "object.h"
#include "errors.h"
#include "prim.h"
-#include "primitive.h"
+#include "prims.h"
extern void
Microcode_Termination(),
/* -*-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
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"
/* -*-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
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"
\f
#define ARG_VECTOR(argument_number) \
((VECTOR_P (ARG_REF (argument_number))) \
return (result);
}
\f
-DEFINE_PRIMITIVE ("VECTOR-CONS", Prim_Vector_Cons, 2)
+DEFINE_PRIMITIVE ("VECTOR-CONS", Prim_vector_cons, 2, 2, 0)
{
PRIMITIVE_HEADER (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;
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);
}
\f
#define VECTOR_LENGTH_PRIMITIVE(arg_type, arg_touch) \
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) \
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) \
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); }
\f
#define SUBVECTOR_TO_LIST_PRIMITIVE(arg_type, arg_touch) \
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); }
\f
static Pointer
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);
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 ();
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 ();
PRIMITIVE_RETURN (NIL);
}
\f
-DEFINE_PRIMITIVE ("SUBVECTOR-FILL!", Prim_vector_fill, 4)
+DEFINE_PRIMITIVE ("SUBVECTOR-FILL!", Prim_vector_fill, 4, 4, 0)
{
Pointer vector;
long start, end;
/* -*-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
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 48
+#define SUBVERSION 49
#endif
#ifndef UCODE_TABLES_FILENAME
/* -*-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
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.
/* -*-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
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.
*/
#include "scheme.h"
-#include "primitive.h"
+#include "prims.h"
\f
/* New debugging utilities */
\f
/* 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;
}
\f
/* 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();
Base = Get_Pointer(Arg1);
}
Print_Memory(Base, Get_Integer(Arg2));
- return TRUTH;
+ return SHARP_T;
}
/* -*-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
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.
/* -*-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
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
*
/* 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 */
\f
/* Assorted sizes used in various places */
/* -*-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
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
/* -*-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
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
/* -*-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
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.
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
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);
}
case RC_PURIFY_GC_2:
- RESULT_OF_PURIFY (TRUTH);
+ RESULT_OF_PURIFY (SHARP_T);
break;
case RC_REPEAT_DISPATCH:
/* 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;
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.
switch (reference_result)
{
case ERR_UNASSIGNED_VARIABLE:
- Val = TRUTH;
+ Val = SHARP_T;
return (PRIM_DONE);
case ERR_UNBOUND_VARIABLE:
case ERR_UNBOUND_VARIABLE:
{
- Val = TRUTH;
+ Val = SHARP_T;
return (PRIM_DONE);
}
/* -*-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
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.
/* -*-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
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
#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)))
\f
#ifndef Heap_In_Low_Memory /* Portable version */
/* 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))))
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
#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))
(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))
#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); \
\f
#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. */
/* -*-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
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
/* -*-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
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
/* -*-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
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 $ */
\f
/* Kinds of traps:
/* -*-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
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
*
/* -*-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
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 48
+#define SUBVERSION 49
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff