program amodule (sin, modlib, sout, modcat, list, output);
(* 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
*)

label 1; (* the end of the program *)

const
(* begin module version *)
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 *)
      lastcharacter = ' '; (* the last character after a module name *)
      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. *)
      maxdepth = 10;

      (* the program will check the correspondence between modlib and modcat.
         checkuptimes is the number of modules to check.
         see the checkup procedure. *)
      checkuptimes = 2;

      (* if the checkup fails, the constant recreate determines
         what will be done:  halt or recreate the catalogue and go on. *)
      recreate = true;

      debugging = false; (* for debugging purposes *)

type
      name = record (* a module name *)
         letter: packed array[1..maxname] of char;
         length: integer; (* the last character of the name *)
      end;

      trigger = record (* an object to be searched for *)
         n: name; (* the characters looked for *)
         state: integer; (* how close to triggering we are *)
         skip: boolean; (* trigger not found- skip the line *)
         found: boolean (* the trigger was found *)
      end;

      modcatitem = record (* an item in modcat *)
         amodule: name; (* the name of a module *)
         line: integer; (* the line module is on in modlib *)
      end;

      modcatfile = file of modcatitem;

var
      sin, (* the source in file *)
      modlib, (* the module library *)
      sout, (* the source out file *)
         list: (* progress of the transfer *)
         text;

      modcat: modcatfile; (* the catalogue for modlib *)

      sinline: integer; (* the current line in sin *)
      modlibline: integer; (* the current line in modlib *)

      (* the triggers for the modules *)
      begintrigger, endtrigger: trigger;

      sinname: name; (* the name of the top level *)
      vermod: name; (* a module named version *)

      (* variables for keeping track of module library version *)
      showversion: boolean; (* is there a version to show? *)
      vername: name; (* 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. *)
      donthalt, (* the halt procedure should be silent *)
      haltcalled: (* if halt is called and donthalt is true
                     then halt will set this to true *)
                  boolean;


      (* 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.)  *)
      detectedmodules, (* number of modules detected *)
      transferredmodules: (* number of modules transferred *)
         integer;

