1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

* * fports.c (scm_stdio_to_port): New function. Its guts used to be

written out several times in scm_start_stack.
	* fports.h: New declaration for the above.
This commit is contained in:
Jim Blandy 1996-10-23 02:14:18 +00:00
parent 0b886892da
commit a089567e22
2 changed files with 38 additions and 2 deletions

View file

@ -180,10 +180,45 @@ scm_open_file (filename, modes)
return port;
}
/* Build a Scheme port from an open stdio port, FILE.
MODE indicates whether FILE is open for reading or writing; it uses
the same notation as open-file's second argument.
If NAME is non-zero, use it as the port's filename.
scm_stdio_to_port sets the revealed count for FILE's file
descriptor to 1, so that FILE won't be closed when the port object
is GC'd. */
SCM
scm_stdio_to_port (file, mode, name)
FILE *file;
char *mode;
char *name;
{
long mode_bits = scm_mode_bits (mode);
SCM port;
struct scm_port_table * pt;
SCM_NEWCELL (port);
SCM_DEFER_INTS;
{
pt = scm_add_to_port_table (port);
SCM_SETPTAB_ENTRY (port, pt);
SCM_SETCAR (port, (scm_tc16_fport | mode_bits));
if (SCM_BUF0 & SCM_CAR (port))
scm_setbuf0 (port);
SCM_SETSTREAM (port, (SCM) file);
SCM_PTAB_ENTRY (port)->file_name = scm_makfrom0str (name);
}
SCM_ALLOW_INTS;
scm_set_port_revealed_x (port, SCM_MAKINUM (1));
return port;
}
/* Return the mode flags from an open port.
* Some modes such as "append" are only used when opening
* a file and are not returned here.
*/
* a file and are not returned here. */
SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);

View file

@ -58,6 +58,7 @@ extern scm_ptobfuns scm_pipob;
extern SCM scm_setbuf0 SCM_P ((SCM port));
extern long scm_mode_bits SCM_P ((char *modes));
extern SCM scm_open_file SCM_P ((SCM filename, SCM modes));
extern SCM scm_stdio_to_port SCM_P ((FILE *file, char *name, char *modes));
extern SCM scm_port_mode SCM_P ((SCM port));
extern void scm_init_fports SCM_P ((void));