Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TEX/WEBTP55.ARC/TANGLE.CHG

Text File | 1989-12-05 | 61.7 KB | 1,879 lines

% This is TANGLE.CHG for TURBO Pascal 5.5
%
% (c) 1989 by Peter Sawatzki <[e-mail]>
%             Buchenhof 3, D-5800 Hagen 1 (Dahl), Germany (West)
%
%  Change History:
%
%  Initials:   PS = Peter Sawatzki, FE617@DHAFEU11
%  =========   WGS = Wayne G. Sullivan, WSULIVAN@IRLEARN
%              PB = Peter Breitenlohner, PEB@DM0MPI11
%
%  rel.  date      Author  description
%  ====  ====      ======  ===========
%  v0.1  2-Mar-88  PS      initial TP3 release
%  v0.2  5-May-88  PS      array-like macros: "()" solution
%  v0.3 22-Aug-88  PS      copy some Inlines from WGS
%  v0.4  3-Sep-88  PS      better handling of shl and shr
%  v0.5  8-Dec-88  PS      better array-like macros based on PB's solution
%  v0.6 10-Dec-88  PS      TurboPascal-like hex constants
%  v0.7  3-Jun-89  PS      include the mod/and, div/shr optimization
%  v0.8 29-Jul-89  PS      @i option: (nested) include files
%  v0.9  1-Aug-89  PS      multiple change files
%  v1.0  3-Aug-89  PS      Inline assembler implemented
%  v1.1  5-Dec-89  PS      kill error in multiple change file handling
%
%  Tangle/Compile Instructions:
%  ============================
%  TANGLE TANGLE /d /m /c
%  TPC /$A+,O-,E-,N-,B-,I-,V-,S-,D- /$M$5000,0,$2000 TANGLE /M
%
%
% kludge fillchar firstvar -> lastvar inserted
%
────────────────────────────────────────────────────────────────
@x l.22 m.0
\def\PASCAL{Pascal}
@y
\def\PASCAL{Pascal}
\def\TP{\hbox{Turbo Pascal 5.5}}
@z
────────────────────────────────────────────────────────────────
@x l.36 m.0
  \vfill}
@y
  \centerline{(Changes for \TP, 5-Dec-89)}
  \vfill}
@z
────────────────────────────────────────────────────────────────
@x l.64 m.1
@d banner=='This is TANGLE, Version 4'
@y
@d banner=='This is TANGLE, Version 4/TP55 1.1'
@z
────────────────────────────────────────────────────────────────
@x l.75 m.2
@d end_of_TANGLE = 9999 {go here to wrap it up}
@y
@z
────────────────────────────────────────────────────────────────
@x l.77 m.2
@p @t\4@>@<Compiler directives@>@/
program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
label end_of_TANGLE; {go here to finish}
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
@y
@p program TANGLE;
uses
  Asm2Inl;
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
const @<Typed constants in the outer block@>@/
var @/
  firstvar: byte; @/
  @<Globals in the outer block@>@/
  lastvar: byte; @/
