
(acons key value alist)
Adds a new key-value pair to @var{alist}.  A new pair is\n" "created whose car is @var{key} and whose cdr is @var{value}, and the\n" "pair is consed onto @var{alist}, and the new list is returned.  This\n" "function is @emph{not} destructive; @var{alist} is not modified.

(sloppy-assq key alist)
Behaves like @code{assq} but does not do any error checking.\n" "Recommended only for use in Guile internals.

(sloppy-assv key alist)
Behaves like @code{assv} but does not do any error checking.\n" "Recommended only for use in Guile internals.

(sloppy-assoc key alist)
Behaves like @code{assoc} but does not do any error checking.\n" "Recommended only for use in Guile internals.

(assq key alist)
@deffnx primitive assv key alist\n" "@deffnx primitive assoc key alist\n" "Fetches the entry in @var{alist} that is associated with @var{key}.  To\n" "decide whether the argument @var{key} matches a particular entry in\n" "@var{alist}, @code{assq} compares keys with @code{eq?}, @code{assv}\n" "uses @code{eqv?} and @code{assoc} uses @code{equal?}.  If @var{key}\n" "cannot be found in @var{alist} (according to whichever equality\n" "predicate is in use), then @code{#f} is returned.  These functions\n" "return the entire alist entry found (i.e. both the key and the value).

(assv key alist)
Behaves like @code{assq} but uses @code{eqv?} for key comparison.

(assoc key alist)
Behaves like @code{assq} but uses @code{equal?} for key comparison.

(assq-ref alist key)
@deffnx primitive assv-ref alist key\n" "@deffnx primitive assoc-ref alist key\n" "Like @code{assq}, @code{assv} and @code{assoc}, except that only the\n" "value associated with @var{key} in @var{alist} is returned.  These\n" "functions are equivalent to
 "@lisp\n" "(let ((ent (@var{associator} @var{key} @var{alist})))\n" "  (and ent (cdr ent)))\n" "@end lisp
 "where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}.

(assv-ref alist key)
Behaves like @code{assq-ref} but uses @code{eqv?} for key comparison.

(assoc-ref alist key)
Behaves like @code{assq-ref} but uses @code{equal?} for key comparison.

(assq-set! alist key val)
@deffnx primitive assv-set! alist key value\n" "@deffnx primitive assoc-set! alist key value\n" "Reassociate @var{key} in @var{alist} with @var{value}: find any existing\n" "@var{alist} entry for @var{key} and associate it with the new\n" "@var{value}.  If @var{alist} does not contain an entry for @var{key},\n" "add a new one.  Return the (possibly new) alist.
 "These functions do not attempt to verify the structure of @var{alist},\n" "and so may cause unusual results if passed an object that is not an\n" "association list.

(assv-set! alist key val)
Behaves like @code{assq-set!} but uses @code{eqv?} for key comparison.

(assoc-set! alist key val)
Behaves like @code{assq-set!} but uses @code{equal?} for key comparison.

(assq-remove! alist key)
@deffnx primitive assv-remove! alist key\n" "@deffnx primitive assoc-remove! alist key\n" "Delete any entry in @var{alist} associated with @var{key}, and return\n" "the resulting alist.

(assv-remove! alist key)
Behaves like @code{assq-remove!} but uses @code{eqv?} for key comparison.

(assoc-remove! alist key)
Behaves like @code{assq-remove!} but uses @code{equal?} for key comparison.

(make-arbiter name)
Returns an object of type arbiter and name name. Its state is initially unlocked.\n" "Arbiters are a way to achieve process synchronization.

(try-arbiter arb)
Returns #t and locks arbiter if arbiter was unlocked. Otherwise, returns #f.

(release-arbiter arb)
Returns #t and unlocks arbiter if arbiter was locked. Otherwise, returns #f.

(async thunk)

(system-async thunk)

(async-mark a)

(system-async-mark a)

(run-asyncs list_of_a)

(noop args)

(unmask-signals)

(mask-signals)

(display-error stack port subr message args rest)

(display-application frame port indent)

(display-backtrace stack port first depth)

(backtrace)

(not x)
Return #t iff X is #f, else return #f.

(boolean? obj)
Return #t iff OBJ is either #t or #f.

(char? x)
Return #t iff X is a character, else #f.

(char=? x y)
Return #t iff X is the same character as Y, else #f.

(char<? x y)
Return #t iff X is less than Y in the Ascii sequence, else #f.

(char<=? x y)
Return #t iff X is less than or equal to Y in the Ascii sequence, else #f.

(char>? x y)
Return #t iff X is greater than Y in the Ascii sequence, else #f.

(char>=? x y)
Return #t iff X is greater than or equal to Y in the Ascii sequence, else #f.

(char-ci=? x y)
Return #t iff X is the same character as Y ignoring case, else #f.

(char-ci<? x y)
Return #t iff X is less than Y in the Ascii sequence ignoring case, else #f.

(char-ci<=? x y)
Return #t iff X is less than or equal to Y in the Ascii sequence ignoring case, else #f.

(char-ci>? x y)
Return #t iff X is greater than Y in the Ascii sequence ignoring case, else #f.

(char-ci>=? x y)
Return #t iff X is greater than or equal to Y in the Ascii sequence ignoring case, else #f.

(char-alphabetic? chr)
Return #t iff CHR is alphabetic, else #f.\n" "Alphabetic means the same thing as the isalpha C library function.

(char-numeric? chr)
Return #t iff CHR is numeric, else #f.\n" "Numeric means the same thing as the isdigit C library function.

(char-whitespace? chr)
Return #t iff CHR is whitespace, else #f.\n" "Whitespace means the same thing as the isspace C library function.

(char-upper-case? chr)
Return #t iff CHR is uppercase, else #f.\n" "Uppercase means the same thing as the isupper C library function.

(char-lower-case? chr)
Return #t iff CHR is lowercase, else #f.\n" "Lowercase means the same thing as the islower C library function.

(char-is-both? chr)
Return #t iff CHR is either uppercase or lowercase, else #f.\n" "Uppercase and lowercase are as defined by the isupper and islower\n" "C library functions.

(char->integer chr)
Return the number corresponding to ordinal position of CHR in the Ascii sequence.

(integer->char n)
Return the character at position N in the Ascii sequence.

(char-upcase chr)
Return the uppercase character version of CHR.

(char-downcase chr)
Return the lowercase character version of CHR.

(debug-options-interface setting)

(with-traps thunk)

(memoized? obj)

(unmemoize m)

(memoized-environment m)

(procedure-name proc)

(procedure-source proc)

(procedure-environment proc)

(local-eval exp env)
Evaluate @var{exp} in its environment.  If @var{env} is supplied,\n" "it is the environment in which to evaluate @var{exp}.  Otherwise,\n" "@var{exp} must be a memoized code object (in which case, its environment\n" "is implicit).

(debug-object? obj)

(c-registered-modules)
Return a list of the object code modules that have been imported into\n" "the current Guile process.  Each element of the list is a pair whose\n" "car is the name of the module, and whose cdr is the function handle\n" "for that module's initializer function.  The name is the string that\n" "has been passed to scm_register_module_xxx.

(c-clear-registered-modules)
Destroy the list of modules registered with the current Guile process.\n" "The return value is unspecified.  @strong{Warning:} this function does\n" "not actually unlink or deallocate these modules, but only destroys the\n" "records of which modules have been loaded.  It should therefore be used\n" "only by module bookkeeping operations.

(dynamic-link fname)
Open the dynamic library @var{library-file}.  A library handle\n" "representing the opened library is returned; this handle should be used\n" "as the @var{lib} argument to the following functions.

(dynamic-object? obj)
Return @code{#t} if @var{obj} is a dynamic library handle, or @code{#f}\n" "otherwise.

(dynamic-unlink dobj)
Unlink the library represented by @var{library-handle},\n" "and remove any imported symbols from the address space.\n" "GJB:FIXME:DOC: 2nd version below:\n" "Unlink the indicated object file from the application.  The\n" "argument @var{dynobj} must have been obtained by a call to\n" "@code{dynamic-link}.  After @code{dynamic-unlink} has been\n" "called on @var{dynobj}, its content is no longer accessible.

(dynamic-func symb dobj)
Import the symbol @var{func} from @var{lib} (a dynamic library handle).\n" "A @dfn{function handle} representing the imported function is returned.\n" "GJB:FIXME:DOC: 2nd version below\n" "Search the C function indicated by @var{function} (a string or symbol)\n" "in @var{dynobj} and return some Scheme object that can later be used\n" "with @code{dynamic-call} to actually call this function.  Right now,\n" "these Scheme objects are formed by casting the address of the function\n" "to @code{long} and converting this number to its Scheme representation.
 "Regardless whether your C compiler prepends an underscore @samp{_} to\n" "the global names in a program, you should @strong{not} include this\n" "underscore in @var{function}.  Guile knows whether the underscore is\n" "needed or not and will add it whe
# 417 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynl.c"
{
void (*func) ();
do { symb = scm_coerce_rostring (symb, s_scm_dynamic_func, 1); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(dobj,SCM_ARG2,422); } while (0);
if (((void *) ((scm_bits_t *) ((SCM_CELLPTR) ((dobj)))) [2]) == 0L) {
do { scm_misc_error (s_scm_dynamic_func, "Already unlinked: ~S", dobj); } while (0);
} else {
do { asm (""); ; ; asm (""); scm_ints_disabled = 1; asm (""); } while (0);
func = (void (*) ()) sysdep_dynl_func (((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((symb)))) [1])),
((void *) ((scm_bits_t *) ((SCM_CELLPTR) ((dobj)))) [2]),
s_scm_dynamic_func);
do { asm (""); ; ; asm (""); scm_ints_disabled = 0; asm (""); ; asm (""); } while (0);
return scm_ulong2num ((unsigned long) func);
}
}

(dynamic-call func dobj)
Call @var{lib-thunk}, a procedure of no arguments.  If @var{lib-thunk}\n" "is a string, it is assumed to be a symbol found in the dynamic library\n" "@var{lib} and is fetched with @code{dynamic-func}.  Otherwise, it should\n" "be a function handle returned by a previous call to @code{dynamic-func}.\n" "The return value is unspecified.\n" "GJB:FIXME:DOC 2nd version below\n" "Call the C function indicated by @var{function} and @var{dynobj}.  The\n" "function is passed no arguments and its return value is ignored.  When\n" "@var{function} is something returned by @code{dynamic-func}, call that\n" "function and ignore @var{dynobj}.  When @var{function} is a string (or\n" "symbol, etc.), look it up in @var{dynobj}; this is equivalent to
 "@smallexample\n" "(dynamic-call (dynamic-func @var{function} @var{d
# 457 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynl.c"
{
void (*fptr) ();
if (((!(6 & (func))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((func)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((func)))) [0]) == 5))))
func = scm_dynamic_func (func, dobj);
fptr = (void (*) ()) (scm_num2ulong (func, (char *) 1, s_scm_dynamic_call));
do { asm (""); ; ; asm (""); scm_ints_disabled = 1; asm (""); } while (0);
fptr ();
do { asm (""); ; ; asm (""); scm_ints_disabled = 0; asm (""); ; asm (""); } while (0);
return ((scm_bits_t) (((21) << 9) + 0x174L));
}

(dynamic-args-call func dobj args)
Call @var{proc}, a dynamically loaded function, passing it the argument\n" "list @var{args} (a list of strings).  As with @code{dynamic-call},\n" "@var{proc} should be either a function handle or a string, in which case\n" "it is first fetched from @var{lib} with @code{dynamic-func}.
 "@var{proc} is assumed to return an integer, which is used as the return\n" "value from @code{dynamic-args-call}.
 "GJB:FIXME:DOC 2nd version below\n" "Call the C function indicated by @var{function} and @var{dynobj}, just\n" "like @code{dynamic-call}, but pass it some arguments and return its\n" "return value.  The C function is expected to take two arguments and\n" "return an @code{int}, just like @code{main}:
 "@smallexample\n" "int c_func (int argc, char **argv);\n" "@end smallexampl
# 492 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynl.c"
{
int (*fptr) (int argc, char **argv);
int result, argc;
char **argv;
if (((!(6 & (func))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((func)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((func)))) [0]) == 5))))
func = scm_dynamic_func (func, dobj);
fptr = (int (*) (int, char **)) (scm_num2ulong (func, (char *) 1, s_scm_dynamic_args_call));
do { asm (""); ; ; asm (""); scm_ints_disabled = 1; asm (""); } while (0);
argv = scm_make_argv_from_stringlist (args, &argc, s_scm_dynamic_args_call, SCM_ARG3);
result = (*fptr) (argc, argv);
scm_must_free_argv (argv);
do { asm (""); ; ; asm (""); scm_ints_disabled = 0; asm (""); ; asm (""); } while (0);
return (((scm_bits_t) (((0L + result) << 2) + 2L)));
}
void
scm_init_dynamic_linking ()
{
scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0);
scm_set_smob_mark (scm_tc16_dynamic_obj, mark_dynl_obj);
scm_set_smob_print (scm_tc16_dynamic_obj, print_dynl_obj);
sysdep_dynl_init ();
# 1 "../libguile/dynl.x" 1
# 519 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynl.c" 2
}

(dynamic-wind thunk1 thunk2 thunk3)
All three arguments must be 0-argument procedures.
 "@var{in-guard} is called, then @var{thunk}, then @var{out-guard}.
 "If, any time during the execution of @var{thunk}, the continuation\n" "of the @code{dynamic-wind} expression is escaped non-locally, @var{out-guard}\n" "is called.   If the continuation of the dynamic-wind is re-entered,\n" "@var{in-guard} is called.   Thus @var{in-guard} and @var{out-guard} may\n" "be called any number of times.
 "@example\n" "(define x 'normal-binding)\n" "@result{} x
 "(define a-cont  (call-with-current-continuation \n" "		  (lambda (escape)\n" "		     (let ((old-x x))\n" "		       (dynamic-wind\n" "			  ;; in-guard:\n" "			  ;;\n" "			  (lambda () (set! x 'special-binding))
 "			  ;; thunk\n" "			  ;;\n" "		 	  (lambda () (dis
# 119 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynwind.c"
{
SCM ans;
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(thunk3,SCM_ARG3,123);
scm_apply (thunk1, ((scm_bits_t) (((20) << 9) + 0x174L)), ((scm_bits_t) (((20) << 9) + 0x174L)));
(scm_root->dynwinds) = scm_acons (thunk1, thunk3, (scm_root->dynwinds));
ans = scm_apply (thunk2, ((scm_bits_t) (((20) << 9) + 0x174L)), ((scm_bits_t) (((20) << 9) + 0x174L)));
(scm_root->dynwinds) = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((scm_root->dynwinds))))) [1])));
scm_apply (thunk3, ((scm_bits_t) (((20) << 9) + 0x174L)), ((scm_bits_t) (((20) << 9) + 0x174L)));
return ans;
}
# 143 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynwind.c"
static long tc16_guards;
static int
printguards (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<guards ", port);
scm_intprint (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((exp)))) [1])))), 16, port);
scm_putc ('>', port);
return 1;
}
SCM
scm_internal_dynamic_wind (scm_guard_t before,
scm_inner_t inner,
scm_guard_t after,
void *inner_data,
void *guard_data)
{
SCM guards, ans;
before (guard_data);
do { do { if ((6 & (scm_freelist2))) guards = scm_gc_for_newcell (&scm_master_freelist2, &scm_freelist2); else { guards = scm_freelist2; scm_freelist2 = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((scm_freelist2)))) [1]))); ((scm_bits_t *) ((SCM_CELLPTR) ((guards)))) [0] = (scm_bits_t) (0x047f); } } while(0); ((scm_bits_t *) ((SCM_CELLPTR) (((guards))))) [1] = (scm_bits_t) (((scm_bits_t) before)); ((scm_bits_t *) ((SCM_CELLPTR) (((guards))))) [2] = (scm_bits_t) (((scm_bits_t) after)); ((scm_bits_t *) ((SCM_CELLPTR) (((guards))))) [3] = (scm_bits_t) (((scm_bits_t) guard_data)); ((scm_bits_t *) ((SCM_CELLPTR) (((guards))))) [0] = (scm_bits_t) ((tc16_guards)); } while (0);
(scm_root->dynwinds) = scm_acons (guards, ((scm_bits_t) (((16) << 9) + 0x174L)), (scm_root->dynwinds));
ans = inner (inner_data);
(scm_root->dynwinds) = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((scm_root->dynwinds))))) [1])));
after (guard_data);
return ans;
}
# 183 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynwind.c"
static void
scm_swap_bindings (SCM glocs, SCM vals)
{
SCM tmp;
while ((!(6 & (vals))))
{
tmp = ((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((((scm_bits_t) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((glocs)))) [0])))) - 1L)))))) [1]))));
(((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((glocs)))) [0])))) - 1L))))))) [1] = (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((vals)))) [0]))))));
(((scm_bits_t *) ((SCM_CELLPTR) (((vals))))) [0] = ((tmp)));
glocs = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((glocs)))) [1])));
vals = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((vals)))) [1])));
}
}
void
scm_dowinds (SCM to, long delta)
{
tail:
if (((to) == ((scm_root->dynwinds))));
else if (0 > delta)
{
SCM wind_elt;
SCM wind_key;
scm_dowinds ((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((to)))) [1]))), 1 + delta);
wind_elt = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((to)))) [0])));
{
wind_key = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((wind_elt)))) [0])));
if ((!(6 & (wind_key))))
{
if ((7 & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == 1)
scm_swap_bindings (wind_key, (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((wind_elt)))) [1]))));
else if ((7 & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == 0)
scm_swap_fluids (wind_key, (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((wind_elt)))) [1]))));
else if (((!(6 & (wind_key))) && (0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == (tc16_guards)))
((scm_guard_t) ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [1]) (((void *) ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [3]));
else if ((7 & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == 3)
scm_apply (wind_key, ((scm_bits_t) (((20) << 9) + 0x174L)), ((scm_bits_t) (((20) << 9) + 0x174L)));
}
}
(scm_root->dynwinds) = to;
}
else
{
SCM from;
SCM wind_elt;
SCM wind_key;
from = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((scm_root->dynwinds))))) [0]))))))) [1])));
wind_elt = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((scm_root->dynwinds))))) [0])));
(scm_root->dynwinds) = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((scm_root->dynwinds))))) [1])));
{
wind_key = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((wind_elt)))) [0])));
if ((!(6 & (wind_key))))
{
if ((7 & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == 1)
scm_swap_bindings (wind_key, from);
else if ((7 & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == 0)
scm_swap_fluids_reverse (wind_key, from);
else if (((!(6 & (wind_key))) && (0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == (tc16_guards)))
((scm_guard_t) ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [2]) (((void *) ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [3]));
else if ((7 & ((scm_bits_t *) ((SCM_CELLPTR) ((wind_key)))) [0]) == 3)
scm_apply (from, ((scm_bits_t) (((20) << 9) + 0x174L)), ((scm_bits_t) (((20) << 9) + 0x174L)));
}
}
delta--;
goto tail;
}
}
void
scm_init_dynwind ()
{
tc16_guards = scm_make_smob_type_mfpe ("guards", 0,
0L, scm_free0, printguards, 0L);
# 1 "../libguile/dynwind.x" 1
# 277 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/dynwind.c" 2
}

(eq? x y)
Return #t iff X references the same object as Y.\n" "`eq?' is similar to `eqv?' except that in some cases\n" "it is capable of discerning distinctions finer than\n" "those detectable by `eqv?'.

(eqv? x y)
The `eqv?' procedure defines a useful equivalence relation on objects.\n" "Briefly, it returns #t if X and Y should normally be\n" "regarded as the same object.  This relation is left\n" "slightly open to interpretation, but works for comparing\n" "immediate integers, characters, and inexact numbers.

(equal? x y)
Return #t iff X and Y are recursively `eqv?' equivalent.\n" "`equal?' recursively compares the contents of pairs, vectors, and\n" "strings, applying `eqv?' on other objects such as numbers and\n" "symbols.  A rule of thumb is that objects are generally `equal?'\n" "if they print the same.  `Equal?' may fail to terminate if its\n" "arguments are circular data structures.