(* halt :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure halt;
(* stop the program *)
begin
      if donthalt
      then haltcalled := true
      else begin
         (* the following two lines pervent partially created files from
            being accidently used: *)
         rewrite(modcat);
(*         if not debugging then (@ allow access to sout *)
         rewrite(sout);
         writeln(output, ' error in module transfer.  see list');
         writeln(output, ' program halt.');
         writeln(list, ' program halt.');
         goto 1
      end
end;

(* 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 :::::::::::::::::::::::::::::::::::::::: *)

procedure copy (var fin, fout: text; var ch: char);
(* copy one character (ch) from file fin to file fout *)
begin
      if not eof(fin) then begin
         read(fin, ch);
         write(fout, ch);
(*         if debugging then writeln(list,'copy ',ch);*)
      end
end;

procedure finishline(var sin, sout: text; var sinline: integer);
(* finish copy of a line in sin to sout, increment sinline *)
var
      ch: char; (* one of the characters copied *)
begin
      while not eoln(sin) do copy(sin, sout, ch);
      readln(sin);
      writeln(sout);
      sinline := succ(sinline)
end;

procedure gettoline(line: integer; var f: text; var current: integer);
(* get to a line in f from the current place.
   current = line after gettoline is done *)
begin
      if current > line then begin (* the line is above where we are *)
         reset(f);
         current := 1
      end;

      while (current < line) and (not eof(f)) do begin
         current := succ(current);
         readln(f)
      end;

      if eof(f) then begin
         writeln(list, ' modcat refers to a line (', line:1,
                        ') that is past the end of modlib.');
         halt
      end
end;

(* name manipulations ::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure clearname(var n: name);
(* set the name to blank *)
var   l: integer; (* a position in the name *)
begin
      with n do begin
         for l := 1 to maxname do letter[l] := ' ';
         length := 0
      end
end;

procedure printname (var f: text; n: name);
(* print the name of n to file f *)
begin
      with n do write(f,letter:length)
end;

procedure untrail(var n: name);
(* remove all trailing blanks from name n and
   end n with the lastcharacter *)
begin
      with n do begin
         length := maxname;
         while (length > 0) and (letter[length] = ' ')
            do length := pred(length);

         (* put lastcharacter at end *)
         length := succ(length);

         if length > maxname then begin
            length:=maxname;
            write(list,' this name was found: "');
            printname(list, n);
            writeln(list,'".');
            writeln(list, ' names must be one character shorter than ',
                           maxname:1, ' characters.');
            halt
         end
         else n.letter[length] := lastcharacter;
      end
end;

procedure getname (var source: text; var n: name);
(* return the name n in source, upto and including the
global constant lastcharacter *)
var
      ch: char; (* one of the characters in n *)
begin
      clearname(n);
      ch := '.'; (* start with a character that is not lastcharacter *)
      with n do begin
         while (not eoln(source)) and
               (ch <> lastcharacter) and
               (length <= maxname) do begin
            length := succ(length);
            read(source, ch);
            letter[length] := ch
         end;
         if letter[length] <> lastcharacter then begin
            writeln(list, ' this module name: ');
            printname(list, n);
            if length = maxname
            then writeln(list, ' is too long (>', (maxname - 1):1,
                                 ' characters)')
                 (* if not that, it must be eoln: *)
            else writeln(list, ' did not end with a "', lastcharacter, '".');
            halt
         end
      end
end;

function equalname(a, b: name): boolean;
(* are the names a and b the same? *)
begin
      if a.length = b.length
      then equalname := (a.letter = b.letter)
      else equalname := false
end;

function greatername(a, b: name): boolean;
(* is a alphabetically after b? *)
begin
      greatername := (a.letter > b.letter)
end;

(* module mechanisms :::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure resettrigger(var t: trigger);
(* reset the trigger to ground state *)
begin
      with t do begin
         state := 0;
         skip := false;
         found := false
      end
end;

procedure testfortrigger(ch: char; var t: trigger);
(* 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. *)
begin
      with t do begin
         state := succ(state);
(*         if debugging then begin
            printname(list,n);
            writeln(list,'testfortrigger n.letter[',state:1,']:',
                           n.letter[state],' ch:',ch);
         end;*)
         if n.letter[state] = ch
         then begin
            skip := false;
            if state = n.length then found := true
                                else found := false
         end
         else begin (* reset trigger *)
            state := 0;
            skip := true;
            found := false
         end
      end
end;

procedure findmoduleend(var sin: text; amodule: name; var sinline: integer);
(* find (by reads) the end of the module in sin.  increment
sinline, the line in sin *)
var
      found: boolean; (* the module end was found *)
      ch: char; (* a character in sin *)
      endname: name; (* perhaps the end *)
begin
      found := false;
      while (not found) and (not eof(sin)) do begin
         resettrigger(endtrigger);
         while not( eoln(sin) or
                    endtrigger.skip or endtrigger.found) do begin
            read(sin, ch);
            testfortrigger(ch, endtrigger)
         end;

         if endtrigger.found then begin
            getname(sin, endname);
            if equalname(endname, amodule) then found := true;
         end;

         (* close sin line up *)
         readln(sin);
         sinline := succ(sinline)
      end;

      if eof(sin) and (not found) then begin
         write(list, ' no end to module ');
         printname(list, amodule);
         writeln(list, ' whose contents were being skipped.');
         halt
      end
end;

function copytobound(var sin, sout: text; var line: integer): char;
(* 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. *)
var
      found: boolean; (* a boundary was found *)
      ch: char; (* one of the characters in sin *)
begin
(*      if debugging then writeln(list,'copytobound');*)
      found := false;

      while (not found) and (not eof(sin)) do begin
         resettrigger(begintrigger);
         resettrigger(endtrigger);
         while not ( eoln(sin) or
                     ((begintrigger.skip or begintrigger.found) and
                      (  endtrigger.skip or   endtrigger.found)    ) ) do begin
            copy(sin, sout, ch);
            testfortrigger(ch, begintrigger);
            testfortrigger(ch, endtrigger)
         end;

         found := begintrigger.found or endtrigger.found;

         if not found
            then if begintrigger.skip or endtrigger.skip
               then while not eoln(sin)
                  do copy(sin, sout, ch);  (* copy rest of line out *)

         if eoln(sin) then begin
            readln(sin);
            writeln(sout);
            line := succ(line)
         end
      end;

      if found
      then begin
(*         if debugging then writeln(list,'copytobound:found');*)
         if begintrigger.found then copytobound := 'b';
         if endtrigger.found    then copytobound := 'e'
      end
      else copytobound := 'f' (* termination at file end *)
(*      ;if debugging then writeln(list,'copytobound') *)
end;

procedure copytoend(var sin, sout: text; amodule: name;
                    var sinline: integer);
(* copy to the end of the module from sin to sout without transfering
inner modules, and objecting to eof in sin.  increment sinline *)
var
      done: boolean; (* done copying *)
      endname: name; (* a name of a module end, perhaps that of module *)
begin
(*      if debugging then writeln(list,'copytoend'); *)
      done := false;
      while not done do begin
         case copytobound(sin, sout, sinline) of
            'b': ; (* ignore begins *)
            'e': begin (* maybe this is it *)
               getname(sin, endname);
               if equalname(endname, amodule) then done := true;
               printname(sout, endname);
               finishline(sin, sout, sinline)
            end;
            'f': begin
               write(list,' the end of module ');
               printname(list, amodule);
               writeln(list, ' was not found during copying');
               halt
            end
         end
      end
end;

procedure skiptoend(var sin, sout: text; var sinline: integer);
(* 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. *)
var
      amodule: name; (* the module being skipped *)
begin
(*      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) then
         (* woah there... we canot strip a version module... *)
         copytoend(sin, sout, amodule, sinline)
      else begin
         (* 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 <> ' ' then write(sout, ' ');
         writeln(sout, '*)') (* end of comment *)
(*         ;if debugging then writeln(list, 'skiptoend') *)
      end
end;

(* catalogue manipulations :::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure grab(var f: modcatfile; var item: modcatitem);
(* obtain an item from file f *)
begin
      item := f^;
      get(f)
end;

procedure drop(var t: modcatfile; var item: modcatitem);
(* place an item into file t *)
begin
      t^ := item;
      put(t)
end;

procedure show(var o: text; var c: modcatfile);
(* show the modcat c on file o *)
var
      item: modcatitem; (* an item in c *)
begin
      reset(c);
      writeln(o);
      writeln(o,'   line module name');
      while not eof(c) do begin
         grab(c,item);
         write(o,' ',item.line:6,' ');
         printname(o,item.amodule);
         writeln(o)
      end;
      writeln(o)
end;

procedure build(var modlib: text;
                var modcat: modcatfile);
(* build the modcat from the modlib *)
var
      li: integer; (* current line in modlib *)
      ch: char; (* a character in modlib *)
      na: name; (* a module name *)
      item: modcatitem; (* one of the records in modcat *)
      number: integer; (* how many modules there are in modlib *)
begin
      reset(modlib);
      rewrite(modcat);
      li := 1;
      number := 0;

      while not eof(modlib) do begin
         resettrigger(begintrigger);
         resettrigger(endtrigger);
         while not ( eoln(modlib) or
                     ((begintrigger.skip or begintrigger.found) and
                      (  endtrigger.skip or   endtrigger.found)    ) ) do begin
            read(modlib, ch);
            testfortrigger(ch, begintrigger);
            testfortrigger(ch, endtrigger)
         end;

         if begintrigger.found then with item do begin
            getname(modlib, amodule);
            line := li;
            drop(modcat, item);
            number := succ(number); (* count the modules *)
            findmoduleend(modlib, amodule, li)
         end
         else if endtrigger.found then begin
            write(list, ' unexpected module end: ');
            getname(modlib, na);
            printname(list, na);
            writeln(list, ' at line ', li:1, ' in modlib.');
            halt
         end
         else begin
            readln(modlib);
            li := succ(li)
         end
      end;

      if number = 0
      then begin
         writeln(list, ' no modules in modlib.');
         halt
      end
      else begin
         write(list, ' ', number:1, ' module');
         if number <> 1 then write(list, 's');
         writeln(list, ' in modlib.');
         reset(modlib) (* clean up *)
      end
end; (* build *)

procedure sort(var f: modcatfile);
(* 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. *)
var
      i: modcatfile; (* an internal file *)
      changes: boolean; (* whether changes were made in a pass *)
procedure bubblepass(var f, t: modcatfile; var changes: boolean);
(* 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. *)
var
      a, b: modcatitem; (* two of the items in f *)
begin (* bubblepass *)
(*      if debugging then show(list,f); *)
      changes := false;
      reset(f);
      rewrite(t);
      grab(f, a);
(*      if debugging then write(list,'grab a,'); *)
      while not eof(f) do begin
(*         if debugging then write(list,'grab b,');*)
         grab(f, b);

         (* always drop the smaller item *)
         if greatername(b.amodule, a.amodule) or
              equalname(b.amodule, a.amodule)
         then begin
(*            if debugging then write(list,'drop a, a:=b,');*)
            drop(t, a);
            a := b (* replenish a *)
         end
         else begin
            changes := true;
(*            if debugging then write(list,'drop b,');*)
            drop(t, b) (* retain a *)
         end
      end;
(*      if debugging then writeln(list,'drop a.'); *)
      drop(t, a) (* the last one *)
end; (* bubble pass *)
begin (* sort *)
      changes := true;
(*      if debugging then writeln(list,'sort'); *)
      while changes do begin
(*         if debugging then writeln(list,'pass 1'); *)
         bubblepass(f, i, changes);
(*         if debugging then writeln(list,'pass 2(?)'); *)
         if changes then bubblepass(i, f, changes)
      end
(*; if debugging then writeln(list,'end sort') *)
end; (* sort *)

procedure checkduplicate(var f: modcatfile);
(* check file f for duplicate names, taking advantage of the fact
that it is sorted *)
var
      a, b: modcatitem; (* two items in f *)
      ok: boolean; (* no duplicates *)
begin
      reset(f);
      ok := true;
      grab(f, a);
      while not eof(f) do begin
         grab(f, b);
         if equalname(a.amodule, b.amodule) then begin
            ok := false;
            write(list, ' duplicate module name: ');
            printname(list, a.amodule);
            writeln(list);
            writeln(list, '           found at lines ',
               a.line:1, ' and ',
               b.line:1, ' of modlib.');
         end;
         a := b
      end;
      if not ok then begin
         rewrite(modcat); (* destroy the bad copy *)
         halt
      end
end;

procedure createmodcat(var modlib: text;
                       var modcat: modcatfile);
(* build sort and check the module catalogue *)
begin
      writeln(list,' creating module catalogue (modcat)');
      build(modlib, modcat);
      sort(modcat);
      checkduplicate(modcat);
      show(list,modcat);
      reset(modcat)
end;

function inmodcat(    amodule: name;
                  var line: integer): boolean;
(* is the module in the modcat?  (modcat is passed as a global for speed)
return the line number in modlib (side effect) *)
var
      n: modcatitem; (* an item in modcat *)
      found: boolean; (* true when module is found *)
begin
      (* quick check to see if we can avoid a reset *)
      if eof(modcat)
      then begin (* oh well... *)
         reset(modcat);
         found := false
      end
      else begin (* we stand a chance *)
         grab(modcat, n);
         if greatername(n.amodule, amodule)
         then begin (* it is above this point - we lose *)
            reset(modcat);
            found := false
         end
            (* it is below this point - or we are on it *)
         else if equalname(n.amodule, amodule)
            then found := true (* zooks...got it...zooks...*)
            else found := false (* it is below this point - we win *)
      end;
(*      if found and debugging then writeln(list, 'zooks...(inmodcat)');*)

      while (not found) and (not eof(modcat)) do begin
         grab(modcat, n);
         if equalname(n.amodule, amodule) then found := true
      end;

      if found then begin
         inmodcat := true;
         line := n.line
      end
      else begin
         inmodcat := false;
         line := -1 (* an impossible line number *)
      end
end; (* inmodcat *)

procedure checkup(var modlib: text;
                  var modcat: modcatfile);
(* check that modlib corresponds to modcat.
   the number of modules to check is set by the global constant
   checkuptimes. *)
var
      times: integer; (*  number of checks completed *)
      fail: boolean; (* what may well happen during this checkup *)
      cat: modcatitem; (* one item in modcat *)
      ch: char; (* a character from modlib *)
      libname: name; (* a name from modlib *)
      modlibline: integer; (* the current line in modlib *)
      modcatline: integer; (* a line refered to by modcat *)
begin
      writeln(list, ' check modlib-modcat correspondence:');
      reset(modlib);
      reset(modcat);
      modlibline := 1;
      times := 0;
      fail := false;

      (* first check: do items in the catalogue point
         to modules in modlib *)
      donthalt := true; (* prevent halting during this check *)
      repeat (* 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
         then begin
            (* reference by modcat to a line past the end of modlib *)
            fail := true;
            haltcalled := false;
         end
         else begin
            (* first we must determine that a module <begin> is there *)
            resettrigger(begintrigger);

            while not (eoln(modlib) or
                       begintrigger.found or begintrigger.skip) do begin
               read(modlib, ch);
               testfortrigger(ch, begintrigger)
            end;

            if begintrigger.skip or eoln(modlib)
            then fail := true
            else (* begintrigger.found *) begin (* check the name *)
               getname(modlib,libname);
               if not equalname(libname, cat.amodule) then fail := true
            end;

            times := succ(times);
         end;
      until (times >= checkuptimes) or (eof(modcat)) or fail;
      donthalt := false; (* allow halting again *)

      (* second check: do items in modlib have
         corresponding items in modcat? *)
      if not fail then begin
(*         if debugging then writeln(list,' second check'); *)
         reset(modlib);
         reset(modcat);
         modlibline := 1;
         times := 0;

         repeat
            resettrigger(begintrigger);
            while not (eoln(modlib) or
                 begintrigger.skip or begintrigger.found) do begin
               read(modlib, ch);
               testfortrigger(ch, begintrigger)
            end;

            if begintrigger.found then begin
               times := succ(times);
               getname(modlib, libname);
               if not(inmodcat(libname, modcatline))
               then fail := true
                  (* maybe the lines do not match... *)
               else if modcatline <> modlibline then fail := true;
               if not fail then findmoduleend(modlib, libname, modlibline)
            end
            else begin
               readln(modlib);
               modlibline := succ(modlibline)
            end
         until (times > checkuptimes) or eof(modlib) or fail
      end;

      if fail
      then begin
         write(list,' failed: ');
         if recreate then createmodcat(modlib, modcat)
                     else halt
      end
      else begin
         writeln(list,' passed.');
         modlibline:=1;
         reset(modlib);
         reset(modcat)
      end
end;

(* main calls ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure initialize;
(* start up the program *)
begin (* initialize *)
      writeln(output, ' ',version);
      reset(sin);
      reset(modlib);
      rewrite(sout);
      reset(modcat);
      rewrite(list);

      writeln(list, ' ',version);

      sinline := 1;
      modlibline := 1;

      (* set up triggers.  they must be the same size as maxname. *)
      with begintrigger do begin
         (*                    1         2         3         4         5 *)
         (*           12345678901234567890123456789012345678901234567890 *)
         n.letter := '(* begin module                                   ';
         untrail(n)
      end;

      with endtrigger do begin
         (*                    1         2         3         4         5 *)
         (*           12345678901234567890123456789012345678901234567890 *)
         n.letter := '(* end module                                     ';
         untrail(n)
      end;

      (* 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 *)
      sinname.letter := '(source input)                                    ';
      untrail(sinname);

      (* make name of the version module *)
      (*                          1         2         3         4         5 *)
      (*                 12345678901234567890123456789012345678901234567890 *)
      vermod.letter := 'version                                           ';
      untrail(vermod);

      (* set up halt variables *)
      donthalt := false;
      haltcalled := false;

      (* set up module counting variables *)
      detectedmodules := 0;
      transferredmodules := 0;
end; (* initialize *)

procedure getversion;
(* find the module named version in modlib, and return its
first line in vername.  if there is no module, set showversion to false *)
var
      line: integer; (* the line in modlib of the version *)
      ch: char; (* a character to go into vername *)
      endofcomment: boolean; (* 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 *)
begin (* getversion *)
      if inmodcat(vermod, line) then begin
         gettoline(line, modlib, modlibline);

         (* move to first line of module version *)
         readln(modlib);
         modlibline := succ(modlibline);

         (* capture the line *)
         clearname(vername);
         endofcomment := false;
         with vername do begin
            while (not eoln(modlib)) and (modlib^=' ')
            do get(modlib); (* skip leading blanks *)
            while (not eoln(modlib)) and
                  (length <= maxname) and
                  (not endofcomment) do begin
               length := succ(length);
               read(modlib, ch);
               letter[length] := ch;

               (* detect a begin-of-comment on the fly *)
               (* and kill it, so that internal comments will not be made *)
               if letter[length] = '*'
               then if length > 1
                  then if letter[length-1] = '('
                     then letter[length] := '@';

               (* detect an end-of-comment on the fly *)
               if letter[length] = ')'
               then if length > 1
                  then if letter[length-1] = '*'
                     then begin
                        endofcomment := true;

                        (* chop off ends of comments *)
                        letter[length] := ' ';
                        letter[length-1] := ' ';
                        (* note: the untrail procedure will find
                           the correct end of the string after this *)
                     end
            end
         end;
         readln(modlib);
         modlibline := succ(modlibline);

         untrail(vername);
         showversion := true
      end
      else showversion := false
end; (* getversion *)

procedure strip(var sin, sout: text);
(* remove modules in sin during copy to sout *)
var
      done: boolean; (* where to stop *)
      sinline: integer; (* line of sin *)
      error: name; (* end name of an extra module end *)
begin
      writeln(list, ' no module library (modlib): stripping sin to sout.');
      writeln(output, ' no module library (modlib): stripping sin to sout.');
      done := false;
      sinline := 1;

      while not done do begin
         case copytobound(sin, sout, sinline) of
            'b': begin
               skiptoend(sin, sout, sinline);
               detectedmodules := succ(detectedmodules)
            end;
            'e': begin
               (* there must be an error: the b case did not close properly *)
               write(list, ' extra module end named ');
               getname(sin, error);
               printname(list, error);
               writeln(list, ' detected at line ', sinline:1, ' of sin.');
               halt
            end;
            'f': done := true
         end
      end
end;

function transfer(    amodule: name;
                  var sin, sout, modlib: text;
                  var sinline: integer;
                  var modlibline: integer;
                      depth: integer): boolean;
(* 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. *)
var
      done: boolean; (* true when done *)
      endname: name; (* the end of a module *)
procedure report(var f: text; (* where the report goes *)
                     depth: integer; (* nesting depth *)
                     what: char; (* what the report is about *)
                     amodule: name); (* 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)
*)
begin (* report *)
      write(f, ' ');
      case what of
         't': write(f,' ');
         'n': write(f,'*'); (* warning mark for the user *)
         'i': write(f,'?'); (* infinite? *)
         'v': write(f,'v'); (* version module *)
      end;
      write(f, ' ', depth:3, '    ');
      case what of
         't': write(f,'transferred ');
         'n': write(f,'not found   ');
         'i': write(f,'infinite??  ');
         'v': write(f,'no transfer ');
      end;
      printname(f, amodule);
      writeln(f)
end; (* report *)
procedure recurse;
(* transfer the insides of a module *)
var
      inner: name; (* name of inner module *)
      line: integer; (* line number on which to find inner *)
      remember: integer; (* the sinline that we must get back to
                            after recursion *)
begin (* recurse *)
      getname(sin, inner);
      printname(sout, inner);
      finishline(sin, sout, sinline);
      remember := sinline;
      if depth = 0 then detectedmodules := succ(detectedmodules);

      if inmodcat(inner, line) then begin (* is a recursion possible? *)
         if depth >= maxdepth then begin
            (* it looks like this is an infinite recursive call,
               so lets kick out. *)
            report(list, depth, 'i', inner);
            writeln(sout,'(* the modules are nested to a depth of ',
                             (depth + 1):1,' at this point.');
            writeln(sout,'   perhaps the modlib has an infinite module ',
                             'nesting.');
            writeln(sout,'   further recursive transfers are aborted. *)');
            write  (output,' a possible infinitely recursive nesting of');
            writeln(output,' modules was detected.  see list.');
            copytoend(sin, sout, inner, sinline)
         end
         else if equalname(vermod, inner) then begin
            (* ignore the module because it is a version module *)
            report(list, depth, 'v', inner);
            copytoend(sin, sout, inner, sinline)
         end
         else begin (* go for a recursive transfer *)
            (* line is the beginning of the module.
               skip that by using line + 1 *)
            gettoline(line + 1, modlib, modlibline);
            if not transfer(inner, modlib, sout, modlib,
                            modlibline, modlibline, succ(depth))
            then begin
               write(list, ' missing end of module ');
               printname(list, inner);
               writeln(list, ' in modlib.');
               halt
            end
            else begin
               (* the inner module was inserted.  now we must move
                  back to the line following the calling line: *)
               gettoline(remember, sin, sinline);

               (* now skip the rest of the calling module *)
               findmoduleend(sin, inner, sinline);

               (*  chalk one up (top depth only) *)
               if depth = 0 then transferredmodules := succ(transferredmodules)
            end
         end
      end
      else begin (* ignore the module since it is not in the modlib *)
         report(list, depth, 'n', inner);
         copytoend(sin, sout, inner, sinline)
      end
end; (* recurse *)

begin (* transfer *)
      done := false;
      while not done do begin
         case copytobound(sin, sout, sinline) of
            'b': recurse;
            'e': begin (* check if it is the real end *)
               getname(sin, endname);
               printname(sout, endname);

               (* show version of modlib *)
               if showversion then begin
                  printname(sout, vername);
                  writeln(sout, '*)');
                  readln(sin); (* toss away the previous stuff... *)
                  sinline := succ(sinline)
               end
               else finishline(sin, sout, sinline);

               if equalname(endname, amodule) then begin
                  done := true;
                  transfer := true
               end
               else begin
                  if depth = 0 then begin
                     write(list, ' sin module ');
                     printname(list, endname);
                     writeln(list, 'ended at line ',(sinline-1):1, '.');
                     writeln(list, ' the begin is missing or incorrect.')
                  end
                  else begin
                     write(list, ' module began with the name ');
                     printname(list, amodule);
                     writeln(list, ',');
                     write(list, ' but ended with ');
                     printname(list, endname);
                     write(list, ' at line ', (sinline-1):1, ' in modlib.');
                  end;
                  halt
               end
            end;
            'f': begin
               done := true;
               transfer := false
            end
         end
      end;
      report(list, depth, 't', amodule)
end;

begin (* module *)
      initialize;

      if eof(sin)
      then begin
         writeln(list, ' no source (sin) file.');
         halt
      end
      else if eof(modlib) then strip(sin, sout)
      else begin
         if eof(modcat) then createmodcat(modlib, modcat)
                        else checkup(modlib, modcat);

         (* set up version mechanism *)
         getversion;
         if showversion
         then begin
            write(list,' module ');
            printname(list,vername);
            writeln(list)
         end
         else writeln(list,' no version for modlib.');

         writeln(list);
         writeln(list,' nesting              module');
         writeln(list,'  depth   action      name');

         (* do the transfer of sinname *)
         if transfer(sinname, sin, sout, modlib,
                     sinline, modlibline, 0) then begin
            write(list, ' zero depth module name ');
            printname(list, sinname);
            writeln(list, ' detected as a module - program error');
            halt
         end
      end;
      writeln(output,' ', detectedmodules:1,' modules detected in sin, ',
                          transferredmodules:1, ' modules transferred');
      writeln(list);
      writeln(list  ,' ', detectedmodules:1,' modules detected in sin, ',
                          transferredmodules:1, ' modules transferred');
      writeln(list);
1: end. (* module *)