|
|
1.1 ! root 1: #include "global.h" ! 2: #include <a.out.h> ! 3: #define STRLIM 1024 ! 4: ! 5: static lispval mkptr(); ! 6: static struct exec header; ! 7: static struct nlist nlist; ! 8: static lispval *linkaddr; ! 9: static int *bindaddr; ! 10: static int fildes; ! 11: static lispval currtab; ! 12: static lispval curibase; ! 13: extern int fvirgin; ! 14: extern int initflag; ! 15: lispval ! 16: Lbind(){ ! 17: register struct argent *mlbot = lbot; ! 18: register lispval work; ! 19: char *sbrk(), *tfile, cbuf[512], *mytemp(), *gstab(); ! 20: ! 21: snpand(2); ! 22: ! 23: strcpy(cbuf, gstab()); ! 24: printf("getting symbol table from %s\n",cbuf); fflush(stdout); ! 25: if((fildes = open(cbuf,0))<0) ! 26: return(nil); ! 27: /* ! 28: * Read a.out header to find out where symbol table is. ! 29: */ ! 30: if(read(fildes,(char *)&header,sizeof(header)) <= 0) { ! 31: close(fildes); ! 32: return(nil); ! 33: } ! 34: ! 35: lseek(fildes, header.a_text+header.a_data+header.a_trsize ! 36: +header.a_drsize, 1); ! 37: ! 38: currtab = Vreadtable->clb; ! 39: Vreadtable->clb = strtab; ! 40: curibase = ibase->clb; ! 41: ibase->clb = inewint(10); ! 42: while((sizeof nlist)==read(fildes,&nlist,sizeof nlist)) { ! 43: if( nlist.n_name[0]!='.' || nlist.n_name[1]!='.') ! 44: continue; ! 45: ! 46: linkaddr = (lispval *)*(int *)nlist.n_value; ! 47: bindaddr = (int *)*(int *)(nlist.n_value+sizeof(int)); ! 48: do_linker(); ! 49: do_binder(); ! 50: } ! 51: ibase->clb = curibase; ! 52: Vreadtable->clb = currtab; ! 53: return(tatom); ! 54: } ! 55: ! 56: static do_linker() ! 57: { ! 58: register int *i, *end, temp; ! 59: char array[STRLIM]; ! 60: extern lispval *bind_lists; ! 61: ! 62: /* first link this linkage table to the garbage ! 63: collector's list. We will try to be tricky ! 64: so that if the garbage collector is invoked ! 65: by mkptr we will not cause markdp() to go off ! 66: the deep end. ! 67: */ ! 68: *(linkaddr-1) = (lispval) bind_lists; ! 69: bind_lists = linkaddr; ! 70: i = (int *)linkaddr; ! 71: initflag = TRUE; ! 72: for(; *i!=-1; i++) { ! 73: temp = *i; ! 74: *i = -1; /* clobber to short circuit gc */ ! 75: findstr(temp, array); ! 76: *i = (int)mkptr(array); ! 77: } ! 78: initflag = FALSE; ! 79: } ! 80: static do_binder() ! 81: { ! 82: char array[STRLIM]; ! 83: register lispval handy; ! 84: struct binder {lispval (*b_entry)(); ! 85: int b_atmlnk; ! 86: int b_type;} bindage, *pos; ! 87: ! 88: pos = (struct binder *)bindaddr; ! 89: initflag = TRUE; ! 90: for(bindage= *pos++; bindage.b_atmlnk!=-1; bindage = *pos++) { ! 91: if( bindage.b_type == 99) { ! 92: struct argent *olbot; ! 93: /* we must evaluate this form for effect */ ! 94: ! 95: findstr(bindage.b_atmlnk, array); ! 96: /* garbage collection appears to ! 97: cause problems at this point */ ! 98: /* if(ISNIL(copval(gcload,CNIL)) && loading->clb != tatom) ! 99: gc(CNIL); /* do a gc if gc will be off */ ! 100: handy = mkptr(array); ! 101: olbot = lbot; ! 102: lbot = np; ! 103: ibase->clb=curibase; ! 104: Vreadtable->clb = currtab; ! 105: (np++)->val = handy; ! 106: Leval(); ! 107: Vreadtable->clb = strtab; ! 108: curibase = ibase->clb; ! 109: ibase->clb = inewint(10); ! 110: np = lbot; ! 111: lbot = olbot; ! 112: } else { ! 113: handy = newfunct(); ! 114: handy->entry = bindage.b_entry; ! 115: handy->discipline = (bindage.b_type == 0 ? lambda : ! 116: bindage.b_type == 1 ? nlambda : ! 117: macro); ! 118: ! 119: findstr(bindage.b_atmlnk, array); ! 120: protect(handy); ! 121: mkptr(array)->fnbnd = handy; ! 122: } ! 123: } ! 124: initflag = FALSE; ! 125: } ! 126: ! 127: static ! 128: findstr(ptr,array) ! 129: int ptr; ! 130: char *array; ! 131: { ! 132: int cnt = 0; ! 133: char *cp; ! 134: ! 135: cp = ptr + (char *)bindaddr; ! 136: while(cnt<STRLIM && (array[cnt++] = *cp++)); ! 137: } ! 138: ! 139: static ! 140: lispval ! 141: mkptr(str) ! 142: register char *str; ! 143: { ! 144: lispval work, Lread(); ! 145: FILE *opiport = piport; ! 146: register FILE *p=stdin; ! 147: struct argent *olbot; ! 148: snpand(2); ! 149: ! 150: /* find free file descriptor */ ! 151: for(;p->_flag&(_IOREAD|_IOWRT);p++) ! 152: if(p >= _iob + _NFILE) ! 153: error("Too many open files to do readlist",FALSE); ! 154: p->_flag = _IOREAD | _IOSTRG; ! 155: p->_base = p->_ptr = str; ! 156: p->_cnt = strlen(str) + 1; ! 157: ! 158: olbot = lbot; ! 159: lbot = np; ! 160: piport = p; ! 161: protect(P(p)); ! 162: work = Lread(); ! 163: piport = opiport; ! 164: lbot = olbot; ! 165: p->_cnt = 0; ! 166: p->_ptr = p->_base = 0; ! 167: p->_file = 0; ! 168: p->_flag=0; ! 169: return(work); ! 170: } ! 171: ! 172: ! 173: ! 174:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.