(scm-error key subr message args rest)
Raise an error with key @var{key}.  @var{subr} can be a string naming\n" "the procedure associated with the error, or @code{#f}.  @var{message}\n" "is the error message string, possibly containing @code{~S} and @code{~A}\n" "escapes.  When an error is reported, these are replaced by formating the\n" "corresponding members of @var{args}: @code{~A} (was @code{%s}) formats using @code{display}\n" "and @code(~S) (was @code{%S}) formats using @code{write}.  @var{data} is a\n" "list or @code{#f} depending on @var{key}: if @var{key} is\n" "@code{system-error} then it should be a list\n" "containing the Unix @code{errno} value;  If @var{key} is @code{signal} then\n" "it should be a list containing the Unix signal number; otherwise it\n" "will usually be @code{#f}.

(strerror err)
Returns the Unix error message corresponding to @var{err}, an integer.

(apply:nconc2last lst)

(force x)
If the promise X has not been computed yet, compute and return\n" "X, otherwise just return the previously computed value.

(promise? x)
Return true if @var{obj} is a promise, i.e. a delayed computation\n" "(@pxref{Delayed evaluation,,,r4rs.info,The Revised^4 Report on Scheme}).

(cons-source xorig x y)

(copy-tree obj)
Recursively copy the data tree that is bound to @var{obj}, and return a\n" "pointer to the new data structure.  @code{copy-tree} recurses down the\n" "contents of both pairs and vectors (since both cons cells and vector\n" "cells may point to arbitrary objects), and stops recursing when it hits\n" "any other object.

(eval2 obj env_thunk)
Evaluate @var{exp}, a Scheme expression, in the environment designated\n" "by @var{lookup}, a symbol-lookup function.  @code{(eval exp)} is\n" "equivalent to @code{(eval2 exp *top-level-lookup-closure*)}.

(eval obj)
Evaluate @var{exp}, a list representing a Scheme expression, in the\n" "top-level environment.

(eval-options-interface setting)

(evaluator-traps-interface setting)

(defined? sym env)
Return @code{#t} if @var{sym} is defined in the top-level environment.

(map-in-order)
scm_map

(program-arguments)

(chown object owner group)
Change the ownership and group of the file referred to by @var{object} to\n" "the integer values @var{owner} and @var{group}.  @var{object} can be\n" "a string containing a file name or, if the platform\n" "supports fchown, a port or integer file descriptor\n" "which is open on the file.  The return value\n" "is unspecified.
 "If @var{object} is a symbolic link, either the\n" "ownership of the link or the ownership of the referenced file will be\n" "changed depending on the operating system (lchown is\n" "unsupported at present).  If @var{owner} or @var{group} is specified\n" "as @code{-1}, then that ID is not changed.

(chmod object mode)
Changes the permissions of the file referred to by @var{obj}.\n" "@var{obj} can be a string containing a file name or a port or integer file\n" "descriptor which is open on a file (in which case @code{fchmod} is used\n" "as the underlying system call).\n" "@var{mode} specifies\n" "the new permissions as a decimal number, e.g., @code{(chmod \"foo\" #o755)}.\n" "The return value is unspecified.

(umask mode)
If @var{mode} is omitted, retuns a decimal number representing the current\n" "file creation mask.  Otherwise the file creation mask is set to\n" "@var{mode} and the previous value is returned.
 "E.g., @code{(umask #o022)} sets the mask to octal 22, decimal 18.

(open-fdes path flags mode)
Similar to @code{open} but returns a file descriptor instead of a\n" "port.

(open path flags mode)
Open the file named by @var{path} for reading and/or writing.\n" "@var{flags} is an integer specifying how the file should be opened.\n" "@var{mode} is an integer specifying the permission bits of the file, if\n" "it needs to be created, before the umask is applied.  The default is 666\n" "(Unix itself has no default).
 "@var{flags} can be constructed by combining variables using @code{logior}.\n" "Basic flags are:
 "@defvar O_RDONLY\n" "Open the file read-only.\n" "@end defvar\n" "@defvar O_WRONLY\n" "Open the file write-only. \n" "@end defvar\n" "@defvar O_RDWR\n" "Open the file read/write.\n" "@end defvar\n" "@defvar O_APPEND\n" "Append to the file instead of truncating.\n" "@end defvar\n" "@defvar O_CREAT\n" "Create the file if it does not already exist.\n" "@end defvar
 "See the Unix documentation
# 280 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/filesys.c"
{
SCM newpt;
char *port_mode;
int fd;
int iflags;
fd = ((((scm_open_fdes (path, flags, mode))) >> (2)));
iflags = (scm_num2long (flags, (char *) 2, s_scm_open));
if (iflags & 0x0002)
{
if (iflags & 0x0008)
port_mode = "a+";
else if (iflags & 0x0200)
port_mode = "w+";
else
port_mode = "r+";
}
else {
if (iflags & 0x0008)
port_mode = "a";
else if (iflags & 0x0001)
port_mode = "w";
else
port_mode = "r";
}
newpt = scm_fdes_to_port (fd, port_mode, path);
return newpt;
}

(close fd_or_port)
Similar to close-port (@pxref{Generic Port Operations, close-port}),\n" "but also works on file descriptors.  A side\n" "effect of closing a file descriptor is that any ports using that file\n" "descriptor are moved to a different file descriptor and have\n" "their revealed counts set to zero.

(stat object)
Returns an object containing various information\n" "about the file determined by @var{obj}.\n" "@var{obj} can be a string containing a file name or a port or integer file\n" "descriptor which is open on a file (in which case @code{fstat} is used\n" "as the underlying system call).
 "The object returned by @code{stat} can be passed as a single parameter\n" "to the following procedures, all of which return integers:
 "@table @code\n" "@item stat:dev\n" "The device containing the file.\n" "@item stat:ino\n" "The file serial number, which distinguishes this file from all other\n" "files on the same device.\n" "@item stat:mode\n" "The mode of the file.  This includes file type information\n" "and the file permission bits.  See @code{stat:type} and @code{stat:perms}\n" "below.\n" "@item stat:nlink\n" "The number of hard links to
# 496 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/filesys.c"
{
int rv;
int fdes;
struct stat stat_temp;
if ((2 & (object)))
rv = fstat (((((object)) >> (2))), &stat_temp);
else
{
do { if (!((!(6 & (object))))) scm_wrong_type_arg_msg(s_scm_stat, 1, object, "NIMP"); } while (0);
if (((!(6 & (object))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == 5))))
{
{ if (((!(6 & (object))) && ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == 23))) object = scm_makfromstr (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1])))), (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) >> 8), 0); };
rv = stat (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1])))), &stat_temp);
}
else
{
object = ((!(6 & (object))) && ((!(6 & (object))) && ((0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == scm_tc16_port_with_ps)) ? (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1]))))))) [0]))) : object);
do { if (!((!(6 & (object)) && (((0xfeff | (1L<<16)) & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == (125 | (1L<<16)))))) scm_wrong_type_arg_msg(s_scm_stat, 1, object, "OPFPORTP"); } while (0);
fdes = (((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1])->stream))->fdes);
rv = fstat (fdes, &stat_temp);
}
}
if (rv == -1)
{
int en = (*__errno());
do { scm_syserror_msg (s_scm_stat, ("~A: ~S"), (scm_listify (scm_makfrom0str (strerror ((*__errno()))), object, ((scm_bits_t) (((18) << 9) + 0x174L)))), (en)); } while (0);
}
return scm_stat2scm (&stat_temp);
}

(link oldpath newpath)
Creates a new name @var{path-to} in the file system for the file\n" "named by @var{path-from}.  If @var{path-from} is a symbolic link, the\n" "link may or may not be followed depending on the system.

(rename-file oldname newname)
Renames the file specified by @var{path-from} to @var{path-to}.\n" "The return value is unspecified.

(delete-file str)
Deletes (or \"unlinks\") the file specified by @var{path}.

(mkdir path mode)
Create a new directory named by @var{path}.  If @var{mode} is omitted\n" "then the permissions of the directory file are set using the current\n" "umask.  Otherwise they are set to the decimal value specified with\n" "@var{mode}.  The return value is unspecified.

(rmdir path)
Remove the existing directory named by @var{path}.  The directory must\n" "be empty for this to succeed.  The return value is unspecified.

(directory-stream? obj)
Returns a boolean indicating whether @var{object} is a directory stream\n" "as returned by @code{opendir}.

(opendir dirname)
Open the directory specified by @var{path} and return a directory\n" "stream.

(readdir port)
Return (as a string) the next directory entry from the directory stream\n" "@var{stream}.  If there is no remaining entry to be read then the\n" "end of file object is returned.

(rewinddir port)
Reset the directory port @var{stream} so that the next call to\n" "@code{readdir} will return the first directory entry.

(closedir port)
Close the directory stream @var{stream}.\n" "The return value is unspecified.

(chdir str)
Change the current working directory to @var{path}.\n" "The return value is unspecified.

(getcwd)
Returns the name of the current working directory.

(select reads writes excepts secs usecs)
This procedure has a variety of uses: waiting for the ability\n" "to provide input, accept output, or the existance of\n" "exceptional conditions on a collection of ports or file\n" "descriptors, or waiting for a timeout to occur.\n" "It also returns if interrupted by a signal.
 "@var{reads}, @var{writes} and @var{excepts} can be lists or\n" "vectors, with each member a port or a file descriptor.\n" "The value returned is a list of three corresponding\n" "lists or vectors containing only the members which meet the\n" "specified requirement.  The ability of port buffers to\n" "provide input or accept output is taken into account.\n" "Ordering of the input lists or vectors is not preserved.
 "The optional arguments @var{secs} and @var{usecs} specify the\n" "timeout.  Either @v
# 993 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/filesys.c"
{
struct timeval timeout;
struct timeval * time_ptr;
fd_set read_set;
fd_set write_set;
fd_set except_set;
int read_count;
int write_count;
int except_count;
SCM read_ports_ready = ((scm_bits_t) (((20) << 9) + 0x174L));
SCM write_ports_ready = ((scm_bits_t) (((20) << 9) + 0x174L));
int max_fd;
if (((!(6 & (reads))) && (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((reads)))) [0]) == 13)))
{
read_count = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((reads)))) [0]) >> 8);
}
else
{
read_count = scm_ilength (reads);
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(reads,SCM_ARG1,1015);
}
if (((!(6 & (writes))) && (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((writes)))) [0]) == 13)))
{
write_count = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((writes)))) [0]) >> 8);
}
else
{
write_count = scm_ilength (writes);
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(writes,SCM_ARG2,1024);
}
if (((!(6 & (excepts))) && (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((excepts)))) [0]) == 13)))
{
except_count = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((excepts)))) [0]) >> 8);
}
else
{
except_count = scm_ilength (excepts);
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(excepts,SCM_ARG3,1033);
}
memset(&read_set, 0, sizeof(*(&read_set)));
memset(&write_set, 0, sizeof(*(&write_set)));
memset(&except_set, 0, sizeof(*(&except_set)));
max_fd = fill_select_type (&read_set, &read_ports_ready, reads, SCM_ARG1);
{
int write_max = fill_select_type (&write_set, &write_ports_ready,
writes, SCM_ARG2);
int except_max = fill_select_type (&except_set, 0L,
excepts, SCM_ARG3);
if (write_max > max_fd)
max_fd = write_max;
if (except_max > max_fd)
max_fd = except_max;
}
if (!((((read_ports_ready)) == (((scm_bits_t) (((20) << 9) + 0x174L))))) || !((((write_ports_ready)) == (((scm_bits_t) (((20) << 9) + 0x174L))))))
{
timeout.tv_sec = 0;
timeout.tv_usec = 0;
time_ptr = &timeout;
}
else if (((((secs)) == (((scm_bits_t) (((18) << 9) + 0x174L))))) || ((((secs)) == (((scm_bits_t) (((16) << 9) + 0x174L))))))
time_ptr = 0;
else
{
if ((2 & (secs)))
{
timeout.tv_sec = ((((secs)) >> (2)));
if (((((usecs)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
timeout.tv_usec = 0;
else
{
do { if (!((2 & (usecs)))) scm_wrong_type_arg_msg(s_scm_select, 5, usecs, "INUMP"); } while (0);
timeout.tv_usec = ((((usecs)) >> (2)));
}
}
else
{
double fl = scm_num2dbl (secs, s_scm_select);
if (!((((usecs)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
do { scm_wrong_type_arg (s_scm_select, 4, secs); } while (0);
if (fl > 0x7fffffffL)
do { scm_out_of_range_pos (s_scm_select, secs, (((scm_bits_t) (((4) << 2) + 2L)))); } while (0);
timeout.tv_sec = (long) fl;
timeout.tv_usec = (long) ((fl - timeout.tv_sec) * 1000000);
}
time_ptr = &timeout;
}
{
int rv = select (max_fd + 1,
&read_set, &write_set, &except_set, time_ptr);
if (rv < 0)
do { scm_syserror (s_scm_select); } while (0);
}
return scm_listify (retrieve_select_type (&read_set, read_ports_ready,
reads),
retrieve_select_type (&write_set, write_ports_ready,
writes),
retrieve_select_type (&except_set, ((scm_bits_t) (((20) << 9) + 0x174L)), excepts),
((scm_bits_t) (((18) << 9) + 0x174L)));
}

(fcntl object cmd value)
Apply @var{command} to the specified file descriptor or the underlying\n" "file descriptor of the specified port.  @var{value} is an optional\n" "integer argument.
 "Values for @var{command} are:
 "@table @code\n" "@item F_DUPFD\n" "Duplicate a file descriptor\n" "@item F_GETFD\n" "Get flags associated with the file descriptor.\n" "@item F_SETFD\n" "Set flags associated with the file descriptor to @var{value}.\n" "@item F_GETFL\n" "Get flags associated with the open file.\n" "@item F_SETFL\n" "Set flags associated with the open file to @var{value}\n" "@item F_GETOWN\n" "Get the process ID of a socket's owner, for @code{SIGIO} signals.\n" "@item F_SETOWN\n" "Set the process that owns a socket to @var{value}, for @code{SIGIO} signals.\n" "@item FD_CLOEXEC\n" "The value used to indicate the \"close on ex
# 1141 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/filesys.c"
{
int rv;
int fdes;
int ivalue;
object = ((!(6 & (object))) && ((!(6 & (object))) && ((0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == scm_tc16_port_with_ps)) ? (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1]))))))) [0]))) : object);
do { if (!((2 & (cmd)))) scm_wrong_type_arg_msg(s_scm_fcntl, 2, cmd, "INUMP"); } while (0);
if ((!(6 & (object)) && (((0xfeff | (1L<<16)) & ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [0]) == (125 | (1L<<16)))))
fdes = (((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((object)))) [1])->stream))->fdes);
else
{
do { if (!((2 & (object)))) scm_wrong_type_arg_msg(s_scm_fcntl, 1, object, "INUMP"); } while (0);
fdes = ((((object)) >> (2)));
}
if (((((value)) == (((scm_bits_t) (((18) << 9) + 0x174L)))))) {
ivalue = 0;
} else {
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(value,SCM_ARG3,1160); ivalue = ((((value)) >> (2))); } while (0);
}
rv = fcntl (fdes, ((((cmd)) >> (2))), ivalue);
if (rv == -1)
do { scm_syserror (s_scm_fcntl); } while (0);
return (((scm_bits_t) (((rv) << 2) + 2L)));
}

(fsync object)
Copies any unwritten data for the specified output file descriptor to disk.\n" "If @var{port/fd} is a port, its buffer is flushed before the underlying\n" "file descriptor is fsync'd.\n" "The return value is unspecified.

(symlink oldpath newpath)
Create a symbolic link named @var{path-to} with the value (i.e., pointing to)\n" "@var{path-from}.  The return value is unspecified.

(readlink path)
Returns the value of the symbolic link named by\n" "@var{path} (a string), i.e., the\n" "file that the link points to.

(lstat str)
Similar to @code{stat}, but does not follow symbolic links, i.e.,\n" "it will return information about a symbolic link itself, not the \n" "file it points to.  @var{path} must be a string.

(copy-file oldfile newfile)
Copy the file specified by @var{path-from} to @var{path-to}.\n" "The return value is unspecified.

(dirname filename)

(basename filename suffix)

(make-fluid)
Return a newly created fluid.\n" "Fluids are objects of a certain type (a smob) that can hold one SCM\n" "value per dynamic root.  That is, modifications to this value are\n" "only visible to code that executes within the same dynamic root as\n" "the modifying code.  When a new dynamic root is constructed, it\n" "inherits the values from its parent.  Because each thread executes\n" "in its own dynamic root, you can use fluids for thread local storage.

(fluid? obj)
Return #t iff @var{obj} is a fluid; otherwise, return #f.

(fluid-ref fluid)
Return the value associated with @var{fluid} in the current dynamic root.\n" "If @var{fluid} has not been set, then this returns #f.

(fluid-set! fluid value)
Set the value associated with @var{fluid} in the current dynamic root.

(with-fluids* fluids values thunk)
Set @var{fluids} to @var{values} temporary, and call @var{thunk}.\n" "@var{fluids} must be a list of fluids and @var{values} must be the same\n" "number of their values to be applied.  Each substitution is done\n" "one after another.  @var{thunk} must be a procedure with no argument.

(setvbuf port mode size)
Set the buffering mode for @var{port}.  @var{mode} can be:\n" "@table @code\n" "@item _IONBF\n" "non-buffered\n" "@item _IOLBF\n" "line buffered\n" "@item _IOFBF\n" "block buffered, using a newly allocated buffer of @var{size} bytes.\n" "If @var{size} is omitted, a default size will be used.\n" "@end table

(open-file filename modes)
Open the file whose name is @var{string}, and return a port\n" "representing that file.  The attributes of the port are\n" "determined by the @var{mode} string.  The way in \n" "which this is interpreted is similar to C stdio:
 "The first character must be one of the following:
 "@table @samp\n" "@item r\n" "Open an existing file for input.\n" "@item w\n" "Open a file for output, creating it if it doesn't already exist\n" "or removing its contents if it does.\n" "@item a\n" "Open a file for output, creating it if it doesn't already exist.\n" "All writes to the port will go to the end of the file.\n" "The \"append mode\" can be turned off while the port is in use\n" "@pxref{Ports and File Descriptors, fcntl}\n" "@end table
 "The following additional characters can be appended:
 "@table @samp
# 271 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/fports.c"
{
SCM port;
int fdes;
int flags = 0;
char *file;
char *mode;
char *ptr;
do { if (!(((!(6 & (filename))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [0]) == 5))))) scm_wrong_type_arg_msg(s_scm_open_file, 1, filename, "ROSTRINGP"); } while (0);
do { if (!(((!(6 & (modes))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 5))))) scm_wrong_type_arg_msg(s_scm_open_file, 2, modes, "ROSTRINGP"); } while (0);
if (((!(6 & (filename))) && ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [0]) == 23)))
filename = scm_makfromstr (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [1])))), (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [0]) >> 8), 0);
if (((!(6 & (modes))) && ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 23)))
modes = scm_makfromstr (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1])))), (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) >> 8), 0);
file = ((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((filename)))) [1]))));
mode = ((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))));
switch (*mode)
{
case 'r':
flags |= 0x0000;
break;
case 'w':
flags |= 0x0001 | 0x0200 | 0x0400;
break;
case 'a':
flags |= 0x0001 | 0x0200 | 0x0008;
break;
default:
scm_out_of_range (s_scm_open_file, modes);
}
ptr = mode + 1;
while (*ptr != '\0')
{
switch (*ptr)
{
case '+':
flags = (flags & ~(0x0000 | 0x0001)) | 0x0002;
break;
case '0':
case 'b':
case 'l':
break;
default:
scm_out_of_range (s_scm_open_file, modes);
}
ptr++;
}
fdes = open (file, flags, 0666);
if (fdes == -1)
{
int en = (*__errno());
do { scm_syserror_msg (s_scm_open_file, ("~A: ~S"), (scm_cons (scm_makfrom0str (strerror (en)), scm_cons (filename, ((scm_bits_t) (((20) << 9) + 0x174L))))), (en)); } while (0);
}
port = scm_fdes_to_port (fdes, mode, filename);
return port;
}
# 342 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/fports.c"
SCM
scm_fdes_to_port (int fdes, char *mode, SCM name)
{
long mode_bits = scm_mode_bits (mode);
SCM port;
scm_port *pt;
int flags;
flags = fcntl (fdes, 3, 0);
if (flags == -1)
do { scm_syserror ("scm_fdes_to_port"); } while (0);
flags &= 0x0003;
if (flags != 0x0002
&& ((flags != 0x0001 && (mode_bits & (4L<<16)))
|| (flags != 0x0000 && (mode_bits & (2L<<16)))))
{
do { scm_misc_error ("scm_fdes_to_port", "requested file mode not available on fdes", ((scm_bits_t) (((20) << 9) + 0x174L))); } while (0);
}
do { if ((6 & (scm_freelist))) port = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist); else { port = scm_freelist; scm_freelist = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((scm_freelist)))) [1]))); ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [0] = (scm_bits_t) (0x047f); } } while(0);
do { asm (""); ; ; asm (""); scm_ints_disabled = 1; asm (""); } while (0);
pt = scm_add_to_port_table (port);
(((scm_bits_t *) ((SCM_CELLPTR) (((port))))) [1] = (scm_bits_t) ((scm_bits_t) (pt)));
((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [0] = (scm_bits_t) (((125 + 0 * 256L) | mode_bits));
{
struct scm_fport *fp
= (struct scm_fport *) malloc (sizeof (struct scm_fport));
if (fp == 0L)
do { scm_memory_error ("scm_fdes_to_port"); } while (0);
fp->fdes = fdes;
pt->rw_random = ((lseek (fdes, 0, 1) == -1) ? 0 : 1);
(((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream = (scm_bits_t) (fp));
if (mode_bits & (8L<<16))
scm_fport_buffer_add (port, 0, 0);
else
scm_fport_buffer_add (port, -1, -1);
}
((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->file_name = name;
do { asm (""); ; ; asm (""); scm_ints_disabled = 0; asm (""); ; asm (""); } while (0);
return port;
}
static int
fport_input_waiting (SCM port)
{
int fdes = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream))->fdes;
struct timeval timeout;
fd_set read_set;
fd_set write_set;
fd_set except_set;
memset(&read_set, 0, sizeof(*(&read_set)));
memset(&write_set, 0, sizeof(*(&write_set)));
memset(&except_set, 0, sizeof(*(&except_set)));
((&read_set)->fds_bits[(fdes)/(sizeof(fd_mask) * 8)] |= (1 << ((fdes) % (sizeof(fd_mask) * 8))));
timeout.tv_sec = 0;
timeout.tv_usec = 0;
if (select (1024,
&read_set, &write_set, &except_set, &timeout)
< 0)
scm_syserror ("fport_input_waiting");
return ((&read_set)->fds_bits[(fdes)/(sizeof(fd_mask) * 8)] & (1 << ((fdes) % (sizeof(fd_mask) * 8)))) ? 1 : 0;
# 423 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/fports.c"
}
static int
prinfport (SCM exp,SCM port,scm_print_state *pstate)
{
scm_puts ("#<", port);
scm_print_port_mode (exp, port);
if ((!(6 & (exp)) && (((0xfeff | (1L<<16)) & ((scm_bits_t *) ((SCM_CELLPTR) ((exp)))) [0]) == (125 | (1L<<16)))))
{
int fdes;
SCM name = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((exp)))) [1])->file_name;
scm_puts (((!(6 & (name))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((name)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((name)))) [0]) == 5)))
? ((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((name)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((name)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((name)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((name)))) [1]))))
: scm_ptobs[((0x0ff & ((((scm_bits_t *) ((SCM_CELLPTR) ((exp)))) [0]) >> 8)))].name,
port);
scm_putc (' ', port);
fdes = (((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((exp)))) [1])->stream)))->fdes;
if (isatty (fdes))
scm_puts (ttyname (fdes), port);
else
scm_intprint (fdes, 10, port);
}
else
{
scm_puts (scm_ptobs[((0x0ff & ((((scm_bits_t *) ((SCM_CELLPTR) ((exp)))) [0]) >> 8)))].name, port);
scm_putc (' ', port);
scm_intprint (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((exp)))) [1])))), 16, port);
}
scm_putc ('>', port);
return 1;
}
# 484 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/fports.c"
static void fport_flush (SCM port);
static int
fport_fill_input (SCM port)
{
int count;
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
struct scm_fport *fp = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream));
count = read (fp->fdes, pt->read_buf, pt->read_buf_size);
if (count == -1)
scm_syserror ("fport_fill_input");
if (count == 0)
return (-1);
else
{
pt->read_pos = pt->read_buf;
pt->read_end = pt->read_buf + count;
return *pt->read_buf;
}
}
static off_t
fport_seek (SCM port, off_t offset, int whence)
{
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
struct scm_fport *fp = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream));
off_t rv;
off_t result;
if (pt->rw_active == SCM_PORT_WRITE)
{
if (offset != 0 || whence != 1)
{
fport_flush (port);
result = rv = lseek (fp->fdes, offset, whence);
}
else
{
rv = lseek (fp->fdes, offset, whence);
result = rv + (pt->write_pos - pt->write_buf);
}
}
else if (pt->rw_active == SCM_PORT_READ)
{
if (offset != 0 || whence != 1)
{
scm_end_input (port);
result = rv = lseek (fp->fdes, offset, whence);
}
else
{
rv = lseek (fp->fdes, offset, whence);
result = rv - (pt->read_end - pt->read_pos);
if (pt->read_buf == pt->putback_buf)
result -= pt->saved_read_end - pt->saved_read_pos;
}
}
else
{
result = rv = lseek (fp->fdes, offset, whence);
}
if (rv == -1)
scm_syserror ("fport_seek");
return result;
}
static void
fport_truncate (SCM port, off_t length)
{
struct scm_fport *fp = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream));
if (ftruncate (fp->fdes, length) == -1)
scm_syserror ("ftruncate");
}
static void
fport_write (SCM port, const void *data, size_t size)
{
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
if (pt->write_buf == &pt->shortbuf)
{
int fdes = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream))->fdes;
if (write (fdes, data, size) == -1)
scm_syserror ("fport_write");
}
else
{
const char *input = (char *) data;
size_t remaining = size;
while (remaining > 0)
{
int space = pt->write_end - pt->write_pos;
int write_len = (remaining > space) ? space : remaining;
memcpy (pt->write_pos, input, write_len);
pt->write_pos += write_len;
remaining -= write_len;
input += write_len;
if (write_len == space)
fport_flush (port);
}
if ((((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [0] & (64L<<16)) && memchr (data, '\n', size))
fport_flush (port);
}
}
extern int terminating;
static void
fport_flush (SCM port)
{
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
struct scm_fport *fp = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream));
unsigned char *ptr = pt->write_buf;
int init_size = pt->write_pos - pt->write_buf;
int remaining = init_size;
while (remaining > 0)
{
int count;
count = write (fp->fdes, ptr, remaining);
if (count < 0)
{
int done = init_size - remaining;
if (done > 0)
{
int i;
for (i = 0; i < remaining; i++)
{
*(pt->write_buf + i) = *(pt->write_buf + done + i);
}
pt->write_pos = pt->write_buf + remaining;
}
if (!terminating)
scm_syserror ("fport_flush");
else
{
const char *msg = "Error: could not flush file-descriptor ";
char buf[11];
write (2, msg, strlen (msg));
sprintf (buf, "%d\n", fp->fdes);
write (2, buf, strlen (buf));
count = remaining;
}
}
ptr += count;
remaining -= count;
}
pt->write_pos = pt->write_buf;
pt->rw_active = SCM_PORT_NEITHER;
}
static void
fport_end_input (SCM port, int offset)
{
struct scm_fport *fp = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream));
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
offset += pt->read_end - pt->read_pos;
if (offset > 0)
{
pt->read_pos = pt->read_end;
if (lseek (fp->fdes, -offset, 1) == -1)
scm_syserror ("fport_end_input");
}
pt->rw_active = SCM_PORT_NEITHER;
}
static int
fport_close (SCM port)
{
struct scm_fport *fp = ((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1])->stream));
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
int rv;
fport_flush (port);
rv = close (fp->fdes);
if (rv == -1 && (*__errno()) != 9)
scm_syserror ("fport_close");
if (pt->read_buf == pt->putback_buf)
pt->read_buf = pt->saved_read_buf;
if (pt->read_buf != &pt->shortbuf)
free (pt->read_buf);
if (pt->write_buf != &pt->shortbuf)
free (pt->write_buf);
free ((char *) fp);
return rv;
}
static size_t
fport_free (SCM port)
{
fport_close (port);
return 0;
}
void scm_make_fptob (void);
void
scm_make_fptob ()
{
long tc = scm_make_port_type ("file", fport_fill_input, fport_write);
scm_set_port_free (tc, fport_free);
scm_set_port_print (tc, prinfport);
scm_set_port_flush (tc, fport_flush);
scm_set_port_end_input (tc, fport_end_input);
scm_set_port_close (tc, fport_close);
scm_set_port_seek (tc, fport_seek);
scm_set_port_truncate (tc, fport_truncate);
scm_set_port_input_waiting (tc, fport_input_waiting);
}
void
scm_init_fports ()
{
# 1 "../libguile/fports.x" 1
# 733 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/fports.c" 2
scm_sysintern ("_IOFBF", (((scm_bits_t) (((0) << 2) + 2L))));
scm_sysintern ("_IOLBF", (((scm_bits_t) (((1) << 2) + 2L))));
scm_sysintern ("_IONBF", (((scm_bits_t) (((2) << 2) + 2L))));
}

