![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fex3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / lisp|
Return to fex3.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / lisp |
1.1 ! root 1: static char *sccsid = "@(#)fex3.c 34.2 10/13/80"; ! 2: ! 3: #include "global.h" ! 4: #include <vadvise.h> ! 5: ! 6: /* chkarg ***************************************************************/ ! 7: /* This insures that there are at least expnum arguments passed to the */ ! 8: /* BCD function that calls this. If there are fewer, nil arguments */ ! 9: /* are pushed onto the name stack and np adjusted accordingly. */ ! 10: #ifdef chkarg ! 11: #undef chkarg ! 12: #endif ! 13: chkarg(expnum,string) ! 14: int expnum; /* expected number of args */ ! 15: char string[]; ! 16: { ! 17: register struct argent *work; ! 18: register r10,r9,r8; ! 19: register struct argent *lbot, *np; ! 20: saveonly(1); ! 21: ! 22: for(work = np,np = lbot + expnum; work < np; ) ! 23: work++->val = nil; ! 24: } ! 25: ! 26: ! 27: /* ! 28: *Ndumplisp -- create executable version of current state of this lisp. ! 29: */ ! 30: #include "a.out.h" ! 31: ! 32: asm(" .globl Dlast") ! 33: lispval ! 34: Ndumplisp() ! 35: { ! 36: register struct exec *workp; ! 37: register lispval argptr, temp; ! 38: register char *fname; ! 39: extern lispval reborn; ! 40: struct exec work, old; ! 41: extern etext; ! 42: extern int dmpmode,holend,curhbeg,usehole; ! 43: extern int end; ! 44: int descrip, des2, count, ax,mode; ! 45: char tbuf[BUFSIZ]; ! 46: snpand(4); ! 47: ! 48: ! 49: #ifndef UNIXTS ! 50: vadvise(VA_ANOM); ! 51: #endif ! 52: ! 53: /* dump mode is kept in decimal (which looks like octal in dmpmode) ! 54: and is changeable via (sstatus dumpmode n) where n is 413 or 410 ! 55: base 10 ! 56: */ ! 57: if(dmpmode == 413) mode = 0413; ! 58: else mode = 0410; ! 59: ! 60: workp = &work; ! 61: workp->a_magic = mode; ! 62: if(usehole) ! 63: workp->a_text = curhbeg & (~PAGRND); ! 64: else ! 65: workp->a_text = ((((unsigned) (&holend)) - 1) & (~PAGRND)) + PAGSIZ; ! 66: #ifndef VMS ! 67: workp->a_data = (unsigned) sbrk(0) - workp->a_text; ! 68: #else ! 69: workp->a_data = ((int)&end) - workp->a_text; ! 70: #endif ! 71: workp->a_bss = 0; ! 72: workp->a_syms = 0; ! 73: workp->a_entry = (unsigned) gstart(); ! 74: workp->a_trsize = 0; ! 75: workp->a_drsize = 0; ! 76: ! 77: fname = "savedlisp"; /*set defaults*/ ! 78: reborn = CNIL; ! 79: argptr = lbot->val; ! 80: if (argptr != nil) { ! 81: temp = argptr->d.car; ! 82: if((TYPE(temp))==ATOM) ! 83: fname = temp->a.pname; ! 84: } ! 85: des2 = open(gstab(),0); ! 86: if(des2 >= 0) { ! 87: if(read(des2,&old,sizeof(old))>=0) ! 88: work.a_syms = old.a_syms; ! 89: } ! 90: descrip=creat(fname,0777); /*doit!*/ ! 91: if(-1==write(descrip,workp,sizeof(work))) ! 92: { ! 93: close(descrip); ! 94: error("Dumplisp failed",FALSE); ! 95: } ! 96: if(mode == 0413) lseek(descrip,PAGSIZ,0); ! 97: if( -1==write(descrip,0,workp->a_text) || ! 98: -1==write(descrip,workp->a_text,workp->a_data) ) { ! 99: close(descrip); ! 100: error("Dumplisp failed",FALSE); ! 101: } ! 102: if(des2>0 && work.a_syms) { ! 103: count = old.a_text + old.a_data + sizeof(old); ! 104: if(-1==lseek(des2,count,0)) ! 105: error("Could not seek to stab",FALSE); ! 106: asm("Dlast:"); ! 107: for(count = old.a_syms;count > 0; count -=BUFSIZ) { ! 108: ax = read(des2,tbuf,BUFSIZ); ! 109: if(ax==0) { ! 110: printf("Unexpected end of syms",count); ! 111: fflush(stdout); ! 112: break; ! 113: } ! 114: if(ax > 0) ! 115: write(descrip,tbuf,ax); ! 116: else ! 117: error("Failure to write dumplisp stab",FALSE); ! 118: } ! 119: } ! 120: close(descrip); ! 121: if(des2>0) close(des2); ! 122: reborn = 0; ! 123: ! 124: #ifndef UNIXTS ! 125: vadvise(VA_NORM); ! 126: #endif ! 127: return(nil); ! 128: } ! 129: ! 130: lispval ! 131: Nndumplisp() ! 132: { ! 133: register struct exec *workp; ! 134: register lispval argptr, temp; ! 135: register char *fname; ! 136: extern lispval reborn; ! 137: struct exec work, old; ! 138: extern etext; ! 139: extern int dmpmode,holend,curhbeg,usehole; ! 140: int descrip, des2, count, ax,mode; ! 141: char tbuf[BUFSIZ]; ! 142: snpand(4); ! 143: ! 144: ! 145: #ifndef UNIXTS ! 146: vadvise(VA_ANOM); ! 147: #endif ! 148: ! 149: /* dump mode is kept in decimal (which looks like octal in dmpmode) ! 150: and is changeable via (sstatus dumpmode n) where n is 413 or 410 ! 151: base 10 ! 152: */ ! 153: if(dmpmode == 413) mode = 0413; ! 154: else mode = 0410; ! 155: ! 156: workp = &work; ! 157: workp->a_magic = mode; ! 158: if(usehole) ! 159: workp->a_text = curhbeg & (~PAGRND); ! 160: else ! 161: workp->a_text = ((((unsigned) (&holend)) - 1) & (~PAGRND)) + PAGSIZ; ! 162: workp->a_data = (unsigned) sbrk(0) - workp->a_text; ! 163: workp->a_bss = 0; ! 164: workp->a_syms = 0; ! 165: workp->a_entry = (unsigned) gstart(); ! 166: workp->a_trsize = 0; ! 167: workp->a_drsize = 0; ! 168: ! 169: fname = "savedlisp"; /*set defaults*/ ! 170: reborn = CNIL; ! 171: argptr = lbot->val; ! 172: if (argptr != nil) { ! 173: temp = argptr->d.car; ! 174: if((TYPE(temp))==ATOM) ! 175: fname = temp->a.pname; ! 176: } ! 177: des2 = open(gstab(),0); ! 178: if(des2 >= 0) { ! 179: if(read(des2,&old,sizeof(old))>=0) ! 180: work.a_syms = old.a_syms; ! 181: } ! 182: descrip=creat(fname,0777); /*doit!*/ ! 183: if(-1==write(descrip,workp,sizeof(work))) ! 184: { ! 185: close(descrip); ! 186: error("Dumplisp failed",FALSE); ! 187: } ! 188: if(mode == 0413) lseek(descrip,PAGSIZ,0); ! 189: if( -1==write(descrip,0,workp->a_text) || ! 190: -1==write(descrip,workp->a_text,workp->a_data) ) { ! 191: close(descrip); ! 192: error("Dumplisp failed",FALSE); ! 193: } ! 194: if(des2>0 && work.a_syms) { ! 195: count = old.a_text + old.a_data + (old.a_magic == 0413 ? PAGSIZ ! 196: : sizeof(old)); ! 197: if(-1==lseek(des2,count,0)) ! 198: error("Could not seek to stab",FALSE); ! 199: for(count = old.a_syms;count > 0; count -=BUFSIZ) { ! 200: ax = read(des2,tbuf,(count < BUFSIZ ? count : BUFSIZ)); ! 201: if(ax==0) { ! 202: printf("Unexpected end of syms",count); ! 203: fflush(stdout); ! 204: break; ! 205: } else if(ax > 0) ! 206: write(descrip,tbuf,ax); ! 207: else ! 208: error("Failure to write dumplisp stab",FALSE); ! 209: } ! 210: if(-1 == lseek(des2, ! 211: (old.a_magic == 0413 ? PAGSIZ : sizeof(old)) ! 212: + old.a_text + old.a_data ! 213: + old.a_trsize + old.a_drsize + old.a_syms, ! 214: 0)) ! 215: error(" Could not seek to string table ",FALSE); ! 216: for( ax = 1 ; ax > 0;) { ! 217: ax = read(des2,tbuf,BUFSIZ); ! 218: if(ax > 0) ! 219: write(descrip,tbuf,ax); ! 220: else if (ax < 0) ! 221: error("Error in string table read ",FALSE); ! 222: } ! 223: } ! 224: close(descrip); ! 225: if(des2>0) close(des2); ! 226: reborn = 0; ! 227: ! 228: #ifndef UNIXTS ! 229: vadvise(VA_NORM); ! 230: #endif ! 231: return(nil); ! 232: } ! 233: lispval ! 234: typred(typ,ptr) ! 235: int typ; ! 236: lispval ptr; ! 237: ! 238: { int tx; ! 239: if ((tx = TYPE(ptr)) == typ) return(tatom); ! 240: if ((tx == INT) && (typ == ATOM)) return(tatom); ! 241: return(nil); ! 242: } ! 243: lispval ! 244: Nfunction() ! 245: { ! 246: register lispval handy; ! 247: ! 248: snpand(1); ! 249: handy = lbot->val->d.car; ! 250: if(TYPE(handy)==ATOM && handy->a.fnbnd!=nil) ! 251: return(handy->a.fnbnd); ! 252: else ! 253: return(handy); ! 254: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.