@<Inline procedures and functions@>@/
@<All purpose procedures and functions@>@/
@z
────────────────────────────────────────────────────────────────
@x l.94 m.3
@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
@y
@d ifdef(#)==@={$ifdef @>#@=}@>
@d endif==@={$endif}@>
@d debug==ifdef(deb)
@d gubed==endif
@d Asm(#)==inline(@[#@])
@z
────────────────────────────────────────────────────────────────
@x l.99 m.3
@d stat==@{ {change this to `$\\{stat}\equiv\null$'
  when gathering usage statistics}
@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
  when gathering usage statistics}
@y
@d stat==ifdef(sta)
@d tats==endif
@z
────────────────────────────────────────────────────────────────
@x l.114 m.4
@<Compiler directives@>=
@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
@y
@<Inline proc...@>=
function mavail: word;
Asm(mov ah,$48/   {allocate memory}
    mov bx,$FFFF/ {determine free memory}
    int $21/
    mov ax,bx);   {return size of largest available block}

function malloc (no: word): word;
Asm(mov ah,$48/   {allocate memory}
    pop bx/       {no of bytes}
    int $21/
    jnc ok/       {no error}
    xor ax,ax/    {clear ax in case of error}
 ok: );

procedure mfree (segm: word);
Asm(mov ah,$49/ {free memory}
    pop es/     {segment to free}
    int $21);
@z
────────────────────────────────────────────────────────────────
@x l.139 m.6
@d incr(#) == #:=#+1 {increase a variable by unity}
@d decr(#) == #:=#-1 {decrease a variable by unity}
@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
@d do_nothing == {empty statement}
@d return == goto exit {terminate a procedure call}
@f return == nil
@f loop == xclause
@y
@d incr(#) == Inc(#) {increase a variable by unity}
@d decr(#) == Dec(#) {decrease a variable by unity}
@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
@d do_nothing == {empty statement}
@d return == @= exit @>
@f return == nil
@f loop == xclause
@d void == begin end
@z
────────────────────────────────────────────────────────────────
@x l.168 m.7
@d othercases == others: {default for cases not listed explicitly}
@y
@d othercases == else {default for cases not listed explicitly}
@z
────────────────────────────────────────────────────────────────
@x l.177 m.8
@!buf_size=100; {maximum length of input line}
@!max_bytes=45000; {|1/ww| times the number of bytes in identifiers,
  strings, and module names; must be less than 65536}
@!max_toks=50000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
  must be less than 65536}
@!max_names=4000; {number of identifiers, strings, module names;
  must be less than 10240}
@y
@!buf_size=256; {maximum length of input line (must be |>255| for inline code)}
@!max_max_bytes=8000;
@!min_bytes=1000;
@!step_bytes=1000;
@!max_bytes: word = max_max_bytes;
 {|1/ww| times the number of bytes in identifiers,
  strings, and module names; must be less than 65536}
@!max_max_toks = 15000;
@!min_toks = 2000;
@!step_toks = 2000;
@!max_toks: word = max_max_toks;
 {|1/zz| times the number of bytes in compressed \PASCAL\ code;
  must be less than 65536}
@!max_names=4600; {number of identifiers, strings, module names;
  must be less than 10240}
@z
────────────────────────────────────────────────────────────────
@x l.190 m.8
@!max_id_length=12; {long identifiers are chopped to this length, which must
  not exceed |line_length|}
@!unambig_length=7; {identifiers must be unique if chopped to this length}
  {note that 7 is more strict than \PASCAL's 8, but this can be varied}
@y
@!max_id_length=30; {long identifiers are chopped to this length, which must
  not exceed |line_length|}
@!unambig_length=25; {identifiers must be unique if chopped to this length}
@z
────────────────────────────────────────────────────────────────
@x l.301 m.12
@!text_file=packed file of text_char;
@y
@!text_file=Text;
@ @d term_out==Output
@z
────────────────────────────────────────────────────────────────
@x l.303 m.13
@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
the user's external character set by means of arrays |xord| and |xchr|
that are analogous to \PASCAL's |ord| and |chr| functions.

@<Globals...@>=
@!xord: array [text_char] of ASCII_code;
  {specifies conversion of input characters}
@!xchr: array [ASCII_code] of text_char;
  {specifies conversion of output characters}

@ If we assume that every system using \.{WEB} is able to read and write the
visible characters of standard ASCII (although not necessarily using the
ASCII codes to represent them), the following assignment statements initialize
most of the |xchr| array properly, without needing any system-dependent
changes. For example, the statement \.{xchr[@@\'101]:=\'A\'} that appears
in the present \.{WEB} file might be encoded in, say, {\mc EBCDIC} code
on the external medium on which it resides, but \.{TANGLE} will convert from
this external code to ASCII and back again. Therefore the assignment
statement \.{XCHR[65]:=\'A\'} will appear in the corresponding \PASCAL\ file,
and \PASCAL\ will compile this statement so that |xchr[65]| receives the
character \.A in the external (|char|) code. Note that it would be quite
incorrect to say \.{xchr[@@\'101]:="A"}, because |"A"| is a constant of
type |integer|, not |char|, and because we have $|"A"|=65$ regardless of
the external character set.

@<Set init...@>=
xchr[@'40]:=' ';
xchr[@'41]:='!';
xchr[@'42]:='"';
xchr[@'43]:='#';
xchr[@'44]:='$';
xchr[@'45]:='%';
xchr[@'46]:='&';
xchr[@'47]:='''';@/
xchr[@'50]:='(';
xchr[@'51]:=')';
xchr[@'52]:='*';
xchr[@'53]:='+';
xchr[@'54]:=',';
xchr[@'55]:='-';
xchr[@'56]:='.';
xchr[@'57]:='/';@/
xchr[@'60]:='0';
xchr[@'61]:='1';
xchr[@'62]:='2';
xchr[@'63]:='3';
xchr[@'64]:='4';
xchr[@'65]:='5';
xchr[@'66]:='6';
xchr[@'67]:='7';@/
xchr[@'70]:='8';
xchr[@'71]:='9';
xchr[@'72]:=':';
xchr[@'73]:=';';
xchr[@'74]:='<';
xchr[@'75]:='=';
xchr[@'76]:='>';
xchr[@'77]:='?';@/
xchr[@'100]:='@@';
xchr[@'101]:='A';
xchr[@'102]:='B';
xchr[@'103]:='C';
xchr[@'104]:='D';
xchr[@'105]:='E';
xchr[@'106]:='F';
xchr[@'107]:='G';@/
xchr[@'110]:='H';
xchr[@'111]:='I';
xchr[@'112]:='J';
xchr[@'113]:='K';
xchr[@'114]:='L';
xchr[@'115]:='M';
xchr[@'116]:='N';
xchr[@'117]:='O';@/
xchr[@'120]:='P';
xchr[@'121]:='Q';
xchr[@'122]:='R';
xchr[@'123]:='S';
xchr[@'124]:='T';
xchr[@'125]:='U';
xchr[@'126]:='V';
xchr[@'127]:='W';@/
xchr[@'130]:='X';
xchr[@'131]:='Y';
xchr[@'132]:='Z';
xchr[@'133]:='[';
xchr[@'134]:='\';
xchr[@'135]:=']';
xchr[@'136]:='^';
xchr[@'137]:='_';@/
xchr[@'140]:='`';
xchr[@'141]:='a';
xchr[@'142]:='b';
xchr[@'143]:='c';
xchr[@'144]:='d';
xchr[@'145]:='e';
xchr[@'146]:='f';
xchr[@'147]:='g';@/
xchr[@'150]:='h';
xchr[@'151]:='i';
xchr[@'152]:='j';
xchr[@'153]:='k';
xchr[@'154]:='l';
xchr[@'155]:='m';
xchr[@'156]:='n';
xchr[@'157]:='o';@/
xchr[@'160]:='p';
xchr[@'161]:='q';
xchr[@'162]:='r';
xchr[@'163]:='s';
xchr[@'164]:='t';
xchr[@'165]:='u';
xchr[@'166]:='v';
xchr[@'167]:='w';@/
xchr[@'170]:='x';
xchr[@'171]:='y';
xchr[@'172]:='z';
xchr[@'173]:='{';
xchr[@'174]:='|';
xchr[@'175]:='}';
xchr[@'176]:='~';@/
xchr[0]:=' '; xchr[@'177]:=' '; {these ASCII codes are not used}
@y
@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
the user's external character set by means of arrays |xord| and |xchr|
that are analogous to \PASCAL's |ord| and |chr| functions.
The following typed constants define the |xchr| array properly.

@<Typed constants...@>=
xchr: array [ASCII_code] of text_char=(@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ', #9,' ',' ',' ',#13,' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ','!','"','#','$','%','&','''', '(',')','*','+',',','-','.','/',@/
'0','1','2','3','4','5','6','7',  '8','9',':',';','<','=','>','?',@/
'@@','A','B','C','D','E','F','G', 'H','I','J','K','L','M','N','O',@/
'P','Q','R','S','T','U','V','W',  'X','Y','Z','[','\',']','^','_',@/
'`','a','b','c','d','e','f','g',  'h','i','j','k','l','m','n','o',@/
'p','q','r','s','t','u','v','w',  'x','y','z','{','|','}','~',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ',@/
' ',' ',' ',' ',' ',' ',' ',' ',  ' ',' ',' ',' ',' ',' ',' ',' ');

@ The following definition makes the |xord| array contain a
suitable inverse to the information in |xchr|.

@<Globals...@>=
@!xord: array [text_char] of ASCII_code absolute xchr;
  {specifies conversion of input characters}
@z
────────────────────────────────────────────────────────────────
@x l.443 m.16
@ When we initialize the |xord| array and the remaining parts of |xchr|,
it will be convenient to make use of an index variable, |i|.

@<Local variables for init...@>=
@!i:0..255;

@ Here now is the system-dependent part of the character set.
If \.{WEB} is being implemented on a garden-variety \PASCAL\ for which
only standard ASCII codes will appear in the input and output files, you
don't need to make any changes here. But if you have, for example, an extended
character set like the one in Appendix~C of {\sl The \TeX book}, the first
line of code in this module should be changed to
$$\hbox{|for i:=1 to @'37 do xchr[i]:=chr(i);|}$$
\.{WEB}'s character set is essentially identical to \TeX's, even with respect to
characters less than @'40.
@^system dependencies@>

Changes to the present module will make \.{WEB} more friendly on computers
that have an extended character set, so that one can type things like
\.^^Z\ instead of \.{<>}. If you have an extended set of characters that
are easily incorporated into text files, you can assign codes arbitrarily
here, giving an |xchr| equivalent to whatever characters the users of
\.{WEB} are allowed to have in their input files, provided that unsuitable
characters do not correspond to special codes like |carriage_return|
that are listed above.

(The present file \.{TANGLE.WEB} does not contain any of the non-ASCII
characters, because it is intended to be used with all implementations of
\.{WEB}.  It was originally created on a Stanford system that has a
convenient extended character set, then ``sanitized'' by applying another
program that transliterated all of the non-standard characters into
standard equivalents.)

@<Set init...@>=
for i:=1 to @'37 do xchr[i]:=' ';
for i:=@'200 to @'377 do xchr[i]:=' ';

@ The following system-independent code makes the |xord| array contain a
suitable inverse to the information in |xchr|.

@<Set init...@>=
for i:=first_text_char to last_text_char do xord[chr(i)]:=" ";
for i:=1 to @'377 do xord[xchr[i]]:=i;
xord[' ']:=" ";
@y
@ not neccesssary

@ not neccessary

@ not neccessary
@z
────────────────────────────────────────────────────────────────
@x l.511 m.20
@!term_out:text_file; {the terminal as an output file}
@y
@z
────────────────────────────────────────────────────────────────
@x l.519 m.21
rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
@y
@z
────────────────────────────────────────────────────────────────
@x l.526 m.22
@d update_terminal == break(term_out) {empty the terminal output buffer}
@y
@d update_terminal ==
@z
────────────────────────────────────────────────────────────────
@x l.528 m.23
@ The main input comes from |web_file|; this input may be overridden
by changes in |change_file|. (If |change_file| is empty, there are no changes.)

@<Globals...@>=
@!web_file:text_file; {primary input}
@!change_file:text_file; {updates}
@y
@ We need some data structures to implement the include facility of
  \.{TANGLE}
@<Constants...@>=
ChangeMax = 5; {maximal # of Changefiles}
No_of_Files = 6; {Webfile + Changefiles + all Include files}
buffer_size = 4*1024; {multiple of 16}

@ @<Globals...@>=
FileMax: 0..No_of_Files; {how many files fit into memory}
@!file_prev: array[1..No_of_Files] of word;
@!file_ptr: array[1..No_of_Files] of word;

@ To access a textfile we use
@d textf(#)==Text(Ptr(file_ptr[#],0)^)

@ The main input comes from |web_file|; this input may be overridden
by changes in the |ChgFile|s. |ChgCnt| is the number of change files.
(If |ChgCnt| is zero, there are no changes.)

@<Globals...@>=
@!web_file:word; {primary input}
@!ChgFile: array[1..ChangeMax] of word; {array of change files}
@!ChgCnt: 0..ChangeMax; { # of change files in |ChgFile|}
@!ChgAct: array[1..ChangeMax] of 1..ChangeMax; {active change files}
@!ChgLevel: 0..ChangeMax; {# of active change files in |ChgAct|}

@z
────────────────────────────────────────────────────────────────
@x l.535 m.24
@ The following code opens the input files.  Since these files were listed
in the program header, we assume that the \PASCAL\ runtime system has
already checked that suitable file names have been given; therefore no
additional error checking needs to be done.
@^system dependencies@>

@p procedure open_input; {prepare to read |web_file| and |change_file|}
begin reset(web_file); reset(change_file);
end;
@y
@ The following code closes an input file. If the input file is the son
of another input file, the higher level file is returned.
@^system dependencies@>

@p procedure close_fil (var f: word);
     var tf: word;
     begin
       if f<>0 then begin
         Close(textf(f));
         if IoResult<>0 then void;
         tf:= f;
         f:= file_prev[f];
         file_prev[tf]:= 0; { buffer now available }
         if f=$FFFF then f:= 0;
       end
     end;

@ Next we need a function to open an input file. Checks will be
  made to verify that there are not too many include files open.

@p function open_fil (var f: word; name: String): boolean;
     var
       tf: word;
     begin
       open_fil:= false;
       tf:= 1;
       while (tf<=FileMax) and (file_prev[tf]<>0) do
         incr(tf);
       if tf>FileMax then
         fatal_halt('@@i ',name,': no more than ',FileMax,' open files.');
       assign(textf(tf),name);
       SetTextBuf(textf(tf),Ptr(file_ptr[tf],128)^,buffer_size);
       reset(textf(tf));
       if IoResult=0 then begin
         open_fil:= true;
         if f=0 then f:= $FFFF;
         file_prev[tf]:= f;
         f:= tf
       end
     end;

@ @<Close all Files@>=
while web_file>0 do close_fil(web_file);
for ChgLevel:= 1 to ChgCnt do
  while ChgFile[ChgLevel]>0 do close_fil(ChgFile[ChgLevel]);

@ The following code initializes the input buffers
@<Local variables for init...@>=
tf: word;

@ @<Set init...@>=
  FileMax:= No_of_Files;
  repeat
    file_ptr[1]:= malloc(((buffer_size+128) shr 4) *FileMax);
    if file_ptr[1]=0 then decr(FileMax)
  until (file_ptr[1]<>0) or (FileMax<2);
  if file_ptr[1]=0 then
    fatal_halt('No memory for the webfile and a changefile.');
  tf:= 2;
  while tf<=No_of_Files do begin
    file_ptr[tf]:= file_ptr[tf-1]+(buffer_size+128) shr 4;
    incr(tf)
  end;

@ We need a procedure to force the extension in a filename.
@<Inline proc...@>=
   function ForceExtension (FName, FExt : String): String;
   {-Return a pathname with the specified extension attached}
   var
     i,DotPos,BackSlashPos: byte;
   begin
     DotPos := 0;
     for i := 1 to _Length(FName) do begin
       if FName[I]='.' then DotPos := i;
       if FName[i]='\' then BackSlashPos:= i;
     end;
     if DotPos>BackSlashPos then
       ForceExtension:= _copy(FName,1,DotPos)+FExt
     else
       ForceExtension := FName+'.'+FExt;
   end;

@ Now we open the |web_file| and the |ChgFile|s if present.
@p procedure open_input; {prepare to read |web_file| and |ChgFile|}
var
  fn: String;
  tf,pc: word;
begin
  for tf:= 1 to No_of_Files do
    file_prev[tf]:= 0;
  web_file:= 0;
  if not open_fil(web_file,Parameter(1)) then
    if not open_fil(web_file,ForceExtension(Parameter(1),'WEB')) then
      fatal_halt('WEB file not found');
  fn:= Parameter(2); if (fn='') or (fn='*') then fn:= Parameter(1);
  ChgCnt:= 0; pc:= 2;
  while fn<>'' do begin
    if open_fil(ChgFile[ChgCnt+1],fn) then
      incr(ChgCnt)
    else
      if open_fil(ChgFile[ChgCnt+1],ForceExtension(fn,'CHG')) then
        incr(ChgCnt)
      else
        print_ln('CHG file ',fn,' not found.');
    incr(pc);
    fn:= Parameter(pc)
  end
end;
@z
────────────────────────────────────────────────────────────────
@x l.549 m.25
@!Pascal_file: text_file;
@y
@!Pascal_file: text_file;
@!Pascal_buffer: word;
@z
────────────────────────────────────────────────────────────────
@x l.558 m.26
@<Set init...@>=
rewrite(Pascal_file); rewrite(pool);
@y
@<Close all...@>=
@!Close(Pascal_file);
@
@<Set init...@>=
Pascal_buffer:= malloc(8192 shr 4);
if Pascal_buffer=0 then fatal_halt('No buffer for the pascal file.');
assign(Pascal_file,ForceExtension(Parameter(1),'PAS'));
SetTextBuf(Pascal_file,Ptr(Pascal_buffer,0)^,8192);
rewrite(Pascal_file);
if IoResult>0 then fatal_halt('Unable to create ',ForceExtension(Parameter(1),'PAS'));
assign(pool,Parameter(1)+'.POO'); rewrite(pool);
@z
────────────────────────────────────────────────────────────────
@x l.579 m.28
@p function input_ln(var f:text_file):boolean;
  {inputs a line or returns |false|}
var final_limit:0..buf_size; {|limit| without trailing blanks}
begin limit:=0; final_limit:=0;
if eof(f) then input_ln:=false
else  begin while not eoln(f) do
    begin buffer[limit]:=xord[f^]; get(f);
    incr(limit);
    if buffer[limit-1]<>" " then final_limit:=limit;
    if limit=buf_size then
      begin while not eoln(f) do get(f);
      decr(limit); {keep |buffer[buf_size]| empty}
      if final_limit>limit then final_limit:=limit;
      print_nl('! Input line too long'); loc:=0; error;
@.Input line too long@>
      end;
    end;
  read_ln(f); limit:=final_limit; input_ln:=true;
  end;
end;
@y
@p function input_ln (var f: word):boolean;
 label
   new_file;
 var
   s: String;
   fileend: boolean;
   i: byte;

     procedure open_include;
     var
       i: byte;
       fn: String;
     begin
       i:= 4;
       while (i<=Length(s)) and (s[i]<>' ') do incr(i);
       byte(fn[0]):= i-4;
       move(s[4],fn[1],Length(fn));
       if not open_fil(f,fn) then
         if not open_fil(f,fn+'.CHI') then
           if not open_fil(f,fn+'.CHG') then
             fatal_halt('@@i ',fn,': Include file not found.')
     end;

 begin new_file:
   limit:= 0;
   fileend:= eof(textf(f));
   if IoResult>0 then fileend:= true;
   if fileend then begin
     close_fil(f);
     if f>0 then
       goto new_file
     else
       input_ln:= false
   end else begin
     readln(textf(f),s);
     limit:= byte(s[0]);
     if (limit>3) and (s[1]='@@') and (s[2]='i') and (s[3]=' ') then begin
       open_include;
       goto new_file
     end;
     while (limit>0) and (s[limit]=' ') do decr(limit);
     for i:= 1 to limit do buffer[i-1]:= xord[s[i]];
     input_ln:=true;
   end;
 end;
@z
────────────────────────────────────────────────────────────────
@x l.651 m.32
@<Print error location based on input buffer@>=
begin if changing then print('. (change file ')@+else print('. (');
print_ln('l.', line:1, ')');
@y
@<Print error location based on input buffer@>=
begin
  if ChgLevel>0 then
    print('. (change file #',ChgAct[ChgLevel],
          ' l.',ChgLine[ChgAct[ChgLevel]]:1)
  else
    print('. (l.', line:1);
  print_ln(')');
@z
────────────────────────────────────────────────────────────────
@x l.685 m.34
@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
  end

@<Error handling...@>=
procedure jump_out;
begin goto end_of_TANGLE;
end;
@y
@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; Halt(history) end
@d fatal_halt(#)==begin new_line; print(#); mark_fatal; Halt(history) end
@z
────────────────────────────────────────────────────────────────
@x l.698 m.35
@d confusion(#)==fatal_error('! This can''t happen (',#,')')
@.This can't happen@>

@ An overflow stop occurs if \.{TANGLE}'s tables aren't large enough.

@d overflow(#)==fatal_error('! Sorry, ',#,' capacity exceeded')
@.Sorry, x capacity exceeded@>
@y
@p procedure confusion(s: String);
begin fatal_error('! This can''t happen (',s,')')
@.This can't happen@>
end;

@ An overflow stop occurs if \.{TANGLE}'s tables aren't large enough.

@p procedure overflow(s: String);
begin fatal_error('! Sorry, ',s,' capacity exceeded')
@.Sorry, x capacity exceeded@>
end;
@z
────────────────────────────────────────────────────────────────
@x l.736 m.38
@d ww=2 {we multiply the byte capacity by approximately this amount}
@d zz=3 {we multiply the token capacity by approximately this amount}
@y
@d ww=16 {we multiply the byte capacity by approximately this amount}
@d zz=16 {we multiply the token capacity by approximately this amount}
@z
────────────────────────────────────────────────────────────────
@x l.739 m.38
@<Globals...@>=
@!byte_mem: packed array [0..ww-1,0..max_bytes] of ASCII_code;
  {characters of names}
@y
@ @<Set init...@>=
if (ww<>16) then
  fatal_halt('! ww must be 16 (segment size).');
free:= mavail;
while (max_bytes+max_toks>free)
  and (max_bytes>min_bytes) and (max_toks>min_toks) do begin
    decr(max_bytes,step_bytes);
    decr(max_toks,step_toks)
end;
byte_seg:= malloc(max_bytes);
tok_seg:= malloc(max_toks);
if byte_seg=0 then
  fatal_halt('! no memory for byte_mem');
if tok_seg=0 then
  fatal_halt('! no memory for tok_mem');

@ @<Inline...@>=
  function bytem (s,o: word): Pointer;@/
  Asm(pop dx/
      pop ax/
      add dx,[>byte_seg]);

@ @d byte_mem[#]==ASCII_code(bytem(#)^)
@ @<Globals...@>=
@t\hskip1em@>@!byte_seg: word;
@!free: word;
@z
────────────────────────────────────────────────────────────────
@x l.742 m.38
@!tok_mem: packed array [0..zz-1,0..max_toks] of eight_bits; {tokens}
@y
@ @<Set init...@>=
if (zz<>16) then
  fatal_halt('! zz must be 16 (segment size).');

@ @<Inline...@>=
  function tokm (s,o: word): Pointer;@/
  Asm(pop dx/
      pop ax/
      add dx,[>tok_seg]);

@ @d tok_mem[#]==eight_bits(tokm(#)^)
@ @<Globals...@>=
@t\hskip1em@>@!tok_seg: word;
@z
────────────────────────────────────────────────────────────────
@x l.788 m.40
@!byte_ptr:array [0..ww-1] of 0..max_bytes;
  {first unused position in |byte_mem|}
@!pool_check_sum:integer; {sort of a hash for the whole string pool}
@y
@!byte_ptr:array [0..ww-1] of 0..max_max_bytes;
  {first unused position in |byte_mem|}
@!pool_check_sum:LongInt; {sort of a hash for the whole string pool}
@z
────────────────────────────────────────────────────────────────
@x l.828 m.44
@t\hskip1em@>@!tok_ptr:array[0..zz-1] of 0..max_toks;
  {first unused position in a given segment of |tok_mem|}
@y
@t\hskip1em@>@!tok_ptr:array[0..zz-1] of 0..max_max_toks;
  {first unused position in a given segment of |tok_mem|}
@z
────────────────────────────────────────────────────────────────
@x l.831 m.44
stat @!max_tok_ptr:array[0..zz-1] of 0..max_toks;
  {largest values assumed by |tok_ptr|}
tats
@y
stat @!max_tok_ptr:array[0..zz-1] of 0..max_max_toks;
  {largest values assumed by |tok_ptr|}
tats
@z
────────────────────────────────────────────────────────────────
@x l.863 m.47
like simple identifiers, their |equiv| value points to the replacement text.
@y
like simple identifiers, their |equiv| value points to the replacement text.

\yskip\hang |array_type| identifiers have been defined to be array-type macros;
they are like parametric identifiers but the macro parameters and
arguments are enclosed in square brackets.
@z
────────────────────────────────────────────────────────────────
@x l.868 m.47
@d parametric=3 {parametric macros have |parametric| ilk}
@y
@d parametric=3 {parametric macros have |parametric| ilk}
@d array_type=4 {array-type macros have |array_type| ilk}
@z
────────────────────────────────────────────────────────────────
@x l.890 m.49
var k:0..max_bytes; {index into |byte_mem|}
@y
var k:0..max_max_bytes; {index into |byte_mem|}
@z
────────────────────────────────────────────────────────────────
@x l.961 m.53
@!k:0..max_bytes; {index into |byte_mem|}
@y
@!k:0..max_max_bytes; {index into |byte_mem|}
@z
────────────────────────────────────────────────────────────────
@x l.979 m.54
h:=buffer[id_first]; i:=id_first+1;
while i<id_loc do
  begin h:=(h+h+buffer[i]) mod hash_size; incr(i);
  end
@y
Asm(_cld/
    _mov bx,>hash_size/
    _xor ax,ax/
    _xor dx,dx/
    _mov si,>buffer/
    _add si,[>id_first]/
    _mov cx,[bp+<l]/
lp1:_shl dx,1/
    _lodsb/
    _add dx,ax/
lp2:_sub dx,bx/
    _jge lp2/
    _add dx,bx/
    _loop lp1/
    _mov [bp+<h],dx);
@z
────────────────────────────────────────────────────────────────
@x l.1024 m.58          - make underscore significant
  begin if buffer[i]<>"_" then
    begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
    else chopped_id[s]:=buffer[i];
    h:=(h+h+chopped_id[s]) mod hash_size; incr(s);
    end;
  incr(i);
@y
  begin
    chopped_id[s]:=buffer[i];
    h:=(h+h+chopped_id[s]) mod hash_size; incr(s);
    incr(i);
@z
────────────────────────────────────────────────────────────────
@x l.1096 m.63          - make underscore significant
  if c<>"_" then
    begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
    if chopped_id[s]<>c then goto not_found;
    incr(s);
    end;
@y
  if chopped_id[s]<>c then goto not_found;
  incr(s);
@z
────────────────────────────────────────────────────────────────
@x l.1168 m.66
@!k:0..max_bytes; {index into |byte_mem|}
@y
@!k:0..max_max_bytes; {index into |byte_mem|}
@z
────────────────────────────────────────────────────────────────
@x l.1222 m.69
@!k:0..max_bytes; {index into |byte_mem|}
@y
@!k:0..max_max_bytes; {index into |byte_mem|}
@z
────────────────────────────────────────────────────────────────
@x l.1324 m.72          - implement an inline assembler
@d join=@'177 {ASCII delete will not appear}
@y
@d join=@'177 {ASCII delete will not appear}
@d asm_start=@'16 {ASCII SO will not appear}
@d asm_end=@'17 {ASCII SI will not appear}
@z
────────────────────────────────────────────────────────────────
@x l.1332 m.73
tok_mem[z,tok_ptr[z]]:=x div@'400; {this could be done by a shift command}
tok_mem[z,tok_ptr[z]+1]:=x mod@'400; {this could be done by a logical and}
@y
tok_mem[z,tok_ptr[z]]:=hi(x); tok_mem[z,tok_ptr[z]+1]:=lo(x);
@z
────────────────────────────────────────────────────────────────
@x l.1495 m.85
  begin if ilk[cur_name]=parametric then
@y
  begin if ilk[cur_name]>=parametric then
@z
────────────────────────────────────────────────────────────────
@x l.1527 m.86
@!cur_val:integer; {additional information corresponding to output token}
@y
@!cur_val:LongInt; {additional information corresponding to output token}
@z
────────────────────────────────────────────────────────────────
@x l.1536 m.87
@!k:0..max_bytes; {index into |byte_mem|}
@y
@!k:0..max_max_bytes; {index into |byte_mem|}
@z
────────────────────────────────────────────────────────────────
@x l.1546 m.87          - implement an inline assembler
a:=tok_mem[zo,cur_byte]; incr(cur_byte);
@y
a:=tok_mem[zo,cur_byte]; incr(cur_byte);
case a of
  asm_start,asm_end: goto found;
end;
@z
────────────────────────────────────────────────────────────────
@x l.1579 m.89
numeric: begin cur_val:=equiv[a]-@'100000; a:=number;
@y
numeric: begin cur_val:=LongInt(equiv[a])-@'100000; a:=number;
@z
────────────────────────────────────────────────────────────────
@x l.1583 m.89
parametric: begin @<Put a parameter on the parameter stack,
@y
parametric,array_type: begin @<Put a parameter on the parameter stack,
@z
────────────────────────────────────────────────────────────────
@x l.1598 m.90
@<Put a parameter...@>=
while (cur_byte=cur_end)and(stack_ptr>0) do pop_level;
if (stack_ptr=0)or(tok_mem[zo,cur_byte]<>"(") then
  begin print_nl('! No parameter given for '); print_id(a); error;
@.No parameter given for macro@>
  goto restart;
  end;
@<Copy the parameter into |tok_mem|@>;
@y
@d NoParam(#)== begin print_nl(#); print_id(a); error; goto restart end
@<Put a parameter...@>=
while (cur_byte=cur_end)and(stack_ptr>0) do pop_level;
if stack_ptr=0 then NoParam('! No parameter given for ');
case ilk[a] of
  parametric: if tok_mem[zo,cur_byte]="(" then begin
                @<Copy the parameter into |tok_mem|@>
              end else
                NoParam('! No parameter given for ');
  array_type: if tok_mem[zo,cur_byte]="[" then begin
                @<Copy the array parameter into |tok_mem|@>
              end else
                NoParam('! No array parameter given for ');
end;
@z
────────────────────────────────────────────────────────────────
@x l.1783 m.95
@!out_val,@!out_app:integer; {pending values}
@y
@!out_val,@!out_app:LongInt; {pending values}
@!assembling: boolean; {true, when parsing/expanding assembler text}
@z
────────────────────────────────────────────────────────────────
@x l.1791 m.96
out_state:=misc; out_ptr:=0; break_ptr:=0; semi_ptr:=0; out_buf[0]:=0; line:=1;
@y
out_state:=misc; out_ptr:=0; break_ptr:=0; semi_ptr:=0; out_buf[0]:=0; line:=1;
assembling:= false;
@z
────────────────────────────────────────────────────────────────
@x l.1799 m.97
@d check_break==if out_ptr>line_length then flush_buffer
@y
@d check_break==if out_ptr>line_length then flush_buffer
@d im_break==begin
               break_ptr:= out_ptr;
               semi_ptr:= 0;
               flush_buffer
             end
@z
────────────────────────────────────────────────────────────────
@x l.1806 m.97          -implement an inline assembler
for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
write_ln(Pascal_file); incr(line);
if line mod 100 = 0 then
  begin print('.');
  if line mod 500 = 0 then print(line:1);
  update_terminal; {progress report}
  end;
if break_ptr<out_ptr then
  begin if out_buf[break_ptr]=" " then
    begin incr(break_ptr); {drop space at break}
    if break_ptr>b then b:=break_ptr;
    end;
  for k:=break_ptr to out_ptr-1 do out_buf[k-break_ptr]:=out_buf[k];
  end;
out_ptr:=out_ptr-break_ptr; break_ptr:=b-break_ptr; semi_ptr:=0;
if out_ptr>line_length then
  begin err_print('! Long line must be truncated'); out_ptr:=line_length;
@.Long line must be truncated@>
  end;
@y
if assembling then begin
  for k:= 1 to out_ptr do
    if not FeedAsm(xchr[out_buf[k-1]]) then
      overflow('inline input');
  out_ptr:= 0
end else begin
  for k:= 1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
  write_ln(Pascal_file); incr(line);
  if line mod 100 = 0 then
    begin print('.');
    if line mod 500 = 0 then print(line:1);
    update_terminal; {progress report}
    end;
  if break_ptr<out_ptr then
    begin if out_buf[break_ptr]=" " then
      begin incr(break_ptr); {drop space at break}
      if break_ptr>b then b:=break_ptr;
      end;
      move(out_buf[break_ptr],out_buf[0],out_ptr-break_ptr);
    end;
  decr(out_ptr,break_ptr); break_ptr:=b-break_ptr; semi_ptr:=0;
  if out_ptr>line_length then
    begin err_print('! Long line must be truncated'); out_ptr:=line_length;
  @.Long line must be truncated@>
    end;
end;
@z
────────────────────────────────────────────────────────────────
@x l.1839 m.99
@p procedure app_val(@!v:integer); {puts |v| into buffer, assumes |v>=0|}
@y
@p procedure app_val(@!v:LongInt); {puts |v| into buffer, assumes |v>=0|}
@z
────────────────────────────────────────────────────────────────
@x l.1881 m.101
if t<>misc then for k:=1 to v do app(out_contrib[k])
@y
if t<>misc then begin
  move(out_contrib,out_buf[out_ptr],v); incr(out_ptr,v)
  end
@z
────────────────────────────────────────────────────────────────
@x l.1930 m.105
 (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
 ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
@y
 (((out_contrib[1]="d")and(out_contrib[2]="i")and(out_contrib[3]="v")) or@|
 ((out_contrib[1]="a")and(out_contrib[2]="n")and(out_contrib[3]="d")) or@|
 ((out_contrib[1]="s")and(out_contrib[2]="h")and
  ((out_contrib[3]="l")or(out_contrib[3]="r"))) or@|
 ((out_contrib[1]="m")and(out_contrib[2]="o")and(out_contrib[3]="d")) ))or@|
@z
────────────────────────────────────────────────────────────────
@x l.1941 m.106
@p procedure send_sign(@!v:integer);
@y
@p procedure send_sign(@!v:LongInt);
@z
────────────────────────────────────────────────────────────────
@x l.1959 m.107
@p procedure send_val(@!v:integer); {output the (signed) value |v|}
@y
@p procedure send_val(@!v:LongInt); {output the (signed) value |v|}
var potcnt: byte;
@z
────────────────────────────────────────────────────────────────
@x l.1995 m.110         - optimize DIV and MOD
@ @<If previous output was \.{DIV}...@>=
if (out_ptr=break_ptr+3)or
 ((out_ptr=break_ptr+4)and(out_buf[break_ptr]=" ")) then
@^uppercase@>
  if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
    (out_buf[out_ptr-1]="V"))or @/
     ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
    (out_buf[out_ptr-1]="D")) then@/ goto bad_case
@y
@ @<Typed constants...@>=
modopt: boolean = false;
divopt: boolean = false;
InsComments: boolean = false;

@ @<Local variables for init...@>=
pi,pp: word;
s: String;
@ @<Set init...@>=
   for pi:= 1 to ParamCount do begin
     s:= ParamStr(pi);
     pp:= pos('-',s);
     if pp=0 then pp:= pos('/',s);
     if pp>0 then case UpCase(s[pp+1]) of
       'D': divopt:= true;
       'M': modopt:= true;
       'C': InsComments:= true;
     end
   end;

@ @<If previous output was \.{DIV}...@>=
begin if (out_ptr=break_ptr+3)or
 ((out_ptr=break_ptr+4)and(out_buf[break_ptr]=" ")) then
@^uppercase@>
 begin
  if ((out_buf[out_ptr-3]="d")and(out_buf[out_ptr-2]="i")and
    (out_buf[out_ptr-1]="v") and divopt) then begin
      if (v>0) and (v<257) and (v and (v-1)=0) then begin
        potcnt:= 0;
        while lo(v) and 1=0 do begin
          incr(potcnt);
          v:= v shr 1
        end;
        v:= potcnt;
        out_buf[out_ptr-3]:= "s";
        out_buf[out_ptr-2]:= "h";
        out_buf[out_ptr-1]:= "r";
      end;
      goto bad_case
    end;
    if ((out_buf[out_ptr-3]="m")and(out_buf[out_ptr-2]="o")and
    (out_buf[out_ptr-1]="d")and modopt) then begin
      if (v>0) and (v and (v-1)=0) then begin
        Dec(v);
        out_buf[out_ptr-3]:= "a";
        out_buf[out_ptr-2]:= "n";
        out_buf[out_ptr-1]:= "d";
      end;
      goto bad_case
    end;
    if ((out_buf[out_ptr-3]="s")and(out_buf[out_ptr-2]="h")and
    (out_buf[out_ptr-1]="l")) or @/
     ((out_buf[out_ptr-3]="s")and(out_buf[out_ptr-2]="h")and
    (out_buf[out_ptr-1]="r")) then@/ goto bad_case
 end
end
@z
────────────────────────────────────────────────────────────────
@x l.2042 m.113
  @!j:0..max_bytes; {index into |byte_mem|}
  @!w:0..ww-1; {segment of |byte_mem|}
  @!n:integer; {number being scanned}
@y
  @!j:0..max_max_bytes; {index into |byte_mem|}
  @!w:0..ww-1; {segment of |byte_mem|}
  @!n:LongInt; {number being scanned}
  @!outind: word;
@z
────────────────────────────────────────────────────────────────
@x l.2059 m.113         - implement an inline assembler
  verbatim: @<Send verbatim string@>;
@y
  verbatim: @<Send verbatim string@>;
  asm_start: if assembling then
               err_print('! Already assembling')
@.Already assembling@>
             else begin
               SetUpAsm;
               im_break;
               assembling:= true
             end;
  asm_end:   if assembling then begin
               send_out(frac,0); {tss, tss}
               im_break;
               assembling:= false;
               if not DoAsm(InsComments) then
                 mark_harmless;

               for outind:= 0 to ObjSize-1 do
                 case byte(TextArray[outind]) of
                   13: im_break;
                   10: do_nothing;
                 else
                   app(byte(TextArray[outind]))
                 end
             end else
               err_print('! Not in assembler mode');
@.Not in assembler mode@>
@z
────────────────────────────────────────────────────────────────
@x l.2070 m.114
and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
@y
and_sign: begin out_contrib[1]:="a"; out_contrib[2]:="n"; out_contrib[3]:="d";
@z
────────────────────────────────────────────────────────────────
@x l.2074 m.114
not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
@y
not_sign: begin out_contrib[1]:="n"; out_contrib[2]:="o"; out_contrib[3]:="t";
@z
────────────────────────────────────────────────────────────────
@x l.2077 m.114
set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
@y
set_element_sign: begin out_contrib[1]:="i"; out_contrib[2]:="n";
@z
────────────────────────────────────────────────────────────────
@x l.2080 m.114
or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
@y
or_sign: begin out_contrib[1]:="o"; out_contrib[2]:="r"; send_out(ident,2);
@z
────────────────────────────────────────────────────────────────
@x l.2124 m.116
@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
  #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
@y
@z
────────────────────────────────────────────────────────────────
@x l.2128 m.116
"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
  end;
"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
  end;
@y
"A".."Z","a".."z": begin out_contrib[1]:=cur_char; send_out(ident,1); end;
@z
────────────────────────────────────────────────────────────────
@x l.2132 m.116
identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
  while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
    begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
    if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
    else if out_contrib[k]="_" then decr(k);
    end;
@y
identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
  while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
    begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
    if out_contrib[k]="_" then decr(k);
    end;
@z
────────────────────────────────────────────────────────────────
@x l.2289 m.124         - implement multiple change files
@ But first we need to consider the low-level routine |get_line|
that takes care of merging |change_file| into |web_file|. The |get_line|
procedure also updates the line numbers for error messages.

@<Globals...@>=
@!line:integer; {the number of the current line in the current file}
@!other_line:integer; {the number of the current line in the input file that
  is not currently being read}
@!temp_line:integer; {used when interchanging |line| with |other_line|}
@!limit:0..buf_size; {the last character position occupied in the buffer}
@!loc:0..buf_size; {the next character position to be read from the buffer}
@!input_has_ended: boolean; {if |true|, there is no more input}
@!changing: boolean; {if |true|, the current line is from |change_file|}

@ As we change |changing| from |true| to |false| and back again, we must
remember to swap the values of |line| and |other_line| so that the |err_print|
routine will be sure to report the correct line number.

@d change_changing==
  changing := not changing;
  temp_line:=other_line; other_line:=line; line:=temp_line
    {|line @t$\null\BA\null$@> other_line|}

@ When |changing| is |false|, the next line of |change_file| is kept in
|change_buffer[0..change_limit]|, for purposes of comparison with the next
line of |web_file|. After the change file has been completely input, we
set |change_limit:=0|, so that no further matches will be made.

@<Globals...@>=
@!change_buffer:array[0..buf_size] of ASCII_code;
@!change_limit:0..buf_size; {the last position occupied in |change_buffer|}
@y
@ But first we need to consider the low-level routine |get_line|
that takes care of merging |change_file| into |web_file|. The |get_line|
procedure also updates the line numbers for error messages.

@<Globals...@>=
@!line:word; {the number of the current line in the current file}
@!limit:0..buf_size; {the last character position occupied in the buffer}
@!loc:0..buf_size; {the next character position to be read from the buffer}
@!input_has_ended: boolean; {if |true|, there is no more input}

@ The next line of the |Chg_File|s is kept in
|ChgBuffer|, for purposes of comparison with the next
line of |web_file| or another |ChgFile|. After a change file
has been completely input, we set the corresponding |ChgLimit|
to zero, so that no further matches will be made.

@<Globals...@>=
@!ChgBuffer:array[1..ChangeMax] of array[0..buf_size] of ASCII_code;
@!ChgLimit: array[1..ChangeMax] of 0..buf_size; {the last positions occupied in |ChgBuffer|}
@!ChgLine: array[1..ChangeMax] of word; {the line numbers}
@z
────────────────────────────────────────────────────────────────
@x l.2321 m.127         - implement multiple change files
@ Here's a simple function that checks if the two buffers are different.

@p function lines_dont_match:boolean;
label exit;
var k:0..buf_size; {index into the buffers}
begin lines_dont_match:=true;
if change_limit<>limit then return;
if limit>0 then
  for k:=0 to limit-1 do if change_buffer[k]<>buffer[k] then return;
lines_dont_match:=false;
exit: end;

@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
for the next matching operation. Since blank lines in the change file are
not used for matching, we have |(change_limit=0)and not changing| if and
only if the change file is exhausted. This procedure is called only
when |changing| is true; hence error messages will be reported correctly.

@p procedure prime_the_change_buffer;
label continue, done, exit;
var k:0..buf_size; {index into the buffers}
begin change_limit:=0; {this value will be used if the change file ends}
@<Skip over comment lines in the change file; |return| if end of file@>;
@<Skip to the next nonblank line; |return| if end of file@>;
@<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
exit: end;

@ While looking for a line that begins with \.{@@x} in the change file,
we allow lines that begin with \.{@@}, as long as they don't begin with
\.{@@y} or \.{@@z} (which would probably indicate that the change file is
fouled up).

@<Skip over comment lines in the change file...@>=
loop@+  begin incr(line);
  if not input_ln(change_file) then return;
  if limit<2 then goto continue;
  if buffer[0]<>"@@" then goto continue;
  if (buffer[1]>="X")and(buffer[1]<="Z") then
    buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
  if buffer[1]="x" then goto done;
  if (buffer[1]="y")or(buffer[1]="z") then
    begin loc:=2; err_print('! Where is the matching @@x?');
@.Where is the match...@>
    end;
continue: end;
done:

@ Here we are looking at lines following the \.{@@x}.

@<Skip to the next nonblank line...@>=
repeat incr(line);
  if not input_ln(change_file) then
    begin err_print('! Change file ended after @@x');
@.Change file ended...@>
    return;
    end;
until limit>0;
@y
@ Here's a simple function that checks |buffer| doesn't match a |ChgBuffer|.

@p function lines_dont_match(ci: word):boolean;
label exit;
var k:0..buf_size; {index into the buffers}
begin lines_dont_match:=true;
if ChgLimit[ci]<>limit then return;
if limit>0 then
  for k:=0 to limit-1 do if ChgBuffer[ci][k]<>buffer[k] then return;
lines_dont_match:=false;
exit: end;

@ Procedure |prime_the_change_buffer| sets a |ChgBuffer| in preparation
for the next matching operation. Since blank lines in the change files are
not used for matching, we have |(ChgLimit=0)and not changing| if and
only if the change file is exhausted. This procedure is called only
when |changing| is true; hence error messages will be reported correctly.

@p procedure prime_the_change_buffer (ci:word);
label exit;
var k:0..buf_size; {index into the buffers}
begin ChgLimit[ci]:=0; {this value will be used if the change file ends}
@<Skip over comment lines in the change file; |return| if end of file@>;
@<Skip to the next nonblank line; |return| if end of file@>;
ChgLimit[ci]:= limit;
move(buffer,ChgBuffer[ci],limit);
exit: end;

@ While looking for a line that begins with \.{@@x} in the change file,
we allow lines that begin with \.{@@}, as long as they don't begin with
\.{@@y} or \.{@@z} (which would probably indicate that the change file is
fouled up).

@<Skip over comment lines in the change file...@>=
repeat
  incr(ChgLine[ci]);
  if not input_ln(ChgFile[ci]) then return;
  if (limit>=2) and (buffer[0]="@@") then
    case buffer[1] of "Y","y","Z","z":
    begin loc:=2; err_print('! Where is the matching @@x?');
@.Where is the match...@>
    end end;
until (limit>=2) and (buffer[0]="@@")
  and ((buffer[1]="X") or (buffer[1]="x"));

@ Here we are looking at lines following the \.{@@x}.

@<Skip to the next nonblank line...@>=
repeat incr(ChgLine[ci]);
  if not input_ln(ChgFile[ci]) then
    begin err_print('! Change file #',ci,' ended after @@x');
@.Change file ended...@>
    return;
    end;
until limit>0;
@z
────────────────────────────────────────────────────────────────
@x l.2379 m.131         - implement multiple change files
@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
begin change_limit:=limit;
if limit>0 then for k:=0 to limit-1 do change_buffer[k]:=buffer[k];
end

@ The following procedure is used to see if the next change entry should
go into effect; it is called only when |changing| is false.
The idea is to test whether or not the current
contents of |buffer| matches the current contents of |change_buffer|.
If not, there's nothing more to do; but if so, a change is called for:
All of the text down to the \.{@@y} is supposed to match. An error
message is issued if any discrepancy is found. Then the procedure
prepares to read the next line from |change_file|.

@p procedure check_change; {switches to |change_file| if the buffers match}
label exit;
var n:integer; {the number of discrepancies found}
@!k:0..buf_size; {index into the buffers}
begin if lines_dont_match then return;
n:=0;
loop@+  begin change_changing; {now it's |true|}
  incr(line);
  if not input_ln(change_file) then
    begin err_print('! Change file ended before @@y');
@.Change file ended...@>
    change_limit:=0;  change_changing; {|false| again}
    return;
    end;
  @<If the current line starts with \.{@@y},
    report any discrepancies and |return|@>;
  @<Move |buffer| and |limit|...@>;
  change_changing; {now it's |false|}
  incr(line);
  if not input_ln(web_file) then
    begin err_print('! WEB file ended during a change');
@.WEB file ended...@>
    input_has_ended:=true; return;
    end;
  if lines_dont_match then incr(n);
  end;
exit: end;
@y
@ The following procedure is used to see if the next change entries should
go into effect. The idea is to test whether or not the current
contents of |buffer| matches the current contents of one |ChgBuffer|.
If not, there's nothing more to do; but if so, a change is called for:
All of the text down to the \.{@@y} is supposed to match. An error
message is issued if any discrepancy is found. Then the procedure
prepares to read the next line from |ChgFile|.

@p procedure check_change (newch: word);
{switches to |change_file| if the buffers match}
label done,exit;
var n:integer; {the number of discrepancies found}
@!k:0..buf_size; {index into the buffers}
SrcFile: word; {this file will be changed by another change file}
begin if lines_dont_match(newch) then return;
if ChgLevel=0 then
  SrcFile:= web_file
else
  SrcFile:= ChgFile[ChgAct[ChgLevel]];
n:=0;
incr(ChgLevel); {new change file}
ChgAct[ChgLevel]:= newch; {store index of new change file}
loop@+  begin
  incr(ChgLine[newch]);
  if not input_ln(ChgFile[newch]) then
    begin err_print('! Change file #',newch,' ended before @@y');
@.Change file ended...@>
    ChgLimit[newch]:=0;
    return;
    end;
  @<If the current line starts with \.{@@y},
    report any discrepancies and |return|@>;
  ChgLimit[newch]:= limit;
  move(buffer,ChgBuffer[newch],limit);
  if SrcFile=web_file then
    incr(line)
  else
    incr(ChgLine[ChgAct[ChgLevel-1]]);

  loop@+  begin
    if not input_ln(SrcFile) then begin
      if SrcFile=web_file then begin
        err_print('! WEB file ended during a change');
@.WEB file ended...@>
        input_has_ended:=true; return;
      end else
        @<Remove |ChgAct[ChgLevel-1]|@>
    end else begin
      if (SrcFile=web_file) or (limit<2) or (buffer[0]<>"@@")
      or ((buffer[1]<>"z") and (buffer[1]<>"Z")) then begin
        if SrcFile=web_file then
          incr(line)
        else
          incr(ChgLine[ChgAct[ChgLevel-1]]);
        goto done
      end else begin
        incr(ChgLine[ChgAct[ChgLevel-1]]);
        prime_the_change_buffer(ChgAct[ChgLevel-1]);
        @<Remove |ChgAct[ChgLevel-1]|@>
      end
    end
  end;
  done:
  if lines_dont_match(newch) then incr(n);
  end;
exit: end;

@ @<Remove |ChgAct[ChgLevel-1]|@>=
begin decr(ChgLevel);
  ChgAct[ChgLevel]:= ChgAct[ChgLevel+1];
  if ChgLevel=1 then
    SrcFile:= web_file
  else
    SrcFile:= ChgFile[ChgAct[ChgLevel-1]]
end;
@z
2423
────────────────────────────────────────────────────────────────
@x l.2439 m.134         - implement multiple change files
@ @<Initialize the input system@>=
open_input; line:=0; other_line:=0;@/
changing:=true; prime_the_change_buffer; change_changing;@/
limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
@y
@ @<Initialize the input system@>=
open_input; line:=0;@/
ChgLevel:= ChgCnt;
while ChgLevel>0 do begin
  ChgLine[ChgLevel]:= 0;
  prime_the_change_buffer(ChgLevel);
  decr(ChgLevel)
end;
limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
@z
────────────────────────────────────────────────────────────────
@x l.2448 m.135         - implement multiple change files
@p procedure get_line; {inputs the next line}
label restart;
begin restart: if changing then
  @<Read from |change_file| and maybe turn off |changing|@>;
if not changing then
  begin @<Read from |web_file| and maybe turn on |changing|@>;
  if changing then goto restart;
  end;
loc:=0; buffer[limit]:=" ";
end;

@ @<Read from |web_file|...@>=
begin incr(line);
if not input_ln(web_file) then input_has_ended:=true
else if limit=change_limit then
  if buffer[0]=change_buffer[0] then
    if change_limit>0 then check_change;
end

@ @<Read from |change_file|...@>=
begin incr(line);
if not input_ln(change_file) then
  begin err_print('! Change file ended without @@z');
@.Change file ended...@>
  buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
  end;
if limit>1 then {check if the change has ended}
  if buffer[0]="@@" then
    begin if (buffer[1]>="X")and(buffer[1]<="Z") then
      buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
    if (buffer[1]="x")or(buffer[1]="y") then
      begin loc:=2; err_print('! Where is the matching @@z?');
@.Where is the match...@>
      end
    else if buffer[1]="z" then
      begin prime_the_change_buffer; change_changing;
      end;
    end;
end

@ At the end of the program, we will tell the user if the change file
had a line that didn't match any relevant line in |web_file|.

@<Check that all changes have been read@>=
if change_limit<>0 then {|changing| is false}
  begin for loc:=0 to change_limit do buffer[loc]:=change_buffer[loc];
  limit:=change_limit; changing:=true; line:=other_line; loc:=change_limit;
  err_print('! Change file entry did not match');
@.Change file entry did not match@>
  end
@y
@p procedure get_line; {inputs the next line}
label restart,reswitch,continue;
var
  i,OldLevel: 0..ChangeMax;
begin restart: @/
  if ChgLevel>0 then
    @<Read the next line from a |ChgFile|@>;
if ChgLevel=0 then
  begin @<Read from |web_file| and maybe increment |ChgLevel|@>;
  if ChgLevel>0 then goto restart;
  end;
loc:=0; buffer[limit]:=" ";
end;

@ @<Read from |web_file|...@>=
begin incr(line);
if not input_ln(web_file) then input_has_ended:=true
else begin
  i:= 0;
  while (i<ChgCnt) and (ChgLevel=0) do begin
    incr(i);
    if (ChgLimit[i]=limit) and (buffer[0]=ChgBuffer[i][0])
    and (ChgLimit[i]>0) then
      check_change(i);
  end
end
end

@ @<Read the next...@>=
begin reswitch:
  incr(ChgLine[ChgAct[ChgLevel]]);
  if not input_ln(ChgFile[ChgAct[ChgLevel]]) then
    begin err_print('! Change file #',ChgAct[ChgLevel],' ended without @@z');
@.Change file ended...@>
      buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
    end;
if (limit>1) and (buffer[0]="@@") then {check if the change has ended}
  case buffer[1] of
    "X","x","Y","y":
      begin loc:=2; err_print('! Where is the matching @@z?');
@.Where is the match...@>
        goto continue;
      end;
    "Z","z":
      begin
        prime_the_change_buffer(ChgAct[ChgLevel]);
        decr(ChgLevel);
        if ChgLevel>0 then goto reswitch; {read from previous CHG file}
        goto continue
      end;
 end; {case}
 i:= ChgAct[ChgLevel]; OldLevel:= ChgLevel;
 while (i<ChgCnt) and (OldLevel=ChgLevel) do begin
   incr(i);
   if (ChgLimit[i]=limit) and (buffer[0]=ChgBuffer[i][0])
   and (ChgLimit[i]>0) then
     check_change(i)
 end;
 continue:
end

@ At the end of the program, we will tell the user if the change file
had a line that didn't match any relevant line in |web_file|.

@<Check that all changes have been read@>=
for ChgLevel:= 1 to ChgCnt do if ChgLimit[ChgLevel]<>0 then
  begin
    move(ChgBuffer[ChgLevel],buffer,ChgLimit[ChgLevel]);
    limit:=ChgLimit[ChgLevel];
    loc:=ChgLimit[ChgLevel];
  err_print('! Change file #',ChgLevel,': entry did not match');
@.Change file entry did not match@>
  end
@z
────────────────────────────────────────────────────────────────
@x l.2538 m.140         - implement an inline assembler
"\": control_code:=force_line; {force a new line in \PASCAL\ output}
@y
"\": control_code:=force_line; {force a new line in \PASCAL\ output}
"[": control_code:= asm_start;
"]": control_code:= asm_end;
@z
────────────────────────────────────────────────────────────────
@x l.2653 m.146         - make use of Turbo's hex constants
"A",up_to("Z"),"a",up_to("z"): @<Get an identifier@>;
@y
"A".."Z","a".."z","_": @<Get an identifier@>;
"$": begin c:= hex; scanning_hex:= true end;
@z
────────────────────────────────────────────────────────────────
@x l.2840 m.160
var accumulator:integer; {accumulates sums}
@y
var accumulator:LongInt; {accumulates sums}
@z
────────────────────────────────────────────────────────────────
@x l.2843 m.160
@!val:integer; {constants being evaluated}
@y
@!val:LongInt; {constants being evaluated}
@z
────────────────────────────────────────────────────────────────
@x l.2872 m.161
    add_in(equiv[q]-@'100000);
@y
    add_in(LongInt(equiv[q])-@'100000);
@z
────────────────────────────────────────────────────────────────
@x l.2908 m.165         - make use of Turbo's hex constants
repeat if next_control>="A" then next_control:=next_control+"0"+10-"A";
@y
repeat
if next_control>="a" then next_control:=next_control+"0"+10-"a"
else if next_control>="A" then next_control:=next_control+"0"+10-"A";
@z
────────────────────────────────────────────────────────────────
@x l.2952 m.168
  "#": if t=parametric then a:=param;
@y
  "#": if (t=parametric)or(t=array_type) then a:=param;
@z
────────────────────────────────────────────────────────────────
@x l.3096 m.180
if next_control="(" then
@y
begin p:=parametric;
if next_control="[" then p:=array_type;
if (p=parametric)and(next_control="(")or
   (p=array_type)and(next_control="[") then
@z
────────────────────────────────────────────────────────────────
@x l.3100 m.180
    if next_control=")" then
@y
    if (p=parametric)and(next_control=")")or
       (p=array_type)and(next_control="]") then
@z
────────────────────────────────────────────────────────────────
@x l.3108 m.180
        begin define_macro(parametric); goto continue;
@y
        begin define_macro(p); goto continue;
@z
────────────────────────────────────────────────────────────────
@x l.3112 m.180
  end;
@y
  end;
end
@z
────────────────────────────────────────────────────────────────
@x l.3227 m.188
@p begin initialize;
@y
@p
var
  ExitSave: Pointer;
@={$F+}@>
procedure FinishUp;
@={$F-}@>
begin
  if ErrorAddr<>NIL then begin
    write_ln('Internal error #',ExitCode);
    ErrorAddr:= NIL;
    Halt(ExitCode)
  end;
if string_ptr>256 then begin
  @<Finish off the string pool file@>;
  Close(pool)
end else
  Erase(pool);
stat @<Print statistics about memory usage@>;@+tats@;@/
@<Print the job |history|@>;
@<Close all Files@>;
mfree(byte_seg);
mfree(tok_seg);
mfree(Pascal_buffer);
ExitProc:= ExitSave;
end; { FinishUp }

begin { main }
  ExitSave:= ExitProc;
  ExitProc:= @@FinishUp;

  fillchar(firstvar,Ofs(lastvar)-Ofs(firstvar),0);
  if (ParamCount=0) then begin
    print_ln(banner);
    print_ln('Usage: TANGLE <WEB file> [<CHG file1>] [<CHG file2>...]'
                  +' [Options]');
    print_ln('Options: /d optimize DIV');
    print_ln('         /m optimize MOD');
    print_ln('         /c include comments in inlines');
    print_ln('');
    Halt(error_message)
  end;
  initialize;
@z
────────────────────────────────────────────────────────────────
@x l.3233 m.188
end_of_TANGLE:
if string_ptr>256 then @<Finish off the string pool file@>;
stat @<Print statistics about memory usage@>;@+tats@;@/
@t\4\4@>{here files should be closed if the operating system requires it}
@<Print the job |history|@>;
@y
@z
-- 3286
────────────────────────────────────────────────────────────────
@x l.3293 m.194
itself will get a new module number.
@^system dependencies@>
@y
itself will get a new module number.
@^system dependencies@>

Here we add the more extensive changes for this \.{TP} version
of \.{TANGLE}.

@ First we need an extra module to copy the parameter of an |array_type|
macro.

@<Copy the array parameter...@>=
bal:= 1; incr(cur_byte); {skip the opening '[' }
repeat b:=tok_mem[zo,cur_byte]; incr(cur_byte);
  if b=param then store_two_bytes(word(name_ptr)+@'77777)
  else  begin if b>=@'200 then
      begin app_repl(b);
      b:=tok_mem[zo,cur_byte]; incr(cur_byte);
      end
    else case b of
      "[": incr(bal);
      "]": decr(bal);
{      ",": if bal=1 then begin
             decr(cur_byte);
             tok_mem[zo,cur_byte]:="[";
             bal:= 0
           end;
}
      "'": repeat app_repl(b);
        b:=tok_mem[zo,cur_byte]; incr(cur_byte);
        until b="'"; {copy string, don't change |bal|}
      othercases do_nothing
      endcases;
    if bal<>0 then app_repl(b)
  end
until bal=0

@ The following function returns a commandline parameter without
  an option

@<All purpose procedures and functions@>=
   function Parameter (i: word): String;
   var
     p: word;
     s: String;
   begin
     s:= ParamStr(i);
     p:= pos('-',s);
     if p=0 then p:= pos('/',s);
     if p>0 then byte(s[0]):= p-1;
     Parameter:= s
   end;
@z