(gc-stats)
Returns an association list of statistics about Guile's current use of storage.

(object-address obj)
Return an integer that for the lifetime of @var{obj} is uniquely\n" "returned by this function for @var{obj}

(gc)
Scans all of SCM objects and reclaims for further use those that are\n" "no longer accessible.

(unhash-name name)

(make-guardian)
Create a new guardian.\n" "A guardian protects a set of objects from garbage collection,\n" "allowing a program to apply cleanup or other actions.
 "make-guardian returns a procedure representing the guardian.\n" "Calling the guardian procedure with an argument adds the\n" "argument to the guardian's set of protected objects.\n" "Calling the guardian procedure without an argument returns\n" "one of the protected objects which are ready for garbage\n" "collection or @code{#f} if no such object is available.\n" "Objects which are returned in this way are removed from\n" "the guardian.
. "See R. Kent Dybvig, Carl Bruggeman, and David Eby (1993)\n" "\"Guardians in a Generation-Based Garbage Collector\".\n" "ACM SIGPLAN Conference on Programming Language Design\n" "and Implementation, June 1993.

(hashq key size)
Determine a hash value for KEY that is suitable for lookups in\n" "a hashtable of size SIZE, where eq? is used as the equality\n" "predicate.  The function returns an integer in the range 0 to\n" "SIZE - 1.  NOTE that `hashq' may use internal addresses.\n" "Thus two calls to hashq where the keys are eq? are not\n" "guaranteed to deliver the same value if the key object gets\n" "garbage collected in between.  This can happen, for example\n" "with symbols:  (hashq 'foo n) (gc) (hashq 'foo n) may produce two\n" "different values, since 'foo will be garbage collected.

(hashv key size)
Determine a hash value for KEY that is suitable for lookups in\n" "a hashtable of size SIZE, where eqv? is used as the equality\n" "predicate.  The function returns an integer in the range 0 to\n" "SIZE - 1.  NOTE that (hashv key) may use internal addresses.\n" "Thus two calls to hashv where the keys are eqv? are not\n" "guaranteed to deliver the same value if the key object gets\n" "garbage collected in between.  This can happen, for example\n" "with symbols:  (hashv 'foo n) (gc) (hashv 'foo n) may produce two\n" "different values, since 'foo will be garbage collected.

(hash key size)
Determine a hash value for KEY that is suitable for lookups in\n" "a hashtable of size SIZE, where equal? is used as the equality\n" "predicate.  The function returns an integer in the range 0 to\n" "SIZE - 1.

(hashq-get-handle table obj)
This procedure is similar to its @code{-ref} cousin, but returns a\n" "@dfn{handle} from the hash table rather than the value associated with\n" "@var{key}.  By convention, a handle in a hash table is the pair which\n" "associates a key with a value.  Where @code{hashq-ref table key} returns\n" "only a @code{value}, @code{hashq-get-handle table key} returns the pair\n" "@code{(key . value)}.

(hashq-create-handle! table key init)
This function looks up @var{key} in @var{table} and returns its handle.\n" "If @var{key} is not already present, a new handle is created which\n" "associates @var{key} with @var{init}.

(hashq-ref table obj dflt)
Look up @var{key} in the hash table @var{table}, and return the\n" "value (if any) associated with it.  If @var{key} is not found,\n" "return @var{default} (or @code{#f} if no @var{default} argument is\n" "supplied).  Uses `eq?' for equality testing.

(hashq-set! table obj val)
Find the entry in @var{table} associated with @var{key}, and store\n" "@var{value} there. Uses `eq?' for equality testing.

(hashq-remove! table obj)
Remove @var{key} (and any value associated with it) from @var{table}.\n" "Uses `eq?' for equality tests.

(hashv-get-handle table obj)
This procedure is similar to its @code{-ref} cousin, but returns a\n" "@dfn{handle} from the hash table rather than the value associated with\n" "@var{key}.  By convention, a handle in a hash table is the pair which\n" "associates a key with a value.  Where @code{hashv-ref table key} returns\n" "only a @code{value}, @code{hashv-get-handle table key} returns the pair\n" "@code{(key . value)}.

(hashv-create-handle! table key init)
This function looks up @var{key} in @var{table} and returns its handle.\n" "If @var{key} is not already present, a new handle is created which\n" "associates @var{key} with @var{init}.

