From: Chris Hanson Date: Thu, 8 Mar 2001 18:00:31 +0000 (+0000) Subject: Export `declare_primitive' and `install_primitive' in "usrdef.h". X-Git-Tag: 20090517-FFI~2923 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=df872d7bb9315fc44b34c077126a91868a6a90a0;p=mit-scheme.git Export `declare_primitive' and `install_primitive' in "usrdef.h". Change declaration of name and doc-string elements to be `const'. --- diff --git a/v7/src/microcode/avltree.c b/v7/src/microcode/avltree.c index 6d7119117..9b32f1819 100644 --- a/v7/src/microcode/avltree.c +++ b/v7/src/microcode/avltree.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: avltree.c,v 1.4 1999/01/02 06:11:34 cph Exp $ +$Id: avltree.c,v 1.5 2001/03/08 18:00:14 cph Exp $ -Copyright (c) 1993-1999 Massachusetts Institute of Technology +Copyright (c) 1993-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -26,21 +26,20 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #include "avltree.h" -int EXFUN (strcmp_ci, (char * s1, char * s2)); +extern int EXFUN (strcmp_ci, (CONST char * s1, CONST char * s2)); +extern PTR EXFUN (malloc, (unsigned long)); +extern void EXFUN (free, (PTR)); -#ifndef NULL -# define NULL ((PTR) 0) -#endif - -char * tree_error_message = ((char *) NULL); -char * tree_error_noise = ((char *) NULL); +CONST char * tree_error_message = 0; +CONST char * tree_error_noise = 0; static void -DEFUN (tree_error, (message, noise), char * message AND char * noise) +DEFUN (tree_error, (message, noise), + CONST char * message AND + CONST char * noise) { tree_error_message = message; - tree_error_noise = noise; - return; + tree_error_noise = noise; } /* AVL trees. o(log n) lookup, insert (and delete, not implemented here). @@ -52,11 +51,9 @@ DEFUN (tree_error, (message, noise), char * message AND char * noise) With random insertion (or when created as below), they are better, approaching log base 2. - This version does not allow duplicate entries. - */ + This version does not allow duplicate entries. */ -#define BRANCH_HEIGHT(tree) \ - (((tree) == ((tree_node) NULL)) ? 0 : (tree)->height) +#define BRANCH_HEIGHT(tree) (((tree) == 0) ? 0 : (tree)->height) #ifndef MAX # define MAX(a,b) (((a) >= (b)) ? (a) : (b)) @@ -67,26 +64,24 @@ DEFUN (update_height, (tree), tree_node tree) { tree->height = (1 + (MAX ((BRANCH_HEIGHT (tree->left)), (BRANCH_HEIGHT (tree->rite))))); - return; } static tree_node DEFUN (leaf_make, (name, value), - char * name AND unsigned long value) + CONST char * name AND + unsigned long value) { - extern PTR EXFUN (malloc, (unsigned long)); tree_node leaf = ((tree_node) (malloc (sizeof (struct tree_node_s)))); - - if (leaf == ((tree_node) NULL)) - { - tree_error ("leaf_make: malloc failed.\n", NULL); - return (leaf); - } + if (leaf == 0) + { + tree_error ("leaf_make: malloc failed.\n", 0); + return (leaf); + } leaf->name = name; leaf->value = value; leaf->height = 1; - leaf->left = ((tree_node) NULL); - leaf->rite = ((tree_node) NULL); + leaf->left = 0; + leaf->rite = 0; return (leaf); } @@ -118,74 +113,74 @@ static tree_node DEFUN (rebalance_left, (tree), tree_node tree) { if ((1 + (BRANCH_HEIGHT (tree->rite))) >= (BRANCH_HEIGHT (tree->left))) - { - update_height (tree); - return (tree); - } + { + update_height (tree); + return (tree); + } else - { - tree_node q = tree->left; - if ((BRANCH_HEIGHT (q->rite)) > (BRANCH_HEIGHT (q->left))) - tree->left = (rotate_left (q)); - return (rotate_rite (tree)); - } + { + tree_node q = tree->left; + if ((BRANCH_HEIGHT (q->rite)) > (BRANCH_HEIGHT (q->left))) + tree->left = (rotate_left (q)); + return (rotate_rite (tree)); + } } static tree_node DEFUN (rebalance_rite, (tree), tree_node tree) { if ((1 + (BRANCH_HEIGHT (tree->left))) >= (BRANCH_HEIGHT (tree->rite))) - { - update_height (tree); - return (tree); - } + { + update_height (tree); + return (tree); + } else - { - tree_node q = tree->rite; - if ((BRANCH_HEIGHT (q->left)) > (BRANCH_HEIGHT (q->rite))) - tree->rite = (rotate_rite (q)); - return (rotate_left (tree)); - } + { + tree_node q = tree->rite; + if ((BRANCH_HEIGHT (q->left)) > (BRANCH_HEIGHT (q->rite))) + tree->rite = (rotate_rite (q)); + return (rotate_left (tree)); + } } tree_node DEFUN (tree_insert, (tree, name, value), - tree_node tree - AND char * name - AND unsigned long value) + tree_node tree AND + CONST char * name AND + unsigned long value) { - if (tree == ((tree_node) NULL)) + if (tree == 0) return (leaf_make (name, value)); switch (strcmp_ci (name, tree->name)) - { + { case 0: tree_error ("tree_insert: Duplicate entry %s.\n", name); return (tree); case -1: - { - /* To the left */ - tree->left = (tree_insert (tree->left, name, value)); - return (rebalance_left (tree)); - } + { + /* To the left */ + tree->left = (tree_insert (tree->left, name, value)); + return (rebalance_left (tree)); + } case 1: - { - /* To the right */ - tree->rite = (tree_insert (tree->rite, name, value)); - return (rebalance_rite (tree)); + { + /* To the right */ + tree->rite = (tree_insert (tree->rite, name, value)); + return (rebalance_rite (tree)); + } } - } /*NOTREACHED*/ return (0); } tree_node -DEFUN (tree_lookup, (tree, name), tree_node tree AND char * name) +DEFUN (tree_lookup, (tree, name), tree_node tree AND CONST char * name) { - while (tree != ((tree_node) NULL)) + while (tree != 0) switch (strcmp_ci (name, tree->name)) - { + { case 0: return (tree); @@ -196,50 +191,48 @@ DEFUN (tree_lookup, (tree, name), tree_node tree AND char * name) case 1: tree = tree->rite; break; - } + } return (tree); } tree_node DEFUN (tree_build, (high, names, value), - unsigned long high AND char ** names AND unsigned long value) + unsigned long high AND + CONST char ** names AND + unsigned long value) { static long bias = 0; - if (high > 1) - { - tree_node tree; - long middle = (high / 2); - long next; - - if ((high & 1) == 0) { - middle -= bias; - bias = (1 - bias); + tree_node tree; + long middle = (high / 2); + long next; + + if ((high & 1) == 0) + { + middle -= bias; + bias = (1 - bias); + } + next = (middle + 1); + tree = (leaf_make (names[middle], (value + middle))); + tree->left = (tree_build (middle, names, value)); + tree->rite = (tree_build ((high - next), &names[next], (value + next))); + update_height (tree); + return (tree); } - next = (middle + 1); - tree = (leaf_make (names[middle], (value + middle))); - tree->left = (tree_build (middle, names, value)); - tree->rite = (tree_build ((high - next), &names[next], (value + next))); - update_height (tree); - return (tree); - } else if (high == 1) return (leaf_make (* names, value)); else - return ((tree_node) NULL); + return (0); } void DEFUN (tree_free, (tree), tree_node tree) { - extern void EXFUN (free, (PTR)); - - if (tree != ((tree_node) NULL)) - { - tree_free (tree->left); - tree_free (tree->rite); - free (tree); - } - return; + if (tree != 0) + { + tree_free (tree->left); + tree_free (tree->rite); + free (tree); + } } diff --git a/v7/src/microcode/avltree.h b/v7/src/microcode/avltree.h index 477ecab41..34bf247d8 100644 --- a/v7/src/microcode/avltree.h +++ b/v7/src/microcode/avltree.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: avltree.h,v 1.3 2000/12/05 21:23:42 cph Exp $ +$Id: avltree.h,v 1.4 2001/03/08 18:00:16 cph Exp $ -Copyright (c) 1993, 1999, 2000 Massachusetts Institute of Technology +Copyright (c) 1993, 1999-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,16 +19,18 @@ along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ +#ifndef AVLTREE_H +#define AVLTREE_H + /* This file contains external declarations for a simple AVL tree library. It is used by the MIT Scheme microcode to quickly map - names to indices into various tables. - */ + names to indices into various tables. */ #include "config.h" -extern char * tree_error_message; -extern char * tree_error_noise; +extern CONST char * tree_error_message; +extern CONST char * tree_error_noise; typedef struct tree_node_s * tree_node; @@ -37,11 +39,14 @@ struct tree_node_s int height; tree_node left; tree_node rite; - char * name; + CONST char * name; unsigned long value; }; -extern tree_node EXFUN (tree_build, (unsigned long, char **, unsigned long)); -extern tree_node EXFUN (tree_lookup, (tree_node, char *)); -extern tree_node EXFUN (tree_insert, (tree_node, char *, unsigned long)); +extern tree_node EXFUN + (tree_build, (unsigned long, CONST char **, unsigned long)); +extern tree_node EXFUN (tree_lookup, (tree_node, CONST char *)); +extern tree_node EXFUN (tree_insert, (tree_node, CONST char *, unsigned long)); extern void EXFUN (tree_free, (tree_node)); + +#endif /* AVLTREE_H */ diff --git a/v7/src/microcode/debug.c b/v7/src/microcode/debug.c index b90a22453..198def32c 100644 --- a/v7/src/microcode/debug.c +++ b/v7/src/microcode/debug.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: debug.c,v 9.51 2000/12/05 21:23:44 cph Exp $ +$Id: debug.c,v 9.52 2001/03/08 18:00:18 cph Exp $ Copyright (c) 1987-2000 Massachusetts Institute of Technology @@ -801,10 +801,8 @@ static Boolean DEFUN (print_primitive_name, (stream, primitive), outf_channel stream AND SCHEME_OBJECT primitive) { - char * name; - - name = (PRIMITIVE_NAME (primitive)); - if (name == ((char *) NULL)) + CONST char * name = (PRIMITIVE_NAME (primitive)); + if (name == 0) { outf (stream, "Unknown primitive 0x%08x", PRIMITIVE_NUMBER(primitive)); return false; diff --git a/v7/src/microcode/extern.c b/v7/src/microcode/extern.c index 38d7a0502..cd09a4a64 100644 --- a/v7/src/microcode/extern.c +++ b/v7/src/microcode/extern.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: extern.c,v 9.37 1999/01/02 06:11:34 cph Exp $ +$Id: extern.c,v 9.38 2001/03/08 18:00:21 cph Exp $ Copyright (c) 1987-1999 Massachusetts Institute of Technology @@ -112,14 +112,14 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PROCEDURE-DOCUMENTATION", PRIMITIVE_HEADER (1); CHECK_ARG (1, PRIMITIVE_P); { - fast SCHEME_OBJECT primitive = (ARG_REF (1)); + SCHEME_OBJECT primitive = (ARG_REF (1)); if ((PRIMITIVE_NUMBER (primitive)) > ((unsigned long) (NUMBER_OF_PRIMITIVES ()))) error_bad_range_arg (1); { - fast char * answer = (PRIMITIVE_DOCUMENTATION (primitive)); + CONST char * answer = (PRIMITIVE_DOCUMENTATION (primitive)); PRIMITIVE_RETURN - ((answer == ((char *) 0)) + ((answer == 0) ? SHARP_F : (char_pointer_to_string ((unsigned char *) answer))); } diff --git a/v7/src/microcode/findprim.c b/v7/src/microcode/findprim.c index 594d693fd..0739eaede 100644 --- a/v7/src/microcode/findprim.c +++ b/v7/src/microcode/findprim.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: findprim.c,v 9.54 2000/12/05 21:23:44 cph Exp $ +$Id: findprim.c,v 9.55 2001/03/08 18:00:23 cph Exp $ -Copyright (c) 1987-2000 Massachusetts Institute of Technology +Copyright (c) 1987-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -578,7 +578,7 @@ DEFUN (print_primitives, (output, limit), fprintf (output, "\n};\n"); /* Print the names table. */ - fprintf (output, "\f\nchar * %s_Name_Table [] = {\n", the_kind); + fprintf (output, "\f\nCONST char * %s_Name_Table [] = {\n", the_kind); for (count = 0; (count < limit); count += 1) { fprintf (output, " \"%s\",\n", ((result_buffer [count]) -> scheme_name)); @@ -586,13 +586,13 @@ DEFUN (print_primitives, (output, limit), fprintf (output, " \"%s\"\n};\n", inexistent_entry.scheme_name); /* Print the documentation table. */ - fprintf (output, "\f\nchar * %s_Documentation_Table [] = {\n", the_kind); + fprintf (output, "\f\nCONST char * %s_Documentation_Table [] = {\n", the_kind); for (count = 0; (count < limit); count += 1) { fprintf (output, " "); table_entry = ((result_buffer [count]) -> documentation); if ((table_entry [0]) == '\0') - fprintf (output, "((char *) 0),\n"); + fprintf (output, "0,\n"); else fprintf (output, "\"%s\",\n", table_entry); } diff --git a/v7/src/microcode/prim.h b/v7/src/microcode/prim.h index b4e9b451d..f82920812 100644 --- a/v7/src/microcode/prim.h +++ b/v7/src/microcode/prim.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: prim.h,v 9.45 1999/01/02 06:11:34 cph Exp $ +$Id: prim.h,v 9.46 2001/03/08 18:00:26 cph Exp $ -Copyright (c) 1987-1999 Massachusetts Institute of Technology +Copyright (c) 1987-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -27,15 +27,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #ifndef SCM_PRIM_H #define SCM_PRIM_H -typedef SCHEME_OBJECT EXFUN ((* primitive_procedure_t), (void)); +typedef SCHEME_OBJECT EXFUN ((*primitive_procedure_t), (void)); extern primitive_procedure_t * Primitive_Procedure_Table; extern int * Primitive_Arity_Table; extern int * Primitive_Count_Table; -extern char ** Primitive_Name_Table; -extern char ** Primitive_Documentation_Table; +extern CONST char ** Primitive_Name_Table; +extern CONST char ** Primitive_Documentation_Table; extern long MAX_PRIMITIVE; +extern SCHEME_OBJECT EXFUN + (declare_primitive, + (CONST char *, primitive_procedure_t, int, int, CONST char *)); + +extern SCHEME_OBJECT EXFUN + (install_primitive, + (CONST char *, primitive_procedure_t, int, int, CONST char *)); + extern SCHEME_OBJECT EXFUN (Prim_unimplemented, (void)); #define PRIMITIVE_NUMBER(primitive) (OBJECT_DATUM (primitive)) diff --git a/v7/src/microcode/primutl.c b/v7/src/microcode/primutl.c index 2a63a7238..79d87b8be 100644 --- a/v7/src/microcode/primutl.c +++ b/v7/src/microcode/primutl.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: primutl.c,v 9.73 2000/12/05 21:23:47 cph Exp $ +$Id: primutl.c,v 9.74 2001/03/08 18:00:28 cph Exp $ -Copyright (c) 1988-2000 Massachusetts Institute of Technology +Copyright (c) 1988-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -64,18 +64,17 @@ extern SCHEME_OBJECT * load_renumber_table; long MAX_PRIMITIVE = 0; -primitive_procedure_t * Primitive_Procedure_Table - = ((primitive_procedure_t *) NULL); +primitive_procedure_t * Primitive_Procedure_Table = 0; -int * Primitive_Arity_Table = ((int *) NULL); +int * Primitive_Arity_Table = 0; -int * Primitive_Count_Table = ((int *) NULL); +int * Primitive_Count_Table = 0; -char ** Primitive_Name_Table = ((char **) NULL); +CONST char ** Primitive_Name_Table = 0; -char ** Primitive_Documentation_Table = ((char **) NULL); +CONST char ** Primitive_Documentation_Table = 0; -SCHEME_OBJECT * load_renumber_table = ((SCHEME_OBJECT *) NULL); +SCHEME_OBJECT * load_renumber_table = 0; /* Exported utilities: @@ -88,8 +87,6 @@ extern void extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int)), EXFUN (find_primitive, (SCHEME_OBJECT, Boolean, Boolean, int)), - EXFUN (declare_primitive, (char *, primitive_procedure_t, int, int, char *)), - EXFUN (install_primitive, (char *, primitive_procedure_t, int, int, char *)), EXFUN (dump_renumber_primitive, (SCHEME_OBJECT)), * EXFUN (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *)), * EXFUN (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)), @@ -138,8 +135,7 @@ DEFUN_VOID (Prim_unimplemented) static void DEFUN (initialization_error, (reason, item), char * reason AND char * item) { - outf_fatal ("initialize_primitives: Error %s %s.\n", - reason, item); + outf_fatal ("initialize_primitives: Error %s %s.\n", reason, item); termination_init_error (); } @@ -256,16 +252,16 @@ static SCHEME_OBJECT DEFUN (declare_primitive_internal, (override_p, name, code, nargs_lo, nargs_hi, docstr), Boolean override_p - AND char * name + AND CONST char * name AND primitive_procedure_t code AND int nargs_lo AND int nargs_hi - AND char * docstr) + AND CONST char * docstr) /* nargs_lo ignored, for now */ { unsigned long index; SCHEME_OBJECT primitive; - char * ndocstr = docstr; + CONST char * ndocstr = docstr; tree_node prim = (tree_lookup (prim_procedure_tree, name)); if (prim != ((tree_node) NULL)) @@ -276,8 +272,8 @@ DEFUN (declare_primitive_internal, && ((PRIMITIVE_ARITY (primitive)) != UNKNOWN_PRIMITIVE_ARITY)) || ((IMPLEMENTED_PRIMITIVE_P (primitive)) && (! override_p))) return (LONG_TO_UNSIGNED_FIXNUM (PRIMITIVE_NUMBER (primitive))); - if (docstr == ((char *) NULL)) - ndocstr = Primitive_Documentation_Table[index]; + if (docstr == 0) + ndocstr = (Primitive_Documentation_Table[index]); } else { @@ -323,11 +319,11 @@ DEFUN (declare_primitive_internal, SCHEME_OBJECT DEFUN (declare_primitive, (name, code, nargs_lo, nargs_hi, docstr), - char * name + CONST char * name AND primitive_procedure_t code AND int nargs_lo AND int nargs_hi - AND char * docstr) + AND CONST char * docstr) { return (declare_primitive_internal (false, name, code, nargs_lo, nargs_hi, docstr)); @@ -341,11 +337,11 @@ DEFUN (declare_primitive, (name, code, nargs_lo, nargs_hi, docstr), SCHEME_OBJECT DEFUN (install_primitive, (name, code, nargs_lo, nargs_hi, docstr), - char * name + CONST char * name AND primitive_procedure_t code AND int nargs_lo AND int nargs_hi - AND char * docstr) + AND CONST char * docstr) { return (declare_primitive_internal (true, name, code, nargs_lo, nargs_hi, docstr)); @@ -491,7 +487,9 @@ DEFUN (copy_primitive_information, (code, start, end), long code AND fast SCHEME_OBJECT * start AND fast SCHEME_OBJECT * end) { static char null_string [] = "\0"; - fast char * source, * dest, * limit; + CONST char * source; + char * dest; + char * limit; long char_count, word_count; SCHEME_OBJECT * saved; diff --git a/v7/src/microcode/usrdef.h b/v7/src/microcode/usrdef.h index f3dc222fc..4e9d60965 100644 --- a/v7/src/microcode/usrdef.h +++ b/v7/src/microcode/usrdef.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: usrdef.h,v 9.43 1999/01/02 06:11:34 cph Exp $ +$Id: usrdef.h,v 9.44 2001/03/08 18:00:31 cph Exp $ -Copyright (c) 1987-1999 Massachusetts Institute of Technology +Copyright (c) 1987-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -30,16 +30,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. extern SCHEME_OBJECT EXFUN ((* (Static_Primitive_Procedure_Table[])), (void)); extern int Static_Primitive_Arity_Table[]; extern int Static_Primitive_Count_Table[]; -extern char * Static_Primitive_Name_Table[]; -extern char * Static_Primitive_Documentation_Table[]; +extern CONST char * Static_Primitive_Name_Table[]; +extern CONST char * Static_Primitive_Documentation_Table[]; extern long MAX_STATIC_PRIMITIVE; -extern SCHEME_OBJECT - EXFUN (declare_primitive, (char *, primitive_procedure_t, int, int, char *)); - -extern SCHEME_OBJECT - EXFUN (install_primitive, (char *, primitive_procedure_t, int, int, char *)); - extern void EXFUN (Microcode_Termination, (int)), EXFUN (signal_error_from_primitive, (long));