|
|
1.1 ! root 1: #include "apl.h" ! 2: ! 3: ex_dibm() ! 4: { ! 5: int inde, fsize; ! 6: char fname[128]; ! 7: register i; ! 8: register char *a, *b; ! 9: ! 10: inde = topfix(); ! 11: a = fetch1(); ! 12: if(a->type!=CH) { ! 13: if(a->size==0||a->size==1&&fuzz(*a->datap,0.0)==0) { ! 14: push(newdat(DA,1,0)); ! 15: switch(inde) { ! 16: case 1: ! 17: if(i=ifile) ! 18: close(i); ! 19: ifile = 0; ! 20: return; ! 21: case 2: ! 22: case 3: ! 23: if((i=ofile)&&i!=1) ! 24: close(i); ! 25: ofile = 1; ! 26: return; ! 27: default: ! 28: error("mibm D"); ! 29: } ! 30: } ! 31: error("mibm T"); ! 32: } ! 33: if(a->rank!=1) ! 34: error("dibm R"); ! 35: if(!(1<=a->size&&a->size<128)) ! 36: error("fnam L"); ! 37: fsize = a->size; ! 38: b = a->datap; ! 39: a = fname; ! 40: for(i=0; i<fsize; ++i) ! 41: *a++ = *b++; ! 42: *a = '\0'; ! 43: push(newdat(DA,1,0)); ! 44: switch(inde) { ! 45: case 1: /* Open for reading */ ! 46: if(i=ifile) ! 47: close(i); ! 48: if((i=open(fname,0))<0) ! 49: goto badfile; ! 50: ifile = i; ! 51: return; ! 52: case 2: /* Open for writing */ ! 53: if((i=ofile)&&i!=1) ! 54: close(i); ! 55: if((i=creat(fname,0666))<0) ! 56: goto badfile; ! 57: ofile = i; ! 58: return; ! 59: case 3: /* Open and append */ ! 60: if((i=ofile)&&i!=1) ! 61: close(i); ! 62: if((i=open(fname,1))<0) ! 63: if((i=creat(fname,0666))<0) ! 64: goto badfile; ! 65: lseek(i, 0, 2); ! 66: ofile = i; ! 67: return; ! 68: case 10: { ! 69: ! 70: int shellpid, oldsignal, termproc; ! 71: ! 72: oldsignal = signal(2, 1); ! 73: if(!(shellpid=vfork())) ! 74: execl(getenv("SHELL") ? getenv("SHELL") : "/bin/sh", "sh", "-c", fname, 0); ! 75: else ! 76: while((termproc=wait(&termproc))!=-1) ! 77: if(termproc==shellpid) ! 78: break; ! 79: signal(2, oldsignal); ! 80: return; ! 81: } ! 82: default: ! 83: error("dibm unk"); ! 84: } ! 85: badfile: ! 86: error("bad file"); ! 87: } ! 88: ! 89: ex_mibm() ! 90: { ! 91: register *p; ! 92: int t[6]; ! 93: ! 94: switch(topfix()) { ! 95: ! 96: default: ! 97: error("ib unk"); ! 98: ! 99: case 1: ! 100: sclr(); ! 101: datum = 0; ! 102: break; ! 103: ! 104: case 20: /* time of day */ ! 105: time(t); ! 106: p = t; ! 107: goto tod; ! 108: ! 109: case 21: /* CPU time */ ! 110: times(t); ! 111: t[3] = t[0]; ! 112: t[0] = 0; ! 113: t[2] = 0; ! 114: datum = ltod(t) + ltod(t+2); ! 115: break; ! 116: ! 117: case 22: /* Ws free */ /* RH 24-Apr-78 UCSF */ ! 118: { ! 119: struct freeblk { ! 120: unsigned size; ! 121: struct freeblk *nxtblk; ! 122: }; ! 123: ! 124: extern int freelist[], sbrk(); ! 125: register struct freeblk *runthru = freelist; ! 126: register unsigned int freesum = 0160000; ! 127: ! 128: freesum -= sbrk(0); ! 129: while(runthru->nxtblk!=-1) { ! 130: freesum += runthru->size; ! 131: runthru = runthru->nxtblk; ! 132: } ! 133: datum = freesum + runthru->size; ! 134: } ! 135: break; ! 136: ! 137: case 24: /* starting time */ ! 138: p = stime; ! 139: ! 140: tod: ! 141: p = localtime(p); ! 142: datum = 60.*(p[0]+60.*(p[1]+60.*p[2])); ! 143: break; ! 144: ! 145: case 25: /* date */ ! 146: time(t); ! 147: p = t; ! 148: goto dt; ! 149: ! 150: /* ! 151: * non standard I functions ! 152: */ ! 153: ! 154: case 28: /* starting date */ ! 155: p = stime; ! 156: ! 157: dt: ! 158: p = localtime(p); ! 159: datum = p[5]+100.*(p[3]+100.*(p[4]+1)); ! 160: break; ! 161: ! 162: case 29: /* iorg */ ! 163: datum = thread.iorg; ! 164: break; ! 165: ! 166: case 30: /* width */ ! 167: datum = thread.width; ! 168: break; ! 169: ! 170: case 31: /* digits */ ! 171: datum = thread.digits; ! 172: break; ! 173: ! 174: case 32: ! 175: { ! 176: int shellpid, oldsignal, termproc; ! 177: ! 178: oldsignal = signal(2, 1); ! 179: if(!(shellpid=fork())) ! 180: execl("/bin/csh","-",0); ! 181: else ! 182: while((termproc=wait(&termproc))!=-1) ! 183: if(termproc==shellpid) ! 184: break; ! 185: signal(2, oldsignal); ! 186: push(newdat(DA,1,0)); ! 187: return; ! 188: } ! 189: } ! 190: p = newdat(DA, 0, 1); ! 191: p->datap[0] = datum; ! 192: push(p); ! 193: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.