/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "module.p" */ #include /* module replacement program Dr. Thomas D. Schneider National Cancer Institute Laboratory of Experimental and Computational Biology Frederick, Maryland 21702-1201 toms@ncifcrf.gov permanent email: toms@alum.mit.edu (use only if first address fails) http://www.lecb.ncifcrf.gov/~toms/ documentation and operation of this program are defined in moddef 2.12. module libraries required: delman, delmods */ /* the end of the program */ /* begin module version */ #define version "6.16 of module.p 2003 May 5" /* 2003 May 5, 6.16: documentation upgrade 2003 May 3, 6.15: documentation upgrade 1998 Dec 3, 6.14: last major changes 1981 fall: origin was during the fall of 1981 */ /* end module version */ /* begin module describe.module */ /* name module: module replacement program synopsis module(sin: in, modlib: in, sout: out, modcat: inout, list: out, output: out) files sin: the source program or file modlib: a library of modules (if empty, modules of sin are stripped) sout: the source program with modules replaced from modlib modcat: an alphabetic index to modlib that is recreated if it does not match modlib list: progress of the transfer. meaning of the list columns: nesting depth: how deeply the module was nested inside other modules action: what was done with the module. if a module was not transferred, a symbol on the left flags the situation: (blank) successful transfer * module not found in the source v no transfer because version modules can not be transferred ? recursive transfers were aborted because the modules may be infinitely nested (the depth at which this happens can be increased by changing the program - ask your programmer). (problem: can you construct this bizarre infinite situation?) module name: the name of the module in the source. in recursive cases, these are from the modlib. output: messages to the user description The module program allows one to construct libraries of special purpose program modules, which one simply 'plugs' into the appropriate place in a program. This speeds up both program design and error correction. Module is more general-purpose than the standard 'include' type processes because it performs a replacement rather than a simple insertion. The operation is recursive, so a module may be composed of other modules. The replacement mechanism also allows one to run the program in 'reverse' so that module-libraries are created by extracting modules from existing programs. This makes the building of module libraries easy, and helps keep them updated with new modules and improvements to old ones. For a full description, see the documentation. documentation moddef, delman.assembly.modules, delman.intro.organization 'technical notes' see also {Defintion of the module system:} moddef {Delila manual describes use:} delman {Major programs that contain modules (ie, modlib examples):} delmod.p, prgmod.p, matmod.p {Example programs:} break.p, show.p {Example of using the module program to insert date/time modules into programs:} http://www.lecb.ncifcrf.gov/~toms/datetime.html author Thomas D. Schneider bugs none known technical notes As usual, many compiler writers are idiots who usurp key words. In the case of this program, the SparcWorks writers at Sun Microsystems decided to use the word "module" and so this can no longer be used in this program. The solution is to use the worcha program to convert these to "amodule". */ /* end module describe.module */ /* more constants */ #define lastcharacter ' ' /* the last character after a module name */ #define maxname 50 /* one plus the largest name allowed */ /* maxdepth is the largest number of recursive transfers allowed before the program assumes that there must be an infinite number. the value can be set very high, an infinite example run (debugging so that sout is not destroyed in procedure halt) and the number of successful transfers found as the number of transfers seen in sout. then maxdepth can be set to a value somewhat under the true maximum of the computer memory. */ #define maxdepth 10 /* the program will check the correspondence between modlib and modcat. checkuptimes is the number of modules to check. see the checkup procedure. */ #define checkuptimes 2 /* if the checkup fails, the constant recreate determines what will be done: halt or recreate the catalogue and go on. */ #define recreate true #define debugging false /* for debugging purposes */ typedef struct name { /* a module name */ Char letter[maxname]; long length; /* the last character of the name */ } name; typedef struct trigger { /* an object to be searched for */ name n; /* the characters looked for */ long state; /* how close to triggering we are */ boolean skip; /* trigger not found- skip the line */ /* the trigger was found */ boolean found; } trigger; typedef struct modcatitem { /* an item in modcat */ name amodule; /* the name of a module */ long line; /* the line module is on in modlib */ } modcatitem; typedef struct modcatfile { FILE *f; FILEBUFNC(f,modcatitem); Char name[_FNSIZE]; } modcatfile; Static _TEXT sin_; /* the source in file */ Static _TEXT modlib; /* the module library */ Static _TEXT sout; /* the source out file */ Static _TEXT list; /* progress of the transfer */ Static modcatfile modcat; /* the catalogue for modlib */ Static long sinline; /* the current line in sin */ Static long modlibline; /* the current line in modlib */ /* the triggers for the modules */ Static trigger begintrigger, endtrigger; Static name sinname; /* the name of the top level */ Static name vermod; /* a module named version */ /* variables for keeping track of module library version */ Static boolean showversion; /* is there a version to show? */ Static name vername; /* the name of the version to show */ /* variables used for checkup. the main purpose for these two variables is to prevent a halt when procedure checkup calls getline and the line refered to by the catalogue is past the end of the modlib. this allows recovery from a switch to a shorter modlib without changing modcat: a new modcat can be created. */ Static boolean donthalt; /* the halt procedure should be silent */ /* if halt is called and donthalt is true then halt will set this to true */ Static boolean haltcalled; /* the next two variables count modules detected and transfered at the depth=0. (note: one could count inner modules, but in a trial, the output became cluttered with almost useless data.) */ Static long detectedmodules; /* number of modules detected */ Static long transferredmodules; /* number of modules transferred */ Static jmp_buf _JL1; /* halt :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */ Static Void halt() { /* stop the program */ if (donthalt) { haltcalled = true; return; } if (*modcat.name != '\0') { if (modcat.f != NULL) modcat.f = freopen(modcat.name, "wb", modcat.f); else modcat.f = fopen(modcat.name, "wb"); } else { if (modcat.f != NULL) rewind(modcat.f); else modcat.f = tmpfile(); } if (modcat.f == NULL) _EscIO2(FileNotFound, modcat.name); SETUPBUF(modcat.f, modcatitem); /* if not debugging then (@ allow access to sout */ if (*sout.name != '\0') { if (sout.f != NULL) sout.f = freopen(sout.name, "w", sout.f); else sout.f = fopen(sout.name, "w"); } else { if (sout.f != NULL) rewind(sout.f); else sout.f = tmpfile(); } if (sout.f == NULL) _EscIO2(FileNotFound, sout.name); SETUPBUF(sout.f, Char); printf(" error in module transfer. see list\n"); printf(" program halt.\n"); fprintf(list.f, " program halt.\n"); longjmp(_JL1, 1); /* the following two lines pervent partially created files from being accidently used: */ } /* nonstandard procedure to allow unlimited output :::::::::::::::::::::::: */ /* begin module unlimitln */ /* end module unlimitln version = 'delmod 6.51 85 apr 17 tds/gds' */ /* character and line manipulation :::::::::::::::::::::::::::::::::::::::: */ Static Void copy_(fin, fout, ch) _TEXT *fin, *fout; Char *ch; { /* copy one character (ch) from file fin to file fout */ if (BUFEOF(fin->f)) return; *ch = getc(fin->f); if (*ch == '\n') *ch = ' '; putc(*ch, fout->f); /* if debugging then writeln(list,'copy ',ch);*/ } Static Void finishline(sin, sout, sinline) _TEXT *sin, *sout; long *sinline; { /* finish copy of a line in sin to sout, increment sinline */ Char ch; /* one of the characters copied */ while (!P_eoln(sin->f)) copy_(sin, sout, &ch); fscanf(sin->f, "%*[^\n]"); getc(sin->f); putc('\n', sout->f); (*sinline)++; } Static Void gettoline(line, f, current) long line; _TEXT *f; long *current; { /* get to a line in f from the current place. current = line after gettoline is done */ if (*current > line) { /* the line is above where we are */ if (*f->name != '\0') { if (f->f != NULL) f->f = freopen(f->name, "r", f->f); else f->f = fopen(f->name, "r"); } else rewind(f->f); if (f->f == NULL) _EscIO2(FileNotFound, f->name); RESETBUF(f->f, Char); *current = 1; } while ((*current < line) & (!BUFEOF(f->f))) { (*current)++; fscanf(f->f, "%*[^\n]"); getc(f->f); } if (BUFEOF(f->f)) { fprintf(list.f, " modcat refers to a line (%ld) that is past the end of modlib.\n", line); halt(); } } /* name manipulations ::::::::::::::::::::::::::::::::::::::::::::::::::::: */ Static Void clearname(n) name *n; { /* set the name to blank */ long l; /* a position in the name */ for (l = 0; l < maxname; l++) n->letter[l] = ' '; n->length = 0; } Static Void printname(f, n) _TEXT *f; name n; { /* print the name of n to file f */ /* p2c: module.p, line 278: Note: * Format for packed-array-of-char will work only if width < length [321] */ fprintf(f->f, "%.*s", (int)n.length, n.letter); } Static Void untrail(n) name *n; { /* remove all trailing blanks from name n and end n with the lastcharacter */ n->length = maxname; while (n->length > 0 && n->letter[n->length - 1] == ' ') n->length--; /* put lastcharacter at end */ n->length++; if (n->length <= maxname) { n->letter[n->length - 1] = lastcharacter; return; } n->length = maxname; fprintf(list.f, " this name was found: \""); printname(&list, *n); fprintf(list.f, "\".\n"); fprintf(list.f, " names must be one character shorter than %ld characters.\n", (long)maxname); halt(); } Static Void getname(source, n) _TEXT *source; name *n; { /* return the name n in source, upto and including the global constant lastcharacter */ Char ch = '.'; /* one of the characters in n */ clearname(n); /* start with a character that is not lastcharacter */ while (!P_eoln(source->f) && ch != lastcharacter && n->length <= maxname) { n->length++; ch = getc(source->f); if (ch == '\n') ch = ' '; n->letter[n->length - 1] = ch; } if (n->letter[n->length - 1] == lastcharacter) return; fprintf(list.f, " this module name: \n"); printname(&list, *n); if (n->length == maxname) { fprintf(list.f, " is too long (>%ld characters)\n", maxname - 1L); /* if not that, it must be eoln: */ } else fprintf(list.f, " did not end with a \"%c\".\n", lastcharacter); halt(); } Static boolean equalname(a, b) name a, b; { /* are the names a and b the same? */ if (a.length == b.length) return (strncmp(a.letter, b.letter, maxname) == 0); else return false; } Static boolean greatername(a, b) name a, b; { /* is a alphabetically after b? */ return (strncmp(a.letter, b.letter, maxname) > 0); } /* module mechanisms :::::::::::::::::::::::::::::::::::::::::::::::::::::: */ Static Void resettrigger(t) trigger *t; { /* reset the trigger to ground state */ t->state = 0; t->skip = false; t->found = false; } Static Void testfortrigger(ch, t) Char ch; trigger *t; { /* look at the character ch. if it is part of the trigger (at the current trigger state), then the trigger state goes higher. if it is not part of the trigger then the trigger state is reset, skip is true and one should skip onward to find the trigger. if the trigger is found, found is true. */ t->state++; /* if debugging then begin printname(list,n); writeln(list,'testfortrigger n.letter[',state:1,']:', n.letter[state],' ch:',ch); end;*/ if (t->n.letter[t->state - 1] == ch) { t->skip = false; if (t->state == t->n.length) t->found = true; else t->found = false; return; } t->state = 0; t->skip = true; t->found = false; /* reset trigger */ } Static Void findmoduleend(sin, amodule, sinline) _TEXT *sin; name amodule; long *sinline; { /* find (by reads) the end of the module in sin. increment sinline, the line in sin */ boolean found = false; /* the module end was found */ Char ch; /* a character in sin */ name endname; /* perhaps the end */ while ((!found) & (!BUFEOF(sin->f))) { resettrigger(&endtrigger); while (!(P_eoln(sin->f) || endtrigger.skip || endtrigger.found)) { ch = getc(sin->f); if (ch == '\n') ch = ' '; testfortrigger(ch, &endtrigger); } if (endtrigger.found) { getname(sin, &endname); if (equalname(endname, amodule)) found = true; } /* close sin line up */ fscanf(sin->f, "%*[^\n]"); getc(sin->f); (*sinline)++; } if (!BUFEOF(sin->f) || found) return; fprintf(list.f, " no end to module "); printname(&list, amodule); fprintf(list.f, " whose contents were being skipped.\n"); halt(); } Static Char copytobound(sin, sout, line) _TEXT *sin, *sout; long *line; { /* copy from sin to sout until a module boundary is found. return a character: b begin module found e end module found f file end = eof found in b or e cases, the name is to be picked up next. */ Char Result; boolean found = false; /* a boundary was found */ Char ch; /* one of the characters in sin */ /* if debugging then writeln(list,'copytobound');*/ while ((!found) & (!BUFEOF(sin->f))) { resettrigger(&begintrigger); resettrigger(&endtrigger); while (!(P_eoln(sin->f) || ((begintrigger.skip || begintrigger.found) && (endtrigger.skip || endtrigger.found)))) { copy_(sin, sout, &ch); testfortrigger(ch, &begintrigger); testfortrigger(ch, &endtrigger); } found = (begintrigger.found || endtrigger.found); if (!found) { /* copy rest of line out */ if (begintrigger.skip || endtrigger.skip) { while (!P_eoln(sin->f)) copy_(sin, sout, &ch); } } if (P_eoln(sin->f)) { fscanf(sin->f, "%*[^\n]"); getc(sin->f); putc('\n', sout->f); (*line)++; } } if (!found) { return 'f'; /* termination at file end */ /* ;if debugging then writeln(list,'copytobound') */ } /* if debugging then writeln(list,'copytobound:found');*/ if (begintrigger.found) Result = 'b'; if (endtrigger.found) return 'e'; return Result; } Static Void copytoend(sin, sout, amodule, sinline) _TEXT *sin, *sout; name amodule; long *sinline; { /* copy to the end of the module from sin to sout without transfering inner modules, and objecting to eof in sin. increment sinline */ boolean done = false; /* done copying */ name endname; /* a name of a module end, perhaps that of module */ /* if debugging then writeln(list,'copytoend'); */ while (!done) { switch (copytobound(sin, sout, sinline)) { case 'b': /* ignore begins */ break; case 'e': /* maybe this is it */ getname(sin, &endname); if (equalname(endname, amodule)) done = true; printname(sout, endname); finishline(sin, sout, sinline); break; case 'f': fprintf(list.f, " the end of module "); printname(&list, amodule); fprintf(list.f, " was not found during copying\n"); halt(); break; } } } Static Void skiptoend(sin, sout, sinline) _TEXT *sin, *sout; long *sinline; { /* skip to the end of the module found in sin. however, we must finish the line to sout while picking up the module name. also, the last line of the module must be made. */ name amodule; /* the module being skipped */ /* if debugging then writeln(list,'skiptoend');*/ /* obtain the module name and copy the line to sout */ getname(sin, &amodule); printname(sout, amodule); finishline(sin, sout, sinline); if (equalname(amodule, vermod)) { /* woah there... we canot strip a version module... */ copytoend(sin, sout, amodule, sinline); return; } /* skip over the module */ findmoduleend(sin, amodule, sinline); /* at this point endtrigger for module must have been found, but the end of the module was not writen to sout. */ printname(sout, endtrigger.n); /* the trigger */ printname(sout, amodule); /* its name */ /* if debugging then write(sout,'(stripped)'); */ /* put a blank at the end of the comment: */ if (lastcharacter != ' ') putc(' ', sout->f); fprintf(sout->f, "*)\n"); /* end of comment */ /* ;if debugging then writeln(list, 'skiptoend') */ } /* catalogue manipulations :::::::::::::::::::::::::::::::::::::::::::::::: */ Static Void grab(f, item) modcatfile *f; modcatitem *item; { /* obtain an item from file f */ fread(item, sizeof(modcatitem), 1, f->f); } Static Void drop(t, item) modcatfile *t; modcatitem *item; { /* place an item into file t */ fwrite(item, sizeof(modcatitem), 1, t->f); } Static Void show(o, c) _TEXT *o; modcatfile *c; { /* show the modcat c on file o */ modcatitem item; /* an item in c */ if (*c->name != '\0') { if (c->f != NULL) c->f = freopen(c->name, "rb", c->f); else c->f = fopen(c->name, "rb"); } else rewind(c->f); if (c->f == NULL) _EscIO2(FileNotFound, c->name); RESETBUF(c->f, modcatitem); fprintf(o->f, "\n line module name\n"); while (!BUFEOF(c->f)) { grab(c, &item); fprintf(o->f, " %6ld ", item.line); printname(o, item.amodule); putc('\n', o->f); } putc('\n', o->f); } Static Void build(modlib, modcat) _TEXT *modlib; modcatfile *modcat; { /* build the modcat from the modlib */ long li = 1; /* current line in modlib */ Char ch; /* a character in modlib */ name na; /* a module name */ modcatitem item; /* one of the records in modcat */ long number = 0; /* how many modules there are in modlib */ if (*modlib->name != '\0') { if (modlib->f != NULL) modlib->f = freopen(modlib->name, "r", modlib->f); else modlib->f = fopen(modlib->name, "r"); } else rewind(modlib->f); if (modlib->f == NULL) _EscIO2(FileNotFound, modlib->name); RESETBUF(modlib->f, Char); if (*modcat->name != '\0') { if (modcat->f != NULL) modcat->f = freopen(modcat->name, "wb", modcat->f); else modcat->f = fopen(modcat->name, "wb"); } else { if (modcat->f != NULL) rewind(modcat->f); else modcat->f = tmpfile(); } if (modcat->f == NULL) _EscIO2(FileNotFound, modcat->name); SETUPBUF(modcat->f, modcatitem); while (!BUFEOF(modlib->f)) { resettrigger(&begintrigger); resettrigger(&endtrigger); while (!(P_eoln(modlib->f) || ((begintrigger.skip || begintrigger.found) && (endtrigger.skip || endtrigger.found)))) { ch = getc(modlib->f); if (ch == '\n') ch = ' '; testfortrigger(ch, &begintrigger); testfortrigger(ch, &endtrigger); } if (begintrigger.found) { getname(modlib, &item.amodule); item.line = li; drop(modcat, &item); number++; /* count the modules */ findmoduleend(modlib, item.amodule, &li); continue; } if (!endtrigger.found) { fscanf(modlib->f, "%*[^\n]"); getc(modlib->f); li++; continue; } fprintf(list.f, " unexpected module end: "); getname(modlib, &na); printname(&list, na); fprintf(list.f, " at line %ld in modlib.\n", li); halt(); } if (number == 0) { fprintf(list.f, " no modules in modlib.\n"); halt(); return; } fprintf(list.f, " %ld module", number); if (number != 1) putc('s', list.f); fprintf(list.f, " in modlib.\n"); if (*modlib->name != '\0') { if (modlib->f != NULL) modlib->f = freopen(modlib->name, "r", modlib->f); else modlib->f = fopen(modlib->name, "r"); } else rewind(modlib->f); if (modlib->f == NULL) _EscIO2(FileNotFound, modlib->name); RESETBUF(modlib->f, Char); /* clean up */ } /* build */ Local Void bubblepass(f, t, changes) modcatfile *f, *t; boolean *changes; { /* pass once across file f copying to file t. indicate whether any sorting happened using changes. the algorithm is simple: pickup two items and always drop the smaller one. */ modcatitem a, b; /* two of the items in f */ /* if debugging then show(list,f); */ *changes = false; if (*f->name != '\0') { if (f->f != NULL) f->f = freopen(f->name, "rb", f->f); else f->f = fopen(f->name, "rb"); } else rewind(f->f); if (f->f == NULL) _EscIO2(FileNotFound, f->name); RESETBUF(f->f, modcatitem); if (*t->name != '\0') { if (t->f != NULL) t->f = freopen(t->name, "wb", t->f); else t->f = fopen(t->name, "wb"); } else { if (t->f != NULL) rewind(t->f); else t->f = tmpfile(); } if (t->f == NULL) _EscIO2(FileNotFound, t->name); SETUPBUF(t->f, modcatitem); grab(f, &a); /* if debugging then write(list,'grab a,'); */ while (!BUFEOF(f->f)) { /* the last one */ /* if debugging then write(list,'grab b,');*/ grab(f, &b); /* always drop the smaller item */ if (greatername(b.amodule, a.amodule) | equalname(b.amodule, a.amodule)) { /* if debugging then write(list,'drop a, a:=b,');*/ drop(t, &a); a = b; /* replenish a */ } else { *changes = true; /* retain a */ /* if debugging then write(list,'drop b,');*/ drop(t, &b); } } /* if debugging then writeln(list,'drop a.'); */ drop(t, &a); } /* bubble pass */ Static Void sort(f) modcatfile *f; { /* sort the file f. a simple multiple pass bubble sort is used since the number of items in modcat is often small. two files are used: f and an internal file (i) to avoid constraints of an array. */ modcatfile i; /* an internal file */ boolean changes = true; /* whether changes were made in a pass */ i.f = NULL; *i.name = '\0'; /* if debugging then writeln(list,'sort'); */ while (changes) { /* if debugging then writeln(list,'pass 1'); */ bubblepass(f, &i, &changes); /* if debugging then writeln(list,'pass 2(?)'); */ if (changes) bubblepass(&i, f, &changes); } /*; if debugging then writeln(list,'end sort') */ if (i.f != NULL) fclose(i.f); } /* sort */ Static Void checkduplicate(f) modcatfile *f; { /* check file f for duplicate names, taking advantage of the fact that it is sorted */ modcatitem a, b; /* two items in f */ boolean ok = true; /* no duplicates */ if (*f->name != '\0') { if (f->f != NULL) f->f = freopen(f->name, "rb", f->f); else f->f = fopen(f->name, "rb"); } else rewind(f->f); if (f->f == NULL) _EscIO2(FileNotFound, f->name); RESETBUF(f->f, modcatitem); grab(f, &a); while (!BUFEOF(f->f)) { grab(f, &b); if (equalname(a.amodule, b.amodule)) { ok = false; fprintf(list.f, " duplicate module name: "); printname(&list, a.amodule); fprintf(list.f, "\n found at lines %ld and %ld of modlib.\n", a.line, b.line); } a = b; } if (ok) return; if (*modcat.name != '\0') { if (modcat.f != NULL) modcat.f = freopen(modcat.name, "wb", modcat.f); else modcat.f = fopen(modcat.name, "wb"); } else { if (modcat.f != NULL) rewind(modcat.f); else modcat.f = tmpfile(); } if (modcat.f == NULL) _EscIO2(FileNotFound, modcat.name); SETUPBUF(modcat.f, modcatitem); /* destroy the bad copy */ halt(); } Static Void createmodcat(modlib, modcat) _TEXT *modlib; modcatfile *modcat; { /* build sort and check the module catalogue */ fprintf(list.f, " creating module catalogue (modcat)\n"); build(modlib, modcat); sort(modcat); checkduplicate(modcat); show(&list, modcat); if (*modcat->name != '\0') { if (modcat->f != NULL) modcat->f = freopen(modcat->name, "rb", modcat->f); else modcat->f = fopen(modcat->name, "rb"); } else rewind(modcat->f); if (modcat->f == NULL) _EscIO2(FileNotFound, modcat->name); RESETBUF(modcat->f, modcatitem); } Static boolean inmodcat(amodule, line) name amodule; long *line; { /* is the module in the modcat? (modcat is passed as a global for speed) return the line number in modlib (side effect) */ boolean Result; modcatitem n; /* an item in modcat */ boolean found; /* true when module is found */ /* quick check to see if we can avoid a reset */ if (BUFEOF(modcat.f)) { /* oh well... */ if (*modcat.name != '\0') { if (modcat.f != NULL) modcat.f = freopen(modcat.name, "rb", modcat.f); else modcat.f = fopen(modcat.name, "rb"); } else rewind(modcat.f); if (modcat.f == NULL) _EscIO2(FileNotFound, modcat.name); RESETBUF(modcat.f, modcatitem); found = false; } else { /* it is above this point - we lose */ grab(&modcat, &n); if (greatername(n.amodule, amodule)) { if (*modcat.name != '\0') { if (modcat.f != NULL) modcat.f = freopen(modcat.name, "rb", modcat.f); else modcat.f = fopen(modcat.name, "rb"); } else rewind(modcat.f); if (modcat.f == NULL) _EscIO2(FileNotFound, modcat.name); RESETBUF(modcat.f, modcatitem); found = false; } /* it is below this point - or we are on it */ else if (equalname(n.amodule, amodule)) found = true; /* zooks...got it...zooks...*/ else found = false; /* it is below this point - we win */ } /* we stand a chance */ /* if found and debugging then writeln(list, 'zooks...(inmodcat)');*/ while ((!found) & (!BUFEOF(modcat.f))) { grab(&modcat, &n); if (equalname(n.amodule, amodule)) found = true; } if (found) { Result = true; *line = n.line; } else { /* an impossible line number */ Result = false; *line = -1; } return Result; } /* inmodcat */ Static Void checkup(modlib, modcat) _TEXT *modlib; modcatfile *modcat; { /* check that modlib corresponds to modcat. the number of modules to check is set by the global constant checkuptimes. */ long times = 0; /* number of checks completed */ boolean fail = false; /* what may well happen during this checkup */ modcatitem cat; /* one item in modcat */ Char ch; /* a character from modlib */ name libname; /* a name from modlib */ long modlibline = 1; /* the current line in modlib */ long modcatline; /* a line refered to by modcat */ fprintf(list.f, " check modlib-modcat correspondence:\n"); if (*modlib->name != '\0') { if (modlib->f != NULL) modlib->f = freopen(modlib->name, "r", modlib->f); else modlib->f = fopen(modlib->name, "r"); } else rewind(modlib->f); if (modlib->f == NULL) _EscIO2(FileNotFound, modlib->name); RESETBUF(modlib->f, Char); if (*modcat->name != '\0') { if (modcat->f != NULL) modcat->f = freopen(modcat->name, "rb", modcat->f); else modcat->f = fopen(modcat->name, "rb"); } else rewind(modcat->f); if (modcat->f == NULL) _EscIO2(FileNotFound, modcat->name); RESETBUF(modcat->f, modcatitem); /* first check: do items in the catalogue point to modules in modlib */ donthalt = true; /* prevent halting during this check */ do { /* this forces at least one check. */ /* get an item from the catalogue */ grab(modcat, &cat); /* use the item to locate a line in modlib */ gettoline(cat.line, modlib, &modlibline); if (haltcalled) { /* reference by modcat to a line past the end of modlib */ fail = true; haltcalled = false; } else { /* first we must determine that a module is there */ resettrigger(&begintrigger); while (!(P_eoln(modlib->f) || begintrigger.found || begintrigger.skip)) { ch = getc(modlib->f); if (ch == '\n') ch = ' '; testfortrigger(ch, &begintrigger); } if (begintrigger.skip | P_eoln(modlib->f)) fail = true; else { getname(modlib, &libname); if (!equalname(libname, cat.amodule)) fail = true; } /* begintrigger.found */ /* check the name */ times++; } } while (!(((times >= checkuptimes) | BUFEOF(modcat->f)) || fail)); donthalt = false; /* allow halting again */ /* second check: do items in modlib have corresponding items in modcat? */ if (!fail) { if (*modlib->name != '\0') { if (modlib->f != NULL) modlib->f = freopen(modlib->name, "r", modlib->f); else modlib->f = fopen(modlib->name, "r"); } else rewind(modlib->f); if (modlib->f == NULL) _EscIO2(FileNotFound, modlib->name); RESETBUF(modlib->f, Char); if (*modcat->name != '\0') { if (modcat->f != NULL) modcat->f = freopen(modcat->name, "rb", modcat->f); else modcat->f = fopen(modcat->name, "rb"); } else rewind(modcat->f); if (modcat->f == NULL) _EscIO2(FileNotFound, modcat->name); RESETBUF(modcat->f, modcatitem); modlibline = 1; times = 0; do { resettrigger(&begintrigger); while (!(P_eoln(modlib->f) || begintrigger.skip || begintrigger.found)) { ch = getc(modlib->f); if (ch == '\n') ch = ' '; testfortrigger(ch, &begintrigger); } if (begintrigger.found) { times++; getname(modlib, &libname); if (!inmodcat(libname, &modcatline)) { fail = true; /* maybe the lines do not match... */ } else if (modcatline != modlibline) fail = true; if (!fail) findmoduleend(modlib, libname, &modlibline); } else { fscanf(modlib->f, "%*[^\n]"); getc(modlib->f); modlibline++; } } while (!(((times > checkuptimes) | BUFEOF(modlib->f)) || fail)); } /* if debugging then writeln(list,' second check'); */ if (fail) { fprintf(list.f, " failed: "); if (recreate) createmodcat(modlib, modcat); else halt(); return; } fprintf(list.f, " passed.\n"); modlibline = 1; if (*modlib->name != '\0') { if (modlib->f != NULL) modlib->f = freopen(modlib->name, "r", modlib->f); else modlib->f = fopen(modlib->name, "r"); } else rewind(modlib->f); if (modlib->f == NULL) _EscIO2(FileNotFound, modlib->name); RESETBUF(modlib->f, Char); if (*modcat->name != '\0') { if (modcat->f != NULL) modcat->f = freopen(modcat->name, "rb", modcat->f); else modcat->f = fopen(modcat->name, "rb"); } else rewind(modcat->f); if (modcat->f == NULL) _EscIO2(FileNotFound, modcat->name); RESETBUF(modcat->f, modcatitem); } /* main calls ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */ Static Void initialize() { /* start up the program */ printf(" %s\n", version); if (*sin_.name != '\0') { if (sin_.f != NULL) sin_.f = freopen(sin_.name, "r", sin_.f); else sin_.f = fopen(sin_.name, "r"); } else rewind(sin_.f); if (sin_.f == NULL) _EscIO2(FileNotFound, sin_.name); RESETBUF(sin_.f, Char); if (*modlib.name != '\0') { if (modlib.f != NULL) modlib.f = freopen(modlib.name, "r", modlib.f); else modlib.f = fopen(modlib.name, "r"); } else rewind(modlib.f); if (modlib.f == NULL) _EscIO2(FileNotFound, modlib.name); RESETBUF(modlib.f, Char); if (*sout.name != '\0') { if (sout.f != NULL) sout.f = freopen(sout.name, "w", sout.f); else sout.f = fopen(sout.name, "w"); } else { if (sout.f != NULL) rewind(sout.f); else sout.f = tmpfile(); } if (sout.f == NULL) _EscIO2(FileNotFound, sout.name); SETUPBUF(sout.f, Char); if (*modcat.name != '\0') { if (modcat.f != NULL) modcat.f = freopen(modcat.name, "rb", modcat.f); else modcat.f = fopen(modcat.name, "rb"); } else rewind(modcat.f); if (modcat.f == NULL) _EscIO2(FileNotFound, modcat.name); RESETBUF(modcat.f, modcatitem); if (*list.name != '\0') { if (list.f != NULL) list.f = freopen(list.name, "w", list.f); else list.f = fopen(list.name, "w"); } else { if (list.f != NULL) rewind(list.f); else list.f = tmpfile(); } if (list.f == NULL) _EscIO2(FileNotFound, list.name); SETUPBUF(list.f, Char); fprintf(list.f, " %s\n", version); sinline = 1; modlibline = 1; /* set up triggers. they must be the same size as maxname. */ /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ memcpy(begintrigger.n.letter, "(* begin module ", (long)maxname); untrail(&begintrigger.n); /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ memcpy(endtrigger.n.letter, "(* end module ", (long)maxname); untrail(&endtrigger.n); /* make name of top level. this name must have blanks in it to avoid detection of a module by the same name */ /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ memcpy(sinname.letter, "(source input) ", (long)maxname); untrail(&sinname); /* make name of the version module */ /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ memcpy(vermod.letter, "version ", (long)maxname); untrail(&vermod); /* set up halt variables */ donthalt = false; haltcalled = false; /* set up module counting variables */ detectedmodules = 0; transferredmodules = 0; } /* initialize */ Static Void getversion() { /* find the module named version in modlib, and return its first line in vername. if there is no module, set showversion to false */ long line; /* the line in modlib of the version */ Char ch; /* a character to go into vername */ boolean endofcomment = false; /* is false until the end of a comment is detected in the version string. when detected, the string is truncated to avoid putting two end-of-comments onto the end module lines */ if (!inmodcat(vermod, &line)) { showversion = false; return; } gettoline(line, &modlib, &modlibline); /* move to first line of module version */ fscanf(modlib.f, "%*[^\n]"); getc(modlib.f); modlibline++; /* capture the line */ clearname(&vername); while ((!P_eoln(modlib.f)) & (P_peek(modlib.f) == ' ')) /* skip leading blanks */ getc(modlib.f); while (!P_eoln(modlib.f) && vername.length <= maxname && !endofcomment) { vername.length++; ch = getc(modlib.f); if (ch == '\n') ch = ' '; vername.letter[vername.length - 1] = ch; /* detect a begin-of-comment on the fly */ /* and kill it, so that internal comments will not be made */ if (vername.letter[vername.length - 1] == '*') { if (vername.length > 1) { if (vername.letter[vername.length - 2] == '(') vername.letter[vername.length - 1] = '@'; } } /* detect an end-of-comment on the fly */ if (vername.letter[vername.length - 1] != ')') continue; if (vername.length > 1) { if (vername.letter[vername.length - 2] == '*') { endofcomment = true; /* chop off ends of comments */ vername.letter[vername.length - 1] = ' '; vername.letter[vername.length - 2] = ' '; /* note: the untrail procedure will find the correct end of the string after this */ } } } fscanf(modlib.f, "%*[^\n]"); getc(modlib.f); modlibline++; untrail(&vername); showversion = true; } /* getversion */ Static Void strip(sin, sout) _TEXT *sin, *sout; { /* remove modules in sin during copy to sout */ boolean done = false; /* where to stop */ long sinline = 1; /* line of sin */ name error; /* end name of an extra module end */ fprintf(list.f, " no module library (modlib): stripping sin to sout.\n"); printf(" no module library (modlib): stripping sin to sout.\n"); while (!done) { switch (copytobound(sin, sout, &sinline)) { case 'b': skiptoend(sin, sout, &sinline); detectedmodules++; break; case 'e': fprintf(list.f, " extra module end named "); getname(sin, &error); printname(&list, error); fprintf(list.f, " detected at line %ld of sin.\n", sinline); halt(); break; /* there must be an error: the b case did not close properly */ case 'f': done = true; break; } } } Static boolean transfer PP((name amodule, _TEXT *sin, _TEXT *sout, _TEXT *modlib, long *sinline, long *modlibline, long depth)); /* Local variables for transfer: */ struct LOC_transfer { _TEXT *sin, *sout, *modlib; long *sinline, *modlibline, depth; } ; Local Void report(f, depth, what, amodule, LINK) _TEXT *f; long depth; Char what; name amodule; struct LOC_transfer *LINK; { /* where the report goes */ /* nesting depth */ /* what the report is about */ /* the module */ /* report to file f what happened to the module at some depth of nesting. values of what: t transferred n not found i infinite recursion v no transfer (this is the version module) */ putc(' ', f->f); switch (what) { case 't': putc(' ', f->f); break; case 'n': /* warning mark for the user */ putc('*', f->f); break; case 'i': /* infinite? */ putc('?', f->f); break; case 'v': /* version module */ putc('v', f->f); break; } fprintf(f->f, " %3ld ", depth); switch (what) { case 't': fprintf(f->f, "transferred "); break; case 'n': fprintf(f->f, "not found "); break; case 'i': fprintf(f->f, "infinite?? "); break; case 'v': fprintf(f->f, "no transfer "); break; } printname(f, amodule); putc('\n', f->f); } /* report */ Local Void recurse(LINK) struct LOC_transfer *LINK; { /* transfer the insides of a module */ name inner; /* name of inner module */ long line; /* line number on which to find inner */ long remember; /* the sinline that we must get back to after recursion */ getname(LINK->sin, &inner); printname(LINK->sout, inner); finishline(LINK->sin, LINK->sout, LINK->sinline); remember = *LINK->sinline; if (LINK->depth == 0) detectedmodules++; if (!inmodcat(inner, &line)) { /* is a recursion possible? */ /* go for a recursive transfer */ report(&list, LINK->depth, 'n', inner, LINK); copytoend(LINK->sin, LINK->sout, inner, LINK->sinline); /* ignore the module since it is not in the modlib */ return; } if (LINK->depth >= maxdepth) { /* it looks like this is an infinite recursive call, so lets kick out. */ report(&list, LINK->depth, 'i', inner, LINK); fprintf(LINK->sout->f, "(* the modules are nested to a depth of %ld at this point.\n", LINK->depth + 1); fprintf(LINK->sout->f, " perhaps the modlib has an infinite module nesting.\n"); fprintf(LINK->sout->f, " further recursive transfers are aborted. *)\n"); printf(" a possible infinitely recursive nesting of"); printf(" modules was detected. see list.\n"); copytoend(LINK->sin, LINK->sout, inner, LINK->sinline); return; } if (equalname(vermod, inner)) { /* ignore the module because it is a version module */ report(&list, LINK->depth, 'v', inner, LINK); copytoend(LINK->sin, LINK->sout, inner, LINK->sinline); return; } /* line is the beginning of the module. skip that by using line + 1 */ gettoline(line + 1, LINK->modlib, LINK->modlibline); if (!transfer(inner, LINK->modlib, LINK->sout, LINK->modlib, LINK->modlibline, LINK->modlibline, LINK->depth + 1)) { fprintf(list.f, " missing end of module "); printname(&list, inner); fprintf(list.f, " in modlib.\n"); halt(); return; } /* the inner module was inserted. now we must move back to the line following the calling line: */ gettoline(remember, LINK->sin, LINK->sinline); /* now skip the rest of the calling module */ findmoduleend(LINK->sin, inner, LINK->sinline); /* chalk one up (top depth only) */ if (LINK->depth == 0) transferredmodules++; } /* recurse */ Static boolean transfer(amodule, sin_, sout_, modlib_, sinline_, modlibline_, depth_) name amodule; _TEXT *sin_, *sout_, *modlib_; long *sinline_, *modlibline_, depth_; { /* copy the module (named module) from file sin to sout. it is assumed that the first line of sin (the module's call line) is already completely copied. if further module calls are seen, recursively transfer from modlib. return true if the module end was found, false if end of file was found. depth keeps track of how deeply we have recursed. */ struct LOC_transfer V; boolean Result; boolean done = false; /* true when done */ name endname; /* the end of a module */ V.sin = sin_; V.sout = sout_; V.modlib = modlib_; V.sinline = sinline_; V.modlibline = modlibline_; V.depth = depth_; while (!done) { switch (copytobound(V.sin, V.sout, V.sinline)) { case 'b': recurse(&V); break; case 'e': /* check if it is the real end */ getname(V.sin, &endname); printname(V.sout, endname); /* show version of modlib */ if (showversion) { printname(V.sout, vername); fprintf(V.sout->f, "*)\n"); fscanf(V.sin->f, "%*[^\n]"); getc(V.sin->f); /* toss away the previous stuff... */ (*V.sinline)++; } else finishline(V.sin, V.sout, V.sinline); if (equalname(endname, amodule)) { done = true; Result = true; } else { if (V.depth == 0) { fprintf(list.f, " sin module "); printname(&list, endname); fprintf(list.f, "ended at line %ld.\n", *V.sinline - 1); fprintf(list.f, " the begin is missing or incorrect.\n"); } else { fprintf(list.f, " module began with the name "); printname(&list, amodule); fprintf(list.f, ",\n"); fprintf(list.f, " but ended with "); printname(&list, endname); fprintf(list.f, " at line %ld in modlib.", *V.sinline - 1); } halt(); } break; case 'f': done = true; Result = false; break; } } report(&list, V.depth, 't', amodule, &V); return Result; } main(argc, argv) int argc; Char *argv[]; { /* module */ PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; modcat.f = NULL; strcpy(modcat.name, "modcat"); list.f = NULL; strcpy(list.name, "list"); sout.f = NULL; strcpy(sout.name, "sout"); modlib.f = NULL; strcpy(modlib.name, "modlib"); sin_.f = NULL; *sin_.name = '\0'; initialize(); if (BUFEOF(sin_.f)) { fprintf(list.f, " no source (sin) file.\n"); halt(); } else if (BUFEOF(modlib.f)) strip(&sin_, &sout); else { if (BUFEOF(modcat.f)) createmodcat(&modlib, &modcat); else checkup(&modlib, &modcat); /* set up version mechanism */ getversion(); if (showversion) { fprintf(list.f, " module "); printname(&list, vername); putc('\n', list.f); } else fprintf(list.f, " no version for modlib.\n"); fprintf(list.f, "\n nesting module\n"); fprintf(list.f, " depth action name\n"); /* do the transfer of sinname */ if (transfer(sinname, &sin_, &sout, &modlib, &sinline, &modlibline, 0L)) { fprintf(list.f, " zero depth module name "); printname(&list, sinname); fprintf(list.f, " detected as a module - program error\n"); halt(); } } printf(" %ld modules detected in sin, %ld modules transferred\n", detectedmodules, transferredmodules); fprintf(list.f, "\n %ld modules detected in sin, %ld modules transferred\n\n", detectedmodules, transferredmodules); _L1: if (sin_.f != NULL) fclose(sin_.f); if (modlib.f != NULL) fclose(modlib.f); if (sout.f != NULL) fclose(sout.f); if (list.f != NULL) fclose(list.f); if (modcat.f != NULL) fclose(modcat.f); exit(EXIT_SUCCESS); } /* module */ /* End. */