/* PUT_LOGFILE -- Put a command into the logfile, if logging is enabled. * Otherwise check if the logfile is open and close it, in case user has * just turned logging off. If the "share_logfile" switch is set the logfile * is opened and closed each time a record is appended to the file, allowing * other processes to access the same file. */ void put_logfile (char *command) { FILE *fp; if (keeplog()) { if (logfp == NULL) if (open_logfile (logfile()) == ERR) /* Do not abort by calling cl_error(). We could be a * background job accessing a shared logfile. Also, we * want to avoid error recursion when logging an error. */ return; if (share_logfile) { if ((fp = fopen (logfile(), "a"))) { print_command (fp, command, "", ""); fclose (fp); } } else print_command (logfp, command, "", ""); } else if (logfp != NULL) close_logfile (logfile()); }
/* BKG_CLOSE -- Close a bkg job. Called after determining that the job has * terminated. */ static void bkg_close ( int job, /* job ordinal */ int pmsg /* print termination message */ ) { register struct _bkgjob *bk = &jobtable[job-1]; bk->b_clock = c_clktime (bk->b_clock); bk->b_exitcode = c_prcldpr (bk->b_jobno); bk->b_flags &= ~(J_RUNNING|J_SERVICE); if (bk->b_verbose && (pmsg > 1 || (pmsg == 1 && !notify()))) { if (bk->b_exitcode != OK) eprintf ("[%d] exit %d\n", job, bk->b_exitcode); else eprintf ("[%d] done\n", job); } /* Make a logfile entry, saying the background job ended. */ if (keeplog() && log_background()) { char buf[SZ_LINE]; sprintf (buf, "Stop [%d]", job); putlog (0, buf); } }
/* PUTLOG -- Format and write a message to the logfile. This is called by * the putlog builtin (clputlog() in builtin.c) and in some places in the * CL (e.g., exec.c). */ void putlog ( struct task *tp, /* pointer to task or NULL */ char *usermsg ) { register char *ip, *op, *otop; register int n; char msg[SZ_LOGBUF], job[5]; char *pkg, *tname, *today(); extern int bkgno; /* job number if bkg job */ if (!keeplog()) return; /* If background job, format job number, but only if background * logging is enabled. */ if (firstask->t_flags & T_BATCH) { if (log_background()) sprintf (job, "[%d] ", bkgno); else return; } else job[0] = EOS; /* If a valid task pointer is given, get the package and task name. * Otherwise, assume it's an internal (cl) logging message. */ if (tp) { pkg = tp->t_ltp->lt_pkp->pk_name; tname = tp->t_ltp->lt_lname; } else { pkg = "cl"; tname = ""; } /* Format the message. Only use time, no day and date. Break long * messages into several lines. */ sprintf (msg, "# %8.8s %s%s%s %s- ", (today() + 4), pkg, (tp ? "." : ""), tname, job); otop = &msg[SZ_LOGBUF]; for (op=msg, n=0; *op && op < otop; op++) n++; for (ip=usermsg; (*op++ = *ip++) && op < otop; n++) if (n + 2 >= MAXCOL) { *op++ = '\\'; *op++ = '\n'; n = 0; } *(op-1) = '\n'; *op = EOS; put_logfile (msg); }
int main(int argc, char **argv) { FILE *fp; attach_SHM(); resolve_boards(); if(argc != 5) { printf("usage: %s <board name> <title> <owner> <file>\n", argv[0]); return 0; } if(strcmp(argv[4], "-") == 0) fp = stdin; else { fp = fopen(argv[4], "r"); if(!fp) { perror(argv[4]); return 1; } } keeplog(fp, argv[1], argv[2], argv[3]); return 0; }
/* BKG_SPAWN -- Spawn a new background job. Called by main() when we have * seen an '&'. */ void bkg_spawn ( char *cmd /* command entered by user to spawn job */ ) { register struct _bkgjob *bk; register int jobno, stat; char clprocess[SZ_PATHNAME]; char *wbkgfile(); char *bkgfile; /* Find first unused slot in a circular search. */ bkg_update (1); jobno = (lastjobno == NBKG) ? 1 : lastjobno + 1; while (jobno != lastjobno) { if (!busy (jobno)) break; if (jobno++ >= NBKG) jobno = 1; } if (jobno == lastjobno) cl_error (E_UERR, "no more background job slots"); /* Write bkgfile. Delete any dreg bkg communication files. */ bkg_delfiles (jobno); bkgfile = wbkgfile (jobno, cmd, NULL); /* Spawn bkg job. */ sprintf (clprocess, "%s%s", CLDIR, CLPROCESS); intr_disable(); jobtable[jobno-1].b_jobno = stat = c_propdpr (findexe (firstask->t_curpack, clprocess), bkgfile, bkgmsg); if (stat == NULL) { c_delete (bkgfile); intr_enable(); cl_error (E_IERR, "cannot spawn background CL"); } else { bk = &jobtable[jobno-1]; bk->b_flags = J_RUNNING; bk->b_clock = c_clktime (0L); bk->b_verbose = 2; strncpy (bk->b_cmd, cmd, SZ_CMD); *(bk->b_cmd+SZ_CMD) = EOS; intr_enable(); } eprintf ("[%d]\n", lastjobno = jobno); /* Make a logfile entry, saying we started the background job. */ if (keeplog() && log_background()) { char buf[SZ_LINE]; sprintf (buf, "Start [%d]", jobno); putlog (0, buf); } }
void cl_error (int errtype, char *diagstr, ...) { va_list args; register struct task *tp; static int nfatal = 0; static int break_locks = 1; va_start (args, diagstr); /* (Re)-initialize the error action. */ erract_init(); /* Safety measure, in the event of error recursion. */ if (err_abort) { if (nfatal) clexit(); if (errlev++ > 2) { nfatal++; eprintf ("Error recursion. Cl dies.\n"); clexit(); } } /* The first setjmp(errenv) is not done until we start the main loop. * Set validerrenv when start the first interactive cl to indicate that * we may safely longjmp back to main's loop on an error. ERRENV is * not set for bkg jobs since error restart is not permitted. */ if (!validerrenv && !(firstask->t_flags & T_BATCH)) { nfatal++; u_doprnt (diagstr, &args, currentask->t_stderr); if (errtype & E_P) perror ("\nOS errmsg"); else eprintf ("\n"); eprintf ("Fatal startup error. CL dies.\n"); clexit(); } /* Any error occurring during logout is fatal. */ if (loggingout || gologout) { nfatal++; u_doprnt (diagstr, &args, currentask->t_stderr); if (errtype & E_P) perror ("\nOS errmsg"); else eprintf ("\n"); eprintf ("Fatal logout error. CL dies.\n"); clexit(); } /* Perform any ONERROR error recovery in the vos first. Initialize * the error recovery mechanism (necessary since the iraf main is not * being allowed to do error recovery). */ c_xonerr (1); XER_RESET(); /* TODO: move into LIBC interface */ /* Clear terminal raw mode if still set. */ c_fseti ((XINT)STDIN, F_RAW, NO); if (firstask->t_flags & T_BATCH) eprintf ("\n[%d] ", bkgno); if (errtype & E_IERR) eprintf ("INTERNAL "); if (errtype & E_FERR) eprintf ("FATAL "); /* Disable error tracing if requested. */ if (err_trace == YES || (errtype & E_UERR)) { if (currentask->t_flags & T_SCRIPT && currentask->t_flags & T_INTERACTIVE) eprintf ("ERROR on line %d: ", errorline); else eprintf ("ERROR: "); u_doprnt (diagstr, &args, currentask->t_stderr); if (errtype & E_P) perror ("\nOS errmsg"); else eprintf ("\n"); } /* Log the error message if from a script or an executable. */ if (!errlog && keeplog() && log_errors()) { if (currentask->t_flags & T_SCRIPT || currentask->t_pid != -1) { PKCHAR buf[SZ_LINE+1]; FILE *fp; int fd; fd = c_stropen (buf, SZ_LINE, NEW_FILE); fp = fdopen (fd, "w"); fprintf (fp, "ERROR on line %d: ", errorline); u_doprnt (diagstr, &args, fp); fclose (fp); c_close (fd); putlog (currentask, c_strpak (buf, (char *)buf, SZ_LINE)); } } errlog = 0; /* Initialize the current command block but do not log the command * which aborted. If we're only trapping errors and not fully * recovering, don't reset the command block so we have the option * to continue execution. */ if ((err_abort == YES && do_error == NO) || (do_error == YES || (errtype & E_UERR))) yy_startblock (NOLOG); /* Delete all pipefiles. Call iofinish() first as some OS's may * require that the files be closed before they can be deleted. */ for (tp=currentask; !(tp->t_flags & T_INTERACTIVE); tp=next_task(tp)) { iofinish (tp); if (tp == firstask) break; } delpipes (0); /* Do not go on if this is a fatal error or we are unattended. */ if (errtype & E_FERR) { nfatal++; pr_dumpcache (0, break_locks); clexit(); } else if (firstask->t_flags & T_BATCH) clshutdown(); /* Reset state variables. */ /* Most of these probably needn't be reset, but we'll play * it safe. */ nestlevel = 0; /* set nesting to 0 */ offsetmode (0); /* offset mode to index */ ncaseval = 0; /* number of case values */ n_indexes = 0; imloopset = 0; /* in an implicit loop */ n_oarr = 0; /* implicit loop indicators */ i_oarr = 0; maybeindex = 0; /* sexagesimal/index range */ parse_state = PARSE_FREE; if (last_parm) { /* have we tried to add a param */ last_parm->p_np = NULL; currentask->t_pfp->pf_lastpp = last_parm; last_parm = NULL; } /* Set the error flag. */ errcom.errflag++; errcom.nhandlers++; /* Get back to an interactive state. We simply return if we're * trapping errors except when processing a E_UERR. These type * messages come from the CL itself and require user attention to * correct (e.g. task not found, parameter type/syntax errors, etc). * The calling procedure is not expecting us to return, so we cannot * properly trap without rewriting the calling code. */ if (cltrace) { eprintf ("cl_error: abort=%d beep=%d trace=%d flpr=%d\n", err_abort, err_beep, err_trace, err_flpr); eprintf ("cl_error: code=%d do_err=%d errtype=%d/%d task='%s'\n", errcom.errcode, do_error, errtype, errtype&E_UERR, currentask->t_ltp->lt_lname); } if ((err_abort == YES && do_error == NO) || (do_error == YES || (errtype & E_UERR))) { extern ErrCom errcom; register struct param *pp; if (!errcom.errcode && (errtype & E_UERR)) { errcom.errcode = errtype; strcpy (errcom.errmsg, diagstr); strcpy (errcom.task, currentask->t_ltp->lt_lname); pp = paramfind (firstask->t_pfp, "$errno", 0, YES); pp->p_val.v_i = errcom.errcode; pp = paramfind (firstask->t_pfp, "$errmsg", 0, YES); pp->p_val.v_s = errcom.errmsg; pp = paramfind (firstask->t_pfp, "$errtask", 0, YES); pp->p_val.v_s = errcom.task; } taskunwind(); /* If an abort occurs while interrupts are disabled they will * never get reenabled unless we do so here. */ intr_reset(); /* Go back to main loop in main(). */ va_end (args); longjmp (errenv, 1); } else { va_end (args); return; } }
void rdcircsum(float *outpsf, osm_ds *head, int bin, float distance, float size, int tandem) { int Nxy,Nz,Nr; int ovrsmp; int symmetric; FILE *logfp,*infofp; float *pupil; /* Pupil function and its Fourier transform */ fcomplex *Cpupil; float *psfobj; /* One (xy) plane of the objective's PSF */ float *psfbin1; /* One plane (xy) of the intermediate PSF */ float *psfbin; /* One plane (xy) of the final PSF */ float *psfcond; /* One plane of the condenser PSF */ fcomplex *otfcond; float peak; /* Max. value of arrays (normalization) */ float illum; /* One sample of the illumination patern */ float tmp; float alpha; float *radpsf; /* PSF intensity image XY crossection */ float *psfxz; float Vxx, Vyx, /* Elements of the sampling matrix */ Vxy, Vyy; int iz, ir, ix, /* indices for depth, radial distance, */ iy, jx, jy; /* and the two lateral coordinates */ int n1, n2; /* indices for periodic sampling in the PSF */ int Maxn1, Maxn2, Minn1, Minn2; int Maxir; /* __Stuff to calculte min and max index values */ float Sxmin, Sxmax, xmax, Maxxprime; float Symin, Symax, ymax, Maxyprime; float Maxrprime; int sMinn1, lMaxn1; float mytemp; /* Number of samples in (x, y), in z and radially (= Nxy*sqrt(2))*/ int HalfNxy, Zup; /* Number of samples radially on the convolution of psfcond and pupil */ int NetNr; /* Number of samples in (x,y) before binning */ int Lxy; /* Number of samples in (x,y) before binning and after oversampling for the summation*/ int Mxy, Halfway; /* Pupil function region of support */ int Pxy; /* normalized radial or lateral sampling rate */ float nrm_deltar, nrm_deltaxy=1.0; /* new lateral sampling rate based on oversampling */ float deltaxy1; /* oversampling rate for the xy plane */ int osamp; /* Floating point version of the above */ float ratio; /* Weigth factors for apodization */ float weight, appod; /* Distances in the detector plane (mm) */ float rd, x, y, ysq; /* Shifted coordinates */ float xprime, yprime, rprime; /* Shifting of coodrinates */ float dx, dy; /* Shifted radial coordinate normalized by deltar */ float normRprime; /* ..To prompt for things */ char temp_string[255]; char answer[255]; /* --------------------- BEGIN EXECUTABLE CODE -------------------- */ /* __Initialize whatever paremeters here */ /* ..Periodicity matrix */ Vxx = 1.0; Vyx = 0.0; Vxy = -0.5; Vyy = (float)sqrt(3.0)*0.5; /* ..Prompt for all data */ Nr = head->nx; Nz = head->ny; psfxz = (float*)head->data; ovrsmp = head->xstart; Nxy = head->ystart; symmetric = head->zstart; /* leave at 1.0 nrm_deltar = head->xlength; nrm_deltaxy = head->ylength; */ HalfNxy = Nxy/2; Lxy = Nxy*bin; /* Number of pixels before binning */ Halfway = (HalfNxy+1)*bin; NetNr = Nr; /* Number of pixels in convolution of psfcond and pupil */ nrm_deltar = nrm_deltaxy/((float)ovrsmp); /* oversampling rate */ /* make it beat nyquist */ osamp = (int)(deltaxy/deltaxy_nyq) + 1; if(osamp < 5) osamp = 5; /* make odd */ if(!(osamp & 1)) osamp++; /* New deltaxy for oversampling */ deltaxy1 = deltaxy/((float)osamp); ratio = (float) deltaxy1 / deltar; printf("DXY: %.4f DXY_NYQ: %.4f SAMP = %d NEW_DXY: %.4f\n", deltaxy,deltaxy_nyq,osamp,deltaxy1); Mxy = Lxy * osamp; /* number of pixels after oversampling */ Halfway = (HalfNxy+1)*bin*osamp; printf("ratio = %f Mxy = %d \n", ratio,Mxy); /* check for single aperture */ if(distance <= 0.0) distance = 1E20; distance = distance*nrm_deltaxy; /* Scale by pre-binning pixel size */ Zup = Nz; /* Limit for z index */ if (symmetric) Zup = (Nz/2) + 1; /* ..Maximum values for row sampling index (NOTE: Assumes Vyy != 0 <--) */ Minn2 = ((float)-Mxy)/(Vyy*distance); Maxn2 = ((float)(2*Mxy))/(Vyy*distance); /* __Calculate a conservative extimate of the maximum value if the 'ir' index that is expected to be used. The estimate is calculated with the following assumptions: Vxx > 0, Vyy > 0 (strictly greater) Vxy < 0 (Striclty less than) Vyx = 0 (exactly) ..Most negative value of n1 expected */ sMinn1 = ((float)-Mxy)/distance - (float)Minn2*Vxy/Vxx; /* ..Most positive value of n1 expected */ lMaxn1 = (((float)(2*Mxy))/distance - (float)Maxn2*Vxy)/Vxx; /* ..most negative value of term subtracted from xprime */ Sxmin = Vxx*(float)sMinn1 + Vyx*(float)Maxn2; /* ..Most positive value of term subtracted from xprime */ Sxmax = Vxx*(float)lMaxn1 + Vyx*(float)Minn2; /* ..Largest value of x */ xmax = (float)(Halfway-1) * nrm_deltaxy; /* ..Largest absolute value of xprime */ Maxxprime = amax1(Sxmax*distance, xmax - Sxmin*distance); /* ..Most negative value of the term subtracted from yprime (with Vyx=0,Vyy>0) */ Symin = Vyy*(float)Minn2; /* ..Most positive value of the term subtracted from yprime (with Vyx=0,Vyy>0) */ /* In the original fortran code, Maxn1 is used in the next line without being initialized first. I suspect it's a bug, and should really be Maxn2. */ Symax = Vyy*(float)Maxn2; /* ..largest value of y */ ymax = (float)(Halfway-1) * nrm_deltaxy; /* ..Largest absolute value of yprime */ Maxyprime=amax1(Vyy*(float)Maxn2*distance,ymax-Vyy*(float)Minn2*distance); /* ..Largest value of rprime we can conservativelly expect */ Maxrprime = (float) sqrt (Maxxprime*Maxxprime + Maxyprime*Maxyprime); /* ..Largetst index ir expected */ Maxir = (int) ((Maxrprime + 1.0)/nrm_deltar); /* ..Factor to be used in linear interpolation used as apodization */ appod = 1.0; if (Maxir > Nr) appod = 1.0/(float)(Maxir - Nr) ; /* ..Calculate size of pupil function array at the higher resolution*/ Pxy = Nxy*ovrsmp*bin; /* ..Calculate the least power of 2 that will fit */ Pxy = intlog2(Pxy-1); Pxy = (int) pow(2.0 , Pxy+1); /* ..Make sure that the log file exists */ if((logfp=fopen(lognm,"a"))==(FILE *)NULL) { fprintf(stderr,"WARNING: (rotdiskcirc) can't open logfile `%s' for write.\n",lognm); logfp = stderr; } fprintf(logfp," Number of slices or planes: %d\n", Nz); fprintf(logfp," Number of xy-samples after binning: %d\n", Nxy); fprintf(logfp," Number of radial samples available: %d\n", Nr); fprintf(logfp," Oversampling (before binning) by: %d\n", ovrsmp); fprintf(logfp," binning factor: %d\n", bin); fprintf(logfp," distance between apertures: %E\n", distance); fprintf(logfp," aperture size(prebin,oversmpled): %f\n", size); fprintf(logfp," pupil support(prebin,oversmpled): %d\n", Pxy); fprintf(logfp," sample matrix:\n"); fprintf(logfp," Vxx: %f\n",Vxx); fprintf(logfp," Vxy: %f\n",Vxy); fprintf(logfp," Vyx: %f\n",Vyx); fprintf(logfp," Vyy: %f\n",Vyy); fprintf(logfp,"even symmetry in z is %s assumed.\n", symmetric ? "":"NOT"); sprintf(temp_string,"%s.info",psfnm); if((infofp=fopen(temp_string,"a"))==(FILE *)NULL) fprintf(stderr,"WARNING: can't open info file %s for write.\n",temp_string); else { fprintf(infofp," binning factor: %d\n", bin); fprintf(infofp," Distance between apertures: %E\n", distance); fprintf(infofp,"aperture diameter(prebin,oversamp): %f\n", size); fprintf(infofp," sample matrix:\n"); fprintf(infofp," Vxx: %f\n",Vxx); fprintf(infofp," Vxy: %f\n",Vxy); fprintf(infofp," Vyx: %f\n",Vyx); fprintf(infofp," Vyy: %f\n",Vyy); fclose(infofp); } fprintf(stderr,"check file %s for progress report.\n",lognm); if (size >= 1.0) { keeplog (logfp, "sampling pupil function "); /* first allocate memory for array pupil */ if((pupil=(float *)calloc(sizeof(float),((Pxy+2)*Pxy)))== (float *)NULL) { fprintf(stderr,"out of memory in %s\n",prognm); exit(1); } ZeroOut(pupil,(Pxy+2)*Pxy); /* Get pupil function */ getpupil(pupil, size, Pxy, Pxy); add2columns(pupil,Pxy,Pxy); /* Fourier transform pupil function */ real_fft3d(pupil,Pxy,Pxy,1,Pxy+2,Pxy,FORWARD); Cpupil=(fcomplex *)pupil; /* If tandem scanning, the equivalent pinhole function is the convolution of the pinhole with itself */ if (tandem) mult3dcm (Cpupil, Cpupil, (Pxy+2)*Pxy/2); /* Normalize Cpupil array to avoid handling very small numbers */ peak = 0.0; norm3dcm (Cpupil, &peak, Pxy*(Pxy+2)/2); } /* allocate memory for psfobj. Notice size of array */ if((psfobj=(float *)calloc(sizeof(float),Mxy*Mxy))==(float *)NULL) { fprintf(stderr,"out of memory in %s\n",prognm); exit(1); } ZeroOut(psfobj,Mxy*Mxy); printf("Mxy = %d and Pxy=%d\n",Mxy,Pxy); fflush(stdout); /* allocate memory for psfcond. Notice size of array */ if (Mxy > Pxy){ /* when ovrsmp < 5 then this is true */ printf("Mxy >Pxy\n"); if((psfcond=(float *)calloc(sizeof(float),(Mxy+2)*Mxy))==(float *)NULL) { fprintf(stderr,"out of memory in %s\n",prognm); exit(1); } } else if((psfcond=(float *)calloc(sizeof(float),(Pxy+2)*Pxy))==(float *)NULL) { fprintf(stderr,"out of memory in %s\n",prognm); exit(1); } ZeroOut(psfcond,(Pxy+2)*Pxy); otfcond=(fcomplex *)psfcond; /* allocate memory for psfbin. Notice size of array */ if((psfbin=(float *)calloc(sizeof(float),Nxy*Nxy))==(float *)NULL) { fprintf(stderr,"out of memory in %s\n",prognm); exit(1); } ZeroOut(psfbin,Nxy*Nxy); /* allocate memory for psfbi1. Notice size of array */ if((psfbin1=(float *)calloc(sizeof(float),Lxy*Lxy))==(float *)NULL) { fprintf(stderr,"out of memory in %s\n",prognm); exit(1); } ZeroOut(psfbin1,Lxy*Lxy); for(iz=1;iz<=Zup;iz++){ if ( (iz-1)%1 == 0) { sprintf(temp_string,"iz = %d",iz); keeplog(logfp, temp_string); } /* ..Read on row of the rz or xz cross-section */ /* first have to go to the right place in file */ radpsf = (psfxz + (iz-1)*Nr); /* Calculate the objective PSF (iterpolate rz section into xyz sect)*/ r2xy(psfobj, radpsf, Mxy, Mxy, Nr, ratio); if (size >= 1.0) { /* Convolve condenser PSF and aperture */ /* interpolate w/o subsampling */ r2xy(psfcond, radpsf, Pxy, Pxy, Nr, 1.0); add2columns(psfcond,Pxy,Pxy); /* Fourier transform, multiply, inverse Fourier transform */ real_fft3d(psfcond,Pxy,Pxy,1,Pxy+2,Pxy,FORWARD); mult3dcm(otfcond, Cpupil, (Pxy+2)*Pxy/2); real_fft3d(psfcond,Pxy,Pxy,1,Pxy+2,Pxy,REVERSE); /* Copy first line of convolution to radpsf to use for illumination */ NetNr = Pxy/2+1; cp3dr(radpsf, psfcond, NetNr); } /* The following loops are based on the PSF's even symmetry in x and y */ /* Calculate the illumination distribution */ for(iy=1;iy<=Halfway;iy++){ y = (float)(iy-1)*nrm_deltaxy; for(ix=1;ix<=Halfway;ix++){ x = (float)(ix-1)*nrm_deltaxy; /*Initialize to use as accumulator */ illum = 0.0; /* ..Index n2 is for columns */ for(n2=Minn2;n2<=Maxn2;n2++){ dx = Vxy*n2; dy = Vyy*n2; /* ..These two lines assume Vxx is not zero */ Minn1=(int)(((float)-Mxy/distance-dx)/Vxx); Maxn1=(int)((2.0*(float)Mxy/distance-dx)/Vxx); /* ..Index n1 involves rows and columns */ for(n1=Minn1;n1<=Maxn1;n1++){ xprime = x - distance*(Vxx*(float)n1+dx); yprime = y - distance*(Vyx*(float)n1+dy); /* Rectangular sampling to check what's going on here */ /* xprime = x - distance*float(n2) yprime = y - distance*float(n1) */ rprime = (float)sqrt((double)(xprime*xprime) + (double)(yprime*yprime)); /* ..Normalize to the subsampled grid */ normRprime = rprime*ratio; ir = (int)normRprime + 1; /* ..Interpolate and accumulate */ if (ir < NetNr) { /* ..Interpolate between adjacent samples */ alpha = ir - normRprime; /*tmp = radpsf(ir)*alpha + radpsf(ir+1)*(1.0-alpha)*/ tmp = *(radpsf+ir-1) * ((float)ir-normRprime) + *(radpsf+ir+1-1) * (normRprime+1.0-(float)ir); } else { /*This should disapear when we become confident that the conservative guess for Maxir is OK */ if (ir > Maxir) { Maxir = ir; fprintf(stderr,"Found an ir > Maxir. \n"); fprintf(stderr,"Maxir set to %d\n",ir); fprintf(stderr,"check the code that guesses Maxir again.\n"); appod = 1.0/(Maxir-Nr); } /*..Apodize from last available sample to zero to avoid sharp edges in the PSF */ /* ..Apodize by linear interpolation to zero at ir = Maxir */ weight = (Maxir-(float)ir)*appod; tmp = *(radpsf+NetNr-1) * weight; } illum = illum + tmp; } /* end loop for n1 */ } /* end loop for n2 */ /* IMPORTANT The dimension of the array psfcond is now Mxy by Mxy, instead of (Pxy+2) by Pxy. */ /* psfcond(ix,iy) = illum */ *(psfcond+(ix-1)+(iy-1)*Mxy) = illum; } /* end loop for ix */ } /* end loop for iy */ /* ..Even symmetric replication into the other three quadrants */ /* IMPORTANT The dimension of the array psfcond is now Mxy by Mxy, instead of (Pxy+2) by Pxy. */ evenrepr(psfcond, Mxy, Mxy); /* ..Multiply illumination and objective psf (into psfobj) */ mult3drm(psfobj, psfcond, Mxy*Mxy); /* sum neighboring pixels to downsample the BIG PSF */ /* note dimension goes from Mxy to Lxy = Nxy*bin */ Sum4N4NToNN(psfobj,psfbin1,Lxy,osamp); /* routine is in rotsum.c */ /* Bin here */ /* If binning by 1 copy psf to psfbin */ if (bin == 1) /* Lxy = Nxy */ cp3dr (psfbin, psfbin1, Nxy*Nxy); else { /* Add pixels together */ /* Clean psfbin array to use as accumulator */ init3dr(psfbin, 0.0, Nxy*Nxy); /* binning */ for(ix=1;ix<=Lxy;ix++){ jx = ((ix-1)/bin) + 1; for(iy=1;iy<=Lxy;iy++){ jy = ((iy-1)/bin) + 1; *(psfbin+(jx-1)+(jy-1)*Nxy) += *(psfbin1+(ix-1)+(iy-1)*Lxy); } } } WritePlane(iz-1,outpsf,psfbin,Nxy,Nxy,Nxy,Nxy); if(symmetric && (iz > 1)) WritePlane(Nz-iz+1,outpsf,psfbin,Nxy,Nxy,Nxy,Nxy); } /* end of "for(iz=1;iz<=Zup;iz++)" */ keeplog (logfp, "DONE"); if(logfp != stderr) fclose(logfp); printf("don't free up the memory\n"); /*free(radpsf); free(psfbin); free(psfobj); free(psfcond); free(pupil);*/ }
/* IOFINISH -- Flush out and wrap up all pending io for given task. * Called when the task is dying and it wants to close all files it opened. * This includes a pipe if it used one, a file if it was a script and io * redirections as indicated by the T_MYXXX flags. The T_MYXXX flags are * set only when the redirections were done for this task, ie, they were * not simply inherited. * Just as a fail-safe measure, always check that a real stdio file is * not being closed. * Don't call error() because in trying to restor to an interactive task * it might call us again and cause an inf. loop. */ void iofinish ( register struct task *tp ) { register FILE *fp; int flags; flags = tp->t_flags; /* Make sure we do not close files more than once. */ if (flags & T_RUNNING) tp->t_flags &= ~T_RUNNING; else return; if (cldebug) eprintf ("flushing io for task `%s'\n", tp->t_ltp->lt_lname); if (flags & T_MYIN) { fp = tp->t_stdin; if (fp != stdin) fclose (fp); } if (flags & T_MYOUT) { fflush (fp = tp->t_stdout); if (fp != stdout) fclose (fp); } if (flags & T_MYERR) { fflush (fp = tp->t_stderr); if (fp != stderr) fclose (fp); } /* Close any redirected graphics output streams. */ if (flags & (T_MYSTDGRAPH|T_MYSTDIMAGE|T_MYSTDPLOT)) { if (flags & T_MYSTDGRAPH) if (tp->t_stdgraph != tp->t_stdimage && tp->t_stdgraph != tp->t_stdplot) fclose (tp->t_stdgraph); if (flags & T_MYSTDIMAGE) if (tp->t_stdimage != tp->t_stdplot) fclose (tp->t_stdimage); if (flags & T_MYSTDPLOT) fclose (tp->t_stdplot); } /* If task i/o is redirected to a subprocess send the done message. */ if (flags & T_IPCIO) fputs (IPCDONEMSG, tp->t_out); fflush (tp->t_out); /* Close files only for script task, not for a cl, a builtin, or * a process. Do call disconnect if the task lives in a process. */ if (flags & T_SCRIPT) { fp = tp->t_in; if (fp != stdin) fclose (fp); } else if (flags & (T_CL|T_BUILTIN)) { ; } else if (tp->t_pid != -1) pr_disconnect (tp->t_pid); /* Log a stop message for script and executable tasks. */ if (keeplog() && log_trace()) if (tp->t_flags & T_SCRIPT || tp->t_pid != -1) putlog (tp, "Stop"); }
/* EXECNEWTASK -- Called from the EXEC instruction after all param and stdio * processing for the new task is complete. Here we actually run the new task, * either directly in the case of a builtin function, or as a new case for * main()'s loop. Do not set newtask to NULL so that run() can tell what it * exec'd. */ void execnewtask (void) { /* VMS C V2.1 cannot handle this (see below). * register struct pfile *pfp; */ static struct pfile *pfp; struct param *pp; FILE *fopen(); if (newtask == NULL) /* if this ever happens, i don't want to know about it. */ return; currentask->t_pc = pc; /* instruction after EXEC */ if (cldebug) eprintf ("execnewtask: pc = %d\n", pc); if (newtask->t_flags & T_BUILTIN) { /* set yyin in case a builtin reads someday; none do now. * unlink newtask's fake param file and reset top of dictionary * to what it was before the fake param file was added; it is * still there, however, for the builtin to use. this is done * since some builtins (eg task) want to add things that are * to stay on the dictionary and the tools all start at topd. * the return is back to run(); it will continue since it will * see that newtask was just a builtin. * note that we do not reset pf_n, as with other fake pfiles, * as this is the way builtins get their number of arguments * (it's faster than building them a $nargs). */ yyin = newtask->t_in = currentask->t_in; /* inherit pipe */ newtask->t_out = currentask->t_out; newtask->t_modep = currentask->t_modep; /* inherit mode */ /* VMS C 2.1 Optimizer cannot handle this. * parhead = dereference (reference (pfile, parhead)->pf_npf); */ pfp = reference (pfile, parhead); parhead = dereference (pfp->pf_npf); topd = currentask->t_topd; currentask = newtask; newtask->t_flags |= T_RUNNING; if (cldebug) eprintf ("execnewtask: calling new task@%x\n", newtask); if (cltrace) eprintf ("\t----- exec %s %s -----\n", (newtask->t_flags & T_FOREIGN) ? "foreign" : "builtin", newtask->t_ltp->lt_lname); (*newtask->t_ltp->lt_f)(); oneof(); /* proceed as though this task saw eof */ return; } pfp = newtask->t_pfp; /* If the new task is a cl, we are not running in background and * its t_in is stdin, it is interactive. Note that when a package * is loaded by a script task rather than interactively by the user, * the t_in of the cl() in the package script task will be reading * from the calling script task rather than from the original stdin * (the user terminal), hence is not interactive. If this task is * flagged interactive, taskunwind() may elect to restart it on an * error so save present state for restor(). */ if (newtask->t_flags & T_CL) { if (cldebug) eprintf ("execnewtask: new task is the CL\n"); if (cltrace) eprintf ("\t----- exec cl -----\n"); /* Call set_clio to set the command input and output streams * t_in and t_out for a cl() or package_name() command. */ set_clio (newtask); /* This code is a temporary patch to allow packages to be * loaded from within scripts regardless of whether there * are enclosing brackets. If a CL statement is executed * within a script which is itself called within another * script, then we will do an implicit keep before the CL. */ if (topcs + 2*TASKSIZ <= STACKSIZ) if ((strcmp (newtask->t_ltp->lt_lname, "cl") == 0) || (strcmp (newtask->t_ltp->lt_lname, "clbye") == 0)) if ((currentask->t_flags & T_SCRIPT) && (prevtask->t_flags & T_SCRIPT)) keep(prevtask); /* If newtask is cleof(), close the input stream of the current * task (the task whose input contained the cleof), and reopen * as the null file. */ if (newtask->t_flags & T_CLEOF) { if (currentask->t_in != stdin) fclose (currentask->t_in); if (currentask != firstask) currentask->t_in = fopen ("dev$null", "r"); } if (!(firstask->t_flags & T_BATCH) && (newtask->t_in == stdin) && (newtask->t_out == stdout)) { newtask->t_flags |= T_INTERACTIVE; newtask->t_topd = topd; newtask->t_topos = topos; newtask->t_topcs = topcs; newtask->t_curpack = curpack; } } /* Standardize the pfile. * Set (or create if necessary) `$nargs', number of command line args, * based on pf_n which is set for each command line argument by * posargset, et al. * If this ltask had no paramfile and we built one up from the * command line, then we need to add a `mode' param. If it did have * a paramfile, then pfileload has already added it for us. * Point t_modep to the mode param for newtask. */ pp = paramfind (pfp, "$nargs", 0, YES); if (pp == NULL || (XINT)pp == ERR) { char nabuf[FAKEPARAMLEN]; sprintf (nabuf, "$nargs,i,h,%d\n", pfp->pf_n); pp = addparam (pfp, nabuf, NULL); pp->p_mode |= M_FAKE; /* never flush out $nargs */ } else pp->p_val.v_i = pfp->pf_n; if (pfp->pf_flags & PF_FAKE) { newtask->t_modep = addparam (pfp, "mode,s,h,q\n", NULL); /* pf_n will be used by paramsrch() to count positional arg * matches; see it and param.h. */ pfp->pf_n = 0; } else { newtask->t_modep = paramfind (pfp, "mode", 0, YES); } if (newtask->t_modep == NULL) cl_error (E_IERR, "no mode param for task `%s'", newtask->t_ltp->lt_lname); /* If task is being run in menu mode, call up eparam so that the user * can edit/inspect the parameters. If eparam is exited with ctrl/c * do not run the task or update the pfile. The parameter editor * will make a copy of the task's pfile(s), edit it, and if necessary * update the incore version created earlier by callnewtask(). */ if ((taskmode(newtask) & M_MENU) || (newtask->t_flags & T_PSET)) { if (epset (newtask->t_ltp->lt_lname) == ERR) { if (newtask->t_flags & T_PSET) cl_error (E_UERR, "parameter file not updated"); else cl_error (E_UERR, "menu mode task execution aborted"); } } /* Set up bascode so new task has a good place to start building * code. See how the pc is set up before each call to the parser in * main() loop. */ newtask->t_bascode = topos + 1; /* Set up io paths. If the new task is cl(), it's command input * and output streams are connected to those of the task which * called currentask. If the currentask is the firstask, there * was no caller (no prevtask), so we must watch out for that. * In the case of a script, commands are read from the script. * In the case of a process, commands are read from the process. */ if (newtask->t_flags & T_PSET) { newtask->t_in = fopen ("dev$null", "r"); newtask->t_out = newtask->t_stdout; } else if (newtask->t_flags & T_SCRIPT) { if (cltrace) eprintf ("\t----- exec script %s (%s) -----\n", newtask->t_ltp->lt_lname, newtask->t_ltp->lt_pname); newtask->t_in = fopen (newtask->t_ltp->lt_pname, "r"); if (newtask->t_in == NULL) cl_error (E_UERR|E_P, "can not open script file `%s'", newtask->t_ltp->lt_pname); newtask->t_out = newtask->t_stdout; } else if (newtask->t_flags & T_CL) { /* The command streams t_in and t_out have already been * set up above by set_clio() in the test for T_INTERACTIVE. */ /* Do nothing */ } else { char startup_msg[SZ_STARTUPMSG+1]; int timeit; /* Connect to an executable process. */ mk_startupmsg (newtask, startup_msg, SZ_STARTUPMSG); timeit = (newtask->t_flags & T_TIMEIT) != 0; if (cltrace) eprintf ("\t----- exec external task %s -----\n", newtask->t_ltp->lt_lname); newtask->t_pid = pr_connect ( findexe (newtask->t_ltp->lt_pkp, newtask->t_ltp->lt_pname), startup_msg, &newtask->t_in, &newtask->t_out, newtask->t_stdin, newtask->t_stdout, newtask->t_stderr, newtask->t_stdgraph, newtask->t_stdimage, newtask->t_stdplot, timeit); } yyin = newtask->t_in; /* set the input for the parser */ /* Tell parser what to expect. */ parse_state = PARSE_FREE; if (newtask->t_flags & T_SCRIPT) { proc_script = (newtask->t_flags & T_PSET) ? NO : procscript(yyin); if (proc_script) { parse_state = PARSE_BODY; /* Skip to the BEGIN statement */ newtask->t_scriptln = skip_to (yyin, "begin"); if (newtask->t_scriptln == ERR) cl_error (E_UERR, "No BEGIN statement in procedure script"); /* Reset pointer here. */ proc_script = NO; } } /* Log a start message for script and executable tasks. */ if (keeplog() && log_trace()) if (newtask->t_flags & T_SCRIPT || newtask->t_pid != -1) { char logmsg[SZ_LINE]; sprintf (logmsg, "Start (%s)", newtask->t_ltp->lt_pname); putlog (newtask, logmsg); } newtask->t_flags |= T_RUNNING; currentask = newtask; /* continue as new the new task; at last. */ if (cldebug) eprintf ("Returning from execnewtask.yyin, ct_in, nt_in:%d %d %d\n", yyin, currentask->t_in, newtask->t_in); }