X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/3b3b36ddb7dfbd5094abee360c253c8f1216dcdd..67941e3cb54bf9cb1d6db30000307f148405730a:/libguile/srcprop.c diff --git a/libguile/srcprop.c b/libguile/srcprop.c index f217b5d56..341c9a670 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1997, 1998, 1999 Free Software Foundation +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation * * 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 @@ -48,17 +48,18 @@ #include -#include "_scm.h" -#include "smob.h" -#include "genio.h" -#include "alist.h" -#include "debug.h" -#include "hashtab.h" -#include "hash.h" -#include "weaks.h" +#include "libguile/_scm.h" +#include "libguile/smob.h" +#include "libguile/alist.h" +#include "libguile/debug.h" +#include "libguile/hashtab.h" +#include "libguile/hash.h" +#include "libguile/ports.h" +#include "libguile/root.h" +#include "libguile/weaks.h" -#include "scm_validate.h" -#include "srcprop.h" +#include "libguile/validate.h" +#include "libguile/srcprop.h" /* {Source Properties} * @@ -75,19 +76,19 @@ * */ -SCM scm_sym_filename; -SCM scm_sym_copy; -SCM scm_sym_line; -SCM scm_sym_column; -SCM scm_sym_breakpoint; +SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename"); +SCM_GLOBAL_SYMBOL (scm_sym_copy, "copy"); +SCM_GLOBAL_SYMBOL (scm_sym_line, "line"); +SCM_GLOBAL_SYMBOL (scm_sym_column, "column"); +SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint"); -long scm_tc16_srcprops; +scm_bits_t scm_tc16_srcprops; static scm_srcprops_chunk *srcprops_chunklist = 0; static scm_srcprops *srcprops_freelist = 0; static SCM -marksrcprops (SCM obj) +srcprops_mark (SCM obj) { scm_gc_mark (SRCPROPFNAME (obj)); scm_gc_mark (SRCPROPCOPY (obj)); @@ -96,16 +97,16 @@ marksrcprops (SCM obj) static scm_sizet -freesrcprops (SCM obj) +srcprops_free (SCM obj) { - *((scm_srcprops **) SCM_CDR (obj)) = srcprops_freelist; - srcprops_freelist = (scm_srcprops *) SCM_CDR (obj); + *((scm_srcprops **) SCM_CELL_WORD_1 (obj)) = srcprops_freelist; + srcprops_freelist = (scm_srcprops *) SCM_CELL_WORD_1 (obj); return 0; /* srcprops_chunks are not freed until leaving guile */ } static int -prinsrcprops (SCM obj,SCM port,scm_print_state *pstate) +srcprops_print (SCM obj, SCM port, scm_print_state *pstate) { int writingp = SCM_WRITINGP (pstate); scm_puts ("#next = srcprops_chunklist; srcprops_chunklist = mem; @@ -165,7 +167,7 @@ scm_srcprops_to_plist (SCM obj) SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, (SCM obj), -"") + "Return the source property association list of @var{obj}.") #define FUNC_NAME s_scm_source_properties { SCM p; @@ -176,8 +178,8 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, else if (SCM_NCONSP (obj)) SCM_WRONG_TYPE_ARG (1, obj); #endif - p = scm_hashq_ref (scm_source_whash, obj, (SCM) NULL); - if (p != (SCM) NULL && SRCPROPSP (p)) + p = scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F); + if (SRCPROPSP (p)) return scm_srcprops_to_plist (p); return SCM_EOL; } @@ -187,7 +189,8 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, and try to make a srcprops-object...? */ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0, (SCM obj, SCM plist), -"") + "Install the association list @var{plist} as the source property\n" + "list for @var{obj}.") #define FUNC_NAME s_scm_set_source_properties_x { SCM handle; @@ -206,7 +209,8 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0, SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, (SCM obj, SCM key), -"") + "Return the source property specified by @var{key} from\n" + "@var{obj}'s source property list.") #define FUNC_NAME s_scm_source_property { SCM p; @@ -220,11 +224,11 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); if (SCM_IMP (p) || !SRCPROPSP (p)) goto plist; - if (scm_sym_breakpoint == key) p = SRCPROPBRK (p); - else if (scm_sym_line == key) p = SCM_MAKINUM (SRCPROPLINE (p)); - else if (scm_sym_column == key) p = SCM_MAKINUM (SRCPROPCOL (p)); - else if (scm_sym_filename == key) p = SRCPROPFNAME (p); - else if (scm_sym_copy == key) p = SRCPROPCOPY (p); + if (SCM_EQ_P (scm_sym_breakpoint, key)) p = SRCPROPBRK (p); + else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_MAKINUM (SRCPROPLINE (p)); + else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_MAKINUM (SRCPROPCOL (p)); + else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p); + else if (SCM_EQ_P (scm_sym_copy, key)) p = SRCPROPCOPY (p); else { p = SRCPROPPLIST (p); @@ -238,7 +242,8 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, (SCM obj, SCM key, SCM datum), -"") + "Set the source property of object @var{obj}, which is specified by\n" + "@var{key} to @var{datum}. Normally, the key will be a symbol.") #define FUNC_NAME s_scm_set_source_property_x { scm_whash_handle h; @@ -258,28 +263,26 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, h = scm_whash_create_handle (scm_source_whash, obj); p = SCM_EOL; } - if (scm_sym_breakpoint == key) + if (SCM_EQ_P (scm_sym_breakpoint, key)) { - if (SCM_FALSEP (datum)) - CLEARSRCPROPBRK (SRCPROPSP (p) - ? p - : SCM_WHASHSET (scm_source_whash, h, - scm_make_srcprops (0, - 0, - SCM_UNDEFINED, - SCM_UNDEFINED, - p))); + if (SRCPROPSP (p)) + { + if (SCM_FALSEP (datum)) + CLEARSRCPROPBRK (p); + else + SETSRCPROPBRK (p); + } else - SETSRCPROPBRK (SRCPROPSP (p) - ? p - : SCM_WHASHSET (scm_source_whash, h, - scm_make_srcprops (0, - 0, - SCM_UNDEFINED, - SCM_UNDEFINED, - p))); + { + SCM sp = scm_make_srcprops (0, 0, SCM_UNDEFINED, SCM_UNDEFINED, p); + SCM_WHASHSET (scm_source_whash, h, sp); + if (SCM_FALSEP (datum)) + CLEARSRCPROPBRK (sp); + else + SETSRCPROPBRK (sp); + } } - else if (scm_sym_line == key) + else if (SCM_EQ_P (scm_sym_line, key)) { SCM_VALIDATE_INUM (3,datum); if (SRCPROPSP (p)) @@ -289,7 +292,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, scm_make_srcprops (SCM_INUM (datum), 0, SCM_UNDEFINED, SCM_UNDEFINED, p)); } - else if (scm_sym_column == key) + else if (SCM_EQ_P (scm_sym_column, key)) { SCM_VALIDATE_INUM (3,datum); if (SRCPROPSP (p)) @@ -299,14 +302,14 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, scm_make_srcprops (0, SCM_INUM (datum), SCM_UNDEFINED, SCM_UNDEFINED, p)); } - else if (scm_sym_filename == key) + else if (SCM_EQ_P (scm_sym_filename, key)) { if (SRCPROPSP (p)) SRCPROPFNAME (p) = datum; else SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, SCM_UNDEFINED, p)); } - else if (scm_sym_filename == key) + else if (SCM_EQ_P (scm_sym_copy, key)) { if (SRCPROPSP (p)) SRCPROPCOPY (p) = datum; @@ -323,18 +326,17 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, void scm_init_srcprop () { - scm_tc16_srcprops = scm_make_smob_type_mfpe ("srcprops", 0, - marksrcprops, freesrcprops, prinsrcprops, NULL); - scm_source_whash = scm_make_weak_key_hash_table (SCM_MAKINUM (2047)); - - scm_sym_filename = SCM_CAR (scm_sysintern ("filename", SCM_UNDEFINED)); - scm_sym_copy = SCM_CAR (scm_sysintern ("copy", SCM_UNDEFINED)); - scm_sym_line = SCM_CAR (scm_sysintern ("line", SCM_UNDEFINED)); - scm_sym_column = SCM_CAR (scm_sysintern ("column", SCM_UNDEFINED)); - scm_sym_breakpoint = SCM_CAR (scm_sysintern ("breakpoint", SCM_UNDEFINED)); + scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0); + scm_set_smob_mark (scm_tc16_srcprops, srcprops_mark); + scm_set_smob_free (scm_tc16_srcprops, srcprops_free); + scm_set_smob_print (scm_tc16_srcprops, srcprops_print); + scm_source_whash = scm_make_weak_key_hash_table (SCM_MAKINUM (2047)); scm_sysintern ("source-whash", scm_source_whash); -#include "srcprop.x" + +#ifndef SCM_MAGIC_SNARFER +#include "libguile/srcprop.x" +#endif } void @@ -350,3 +352,9 @@ scm_finish_srcprop () ptr = next; } } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/