| 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 | } |