(hashv-ref table obj dflt)
Look up @var{key} in the hash table @var{table}, and return the\n" "value (if any) associated with it.  If @var{key} is not found,\n" "return @var{default} (or @code{#f} if no @var{default} argument is\n" "supplied).  Uses `eqv?' for equality testing.

(hashv-set! table obj val)
Find the entry in @var{table} associated with @var{key}, and store\n" "@var{value} there. Uses `eqv?' for equality testing.

(hashv-remove! table obj)
Remove @var{key} (and any value associated with it) from @var{table}.\n" "Uses `eqv?' for equality tests.

(hash-get-handle table obj)
This procedure is similar to its @code{-ref} cousin, but returns a\n" "@dfn{handle} from the hash table rather than the value associated with\n" "@var{key}.  By convention, a handle in a hash table is the pair which\n" "associates a key with a value.  Where @code{hash-ref table key} returns\n" "only a @code{value}, @code{hash-get-handle table key} returns the pair\n" "@code{(key . value)}.

(hash-create-handle! table key init)
This function looks up @var{key} in @var{table} and returns its handle.\n" "If @var{key} is not already present, a new handle is created which\n" "associates @var{key} with @var{init}.

(hash-ref table obj dflt)
Look up @var{key} in the hash table @var{table}, and return the\n" "value (if any) associated with it.  If @var{key} is not found,\n" "return @var{default} (or @code{#f} if no @var{default} argument is\n" "supplied).  Uses `equal?' for equality testing.

(hash-set! table obj val)
Find the entry in @var{table} associated with @var{key}, and store\n" "@var{value} there. Uses `equal?' for equality testing.

(hash-remove! table obj)
Remove @var{key} (and any value associated with it) from @var{table}.\n" "Uses `equal?' for equality tests.

(hashx-get-handle hash assoc table obj)
This behaves the same way as the corresponding @code{-get-handle}\n" "function, but uses @var{hasher} as a\n" "hash function and @var{assoc} to compare keys.  @code{hasher} must\n" "be a function that takes two arguments, a key to be hashed and a\n" "table size.  @code{assoc} must be an associator function, like\n" "@code{assoc}, @code{assq} or @code{assv}.

(hashx-create-handle! hashassoctableobjinit)
This behaves the same way as the corresponding @code{-create-handle}\n" "function, but uses @var{hasher} as a\n" "hash function and @var{assoc} to compare keys.  @code{hasher} must\n" "be a function that takes two arguments, a key to be hashed and a\n" "table size.  @code{assoc} must be an associator function, like\n" "@code{assoc}, @code{assq} or @code{assv}.

(hashx-ref hashassoctableobjdflt)
This behaves the same way as the corresponding @code{ref}\n" "function, but uses @var{hasher} as a\n" "hash function and @var{assoc} to compare keys.  @code{hasher} must\n" "be a function that takes two arguments, a key to be hashed and a\n" "table size.  @code{assoc} must be an associator function, like\n" "@code{assoc}, @code{assq} or @code{assv}.
 "By way of illustration, @code{hashq-ref table key} is equivalent\n" "to @code{hashx-ref hashq assq table key}.

(hashx-set! hash assoc table obj val)
This behaves the same way as the corresponding @code{set!}\n" "function, but uses @var{hasher} as a\n" "hash function and @var{assoc} to compare keys.  @code{hasher} must\n" "be a function that takes two arguments, a key to be hashed and a\n" "table size.  @code{assoc} must be an associator function, like\n" "@code{assoc}, @code{assq} or @code{assv}.
 "By way of illustration, @code{hashq-set! table key} is equivalent\n" "to @code{hashx-set! hashq assq table key}.

(hash-fold proc init table)
An iterator over hash-table elements.\n" "Accumulates and returns a result by applying PROC successively.\n" "The arguments to PROC are \"(key value prior-result)\" where key\n" "and value are successive pairs from the hash table TABLE, and\n" "prior-result is either INIT (for the first application of PROC)\n" "or the return value of the previous application of PROC.\n" "For example, @code{(hash-fold acons () tab)} will convert a hash\n" "table into an a-list of key-value pairs.

(make-hook-with-name name n_args)

(make-hook n_args)

(hook? x)

(hook-empty? hook)

(add-hook! hook proc append_p)

(remove-hook! hook proc)

(reset-hook! hook)

(run-hook hook args)

(hook->list hook)

(%read-delimited! delims buf gobble port start end)
Read characters from @var{port} into @var{buf} until one of the\n" "characters in the @var{delims} string is encountered.  If @var{gobble?}\n" "is true, store the delimiter character in @var{buf} as well; otherwise,\n" "discard it.  If @var{port} is not specified, use the value of\n" "@code{(current-input-port)}.  If @var{start} or @var{end} are specified,\n" "store data only into the substring of @var{buf} bounded by @var{start}\n" "and @var{end} (which default to the beginning and end of the buffer,\n" "respectively).
 "Return a pair consisting of the delimiter that terminated the string and\n" "the number of characters read.  If reading stopped at the end of file,\n" "the delimiter returned is the @var{eof-object}; if the buffer was filled
# 87 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/ioext.c"
{
long j;
char *cbuf;
long cstart;
long cend, tend;
int c;
char *cdelims;
int num_delims;
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(delims,1,96); cdelims = ((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((delims)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((delims)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((delims)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((delims)))) [1])))); } while (0);
num_delims = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((delims)))) [0]) >> 8);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(buf,2,98); cbuf = ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((buf)))) [1])); } while (0);
cend = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((buf)))) [0]) >> 8);
if (((((port)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
port = (scm_root->cur_inp);
else
do { if (!(((!(6 & (port))) && (((0x7f | (1L<<16) | (2L<<16)) & ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [0])==(125 | (1L<<16) | (2L<<16)))))) scm_wrong_type_arg_msg(s_scm_read_delimited_x, 4, port, "OPINPORTP"); } while (0);
do { if (((((start)) == (((scm_bits_t) (((18) << 9) + 0x174L)))))) { start = (((scm_bits_t) (((0) << 2) + 2L))); cstart = 0; } else { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(start,5,105); cstart = ((((start)) >> (2))); } } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(start,SCM_OUTOFRANGE,106); } while (0);
do { if (((((end)) == (((scm_bits_t) (((18) << 9) + 0x174L)))))) { end = (((scm_bits_t) (((cend) << 2) + 2L))); tend = cend; } else { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(end,6,108); tend = ((((end)) >> (2))); } } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(end,SCM_OUTOFRANGE,109); } while (0);
cend = tend;
for (j = cstart; j < cend; j++)
{
int k;
c = scm_getc (port);
for (k = 0; k < num_delims; k++)
{
if (cdelims[k] == c)
{
if (((((gobble)) == (((scm_bits_t) (((16) << 9) + 0x174L))))))
scm_ungetc (c, port);
return scm_cons (((scm_bits_t) (((c) << 8) + scm_tc8_char)),
scm_long2num (j - cstart));
}
}
if (c == (-1))
return scm_cons (((scm_bits_t) (((19) << 9) + 0x174L)),
scm_long2num (j - cstart));
cbuf[j] = c;
}
return scm_cons (((scm_bits_t) (((16) << 9) + 0x174L)), scm_long2num (j - cstart));
}
static unsigned char *
scm_do_read_line (SCM port, int *len_p)
{
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
unsigned char *end;
if ((end = memchr (pt->read_pos, '\n', (pt->read_end - pt->read_pos)))
!= 0)
{
int buf_len = (end + 1) - pt->read_pos;
unsigned char *buf = scm_must_malloc (buf_len + 1, "%read-line");
memcpy (buf, pt->read_pos, buf_len);
pt->read_pos += buf_len;
buf[buf_len] = '\0';
*len_p = buf_len;
return buf;
}
{
int len = (pt->read_end - pt->read_pos);
int buf_size = (len < 50) ? 60 : len * 2;
unsigned char *buf = scm_must_malloc (buf_size + 1, "%read-line");
int buf_len = 0;
for (;;)
{
if (buf_len + len > buf_size)
{
int new_size = (buf_len + len) * 2;
buf = scm_must_realloc (buf, buf_size + 1, new_size + 1,
%read-line");
buf_size = new_size;
}
memcpy (buf + buf_len, pt->read_pos, len);
buf_len += len;
pt->read_pos += len;
if (end)
break;
if (scm_fill_input (port) == (-1))
{
if (buf_len > 0)
break;
free (buf);
return 0;
}
if ((end = memchr (pt->read_pos, '\n',
(len = (pt->read_end - pt->read_pos))))
!= 0)
len = (end - pt->read_pos) + 1;
}
buf = scm_must_realloc (buf, buf_size + 1, buf_len + 1, "%read-line");
buf[buf_len] = '\0';
*len_p = buf_len;
return buf;
}
}
# 231 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/ioext.c"

(%read-line port)
Read a newline-terminated line from @var{port}, allocating storage as\n" "necessary.  The newline terminator (if any) is removed from the string,\n" "and a pair consisting of the line and its delimiter is returned.  The\n" "delimiter may be either a newline or the @var{eof-object}; if\n" "@code{%read-line} is called at the end of file, it returns the pair\n" "@code{(#<eof> . #<eof>)}.

(write-line obj port)
Display @var{obj} and a newline character to @var{port}.  If @var{port}\n" "is not specified, @code{(current-output-port)} is used.  This function\n" "is equivalent to:
 "@smalllisp\n" "(display obj [port])\n" "(newline [port])\n" "@end smalllisp

(ftell object)
Returns an integer representing the current position of @var{fd/port},\n" "measured from the beginning.  Equivalent to:\n" "@smalllisp\n" "(seek port 0 SEEK_CUR)\n" "@end smalllisp

(fseek object offset whence)
Obsolete.  Almost the same as seek, above, but the return value is\n" "unspecified.

(redirect-port old new)
This procedure takes two ports and duplicates the underlying file\n" "descriptor from @var{old-port} into @var{new-port}.  The\n" "current file descriptor in @var{new-port} will be closed.\n" "After the redirection the two ports will share a file position\n" "and file status flags.
 "The return value is unspecified.
 "Unexpected behaviour can result if both ports are subsequently used\n" "and the original and/or duplicate ports are buffered.
 "This procedure does not have any side effects on other ports or\n" "revealed counts.

(dup->fdes fd_or_port fd)
Returns an integer file descriptor.

(fileno port)
Returns the integer file descriptor underlying @var{port}.\n" "Does not change its revealed count.

(isatty? port)
Returns @code{#t} if @var{port} is using a serial\n" "non-file device, otherwise @code{#f}.

(fdopen fdes modes)
Returns a new port based on the file descriptor @var{fdes}.\n" "Modes are given by the string @var{modes}.  The revealed count of the port\n" "is initialized to zero.  The modes string is the same as that accepted\n" "by @ref{File Ports, open-file}.

(primitive-move->fdes port fd)
Moves the underlying file descriptor for @var{port} to the integer\n" "value @var{fdes} without changing the revealed count of @var{port}.\n" "Any other ports already using this descriptor will be automatically\n" "shifted to new descriptors and their revealed counts reset to zero.\n" "The return value is @code{#f} if the file descriptor already had the\n" "required value or @code{#t} if it was moved.

(fdes->ports fd)
Returns a list of existing ports which have @var{fdes} as an\n" "underlying file descriptor, without changing their revealed counts.

(make-keyword-from-dash-symbol symbol)
Return a keyword object from SYMBOL that starts with `-' (a dash).

(keyword? obj)
Returns #t if the argument OBJ is a keyword, else #f.

(keyword-dash-symbol keyword)
Return KEYWORD as a dash symbol.\n" "This is the inverse of `make-keyword-from-dash-symbol'.

(nil-cons x y)

(nil-car x)

(nil-cdr x)

(null x)

(nil-eq x y)

(list objs)
Return a list containing OBJS, the arguments to `list'.

(list*)
scm_cons_star

(cons* arg rest)
Like `list', but the last arg provides the tail of the constructed list,\n" "returning (cons ARG1 (cons ARG2 (cons ... ARGn))).\n" "Requires at least one argument.  If given one argument, that argument\n" "is returned as result.\n" "This function is called `list*' in some other Schemes and in Common LISP.

(null? x)
Return #t iff X is the empty list, else #f.

(list? x)
Return #t iff X is a proper list, else #f.

(length lst)
Return the number of elements in list LST.

(append args)
Returns a list consisting of the elements of the first LIST\n" "followed by the elements of the other LISTs.\n" "\n" "  (append '(x) '(y))          =>  (x y)\n" "  (append '(a) '(b c d))      =>  (a b c d)\n" "  (append '(a (b)) '((c)))    =>  (a (b) (c))\n" "\n" "The resulting list is always newly allocated, except that it shares\n" "structure with the last LIST argument.  The last argument may\n" "actually be any object; an improper list results if the last\n" "argument is not a proper list.\n" "  (append '(a b) '(c . d))    =>  (a b c . d)\n" "  (append '() 'a)             =>  a

(append! args)
A destructive version of @code{append} (@pxref{Pairs and Lists,,,r4rs,\n" "The Revised^4 Report on Scheme}).  The cdr field of each list's final\n" "pair is changed to point to the head of the next list, so no consing is\n" "performed.  Return a pointer to the mutated list.

(last-pair lst)
Return a pointer to the last pair in @var{lst}, signalling an error if\n" "@var{lst} is circular.

(reverse lst)
Return a new list that contains the elements of LST but in reverse order.

(reverse! lst new_tail)
A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r4rs,\n" "The Revised^4 Report on Scheme}).  The cdr of each cell in @var{lst} is\n" "modified to point to the previous list element.  Return a pointer to the\n" "head of the reversed list.
 "Caveat: because the list is modified in place, the tail of the original\n" "list now becomes its head, and the head of the original list now becomes\n" "the tail.  Therefore, the @var{lst} symbol to which the head of the\n" "original list was bound now points to the tail.  To ensure that the head\n" "of the modified list is not lost, it is wise to save the return value of\n" "@code{reverse!}

(list-ref lst k)
Return the Kth element from list LST.

(list-set! lst k val)
Set the @var{k}th element of @var{lst} to @var{val}.

(list-cdr-ref)
scm_list_tail

(list-tail lst k)
Return the \"tail\" of @var{lst} beginning with its @var{k}th element.\n" "The first element of the list is considered to be element 0.
 "@code{list-cdr-ref} and @code{list-tail} are identical.  It may help to\n" "think of @code{list-cdr-ref} as accessing the @var{k}th cdr of the list,\n" "or returning the results of cdring @var{k} times down @var{lst}.

(list-cdr-set! lst k val)
Set the @var{k}th cdr of @var{lst} to @var{val}.

(list-head lst k)
Copy the first @var{k} elements from @var{lst} into a new list, and\n" "return it.

(list-copy lst)
Return a (newly-created) copy of @var{lst}.

(sloppy-memq x lst)
This procedure behaves like @code{memq}, but does no type or error checking.\n" "Its use is recommended only in writing Guile internals,\n" "not for high-level Scheme programs.

(sloppy-memv x lst)
This procedure behaves like @code{memv}, but does no type or error checking.\n" "Its use is recommended only in writing Guile internals,\n" "not for high-level Scheme programs.

(sloppy-member x lst)
This procedure behaves like @code{member}, but does no type or error checking.\n" "Its use is recommended only in writing Guile internals,\n" "not for high-level Scheme programs.

(memq x lst)
Return the first sublist of LST whose car is `eq?' to X\n" "where the sublists of LST are the non-empty lists returned\n" "by `(list-tail LST K)' for K less than the length of LST.  If\n" "X does not occur in LST, then `#f' (not the empty list) is\n" "returned.

(memv x lst)
Return the first sublist of LST whose car is `eqv?' to X\n" "where the sublists of LST are the non-empty lists returned\n" "by `(list-tail LST K)' for K less than the length of LST.  If\n" "X does not occur in LST, then `#f' (not the empty list) is\n" "returned.

(member x lst)
Return the first sublist of LST whose car is `equal?' to X\n" "where the sublists of LST are the non-empty lists returned\n" "by `(list-tail LST K)' for K less than the length of LST.  If\n" "X does not occur in LST, then `#f' (not the empty list) is\n" "returned.

(delq! item lst)
@deffnx primitive delv! item lst\n" "@deffnx primitive delete! item lst\n" "These procedures are destructive versions of @code{delq}, @code{delv}\n" "and @code{delete}: they modify the pointers in the existing @var{lst}\n" "rather than creating a new list.  Caveat evaluator: Like other\n" "destructive list functions, these functions cannot modify the binding of\n" "@var{lst}, and so cannot be used to delete the first element of\n" "@var{lst} destructively.

(delv! item lst)
Destructively remove all elements from LST that are `eqv?' to ITEM.

(delete! item lst)
Destructively remove all elements from LST that are `equal?' to ITEM.

(delq item lst)
Return a newly-created copy of @var{lst} with elements `eq?' to @var{item} removed.\n" "This procedure mirrors @code{memq}:\n" "@code{delq} compares elements of @var{lst} against @var{item} with\n" "@code{eq?}.

(delv item lst)
Return a newly-created copy of @var{lst} with elements `eqv?' to @var{item} removed.\n" "This procedure mirrors @code{memv}:\n" "@code{delv} compares elements of @var{lst} against @var{item} with\n" "@code{eqv?}.

(delete item lst)
Return a newly-created copy of @var{lst} with elements `equal?' to @var{item} removed.\n" "This procedure mirrors @code{member}:\n" "@code{delete} compares elements of @var{lst} against @var{item} with\n" "@code{equal?}.

(delq1! item lst)
Like `delq!', but only deletes the first occurrence of ITEM from LST.\n" "Tests for equality using `eq?'.  See also `delv1!' and `delete1!'.

(delv1! item lst)
Like `delv!', but only deletes the first occurrence of ITEM from LST.\n" "Tests for equality using `eqv?'.  See also `delq1!' and `delete1!'.

(delete1! item lst)
Like `delete!', but only deletes the first occurrence of ITEM from LST.\n" "Tests for equality using `equal?'.  See also `delq1!' and `delv1!'.

(primitive-load filename)
Load @var{file} and evaluate its contents in the top-level environment.\n" "The load paths are not searched; @var{file} must either be a full\n" "pathname or be a pathname relative to the current directory.  If the\n" "variable @code{%load-hook} is defined, it should be bound to a procedure\n" "that will be called before any code is loaded.  See documentation for\n" "@code{%load-hook} later in this section.

(%package-data-dir)
Return the name of the directory where Scheme packages, modules and\n" "libraries are kept.  On most Unix systems, this will be\n" "@samp{/usr/local/share/guile}.

(%library-dir)
Return the directory where the Guile Scheme library files are installed.\n" "E.g., may return \"/usr/share/guile/1.3.5\".

(%site-dir)
Return the directory where the Guile site files are installed.\n" "E.g., may return \"/usr/share/guile/site\".

(parse-path path tail)

(search-path path filename extensions)

(%search-load-path filename)
Search @var{%load-path} for @var{file}, which must be readable by the\n" "current user.  If @var{file} is found in the list of paths to search or\n" "is an absolute pathname, return its full pathname.  Otherwise, return\n" "@code{#f}.  Filenames may have any of the optional extensions in the\n" "@code{%load-extensions} list; @code{%search-load-path} will try each\n" "extension automatically.

(primitive-load-path filename)
Search @var{%load-path} for @var{file} and load it into the top-level\n" "environment.  If @var{file} is a relative pathname and is not found in\n" "the list of search paths, an error is signalled.

(read-and-eval! port)
Read a form from @var{port} (standard input by default), and evaluate it\n" "(memoizing it in the process) in the top-level environment.  If no data\n" "is left to be read from @var{port}, an @code{end-of-file} error is\n" "signalled.

(procedure->syntax code)
Returns a @dfn{macro} which, when a symbol defined to this value\n" "appears as the first symbol in an expression, returns the result\n" "of applying @var{code} to the expression and the environment.

(procedure->macro code)
Returns a @dfn{macro} which, when a symbol defined to this value\n" "appears as the first symbol in an expression, evaluates the result\n" "of applying @var{code} to the expression and the environment.\n" "The value returned from @var{code} which has been passed to\n" "@code{procedure->memoizing-macro} replaces the form passed to\n" "@var{code}.  For example:
 "@example\n" "(define trace\n" "  (procedure->macro\n" "   (lambda (x env) `(set! ,(cadr x) (tracef ,(cadr x) ',(cadr x))))))
 "(trace @i{foo}) @equiv{} (set! @i{foo} (tracef @i{foo} '@i{foo})).\n" "@end example

(procedure->memoizing-macro code)
Returns a @dfn{macro} which, when a symbol defined to this value\n" "appears as the first symbol in an expression, evaluates the result\n" "of applying @var{proc} to the expression and the environment.\n" "The value returned from @var{proc} which has been passed to\n" "@code{procedure->memoizing-macro} replaces the form passed to\n" "@var{proc}.  For example:
 "@example\n" "(define trace\n" "  (procedure->macro\n" "   (lambda (x env) `(set! ,(cadr x) (tracef ,(cadr x) ',(cadr x))))))
 "(trace @i{foo}) @equiv{} (set! @i{foo} (tracef @i{foo} '@i{foo})).\n" "@end example

(macro? obj)
Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a\n" "syntax transformer.

(macro-type m)
Return one of the symbols @code{syntax}, @code{macro} or @code{macro!},\n" "depending on whether @var{obj} is a syntax tranformer, a regular macro,\n" "or a memoizing macro, respectively.  If @var{obj} is not a macro,\n" "@code{#f} is returned.

(macro-name m)

(macro-transformer m)

(standard-eval-closure module)

(inet-aton address)
Converts a string containing an Internet host address in the traditional\n" "dotted decimal notation into an integer.
 "@smalllisp\n" "(inet-aton \"127.0.0.1\") @result{} 2130706433
 "@end smalllisp

(inet-ntoa inetid)
Converts an integer Internet host address into a string with the\n" "traditional dotted decimal representation.
 "@smalllisp\n" "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"" "@end smalllisp

(inet-netof address)
Returns the network number part of the given integer Internet address.
 "@smalllisp\n" "(inet-netof 2130706433) @result{} 127\n" "@end smalllisp

(inet-lnaof address)
Returns the local-address-with-network part of the given Internet\n" "address.
 "@smalllisp\n" "(inet-lnaof 2130706433) @result{} 1\n" "@end smalllisp

(inet-makeaddr net lna)
Makes an Internet host address by combining the network number @var{net}\n" "with the local-address-within-network number @var{lna}.
 "@smalllisp\n" "(inet-makeaddr 127 1) @result{} 2130706433\n" "@end smalllisp

(gethost name)
@deffnx procedure gethostbyname hostname\n" "@deffnx procedure gethostbyaddr address\n" "Look up a host by name or address, returning a host object.  The\n" "@code{gethost} procedure will accept either a string name or an integer\n" "address; if given no arguments, it behaves like @code{gethostent} (see\n" "below).  If a name or address is supplied but the address can not be\n" "found, an error will be thrown to one of the keys:\n" "@code{host-not-found}, @code{try-again}, @code{no-recovery} or\n" "@code{no-data}, corresponding to the equivalent @code{h_error} values.\n" "Unusual conditions may result in errors thrown to the\n" "@code{system-error} or @code{misc_error} keys.

(getnet name)
@deffnx procedure getnetbyname net-name\n" "@deffnx procedure getnetbyaddr net-number\n" "Look up a network by name or net number in the network database.  The\n" "@var{net-name} argument must be a string, and the @var{net-number}\n" "argument must be an integer.  @code{getnet} will accept either type of\n" "argument, behaving like @code{getnetent} (see below) if no arguments are\n" "given.

(getproto name)
@deffnx procedure getprotobyname name\n" "@deffnx procedure getprotobynumber number\n" "Look up a network protocol by name or by number.  @code{getprotobyname}\n" "takes a string argument, and @code{getprotobynumber} takes an integer\n" "argument.  @code{getproto} will accept either type, behaving like\n" "@code{getprotoent} (see below) if no arguments are supplied.

(getserv name proto)
@deffnx procedure getservbyname name protocol\n" "@deffnx procedure getservbyport port protocol\n" "Look up a network service by name or by service number, and return a\n" "network service object.  The @var{protocol} argument specifies the name\n" "of the desired protocol; if the protocol found in the network service\n" "database does not match this name, a system error is signalled.
 "The @code{getserv} procedure will take either a service name or number\n" "as its first argument; if given no arguments, it behaves like\n" "@code{getservent} (see below).

(sethost arg)
If @var{stayopen} is omitted, this is equivalent to @code{endhostent}.\n" "Otherwise it is equivalent to @code{sethostent stayopen}.

(setnet arg)
If @var{stayopen} is omitted, this is equivalent to @code{endnetent}.\n" "Otherwise it is equivalent to @code{setnetent stayopen}.

(setproto arg)
If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}.\n" "Otherwise it is equivalent to @code{setprotoent stayopen}.

(setserv arg)
If @var{stayopen} is omitted, this is equivalent to @code{endservent}.\n" "Otherwise it is equivalent to @code{setservent stayopen}.

(exact? x)
Return #t if X is an exact number, #f otherwise.

(odd? n)
Return #t if N is an odd number, #f otherwise.

(even? n)
Return #t if N is an even number, #f otherwise.

(logand n1 n2)
Returns the integer which is the bit-wise AND of the two integer\n" "arguments.
 "Example:\n" "@lisp\n" "(number->string (logand #b1100 #b1010) 2)\n" "   @result{} \"1000"

(logior n1 n2)
Returns the integer which is the bit-wise OR of the two integer\n" "arguments.
 "Example:\n" "@lisp\n" "(number->string (logior #b1100 #b1010) 2)\n" "   @result{} \"1110\"\n" "@end lisp

(logxor n1 n2)
Returns the integer which is the bit-wise XOR of the two integer\n" "arguments.
 "Example:\n" "@lisp\n" "(number->string (logxor #b1100 #b1010) 2)\n" "   @result{} \"110\"\n" "@end lisp

(logtest n1 n2)
@example\n" "(logtest j k) @equiv{} (not (zero? (logand j k)))
 "(logtest #b0100 #b1011) @result{} #f\n" "(logtest #b0100 #b0111) @result{} #t\n" "@end example

(logbit? index j)
@example\n" "(logbit? index j) @equiv{} (logtest (integer-expt 2 index) j)
 "(logbit? 0 #b1101) @result{} #t\n" "(logbit? 1 #b1101) @result{} #f\n" "(logbit? 2 #b1101) @result{} #t\n" "(logbit? 3 #b1101) @result{} #t\n" "(logbit? 4 #b1101) @result{} #f\n" "@end example

(lognot n)
Returns the integer which is the 2s-complement of the integer argument.
 "Example:\n" "@lisp\n" "(number->string (lognot #b10000000) 2)\n" "   @result{} \"-10000001\"\n" "(number->string (lognot #b0) 2)\n" "   @result{} \"-1\"\n" "@end lisp\n" "

(integer-expt n k)
Returns @var{n} raised to the non-negative integer exponent @var{k}.
 "Example:\n" "@lisp\n" "(integer-expt 2 5)\n" "   @result{} 32\n" "(integer-expt -3 3)\n" "   @result{} -27\n" "@end lisp

(ash n cnt)
The function ash performs an arithmetic shift left by CNT bits\n" "(or shift right, if CNT is negative).  'Arithmetic' means, that\n" "the function does not guarantee to keep the bit structure of N,\n" "but rather guarantees that the result will always be rounded\n" "towards minus infinity.  Therefore, the results of ash and a\n" "corresponding bitwise shift will differ if N is negative.
 "Formally, the function returns an integer equivalent to\n" "@code{(inexact->exact (floor (* N (expt 2 CNT))))}.@refill
 "Example:\n" "@lisp\n" "(number->string (ash #b1 3) 2)\n" "   @result{} \"1000\"" "(number->string (ash #b1010 -1) 2)" "   @result{} \"101\"" "@end lisp

(bit-extract n start end)
Returns the integer composed of the @var{start} (inclusive) through\n" "@var{end} (exclusive) bits of @var{n}.  The @var{start}th bit becomes\n" "the 0-th bit in the result.@refill
 "Example:\n" "@lisp\n" "(number->string (bit-extract #b1101101010 0 4) 2)\n" "   @result{} \"1010\"\n" "(number->string (bit-extract #b1101101010 4 9) 2)\n" "   @result{} \"10110\"\n" "@end lisp

(logcount n)
Returns the number of bits in integer @var{n}.  If integer is positive,\n" "the 1-bits in its binary representation are counted.  If negative, the\n" "0-bits in its two's-complement binary representation are counted.  If 0,\n" "0 is returned.
 "Example:\n" "@lisp\n" "(logcount #b10101010)\n" "   @result{} 4\n" "(logcount 0)\n" "   @result{} 0\n" "(logcount -2)\n" "   @result{} 1\n" "@end lisp

(integer-length n)
Returns the number of bits neccessary to represent @var{n}.
 "Example:\n" "@lisp\n" "(integer-length #b10101010)\n" "   @result{} 8\n" "(integer-length 0)\n" "   @result{} 0\n" "(integer-length #b1111)\n" "   @result{} 4\n" "@end lisp

(number->string n radix)
Return a string holding the external representation of the\n" "number N in the given RADIX.  If N is inexact, a radix of 10\n" "will be used.

(string->number string radix)
Returns a number of the maximally precise representation\n" "expressed by the given STRING. RADIX must be an exact integer,\n" "either 2, 8, 10, or 16. If supplied, RADIX is a default radix\n" "that may be overridden by an explicit radix prefix in STRING\n" "(e.g. \"#o177\"). If RADIX is not supplied, then the default\n" "radix is 10. If string is not a syntactically valid notation\n" "for a number, then `string->number' returns #f.  (r5rs)

(number?)
scm_number_p

(complex? x)
Return #t if X is a complex number, #f else.  Note that the\n" "sets of real, rational and integer values form subsets of the\n" "set of complex numbers, i. e. the predicate will also be\n" "fulfilled if X is a real, rational or integer number.

(real?)
scm_real_p

(rational? x)
Return #t if X is a rational number, #f else.  Note that the\n" "set of integer values forms a subset of the set of rational\n" "numbers, i. e. the predicate will also be fulfilled if X is an\n" "integer number.

(integer? x)
Return #t if X is an integer number, #f else.

(inexact? x)
Return #t if X is an inexact number, #f else.

(> x y)
Return #t if the list of parameters is monotonically\n" "increasing.

(<= x y)
Return #t if the list of parameters is monotonically\n" "non-decreasing.

(>= x y)
Return #t if the list of parameters is monotonically\n" "non-increasing.

($expt z1 z2)

($atan2 z1 z2)

(make-rectangular real imaginary)
Return a complex number constructed of the given REAL and\n" "IMAGINARY parts.

(make-polar z1 z2)
Return the complex number Z1 * e^(i * Z2).

(inexact->exact z)
Returns an exact number that is numerically closest to Z.

(entity? obj)

(operator? obj)

(set-object-procedure! obj proc)

(make-class-object metaclass layout)

(make-subclass-object class layout)

(object-properties obj)
@deffnx primitive procedure-properties obj\n" "Return @var{obj}'s property list.

(set-object-properties! obj plist)
@deffnx primitive set-procedure-properties! obj alist\n" "Set @var{obj}'s property list to @var{alist}.

(object-property obj key)
@deffnx primitive procedure-property obj key\n" "Return the property of @var{obj} with name @var{key}.

(set-object-property! obj key val)
@deffnx primitive set-procedure-property! obj key value\n" "In @var{obj}'s property list, set the property named @var{key} to\n" "@var{value}.

(cons x y)
Returns a newly allocated pair whose car is @var{x} and whose cdr is\n" "@var{y}.  The pair is guaranteed to be different (in the sense of\n" "@code{eqv?}) from every previously existing object.

(pair? x)
Returns @code{#t} if @var{x} is a pair; otherwise returns @code{#f}.

(set-car! pair value)
Stores @var{value} in the car field of @var{pair}.  The value returned\n" "by @code{set-car!} is unspecified.

(set-cdr! pair value)
Stores @var{value} in the cdr field of @var{pair}.  The value returned\n" "by @code{set-cdr!} is unspecified.

(char-ready? port)
Returns @code{#t} if a character is ready on input @var{port} and\n" "returns @code{#f} otherwise.  If @code{char-ready?} returns @code{#t}\n" "then the next @code{read-char} operation on @var{port} is\n" "guaranteed not to hang.  If @var{port} is a file port at end of\n" "file then @code{char-ready?} returns @code{#t}.\n" "@footnote{@code{char-ready?} exists to make it possible for a\n" "program to accept characters from interactive ports without getting\n" "stuck waiting for input.  Any input editors associated with such ports\n" "must make sure that characters whose existence has been asserted by\n" "@code{char-ready?} cannot be rubbed out.  If @code{char-ready?} were to\n" "return @code{#f} at end of file, a port at end of file would be\n" "indistinguishable from an interactive port that has no ready\n" "chara
# 243 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/ports.c"
{
scm_port *pt;
if (((((port)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
port = (scm_root->cur_inp);
else
do { if (!(((!(6 & (port))) && (((0x7f | (1L<<16) | (2L<<16)) & ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [0])==(125 | (1L<<16) | (2L<<16)))))) scm_wrong_type_arg_msg(s_scm_char_ready_p, 1, port, "OPINPORTP"); } while (0);
pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [1]);
if (pt->read_pos < pt->read_end
|| (pt->read_buf == pt->putback_buf
&& pt->saved_read_pos < pt->saved_read_end))
return ((scm_bits_t) (((17) << 9) + 0x174L));
else
{
scm_ptob_descriptor *ptob = &scm_ptobs[((0x0ff & ((((scm_bits_t *) ((SCM_CELLPTR) ((port)))) [0]) >> 8)))];
if (ptob->input_waiting)
return ((ptob->input_waiting (port)) ? ((scm_bits_t) (((17) << 9) + 0x174L)) : ((scm_bits_t) (((16) << 9) + 0x174L)));
else
return ((scm_bits_t) (((17) << 9) + 0x174L));
}
}

(drain-input port)
Drains @var{PORT}'s read buffers (including any pushed-back characters)\n" "and returns the contents as a single string.

(current-input-port)
Returns the current input port.  This is the default port used by many\n" "input procedures.  Initially, @code{current-input-port} returns the\n" "value of @code{???}.

(current-output-port)
Returns the current output port.  This is the default port used by many\n" "output procedures.  Initially, @code{current-output-port} returns the\n" "value of @code{???}.

(current-error-port)
Return the port to which errors and warnings should be sent (the\n" "@dfn{standard error} in Unix and C terminology).

(current-load-port)
Return the current-load-port.\n" "The load port is used internally by `primitive-load'.

(set-current-input-port port)
@deffnx primitive set-current-output-port port\n" "@deffnx primitive set-current-error-port port\n" "Change the ports returned by @code{current-input-port},\n" "@code{current-output-port} and @code{current-error-port}, respectively,\n" "so that they use the supplied @var{port} for input or output.

(set-current-output-port port)
Set the current default output port to PORT.

(set-current-error-port port)
Set the current default error port to PORT.

(port-revealed port)
Returns the revealed count for @var{port}.

(set-port-revealed! port rcount)
Sets the revealed count for a port to a given value.\n" "The return value is unspecified.

(port-mode port)
Returns the port modes associated with the open port @var{port}.  These\n" "will not necessarily be identical to the modes used when the port was\n" "opened, since modes such as \"append\" which are used only during\n" "port creation are not retained.

(close-port port)
Close the specified port object.  Returns @code{#t} if it successfully\n" "closes a port or @code{#f} if it was already\n" "closed.  An exception may be raised if an error occurs, for example\n" "when flushing buffered output.\n" "See also @ref{Ports and File Descriptors, close}, for a procedure\n" "which can close file descriptors.

(close-input-port port)
Close the specified input port object.  The routine has no effect if\n" "the file has already been closed.  An exception may be raised if an\n" "error occurs.  The value returned is unspecified.
 "See also @ref{Ports and File Descriptors, close}, for a procedure\n" "which can close file descriptors.

(close-output-port port)
Close the specified output port object.  The routine has no effect if\n" "the file has already been closed.  An exception may be raised if an\n" "error occurs.  The value returned is unspecified.
 "See also @ref{Ports and File Descriptors, close}, for a procedure\n" "which can close file descriptors.

(close-all-ports-except ports)
Close all open file ports used by the interpreter\n" "except for those supplied as arguments.  This procedure\n" "is intended to be used before an exec call to close file descriptors\n" "which are not needed in the new process.

(input-port? x)
Returns @code{#t} if @var{x} is an input port, otherwise returns\n" "@code{#f}.  Any object satisfying this predicate also satisfies\n" "@code{port?}.

(output-port? x)
Returns @code{#t} if @var{x} is an output port, otherwise returns\n" "@code{#f}.  Any object satisfying this predicate also satisfies\n" "@code{port?}.

(port-closed? port)
Returns @code{#t} if @var{port} is closed or @code{#f} if it is open.

(eof-object? x)
Returns @code{#t} if @var{x} is an end-of-file object; otherwise\n" "returns @code{#f}.

(force-output port)
Flush the specified output port, or the current output port if @var{port}\n" "is omitted.  The current output buffer contents are passed to the \n" "underlying port implementation (e.g., in the case of fports, the\n" "data will be written to the file and the output buffer will be cleared.)\n" "It has no effect on an unbuffered port.
 "The return value is unspecified.

(flush-all-ports)
Equivalent to calling @code{force-output} on\n" "all open output ports.  The return value is unspecified.

(read-char port)
Returns the next character available from @var{port}, updating\n" "@var{port} to point to the following character.  If no more\n" "characters are available, an end-of-file object is returned.

(peek-char port)
Returns the next character available from @var{port},\n" "@emph{without} updating @var{port} to point to the following\n" "character.  If no more characters are available, an end-of-file object\n" "is returned.@footnote{The value returned by a call to @code{peek-char}\n" "is the same as the value that would have been returned by a call to\n" "@code{read-char} on the same port.  The only difference is that the very\n" "next call to @code{read-char} or @code{peek-char} on that\n" "@var{port} will return the value returned by the preceding call to\n" "@code{peek-char}.  In particular, a call to @code{peek-char} on an\n" "interactive port will hang waiting for input whenever a call to\n" "@code{read-char} would have hung.}

(unread-char cobj port)
Place @var{char} in @var{port} so that it will be read by the\n" "next read operation.  If called multiple times, the unread characters\n" "will be read again in last-in first-out order.  If @var{port} is\n" "not supplied, the current input port is used.

(unread-string str port)
Place the string @var{str} in @var{port} so that its characters will be\n" "read in subsequent read operations.  If called multiple times, the\n" "unread characters will be read again in last-in first-out order.  If\n" "@var{port} is not supplied, the current-input-port is used.

(seek object offset whence)
Sets the current position of @var{fd/port} to the integer @var{offset},\n" "which is interpreted according to the value of @var{whence}.
 "One of the following variables should be supplied\n" "for @var{whence}:\n" "@defvar SEEK_SET\n" "Seek from the beginning of the file.\n" "@end defvar\n" "@defvar SEEK_CUR\n" "Seek from the current position.\n" "@end defvar\n" "@defvar SEEK_END\n" "Seek from the end of the file.\n" "@end defvar
 "If @var{fd/port} is a file descriptor, the underlying system call is\n" "@code{lseek}.  @var{port} may be a string port.
 "The value returned is the new position in the file.  This means that\n" "the current position of a port can be obtained using:\n" "@smalllisp\n" "(seek port 0 SEEK_CUR)\n" "@end smalllisp

(truncate-file object length)
Truncates the object referred to by @var{obj} to at most @var{size} bytes.\n" "@var{obj} can be a string containing a file name or an integer file\n" "descriptor or a port.  @var{size} may be omitted if @var{obj} is not\n" "a file name, in which case the truncation occurs at the current port.\n" "position.
 "The return value is unspecified.

(port-line port)
Return the current line number for PORT.

(set-port-line! port line)
Set the current line number for PORT to LINE.

(port-column port)
@deffnx primitive port-line [input-port]\n" "Return the current column number or line number of @var{input-port},\n" "using the current input port if none is specified.  If the number is\n" "unknown, the result is #f.  Otherwise, the result is a 0-origin integer\n" "- i.e. the first character of the first line is line 0, column 0.\n" "(However, when you display a file position, for example in an error\n" "message, we recommand you add 1 to get 1-origin integers.  This is\n" "because lines and column numbers traditionally start with 1, and that is\n" "what non-programmers will find most natural.)

(set-port-column! port column)
@deffnx primitive set-port-column! [input-port] column\n" "Set the current column or line number of @var{input-port}, using the\n" "current input port if none is specified.

(port-filename port)
Return the filename associated with @var{port}.  This function returns\n" "the strings \"standard input\", \"standard output\" and \"standard error\"" "when called on the current input, output and error ports respectively.

(set-port-filename! port filename)
Change the filename associated with @var{port}, using the current input\n" "port if none is specified.  Note that this does not change the port's\n" "source of data, but only the value that is returned by\n" "@code{port-filename} and reported in diagnostic output.

(%make-void-port mode)
Create and return a new void port.  A void port acts like\n" "/dev/null.  The @var{mode} argument\n" "specifies the input/output modes for this port: see the\n" "documentation for @code{open-file} in @ref{File Ports}.

(pipe)
Returns a newly created pipe: a pair of ports which are linked\n" "together on the local machine.  The CAR is the input port and\n" "the CDR is the output port.  Data written (and flushed) to the\n" "output port can be read from the input port.\n" "Pipes are commonly used for communication with a newly\n" "forked child process.  The need to flush the output port\n" "can be avoided by making it unbuffered using @code{setvbuf}.
 "Writes occur atomically provided the size of the data in\n" "bytes is not greater than the value of @code{PIPE_BUF}\n" "Note that the output port is likely to block if too much data\n" "(typically equal to @code{PIPE_BUF}) has been written but not\n" "yet read from the input port

(getgroups)
Returns a vector of integers representing the current supplimentary group IDs.

(getpw user)
Look up an entry in the user database.  @var{obj} can be an integer,\n" "a string, or omitted, giving the behaviour of getpwuid, getpwnam\n" "or getpwent respectively.

(setpw arg)
If called with a true argument, initialize or reset the password data\n" "stream.  Otherwise, close the stream.  The @code{setpwent} and\n" "@code{endpwent} procedures are implemented on top of this.

(getgr name)
Look up an entry in the group database.  @var{obj} can be an integer,\n" "a string, or omitted, giving the behaviour of getgrgid, getgrnam\n" "or getgrent respectively.

(setgr arg)
If called with a true argument, initialize or reset the group data\n" "stream.  Otherwise, close the stream.  The @code{setgrent} and\n" "@code{endgrent} procedures are implemented on top of this.

(kill pid sig)
Sends a signal to the specified process or group of processes.
 "@var{pid} specifies the processes to which the signal is sent:
 "@table @r\n" "@item @var{pid} greater than 0\n" "The process whose identifier is @var{pid}.\n" "@item @var{pid} equal to 0\n" "All processes in the current process group.\n" "@item @var{pid} less than -1\n" "The process group whose identifier is -@var{pid}\n" "@item @var{pid} equal to -1\n" "If the process is privileged, all processes except for some special\n" "system processes.  Otherwise, all processes with the current effective\n" "user ID.\n" "@end table
 "@var{sig} should be specified using a variable corresponding to\n" "the Unix symbolic name, e.g.,
 "@defvar SIGHUP\n" "Hang-up signal.\n" "@end defvar
 "@defvar SIGINT\n" "Interrupt signal.\n" "@end defvar

(waitpid pid options)
This procedure collects status information from a child process which\n" "has terminated or (optionally) stopped.  Normally it will\n" "suspend the calling process until this can be done.  If more than one\n" "child process is eligible then one will be chosen by the operating system.
 "The value of @var{pid} determines the behaviour:
 "@table @r\n" "@item @var{pid} greater than 0\n" "Request status information from the specified child process.\n" "@item @var{pid} equal to -1 or WAIT_ANY\n" "Request status information for any child process.\n" "@item @var{pid} equal to 0 or WAIT_MYPGRP\n" "Request status information for any child process in the current process\n" "group.\n" "@item @var{pid} less than -1\n" "Request status information for any child process whose process group ID\n" "is -@var{PID}.\n" "@end tab
# 444 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/posix.c"
{
int i;
int status;
int ioptions;
do { if (!((2 & (pid)))) scm_wrong_type_arg_msg(s_scm_waitpid, 1, pid, "INUMP"); } while (0);
if (((((options)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
ioptions = 0;
else
{
do { if (!((2 & (options)))) scm_wrong_type_arg_msg(s_scm_waitpid, 2, options, "INUMP"); } while (0);
ioptions = ((((options)) >> (2)));
}
i = waitpid (((((pid)) >> (2))), &status, ioptions);
if (i == -1)
do { scm_syserror (s_scm_waitpid); } while (0);
return scm_cons ((((scm_bits_t) (((0L + i) << 2) + 2L))), (((scm_bits_t) (((0L + status) << 2) + 2L))));
}

(status:exit-val status)
Returns the exit status value, as would be\n" "set if a process ended normally through a\n" "call to @code{exit} or @code{_exit}, if any, otherwise @code{#f}.

(status:term-sig status)
Returns the signal number which terminated the\n" "process, if any, otherwise @code{#f}.

(status:stop-sig status)
Returns the signal number which stopped the\n" "process, if any, otherwise @code{#f}.

(getppid)
Returns an integer representing the process ID of the parent process.

(getuid)
Returns an integer representing the current real user ID.

(getgid)
Returns an integer representing the current real group ID.

(geteuid)
Returns an integer representing the current effective user ID.\n" "If the system does not support effective IDs, then the real ID\n" "is returned.  @code{(feature? 'EIDs)} reports whether the system\n" "supports effective IDs.

(getegid)
Returns an integer representing the current effective group ID.\n" "If the system does not support effective IDs, then the real ID\n" "is returned.  @code{(feature? 'EIDs)} reports whether the system\n" "supports effective IDs.

(setuid id)
Sets both the real and effective user IDs to the integer @var{id}, provided\n" "the process has appropriate privileges.\n" "The return value is unspecified.

(setgid id)
Sets both the real and effective group IDs to the integer @var{id}, provided\n" "the process has appropriate privileges.\n" "The return value is unspecified.

(seteuid id)
Sets the effective user ID to the integer @var{id}, provided the process\n" "has appropriate privileges.  If effective IDs are not supported, the\n" "real ID is set instead -- @code{(feature? 'EIDs)} reports whether the\n" "system supports effective IDs.\n" "The return value is unspecified.

(setegid id)
Sets the effective group ID to the integer @var{id}, provided the process\n" "has appropriate privileges.  If effective IDs are not supported, the\n" "real ID is set instead -- @code{(feature? 'EIDs)} reports whether the\n" "system supports effective IDs.\n" "The return value is unspecified.

(getpgrp)
Returns an integer representing the current process group ID.\n" "This is the POSIX definition, not BSD.

(setpgid pid pgid)
Move the process @var{pid} into the process group @var{pgid}.  @var{pid} or\n" "@var{pgid} must be integers: they can be zero to indicate the ID of the\n" "current process.\n" "Fails on systems that do not support job control.\n" "The return value is unspecified.

(setsid)
Creates a new session.  The current process becomes the session leader\n" "and is put in a new process group.  The process will be detached\n" "from its controlling terminal if it has one.\n" "The return value is an integer representing the new process group ID.

(ttyname port)
Returns a string with the name of the serial terminal device underlying\n" "@var{port}.

(ctermid)
Returns a string containing the file name of the controlling terminal\n" "for the current process.

(tcgetpgrp port)
Returns the process group ID of the foreground\n" "process group associated with the terminal open on the file descriptor\n" "underlying @var{port}.
 "If there is no foreground process group, the return value is a\n" "number greater than 1 that does not match the process group ID\n" "of any existing process group.  This can happen if all of the\n" "processes in the job that was formerly the foreground job have\n" "terminated, and no other job has yet been moved into the\n" "foreground.

(tcsetpgrp port pgid)
Set the foreground process group ID for the terminal used by the file\n" "descriptor underlying @var{port} to the integer @var{pgid}.\n" "The calling process\n" "must be a member of the same session as @var{pgid} and must have the same\n" "controlling terminal.  The return value is unspecified.

(execl filename args)
Executes the file named by @var{path} as a new process image.\n" "The remaining arguments are supplied to the process; from a C program\n" "they are accessable as the @code{argv} argument to @code{main}.\n" "Conventionally the first @var{arg} is the same as @var{path}.\n" "All arguments must be strings.  
 "If @var{arg} is missing, @var{path} is executed with a null\n" "argument list, which may have system-dependent side-effects.
 "This procedure is currently implemented using the @code{execv} system\n" "call, but we call it @code{execl} because of its Scheme calling interface.

(execlp filename args)
Similar to @code{execl}, however if\n" "@var{filename} does not contain a slash\n" "then the file to execute will be located by searching the\n" "directories listed in the @code{PATH} environment variable.
 "This procedure is currently implemented using the @code{execvp} system\n" "call, but we call it @code{execlp} because of its Scheme calling interface.

(execle filename env args)
Similar to @code{execl}, but the environment of the new process is\n" "specified by @var{env}, which must be a list of strings as returned by the\n" "@code{environ} procedure.
 "This procedure is currently implemented using the @code{execve} system\n" "call, but we call it @code{execle} because of its Scheme calling interface.

(primitive-fork)
Creates a new \"child\" process by duplicating the current \"parent\" process.\n" "In the child the return value is 0.  In the parent the return value is\n" "the integer process ID of the child.
 "This procedure has been renamed from @code{fork} to avoid a naming conflict\n" "with the scsh fork.

(uname)
Returns an object with some information about the computer system the\n" "program is running on.

(environ env)
If @var{env} is omitted, returns the current environment as a list of strings.\n" "Otherwise it sets the current environment, which is also the\n" "default environment for child processes, to the supplied list of strings.\n" "Each member of @var{env} should be of the form\n" "@code{NAME=VALUE} and values of @code{NAME} should not be duplicated.\n" "If @var{env} is supplied then the return value is unspecified.

(tmpnam)
Create a new file in the file system with a unique name.  The return\n" "value is the name of the new file.  This function is implemented with\n" "the @code{tmpnam} function in the system libraries.

(utime pathname actime modtime)
@code{utime} sets the access and modification times for\n" "the file named by @var{path}.  If @var{actime} or @var{modtime}\n" "is not supplied, then the current time is used.\n" "@var{actime} and @var{modtime}\n" "must be integer time values as returned by the @code{current-time}\n" "procedure.
 "E.g.,
 "@smalllisp\n" "(utime \"foo\" (- (current-time) 3600))\n" "@end smalllisp
 "will set the access time to one hour in the past and the modification\n" "time to the current time.

(access? path how)
Returns @code{#t} if @var{path} corresponds to an existing\n" "file and the current process\n" "has the type of access specified by @var{how}, otherwise \n" "@code{#f}.\n" "@var{how} should be specified\n" "using the values of the variables listed below.  Multiple values can\n" "be combined using a bitwise or, in which case @code{#t} will only\n" "be returned if all accesses are granted.
 "Permissions are checked using the real id of the current process,\n" "not the effective id, although it's the effective id which determines\n" "whether the access would actually be granted.
 "@defvar R_OK\n" "test for read permission.\n" "@end defvar\n" "@defvar W_OK\n" "test for write permission.\n" "@end defvar\n" "@defvar X_OK\n" "test for execute permission.\n" "@end defvar\n" "@defvar F_OK\n" "test for existence of the fi
# 1100 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/posix.c"
{
int rv;
do { if (!(((!(6 & (path))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [0]) == 5))))) scm_wrong_type_arg_msg(s_scm_access, 1, path, "ROSTRINGP"); } while (0);
if (((!(6 & (path))) && ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [0]) == 23)))
path = scm_makfromstr (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [1])))), (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [0]) >> 8), 0);
do { if (!((2 & (how)))) scm_wrong_type_arg_msg(s_scm_access, 2, how, "INUMP"); } while (0);
rv = access (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((path)))) [1])))), ((((how)) >> (2))));
return ((rv) ? ((scm_bits_t) (((16) << 9) + 0x174L)) : ((scm_bits_t) (((17) << 9) + 0x174L)));
}

(getpid)
Returns an integer representing the current process ID.

(putenv str)
Modifies the environment of the current process, which is\n" "also the default environment inherited by child processes.
 "If @var{string} is of the form @code{NAME=VALUE} then it will be written\n" "directly into the environment, replacing any existing environment string\n" "with\n" "name matching @code{NAME}.  If @var{string} does not contain an equal\n" "sign, then any existing string with name matching @var{string} will\n" "be removed.
 "The return value is unspecified.

(setlocale category locale)
If @var{locale} is omitted, returns the current value of the specified\n" "locale category \n" "as a system-dependent string.\n" "@var{category} should be specified using the values @code{LC_COLLATE},\n" "@code{LC_ALL} etc.
 "Otherwise the specified locale category is set to\n" "the string @var{locale}\n" "and the new value is returned as a system-dependent string.  If @var{locale}\n" "is an empty string, the locale will be set using envirionment variables.

(mknod path type perms dev)
Creates a new special file, such as a file corresponding to a device.\n" "@var{path} specifies the name of the file.  @var{type} should\n" "be one of the following symbols:\n" "regular, directory, symlink, block-special, char-special,\n" "fifo, or socket.  @var{perms} (an integer) specifies the file permissions.\n" "@var{dev} (an integer) specifies which device the special file refers\n" "to.  Its exact interpretation depends on the kind of special file\n" "being created.
 "E.g.,\n" "@example\n" "(mknod \"/dev/fd0\" 'block-special #o660 (+ (* 2 256) 2))" "@end example\n" "The return value is unspecified.

(nice incr)
Increment the priority of the current process by @var{incr}.  A higher\n" "priority value means that the process runs less often.\n" "The return value is unspecified.

(sync)
Flush the operating system disk buffers.\n" "The return value is unspecified.

(print-options-interface setting)

(simple-format destination message args)
Write MESSAGE to DESTINATION, defaulting to `current-output-port'.\n" "MESSAGE can contain ~A (was %s) and ~S (was %S) escapes.  When printed,\n" "the escapes are replaced with corresponding members of ARGS:\n" "~A formats using `display' and ~S formats using `write'.\n" "If DESTINATION is #t, then use the `current-output-port',\n" "if DESTINATION is #f, then return a string containing the formatted text.\n" "Does not add a trailing newline.

(newline port)
Send a newline to PORT.

(write-char chr port)
Send character CHR to PORT.

(port-with-print-state port pstate)

(get-print-state port)

(procedure-properties proc)
Return @var{obj}'s property list.

(set-procedure-properties! proc new_val)
Set @var{obj}'s property list to @var{alist}.

(procedure-property p k)
Return the property of @var{obj} with name @var{key}.

(set-procedure-property! p k v)
In @var{obj}'s property list, set the property named @var{key} to\n" "@var{value}.

(procedure? obj)

(closure? obj)

(thunk? obj)

(procedure-documentation proc)
Return the documentation string associated with @code{proc}.  By\n" "convention, if a procedure contains more than one expression and the\n" "first expression is a string constant, that string is assumed to contain\n" "documentation for that procedure.

(procedure-with-setter? obj)

(make-procedure-with-setter procedure setter)

(procedure proc)

(array-fill! ra fill)
Stores @var{fill} in every element of @var{array}.  The value returned\n" "is unspecified.

(array-copy-in-order!)
scm_array_copy_x

(array-copy! src dst)
Copies every element from vector or array @var{source} to the\n" "corresponding element of @var{destination}.  @var{destination} must have\n" "the same rank as @var{source}, and be at least as large in each\n" "dimension.  The order is unspecified.

(array-map-in-order!)
scm_array_map_x

(array-map! ra0 proc lra)
@var{array1}, @dots{} must have the same number of dimensions as\n" "@var{array0} and have a range for each index which includes the range\n" "for the corresponding index in @var{array0}.  @var{proc} is applied to\n" "each tuple of elements of @var{array1} @dots{} and the result is stored\n" "as the corresponding element in @var{array0}.  The value returned is\n" "unspecified.  The order of application is unspecified.

(array-for-each proc ra0 lra)
@var{proc} is applied to each tuple of elements of @var{array0} @dots{}\n" "in row-major order.  The value returned is unspecified.

(array-index-map! ra proc)
applies @var{proc} to the indices of each element of @var{array} in\n" "turn, storing the result in the corresponding element.  The value\n" "returned and the order of application are unspecified.
 "One can implement @var{array-indexes} as\n" "@example\n" "(define (array-indexes array)\n" "    (let ((ra (apply make-array #f (array-shape array))))\n" "      (array-index-map! ra (lambda x x))\n" "      ra))\n" "@end example\n" "Another example:\n" "@example\n" "(define (apl:index-generator n)\n" "    (let ((v (make-uniform-vector n 1)))\n" "      (array-index-map! v (lambda (i) i))\n" "      v))\n" "@end example

(random n state)
Return a number in [0,N).\n" "\n" "Accepts a positive integer or real n and returns a \n" "number of the same type between zero (inclusive) and \n" "N (exclusive). The values returned have a uniform \n" "distribution.\n" "\n" "The optional argument STATE must be of the type produced by\n" "`seed->random-state'. It defaults to the value of the variable\n" "*random-state*. This object is used to maintain the state of\n" "the pseudo-random-number generator and is altered as a side\n" "effect of the random operation.\n" "

(copy-random-state state)
Return a copy of the random state STATE.

(seed->random-state seed)
Return a new random state using SEED.

(random:uniform state)
Returns a uniformly distributed inexact real random number in [0,1).

(random:normal state)
Returns an inexact real in a normal distribution.\n" "The distribution used has mean 0 and standard deviation 1.\n" "For a normal distribution with mean m and standard deviation\n" "d use @code{(+ m (* d (random:normal)))}.\n" "

(random:solid-sphere! v state)
Fills vect with inexact real random numbers\n" "the sum of whose squares is less than 1.0.\n" "Thinking of vect as coordinates in space of \n" "dimension n = (vector-length vect), the coordinates \n" "are uniformly distributed within the unit n-shere.\n" "The sum of the squares of the numbers is returned.\n" "

(random:hollow-sphere! v state)
Fills vect with inexact real random numbers\n" "the sum of whose squares is equal to 1.0.\n" "Thinking of vect as coordinates in space of \n" "dimension n = (vector-length vect), the coordinates\n" "are uniformly distributed over the surface of the \n" "unit n-shere.\n" "

(random:normal-vector! v state)
Fills vect with inexact real random numbers that are\n" "independent and standard normally distributed\n" "(i.e., with mean 0 and variance 1).\n" "

(random:exp state)
Returns an inexact real in an exponential distribution with mean 1.\n" "For an exponential distribution with mean u use (* u (random:exp)).\n" "

(read-options-interface setting)

(read port)

(read-hash-extend chr proc)

(regexp? x)
Return @code{#t} if @var{obj} is a compiled regular expression, or\n" "@code{#f} otherwise.

(make-regexp pat flags)
Compile the regular expression described by @var{str}, and return the\n" "compiled regexp structure.  If @var{str} does not describe a legal\n" "regular expression, @code{make-regexp} throws a\n" "@code{regular-expression-syntax} error.
 "The @var{flag} arguments change the behavior of the compiled regexp.\n" "The following flags may be supplied:
 "@table @code\n" "@item regexp/icase\n" "Consider uppercase and lowercase letters to be the same when matching.
 "@item regexp/newline\n" "If a newline appears in the target string, then permit the @samp{^} and\n" "@samp{$} operators to match immediately after or immediately before the\n" "newline, respectively.  Also, the @samp{.} and @samp{[^...]} operators\n" "will never match a newline character.  The intent of this flag is to\n" "treat the
# 182 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/regex-posix.c"
{
SCM flag;
regex_t *rx;
int status, cflags;
do { if (!(((!(6 & (pat))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [0]) == 5))))) scm_wrong_type_arg_msg(s_scm_make_regexp, 1, pat, "ROSTRINGP"); } while (0);
do { if (0) { if (scm_ilength (flags) < 0) { do { scm_misc_error (s_scm_make_regexp, "Rest arguments do not form a proper list.", ((scm_bits_t) (((20) << 9) + 0x174L))); } while (0); } } } while (0);
{ if (((!(6 & (pat))) && ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [0]) == 23))) pat = scm_makfromstr (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [1])))), (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [0]) >> 8), 0); };
cflags = 0001;
flag = flags;
while (!((((flag)) == (((scm_bits_t) (((20) << 9) + 0x174L))))))
{
if ((((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((flag)))) [0]))))) >> (2))) == 0000)
cflags &= ~0001;
else
cflags |= (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((flag)))) [0]))))) >> (2)));
flag = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((flag)))) [1])));
}
rx = ((regex_t *) scm_must_malloc (sizeof (regex_t), s_scm_make_regexp));
status = regcomp (rx, ((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((pat)))) [1])))),
cflags & ~0004);
if (status != 0)
{
scm_error (scm_regexp_error_key,
s_scm_make_regexp,
scm_regexp_error_msg (status, rx),
((scm_bits_t) (((16) << 9) + 0x174L)),
((scm_bits_t) (((16) << 9) + 0x174L)));
}
do { SCM __SCM_smob_answer; do { do { if ((6 & (scm_freelist))) __SCM_smob_answer = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist); else { __SCM_smob_answer = scm_freelist; scm_freelist = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((scm_freelist)))) [1]))); ((scm_bits_t *) ((SCM_CELLPTR) ((__SCM_smob_answer)))) [0] = (scm_bits_t) (0x047f); } } while(0); ((scm_bits_t *) ((SCM_CELLPTR) (((__SCM_smob_answer))))) [1] = (scm_bits_t) (((rx))); ((scm_bits_t *) ((SCM_CELLPTR) (((__SCM_smob_answer))))) [0] = (scm_bits_t) (((scm_tc16_regex))); } while (0); return __SCM_smob_answer; } while (0);
}

(regexp-exec rx str start flags)
Match the compiled regular expression @var{regexp} against @code{str}.\n" "If the optional integer @var{start} argument is provided, begin matching\n" "from that position in the string.  Return a match structure describing\n" "the results of the match, or @code{#f} if no match could be found.

(call-with-dynamic-root thunk handler)
Evaluate @var{(thunk)} in a new dynamic context, returning its value.
 "If an error occurs during evaluation, apply @var{handler} to the\n" "arguments to the throw, just as @code{throw} would.  If this happens,\n" "@var{handler} is called outside the scope of the new root -- it is\n" "called in the same dynamic context in which\n" "@code{call-with-dynamic-root} was evaluated.
 "If @var{thunk} captures a continuation, the continuation is rooted at\n" "the call to @var{thunk}.  In particular, the call to\n" "@code{call-with-dynamic-root} is not captured.  Therefore,\n" "@code{call-with-dynamic-root} always returns at most one time.
 "Before calling @var{thunk}, the dynamic-wind chain is un-wound back to\n" "the root and a new chain started for @var{thunk}.  The
# 377 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/root.c"
{
SCM_STACKITEM stack_place;
return cwdr (thunk, ((scm_bits_t) (((20) << 9) + 0x174L)), ((scm_bits_t) (((20) << 9) + 0x174L)), handler, &stack_place);
}

(dynamic-root)
Return an object representing the current dynamic root.
 "These objects are only useful for comparison using @code{eq?}.\n" "They are currently represented as numbers, but your code should\n" "in no way depend on this.

(sigaction signum handler flags)
Install or report the signal handler for a specified signal.
 "@var{signum} is the signal number, which can be specified using the value\n" "of variables such as @code{SIGINT}.
 "If @var{action} is omitted, @code{sigaction} returns a pair: the\n" "CAR is the current\n" "signal hander, which will be either an integer with the value @code{SIG_DFL}\n" "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n" "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n" "signal.  The CDR contains the current @code{sigaction} flags for the handler.
 "If @var{action} is provided, it is installed as the new handler for\n" "@var{signum}.  @var{action} can be a Scheme procedure taking one\n" "argument, or the value of @code{SIG_DFL} (default action) or\n" "@
# 202 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/scmsigs.c"
{
int csig;
struct sigaction action;
struct sigaction old_action;
int query_only = 0;
int save_handler = 0;
SCM *scheme_handlers = ((SCM *) ((scm_bits_t *) ((SCM_CELLPTR) ((*signal_handlers)))) [1]);
SCM old_handler;
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(signum,1,216); csig = ((((signum)) >> (2))); } while (0);
action.sa_flags = 0x0002;
if (!((((flags)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
{
do { if (!((2 & (flags)))) scm_wrong_type_arg_msg(s_scm_sigaction, 3, flags, "INUMP"); } while (0);
action.sa_flags |= ((((flags)) >> (2)));
}
(*(&action.sa_mask) = 0, 0);
do { asm (""); ; ; asm (""); scm_ints_disabled = 1; asm (""); } while (0);
old_handler = scheme_handlers[csig];
if (((((handler)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
query_only = 1;
else if (((scm_integer_p (handler)) == (((scm_bits_t) (((17) << 9) + 0x174L)))))
{
if ((scm_num2long (handler, (char *) 2, s_scm_sigaction)) == (long) (void (*)(int))0
|| (scm_num2long (handler, (char *) 2, s_scm_sigaction)) == (long) (void (*)(int))1)
{
action.__sigaction_u.__sa_handler = (void (*) (int)) ((((handler)) >> (2)));
scheme_handlers[csig] = ((scm_bits_t) (((16) << 9) + 0x174L));
}
else
do { scm_out_of_range_pos (s_scm_sigaction, handler, (((scm_bits_t) (((2) << 2) + 2L)))); } while (0);
}
else if (((((handler)) == (((scm_bits_t) (((16) << 9) + 0x174L))))))
{
if (orig_handlers[csig].__sigaction_u.__sa_handler == (void (*)(int))-1)
query_only = 1;
else
{
action = orig_handlers[csig];
orig_handlers[csig].__sigaction_u.__sa_handler = (void (*)(int))-1;
scheme_handlers[csig] = ((scm_bits_t) (((16) << 9) + 0x174L));
}
# 274 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/scmsigs.c"
}
else
{
do { if (!((!(6 & (handler))))) scm_wrong_type_arg_msg(s_scm_sigaction, 2, handler, "NIMP"); } while (0);
action.__sigaction_u.__sa_handler = take_signal;
if (orig_handlers[csig].__sigaction_u.__sa_handler == (void (*)(int))-1)
save_handler = 1;
scheme_handlers[csig] = handler;
}
switch (csig)
{
case 8:
case 4:
case 11:
case 10:
case 6:
case 5:
case 7:
case 12:
query_only = 1;
}
if (query_only)
{
if (sigaction (csig, 0, &old_action) == -1)
do { scm_syserror (s_scm_sigaction); } while (0);
}
else
{
if (sigaction (csig, &action , &old_action) == -1)
do { scm_syserror (s_scm_sigaction); } while (0);
if (save_handler)
orig_handlers[csig] = old_action;
}
if (old_action.__sigaction_u.__sa_handler == (void (*)(int))0 || old_action.__sigaction_u.__sa_handler == (void (*)(int))1)
old_handler = scm_long2num ((long) old_action.__sigaction_u.__sa_handler);
do { asm (""); ; ; asm (""); scm_ints_disabled = 0; asm (""); ; asm (""); } while (0);
return scm_cons (old_handler, (((scm_bits_t) (((old_action.sa_flags) << 2) + 2L))));
# 353 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/scmsigs.c"
}

(restore-signals)
Return all signal handlers to the values they had before any call to\n" "@code{sigaction} was made.  The return value is unspecified.

(alarm i)
Set a timer to raise a @code{SIGALRM} signal after the specified\n" "number of seconds (an integer).  It's advisable to install a signal\n" "handler for\n" "@code{SIGALRM} beforehand, since the default action is to terminate\n" "the process.
 "The return value indicates the time remaining for the previous alarm,\n" "if any.  The new value replaces the previous alarm.  If there was\n" "no previous alarm, the return value is zero.

(pause)
Pause the current process (thread?) until a signal arrives whose\n" "action is to either terminate the current process or invoke a\n" "handler procedure.  The return value is unspecified.

(sleep i)
Wait for the given number of seconds (an integer) or until a signal\n" "arrives.  The return value is zero if the time elapses or the number\n" "of seconds remaining otherwise.

(usleep i)
Sleep for I microseconds.\n" "`usleep' is not available on all platforms.

(raise sig)
\n" "Sends a specified signal @var{sig} to the current process, where\n" "@var{sig} is as described for the kill procedure.

(system cmd)
Executes @var{cmd} using the operating system's \"command processor\".\n" "Under Unix this is usually the default shell @code{sh}.  The value\n" "returned is @var{cmd}'s exit status as returned by @code{waitpid}, which\n" "can be interpreted using the functions above.
 "If @code{system} is called without arguments, it returns a boolean\n" "indicating whether the command processor is available.

(getenv nam)
Looks up the string @var{name} in the current environment.  The return\n" "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n" "found, in which case the string @code{VALUE} is\n" "returned.

(primitive-exit status)
Terminate the current process without unwinding the Scheme stack.\n" "This is would typically be useful after a fork.  The exit status\n" "is @var{status} if supplied, otherwise zero.

(htons in)
Returns a new integer from @var{value} by converting from host to\n" "network order. @var{value} must be within the range of a C unsigned\n" "short integer.

(ntohs in)
Returns a new integer from @var{value} by converting from network to\n" "host order.  @var{value} must be within the range of a C unsigned short\n" "integer.

(htonl in)
Returns a new integer from @var{value} by converting from host to\n" "network order. @var{value} must be within the range of a C unsigned\n" "long integer.

(ntohl in)
Returns a new integer from @var{value} by converting from network to\n" "host order. @var{value} must be within the range of a C unsigned\n" "long integer.

(socket family style proto)
Returns a new socket port of the type specified by @var{family}, @var{style}\n" "and @var{protocol}.  All three parameters are integers.  Typical values\n" "for @var{family} are the values of @code{AF_UNIX}\n" "and @code{AF_INET}.  Typical values for @var{style} are\n" "the values of @code{SOCK_STREAM}, @code{SOCK_DGRAM} and @code{SOCK_RAW}.
 "@var{protocol} can be obtained from a protocol name using\n" "@code{getprotobyname}.  A value of\n" "zero specifies the default protocol, which is usually right.
 "A single socket port cannot by used for communication until\n" "it has been connected to another socket.

(socketpair family style proto)
Returns a pair of connected (but unnamed) socket ports of the type specified\n" "by @var{family}, @var{style} and @var{protocol}.\n" "Many systems support only\n" "socket pairs of the @code{AF_UNIX} family.  Zero is likely to be\n" "the only meaningful value for @var{protocol}.

(getsockopt sock level optname)
Returns the value of a particular socket option for the socket\n" "port @var{socket}.  @var{level} is an integer code for type of option\n" "being requested, e.g., @code{SOL_SOCKET} for socket-level options.\n" "@var{optname} is an\n" "integer code for the option required and should be specified using one of\n" "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.
 "The returned value is typically an integer but @code{SO_LINGER} returns a\n" "pair of integers.

(setsockopt sock level optname value)
Sets the value of a particular socket option for the socket\n" "port @var{socket}.  @var{level} is an integer code for type of option\n" "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n" "@var{optname} is an\n" "integer code for the option to set and should be specified using one of\n" "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n" "@var{value} is the value to which the option should be set.  For\n" "most options this must be an integer, but for @code{SO_LINGER} it must\n" "be a pair.
 "The return value is unspecified.

(shutdown sock how)
Sockets can be closed simply by using @code{close-port}. The\n" "@code{shutdown} procedure allows reception or tranmission on a\n" "connection to be shut down individually, according to the parameter\n" "@var{how}:
 "@table @asis\n" "@item 0\n" "Stop receiving data for this socket.  If further data arrives,  reject it.\n" "@item 1\n" "Stop trying to transmit data from this socket.  Discard any\n" "data waiting to be sent.  Stop looking for acknowledgement of\n" "data already sent; don't retransmit it if it is lost.\n" "@item 2\n" "Stop both reception and transmission.\n" "@end table
 "The return value is unspecified.

(connect sock fam address args)
Initiates a connection from @var{socket} to the address\n" "specified by @var{address} and possibly @var{arg @dots{}}.  The format\n" "required for @var{address}\n" "and @var{arg} @dots{} depends on the family of the socket.
 "For a socket of family @code{AF_UNIX},\n" "only @code{address} is specified and must be a string with the\n" "filename where the socket is to be created.
 "For a socket of family @code{AF_INET},\n" "@code{address} must be an integer Internet host address and @var{arg} @dots{}\n" "must be a single integer port number.
 "The return value is unspecified.

(bind sock fam address args)
Assigns an address to the socket port @var{socket}.\n" "Generally this only needs to be done for server sockets,\n" "so they know where to look for incoming connections.  A socket\n" "without an address will be assigned one automatically when it\n" "starts communicating.
 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n" "of the socket.
 "For a socket of family @code{AF_UNIX}, only @var{address}\n" "is specified and must \n" "be a string with the filename where the socket is to be created.
 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n" "Internet host address and @var{arg} @dots{} must be a single integer\n" "port number.
 "The values of the following variables can also be used for @var{address}:
 "@defvar INADDR_ANY\n" "Allow con
# 507 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/socket.c"
{
int rv;
struct sockaddr *soka;
size_t size;
int fd;
sock = ((!(6 & (sock))) && ((!(6 & (sock))) && ((0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((sock)))) [0]) == scm_tc16_port_with_ps)) ? (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((sock)))) [1]))))))) [0]))) : sock);
do { if (!((!(6 & (sock)) && (((0xfeff | (1L<<16)) & ((scm_bits_t *) ((SCM_CELLPTR) ((sock)))) [0]) == (125 | (1L<<16)))))) scm_wrong_type_arg_msg(s_scm_bind, 1, sock, "OPFPORTP"); } while (0);
do { if (!((2 & (fam)))) scm_wrong_type_arg_msg(s_scm_bind, 2, fam, "INUMP"); } while (0);
soka = scm_fill_sockaddr (((((fam)) >> (2))), address, &args, 3, s_scm_bind, &size);
fd = (((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((sock)))) [1])->stream))->fdes);
rv = bind (fd, soka, size);
if (rv == -1)
do { scm_syserror (s_scm_bind); } while (0);
scm_must_free ((char *) soka);
return ((scm_bits_t) (((21) << 9) + 0x174L));
}

