Return to fex3.c CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / lisp

Annotation of 3BSD/cmd/lisp/fex3.c, revision 1.1

1.1     ! root        1: #include "global.h"
        !             2: 
        !             3: /* chkarg ***************************************************************/
        !             4: /* This insures that there are at least expnum arguments passed to the */
        !             5: /* BCD function that calls this.  If there are fewer, nil arguments    */
        !             6: /* are pushed onto the name stack and np adjusted accordingly.         */
        !             7: chkarg(expnum)
        !             8: int    expnum;                 /* expected number of args      */
        !             9: {
        !            10:        register struct argent *work;
        !            11:        register r10,r9,r8;
        !            12:        register struct argent *lbot, *np;
        !            13:        saveonly(1);
        !            14: 
        !            15:        for(work = np,np = lbot + expnum; work < np; )
        !            16:                work++->val = nil;
        !            17:                
        !            18: }
        !            19: 
        !            20: 
        !            21: /*
        !            22:  *Ndumplisp -- create executable version of current state of this lisp.
        !            23:  */
        !            24: #include <a.out.h>
        !            25: 
        !            26: asm("  .globl  Dlast")
        !            27: lispval
        !            28: Ndumplisp()
        !            29: {
        !            30:        register struct exec *workp;
        !            31:        register lispval argptr, temp;
        !            32:        register char *fname;
        !            33:        extern lispval reborn;
        !            34:        struct exec work, old;
        !            35:        extern etext;
        !            36:        extern int dmpmode;
        !            37:        int descrip, des2, count, ax,mode;
        !            38:        char tbuf[BUFSIZ];
        !            39:        snpand(4);
        !            40: 
        !            41:        /* dump mode is kept in decimal (which looks like octal in dmpmode)
        !            42:           and is changeable via (sstatus dumpmode n) where n is 413 or 410
        !            43:           base 10              
        !            44:        */
        !            45:        if(dmpmode == 413) mode = 0413;
        !            46:        else mode = 0410;
        !            47: 
        !            48:        workp = &work;
        !            49:        workp->a_magic  = mode;
        !            50:        workp->a_text   = ((((unsigned) (&etext)) - 1) & (~PAGRND)) + PAGSIZ;
        !            51:        workp->a_data   = (unsigned) sbrk(0) - workp->a_text;
        !            52:        workp->a_bss    = 0;
        !            53:        workp->a_syms   = 0;
        !            54:        workp->a_entry  = (unsigned) gstart();
        !            55:        workp->a_trsize = 0;
        !            56:        workp->a_drsize = 0;
        !            57: 
        !            58:        fname = "savedlisp"; /*set defaults*/
        !            59:        reborn = CNIL;
        !            60:        argptr = lbot->val;
        !            61:        if (argptr != nil) {
        !            62:                temp = argptr->car;
        !            63:                if((TYPE(temp))==ATOM)
        !            64:                        fname = temp->pname;
        !            65:        }
        !            66:        des2 = open(gstab(),0);
        !            67:        if(des2 >= 0) {
        !            68:                if(read(des2,&old,sizeof(old))>=0)
        !            69:                        work.a_syms = old.a_syms;
        !            70:        }
        !            71:        descrip=creat(fname,0777); /*doit!*/
        !            72:        if(-1==write(descrip,workp,sizeof(work)))
        !            73:        {
        !            74:                close(descrip);
        !            75:                error("Dumplisp failed",FALSE);
        !            76:        }
        !            77:        if(mode == 0413) lseek(descrip,PAGSIZ,0); 
        !            78:        if( -1==write(descrip,0,workp->a_text)    ||
        !            79:            -1==write(descrip,workp->a_text,workp->a_data) ) {
        !            80:                close(descrip);
        !            81:                error("Dumplisp failed",FALSE);
        !            82:        }
        !            83:        if(des2>0  && work.a_syms) {
        !            84:                count = old.a_text + old.a_data + sizeof(old);
        !            85:                if(-1==lseek(des2,count,0))
        !            86:                        error("Could not seek to stab",FALSE);
        !            87:                asm("Dlast:");
        !            88:                for(count = old.a_syms;count > 0; count -=BUFSIZ) {
        !            89:                        ax = read(des2,tbuf,BUFSIZ);
        !            90:                        if(ax==0) {
        !            91:                                printf("Unexpected end of syms",count);
        !            92:                                fflush(stdout);
        !            93:                                break;
        !            94:                        }
        !            95:                        if(ax >  0)
        !            96:                                write(descrip,tbuf,ax);
        !            97:                        else 
        !            98:                                error("Failure to write dumplisp stab",FALSE);
        !            99:                }
        !           100:        }
        !           101:        close(descrip);
        !           102:        if(des2>0) close(des2);
        !           103:        reborn = 0;
        !           104:        return(nil);
        !           105: }
        !           106: lispval
        !           107: typred(typ,ptr)
        !           108: int    typ;
        !           109: lispval        ptr;
        !           110: 
        !           111: {   int tx;
        !           112:        if ((tx = TYPE(ptr)) == typ) return(tatom);
        !           113:        if ((tx == INT) && (typ == ATOM)) return(tatom);
        !           114:        return(nil);
        !           115: }
        !           116: lispval
        !           117: Nfunction()
        !           118: {
        !           119:        register lispval handy;
        !           120: 
        !           121:        snpand(1);
        !           122:        handy = lbot->val->car;
        !           123:        if(TYPE(handy)==ATOM && handy->fnbnd!=nil)
        !           124:                return(handy->fnbnd);
        !           125:        else
        !           126:                return(handy);
        !           127: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.