From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/nmemio/main.x | 893 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 893 insertions(+) create mode 100644 sys/nmemio/main.x (limited to 'sys/nmemio/main.x') diff --git a/sys/nmemio/main.x b/sys/nmemio/main.x new file mode 100644 index 00000000..653023ed --- /dev/null +++ b/sys/nmemio/main.x @@ -0,0 +1,893 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include +include +include +include +include +include +include + +.help iraf_main +.nf __________________________________________________________________________ +The IRAF MAIN + + Task resident interpreter for interface to CL. Supervises process startup +and shutdown, error restart, and task execution. A process may contain any +number of tasks, which need not be related. The iraf main allows a process to +be run either directly (interactively or in batch) or from the CL. A brief +description of the operation of the Main is given here; additional documentation +is given in the System Interface Reference Manual. + + +EXECUTION + +[1] The process containing the IRAF Main is run. The PROCESS MAIN, a machine + dependent code segment, gains control initially. The process main + determines whether the task is being run from as a connected subprocess, + as a detached process, or as a host process, and opens the process + standard i/o channels. The process main then calls the IRAF Main, i.e., us. + +[2] The IRAF Main performs the initialization associated with process startup + and then enters the interpreter loop waiting for a command. A number of + special commands are implemented, e.g.: + + ? print menu + bye shutdown process + chdir change directory + set set environment variable or variables + + Any other command is assumed to be the name of a task. The syntax of a + task invocation statement is as follows: + + [$]task [<[fname]], ([[stream[(T|B)]]>[fname]])|([[stream]>>[fname]]) + + Everything but the task name is optional. A leading $ enables printing of + the cpu time and clock time consumed by the process at termination. Any + combination of the standard i/o streams may be redirected on the command + line into a file. If the stream is redirected at the CL level redirection + is shown on the command line but the filename is omitted. + +[3] The communications protocol during task execution varies depending on + whether or not we are talking to the CL. If talking directly to the user, + the interpreter generates a prompt, and the standard input and output is + not blocked into XMIT and XFER commands. Interactive parameter requests + have the form "paramname: response" while CL/IPC requests have the form + "paramname=\nresponse", where "response" is the value entered by the user. + +[4] Task termination is indicated in interactive mode by generation of a prompt + for the next command and in CL/IPC mode by transmission of the command + "bye" to the parent process. If a task terminates abnormally the command + "error" is sent to the parent process or the terminal, and the Main reenters + the interpreter loop. + +A unique SYS_RUNTASK procedure is generated for each process at compile time by +performing string substitution on a TASK statement appearing in the source code. +The SYS_RUNTASK procedure contains the task dictionary, CALL statements for +each task, plus the special task "?". The main itself, i.e. this file, is a +precompiled library procedure which has no direct knowledge of the commands +to be run. + + +ERROR RECOVERY + + If a task terminates abnormally two things can happen: [1] a panic abort +occurs, causing immediate shutdown of the process (rare), or [2] the IRAF Main +is reentered at the ZSVJMP statement by a corresponding call to ZDOJMP from +elsewhere in the system, e.g., ERRACT in the error handling code. + +Error restart consists of the following steps: + + (1) The IRAF main is reentered at the point just after the ZDOJMP statement, + with a nonzero error code identifying the error in STATUS. + (2) The main performs error recovery, cleaning up the files system (deleting + NEW_FILES and TEMP_FILES), clearing the stack, and calling any + procedures posted with ONERROR. At present the error recovery code does + not free heap buffers or clear posted exception handlers. + (3) The ERROR statement is sent to the CL. An example of the + error statment is "ERROR (501, "Access Violation")". + (4) The main reenters the interpreter loop awaiting the next command from + the CL. + +Any error occuring during error restart is fatal and results in immediate +process termination, usually with a panic error message. This is necessary +to prevent infinite error recursion. + + +SHUTDOWN + + The process does not shutdown when interrupted by the CL or during error +recovery, unless a panic occurs. In normal operation shutdown only occurs when +the command BYE is received from the parennt process, or when EOF is read from +the process standard input. Procedures posted during execution with ONEXIT +will be called during process shutdown. Any error occuring while executing +an ONEXIT procedure is fatal and will result in a panic abort of the process. +.endhelp _____________________________________________________________________ + +define SZ_VALSTR SZ_COMMAND +define SZ_CMDBUF (SZ_COMMAND+1024) +define SZ_TASKNAME 32 +define TIMEIT_CHAR '$' +define MAXFD 5 # max redirectable fd's +define STARTUP 0 # stages of execution +define SHUTDOWN 1 +define IDLE 2 +define EXECUTING 3 +define DUMMY finit # any procedure will do + + +# IRAF_MAIN -- Execute commands read from the standard input until the special +# command "bye" is received, initiating process shutdown. The arguments tell +# the process type (connected, detached, or host) and identify the process +# standard i/o channels and device driver to be used. + +int procedure iraf_main (a_cmd, a_inchan, a_outchan, a_errchan, + a_driver, a_devtype, prtype, bkgfile, jobcode, sys_runtask, onentry) + +char a_cmd[ARB] # command to be executed or null string +int a_inchan # process standard input +int a_outchan # process standard output +int a_errchan # process standard error output +int a_driver # ZLOCPR address of device driver +int a_devtype # device type (text or binary) +int prtype # process type (connected, detached, host) +char bkgfile[ARB] # packed filename of bkg file if detached +int jobcode # jobcode if detached process +extern sys_runtask() # client task execution procedure +extern onentry() # client onentry procedure + +bool networking +int inchan, outchan, errchan, driver, devtype +char cmd[SZ_CMDBUF], taskname[SZ_TASKNAME], bkgfname[SZ_FNAME] +int arglist_offset, timeit, junk, interactive, builtin_task, cmdin +int jumpbuf[LEN_JUMPBUF], status, errstat, state, interpret, i +long save_time[2] +pointer sp + +bool streq() +extern DUMMY() +int sys_getcommand(), sys_runtask(), oscmd() +int access(), envscan(), onentry(), stropen() +errchk xonerror, fio_cleanup +common /JUMPCOM/ jumpbuf +string nullfile "dev$null" +data networking /KNET/ +define shutdown_ 91 + +# The following common is required on VMS systems to defeat the Fortran +# optimizer, which would otherwise produce optimizations that would cause +# a future return from ZSVJMP to fail. Beware that this trick may fail on +# other systems with clever optimizers. + +common /zzfakecom/ state + +begin + # The following initialization code is executed upon process + # startup only. + + errstat = OK + state = STARTUP + call mio_init() + call zsvjmp (jumpbuf, status) + if (status != OK) + call sys_panic (EA_FATAL, "fatal error during process startup") + + # Install the standard exception handlers, but if we are a connected + # subprocess do not enable interrupts until process startup has + # completed. + + call ma_ideh() + if (prtype == PR_CONNECTED) + call intr_disable() + + inchan = a_inchan + outchan = a_outchan + errchan = a_errchan + driver = a_driver + devtype = a_devtype + + # If the system is configured with networking initialize the network + # interface and convert the input channel codes and device driver + # code to their network equivalents. + + if (networking) + call ki_init (inchan, outchan, errchan, driver, devtype) + + # Other initializations. + call env_init() + call fmt_init (FMT_INITIALIZE) # init printf + call xer_reset() # init error checking + call erract (OK) # init error handling + call onerror (DUMMY) # init onerror + call onexit (DUMMY) # init onexit + call finit() # initialize FIO + call clopen (inchan, outchan, errchan, driver, devtype) + call clseti (CL_PRTYPE, prtype) + call clc_init() # init param cache + call strupk (bkgfile, bkgfname, SZ_FNAME) + + # If we are running as a host process (no IRAF parent process) look + # for the file "zzsetenv.def" in the current directory and then in + # the system library, and initialize the environment from this file + # if found. This works because the variable "iraf$" is defined at + # the ZGTENV level. + + interactive = NO + if (prtype == PR_HOST) { + interactive = YES + if (access ("zzsetenv.def",0,0) == YES) { + iferr (junk = envscan ("set @zzsetenv.def")) + ; + } else if (access ("host$hlib/zzsetenv.def",0,0) == YES) { + iferr (junk = envscan ("set @host$hlib/zzsetenv.def")) + ; + } + } + + # Save context for error restart. If an error occurs execution + # resumes just past the ZSVJMP statement with a nonzero status. + + call smark (sp) + call zsvjmp (jumpbuf, status) + + if (status != OK) { + errstat = status + + # Give up if error occurs during shutdown. + if (state == SHUTDOWN) + call sys_panic (errstat, "fatal error during process shutdown") + + # Tell error handling package that an error restart is in + # progress (necessary to avoid recursion). + + call erract (EA_RESTART) + + iferr { + # Call user cleanup routines and then clean up files system. + # Make sure that user cleanup routines are called FIRST. + + call xonerror (status) + call ma_ideh() + call flush (STDERR) + do i = CLIN, STDPLOT + call fseti (i, F_CANCEL, OK) + call fio_cleanup (status) + call fmt_init (FMT_INITIALIZE) + call sfree (sp) + } then + call erract (EA_FATAL) # panic abort + + # Send ERROR statement to the CL, telling the CL that the task + # has terminated abnormally. The CL will either kill us, resulting + # in error restart with status=SYS_XINT, or send us another command + # to execute. If we are connected but idle, do not send the ERROR + # statement because the CL will not read it until it executes the + # next task (which it will then mistakenly think has aborted). + + if (!(prtype == PR_CONNECTED && state == IDLE)) + call xer_send_error_statement_to_cl (status) + + # Inform error handling code that error restart has completed, + # or next error call will result in a panic shutdown. + + call erract (OK) + call xer_reset () + status = OK + } + + # During process startup and shutdown the parent is not listening to + # us, hence we dump STDOUT and STDERR into the null file. If this is + # not done and we write to CLOUT, deadlock may occur. During startup + # we also call the ONENTRY procedure. This is a no-op for connected + # and host subprocesses unless a special procedure is linked by the + # user (for detached processes the standard ONENTRY procedure opens + # the bkgfile as CLIN). The return value of ONENTRY determines whether + # the interpreter loop is entered. Note that ONENTRY permits complete + # bypass of the standard interpreter loop by an application (e.g. the + # IRAF CL). + + if (state == STARTUP) { + # Redirect stderr and stdout to the null file. + if (prtype == PR_CONNECTED) { + call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE) + call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE) + } + + # Call the custom or default ONENTRY procedure. The lowest bit + # of the return value contains the PR_EXIT/PR_NOEXIT flag, higher + # bits may contain a more meaningful 7-bit status code which will + # be returned to the shell. + + i = onentry (prtype, bkgfname, a_cmd) + if (mod(i, 2) == PR_EXIT) { + interpret = NO + errstat = i / 2 + goto shutdown_ + } else + interpret = YES + + # Open the command input stream. If a command string was given on + # the command line then we read commands from that, otherwise we + # take commands from CLIN. + + for (i=1; IS_WHITE(a_cmd[i]) || a_cmd[i] == '\n'; i=i+1) + ; + if (a_cmd[i] != EOS) { + cmdin = stropen (a_cmd, ARB, READ_ONLY) + call fseti (cmdin, F_KEEP, YES) + interpret = NO + interactive = NO + } else + cmdin = CLIN + } + + # Interpreter loop of the IRAF Main. Execute named tasks until the + # command "bye" is received, or EOF is read on the process standard + # input (CLIN). Prompts and other perturbations in the CL/IPC protocol + # are generated if we are being run directly as a host process. + + while (sys_getcommand (cmdin, cmd, taskname, arglist_offset, + timeit, prtype) != EOF) { + + builtin_task = NO + if (streq (taskname, "bye")) { + # Initiate process shutdown. + break + } else if (streq (taskname, "set") || streq (taskname, "reset")) { + builtin_task = YES + } else if (streq (taskname, "cd") || streq (taskname, "chdir")) { + builtin_task = YES + } else if (prtype == PR_CONNECTED && streq (taskname, "_go_")) { + # Restore the normal standard output streams, following + # completion of process startup. Reenable interrupts. + call close (STDOUT) + call close (STDERR) + call intr_enable() + state = IDLE + next + } else if (taskname[1] == '!') { + # Send a command to the host system. + junk = oscmd (cmd[arglist_offset], "", "", "") + next + } else + state = EXECUTING + + if (builtin_task == NO) { + if (timeit == YES) + call sys_mtime (save_time) + + # Clear the parameter cache. + call clc_init() + + # Set the name of the root pset. + call clc_newtask (taskname) + + # Process the argument list, consisting of any mixture of + # parameter=value directives and i/o redirection directives. + + call sys_scanarglist (cmdin, cmd[arglist_offset]) + } + + # Call sys_runtask (the code for which was generated automatically + # by the preprocessor in place of the TASK statement) to search + # the dictionary and run the named task. + + errstat = OK + call mem_init (taskname) + if (sys_runtask (taskname,cmd,arglist_offset,interactive) == ERR) { + call flush (STDOUT) + call sprintf (cmd, SZ_CMDBUF, + "ERROR (0, \"Iraf Main: Unknown task name (%s)\")\n") + call pargstr (taskname) + call putline (CLOUT, cmd) + call flush (CLOUT) + state = IDLE + next + } + call mem_fini (taskname) + + # Cleanup after successful termination of command. Flush the + # standard output, cancel any unread standard input so the next + # task won't try to read it, print elapsed time if enabled, + # check for an incorrect error handler, call any user posted + # termination procedures, close open files, close any redirected + # i/o and restore the normal standard i/o streams. + + if (builtin_task == NO) { + + call flush (STDOUT) + call fseti (STDIN, F_CANCEL, OK) + + if (timeit == YES) + call sys_ptime (STDERR, taskname, save_time) + + call xer_verify() + call xonerror (OK) + call fio_cleanup (OK) + + if (prtype == PR_CONNECTED) { + call putline (CLOUT, "bye\n") + call flush (CLOUT) + } + if (state != STARTUP) + state = IDLE + } + } + + # The interpreter has exited after receipt of "bye" or EOF. Redirect + # stdout and stderr to the null file (since the parent is no longer + # listening to us), call the user exit procedures if any, and exit. + +shutdown_ + state = SHUTDOWN + if (prtype == PR_CONNECTED) { + call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE) + call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE) + } else if (prtype == PR_HOST && cmd[1] == EOS && interpret == YES) { + call putci (CLOUT, '\n') + call flush (CLOUT) + } + + call xonexit (OK) + call fio_cleanup (OK) + call clclose() + + return (errstat) +end + + +# SYS_GETCOMMAND -- Get the next command from the input file. Ignore blank +# lines and comment lines. Parse the command and return the components as +# output arguments. EOF is returned as the function value when eof file is +# reached on the input file. + +int procedure sys_getcommand (fd, cmd, taskname, arglist_offset, timeit, prtype) + +int fd #I command input file +char cmd[SZ_CMDBUF] #O command line +char taskname[SZ_TASKNAME] #O extracted taskname, lower case +int arglist_offset #O offset into CMD of first argument +int timeit #O if YES, time the command +int prtype #I process type code + +int ip, op +int getlline(), stridx() + +begin + repeat { + # Get command line. Issue prompt first if process is being run + # interactively. + + if (prtype == PR_HOST && fd == CLIN) { + call putline (CLOUT, "> ") + call flush (CLOUT) + } + if (getlline (fd, cmd, SZ_CMDBUF) == EOF) + return (EOF) + + # Check for timeit character and advance to first character of + # the task name. + + timeit = NO + for (ip=1; cmd[ip] != EOS; ip=ip+1) { + if (cmd[ip] == TIMEIT_CHAR && timeit == NO) + timeit = YES + else if (!IS_WHITE (cmd[ip])) + break + } + + # Skip blank lines and comment lines. + switch (cmd[ip]) { + case '#', '\n', EOS: + next + case '?', '!': + taskname[1] = cmd[ip] + taskname[2] = EOS + arglist_offset = ip + 1 + return (OK) + } + + # Extract task name. + op = 1 + while (IS_ALNUM (cmd[ip]) || stridx (cmd[ip], "_.$") > 0) { + taskname[op] = cmd[ip] + ip = ip + 1 + op = min (SZ_TASKNAME + 1, op + 1) + } + taskname[op] = EOS + + # Determine index of argument list. + while (IS_WHITE (cmd[ip])) + ip = ip + 1 + arglist_offset = ip + + # Get rid of the newline. + for (; cmd[ip] != EOS; ip=ip+1) + if (cmd[ip] == '\n') { + cmd[ip] = EOS + break + } + + return (OK) + } +end + + +# SYS_SCANARGLIST -- Parse the argument list of a task. At the level of the +# iraf main the command syntax is very simple. There are two types of +# arguments, parameter assignments (including switches) and i/o redirection +# directives. All param assignments are of the form "param=value", where +# PARAM must start with a lower case alpha and where VALUE is either quoted or +# is delimited by one of the metacharacters [ \t\n<>\\]. A redirection argument +# is anything which is not a parameter set argument, i.e., any argument which +# does not start with a lower case alpha. + +procedure sys_scanarglist (cmdin, i_args) + +int cmdin # command input stream +char i_args[ARB] # (first part of) argument list + +int fd +char ch +bool skip +pointer sp, fname, args, ip, op +int getlline() + +begin + call smark (sp) + call salloc (args, SZ_CMDBUF, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + + call strcpy (i_args, Memc[args], SZ_CMDBUF) + + # Do not skip whitespace for param=value args on the command line. + skip = false + + # Inform FIO that all standard i/o streams are unredirected (overridden + # below if redirected by an argument). + + for (fd=1; fd < FIRST_FD; fd=fd+1) + call fseti (fd, F_REDIR, NO) + + # Process each argument in the argument list. If the command line ends + # with an escaped newline then continuation is assumed. Arguments are + # delimited by whitespace. + + for (ip=args; Memc[ip] != '\n' && Memc[ip] != EOS; ) { + # Advance to the next argument. + while (IS_WHITE (Memc[ip])) + ip = ip + 1 + + # Check for continuation. + ch = Memc[ip] + if (ch == '\\' && (Memc[ip+1] == '\n' || Memc[ip+1] == EOS)) { + if (getlline (cmdin, Memc[args], SZ_CMDBUF) == EOF) { + call sfree (sp) + return + } + ip = args + next + } else if (ch == '\n' || ch == EOS) + break + + # If the argument begins with an alpha, _, or $ (e.g., $nargs) + # then it is a param=value argument, otherwise it must be a redir. + # The form @filename causes param=value pairs to be read from + # the named file. + + if (ch == '@') { + op = fname + for (ip=ip+1; Memc[ip] != EOS; ip=ip+1) + if (IS_WHITE (Memc[ip]) || Memc[ip] == '\n') + break + else if (Memc[ip] == '\\' && Memc[ip+1] == '\n') + break + else { + Memc[op] = Memc[ip] + op = op + 1 + } + Memc[op] = EOS + call sys_getpars (Memc[fname]) + + } else if (IS_ALPHA(ch) || ch == '_' || ch == '$') { + call sys_paramset (Memc, ip, skip) + } else + call sys_redirect (Memc, ip) + } + + call sfree (sp) +end + + +# SYS_GETPARS -- Read a sequence of param=value parameter assignments from +# the named file and enter them into the CLIO cache for the task. + +procedure sys_getpars (fname) + +char fname # pset file + +bool skip +int lineno, fd +pointer sp, lbuf, ip +int open(), getlline() +errchk open, getlline + +begin + call smark (sp) + call salloc (lbuf, SZ_CMDBUF, TY_CHAR) + + fd = open (fname, READ_ONLY, TEXT_FILE) + + # Skip whitespace for param = value args in a par file. + skip = true + + lineno = 0 + while (getlline (fd, Memc[lbuf], SZ_CMDBUF) != EOF) { + lineno = lineno + 1 + for (ip=lbuf; IS_WHITE (Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '#' || Memc[ip] == '\n') + next + iferr (call sys_paramset (Memc, ip, skip)) { + for (; Memc[ip] != EOS && Memc[ip] != '\n'; ip=ip+1) + ; + Memc[ip] = EOS + call eprintf ("Bad param assignment, line %d: `%s'\n") + call pargi (lineno) + call pargstr (Memc[lbuf]) + } + } + + call close (fd) + call sfree (sp) +end + + +# SYS_PARAMSET -- Extract the param and value substrings from a param=value +# or switch argument and enter them into the CL parameter cache. (see also +# clio.clcache). + +procedure sys_paramset (args, ip, skip) + +char args[ARB] # argument list +int ip # pointer to first char of argument +bool skip # skip whitespace within "param=value" args + +pointer sp, param, value, op +int stridx() + +begin + call smark (sp) + call salloc (param, SZ_FNAME, TY_CHAR) + call salloc (value, SZ_VALSTR, TY_CHAR) + + # Extract the param field. + op = param + while (IS_ALNUM (args[ip]) || stridx (args[ip], "_.$") > 0) { + Memc[op] = args[ip] + op = op + 1 + ip = ip + 1 + } + Memc[op] = EOS + + # Advance to the switch character or assignment operator. + while (IS_WHITE (args[ip])) + ip = ip + 1 + + switch (args[ip]) { + case '+': + # Boolean switch "yes". + ip = ip + 1 + call strcpy ("yes", Memc[value], SZ_VALSTR) + + case '-': + # Boolean switch "no". + ip = ip + 1 + call strcpy ("no", Memc[value], SZ_VALSTR) + + case '=': + # Extract the value field. This is either a quoted string or a + # string delimited by any of the metacharacters listed below. + + ip = ip + 1 + if (skip) { + while (IS_WHITE (args[ip])) + ip = ip + 1 + } + call sys_gstrarg (args, ip, Memc[value], SZ_VALSTR) + + default: + call error (1, "IRAF Main: command syntax error") + } + + # Enter the param=value pair into the CL parameter cache. + call clc_enter (Memc[param], Memc[value]) + + call sfree (sp) +end + + +# SYS_REDIRECT -- Process a single redirection argument. The syntax of an +# argument to redirect the standard input is +# +# < [fname] +# +# If the filename is omitted it is understood that STDIN has been redirected +# in the CL. The syntax to redirect a standard output stream is +# +# [45678][TB](>|>>)[fname] +# +# where [4567] is the FD number of a standard output stream (STDOUT, STDERR, +# STDGRAPH, STDIMAGE, or STDPLOT), and [TB] indicates if the file is text or +# binary. If the stream is redirected at the CL level the output filename +# will be given as `$', serving only to indicate that the stream is redirected. + +procedure sys_redirect (args, ip) + +char args[ARB] # argument list +int ip # pointer to first char of redir arg + +pointer sp, fname +int fd, mode, type +int ctoi() +define badredir_ 91 +errchk fredir, fseti + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Get number of stream (0 if not given). + if (ctoi (args, ip, fd) <= 0) + fd = 0 + + # Get file type (optional). + while (IS_WHITE (args[ip])) + ip = ip + 1 + + switch (args[ip]) { + case 'T', 't': + type = TEXT_FILE + ip = ip + 1 + case 'B', 'b': + type = BINARY_FILE + ip = ip + 1 + default: + type = 0 + } + + # Check for "<", ">", or ">>". + while (IS_WHITE (args[ip])) + ip = ip + 1 + + switch (args[ip]) { + case '<': + ip = ip + 1 + mode = READ_ONLY + if (fd == 0) + fd = STDIN + else if (fd != STDIN || fd != CLIN) + goto badredir_ + + case '>': + ip = ip + 1 + if (args[ip] == '>') { + ip = ip + 1 + mode = APPEND + } else + mode = NEW_FILE + + if (fd == 0) + fd = STDOUT + else { + switch (fd) { + case CLOUT, STDOUT, STDERR, STDGRAPH, STDIMAGE, STDPLOT: + ; + default: + goto badredir_ + } + } + + default: + # Not a redirection argument. + call error (1, "IRAF Main: command syntax error") + } + + # Set default file type for given stream if no type specified. + if (type == 0) + switch (fd) { + case CLIN, CLOUT, STDIN, STDOUT, STDERR: + type = TEXT_FILE + default: + type = BINARY_FILE + } + + # Extract the filename, if any. If the CL has redirected the output + # and is merely using the redirection syntax to inform us of this, + # the metafilename "$" is given. + + while (IS_WHITE (args[ip])) + ip = ip + 1 + + if (args[ip] == '$') { + Memc[fname] = EOS + ip = ip + 1 + } else + call sys_gstrarg (args, ip, Memc[fname], SZ_FNAME) + + # At this point we have FD, FNAME, MODE and TYPE. If no file is + # named the stream has already been redirected by the parent and + # all we need to is inform FIO that the stream has been redirected. + # Otherwise we redirect the stream in the local process. A locally + # redirected stream will be closed and the normal direction restored + # during FIO cleanup, at program termination or during error + # recovery. + + if (Memc[fname] != EOS) + call fredir (fd, Memc[fname], mode, type) + else + call fseti (fd, F_REDIR, YES) + + call sfree (sp) + return + +badredir_ + call error (2, "IRAF Main: illegal redirection") +end + + +# SYS_GSTRARG -- Extract a string field. This is either a quoted string or a +# string delimited by any of the metacharacters " \t\n<>\\". + +procedure sys_gstrarg (args, ip, outstr, maxch) + +char args[ARB] # input string +int ip # pointer into input string +char outstr[maxch] # receives string field +int maxch + +char delim, ch +int op +int stridx() + +begin + op = 1 + if (args[ip] == '"' || args[ip] == '\'') { + # Quoted value string. + + delim = args[ip] + for (ip=ip+1; args[ip] != delim && args[ip] != EOS; ip=ip+1) { + if (args[ip] == '\n') { + break + } else if (args[ip] == '\\' && args[ip+1] == delim) { + outstr[op] = delim + op = op + 1 + ip = ip + 1 + } else { + outstr[op] = args[ip] + op = op + 1 + } + } + + } else { + # Nonquoted value string. + + for (delim=-1; args[ip] != EOS; ip=ip+1) { + ch = args[ip] + if (ch == '\\' && (args[ip+1] == '\n' || args[ip+1] == EOS)) + break + else if (stridx (ch, " \t\n<>\\") > 0) + break + else { + outstr[op] = ch + op = op + 1 + } + } + } + + outstr[op] = EOS + if (args[ip] == delim) + ip = ip + 1 +end -- cgit