(listen sock backlog)
This procedure enables @var{socket} to accept connection\n" "requests.  @var{backlog} is an integer specifying\n" "the maximum length of the queue for pending connections.\n" "If the queue fills, new clients will fail to connect until the\n" "server calls @code{accept} to accept a connection from the queue.
 "The return value is unspecified.

(accept sock)
Accepts a connection on a bound, listening socket @var{socket}.  If there\n" "are no pending connections in the queue, it waits until\n" "one is available unless the non-blocking option has been set on the\n" "socket.
 "The return value is a\n" "pair in which the CAR is a new socket port for the connection and\n" "the CDR is an object with address information about the client which\n" "initiated the connection.
 "If the address is not available then the CDR will be an empty vector.
 "@var{socket} does not become part of the\n" "connection and will continue to accept new requests.

(getsockname sock)
Returns the address of @var{socket}, in the same form as the object\n" "returned by @code{accept}.  On many systems the address of a socket\n" "in the @code{AF_FILE} namespace cannot be read.

(getpeername sock)
Returns the address of the socket that the socket @var{socket} is connected to,\n" "in the same form as the object\n" "returned by @code{accept}.  On many systems the address of a socket\n" "in the @code{AF_FILE} namespace cannot be read.

(recv! sock buf flags)
Receives data from the socket port @var{socket}.  @var{socket} must already\n" "be bound to the address from which data is to be received.\n" "@var{buf} is a string into which\n" "the data will be written.  The size of @var{buf} limits the amount of\n" "data which can be received: in the case of packet\n" "protocols, if a packet larger than this limit is encountered then some data\n" "will be irrevocably lost.
 "The optional @var{flags} argument is a value or\n" "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.
 "The value returned is the number of bytes read from the socket.
 "Note that the data is read directly from the socket file descriptor:any unread buffered port data is ignored.

