/******************************************************************************
*
* F I L E A P R O C (char *procname,char *filename, char *comm)
*
* Saves the procedure 'procname' in the file 'filename' for the command 'comm'.
*
* If the procname parameter is CHARNIL then saves all the currently known
* procedures into the file filename
* OR
* if procname is not CHARNIL the procedure is checked to exist (lookup_proc()).
*
* The file "filename" is opened for write using iclopenasoutfp()
* If procname is CHARNIL then forall_typed_symbols() is called with
* listproc() to print all the procs to the file otherwise listproc() is used
* once to list the named proc to filename.
* The file filename is then closed using iclcloseasoutfp().
*
******************************************************************************
*/
value
fileaproc(char *procname, char *filename, char *comm)
{
extern value iclopenasoutfp (char *whofor, char *filename); /* output.c */
extern value iclcloseasoutfp(char *whofor, char *filename); /* output.c */
node *proc = NULL;
value val;
if (procname != CHARNIL) { /* Named procedure */
if( (proc = lookup_proc(procname)) == NODENIL)
return exception2(
"PROCERR %s: Unrecognised procedure or command name %s",
comm, procname);
} else
if( symbol_total(world, SYM_PROC) == 0) { /* No procedures */
unlink(filename);
return trueval;
}
if (isexc(val = iclopenasoutfp(comm, filename)))
return val;
if (procname == CHARNIL ) /* All procedures */
(void) forall_typed_symbols(SYM_PROC, listproc);
else
(void) listproc(procname, proc, 0);
return (iclcloseasoutfp(comm, filename));
}
/******************************************************************************
*
* L I S T A P R O C (char *name)
*
* Routine used by the ICL command "LIST" and lists the procedure with the
* name "name".
*
* Uses lookup_symbol() to find the proc entry in the global symbol table and,
* if found, use listproc() to list it
*
******************************************************************************
*/
value
listaproc(char *name)
{
node *proc;
if ((proc = lookup_symbol(name, SYM_PROC)) != NODENIL) {
outfpstring("\n");
listproc(name, proc, 0);
outfpstring("\n");
return trueval;
} else
return exception(
"PROCERR LIST: Unrecognised procedure or command name");
}
int dofunc() { cloc=&co; strcpy1(fname, symbol);
prs("\n\n"); prs(symbol); prs(" PROC");
expect('('); narg=0; LTop=LStart;
if (istoken(')')==0) { prs("\narg ");
do { typeName(); addlocal();
if (narg) prc(','); prs(symbol);
if (istype!='*') {if (iswidth=='B') prs(":byte ");} narg++; }
while (istoken(',')); expect(')'); }
expect('{'); /*body*/
nlocal=0; nreturn=0; nconst=0;
if (isvariable()) prs("\nlocal ");
while(isvariable()) {
do { typeName(); addlocal();
if (nlocal) prc(','); prs(symbol);
if (istype!='*') {if (iswidth=='B') prs(":byte ");} nlocal++;
if (istoken('[')){istype='&';GType[LTop]='&';expect(T_CONST);expect(']');
prs(":BYTE:"); prnum(lexval); }
} while (istoken(',')); expect(';'); }
while(istoken('}')==0) stmt();
if (nreturn) prs("\n@@retn:"); prs("\n ret\nENDP"); listproc(); }
int expect(int t) {if (istoken(t)==0) { listproc();
prs("\nErwartet ASCII(dez): "); prnum(t); error1(" nicht gefunden"); } }
