fd_to_stream function

[yeh@cs.purdue.edu (Wei Jen Yeh)]

Hello,
  I wonder if someone can see what I did wrong in the following code.
I'm trying to code up a unix-fd-2-lisp-stream function so that I can do
io at higher level.  The particular fd was returned from accept.
However, when I called the _srv_accept function, akcl reported that memory
may be damaged.  I basically copied the code from file.d, but somehow it just
didn't work.  I've enclosed the fd_to_stream function and a script below.
Thanks in advance for any help.

Wei Jen Yeh                      yeh@cs.purdue.edu
                                 Department of Computer Science
                                 Purdue University
                                 West Lafayette, Indiana

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

object fd_to_stream
        (fd, smm)
        int fd;
        enum smmode smm;
{
        FILE *fp;
        object x;
        extern object Sstring_char;
        vs_mark;

        fp = (&_iob[fd]);
        x = alloc_object(t_stream);
        x->sm.sm_mode = (short)smm;
        x->sm.sm_fp = fp;
        fp->_base = BASEFF;
        x->sm.sm_buffer = 0;
        x->sm.sm_object0 = Sstring_char;
        x->sm.sm_object1 = \"stream_sock\";
        x->sm.sm_int0 = x->sm.sm_int1 = 0;
        vs_push(x);
        {char *buf=alloc_contblock(BUFSIZ);
        x->sm.sm_buffer = buf;
        setbuf(fp, buf);
        }
        vs_reset;
        return(x);
}
AKCL (Austin Kyoto Common Lisp)  Version(1.615) Wed Aug 19 14:58:11 EST 1992
Contains Enhancements by W. Schelter

>(cfs "socket")
Compiling ./socket.lsp.
End of Pass 1.
End of Pass 2.
OPTIMIZE levels: Safety=2, Space=0, Speed=3
Finished compiling ./socket.
T

>(si::faslink "socket.o" "-lc")
start address -T 39b808 1848

>(setq host (_srv_current_host))
"jessie.cs.purdue.edu"

>(setq sock (_srv_create_listening_socket host 3012))
3

>(trace _srv_accept)
(_SRV_ACCEPT)

>(setq stream (_srv_accept 3))
  1> (_SRV_ACCEPT 3)
  <1
Error: Caught fatal error [memory may be damaged]
Fast links are on: do (use-fast-links nil) for debugging
Error signalled by SYSTEM::TRACE-CALL.
Broken at SYSTEM::TRACE-CALL.  Type :H for Help.