(send sock message flags)
Transmits the string @var{message} on the socket port @var{socket}. \n" "@var{socket} must already be bound to a destination address.  The\n" "value returned is the number of bytes transmitted -- it's possible for\n" "this to be less than the length of @var{message} if the socket is\n" "set to be non-blocking.  The optional @var{flags} argument is a value or\n" "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.
 "Note that the data is written directly to the socket file descriptor:\n" "any unflushed buffered port data is ignored.

(recvfrom! sock buf flags start end)
Returns data from the socket port @var{socket} and also information about\n" "where the data was received from.  @var{socket} must already\n" "be bound to the address from which data is to be received.\n" "@code{buf}, is a string into which\n" "the data will be written.  The size of @var{buf} limits the amount of\n" "data which can be received: in the case of packet\n" "protocols, if a packet larger than this limit is encountered then some data\n" "will be irrevocably lost.
 "The optional @var{flags} argument is a value or\n" "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.
 "The value returned is a pair: the CAR is the number of bytes read from\n" "the socket and the CDR an address object in the same form as returned by\n" "@code{accept}.
 "The @var{start} and @var{e
# 768 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/socket.c"
{
int rv;
int fd;
int flg;
int offset = 0;
int cend;
size_t tmp_size;
SCM address;
do { if (!((!(6 & (sock)) && (((0xfeff | (1L<<16)) & ((scm_bits_t *) ((SCM_CELLPTR) ((sock)))) [0]) == (125 | (1L<<16)))))) scm_wrong_type_arg_msg(s_scm_recvfrom, 1, sock, "OPFPORTP"); } while (0);
do { if (!(((!(6 & (buf))) && (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((buf)))) [0]) == 21)))) scm_wrong_type_arg_msg(s_scm_recvfrom, 2, buf, "STRINGP"); } while (0);
cend = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((buf)))) [0]) >> 8);
if (((((flags)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
flg = 0;
else
{
flg = (scm_num2ulong (flags, (char *) 3, s_scm_recvfrom));
if (!((((start)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
{
offset = (int) (scm_num2long (start, (char *) 4, s_scm_recvfrom));
if (offset < 0 || offset >= cend)
do { scm_out_of_range_pos (s_scm_recvfrom, start, (((scm_bits_t) (((4) << 2) + 2L)))); } while (0);
if (!((((end)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
{
int tend = (int) (scm_num2long (end, (char *) 5, s_scm_recvfrom));
if (tend <= offset || tend > cend)
do { scm_out_of_range_pos (s_scm_recvfrom, end, (((scm_bits_t) (((5) << 2) + 2L)))); } while (0);
cend = tend;
}
}
}
fd = (((struct scm_fport *) (((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((sock)))) [1])->stream))->fdes);
tmp_size = scm_addr_buffer_size;
rv = recvfrom (fd, ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((buf)))) [1])) + offset, cend - offset, flg, (struct sockaddr *) scm_addr_buffer, &tmp_size);
if (rv == -1)
do { scm_syserror (s_scm_recvfrom); } while (0);
if (tmp_size > 0)
address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_scm_recvfrom);
else
address = ((scm_bits_t) (((16) << 9) + 0x174L));
return scm_cons ((((scm_bits_t) (((rv) << 2) + 2L))), address);
}

(sendto sock message fam address args_and_flags)
Transmits the string @var{message} on the socket port @var{socket}.  The\n" "destination address is specified using the @var{family}, @var{address} and\n" "@var{arg} arguments, in a similar way to the @code{connect}\n" "procedure.  The\n" "value returned is the number of bytes transmitted -- it's possible for\n" "this to be less than the length of @var{message} if the socket is\n" "set to be non-blocking.  The optional @var{flags} argument is a value or\n" "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.
 "Note that the data is written directly to the socket file descriptor:\n" "any unflushed buffered port data is ignored.

(restricted-vector-sort! vec less startpos endpos)

(sorted? items less)

(merge alist blist less)

(merge! alist blist less)

(sort! items less)

(sort items less)

(stable-sort! items less)

(stable-sort items less)

(sort-list! items less)

(sort-list items less)

(source-properties obj)

(set-source-properties! obj plist)

(source-property obj key)

(set-source-property! obj key datum)

(stack? obj)
Return @code{#t} if @var{obj} is a calling stack.

(make-stack obj args)

(stack-id stack)
Return the identifier given to @var{stack} by @code{start-stack}.

(stack-ref stack i)

(stack-length stack)

(frame? obj)

(last-stack-frame obj)

(frame-number frame)

(frame-source frame)

(frame-procedure frame)

(frame-arguments frame)

(frame-previous frame)

(frame-next frame)

(frame-real? frame)

(frame-procedure? frame)

(frame-evaluating-args? frame)

(frame-overflow? frame)

(get-internal-real-time)
Returns the number of time units since the interpreter was started.

(times)
Returns an object with information about real and processor time.\n" "The following procedures accept such an object as an argument and\n" "return a selected component:
 "@table @code\n" "@item tms:clock\n" "The current real time, expressed as time units relative to an\n" "arbitrary base.\n" "@item tms:utime\n" "The CPU time units used by the calling process.\n" "@item tms:stime\n" "The CPU time units used by the system on behalf of the calling process.\n" "@item tms:cutime\n" "The CPU time units used by terminated child processes of the calling\n" "process, whose status has been collected (e.g., using @code{waitpid}).\n" "@item tms:cstime\n" "Similarly, the CPU times units used by the system on behalf of \n" "terminated child processes.\n" "@end table

(get-internal-run-time)
Returns the number of time units of processor time used by the interpreter.\n" "Both \"system\" and \"user\" time are included but subprocesses are not.

(current-time)
Returns the number of seconds since 1970-01-01 00:00:00 UTC, excludingleap seconds.

(gettimeofday)
Returns a pair containing the number of seconds and microseconds since\n" "1970-01-01 00:00:00 UTC, excluding leap seconds.  Note: whether true\n" "microsecond resolution is available depends on the operating system.

(localtime time zone)
Returns an object representing the broken down components of @var{time},\n" "an integer like the one returned by @code{current-time}.  The time zone\n" "for the calculation is optionally specified by @var{zone} (a string),\n" "otherwise the @code{TZ} environment variable or the system default is\n" "used.

(gmtime time)
Returns an object representing the broken down components of @var{time},\n" "an integer like the one returned by @code{current-time}.  The values\n" "are calculated for UTC.

(mktime sbd_time zone)
@var{bd-time} is an object representing broken down time and @code{zone}\n" "is an optional time zone specifier (otherwise the TZ environment variable\n" "or the system default is used).
 "Returns a pair: the CAR is a corresponding\n" "integer time value like that returned\n" "by @code{current-time}; the CDR is a broken down time object, similar to\n" "as @var{bd-time} but with normalized values.

(tzset)
Initialize the timezone from the TZ environment variable\n" "or the system default.  It's not usually necessary to call this procedure\n" "since it's done automatically by other procedures that depend on the\n" "timezone.

(strftime format stime)
Formats a time specification @var{time} using @var{template}.  @var{time}\n" "is an object with time components in the form returned by @code{localtime}\n" "or @code{gmtime}.  @var{template} is a string which can include formatting\n" "specifications introduced by a @code{%} character.  The formatting of\n" "month and day names is dependent on the current locale.  The value returned\n" "is the formatted string.\n" "@xref{Formatting Date and Time, , , libc, The GNU C Library Reference Manual}.)

(strptime format string)
Performs the reverse action to @code{strftime}, parsing @var{string}\n" "according to the specification supplied in @var{template}.  The\n" "interpretation of month and day names is dependent on the current\n" "locale.  The\n" "value returned is a pair.  The CAR has an object with time components \n" "in the form returned by @code{localtime} or @code{gmtime},\n" "but the time zone components\n" "are not usefully set.\n" "The CDR reports the number of characters from @var{string} which\n" "vwere used for the conversion.

(string? obj)
Returns #t iff OBJ is a string, else returns #f.

(read-only-string? x)
Return true if OBJ can be read as a string,
 "This illustrates the difference between @code{string?} and\n" "@code{read-only-string?}:
 "@example\n" "(string? \"a string\") @result{} #t\n" "(string? 'a-symbol) @result{} #f
 "(read-only-string? \"a string\") @result{} #t\n" "(read-only-string? 'a-symbol) @result{} #t\n" "@end example

(list->string)
scm_string

(string chrs)
Returns a newly allocated string composed of the arguments, CHRS.

(make-string k chr)
Returns a newly allocated string of\n" "length K.  If CHR is given, then all elements of the string\n" "are initialized to CHR, otherwise the contents of the\n" "STRING are unspecified.

(string-length string)
Returns the number of characters in STRING

(string-ref str k)
Returns character K of STR using zero-origin indexing.\n" "K must be a valid index of STR.

(string-set! str k chr)
Stores CHR in element K of STRING and returns an unspecified value.\n" "K must be a valid index of STR.

(substring str start end)
Returns a newly allocated string formed from the characters\n" "of STR beginning with index START (inclusive) and ending with\n" "index END (exclusive).\n" "STR must be a string, START and END must be exact integers satisfying:
 "0 <= START <= END <= (string-length STR).

(string-append args)
Returns a newly allocated string whose characters form the\n" "concatenation of the given strings, ARGS.

(make-shared-substring str frm to)
Return a shared substring of @var{str}.  The semantics are the same as\n" "for the @code{substring} function: the shared substring returned\n" "includes all of the text from @var{str} between indexes @var{start}\n" "(inclusive) and @var{end} (exclusive).  If @var{end} is omitted, it\n" "defaults to the end of @var{str}.  The shared substring returned by\n" "@code{make-shared-substring} occupies the same storage space as\n" "@var{str}.

(string-index str chr frm to)
Return the index of the first occurrence of @var{chr} in @var{str}.  The\n" "optional integer arguments @var{frm} and @var{to} limit the search to\n" "a portion of the string.  This procedure essentially implements the\n" "@code{index} or @code{strchr} functions from the C library.
 "(qdocs:)  Returns the index of @var{char} in @var{str}, or @code{#f} if the\n" "@var{char} isn't in @var{str}. If @var{frm} is given and not @code{#f},\n" "it is used as the starting index; if @var{to} is given and not @var{#f},\n" "it is used as the ending index (exclusive).
 "@example\n" "(string-index "weiner" #\e)\n" "@result{} 1
 "(string-index "weiner" #\e 2)\n" "@result{} 4
 "(string-index "weiner" #\e 2 4)\n" "@result{} #f\n" "@end example

(string-rindex str chr frm to)
Like @code{string-index}, but search from the right of the string rather\n" "than from the left.  This procedure essentially implements the\n" "@code{rindex} or @code{strrchr} functions from the C library.
 "(qdocs:) The same as @code{string-index}, except it gives the rightmost occurance\n" "of @var{char} in the range [@var{frm}, @var{to}-1], which defaults to\n" "the entire string.
 "@example\n" "(string-rindex "weiner" #\e)\n" "@result{} 4
 "(string-rindex "weiner" #\e 2 4)\n" "@result{} #f
 "(string-rindex "weiner" #\e 2 5)\n" "@result{} 4\n" "@end example

(substring-move-left!)
scm_substring_move_x

(substring-move-right!)
scm_substring_move_x

(substring-move! str1 start1 end1 str2 start2)
Copy the substring of @var{str1} bounded by @var{start1} and @var{end1}\n" "into @var{str2} beginning at position @var{end2}.\n" "@code{substring-move-right!} begins copying from the rightmost character\n" "and moves left, and @code{substring-move-left!} copies from the leftmost\n" "character moving right.
 "It is useful to have two functions that copy in different directions so\n" "that substrings can be copied back and forth within a single string.  If\n" "you wish to copy text from the left-hand side of a string to the\n" "right-hand side of the same string, and the source and destination\n" "overlap, you must be careful to copy the rightmost characters of the\n" "text first, to avoid clobbering your data.  Hence, when @var{str1} and\n" "@var{str2} are
# 246 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/strop.c"
{
long s1, s2, e, len;
do { if (!(((!(6 & (str1))) && (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((str1)))) [0]) == 21)))) scm_wrong_type_arg_msg(s_scm_substring_move_x, 1, str1, "STRINGP"); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(start1,2,250); s1 = ((((start1)) >> (2))); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(end1,3,251); e = ((((end1)) >> (2))); } while (0);
do { if (!(((!(6 & (str2))) && (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((str2)))) [0]) == 21)))) scm_wrong_type_arg_msg(s_scm_substring_move_x, 4, str2, "STRINGP"); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(start2,5,253); s2 = ((((start2)) >> (2))); } while (0);
len = e - s1;
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(end1,SCM_OUTOFRANGE,255); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(start1,SCM_OUTOFRANGE,256); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(start2,SCM_OUTOFRANGE,257); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(end1,SCM_OUTOFRANGE,258); } while (0);
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(start2,SCM_OUTOFRANGE,259); } while (0);
memmove((void *)(&(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((str2)))) [1]))[s2])), (void *)(&(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((str1)))) [1]))[s1])), len);
return scm_return_first(((scm_bits_t) (((21) << 9) + 0x174L)), str1, str2);
}

