-
-
-SCM_PROC (s_duplicate_port, "duplicate-port", 2, 0, 0, scm_duplicate_port);
-
-SCM
-scm_duplicate_port (oldpt, modes)
- SCM oldpt;
- SCM modes;
-{
- int oldfd;
- int newfd;
- FILE *f;
- SCM newpt;
- SCM_ASSERT (SCM_NIMP (oldpt) && SCM_OPPORTP (oldpt), oldpt, SCM_ARG1, s_duplicate_port);
- SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_duplicate_port);
- SCM_NEWCELL (newpt);
- SCM_DEFER_INTS;
- oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
- if (oldfd == -1)
- scm_syserror (s_duplicate_port);
- SCM_SYSCALL (newfd = dup (oldfd));
- if (newfd == -1)
- scm_syserror (s_duplicate_port);
- f = fdopen (newfd, SCM_CHARS (modes));
- if (!f)
- {
- SCM_SYSCALL (close (newfd));
- scm_syserror (s_duplicate_port);
- }
- {
- struct scm_port_table * pt;
- pt = scm_add_to_port_table (newpt);
- SCM_SETPTAB_ENTRY (newpt, pt);
- SCM_SETCAR (newpt, scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes)));
- if (SCM_BUF0 & SCM_CAR (newpt))
- scm_setbuf0 (newpt);
- SCM_SETSTREAM (newpt, (SCM)f);
- SCM_PTAB_ENTRY (newpt)->file_name = SCM_PTAB_ENTRY (oldpt)->file_name;
- }
- SCM_ALLOW_INTS;
- return newpt;
-}
-
-
-