(substring-fill! str start end fill)
Change every character in @var{str} between @var{start} and @var{end} to\n" "@var{fill-char}.
 "(qdocs:) Destructively fills @var{str}, from @var{start} to @var{end}, with @var{fill}.
 "@example\n" "(define y \"abcdefg\")\n" "(substring-fill! y 1 3 #\r)\n" "y\n" "@result{} \"arrdefg\"\n" "@end example

(string-null? str)
Return @code{#t} if @var{str}'s length is nonzero, and @code{#f}\n" "otherwise.
 "(qdocs:) Returns @code{#t} if @var{str} is empty, else returns @code{#f}.
 "@example\n" "(string-null? \"\")\n" "@result{} #t
 "(string-null? y)\n" "@result{} #f\n" "@end example

(string->list str)
@samp{String->list} returns a newly allocated list of the\n" "characters that make up the given string.  @samp{List->string}\n" "returns a newly allocated string formed from the characters in the list\n" "@var{list}, which must be a list of characters. @samp{String->list}\n" "and @samp{list->string} are\n" "inverses so far as @samp{equal?} is concerned.  (r5rs)

(string-copy str)
Returns a newly allocated copy of the given @var{string}. (r5rs)

(string-fill! str chr)
Stores @var{char} in every element of the given @var{string} and returns an\n" "unspecified value.  (r5rs)

(string-upcase! v)
Destructively upcase every character in @code{str}.
 "(qdocs:) Converts each element in @var{str} to upper case.
 "@example\n" "(string-upcase! y)\n" "@result{} \"ARRDEFG\"
 "y\n" "@result{} \"ARRDEFG\"\n" "@end example

(string-upcase str)
Upcase every character in @code{str}.

(string-downcase! v)
Destructively downcase every character in @code{str}.
 "(qdocs:) Converts each element in @var{str} to lower case.
 "@example\n" "y\n" "@result{} \"ARRDEFG\"
 "(string-downcase! y)\n" "@result{} \"arrdefg\"
 "y\n" "@result{} \"arrdefg\"\n" "@end example

(string-downcase str)
Downcase every character in @code{str}.

(string-capitalize! str)
Destructively capitalize every character in @code{str}.

(string-capitalize str)
Capitalize every character in @code{str}.

(string-ci->symbol str)
Return the symbol whose name is @var{str}, downcased in necessary(???).

(string=? s1 s2)
Lexicographic equality predicate; \n" "Returns @t{#t} if the two strings are the same length and contain the same\n" "characters in the same positions, otherwise returns @t{#f}. (r5rs)
 "@samp{String-ci=?} treats\n" "upper and lower case letters as though they were the same character, but\n" "@samp{string=?} treats upper and lower case as distinct characters.

(string-ci=? s1 s2)
Case-insensitive string equality predicate; returns @t{#t} if\n" "the two strings are the same length and their component characters\n" "match (ignoring case) at each position; otherwise returns @t{#f}. (r5rs)

(string<? s1 s2)
Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" "is lexicographically less than @var{s2}.  (r5rs)

(string<=? s1 s2)
Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" "is lexicographically less than or equal to @var{s2}.  (r5rs)

(string>? s1 s2)
Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" "is lexicographically greater than @var{s2}.  (r5rs)

(string>=? s1 s2)
Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" "is lexicographically greater than or equal to @var{s2}.  (r5rs)

(string-ci<? s1 s2)
Case insensitive lexicographic ordering predicate; \n" "returns @t{#t} if @var{s1} is lexicographically less than\n" "@var{s2} regardless of case.  (r5rs)

(string-ci<=? s1 s2)
Case insensitive lexicographic ordering predicate; \n" "returns @t{#t} if @var{s1} is lexicographically less than\n" "or equal to @var{s2} regardless of case.  (r5rs)

(string-ci>? s1 s2)
Case insensitive lexicographic ordering predicate; \n" "returns @t{#t} if @var{s1} is lexicographically greater than\n" "@var{s2} regardless of case.  (r5rs)

(string-ci>=? s1 s2)
Case insensitive lexicographic ordering predicate; \n" "returns @t{#t} if @var{s1} is lexicographically greater than\n" "or equal to @var{s2} regardless of case.  (r5rs)

(call-with-output-string proc)
Calls the one-argument procedure @var{proc} with a newly created output\n" "port.  When the function returns, the string composed of the characters\n" "written into the port is returned.

(call-with-input-string str proc)
Calls the one-argument procedure @var{proc} with a newly created input\n" "port from which @var{string}'s contents may be read.  The value yielded\n" "by the @var{proc} is returned.

(eval-string string)
Evaluate @var{string} as the text representation of a Scheme form\n" "or forms, and return whatever value they produce.

(make-struct-layout fields)
Return a new structure layout object.
 "@var{fields} must be a read-only string made up of pairs of characters\n" "strung together.  The first character of each pair describes a field\n" "type, the second a field protection.  Allowed types are 'p' for\n" "GC-protected Scheme data, 'u' for unprotected binary data, and 's' for\n" "fields that should point to the structure itself.    Allowed protections\n" "are 'w' for mutable fields, 'r' for read-only fields, and 'o' for opaque \n" "fields.  The last field protection specification may be capitalized to\n" "indicate that the field is a tail-array.

(struct? x)
Return #t iff @var{obj} is a structure object, else #f.

(struct-vtable? x)
Return #t iff obj is a vtable structure.

(make-struct vtable tail_array_size init)
Create a new structure.
 "@var{type} must be a vtable structure (@xref{Vtables}).
 "@var{tail-elts} must be a non-negative integer.  If the layout\n" "specification indicated by @var{type} includes a tail-array,\n" "this is the number of elements allocated to that array.
 "The @var{inits} are optional arguments describing how successive fields\n" "of the structure should be initialized.  Only fields with protection 'r'\n" "or 'w' can be initialized -- fields of protection 's' are automatically\n" "initialized to point to the new structure itself;  fields of protection 'o'\n" "can not be initialized by Scheme programs.

(make-vtable-vtable extra_fields tail_array_size init)
Return a new, self-describing vtable structure.
 "@var{new-fields} is a layout specification describing fields\n" "of the resulting structure beginning at the position bound to\n" "@code{vtable-offset-user}.
 "@var{tail-size} specifies the size of the tail-array (if any) of\n" "this vtable.
 "@var{inits} initializes the fields of the vtable.  Minimally, one\n" "initializer must be provided: the layout specification for instances\n" "of the type this vtable will describe.  If a second initializer is\n" "provided, it will be interpreted as a print call-back function.
 "@example\n" ";;; loading ,a...\n" "(define x\n" "  (make-vtable-vtable (make-struct-layout (quote pw))\n" "                      0\n" "                      'foo))
 "(struc
# 468 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/struct.c"
{
SCM fields;
SCM layout;
int basic_size;
int tail_elts;
scm_bits_t * data;
SCM handle;
do { if (!(((!(6 & (extra_fields))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((extra_fields)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((extra_fields)))) [0]) == 5))))) scm_wrong_type_arg_msg(s_scm_make_vtable_vtable, 1, extra_fields, "ROSTRINGP"); } while (0);
do { if (!((2 & (tail_array_size)))) scm_wrong_type_arg_msg(s_scm_make_vtable_vtable, 2, tail_array_size, "INUMP"); } while (0);
do { if (0) { if (scm_ilength (init) < 0) { do { scm_misc_error (s_scm_make_vtable_vtable, "Rest arguments do not form a proper list.", ((scm_bits_t) (((20) << 9) + 0x174L))); } while (0); } } } while (0);
fields = scm_string_append (scm_listify (required_vtable_fields,
extra_fields,
((scm_bits_t) (((18) << 9) + 0x174L))));
layout = scm_make_struct_layout (fields);
basic_size = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((layout)))) [0]) >> 8) / 2;
tail_elts = ((((tail_array_size)) >> (2)));
do { if ((6 & (scm_freelist))) handle = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist); else { handle = scm_freelist; scm_freelist = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((scm_freelist)))) [1]))); ((scm_bits_t *) ((SCM_CELLPTR) ((handle)))) [0] = (scm_bits_t) (0x047f); } } while(0);
do { asm (""); ; ; asm (""); scm_ints_disabled = 1; asm (""); } while (0);
data = scm_alloc_struct (basic_size + tail_elts,
4,
make-vtable-vtable");
((scm_bits_t *) ((SCM_CELLPTR) ((handle)))) [1] = (scm_bits_t) (data);
((scm_bits_t *) ((SCM_CELLPTR) ((handle)))) [0] = (scm_bits_t) ((scm_bits_t) data + 1);
(((scm_bits_t *) (((scm_bits_t *) ((SCM_CELLPTR) ((handle)))) [0] - 1)) [0] = (layout));
scm_struct_init (handle, tail_elts, scm_cons (layout, init));
do { asm (""); ; ; asm (""); scm_ints_disabled = 0; asm (""); ; asm (""); } while (0);
return handle;
}

(struct-ref handle pos)
@deffnx primitive struct-set! struct n value\n" "Access (or modify) the @var{n}th field of @var{struct}.
 "If the field is of type 'p', then it can be set to an arbitrary value.
 "If the field is of type 'u', then it can only be set to a non-negative\n" "integer value small enough to fit in one machine word.

(struct-set! handle pos val)

(struct-vtable handle)
Return the vtable structure that describes the type of @var{struct}.

(struct-vtable-tag handle)

(struct-vtable-name vtable)

(set-struct-vtable-name! vtable name)

(symbol? obj)
Returns @t{#t} if @var{obj} is a symbol, otherwise returns @t{#f}. (r5rs)

(symbol->string s)
Returns the name of @var{symbol} as a string.  If the symbol was part of\n" "an object returned as the value of a literal expression\n" "(section @pxref{Literal expressions}) or by a call to the @samp{read} procedure,\n" "and its name contains alphabetic characters, then the string returned\n" "will contain characters in the implementation's preferred standard\n" "case---some implementations will prefer upper case, others lower case.\n" "If the symbol was returned by @samp{string->symbol}, the case of\n" "characters in the string returned will be the same as the case in the\n" "string that was passed to @samp{string->symbol}.  It is an error\n" "to apply mutation procedures like @code{string-set!} to strings returned\n" "by this procedure. (r5rs)
 "The following examples assume that the implementatio
# 465 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/symbols.c"
{
do { if (!(((!(6 & (s))) && (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [0]) == 5)))) scm_wrong_type_arg_msg(s_scm_symbol_to_string, 1, s, "SYMBOLP"); } while (0);
return scm_makfromstr(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [1])), (size_t)(((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [0]) >> 8), 0);
}

(string->symbol s)
Returns the symbol whose name is @var{string}.  This procedure can\n" "create symbols with names containing special characters or letters in\n" "the non-standard case, but it is usually a bad idea to create such\n" "symbols because in some implementations of Scheme they cannot be read as\n" "themselves.  See @samp{symbol->string}.
 "The following examples assume that the implementation's standard case is\n" "lower case:
 "@format\n" "@t{(eq? 'mISSISSIppi 'mississippi)  \n" "          ==>  #t\n" "(string->symbol \"mISSISSIppi\")  \n" "          ==>\n" "  @r{}the symbol with name \"mISSISSIppi\"\n" "(eq? 'bitBlt (string->symbol \"bitBlt\"))     \n" "          ==>  #f\n" "(eq? 'JollyWog\n" "     (string->symbol\n" "       (symbol->string 'JollyWog)))  \n" "          ==>  #t\n" "(string=? \"K. Harper
# 500 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/symbols.c"
{
SCM vcell;
SCM answer;
do { if (!(((!(6 & (s))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [0]) == 5))))) scm_wrong_type_arg_msg(s_scm_string_to_symbol, 1, s, "ROSTRINGP"); } while (0);
vcell = scm_intern(((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [1])))), (size_t)(((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((s)))) [0]) >> 8));
answer = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((vcell)))) [0])));
return answer;
}

(string->obarray-symbol o s softp)
Intern a new symbol in @var{obarray}, a symbol table, with name\n" "@var{string}.
 "If @var{obarray} is @code{#f}, use the default system symbol table.  If\n" "@var{obarray} is @code{#t}, the symbol should not be interned in any\n" "symbol table; merely return the pair (@var{symbol}\n" ". @var{#<undefined>}).
 "The @var{soft?} argument determines whether new symbol table entries\n" "should be created when the specified symbol is not already present in\n" "@var{obarray}.  If @var{soft?} is specified and is a true value, then\n" "new entries should not be added for symbols not already present in the\n" "table; instead, simply return @code{#f}.

(intern-symbol o s)
Add a new symbol to @var{obarray} with name @var{string}, bound to an\n" "unspecified initial value.  The symbol table is not modified if a symbol\n" "with this name is already present.

(unintern-symbol o s)
Remove the symbol with name @var{string} from @var{obarray}.  This\n" "function returns @code{#t} if the symbol was present and @code{#f}\n" "otherwise.

(symbol-binding o s)
Look up in @var{obarray} the symbol whose name is @var{string}, and\n" "return the value to which it is bound.  If @var{obarray} is @code{#f},\n" "use the global symbol table.  If @var{string} is not interned in\n" "@var{obarray}, an error is signalled.

(symbol-interned? o s)
Return @var{#t} if @var{obarray} contains a symbol with name\n" "@var{string}, and @var{#f} otherwise.

(symbol-bound? o s)
Return @var{#t} if @var{obarray} contains a symbol with name\n" "@var{string} bound to a defined value.  This differs from\n" "@var{symbol-bound?} in that the mere mention of a symbol usually causes\n" "it to be interned; @code{symbol-bound?} determines whether a symbol has\n" "been given any meaningful value.

(symbol-set! o s v)
Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n" "it to @var{value}.  An error is signalled if @var{string} is not present\n" "in @var{obarray}.

(symbol-fref s)
Return the contents of @var{symbol}'s @dfn{function slot}.

(symbol-pref s)
Return the @dfn{property list} currently associated with @var{symbol}.

(symbol-fset! s val)
Change the binding of @var{symbol}'s function slot.

(symbol-pset! s val)
Change the binding of @var{symbol}'s property slot.

(symbol-hash s)
Return the hash value derived from @var{symbol}'s name, i.e. the integer\n" "index into @var{symbol}'s obarray at which it is stored.

(builtin-bindings)
Create and return a copy of the global symbol table, removing all\n" "unbound symbols.

(builtin-weak-bindings)

(gensym name obarray)
Create a new, unique symbol in @var{obarray}, using the global symbol\n" "table by default.  If @var{name} is specified, it should be used as a\n" "prefix for the new symbol's name.  The default prefix is @code{%%gensym}.

(tag x)
Return an integer corresponding to the type of X.  Deprecated.

(catch tag thunk handler)
Invoke @var{thunk} in the dynamic context of @var{handler} for\n" "exceptions matching @var{key}.  If thunk throws to the symbol @var{key},\n" "then @var{handler} is invoked this way:
 "@example\n" "(handler key args ...)\n" "@end example
 "@var{key} is a symbol or #t.
 "@var{thunk} takes no arguments.  If @var{thunk} returns normally, that\n" "is the return value of @code{catch}.
 "Handler is invoked outside the scope of its own @code{catch}.  If\n" "@var{handler} again throws to the same key, a new handler from further\n" "up the call chain is invoked.
 "If the key is @code{#t}, then a throw to @emph{any} symbol will match\n" "this call to @code{catch}.

(lazy-catch tag thunk handler)

(throw key args)
Invoke the catch form matching @var{key}, passing @var{args} to the\n" "@var{handler}.  
 "@var{key} is a symbol.  It will match catches of the same symbol or of\n" "#t.
 "If there is no handler at all, an error is signaled.

(uniform-vector-length v)
Returns the number of elements in @var{uve}.

(array? v prot)
Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not.
 "The @var{prototype} argument is used with uniform arrays and is described\n" "elsewhere.

(array-rank ra)
Returns the number of dimensions of @var{obj}.  If @var{obj} is not an\n" "array, @code{0} is returned.

(array-dimensions ra)
@code{Array-dimensions} is similar to @code{array-shape} but replaces\n" "elements with a @code{0} minimum with one greater than the maximum. So:\n" "@example\n" "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5)\n" "@end example

(shared-array-root ra)
Return the root vector of a shared array.

(shared-array-offset ra)
Return the root vector index of the first element in the array.

(shared-array-increments ra)
For each dimension, return the distance between elements in the root vector.

(dimensions->uniform-array dims prot fill)
@deffnx primitive make-uniform-vector length prototype [fill]\n" "Creates and returns a uniform array or vector of type corresponding to\n" "@var{prototype} with dimensions @var{dims} or length @var{length}.  If\n" "@var{fill} is supplied, it's used to fill the array, otherwise \n" "@var{prototype} is used.

(make-shared-array oldra mapfunc dims)
@code{make-shared-array} can be used to create shared subarrays of other\n" "arrays.  The @var{mapper} is a function that translates coordinates in\n" "the new array into coordinates in the old array.  A @var{mapper} must be\n" "linear, and its range must stay within the bounds of the old array, but\n" "it can be otherwise arbitrary.  A simple example:\n" "@example\n" "(define fred (make-array #f 8 8))\n" "(define freds-diagonal\n" "  (make-shared-array fred (lambda (i) (list i i)) 8))\n" "(array-set! freds-diagonal 'foo 3)\n" "(array-ref fred 3 3) @result{} foo\n" "(define freds-center\n" "  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2))\n" "(array-ref freds-center 0 0) @result{} foo\n" "@end example

(transpose-array ra args)
Returns an array sharing contents with @var{array}, but with dimensions\n" "arranged in a different order.  There must be one @var{dim} argument for\n" "each dimension of @var{array}.  @var{dim0}, @var{dim1}, @dots{} should\n" "be integers between 0 and the rank of the array to be returned.  Each\n" "integer in that range must appear at least once in the argument list.
 "The values of @var{dim0}, @var{dim1}, @dots{} correspond to dimensions\n" "in the array to be returned, their positions in the argument list to\n" "dimensions of @var{array}.  Several @var{dim}s may have the same value,\n" "in which case the returned array will have smaller rank than\n" "@var{array}.
 "examples:\n" "@example\n" "(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n" "(transpose-array '#2((a b)
# 808 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/unif.c"
{
SCM res, vargs, *ve = &vargs;
scm_array_dim *s, *r;
int ndim, i, k;
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(ra,SCM_ARG1,813);
switch ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0]))
{
default:
badarg:do { scm_wta (ra, (char *) 1, s_scm_transpose_array); } while (0);
case 71:
case 21:
case 77:
case 37:
case 79:
case 45:
case 47:
case 53:
case 55:
case 29:
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(scm_makfrom0str (s_scm_transpose_array),SCM_WNA,831);
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((args)))) [0]))),SCM_ARG2,833);
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((args)))) [0]))),SCM_OUTOFRANGE,835);
return ra;
case 127:
if (!(((!(6 & (ra))) && (scm_tc16_array == (0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0]))))) goto badarg;
vargs = scm_vector (args);
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(scm_makfrom0str (s_scm_transpose_array),SCM_WNA,841);
ve = ((SCM *) ((scm_bits_t *) ((SCM_CELLPTR) ((vargs)))) [1]);
ndim = 0;
for (k = 0; k < ((size_t) (((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0] >> 17)); k++)
{
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(ve[k],(SCM_ARG2 + k),847);
i = ((((ve[k])) >> (2)));
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(ve[k],SCM_OUTOFRANGE,850);
if (ndim < i)
ndim = i;
}
ndim++;
res = scm_make_ra (ndim);
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1])->v) = (((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [1])->v);
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1])->base) = (((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [1])->base);
for (k = ndim; k--;)
{
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1]))+sizeof(scm_array)))[k].lbnd = 0;
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1]))+sizeof(scm_array)))[k].ubnd = -1;
}
for (k = ((size_t) (((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0] >> 17)); k--;)
{
i = ((((ve[k])) >> (2)));
s = &(((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [1]))+sizeof(scm_array)))[k]);
r = &(((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1]))+sizeof(scm_array)))[i]);
if (r->ubnd < r->lbnd)
{
r->lbnd = s->lbnd;
r->ubnd = s->ubnd;
r->inc = s->inc;
ndim--;
}
else
{
if (r->ubnd > s->ubnd)
r->ubnd = s->ubnd;
if (r->lbnd < s->lbnd)
{
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1])->base) += (s->lbnd - r->lbnd) * r->inc;
r->lbnd = s->lbnd;
}
r->inc += s->inc;
}
}
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(args,"bad argument list",887);
scm_ra_set_contp (res);
return res;
}
}

(enclose-array ra axes)
@var{dim0}, @var{dim1} @dots{} should be nonnegative integers less than\n" "the rank of @var{array}.  @var{enclose-array} returns an array\n" "resembling an array of shared arrays.  The dimensions of each shared\n" "array are the same as the @var{dim}th dimensions of the original array,\n" "the dimensions of the outer array are the same as those of the original\n" "array that did not match a @var{dim}.
 "An enclosed array is not a general Scheme array.  Its elements may not\n" "be set using @code{array-set!}.  Two references to the same element of\n" "an enclosed array will be @code{equal?} but will not in general be\n" "@code{eq?}.  The value returned by @var{array-prototype} when given an\n" "enclosed array is unspecified.
 "examples:\n" "@example\n" "(enclose-array '#3(((a b c) (d e f)) ((1 2
# 916 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/unif.c"
{
SCM axv, res, ra_inr;
scm_array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr;
if (((((axes)) == (((scm_bits_t) (((20) << 9) + 0x174L))))))
axes = scm_cons ((((!(6 & (ra))) && (scm_tc16_array == (0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0]))) ? (((scm_bits_t) (((((size_t) (((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0] >> 17)) - 1) << 2) + 2L))) : ((((scm_bits_t) (((0) << 2) + 2L))))), ((scm_bits_t) (((20) << 9) + 0x174L)));
ninr = scm_ilength (axes);
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(scm_makfrom0str (s_scm_enclose_array),SCM_WNA,924);
ra_inr = scm_make_ra (ninr);
if (!((!(6 & (ra))))) goto badarg1;
switch (0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0])
{
default:
badarg1:do { scm_wta (ra, (char *) 1, s_scm_enclose_array); } while (0);
case 21:
case 71:
case 77:
case 37:
case 79:
case 45:
case 47:
case 53:
case 13:
case 15:
case 55:
case 29:
s->lbnd = 0;
s->ubnd = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0]) >> 8) - 1;
s->inc = 1;
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1])->v) = ra;
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1])->base) = 0;
ndim = 1;
break;
case 127:
if (!(((!(6 & (ra))) && (scm_tc16_array == (0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0]))))) goto badarg1;
s = ((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [1]))+sizeof(scm_array)));
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1])->v) = (((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [1])->v);
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1])->base) = (((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [1])->base);
ndim = ((size_t) (((scm_bits_t *) ((SCM_CELLPTR) ((ra)))) [0] >> 17));
break;
}
noutr = ndim - ninr;
axv = scm_make_string ((((scm_bits_t) (((ndim) << 2) + 2L))), ((scm_bits_t) (((0) << 8) + scm_tc8_char)));
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(scm_makfrom0str (s_scm_enclose_array),SCM_WNA,963);
res = scm_make_ra (noutr);
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1])->base) = (((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1])->base);
(((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1])->v) = ra_inr;
for (k = 0; k < ninr; k++, axes = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((axes)))) [1]))))
{
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((axes)))) [0]))),"bad axis",969);
j = (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((axes)))) [0]))))) >> (2)));
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1]))+sizeof(scm_array)))[k].lbnd = s[j].lbnd;
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1]))+sizeof(scm_array)))[k].ubnd = s[j].ubnd;
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((ra_inr)))) [1]))+sizeof(scm_array)))[k].inc = s[j].inc;
((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((axv)))) [1]))[j] = 1;
}
for (j = 0, k = 0; k < noutr; k++, j++)
{
while (((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((axv)))) [1]))[j])
j++;
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1]))+sizeof(scm_array)))[k].lbnd = s[j].lbnd;
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1]))+sizeof(scm_array)))[k].ubnd = s[j].ubnd;
((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((res)))) [1]))+sizeof(scm_array)))[k].inc = s[j].inc;
}
scm_ra_set_contp (ra_inr);
scm_ra_set_contp (res);
return res;
}

(array-in-bounds? v args)
Returns @code{#t} if its arguments would be acceptable to array-ref.

(array-ref)
scm_uniform_vector_ref

(uniform-vector-ref v args)
Returns the element at the @code{(index1, index2)} element in @var{array}.

(uniform-array-set1!)
scm_array_set_x

(array-set! v obj args)
Sets the element at the @code{(index1, index2)} element in @var{array} to\n" "@var{new-value}.  The value returned by array-set! is unspecified.

(array-contents ra strict)
@deffnx primitive array-contents array strict\n" "If @var{array} may be @dfn{unrolled} into a one dimensional shared array\n" "without changing their order (last subscript changing fastest), then\n" "@code{array-contents} returns that shared array, otherwise it returns\n" "@code{#f}.  All arrays made by @var{make-array} and\n" "@var{make-uniform-array} may be unrolled, some arrays made by\n" "@var{make-shared-array} may not be.
 "If the optional argument @var{strict} is provided, a shared array will\n" "be returned only if its elements are stored internally contiguous in\n" "memory.

(uniform-array-read! ra port_or_fd start end)
@deffnx primitive uniform-vector-read! uve [port-or-fdes] [start] [end]\n" "Attempts to read all elements of @var{ura}, in lexicographic order, as\n" "binary objects from @var{port-or-fdes}.\n" "If an end of file is encountered during\n" "uniform-array-read! the objects up to that point only are put into @var{ura}\n" "(starting at the beginning) and the remainder of the array is\n" "unchanged.
 "The optional arguments @var{start} and @var{end} allow\n" "a specified region of a vector (or linearized array) to be read,\n" "leaving the remainder of the vector unchanged.
 "@code{uniform-array-read!} returns the number of objects read.\n" "@var{port-or-fdes} may be omitted, in which case it defaults to the value\n" "returned by @code{(current-input-port)
# 1469 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/unif.c"
{
SCM cra = ((scm_bits_t) (((18) << 9) + 0x174L)), v = ra;
long sz, vlen, ans;
long cstart = 0;
long cend;
long offset = 0;
if (!((!(6 & (v))))) goto badarg1;
if (((((port_or_fd)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
port_or_fd = (scm_root->cur_inp);
else
*&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(port_or_fd,SCM_ARG2,1482);
vlen = (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((v)))) [0]) >> 8);
loop:
switch (0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((v)))) [0])
{
default:
badarg1:do { scm_wta (v, (char *) SCM_ARG1, s_scm_uniform_array_read_x); } while (0);
case 127:
if (!(((!(6 & (v))) && (scm_tc16_array == (0xffff & ((scm_bits_t *) ((SCM_CELLPTR) ((v)))) [0]))))) goto badarg1;
cra = scm_ra2contig (ra, 0);
cstart += (((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((cra)))) [1])->base);
vlen = ((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((cra)))) [1]))+sizeof(scm_array)))->inc *
(((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((cra)))) [1]))+sizeof(scm_array)))->ubnd - ((scm_array_dim *)(((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((cra)))) [1]))+sizeof(scm_array)))->lbnd + 1);
v = (((scm_array *) ((scm_bits_t *) ((SCM_CELLPTR) ((cra)))) [1])->v);
goto loop;
case 21:
case 77:
sz = sizeof (char);
break;
case 71:
vlen = (vlen + (8*sizeof(long)/sizeof(char)) - 1) / (8*sizeof(long)/sizeof(char));
cstart /= (8*sizeof(long)/sizeof(char));
case 37:
case 79:
sz = sizeof (long);
break;
case 55:
sz = sizeof (short);
break;
case 29:
sz = sizeof (long_long);
break;
case 45:
sz = sizeof (float);
break;
case 47:
sz = sizeof (double);
break;
case 53:
sz = 2 * sizeof (double);
break;
}
cend = vlen;
if (!((((start)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
{
offset =
(scm_num2long (start, (char *) 3, s_scm_uniform_array_read_x));
if (offset < 0 || offset >= cend)
scm_out_of_range (s_scm_uniform_array_read_x, start);
if (!((((end)) == (((scm_bits_t) (((18) << 9) + 0x174L))))))
{
long tend =
(scm_num2long (end, (char *) 4, s_scm_uniform_array_read_x));
if (tend <= offset || tend > cend)
scm_out_of_range (s_scm_uniform_array_read_x, end);
cend = tend;
}
}
if ((!(6 & (port_or_fd))))
{
scm_port *pt = ((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((port_or_fd)))) [1]);
int remaining = (cend - offset) * sz;
char *dest = ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((v)))) [1])) + (cstart + offset) * sz;
if (pt->rw_active == SCM_PORT_WRITE)
scm_flush (port_or_fd);
ans = cend - offset;
while (remaining > 0)
{
if (pt->read_pos < pt->read_end)
{
int to_copy = ((pt->read_end - pt->read_pos) <= (remaining) ? (pt->read_end - pt->read_pos) : (remaining));
memcpy (dest, pt->read_pos, to_copy);
pt->read_pos += to_copy;
remaining -= to_copy;
dest += to_copy;
}
else
{
if (scm_fill_input (port_or_fd) == (-1))
{
if (remaining % sz != 0)
{
do { scm_misc_error (s_scm_uniform_array_read_x, "unexpected EOF", ((scm_bits_t) (((20) << 9) + 0x174L))); } while (0);
}
ans -= remaining / sz;
break;
}
}
}
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
}
else
{
ans = read (((((port_or_fd)) >> (2))), ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((v)))) [1])) + (cstart + offset) * sz, (size_t) (sz * (cend - offset)));
if (ans == -1)
do { scm_syserror (s_scm_uniform_array_read_x); } while (0);
}
if ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((v)))) [0]) == 71)
ans *= (8*sizeof(long)/sizeof(char));
if (!((v) == (ra)) && !((cra) == (ra)))
scm_array_copy_x (cra, ra);
return (((scm_bits_t) (((ans) << 2) + 2L)));
}

(uniform-array-write v port_or_fd start end)
@deffnx primitive uniform-vector-write uve [port-or-fdes] [start] [end]\n" "Writes all elements of @var{ura} as binary objects to\n" "@var{port-or-fdes}.
 "The optional arguments @var{start}\n" "and @var{end} allow\n" "a specified region of a vector (or linearized array) to be written.
 "The number of objects actually written is returned. \n" "@var{port-or-fdes} may be\n" "omitted, in which case it defaults to the value returned by\n" "@code{(current-output-port)}.

(bit-count b bitvector)
Returns the number of occurrences of the boolean B in BITVECTOR.

(bit-position item v k)
Returns the minimum index of an occurrence of @var{bool} in @var{bv}\n" "which is at least @var{k}.  If no @var{bool} occurs within the specified\n" "range @code{#f} is returned.

(bit-set*! v kv obj)
If uve is a bit-vector @var{bv} and uve must be of the same length.  If\n" "@var{bool} is @code{#t}, uve is OR'ed into @var{bv}; If @var{bool} is @code{#f}, the\n" "inversion of uve is AND'ed into @var{bv}.
 "If uve is a unsigned integer vector all the elements of uve must be\n" "between 0 and the @code{LENGTH} of @var{bv}.  The bits of @var{bv}\n" "corresponding to the indexes in uve are set to @var{bool}.
 "The return value is unspecified.

(bit-count* v kv obj)
Returns\n" "@example\n" "(bit-count (bit-set*! (if bool bv (bit-invert! bv)) uve #t) #t).\n" "@end example\n" "@var{bv} is not modified.

(bit-invert! v)
Modifies @var{bv} by replacing each element with its negation.

(array->list v)
Returns a list consisting of all the elements, in order, of @var{array}.

(list->uniform-array ndim prot lst)
@deffnx procedure list->uniform-vector prot lst\n" "Returns a uniform array of the type indicated by prototype @var{prot}\n" "with elements the same as those of @var{lst}.  Elements must be of the\n" "appropriate type, no coercions are done.

(array-prototype ra)
Returns an object that would produce an array of the same type as\n" "@var{array}, if used as the @var{prototype} for\n" "@code{make-uniform-array}.

(make-variable init name_hint)
Return a variable object initialized to value INIT.\n" "If given, uses NAME-HINT as its internal (debugging)\n" "name, otherwise just treat it as an anonymous variable.\n" "Remember, of course, that multiple bindings to the same\n" "variable may exist, so NAME-HINT is just that---a hint.

(make-undefined-variable name_hint)
Return a variable object initialized to an undefined value.\n" "If given, uses NAME-HINT as its internal (debugging)\n" "name, otherwise just treat it as an anonymous variable.\n" "Remember, of course, that multiple bindings to the same\n" "variable may exist, so NAME-HINT is just that---a hint.

(variable? obj)
Return #t iff OBJ is a variable object, else return #f

(variable-ref var)
Dereference VAR and return its value.\n" "VAR must be a variable object;  see `make-variable' and\n" "`make-undefined-variable'

(variable-set! var val)
Set the value of the variable VAR to VAL.\n" "VAR must be a variable object, VAL can be any value.\n" "Returns an unspecified value.

(builtin-variable name)
Return the built-in variable with the name NAME.\n" "NAME must be a symbol (not a string).\n" "Then use `variable-ref' to access its value.

(variable-bound? var)
Return #t iff VAR is bound to a value.\n" "Throws an error if VAR is not a variable object.

(vector? obj)
Returns @t{#t} if @var{obj} is a vector, otherwise returns @t{#f}. (r5rs)

(list->vector)
scm_vector

(vector l)
Returns a newly allocated vector whose elements contain the given\n" "arguments.  Analogous to @samp{list}. (r5rs)
 "@format\n" "@t{(vector 'a 'b 'c)                      ==>  #(a b c) }\n" "@end format

(make-vector k fill)
Returns a newly allocated vector of @var{k} elements.  If a second\n" "argument is given, then each element is initialized to @var{fill}.\n" "Otherwise the initial contents of each element is unspecified. (r5rs)

(vector->list v)
@samp{Vector->list} returns a newly allocated list of the objects contained\n" "in the elements of @var{vector}.  (r5rs)
 "@format\n" "@t{(vector->list '#(dah dah didah))\n" "=>  (dah dah didah)\n" "list->vector '(dididit dah))\n" "=>  #(dididit dah)\n" "}\n" "@end format

(vector-fill! v fill_x)
Stores @var{fill} in every element of @var{vector}.\n" "The value returned by @samp{vector-fill!} is unspecified. (r5rs)

(vector-move-left! vec1 start1 end1 vec2 start2)
Vector version of @code{substring-move-left!}.

(vector-move-right! vec1 start1 end1 vec2 start2)
Vector version of @code{substring-move-right!}.

(major-version)
Return a string containing Guile's major version number.\n" "E.g., \"1\".

(minor-version)
Return a string containing Guile's minor version number.\n" "E.g., \"3.5\".

(version)
@deffnx primitive major-version\n" "@deffnx primitive minor-version\n" "Return a string describing Guile's version number, or its major or minor\n" "version numbers, respectively.
 "@example\n" "(version) @result{} \"1.3a\"\n" "(major-version) @result{} \"1\"\n" "(minor-version) @result{} \"3a\"\n" "@end example

(make-soft-port pv modes)
Returns a port capable of receiving or delivering characters as\n" "specified by the @var{modes} string (@pxref{File Ports,\n" "open-file}).  @var{vector} must be a vector of length 6.  Its components\n" "are as follows:
 "@enumerate 0\n" "@item\n" "procedure accepting one character for output\n" "@item\n" "procedure accepting a string for output\n" "@item\n" "thunk for flushing output\n" "@item\n" "thunk for getting one character\n" "@item\n" "thunk for closing port (not by garbage collection)\n" "@end enumerate
 "For an output-only port only elements 0, 1, 2, and 4 need be\n" "procedures.  For an input-only port only elements 3 and 4 need be\n" "procedures.  Thunks 2 and 4 can instead be @code{#f} if there is no useful\n" "operation for them to perform.
 "If thunk 3 returns @code{#f}
# 181 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/vports.c"
{
scm_port *pt;
SCM z;
do { *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(pv,1,184); } while (0);
do { if (!(((!(6 & (modes))) && ((((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0])==21) || (((0x7f & ~2) & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 5))))) scm_wrong_type_arg_msg(s_scm_make_soft_port, 2, modes, "ROSTRINGP"); } while (0);
{ if (((!(6 & (modes))) && ((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 23))) modes = scm_makfromstr (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1])))), (((unsigned long) ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) >> 8), 0); };
do { if ((6 & (scm_freelist))) z = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist); else { z = scm_freelist; scm_freelist = (((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((scm_freelist)))) [1]))); ((scm_bits_t *) ((SCM_CELLPTR) ((z)))) [0] = (scm_bits_t) (0x047f); } } while(0);
do { asm (""); ; ; asm (""); scm_ints_disabled = 1; asm (""); } while (0);
pt = scm_add_to_port_table (z);
scm_port_non_buffer (pt);
((scm_bits_t *) ((SCM_CELLPTR) ((z)))) [0] = (scm_bits_t) ((125 + 3 * 256L) | scm_mode_bits (((char *)(((0x7f & ((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [0]) == 23) ? (((((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [0]))))) >> (2))) + ((char *) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) (((((scm_bits_t) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))))) [1]))))))) [1])) : ((char *) (((scm_bits_t *) ((SCM_CELLPTR) ((modes)))) [1]))))));
(((scm_bits_t *) ((SCM_CELLPTR) (((z))))) [1] = (scm_bits_t) ((scm_bits_t) (pt)));
(((scm_port *) ((scm_bits_t *) ((SCM_CELLPTR) ((z)))) [1])->stream = (scm_bits_t) ((pv)));
do { asm (""); ; ; asm (""); scm_ints_disabled = 0; asm (""); ; asm (""); } while (0);
return z;
}
void scm_make_sfptob (void);
void
scm_make_sfptob ()
{
long tc = scm_make_port_type ("soft", sf_fill_input, sf_write);
scm_set_port_mark (tc, scm_markstream);
scm_set_port_flush (tc, sf_flush);
scm_set_port_close (tc, sf_close);
}
void
scm_init_vports ()
{
# 1 "../libguile/vports.x" 1
# 215 "/usr/obj/ports/guile-1.4/guile-1.4/libguile/vports.c" 2
}

(make-weak-vector k fill)
Return a weak vector with @var{size} elements. If the optional\n" "argument @var{fill} is given, all entries in the vector will be set to\n" "@var{fill}. The default value for @var{fill} is the empty list.

(list->weak-vector)
scm_weak_vector

(weak-vector l)
@deffnx primitive list->weak-vector l\n" "Construct a weak vector from a list: @code{weak-vector} uses the list of\n" "its arguments while @code{list->weak-vector} uses its only argument\n" "@var{l} (a list) to construct a weak vector the same way\n" "@code{vector->list} would.

(weak-vector? x)
Return @var{#t} if @var{obj} is a weak vector. Note that all weak\n" "hashes are also weak vectors.

(make-weak-key-hash-table k)
@deffnx primitive make-weak-value-hash-table size\n" "@deffnx primitive make-doubly-weak-hash-table size\n" "Return a weak hash table with @var{size} buckets. As with any hash\n" "table, choosing a good size for the table requires some caution.
 "You can modify weak hash tables in exactly the same way you would modify\n" "regular hash tables. (@pxref{Hash Tables})

(make-weak-value-hash-table k)

(make-doubly-weak-hash-table k)

(weak-key-hash-table? x)
@deffnx primitive weak-value-hash-table? obj\n" "@deffnx primitive doubly-weak-hash-table? obj\n" "Return @var{#t} if @var{obj} is the specified weak hash table. Note\n" "that a doubly weak hash table is neither a weak key nor a weak value\n" "hash table.

(weak-value-hash-table? x)

(doubly-weak-hash-table? x)
