diff options
Diffstat (limited to 'Build/source/texk/web2c/luatexdir/luatangle.web')
-rw-r--r-- | Build/source/texk/web2c/luatexdir/luatangle.web | 3329 |
1 files changed, 0 insertions, 3329 deletions
diff --git a/Build/source/texk/web2c/luatexdir/luatangle.web b/Build/source/texk/web2c/luatexdir/luatangle.web deleted file mode 100644 index 46ca98e1e14..00000000000 --- a/Build/source/texk/web2c/luatexdir/luatangle.web +++ /dev/null @@ -1,3329 +0,0 @@ -% luatangle.web: LuaTeX version of file tangle.web -% $Id$ -% -% This file is part of LuaTeX. -% -% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous -% Copyright 2006-2008 Taco Hoekwater <taco@luatex.org> -% applies only to the changes to the original tangle.web. -% -% This program by D. E. Knuth is not copyrighted and can be used freely. -% Version 0 was released in December, 1981. -% Version 1 was released in September, 1982, with version 0 of TeX. -% Slight changes were made in October, 1982, for version 0.6 of TeX. -% Version 1.2 introduced {:nnn} comments, added @@= and @@\ (December, 1982). -% Version 1.4 added "history" (February, 1983). -% Version 1.5 conformed to TeX version 0.96 and fixed @@\ (March, 1983). -% Version 1.7 introduced the new change file format (June, 1983). -% Version 2.0 was released in July, 1983, with version 0.999 of TeX. -% Version 2.5 was released in November, 1983, with version 1.0 of TeX. -% Version 2.6 fixed a bug: force-line-break after a constant (August, 1984). -% Version 2.7 fixed the definition of check_sum_prime (May, 1985). -% Version 2.8 fixed a bug in change_buffer movement (August, 1985). -% Version 2.9 allows nonnumeric macros before their def (December, 1988). -% Version 3, for Sewell's book, fixed long-line bug in input_ln (March, 1989). -% Version 4 was major change to allow 8-bit input (September, 1989). -% Version 4.1 conforms to ANSI standard for-loop rules (September, 1990). -% Version 4.2 fixes stat report if phase one dies (March, 1991). -% Version 4.3 fixes @@ bug in verbatim, catches extra } (September, 1991). -% Version 4.4 activates debug_help on errors as advertised (February, 1993). - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\indent\ignorespaces} -\font\ninerm=cmr9 -\let\mc=\ninerm % medium caps for names like SAIL -\def\PASCAL{Pascal} -\def\pb{$\.|\ldots\.|$} % Pascal brackets (|...|) -\def\v{\.{\char'174}} % vertical (|) in typewriter font -\mathchardef\BA="3224 % double arrow -\def\({} % kludge for alphabetizing certain module names - -\def\title{LUATANGLE} -\def\contentspagenumber{123} % should be odd -\def\topofcontents{\null\vfill - \titlefalse % include headline on the contents page - \def\rheader{\mainfont Appendix E\hfil \contentspagenumber} - \centerline{\titlefont The {\ttitlefont LUATANGLE} processor} - \vskip 15pt - \centerline{(Version 4.4)} - \vfill} -\pageno=\contentspagenumber \advance\pageno by 1 - -@* Introduction. -This program converts a \.{WEB} file to a \PASCAL\ file. It was written -by D. E. Knuth in September, 1981; a somewhat similar {\mc SAIL} program had -been developed in March, 1979. Since this program describes itself, a -bootstrapping process involving hand-translation had to be used to get started. - -For large \.{WEB} files one should have a large memory, since \.{TANGLE} keeps -all the \PASCAL\ text in memory (in an abbreviated form). The program uses -a few features of the local \PASCAL\ compiler that may need to be changed in -other installations: - -\yskip\item{1)} Case statements have a default. -\item{2)} Input-output routines may need to be adapted for use with a particular -character set and/or for printing messages on the user's terminal. - -\yskip\noindent -These features are also present in the \PASCAL\ version of \TeX, where they -are used in a similar (but more complex) way. System-dependent portions -of \.{TANGLE} can be identified by looking at the entries for `system -dependencies' in the index below. -@!@^system dependencies@> - -The ``banner line'' defined here should be changed whenever \.{TANGLE} -is modified. - -@d banner=='This is LUATANGLE, Version 4.4' - -@ The program begins with a fairly normal header, made up of pieces that -@^system dependencies@> -will mostly be filled in later. The \.{WEB} input comes from files |web_file| -and |change_file|, the \PASCAL\ output goes to file |Pascal_file|, -and the string pool output goes to file |pool|. - -If it is necessary to abort the job because of a fatal error, the program -calls the `|jump_out|' procedure, which goes to the label |end_of_TANGLE|. - -@d end_of_TANGLE = 9999 {go here to wrap it up} - -@p @t\4@>@<Compiler directives@>@/ -program LUATANGLE(@!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@>@/ -@<Error handling procedures@>@/ -procedure initialize; - var @<Local variables for initialization@>@/ - begin @<Set initial values@>@/ - end; - -@ Some of this code is optional for use when debugging only; -such material is enclosed between the delimiters |debug| and $|gubed|$. -Other parts, delimited by |stat| and $|tats|$, are optionally included if -statistics about \.{TANGLE}'s memory usage are desired. - -@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} -@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} -@f debug==begin -@f gubed==end -@# -@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} -@f stat==begin -@f tats==end - -@ The \PASCAL\ compiler used to develop this system has ``compiler -directives'' that can appear in comments whose first character is a dollar sign. -In production versions of \.{TANGLE} these directives tell the compiler that -@^system dependencies@> -it is safe to avoid range checks and to leave out the extra code it inserts -for the \PASCAL\ debugger's benefit, although interrupts will occur if -there is arithmetic overflow. - -@<Compiler directives@>= -@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} -@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} - -@ Labels are given symbolic names by the following definitions. We insert -the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a -procedure in which we have used the `|return|' statement defined below; -the label `|restart|' is occasionally used at the very beginning of a -procedure; and the label `|reswitch|' is occasionally used just prior to -a \&{case} statement in which some cases change the conditions and we wish to -branch to the newly applicable case. -Loops that are set up with the \&{loop} construction defined below are -commonly exited by going to `|done|' or to `|found|' or to `|not_found|', -and they are sometimes repeated by going to `|continue|'. - -@d exit=10 {go here to leave a procedure} -@d restart=20 {go here to start a procedure again} -@d reswitch=21 {go here to start a case statement again} -@d continue=22 {go here to resume a loop} -@d done=30 {go here to exit a loop} -@d found=31 {go here when you've found it} -@d not_found=32 {go here when you've found something else} - -@ Here are some macros for common programming idioms. - -@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 - -@ We assume that |case| statements may include a default case that applies -if no matching label is found. Thus, we shall use constructions like -@^system dependencies@> -$$\vbox{\halign{#\hfil\cr -|case x of|\cr -1: $\langle\,$code for $x=1\,\rangle$;\cr -3: $\langle\,$code for $x=3\,\rangle$;\cr -|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr -|endcases|\cr}}$$ -since most \PASCAL\ compilers have plugged this hole in the language by -incorporating some sort of default mechanism. For example, the compiler -used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label, -and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or -`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases| -and |endcases| should be changed to agree with local conventions. (Of -course, if no default mechanism is available, the |case| statements of -this program must be extended by listing all remaining cases. The author -would have taken the trouble to modify \.{TANGLE} so that such extensions -were done automatically, if he had not wanted to encourage \PASCAL\ -compiler writers to make this important change in \PASCAL, where it belongs.) - -@d othercases == others: {default for cases not listed explicitly} -@d endcases == @+end {follows the default case in an extended |case| statement} -@f othercases == else -@f endcases == end - -@ The following parameters are set big enough to handle \TeX, so they -should be sufficient for most applications of \.{TANGLE}. - -@<Constants...@>= -@!buf_size=100; {maximum length of input line} -@!max_bytes=65535; {|1/ww| times the number of bytes in identifiers, - strings, and module names; must be less than 65536} -@!max_toks=65535; {|1/zz| times the number of bytes in compressed \PASCAL\ code; - must be less than 65536} -@!max_names=10239; {number of identifiers, strings, module names; - must be less than 10240} -@!max_texts=10239; {number of replacement texts, must be less than 10240} -@!hash_size=353; {should be prime} -@!longest_name=400; {module names shouldn't be longer than this} -@!line_length=72; {lines of \PASCAL\ output have at most this many characters} -@!out_buf_size=144; {length of output buffer, should be twice |line_length|} -@!stack_size=50; {number of simultaneous levels of macro expansion} -@!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} - -@ A global variable called |history| will contain one of four values -at the end of every run: |spotless| means that no unusual messages were -printed; |harmless_message| means that a message of possible interest -was printed but no serious errors were detected; |error_message| means that -at least one error was found; |fatal_message| means that the program -terminated abnormally. The value of |history| does not influence the -behavior of the program; it is simply computed for the convenience -of systems that might want to use such information. - -@d spotless=0 {|history| value for normal jobs} -@d harmless_message=1 {|history| value when non-serious info was printed} -@d error_message=2 {|history| value when an error was noted} -@d fatal_message=3 {|history| value when we had to stop prematurely} -@# -@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message -@d mark_error==history:=error_message -@d mark_fatal==history:=fatal_message -@d biggest_char=2097151 -@d number_chars=2097152 - -@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?} - -@ @<Set init...@>=history:=spotless; - -@* The character set. -One of the main goals in the design of \.{WEB} has been to make it readily -portable between a wide variety of computers. Yet \.{WEB} by its very -nature must use a greater variety of characters than most computer -programs deal with, and character encoding is one of the areas in which -existing machines differ most widely from each other. - -To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is converted -to an internal eight-bit code that is essentially standard ASCII, the ``American -Standard Code for Information Interchange.'' The conversion is done -immediately when each character is read in. Conversely, characters are -converted from ASCII to the user's external representation just before -they are output. (The original ASCII code was seven bits only; \.{WEB} now -allows eight bits in an attempt to keep up with modern times.) - -Such an internal code is relevant to users of \.{WEB} only because it is -the code used for preprocessed constants like \.{"A"}. If you are writing -a program in \.{WEB} that makes use of such one-character constants, you -should convert your input to ASCII form, like \.{WEAVE} and \.{TANGLE} do. -Otherwise \.{WEB}'s internal coding scheme does not affect you. -@^ASCII code@> - -Here is a table of the standard visible ASCII codes: -$$\def\:{\char\count255\global\advance\count255 by 1} -\count255='40 -\vbox{ -\hbox{\hbox to 40pt{\it\hfill0\/\hfill}% -\hbox to 40pt{\it\hfill1\/\hfill}% -\hbox to 40pt{\it\hfill2\/\hfill}% -\hbox to 40pt{\it\hfill3\/\hfill}% -\hbox to 40pt{\it\hfill4\/\hfill}% -\hbox to 40pt{\it\hfill5\/\hfill}% -\hbox to 40pt{\it\hfill6\/\hfill}% -\hbox to 40pt{\it\hfill7\/\hfill}} -\vskip 4pt -\hrule -\def\^{\vrule height 10.5pt depth 4.5pt} -\halign{\hbox to 0pt{\hskip -24pt\O{#0}\hfill}&\^ -\hbox to 40pt{\tt\hfill#\hfill\^}& -&\hbox to 40pt{\tt\hfill#\hfill\^}\cr -04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule} -17&\:&\:&\:&\:&\:&\:&\:\cr} -\hrule width 280pt}$$ -(Actually, of course, code @'040 is an invisible blank space.) Code @'136 -was once an upward arrow (\.{\char'13}), and code @'137 was -once a left arrow (\.^^X), in olden times when the first draft -of ASCII code was prepared; but \.{WEB} works with today's standard -ASCII in which those codes represent circumflex and underline as shown. - -@<Types...@>= -@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers} - -@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit -character sets were common, so it did not make provision for lowercase -letters. Nowadays, of course, we need to deal with both capital and small -letters in a convenient way, so \.{WEB} assumes that it is being used -with a \PASCAL\ whose character set contains at least the characters of -standard ASCII as listed above. Some \PASCAL\ compilers use the original -name |char| for the data type associated with the characters in text files, -while other \PASCAL s consider |char| to be a 64-element subrange of a larger -data type that has some other name. - -In order to accommodate this difference, we shall use the name |text_char| -to stand for the data type of the characters in the input and output -files. We shall also assume that |text_char| consists of the elements -|chr(first_text_char)| through |chr(last_text_char)|, inclusive. The -following definitions should be adjusted if necessary. -@^system dependencies@> - -@d text_char == char {the data type of characters in text files} -@d first_text_char=0 {ordinal number of the smallest element of |text_char|} -@d last_text_char=255 {ordinal number of the largest element of |text_char|} - -@<Types...@>= -@!text_file=packed file of text_char; - -@ 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} - -@ Some of the ASCII codes below @'40 have been given symbolic names in -\.{WEAVE} and \.{TANGLE} because they are used with a special meaning. - -@d and_sign=@'4 {equivalent to `\.{and}'} -@d not_sign=@'5 {equivalent to `\.{not}'} -@d set_element_sign=@'6 {equivalent to `\.{in}'} -@d tab_mark=@'11 {ASCII code used as tab-skip} -@d line_feed=@'12 {ASCII code thrown away at end of line} -@d form_feed=@'14 {ASCII code used at end of page} -@d carriage_return=@'15 {ASCII code used at end of line} -@d left_arrow=@'30 {equivalent to `\.{:=}'} -@d not_equal=@'32 {equivalent to `\.{<>}'} -@d less_or_equal=@'34 {equivalent to `\.{<=}'} -@d greater_or_equal=@'35 {equivalent to `\.{>=}'} -@d equivalence_sign=@'36 {equivalent to `\.{==}'} -@d or_sign=@'37 {equivalent to `\.{or}'} - -@ 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[' ']:=" "; - -@* Input and output. -The input conventions of this program are intended to be very much like those -of \TeX\ (except, of course, that they are much simpler, because much less -needs to be done). Furthermore they are identical to those of \.{WEAVE}. -Therefore people who need to make modifications to all three systems -should be able to do so without too many headaches. - -We use the standard \PASCAL\ input/output procedures in several places that -\TeX\ cannot, since \.{TANGLE} does not have to deal with files that are named -dynamically by the user, and since there is no input from the terminal. - -@ Terminal output is done by writing on file |term_out|, which is assumed to -consist of characters of type |text_char|: -@^system dependencies@> - -@d print(#)==write(term_out,#) {`|print|' means write on the terminal} -@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line} -@d new_line==write_ln(term_out) {start new line} -@d print_nl(#)== {print information starting on a new line} - begin new_line; print(#); - end - -@<Globals...@>= -@!term_out:text_file; {the terminal as an output file} - -@ Different systems have different ways of specifying that the output on a -certain file will appear on the user's terminal. Here is one way to do this -on the \PASCAL\ system that was used in \.{TANGLE}'s initial development: -@^system dependencies@> - -@<Set init...@>= -rewrite(term_out,'TTY:'); {send |term_out| output to the terminal} - -@ The |update_terminal| procedure is called when we want -to make sure that everything we have output to the terminal so far has -actually left the computer's internal buffers and been sent. -@^system dependencies@> - -@d update_terminal == break(term_out) {empty the terminal output buffer} - -@ 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} - -@ 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; - -@ The main output goes to |Pascal_file|, and string pool constants are -written to the |pool| file. - -@<Globals...@>= -@!Pascal_file: text_file; -@!pool: text_file; - -@ The following code opens |Pascal_file| and |pool|. -Since these files were listed in the program header, we assume that the -\PASCAL\ runtime system has checked that suitable external file names have -been given. -@^system dependencies@> - -@<Set init...@>= -rewrite(Pascal_file); rewrite(pool); - -@ Input goes into an array called |buffer|. - -@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code; - -@ The |input_ln| procedure brings the next line of input from the specified -file into the |buffer| array and returns the value |true|, unless the file has -already been entirely read, in which case it returns |false|. The conventions -of \TeX\ are followed; i.e., |ASCII_code| numbers representing the next line -of the file are input into |buffer[0]|, |buffer[1]|, \dots, -|buffer[limit-1]|; trailing blanks are ignored; -and the global variable |limit| is set to the length of the -@^system dependencies@> -line. The value of |limit| must be strictly less than |buf_size|. - -We assume that none of the |ASCII_code| values -of |buffer[j]| for |0<=j<limit| is equal to 0, @'177, |line_feed|, |form_feed|, -or |carriage_return|. - -@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; - -@* Reporting errors to the user. -The \.{TANGLE} processor operates in two phases: first it inputs the source -file and stores a compressed representation of the program, then it produces -the \PASCAL\ output from the compressed representation. - -The global variable |phase_one| tells whether we are in Phase I or not. - -@<Globals...@>= -@!phase_one: boolean; {|true| in Phase I, |false| in Phase II} - -@ If an error is detected while we are debugging, -we usually want to look at the contents of memory. -A special procedure will be declared later for this purpose. - -@<Error handling...@>= -@!debug @+ procedure debug_help; forward;@+ gubed - -@ During the first phase, syntax errors are reported to the user by saying -$$\hbox{`|err_print('! Error message')|'},$$ -followed by `|jump_out|' if no recovery from the error is provided. -This will print the error message followed by an indication of where the error -was spotted in the source file. Note that no period follows the error message, -since the error routine will automatically supply a period. - -Errors that are noticed during the second phase are reported to the user -in the same fashion, but the error message will be -followed by an indication of where the error was spotted in the output file. - -The actual error indications are provided by a procedure called |error|. - -@d err_print(#)==begin new_line; print(#); error; - end - -@<Error handling...@>= -procedure error; {prints '\..' and location of error message} -var j: 0..out_buf_size; {index into |out_buf|} -@!k,@!l: 0..buf_size; {indices into |buffer|} -begin if phase_one then @<Print error location based on input buffer@> -else @<Print error location based on output buffer@>; -update_terminal; mark_error; -@!debug debug_skipped:=debug_cycle; debug_help;@+gubed -end; - -@ The error locations during Phase I can be indicated by using the global -variables |loc|, |line|, and |changing|, which tell respectively the first -unlooked-at position in |buffer|, the current line number, and whether or not -the current line is from |change_file| or |web_file|. -This routine should be modified on systems whose standard text editor -has special line-numbering conventions. -@^system dependencies@> - -@<Print error location based on input buffer@>= -begin if changing then print('. (change file ')@+else print('. ('); -print_ln('l.', line:1, ')'); -if loc>=limit then l:=limit else l:=loc; -for k:=1 to l do - if buffer[k-1]=tab_mark then print(' ') - else print(xchr[buffer[k-1]]); {print the characters already read} -new_line; -for k:=1 to l do print(' '); {space out the next line} -for k:=l+1 to limit do print(xchr[buffer[k-1]]); {print the part not yet read} -print(' '); {this space separates the message from future asterisks} -end - -@ The position of errors detected during the second phase can be indicated -by outputting the partially-filled output buffer, which contains |out_ptr| -entries. - -@<Print error location based on output...@>= -begin print_ln('. (l.',line:1,')'); -for j:=1 to out_ptr do print(xchr[out_buf[j-1]]); {print current partial line} -print('... '); {indicate that this information is partial} -end - -@ The |jump_out| procedure just cuts across all active procedure levels -and jumps out of the program. This is the only non-local |goto| statement -in \.{TANGLE}. It is used when no recovery from a particular error has -been provided. - -Some \PASCAL\ compilers do not implement non-local |goto| statements. -@^system dependencies@> -In such cases the code that appears at label |end_of_TANGLE| should be -copied into the |jump_out| procedure, followed by a call to a system procedure -that terminates the program. - -@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out; - end - -@<Error handling...@>= -procedure jump_out; -begin goto end_of_TANGLE; -end; - -@ Sometimes the program's behavior is far different from what it should be, -and \.{TANGLE} prints an error message that is really for the \.{TANGLE} -maintenance person, not the user. In such cases the program says -|confusion('indication of where we are')|. - -@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@> - - -@* Data structures. -Most of the user's \PASCAL\ code is packed into eight-bit integers -in two large arrays called |byte_mem| and |tok_mem|. -The |byte_mem| array holds the names of identifiers, strings, and modules; -the |tok_mem| array holds the replacement texts -for macros and modules. Allocation is sequential, since things are deleted only -during Phase II, and only in a last-in-first-out manner. - -Auxiliary arrays |byte_start| and |tok_start| are used as directories to -|byte_mem| and |tok_mem|, and the |link|, |ilk|, |equiv|, and |text_link| -arrays give further information about names. These auxiliary arrays -consist of sixteen-bit items. - -@<Types...@>= -@!eight_bits=0..255; {unsigned one-byte quantity} -@!sixteen_bits=integer; {not quite a two-byte quantity} - -@ \.{TANGLE} has been designed to avoid the need for indices that are more -than sixteen bits wide, so that it can be used on most computers. But -there are programs that need more than 65536 tokens, and some programs -even need more than 65536 bytes; \TeX\ is one of these. To get around -this problem, a slight complication has been added to the data structures: -|byte_mem| and |tok_mem| are two-dimensional arrays, whose first index is -either 0 or 1. (For generality, the first index is actually allowed to run -between 0 and |ww-1| in |byte_mem|, or between 0 and |zz-1| in |tok_mem|, -where |ww| and |zz| are set to 2 and~3; the program will work for any -positive values of |ww| and |zz|, and it can be simplified in obvious ways -if |ww=1| or |zz=1|.) - -@d ww=2 {we multiply the byte capacity by approximately this amount} -@d zz=3 {we multiply the token capacity by approximately this amount} - -@<Globals...@>= -@!byte_mem: packed array [0..ww-1,0..max_bytes] of ASCII_code; - {characters of names} -@!tok_mem: packed array [0..zz-1,0..max_toks] of eight_bits; {tokens} -@!byte_start: array [0..max_names] of sixteen_bits; {directory into |byte_mem|} -@!tok_start: array [0..max_texts] of sixteen_bits; {directory into |tok_mem|} -@!link: array [0..max_names] of sixteen_bits; {hash table or tree links} -@!ilk: array [0..max_names] of sixteen_bits; {type codes or tree links} -@!equiv: array [0..max_names] of sixteen_bits; {info corresponding to names} -@!text_link: array [0..max_texts] of sixteen_bits; {relates replacement texts} - -@ The names of identifiers are found by computing a hash address |h| and -then looking at strings of bytes signified by |hash[h]|, |link[hash[h]]|, -|link[link[hash[h]]]|, \dots, until either finding the desired name -or encountering a zero. - -A `|name_pointer|' variable, which signifies a name, is an index into -|byte_start|. The actual sequence of characters in the name pointed to by -|p| appears in positions |byte_start[p]| to |byte_start[p+ww]-1|, inclusive, -in the segment of |byte_mem| whose first index is |p mod ww|. Thus, when -|ww=2| the even-numbered name bytes appear in |byte_mem[0,@t$*$@>]| -and the odd-numbered ones appear in |byte_mem[1,@t$*$@>]|. -The pointer 0 is used for undefined module names; we don't -want to use it for the names of identifiers, since 0 stands for a null -pointer in a linked list. - -Strings are treated like identifiers; the first character (a double-quote) -distinguishes a string from an alphabetic name, but for \.{TANGLE}'s purposes -strings behave like numeric macros. (A `string' here refers to the -strings delimited by double-quotes that \.{TANGLE} processes. \PASCAL\ -string constants delimited by single-quote marks are not given such special -treatment; they simply appear as sequences of characters in the \PASCAL\ -texts.) The total number of strings in the string -pool is called |string_ptr|, and the total number of names in |byte_mem| -is called |name_ptr|. The total number of bytes occupied in -|byte_mem[w,@t$*$@>]| is called |byte_ptr[w]|. - -We usually have |byte_start[name_ptr+w]=byte_ptr[(name_ptr+w) mod ww]| -for |0<=w<ww|, since these are the starting positions for the next |ww| -names to be stored in |byte_mem|. - -@d length(#)==byte_start[#+ww]-byte_start[#] {the length of a name} - -@<Types...@>= -@!name_pointer=0..max_names; {identifies a name} - -@ @<Global...@>= -@!name_ptr:name_pointer; {first unused position in |byte_start|} -@!string_ptr:name_pointer; {next number to be given to a string of length |<>1|} -@!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} - -@ @<Local variables for init...@>= -@!wi: 0..ww-1; {to initialize the |byte_mem| indices} - -@ @<Set init...@>= -for wi:=0 to ww-1 do - begin byte_start[wi]:=0; byte_ptr[wi]:=0; - end; -byte_start[ww]:=0; {this makes name 0 of length zero} -name_ptr:=1; string_ptr:=number_chars; pool_check_sum:=271828; - -@ Replacement texts are stored in |tok_mem|, using similar conventions. -A `|text_pointer|' variable is an index into |tok_start|, and the -replacement text that corresponds to |p| runs from positions -|tok_start[p]| to |tok_start[p+zz]-1|, inclusive, in the segment of -|tok_mem| whose first index is |p mod zz|. Thus, when |zz=2| the -even-numbered replacement texts appear in |tok_mem[0,@t$*$@>]| and the -odd-numbered ones appear in |tok_mem[1,@t$*$@>]|. Furthermore, -|text_link[p]| is used to connect pieces of text that have the same name, -as we shall see later. The pointer 0 is used for undefined replacement -texts. - -The first position of |tok_mem[z,@t$*$@>]| that is unoccupied by -replacement text is called |tok_ptr[z]|, and the first unused location of -|tok_start| is called |text_ptr|. We usually have the identity -|tok_start[text_ptr+z]=tok_ptr[(text_ptr+z) mod zz]|, for |0<=z<zz|, since -these are the starting positions for the next |zz| replacement texts to -be stored in |tok_mem|. - -@<Types...@>= -@!text_pointer=0..max_texts; {identifies a replacement text} - -@ It is convenient to maintain a variable |z| that is equal to |text_ptr -mod zz|, so that we always insert tokens into segment |z| of |tok_mem|. - -@<Glob...@>= -@t\hskip1em@>@!text_ptr:text_pointer; {first unused position in |tok_start|} -@t\hskip1em@>@!tok_ptr:array[0..zz-1] of 0..max_toks; - {first unused position in a given segment of |tok_mem|} -@t\hskip1em@>@!z:0..zz-1; {current segment of |tok_mem|} -stat @!max_tok_ptr:array[0..zz-1] of 0..max_toks; - {largest values assumed by |tok_ptr|} -tats - -@ @<Local variables for init...@>= -@!zi:0..zz-1; {to initialize the |tok_mem| indices} - -@ @<Set init...@>= -for zi:=0 to zz-1 do - begin tok_start[zi]:=0; tok_ptr[zi]:=0; - end; -tok_start[zz]:=0; {this makes replacement text 0 of length zero} -text_ptr:=1; z:=1 mod zz; - -@ Four types of identifiers are distinguished by their |ilk|: - -\yskip\hang |normal| identifiers will appear in the \PASCAL\ program as -ordinary identifiers since they have not been defined to be macros; the -corresponding value in the |equiv| array -for such identifiers is a link in a secondary hash table that -is used to check whether any two of them agree in their first |unambig_length| -characters after underline symbols are removed and lowercase letters are -changed to uppercase. - -\yskip\hang |numeric| identifiers have been defined to be numeric macros; -their |equiv| value contains the corresponding numeric value plus $2^{15}$. -Strings are treated as numeric macros. - -\yskip\hang |simple| identifiers have been defined to be simple macros; -their |equiv| value points to the corresponding replacement text. - -\yskip\hang |parametric| identifiers have been defined to be parametric macros; -like simple identifiers, their |equiv| value points to the replacement text. - -@d normal=0 {ordinary identifiers have |normal| ilk} -@d numeric=1 {numeric macros and strings have |numeric| ilk} -@d simple=2 {simple macros have |simple| ilk} -@d parametric=3 {parametric macros have |parametric| ilk} - -@ The names of modules are stored in |byte_mem| together -with the identifier names, but a hash table is not used for them because -\.{TANGLE} needs to be able to recognize a module name when given a prefix of -that name. A conventional binary seach tree is used to retrieve module names, -with fields called |llink| and |rlink| in place of |link| and |ilk|. The -root of this tree is |rlink[0]|. If |p| is a pointer to a module name, -|equiv[p]| points to its replacement text, just as in simple and parametric -macros, unless this replacement text has not yet been defined (in which case -|equiv[p]=0|). - -@d llink==link {left link in binary search tree for module names} -@d rlink==ilk {right link in binary search tree for module names} - -@<Set init...@>= -rlink[0]:=0; {the binary search tree starts out with nothing in it} -equiv[0]:=0; {the undefined module has no replacement text} - -@ Here is a little procedure that prints the text of a given name. - -@p procedure print_id(@!p:name_pointer); {print identifier or module name} -var k:0..max_bytes; {index into |byte_mem|} -@!w:0..ww-1; {segment of |byte_mem|} -begin if p>=name_ptr then print('IMPOSSIBLE') -else begin w:=p mod ww; - for k:=byte_start[p] to byte_start[p+ww]-1 do print(xchr[byte_mem[w,k]]); - end; -end; - -@* Searching for identifiers. -The hash table described above is updated by the |id_lookup| procedure, -which finds a given identifier and returns a pointer to its index in -|byte_start|. If the identifier was not already present, it is inserted with -a given |ilk| code; and an error message is printed if the identifier is being -doubly defined. - -Because of the way \.{TANGLE}'s scanning mechanism works, it is most convenient -to let |id_lookup| search for an identifier that is present in the |buffer| -array. Two other global variables specify its position in the buffer: the -first character is |buffer[id_first]|, and the last is |buffer[id_loc-1]|. -Furthermore, if the identifier is really a string, the global variable -|double_chars| tells how many of the characters in the buffer appear -twice (namely \.{@@@@} and \.{""}), since this additional information makes -it easy to calculate the true length of the string. The final double-quote -of the string is not included in its ``identifier,'' but the first one is, -so the string length is |id_loc-id_first-double_chars-1|. - -We have mentioned that |normal| identifiers belong to two hash tables, -one for their true names as they appear in the \.{WEB} file and the other -when they have been reduced to their first |unambig_length| characters. -The hash tables are kept by the method of simple chaining, where the -heads of the individual lists appear in the |hash| and |chop_hash| arrays. -If |h| is a hash code, the primary hash table list starts at |hash[h]| and -proceeds through |link| pointers; the secondary hash table list starts at -|chop_hash[h]| and proceeds through |equiv| pointers. Of course, the same -identifier will probably have two different values of |h|. - -The |id_lookup| procedure uses an auxiliary array called |chopped_id| to -contain up to |unambig_length| characters of the current identifier, if -it is necessary to compute the secondary hash code. (This array could be -declared local to |id_lookup|, but in general we are making all array -declarations global in this program, because some compilers and some machine -architectures make dynamic array allocation inefficient.) - -@<Glob...@>= -@!id_first:0..buf_size; {where the current identifier begins in the buffer} -@!id_loc:0..buf_size; {just after the current identifier in the buffer} -@!double_chars:0..buf_size; {correction to length in case of strings} -@# -@!hash,@!chop_hash:array [0..hash_size] of sixteen_bits; {heads of hash lists} -@!chopped_id:array [0..unambig_length] of ASCII_code; {chopped identifier} - -@ Initially all the hash lists are empty. - -@<Local variables for init...@>= -@!h:0..hash_size; {index into hash-head arrays} - -@ @<Set init...@>= -for h:=0 to hash_size-1 do - begin hash[h]:=0; chop_hash[h]:=0; - end; - -@ Here now is the main procedure for finding identifiers (and strings). -The parameter |t| is set to |normal| except when the identifier is -a macro name that is just being defined; in the latter case, |t| will be -|numeric|, |simple|, or |parametric|. - -@p function id_lookup(@!t:eight_bits):name_pointer; {finds current identifier} -label found, not_found; -var c:eight_bits; {byte being chopped} -@!i:0..buf_size; {index into |buffer|} -@!h:0..hash_size; {hash code} -@!k:0..max_bytes; {index into |byte_mem|} -@!w:0..ww-1; {segment of |byte_mem|} -@!l:0..buf_size; {length of the given identifier} -@!p,@!q:name_pointer; {where the identifier is being sought} -@!s:0..unambig_length; {index into |chopped_id|} -begin l:=id_loc-id_first; {compute the length} -@<Compute the hash code |h|@>; -@<Compute the name location |p|@>; -if (p=name_ptr)or(t<>normal) then - @<Update the tables and check for possible errors@>; -id_lookup:=p; -end; - -@ A simple hash code is used: If the sequence of -ASCII codes is $c_1c_2\ldots c_m$, its hash value will be -$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$ - -@<Compute the hash...@>= -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 - -@ If the identifier is new, it will be placed in position |p=name_ptr|, -otherwise |p| will point to its existing location. - -@<Compute the name location...@>= -p:=hash[h]; -while p<>0 do - begin if length(p)=l then - @<Compare name |p| with current identifier, |goto found| if equal@>; - p:=link[p]; - end; -p:=name_ptr; {the current identifier is new} -link[p]:=hash[h]; hash[h]:=p; {insert |p| at beginning of hash list} -found: - -@ @<Compare name |p|...@>= -begin i:=id_first; k:=byte_start[p]; w:=p mod ww; -while (i<id_loc)and(buffer[i]=byte_mem[w,k]) do - begin incr(i); incr(k); - end; -if i=id_loc then goto found; {all characters agree} -end - -@ @<Update the tables...@>= -begin if ((p<>name_ptr)and(t<>normal)and(ilk[p]=normal)) or - ((p=name_ptr)and(t=normal)and(buffer[id_first]<>"""")) then - @<Compute the secondary hash code |h| and put the first characters - into the auxiliary array |chopped_id|@>; -if p<>name_ptr then - @<Give double-definition error, if necessary, and change |p| to type |t|@> -else @<Enter a new identifier into the table at position |p|@>; -end - -@ The following routine, which is called into play when it is necessary to -look at the secondary hash table, computes the same hash function as before -(but on the chopped data), and places a zero after the chopped identifier -in |chopped_id| to serve as a convenient sentinel. - -@<Compute the secondary...@>= -begin i:=id_first; s:=0; h:=0; -while (i<id_loc)and(s<unambig_length) do - 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); - end; -chopped_id[s]:=0; -end - -@ If a nonnumeric macro has appeared before it was defined, \.{TANGLE} -will still work all right; after all, such behavior is typical of the -replacement texts for modules, which act very much like macros. -However, an undefined numeric macro may not be used on the right-hand -side of another numeric macro definition, so \.{TANGLE} finds it -simplest to make a blanket rule that numeric macros should be defined -before they are used. The following routine gives an error message and -also fixes up any damage that may have been caused. - -@<Give double...@>= {now |p<>name_ptr| and |t<>normal|} -begin if ilk[p]=normal then - begin if t=numeric then err_print('! This identifier has already appeared'); -@.This identifier has already...@> - @<Remove |p| from secondary hash table@>; - end -else err_print('! This identifier was defined before'); -@.This identifier was defined...@> -ilk[p]:=t; -end - -@ When we have to remove a secondary hash entry, because a |normal| identifier -is changing to another |ilk|, the hash code |h| and chopped identifier have -already been computed. - -@<Remove |p| from secondary...@>= -q:=chop_hash[h]; -if q=p then chop_hash[h]:=equiv[p] -else begin while equiv[q]<>p do q:=equiv[q]; - equiv[q]:=equiv[p]; - end - -@ The following routine could make good use of a generalized |pack| procedure -that puts items into just part of a packed array instead of the whole thing. - -@<Enter a new identifier...@>= -begin if (t=normal)and(buffer[id_first]<>"""") then - @<Check for ambiguity and update secondary hash@>; -w:=name_ptr mod ww; k:=byte_ptr[w]; -if k+l>max_bytes then overflow('byte memory'); -if name_ptr>max_names-ww then overflow('name'); -i:=id_first; {get ready to move the identifier into |byte_mem|} -while i<id_loc do - begin byte_mem[w,k]:=buffer[i]; incr(k); incr(i); - end; -byte_ptr[w]:=k; byte_start[name_ptr+ww]:=k; incr(name_ptr); -if buffer[id_first]<>"""" then ilk[p]:=t -else @<Define and output a new string of the pool@>; -end - -@ @<Check for ambig...@>= -begin q:=chop_hash[h]; -while q<>0 do - begin @<Check if |q| conflicts with |p|@>; - q:=equiv[q]; - end; -equiv[p]:=chop_hash[h]; chop_hash[h]:=p; {put |p| at front of secondary list} -end - -@ @<Check if |q| conflicts...@>= -begin k:=byte_start[q]; s:=0; w:=q mod ww; -while (k<byte_start[q+ww]) and (s<unambig_length) do - begin c:=byte_mem[w,k]; - 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; - incr(k); - end; -if (k=byte_start[q+ww])and(chopped_id[s]<>0) then goto not_found; -print_nl('! Identifier conflict with '); -@.Identifier conflict...@> -for k:=byte_start[q] to byte_start[q+ww]-1 do print(xchr[byte_mem[w,k]]); -error; q:=0; {only one conflict will be printed, since |equiv[0]=0|} -not_found: -end - -@ We compute the string pool check sum by working modulo a prime number -that is large but not so large that overflow might occur. - -@d check_sum_prime==@'3777777667 {$2^{29}-73$} -@^preprocessed strings@> - -@<Define and output a new string...@>= -begin ilk[p]:=numeric; {strings are like numeric macros} -if l-double_chars=2 then {this string is for a single character} - equiv[p]:=buffer[id_first+1]+1073741824 -else begin equiv[p]:=string_ptr+1073741824; - l:=l-double_chars-1; - if l>99 then err_print('! Preprocessed string is too long'); -@.Preprocessed string is too long@> - incr(string_ptr); - write(pool,xchr["0"+l div 10],xchr["0"+l mod 10]); {output the length} - pool_check_sum:=pool_check_sum+pool_check_sum+l; - while pool_check_sum>check_sum_prime do - pool_check_sum:=pool_check_sum-check_sum_prime; - i:=id_first+1; - while i<id_loc do - begin write(pool,xchr[buffer[i]]); {output characters of string} - pool_check_sum:=pool_check_sum+pool_check_sum+buffer[i]; - while pool_check_sum>check_sum_prime do - pool_check_sum:=pool_check_sum-check_sum_prime; - if (buffer[i]="""") or (buffer[i]="@@") then - i:=i+2 {omit second appearance of doubled character} - else incr(i); - end; - write_ln(pool); - end; -end - -@* Searching for module names. -The |mod_lookup| procedure finds the module name |mod_text[1..l]| in the -search tree, after inserting it if necessary, and returns a pointer to -where it was found. - -@<Glob...@>= -@!mod_text:array [0..longest_name] of ASCII_code; {name being sought for} - -@ According to the rules of \.{WEB}, no module name -should be a proper prefix of another, so a ``clean'' comparison should -occur between any two names. The result of |mod_lookup| is 0 if this -prefix condition is violated. An error message is printed when such violations -are detected during phase two of \.{WEAVE}. - -@d less=0 {the first name is lexicographically less than the second} -@d equal=1 {the first name is equal to the second} -@d greater=2 {the first name is lexicographically greater than the second} -@d prefix=3 {the first name is a proper prefix of the second} -@d extension=4 {the first name is a proper extension of the second} - -@p function mod_lookup(@!l:sixteen_bits):name_pointer; {finds module name} -label found; -var c:less..extension; {comparison between two names} -@!j:0..longest_name; {index into |mod_text|} -@!k:0..max_bytes; {index into |byte_mem|} -@!w:0..ww-1; {segment of |byte_mem|} -@!p:name_pointer; {current node of the search tree} -@!q:name_pointer; {father of node |p|} -begin c:=greater; q:=0; p:=rlink[0]; {|rlink[0]| is the root of the tree} -while p<>0 do - begin @<Set \(|c| to the result of comparing the given name to - name |p|@>; - q:=p; - if c=less then p:=llink[q] - else if c=greater then p:=rlink[q] - else goto found; - end; -@<Enter a new module name into the tree@>; -found: if c<>equal then - begin err_print('! Incompatible section names'); p:=0; -@.Incompatible module names@> - end; -mod_lookup:=p; -end; - -@ @<Enter a new module name...@>= -w:=name_ptr mod ww; k:=byte_ptr[w]; -if k+l>max_bytes then overflow('byte memory'); -if name_ptr>max_names-ww then overflow('name'); -p:=name_ptr; -if c=less then llink[q]:=p else rlink[q]:=p; -llink[p]:=0; rlink[p]:=0; c:=equal; equiv[p]:=0; -for j:=1 to l do byte_mem[w,k+j-1]:=mod_text[j]; -byte_ptr[w]:=k+l; byte_start[name_ptr+ww]:=k+l; incr(name_ptr); - -@ @<Set \(|c|...@>= -begin k:=byte_start[p]; w:=p mod ww; c:=equal; j:=1; -while (k<byte_start[p+ww]) and (j<=l) and (mod_text[j]=byte_mem[w,k]) do - begin incr(k); incr(j); - end; -if k=byte_start[p+ww] then - if j>l then c:=equal - else c:=extension -else if j>l then c:=prefix -else if mod_text[j]<byte_mem[w,k] then c:=less -else c:=greater; -end - -@ The |prefix_lookup| procedure is supposed to find exactly one module -name that has |mod_text[1..l]| as a prefix. Actually the algorithm silently -accepts also the situation that some module name is a prefix of -|mod_text[1..l]|, because the user who painstakingly typed in more than -necessary probably doesn't want to be told about the wasted effort. - -@p function prefix_lookup(@!l:sixteen_bits):name_pointer; {finds name extension} -var c:less..extension; {comparison between two names} -@!count:0..max_names; {the number of hits} -@!j:0..longest_name; {index into |mod_text|} -@!k:0..max_bytes; {index into |byte_mem|} -@!w:0..ww-1; {segment of |byte_mem|} -@!p:name_pointer; {current node of the search tree} -@!q:name_pointer; {another place to resume the search after one branch is done} -@!r:name_pointer; {extension found} -begin q:=0; p:=rlink[0]; count:=0; r:=0; {begin search at root of tree} -while p<>0 do - begin @<Set \(|c|...@>; - if c=less then p:=llink[p] - else if c=greater then p:=rlink[p] - else begin r:=p; incr(count); q:=rlink[p]; p:=llink[p]; - end; - if p=0 then - begin p:=q; q:=0; - end; - end; -if count<>1 then - if count=0 then err_print('! Name does not match') -@.Name does not match@> - else err_print('! Ambiguous prefix'); -@.Ambiguous prefix@> -prefix_lookup:=r; {the result will be 0 if there was no match} -end; - -@* Tokens. -Replacement texts, which represent \PASCAL\ code in a compressed format, -appear in |tok_mem| as mentioned above. The codes in -these texts are called `tokens'; some tokens occupy two consecutive -eight-bit byte positions, and the others take just one byte. - -If $p>0$ points to a replacement text, |tok_start[p]| is the |tok_mem| position -of the first eight-bit code of that text. If |text_link[p]=0|, -this is the replacement text for a macro, otherwise it is the replacement -text for a module. In the latter case |text_link[p]| is either equal to -|module_flag|, which means that there is no further text for this module, or -|text_link[p]| points to a -continuation of this replacement text; such links are created when -several modules have \PASCAL\ texts with the same name, and they also -tie together all the \PASCAL\ texts of unnamed modules. -The replacement text pointer for the first unnamed module -appears in |text_link[0]|, and the most recent such pointer is |last_unnamed|. - -@d module_flag==max_texts {final |text_link| in module replacement texts} - -@<Glob...@>= -@!last_unnamed:text_pointer; {most recent replacement text of unnamed module} - -@ @<Set init...@>= last_unnamed:=0; text_link[0]:=0; - -@ If the first byte of a token is less than @'200, the token occupies a -single byte. Otherwise we make a sixteen-bit token by combining two consecutive -bytes |a| and |b|. If |@'200<=a<@'250|, then $(a-@'200)\times2^8+b$ points -to an identifier; if |@'250<=a<@'320|, then -$(a-@'250)\times2^8+b$ points to a module name; otherwise, i.e., if -|@'320<=a<@'400|, then $(a-@'320)\times2^8+b$ is the number of the module -in which the current replacement text appears. - -Codes less than @'200 are 7-bit ASCII codes that represent themselves. -In particular, a single-character identifier like `|x|' will be a one-byte -token, while all longer identifiers will occupy two bytes. - -Some of the 7-bit ASCII codes will not be present, however, so we can -use them for special purposes. The following symbolic names are used: - -\yskip\hang |param| denotes insertion of a parameter. This occurs only in -the replacement texts of parametric macros, outside of single-quoted strings -in those texts. - -\hang |begin_comment| denotes \.{@@\{}, which will become either -\.{\{} or \.{[}. - -\hang |end_comment| denotes \.{@@\}}, which will become either -\.{\}} or \.{]}. - -\hang |octal| denotes the \.{@@\'} that precedes an octal constant. - -\hang |hex| denotes the \.{@@"} that precedes a hexadecimal constant. - -\hang |check_sum| denotes the \.{@@\char'44} that denotes the string pool -check sum. - -\hang |join| denotes the concatenation of adjacent items with no -space or line breaks allowed between them (the \.{@@\&} operation of \.{WEB}). - -\hang |double_dot| denotes `\.{..}' in \PASCAL. - -\hang |verbatim| denotes the \.{@@=} that begins a verbatim \PASCAL\ string. -It is also used for the end of the string. - -\hang |force_line| denotes the \.{@@\\} that forces a new line in the -\PASCAL\ output. -@^ASCII code@> - -@d param=0 {ASCII null code will not appear} -@d verbatim=@'2 {extended ASCII alpha should not appear} -@d force_line=@'3 {extended ASCII beta should not appear} -@d begin_comment=@'11 {ASCII tab mark will not appear} -@d end_comment=@'12 {ASCII line feed will not appear} -@d octal=@'14 {ASCII form feed will not appear} -@d hex=@'15 {ASCII carriage return will not appear} -@d double_dot=@'40 {ASCII space will not appear except in strings} -@d check_sum=@'175 {will not be confused with right brace} -@d join=@'177 {ASCII delete will not appear} - -@ The following procedure is used to enter a two-byte value into -|tok_mem| when a replacement text is being generated. - -@p procedure store_two_bytes(@!x:sixteen_bits); - {stores high byte, then low byte} -begin if tok_ptr[z]+2>max_toks then overflow('token'); -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} -tok_ptr[z]:=tok_ptr[z]+2; -end; - -@ When \.{TANGLE} is being operated in debug mode, it has a procedure to display -a replacement text in symbolic form. This procedure has not been spruced up to -generate a real great format, but at least the results are not as bad as -a memory dump. - -@p @!debug procedure print_repl(@!p:text_pointer); -var k:0..max_toks; {index into |tok_mem|} -@!a: sixteen_bits; {current byte(s)} -@!zp: 0..zz-1; {segment of |tok_mem| being accessed} -begin if p>=text_ptr then print('BAD') -else begin k:=tok_start[p]; zp:=p mod zz; - while k<tok_start[p+zz] do - begin a:=tok_mem[zp,k]; - if a>=@'200 then @<Display two-byte token starting with |a|@> - else @<Display one-byte token |a|@>; - incr(k); - end; - end; -end; -gubed - -@ @<Display two-byte...@>= -begin incr(k); -if a<@'250 then {identifier or string} - begin a:=(a-@'200)*@'400+tok_mem[zp,k]; print_id(a); - if byte_mem[a mod ww,byte_start[a]]="""" then print('"') - else print(' '); - end -else if a<@'320 then {module name} - begin print('@@<'); print_id((a-@'250)*@'400+tok_mem[zp,k]); - print('@@>'); - end -else begin a:=(a-@'320)*@'400+tok_mem[zp,k]; {module number} - print('@@',xchr["{"],a:1,'@@',xchr["}"]); {can't use right brace - between \&{debug} and \&{gubed}} - end; -end - -@ @<Display one-byte...@>= -case a of -begin_comment: print('@@',xchr["{"]); -end_comment: print('@@',xchr["}"]); {can't use right brace - between \&{debug} and \&{gubed}} -octal: print('@@'''); -hex: print('@@"'); -check_sum: print('@@$'); -param: print('#'); -"@@": print('@@@@'); -verbatim: print('@@='); -force_line: print('@@\'); -othercases print(xchr[a]) -endcases - -@* Stacks for output. -Let's make sure that our data structures contain enough information to -produce the entire \PASCAL\ program as desired, by working next on the -algorithms that actually do produce that program. - -@ The output process uses a stack to keep track of what is going on at -different ``levels'' as the macros are being expanded. -Entries on this stack have five parts: - -\yskip\hang |end_field| is the |tok_mem| location where the replacement -text of a particular level will end; - -\hang |byte_field| is the |tok_mem| location from which the next token -on a particular level will be read; - -\hang |name_field| points to the name corresponding to a particular level; - -\hang |repl_field| points to the replacement text currently being read -at a particular level; - -\hang |mod_field| is the module number, or zero if this is a macro. - -\yskip\noindent The current values of these five quantities are referred to -quite frequently, so they are stored in a separate place instead of in -the |stack| array. We call the current values |cur_end|, |cur_byte|, -|cur_name|, |cur_repl|, and |cur_mod|. - -The global variable |stack_ptr| tells how many levels of output are -currently in progress. The end of all output occurs when the stack is -empty, i.e., when |stack_ptr=0|. - -@<Types...@>= -@t\4@>@!output_state=record - @!end_field: sixteen_bits; {ending location of replacement text} - @!byte_field: sixteen_bits; {present location within replacement text} - @!name_field: name_pointer; {|byte_start| index for text being output} - @!repl_field: text_pointer; {|tok_start| index for text being output} - @!mod_field: 0..@'27777; {module number or zero if not a module} - end; - -@ @d cur_end==cur_state.end_field {current ending location in |tok_mem|} -@d cur_byte==cur_state.byte_field {location of next output byte in |tok_mem|} -@d cur_name==cur_state.name_field {pointer to current name being expanded} -@d cur_repl==cur_state.repl_field {pointer to current replacement text} -@d cur_mod==cur_state.mod_field {current module number being expanded} - -@<Globals...@>= -@!cur_state : output_state; {|cur_end|, |cur_byte|, |cur_name|, - |cur_repl|, |cur_mod|} -@!stack : array [1..stack_size] of output_state; {info for non-current levels} -@!stack_ptr: 0..stack_size; {first unused location in the output state stack} - -@ It is convenient to keep a global variable |zo| equal to |cur_repl mod zz|. - -@<Glob...@>= -@!zo:0..zz-1; {the segment of |tok_mem| from which output is coming} - -@ Parameters must also be stacked. They are placed in -|tok_mem| just above the other replacement texts, and dummy parameter -`names' are placed in |byte_start| just after the other names. -The variables |text_ptr| and |tok_ptr[z]| essentially serve as parameter -stack pointers during the output phase, so there is no need for a separate -data structure to handle this problem. - -@ There is an implicit stack corresponding to meta-comments that are output -via \.{@@\{} and \.{@@\}}. But this stack need not be represented in detail, -because we only need to know whether it is empty or not. A global variable -|brace_level| tells how many items would be on this stack if it were present. - -@<Globals...@>= -@!brace_level: eight_bits; {current depth of $\.{@@\{}\ldots\.{@@\}}$ nesting} - -@ To get the output process started, we will perform the following -initialization steps. We may assume that |text_link[0]| is nonzero, since it -points to the \PASCAL\ text in the first unnamed module that generates -code; if there are no such modules, there is nothing to output, and an -error message will have been generated before we do any of the initialization. - -@<Initialize the output stacks@>= -stack_ptr:=1; brace_level:=0; cur_name:=0; cur_repl:=text_link[0]; -zo:=cur_repl mod zz; cur_byte:=tok_start[cur_repl]; -cur_end:=tok_start[cur_repl+zz]; cur_mod:=0; - -@ When the replacement text for name |p| is to be inserted into the output, -the following subroutine is called to save the old level of output and get -the new one going. - -@p procedure push_level(@!p:name_pointer); {suspends the current level} -begin if stack_ptr=stack_size then overflow('stack') -else begin stack[stack_ptr]:=cur_state; {save |cur_end|, |cur_byte|, etc.} - incr(stack_ptr); - cur_name:=p; cur_repl:=equiv[p]; zo:=cur_repl mod zz; - cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz]; - cur_mod:=0; - end; -end; - -@ When we come to the end of a replacement text, the |pop_level| subroutine -does the right thing: It either moves to the continuation of this replacement -text or returns the state to the most recently stacked level. Part of this -subroutine, which updates the parameter stack, will be given later when we -study the parameter stack in more detail. - -@p procedure pop_level; {do this when |cur_byte| reaches |cur_end|} -label exit; -begin if text_link[cur_repl]=0 then {end of macro expansion} - begin if ilk[cur_name]=parametric then - @<Remove a parameter from the parameter stack@>; - end -else if text_link[cur_repl]<module_flag then {link to a continuation} - begin cur_repl:=text_link[cur_repl]; {we will stay on the same level} - zo:=cur_repl mod zz; - cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz]; - return; - end; -decr(stack_ptr); {we will go down to the previous level} -if stack_ptr>0 then - begin cur_state:=stack[stack_ptr]; zo:=cur_repl mod zz; - end; -exit: end; - -@ The heart of the output procedure is the |get_output| routine, which produces -the next token of output that is not a reference to a macro. This procedure -handles all the stacking and unstacking that is necessary. It returns the -value |number| if the next output has a numeric value (the value of a -numeric macro or string), in which case |cur_val| has been set to the -number in question. The procedure also returns the value |module_number| -if the next output begins or ends the replacement text of some module, -in which case |cur_val| is that module's number (if beginning) or the -negative of that value (if ending). And it returns the value |identifier| -if the next output is an identifier of length two or more, in which case -|cur_val| points to that identifier name. - -@d number=@'200 {code returned by |get_output| when next output is numeric} -@d module_number=@'201 {code returned by |get_output| for module numbers} -@d identifier=@'202 {code returned by |get_output| for identifiers} - -@<Globals...@>= -@!cur_val:integer; {additional information corresponding to output token} - -@ If |get_output| finds that no more output remains, it returns the value zero. - -@p function get_output:sixteen_bits; {returns next token after macro expansion} -label restart, done, found; -var a:sixteen_bits; {value of current byte} -@!b:eight_bits; {byte being copied} -@!bal:sixteen_bits; {excess of \.( versus \.) while copying a parameter} -@!k:0..max_bytes; {index into |byte_mem|} -@!w:0..ww-1; {segment of |byte_mem|} -begin restart: if stack_ptr=0 then - begin a:=0; goto found; - end; -if cur_byte=cur_end then - begin cur_val:=-cur_mod; pop_level; - if cur_val=0 then goto restart; - a:=module_number; goto found; - end; -a:=tok_mem[zo,cur_byte]; incr(cur_byte); -if a<@'200 then {one-byte token} - if a=param then - @<Start scanning current macro parameter, |goto restart|@> - else goto found; -a:=(a-@'200)*@'400+tok_mem[zo,cur_byte]; incr(cur_byte); -if a<@'24000 then {|@'24000=(@'250-@'200)*@'400|} - @<Expand macro |a| and |goto found|, or |goto restart| if no output found@>; -if a<@'50000 then {|@'50000=(@'320-@'200)*@'400|} - @<Expand module |a-@'24000|, |goto restart|@>; -cur_val:=a-@'50000; a:=module_number; cur_mod:=cur_val; -found: -@!debug if trouble_shooting then debug_help;@;@+gubed@/ -get_output:=a; -end; - -@ The user may have forgotten to give any \PASCAL\ text for a module name, -or the \PASCAL\ text may have been associated with a different name by mistake. - -@<Expand module |a-...@>= -begin a:=a-@'24000; -if equiv[a]<>0 then push_level(a) -else if a<>0 then - begin print_nl('! Not present: <'); print_id(a); print('>'); error; -@.Not present: <section name>@> - end; -goto restart; -end - -@ @<Expand macro ...@>= -begin case ilk[a] of -normal: begin cur_val:=a; a:=identifier; - end; -numeric: begin cur_val:=equiv[a]-1073741824; a:=number; - end; -simple: begin push_level(a); goto restart; - end; -parametric: begin @<Put a parameter on the parameter stack, - or |goto restart| if error occurs@>; - push_level(a); goto restart; - end; -othercases confusion('output') -endcases;@/ -goto found; -end - -@ We come now to the interesting part, the job of putting a parameter on -the parameter stack. First we pop the stack if necessary until getting to -a level that hasn't ended. Then the next character must be a `\.('; -and since parentheses are balanced on each level, the entire parameter must -be present, so we can copy it without difficulty. - -@<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|@>; -equiv[name_ptr]:=text_ptr; ilk[name_ptr]:=simple; w:=name_ptr mod ww; -k:=byte_ptr[w]; -@!debug if k=max_bytes then overflow('byte memory'); -byte_mem[w,k]:="#"; incr(k); byte_ptr[w]:=k; -gubed {this code has set the parameter identifier for debugging printouts} -if name_ptr>max_names-ww then overflow('name'); -byte_start[name_ptr+ww]:=k; incr(name_ptr); -if text_ptr>max_texts-zz then overflow('text'); -text_link[text_ptr]:=0; tok_start[text_ptr+zz]:=tok_ptr[z]; -incr(text_ptr); -z:=text_ptr mod zz - -@ The |pop_level| routine undoes the effect of parameter-pushing when -a parameter macro is finished: - -@<Remove a parameter...@>= -begin decr(name_ptr); decr(text_ptr); -z:=text_ptr mod zz; -stat if tok_ptr[z]>max_tok_ptr[z] then max_tok_ptr[z]:=tok_ptr[z]; -tats {the maximum value of |tok_ptr| occurs just before parameter popping} -tok_ptr[z]:=tok_start[text_ptr]; -@!debug decr(byte_ptr[name_ptr mod ww]);@+gubed -end - -@ When a parameter occurs in a replacement text, we treat it as a simple -macro in position (|name_ptr-1|): - -@<Start scanning...@>= -begin push_level(name_ptr-1); goto restart; -end - -@ Similarly, a |param| token encountered as we copy a parameter is converted -into a simple macro call for |name_ptr-1|. -Some care is needed to handle cases like \\{macro}|(#; print('#)'))|; the -\.{\#} token will have been changed to |param| outside of strings, but we -still must distinguish `real' parentheses from those in strings. - -@d app_repl(#)==begin if tok_ptr[z]=max_toks then overflow('token'); - tok_mem[z,tok_ptr[z]]:=#; incr(tok_ptr[z]); end - -@<Copy the parameter...@>= -bal:=1; incr(cur_byte); {skip the opening `\.('} -loop@+ begin b:=tok_mem[zo,cur_byte]; incr(cur_byte); - if b=param then store_two_bytes(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); - ")": begin decr(bal); - if bal=0 then goto done; - 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; - app_repl(b); - end; - end; -done: - -@* Producing the output. -The |get_output| routine above handles most of the complexity of output -generation, but there are two further considerations that have a nontrivial -effect on \.{TANGLE}'s algorithms. - -First, we want to make sure that the output is broken into lines not -exceeding |line_length| characters per line, where these breaks occur at -valid places (e.g., not in the middle of a string or a constant or an -identifier, not between `\.<' and `\.>', not at a `\.{@@\&}' position -where quantities are being joined together). Therefore we assemble the -output into a buffer before deciding where the line breaks will appear. -However, we make very little attempt to make ``logical'' line breaks that -would enhance the readability of the output; people are supposed to read -the input of \.{TANGLE} or the \TeX ed output of \.{WEAVE}, but not the -tangled-up output. The only concession to readability is that a break after -a semicolon will be made if possible, since commonly used ``pretty -printing'' routines give better results in such cases. - -Second, we want to decimalize non-decimal constants, and to combine integer -quantities that are added or subtracted, because \PASCAL\ doesn't allow -constant expressions in subrange types or in case labels. This means we -want to have a procedure that treats a construction like \.{(E-15+17)} -as equivalent to `\.{(E+2)}', while also leaving `\.{(1E-15+17)}' and -`\.{(E-15+17*y)}' untouched. Consider also `\.{-15+17.5}' versus -`\.{-15+17..5}'. We shall not combine integers preceding or following -\.*, \./, \.{div}, \.{mod}, or \.{@@\&}. Note that if |y| has been defined -to equal $-2$, we must expand `\.{x*y}' into `\.{x*(-2)}'; but `\.{x-y}' -can expand into `\.{x+2}' and we can even change `\.{x - y mod z}' to -@^mod@> -`\.{x + 2 mod z}' because \PASCAL\ has a nonstandard \&{mod} operation! - -The following solution to these problems has been adopted: An array -|out_buf| contains characters that have been generated but not yet output, -and there are three pointers into this array. One of these, |out_ptr|, is -the number of characters currently in the buffer, and we will have -|1<=out_ptr<=line_length| most of the time. The second is |break_ptr|, -which is the largest value |<=out_ptr| such that we are definitely entitled -to end a line by outputting the characters |out_buf[1..(break_ptr-1)]|; -we will always have |break_ptr<=line_length|. Finally, |semi_ptr| is either -zero or the largest known value of a legal break after a semicolon or comment -on the current line; we will always have |semi_ptr<=break_ptr|. - -@<Globals...@>= -@!out_buf: array [0..out_buf_size] of ASCII_code; {assembled characters} -@!out_ptr: 0..out_buf_size; {first available place in |out_buf|} -@!break_ptr: 0..out_buf_size; {last breaking place in |out_buf|} -@!semi_ptr: 0..out_buf_size; {last semicolon breaking place in |out_buf|} - -@ Besides having those three pointers, -the output process is in one of several states: - -\yskip\hang |num_or_id| means that the last item in the buffer is a number or -identifier, hence a blank space or line break must be inserted if the next -item is also a number or identifier. - -\yskip\hang |unbreakable| means that the last item in the buffer was followed -by the \.{@@\&} operation that inhibits spaces between it and the next item. - -\yskip\hang |sign| means that the last item in the buffer is to be followed -by \.+ or \.-, depending on whether |out_app| is positive or negative. - -\yskip\hang |sign_val| means that the decimal equivalent of -$\vert|out_val|\vert$ should be appended to the buffer. If |out_val<0|, -or if |out_val=0| and |last_sign<0|, the number should be preceded by a minus -sign. Otherwise it should be preceded by the character |out_sign| unless -|out_sign=0|; the |out_sign| variable is either 0 or \.{"\ "} or \.{"+"}. - -\yskip\hang |sign_val_sign| is like |sign_val|, but also append \.+ or \.- -afterwards, depending on whether |out_app| is positive or negative. - -\yskip\hang |sign_val_val| is like |sign_val|, but also append the decimal -equivalent of |out_app| including its sign, using |last_sign| in case -|out_app=0|. - -\yskip\hang |misc| means none of the above. - -\yskip\noindent -For example, the output buffer and output state run through the following -sequence as we generate characters from `\.{(x-15+19-2)}': -$$\vbox{\halign{$\hfil#\hfil$\quad&#\hfil&\quad\hfil#\hfil&\quad -\hfil#\hfil&\quad\hfil#\hfil&\quad\hfil#\hfil\quad&\hfil#\hfil\cr -output&|out_buf|&|out_state|&|out_sign|&|out_val|&|out_app|&|last_sign|\cr -\noalign{\vskip 3pt} -(&\.(&|misc|\cr -x&\.{(x}&|num_or_id|\cr --&\.{(x}&|sign|&&&$-1$&$-1$\cr -15&\.{(x}&|sign_val|&\.{"+"}&$-15$&&$-15$\cr -+&\.{(x}&|sign_val_sign|&\.{"+"}&$-15$&$+1$&$+1$\cr -19&\.{(x}&|sign_val_val|&\.{"+"}&$-15$&$+19$&$+1$\cr --&\.{(x}&|sign_val_sign|&\.{"+"}&$+4$&$-1$&$-1$\cr -2&\.{(x}&|sign_val_val|&\.{"+"}&$+4$&$-2$&$-2$\cr -)&\.{(x+2)}&|misc|\cr}}$$ -At each stage we have put as much into the buffer as possible without -knowing what is coming next. Examples like `\.{x-0.1}' indicate why -|last_sign| is needed to associate the proper sign with an output of zero. - -In states |num_or_id|, |unbreakable|, and |misc| the last item in the buffer -lies between |break_ptr| and |out_ptr-1|, inclusive; in the other states we -have |break_ptr=out_ptr|. - -The numeric values assigned to |num_or_id|, etc., have been chosen to -shorten some of the program logic; for example, the program makes use of -the fact that |sign+2=sign_val_sign|. - -@d misc=0 {state associated with special characters} -@d num_or_id=1 {state associated with numbers and identifiers} -@d sign=2 {state associated with pending \.+ or \.-} -@d sign_val=num_or_id+2 {state associated with pending sign and value} -@d sign_val_sign=sign+2 {|sign_val| followed by another pending sign} -@d sign_val_val=sign_val+2 {|sign_val| followed by another pending value} -@d unbreakable=sign_val_val+1 {state associated with \.{@@\&}} - -@<Globals...@>= -@!out_state:eight_bits; {current status of partial output} -@!out_val,@!out_app:integer; {pending values} -@!out_sign:ASCII_code; {sign to use if appending |out_val>=0|} -@!last_sign:-1..+1; {sign to use if appending a zero} - -@ During the output process, |line| will equal the number of the next line -to be output. - -@<Initialize the output buffer@>= -out_state:=misc; out_ptr:=0; break_ptr:=0; semi_ptr:=0; out_buf[0]:=0; line:=1; - -@ Here is a routine that is invoked when |out_ptr>line_length| -or when it is time to flush out the final line. The |flush_buffer| procedure -often writes out the line up to the current |break_ptr| position, then moves the -remaining information to the front of |out_buf|. However, it prefers to -write only up to |semi_ptr|, if the residual line won't be too long. - -@d check_break==if out_ptr>line_length then flush_buffer - -@p procedure flush_buffer; {writes one line to output file} -var k:0..out_buf_size; {index into |out_buf|} -@!b:0..out_buf_size; {value of |break_ptr| upon entry} -begin b:=break_ptr; -if (semi_ptr<>0)and(out_ptr-semi_ptr<=line_length) then break_ptr:=semi_ptr; -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; -end; - -@ @<Empty the last line from the buffer@>= -break_ptr:=out_ptr; semi_ptr:=0; flush_buffer; -if brace_level<>0 then - err_print('! Program ended at brace level ',brace_level:1); -@.Program ended at brace level n@> - -@ Another simple and useful routine appends the decimal equivalent of -a nonnegative integer to the output buffer. - -@d app(#)==begin out_buf[out_ptr]:=#; incr(out_ptr); {append a single character} - end - -@p procedure app_val(@!v:integer); {puts |v| into buffer, assumes |v>=0|} -var k:0..out_buf_size; {index into |out_buf|} -begin k:=out_buf_size; {first we put the digits at the very end of |out_buf|} -repeat out_buf[k]:=v mod 10; v:=v div 10; decr(k); -until v=0; -repeat incr(k); app(out_buf[k]+"0"); -until k=out_buf_size; {then we append them, most significant first} -end; - -@ The output states are kept up to date by the output routines, which are -called |send_out|, |send_val|, and |send_sign|. The |send_out| procedure -has two parameters: |t| tells the type of information being sent and -|v| contains the information proper. Some information may also be passed -in the array |out_contrib|. - -\yskip\hang If |t=misc| then |v| is a character to be output. - -\hang If |t=str| then |v| is the length of a string or something like `\.{<>}' -in |out_contrib|. - -\hang If |t=ident| then |v| is the length of an identifier in |out_contrib|. - -\hang If |t=frac| then |v| is the length of a fraction and/or exponent in -|out_contrib|. - -@d str=1 {|send_out| code for a string} -@d ident=2 {|send_out| code for an identifier} -@d frac=3 {|send_out| code for a fraction} - -@<Glob...@>= -@!out_contrib:array[1..line_length] of ASCII_code; {a contribution to |out_buf|} - -@ A slightly subtle point in the following code is that the user may ask -for a |join| operation (i.e., \.{@@\&}) following whatever is being sent -out. We will see later that |join| is implemented in part by calling -|send_out(frac,0)|. - -@p procedure send_out(@!t:eight_bits; @!v:sixteen_bits); - {outputs |v| of type |t|} -label restart; -var k: 0..line_length; {index into |out_contrib|} -begin @<Get the buffer ready for appending the new information@>; -if t<>misc then for k:=1 to v do app(out_contrib[k]) -else app(v); -check_break; -if (t=misc)and((v=";")or(v="}")) then - begin semi_ptr:=out_ptr; break_ptr:=out_ptr; - end; -if t>=ident then out_state:=num_or_id {|t=ident| or |frac|} -else out_state:=misc {|t=str| or |misc|} -end; - -@ Here is where the buffer states for signs and values collapse into simpler -states, because we are about to append something that doesn't combine with -the previous integer constants. - -We use an ASCII-code trick: Since |","-1="+"| and |","+1="-"|, we have -|","-c=@t sign of $c$@>|, when $\vert c\vert=1$. - -@<Get the buffer ready...@>= -restart: case out_state of -num_or_id: if t<>frac then - begin break_ptr:=out_ptr; - if t=ident then app(" "); - end; -sign: begin app(","-out_app); check_break; break_ptr:=out_ptr; - end; -sign_val,sign_val_sign: begin @<Append \(|out_val| to buffer@>; - out_state:=out_state-2; goto restart; - end; -sign_val_val: @<Reduce |sign_val_val| to |sign_val| and |goto restart|@>; -misc: if t<>frac then break_ptr:=out_ptr;@/ -othercases do_nothing {this is for |unbreakable| state} -endcases - -@ @<Append \(|out_val|...@>= -if (out_val<0)or((out_val=0)and(last_sign<0)) then app("-") -else if out_sign>0 then app(out_sign); -app_val(abs(out_val)); check_break; - -@ @<Reduce |sign_val_val|...@>= -begin if (t=frac)or(@<Contribution is \.* or \./ or \.{DIV} or \.{MOD}@>) then - begin @<Append \(|out_val| to buffer@>; - out_sign:="+"; out_val:=out_app; - end -else out_val:=out_val+out_app; -out_state:=sign_val; goto restart; -end - -@ @<Contribution is \.*...@>= -((t=ident)and(v=3)and@| - (((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@| -@^uppercase@> - ((t=misc)and((v="*")or(v="/"))) - -@ The following routine is called with $v=\pm1$ when a plus or minus sign is -appended to the output. It extends \PASCAL\ to allow repeated signs -(e.g., `\.{--}' is equivalent to `\.+'), rather than to give an error message. -The signs following `\.E' in real constants are treated as part of a fraction, -so they are not seen by this routine. - -@p procedure send_sign(@!v:integer); -begin case out_state of -sign, sign_val_sign: out_app:=out_app*v; -sign_val:begin out_app:=v; out_state:=sign_val_sign; - end; -sign_val_val: begin out_val:=out_val+out_app; out_app:=v; - out_state:=sign_val_sign; - end; -othercases begin break_ptr:=out_ptr; out_app:=v; out_state:=sign; - end -endcases;@/ -last_sign:=out_app; -end; - -@ When a (signed) integer value is to be output, we call |send_val|. - -@d bad_case=666 {this is a label used below} - -@p procedure send_val(@!v:integer); {output the (signed) value |v|} -label bad_case, {go here if we can't keep |v| in the output state} - exit; -begin case out_state of -num_or_id: begin @<If previous output was \.{DIV} or \.{MOD}, |goto bad_case|@>; - out_sign:=" "; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr; - last_sign:=+1; - end; -misc: begin @<If previous output was \.* or \./, |goto bad_case|@>; - out_sign:=0; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr; - last_sign:=+1; - end; -@t\4@>@<Handle cases of |send_val| when |out_state| contains a sign@>@; -othercases goto bad_case -endcases;@/ -return; -bad_case: @<Append the decimal value of |v|, with parentheses if negative@>; -exit: end; - -@ @<Handle cases of |send_val|...@>= -sign: begin out_sign:="+"; out_state:=sign_val; out_val:=out_app*v; - end; -sign_val: begin out_state:=sign_val_val; out_app:=v; - err_print('! Two numbers occurred without a sign between them'); - end; -sign_val_sign: begin out_state:=sign_val_val; out_app:=out_app*v; - end; -sign_val_val: begin out_val:=out_val+out_app; out_app:=v; - err_print('! Two numbers occurred without a sign between them'); -@.Two numbers occurred...@> - end; - -@ @<If previous output was \.*...@>= -if (out_ptr=break_ptr+1)and((out_buf[break_ptr]="*")or(out_buf[break_ptr]="/")) - then goto bad_case - -@ @<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 - -@ @<Append the decimal value...@>= -if v>=0 then - begin if out_state=num_or_id then - begin break_ptr:=out_ptr; app(" "); - end; - app_val(v); check_break; out_state:=num_or_id; - end -else begin app("("); app("-"); app_val(-v); app(")"); check_break; - out_state:=misc; - end - -@* The big output switch. -To complete the output process, we need a routine that takes the results -of |get_output| and feeds them to |send_out|, |send_val|, or |send_sign|. -This procedure `|send_the_output|' will be invoked just once, as follows: - -@<Phase II: Output the contents of the compressed tables@>= -if text_link[0]=0 then - begin print_nl('! No output was specified.'); mark_harmless; -@.No output was specified@> - end -else begin print_nl('Writing the output file'); update_terminal;@/ - @<Initialize the output stacks@>; - @<Initialize the output buffer@>; - send_the_output;@/ - @<Empty the last line...@>; - print_nl('Done.'); - end - -@ A many-way switch is used to send the output: - -@d get_fraction=2 {this label is used below} - -@p procedure send_the_output; -label get_fraction, {go here to finish scanning a real constant} - reswitch, continue; -var cur_char:eight_bits; {the latest character received} - @!k:0..line_length; {index into |out_contrib|} - @!j:0..max_bytes; {index into |byte_mem|} - @!w:0..ww-1; {segment of |byte_mem|} - @!n:integer; {number being scanned} -begin while stack_ptr>0 do - begin cur_char:=get_output; - reswitch: case cur_char of - 0: do_nothing; {this case might arise if output ends unexpectedly} - @t\4@>@<Cases related to identifiers@>@; - @t\4@>@<Cases related to constants, possibly leading to - |get_fraction| or |reswitch|@>@; - "+","-": send_sign(","-cur_char); - @t\4@>@<Cases like \.{<>} and \.{:=}@>@; - "'": @<Send a string, |goto reswitch|@>; - @<Other printable characters@>: send_out(misc,cur_char); - @t\4@>@<Cases involving \.{@@\{} and \.{@@\}}@>@; - join: begin send_out(frac,0); out_state:=unbreakable; - end; - verbatim: @<Send verbatim string@>; - force_line: @<Force a line break@>; - othercases err_print('! Can''t output ASCII code ',cur_char:1) -@.Can't output ASCII code n@> - endcases;@/ - goto continue; - get_fraction: @<Special code to finish real constants@>; - continue: end; -end; - -@ @<Cases like \.{<>}...@>= -and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D"; -@^uppercase@> - send_out(ident,3); - end; -not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T"; - send_out(ident,3); - end; -set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N"; - send_out(ident,2); - end; -or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2); - end; -left_arrow: begin out_contrib[1]:=":"; out_contrib[2]:="="; send_out(str,2); - end; -not_equal: begin out_contrib[1]:="<"; out_contrib[2]:=">"; send_out(str,2); - end; -less_or_equal: begin out_contrib[1]:="<"; out_contrib[2]:="="; send_out(str,2); - end; -greater_or_equal: begin out_contrib[1]:=">"; out_contrib[2]:="="; - send_out(str,2); - end; -equivalence_sign: begin out_contrib[1]:="="; out_contrib[2]:="="; - send_out(str,2); - end; -double_dot: begin out_contrib[1]:="."; out_contrib[2]:="."; send_out(str,2); - end; - -@ Please don't ask how all of the following characters can actually get -through \.{TANGLE} outside of strings. It seems that |""""| and |"{"| -cannot actually occur at this point of the program, but they have -been included just in case \.{TANGLE} changes. - -If \.{TANGLE} is producing code for a \PASCAL\ compiler that uses `\.{(.}' -and `\.{.)}' instead of square brackets (e.g., on machines with {\mc EBCDIC} -code), one should remove |"["| and |"]"| from this list and put them into -the preceding module in the appropriate way. Similarly, some compilers -want `\.\^' to be converted to `\.{@@}'. -@^system dependencies@>@^EBCDIC@> - -@<Other printable characters@>= -"!","""","#","$","%","&","(",")","*",",","/",":",";","<","=",">","?", -"@@","[","\","]","^","_","`","{","|" - -@ Single-character identifiers represent themselves, while longer ones -appear in |byte_mem|. All must be converted to uppercase, -with underlines removed. Extremely long identifiers must be chopped. - -(Some \PASCAL\ compilers work with lowercase letters instead of -uppercase. If this module of \.{TANGLE} is changed, it's also necessary -to change from uppercase to lowercase in the modules that are -listed in the index under ``uppercase''.) -@^system dependencies@> -@^uppercase@> - -@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,# - -@<Cases related to identifiers@>= -"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; -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; - send_out(ident,k); - end; - -@ After sending a string, we need to look ahead at the next character, in order -to see if there were two consecutive single-quote marks. Afterwards we go to -|reswitch| to process the next character. - -@<Send a string...@>= -begin k:=1; out_contrib[1]:="'"; -repeat if k<line_length then incr(k); -out_contrib[k]:=get_output; -until (out_contrib[k]="'")or(stack_ptr=0); -if k=line_length then err_print('! String too long'); -@.String too long@> -send_out(str,k); cur_char:=get_output; -if cur_char="'" then out_state:=unbreakable; -goto reswitch; -end - -@ Sending a verbatim string is similar, but we don't have to look ahead. - -@<Send verbatim string@>= -begin k:=0; -repeat if k<line_length then incr(k); -out_contrib[k]:=get_output; -until (out_contrib[k]=verbatim)or(stack_ptr=0); -if k=line_length then err_print('! Verbatim string too long'); -@.Verbatim string too long@> -send_out(str,k-1); -end - -@ In order to encourage portable software, \.{TANGLE} complains -if the constants get dangerously close to the largest value representable -on a 32-bit computer ($2^{31}-1$). - -@d digits=="0","1","2","3","4","5","6","7","8","9" - -@<Cases related to constants...@>= -digits: begin n:=0; - repeat cur_char:=cur_char-"0"; - if n>=@'1463146314 then err_print('! Constant too big') -@.Constant too big@> - else n:=10*n+cur_char; - cur_char:=get_output; - until (cur_char>"9")or(cur_char<"0"); - send_val(n); k:=0; - if cur_char="e" then cur_char:="E"; -@^uppercase@> - if cur_char="E" then goto get_fraction - else goto reswitch; - end; -check_sum: send_val(pool_check_sum); -octal: begin n:=0; cur_char:="0"; - repeat cur_char:=cur_char-"0"; - if n>=@'2000000000 then err_print('! Constant too big') - else n:=8*n+cur_char; - cur_char:=get_output; - until (cur_char>"7")or(cur_char<"0"); - send_val(n); goto reswitch; - end; -hex: begin n:=0; cur_char:="0"; - repeat if cur_char>="A" then cur_char:=cur_char+10-"A" - else cur_char:=cur_char-"0"; - if n>=@"8000000 then err_print('! Constant too big') - else n:=16*n+cur_char; - cur_char:=get_output; - until (cur_char>"F")or(cur_char<"0")or@| - ((cur_char>"9")and(cur_char<"A")); - send_val(n); goto reswitch; - end; -number: send_val(cur_val); -".": begin k:=1; out_contrib[1]:="."; cur_char:=get_output; - if cur_char="." then - begin out_contrib[2]:="."; send_out(str,2); - end - else if (cur_char>="0")and(cur_char<="9") then goto get_fraction - else begin send_out(misc,"."); goto reswitch; - end; - end; - -@ The following code appears at label `|get_fraction|', when we want to -scan to the end of a real constant. The first |k| characters of a fraction -have already been placed in |out_contrib|, and |cur_char| is the next character. - -@<Special code...@>= -repeat if k<line_length then incr(k); -out_contrib[k]:=cur_char; cur_char:=get_output; -if (out_contrib[k]="E")and((cur_char="+")or(cur_char="-")) then -@^uppercase@> - begin if k<line_length then incr(k); - out_contrib[k]:=cur_char; cur_char:=get_output; - end -else if cur_char="e" then cur_char:="E"; -until (cur_char<>"E")and((cur_char<"0")or(cur_char>"9")); -if k=line_length then err_print('! Fraction too long'); -@.Fraction too long@> -send_out(frac,k); goto reswitch - -@ Some \PASCAL\ compilers do not recognize comments in braces, so the -comments must be delimited by `\.{(*}' and `\.{*)}'. -@^system dependencies@> -In such cases the statement `|send_out(misc,"{")|' that appears here should -be replaced by `\ignorespaces|begin out_contrib[1]:="("; out_contrib[2]:="*"; -send_out(str,2); end|', and a similar change should be made to -`|send_out(misc,"}")|'. - -@<Cases involving \.{@@\{} and \.{@@\}}@>= -begin_comment: begin if brace_level=0 then send_out(misc,"{") - else send_out(misc,"["); - incr(brace_level); - end; -end_comment: if brace_level>0 then - begin decr(brace_level); - if brace_level=0 then send_out(misc,"}") - else send_out(misc,"]"); - end - else err_print('! Extra @@}'); -@.Extra \AT!\}@> -module_number: begin if brace_level=0 then send_out(misc,"{") - else send_out(misc,"["); - if cur_val<0 then - begin send_out(misc,":"); send_val(-cur_val); - end - else begin send_val(cur_val); send_out(misc,":"); - end; - if brace_level=0 then send_out(misc,"}") - else send_out(misc,"]"); - end; - -@ @<Force a line break@>= -begin send_out(str,0); {normalize the buffer} -while out_ptr>0 do - begin if out_ptr<=line_length then break_ptr:=out_ptr; - flush_buffer; - end; -out_state:=misc; -end - -@* Introduction to the input phase. -We have now seen that \.{TANGLE} will be able to output the full -\PASCAL\ program, if we can only get that program into the byte memory in -the proper format. The input process is something like the output process -in reverse, since we compress the text as we read it in and we expand it -as we write it out. - -There are three main input routines. The most interesting is the one that gets -the next token of a \PASCAL\ text; the other two are used to scan rapidly past -\TeX\ text in the \.{WEB} source code. One of the latter routines will jump to -the next token that starts with `\.{@@}', and the other skips to the end -of a \PASCAL\ comment. - -@ 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...@>= -@!ii:integer; {general purpose |for| loop variable in the outer block} -@!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|} - -@ 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; - -@ @<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; - -@ @<If the current line starts with \.{@@y}...@>= -if limit>1 then 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]="z") then - begin loc:=2; err_print('! Where is the matching @@y?'); -@.Where is the match...@> - end - else if buffer[1]="y" then - begin if n>0 then - begin loc:=2; err_print('! Hmm... ',n:1, - ' of the preceding lines failed to match'); -@.Hmm... n of the preceding...@> - end; - return; - end; - end - -@ @<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; - -@ The |get_line| procedure is called when |loc>limit|; it puts the next -line of merged input into the buffer and updates the other variables -appropriately. A space is placed at the right end of the line. - -@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 ii:=0 to change_limit do buffer[ii]:=change_buffer[ii]; - 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 - -@ Important milestones are reached during the input phase when certain -control codes are sensed. - -Control codes in \.{WEB} begin with `\.{@@}', and the next character -identifies the code. Some of these are of interest only to \.{WEAVE}, -so \.{TANGLE} ignores them; the others are converted by \.{TANGLE} into -internal code numbers by the |control_code| function below. The ordering -of these internal code numbers has been chosen to simplify the program logic; -larger numbers are given to the control codes that denote more significant -milestones. - -@d ignore=0 {control code of no interest to \.{TANGLE}} -@d control_text=@'203 {control code for `\.{@@t}', `\.{@@\^}', etc.} -@d format=@'204 {control code for `\.{@@f}'} -@d definition=@'205 {control code for `\.{@@d}'} -@d begin_Pascal=@'206 {control code for `\.{@@p}'} -@d module_name=@'207 {control code for `\.{@@<}'} -@d new_module=@'210 {control code for `\.{@@\ }' and `\.{@@*}'} - -@p function control_code(@!c:ASCII_code):eight_bits; {convert |c| after \.{@@}} -begin case c of -"@@": control_code:="@@"; {`quoted' at sign} -"'": control_code:=octal; {precedes octal constant} -"""": control_code:=hex; {precedes hexadecimal constant} -"$": control_code:=check_sum; {string pool check sum} -" ",tab_mark: control_code:=new_module; {beginning of a new module} -"*": begin print('*',module_count+1:1); - update_terminal; {print a progress report} - control_code:=new_module; {beginning of a new module} - end; -"D","d": control_code:=definition; {macro definition} -"F","f": control_code:=format; {format definition} -"{": control_code:=begin_comment; {begin-comment delimiter} -"}": control_code:=end_comment; {end-comment delimiter} -"P","p": control_code:=begin_Pascal; {\PASCAL\ text in unnamed module} -"T","t","^",".",":": control_code:=control_text; {control text to be ignored} -"&": control_code:=join; {concatenate two tokens} -"<": control_code:=module_name; {beginning of a module name} -"=": control_code:=verbatim; {beginning of \PASCAL\ verbatim mode} -"\": control_code:=force_line; {force a new line in \PASCAL\ output} -othercases control_code:=ignore {ignore all other cases} -endcases; -end; - -@ The |skip_ahead| procedure reads through the input at fairly high speed -until finding the next non-ignorable control code, which it returns. - -@p function skip_ahead:eight_bits; {skip to next control code} -label done; -var c:eight_bits; {control code found} -begin loop begin if loc>limit then - begin get_line; - if input_has_ended then - begin c:=new_module; goto done; - end; - end; - buffer[limit+1]:="@@"; - while buffer[loc]<>"@@" do incr(loc); - if loc<=limit then - begin loc:=loc+2; c:=control_code(buffer[loc-1]); - if (c<>ignore)or(buffer[loc-1]=">") then goto done; - end; - end; -done: skip_ahead:=c; -end; - -@ The |skip_comment| procedure reads through the input at somewhat high speed -until finding the first unmatched right brace or until coming to the end -of the file. It ignores characters following `\.\\' characters, since all -braces that aren't nested are supposed to be hidden in that way. For -example, consider the process of skipping the first comment below, -where the string containing the right brace has been typed as \.{\`\\.\\\}\'} -in the \.{WEB} file. - -@p procedure skip_comment; {skips to next unmatched `\.\}'} -label exit; -var bal:eight_bits; {excess of left braces} -@!c:ASCII_code; {current character} -begin bal:=0; -loop@+ begin if loc>limit then - begin get_line; - if input_has_ended then - begin err_print('! Input ended in mid-comment'); -@.Input ended in mid-comment@> - return; - end; - end; - c:=buffer[loc]; incr(loc); - @<Do special things when |c="@@", "\", "{", "}"|; |return| at end@>; - end; -exit:end; - -@ @<Do special things when |c="@@"...@>= -if c="@@" then - begin c:=buffer[loc]; - if (c<>" ")and(c<>tab_mark)and(c<>"*")and(c<>"z")and(c<>"Z") then incr(loc) - else begin err_print('! Section ended in mid-comment'); -@.Section ended in mid-comment@> - decr(loc); return; - end - end -else if (c="\")and(buffer[loc]<>"@@") then incr(loc) -else if c="{" then incr(bal) -else if c="}" then - begin if bal=0 then return; - decr(bal); - end - -@* Inputting the next token. -As stated above, \.{TANGLE}'s most interesting input procedure is the -|get_next| routine that inputs the next token. However, the procedure -isn't especially difficult. - -In most cases the tokens output by |get_next| have the form used in -replacement texts, except that two-byte tokens are not produced. -An identifier that isn't one letter long is represented by the -output `|identifier|', and in such a case the global variables -|id_first| and |id_loc| will have been set to the appropriate values -needed by the |id_lookup| procedure. A string that begins with a -double-quote is also considered an |identifier|, and in such a case -the global variable |double_chars| will also have been set appropriately. -Control codes produce the corresponding output of the |control_code| -function above; and if that code is |module_name|, the value of |cur_module| -will point to the |byte_start| entry for that module name. - -Another global variable, |scanning_hex|, is |true| during the time that -the letters \.A through \.F should be treated as if they were digits. - -@<Globals...@>= -@!cur_module: name_pointer; {name of module just scanned} -@!scanning_hex: boolean; {are we scanning a hexadecimal constant?} - -@ @<Set init...@>= -scanning_hex:=false; - -@ At the top level, |get_next| is a multi-way switch based on the next -character in the input buffer. A |new_module| code is inserted at the -very end of the input file. - -@p function get_next:eight_bits; {produces the next input token} -label restart,done,found; -var c:eight_bits; {the current character} -@!d:eight_bits; {the next character} -@!j,@!k:0..longest_name; {indices into |mod_text|} -begin restart: if loc>limit then - begin get_line; - if input_has_ended then - begin c:=new_module; goto found; - end; - end; -c:=buffer[loc]; incr(loc); -if scanning_hex then @<Go to |found| if |c| is a hexadecimal digit, - otherwise set |scanning_hex:=false|@>; -case c of -"A",up_to("Z"),"a",up_to("z"): @<Get an identifier@>; -"""": @<Get a preprocessed string@>; -"@@": @<Get control code and possible module name@>; -@t\4@>@<Compress two-symbol combinations like `\.{:=}'@>@; -" ",tab_mark: goto restart; {ignore spaces and tabs} -"{": begin skip_comment; goto restart; - end; -"}": begin err_print('! Extra }'); goto restart; -@.Extra \}@> - end; -othercases if c>=128 then goto restart {ignore nonstandard characters} - else do_nothing -endcases; -found:@!debug if trouble_shooting then debug_help;@;@+gubed@/ -get_next:=c; -end; - -@ @<Go to |found| if |c| is a hexadecimal digit...@>= -if ((c>="0")and(c<="9"))or((c>="A")and(c<="F")) then goto found -else scanning_hex:=false - -@ Note that the following code substitutes \.{@@\{} and \.{@@\}} for the -respective combinations `\.{(*}' and `\.{*)}'. Explicit braces should be used -for \TeX\ comments in \PASCAL\ text. - -@d compress(#)==begin if loc<=limit then begin c:=#; incr(loc); end; end - -@<Compress two-symbol...@>= -".": if buffer[loc]="." then compress(double_dot) - else if buffer[loc]=")" then compress("]"); -":": if buffer[loc]="=" then compress(left_arrow); -"=": if buffer[loc]="=" then compress(equivalence_sign); -">": if buffer[loc]="=" then compress(greater_or_equal); -"<": if buffer[loc]="=" then compress(less_or_equal) - else if buffer[loc]=">" then compress(not_equal); -"(": if buffer[loc]="*" then compress(begin_comment) - else if buffer[loc]="." then compress("["); -"*": if buffer[loc]=")" then compress(end_comment); - -@ We have to look at the preceding character to make sure this isn't part -of a real constant, before trying to find an identifier starting with -`\.e' or `\.E'. - -@<Get an identifier@>= -begin if ((c="e")or(c="E"))and(loc>1) then - if (buffer[loc-2]<="9")and(buffer[loc-2]>="0") then c:=0; -if c<>0 then - begin decr(loc); id_first:=loc; - repeat incr(loc); d:=buffer[loc]; - until ((d<"0")or((d>"9")and(d<"A"))or((d>"Z")and(d<"a"))or(d>"z")) and - (d<>"_"); - if loc>id_first+1 then - begin c:=identifier; id_loc:=loc; - end; - end -else c:="E"; {exponent of a real constant} -end - -@ A string that starts and ends with double-quote marks is converted into -an identifier that behaves like a numeric macro by means of the following -piece of the program. -@^preprocessed strings@> - -@<Get a preprocessed string@>= -begin double_chars:=0; id_first:=loc-1; -repeat d:=buffer[loc]; incr(loc); - if (d="""")or(d="@@") then - if buffer[loc]=d then - begin incr(loc); d:=0; incr(double_chars); - end - else begin if d="@@" then err_print('! Double @@ sign missing') -@.Double \AT! sign missing@> - end - else if loc>limit then - begin err_print('! String constant didn''t end'); d:=""""; -@.String constant didn't end@> - end; -until d=""""; -id_loc:=loc-1; c:=identifier; -end - -@ After an \.{@@} sign has been scanned, the next character tells us -whether there is more work to do. - -@<Get control code and possible module name@>= -begin c:=control_code(buffer[loc]); incr(loc); -if c=ignore then goto restart -else if c=hex then scanning_hex:=true -else if c=module_name then - @<Scan the \(module name and make |cur_module| point to it@> -else if c=control_text then - begin repeat c:=skip_ahead; - until c<>"@@"; - if buffer[loc-1]<>">" then - err_print('! Improper @@ within control text'); -@.Improper \AT! within control text@> - goto restart; - end; -end - -@ @<Scan the \(module name...@>= -begin @<Put module name into |mod_text[1..k]|@>; -if k>3 then - begin if (mod_text[k]=".")and(mod_text[k-1]=".")and(mod_text[k-2]=".") then - cur_module:=prefix_lookup(k-3) - else cur_module:=mod_lookup(k); - end -else cur_module:=mod_lookup(k); -end - -@ Module names are placed into the |mod_text| array with consecutive spaces, -tabs, and carriage-returns replaced by single spaces. There will be no -spaces at the beginning or the end. (We set |mod_text[0]:=" "| to facilitate -this, since the |mod_lookup| routine uses |mod_text[1]| as the first -character of the name.) - -@<Set init...@>=mod_text[0]:=" "; - -@ @<Put module name...@>= -k:=0; -loop@+ begin if loc>limit then - begin get_line; - if input_has_ended then - begin err_print('! Input ended in section name'); -@.Input ended in section name@> - goto done; - end; - end; - d:=buffer[loc]; - @<If end of name, |goto done|@>; - incr(loc); if k<longest_name-1 then incr(k); - if (d=" ")or(d=tab_mark) then - begin d:=" "; if mod_text[k-1]=" " then decr(k); - end; - mod_text[k]:=d; - end; -done: @<Check for overlong name@>; -if (mod_text[k]=" ")and(k>0) then decr(k); - -@ @<If end of name,...@>= -if d="@@" then - begin d:=buffer[loc+1]; - if d=">" then - begin loc:=loc+2; goto done; - end; - if (d=" ")or(d=tab_mark)or(d="*") then - begin err_print('! Section name didn''t end'); goto done; -@.Section name didn't end@> - end; - incr(k); mod_text[k]:="@@"; incr(loc); {now |d=buffer[loc]| again} - end - -@ @<Check for overlong name@>= -if k>=longest_name-2 then - begin print_nl('! Section name too long: '); -@.Section name too long@> - for j:=1 to 25 do print(xchr[mod_text[j]]); - print('...'); mark_harmless; - end - -@* Scanning a numeric definition. -When \.{TANGLE} looks at the \PASCAL\ text following the `\.=' of a numeric -macro definition, it calls on the precedure |scan_numeric(p)|, where |p| -points to the name that is to be defined. This procedure evaluates the -right-hand side, which must consist entirely of integer constants and -defined numeric macros connected with \.+ and \.- signs (no parentheses). -It also sets the global variable |next_control| to the control code that -terminated this definition. - -A definition ends with the control codes |definition|, |format|, |module_name|, -|begin_Pascal|, and |new_module|, all of which can be recognized -by the fact that they are the largest values |get_next| can return. - -@d end_of_definition(#)==(#>=format) - {is |#| a control code ending a definition?} - -@<Global...@>= -@!next_control:eight_bits; {control code waiting to be acted upon} - -@ The evaluation of a numeric expression makes use of two variables called the -|accumulator| and the |next_sign|. At the beginning, |accumulator| is zero and -|next_sign| is $+1$. When a \.+ or \.- is scanned, |next_sign| is multiplied -by the value of that sign. When a numeric value is scanned, it is multiplied by -|next_sign| and added to the |accumulator|, then |next_sign| is reset to $+1$. - -@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1; - end - -@p procedure scan_numeric(@!p:name_pointer); {defines numeric macros} -label reswitch, done; -var accumulator:integer; {accumulates sums} -@!next_sign:-1..+1; {sign to attach to next value} -@!q:name_pointer; {points to identifiers being evaluated} -@!val:integer; {constants being evaluated} -begin @<Set \(|accumulator| to the value of the right-hand side@>; -if abs(accumulator)>=1073741824 then - begin err_print('! Value too big: ',accumulator:1); accumulator:=0; -@.Value too big@> - end; -equiv[p]:=accumulator+1073741824; - {name |p| now is defined to equal |accumulator|} -end; - -@ @<Set \(|accumulator| to the value of the right-hand side@>= -accumulator:=0; next_sign:=+1; -loop@+ begin next_control:=get_next; - reswitch: case next_control of - digits: begin @<Set |val| to value of decimal constant, and - set |next_control| to the following token@>; - add_in(val); goto reswitch; - end; - octal: begin @<Set |val| to value of octal constant, and - set |next_control| to the following token@>; - add_in(val); goto reswitch; - end; - hex: begin @<Set |val| to value of hexadecimal constant, and - set |next_control| to the following token@>; - add_in(val); goto reswitch; - end; - identifier: begin q:=id_lookup(normal); - if ilk[q]<>numeric then - begin next_control:="*"; goto reswitch; {leads to error} - end; - add_in(equiv[q]-1073741824); - end; - "+": do_nothing; - "-": next_sign:=-next_sign; - format, definition, module_name, begin_Pascal, new_module: goto done; - ";": err_print('! Omit semicolon in numeric definition'); -@.Omit semicolon in numeric def...@> - othercases @<Signal error, flush rest of the definition@> - endcases; - end; -done: - -@ @<Signal error, flush rest...@>= -begin err_print('! Improper numeric definition will be flushed'); -@.Improper numeric definition...@> -repeat next_control:=skip_ahead -until end_of_definition(next_control); -if next_control=module_name then - begin {we want to scan the module name too} - loc:=loc-2; next_control:=get_next; - end; -accumulator:=0; goto done; -end - -@ @<Set |val| to value of decimal...@>= -val:=0; -repeat val:=10*val+next_control-"0"; next_control:=get_next; -until (next_control>"9")or(next_control<"0") - -@ @<Set |val| to value of octal...@>= -val:=0; next_control:="0"; -repeat val:=8*val+next_control-"0"; next_control:=get_next; -until (next_control>"7")or(next_control<"0") - -@ @<Set |val| to value of hex...@>= -val:=0; next_control:="0"; -repeat if next_control>="A" then next_control:=next_control+"0"+10-"A"; -val:=16*val+next_control-"0"; next_control:=get_next; -until (next_control>"F")or(next_control<"0")or@| - ((next_control>"9")and(next_control<"A")) - -@* Scanning a macro definition. -The rules for generating the replacement texts corresponding to simple -macros, parametric macros, and \PASCAL\ texts of a module are almost -identical, so a single procedure is used for all three cases. The -differences are that - -\yskip\item{a)} The sign |#| denotes a parameter only when it appears -outside of strings in a parametric macro; otherwise it stands for the -ASCII character |#|. (This is not used in standard \PASCAL, but some -\PASCAL s allow, for example, `\.{/\#}' after a certain kind of file name.) - -\item{b)}Module names are not allowed in simple macros or parametric macros; -in fact, the appearance of a module name terminates such macros and denotes -the name of the current module. - -\item{c)}The symbols \.{@@d} and \.{@@f} and \.{@@p} are not allowed after -module names, while they terminate macro definitions. - -@ Therefore there is a procedure |scan_repl| whose parameter |t| specifies -either |simple| or |parametric| or |module_name|. After |scan_repl| has -acted, |cur_repl_text| will point to the replacement text just generated, and -|next_control| will contain the control code that terminated the activity. - -@<Globals...@>= -@!cur_repl_text:text_pointer; {replacement text formed by |scan_repl|} - -@ @p procedure scan_repl(@!t:eight_bits); {creates a replacement text} -label continue, done, found, reswitch; -var a:sixteen_bits; {the current token} -@!b:ASCII_code; {a character from the buffer} -@!bal:eight_bits; {left parentheses minus right parentheses} -begin bal:=0; -loop@+ begin continue: a:=get_next; - case a of - "(": incr(bal); - ")": if bal=0 then err_print('! Extra )') -@.Extra )@> - else decr(bal); - "'": @<Copy a string from the buffer to |tok_mem|@>; - "#": if t=parametric then a:=param; - @t\4@>@<In cases that |a| is a non-ASCII token (|identifier|, - |module_name|, etc.), either process it and change |a| to a byte - that should be stored, or |goto continue| if |a| should be ignored, - or |goto done| if |a| signals the end of this replacement text@>@; - othercases do_nothing - endcases;@/ - app_repl(a); {store |a| in |tok_mem|} - end; -done: next_control:=a; -@<Make sure the parentheses balance@>; -if text_ptr>max_texts-zz then overflow('text'); -cur_repl_text:=text_ptr; tok_start[text_ptr+zz]:=tok_ptr[z]; -incr(text_ptr); -if z=zz-1 then z:=0@+else incr(z); -end; - -@ @<Make sure the parentheses balance@>= -if bal>0 then - begin if bal=1 then err_print('! Missing )') - else err_print('! Missing ',bal:1,' )''s'); -@.Missing n )@> - while bal>0 do - begin app_repl(")"); decr(bal); - end; - end - -@ @<In cases that |a| is...@>= -identifier: begin a:=id_lookup(normal); app_repl((a div @'400)+@'200); - a:=a mod @'400; - end; -module_name: if t<>module_name then goto done - else begin app_repl((cur_module div @'400)+@'250); - a:=cur_module mod @'400; - end; -verbatim: @<Copy verbatim string from the buffer to |tok_mem|@>; -definition, format, begin_Pascal: if t<>module_name then goto done - else begin err_print('! @@',xchr[buffer[loc-1]], -@.\AT!p is ignored in Pascal text@> -@.\AT!d is ignored in Pascal text@> -@.\AT!f is ignored in Pascal text@> - ' is ignored in Pascal text'); goto continue; - end; -new_module: goto done; - -@ @<Copy a string...@>= -begin b:="'"; -loop@+ begin app_repl(b); - if b="@@" then - if buffer[loc]="@@" then incr(loc) {store only one \.{@@}} - else err_print('! You should double @@ signs in strings'); -@.You should double \AT! signs@> - if loc=limit then - begin err_print('! String didn''t end'); -@.String didn't end@> - buffer[loc]:="'"; buffer[loc+1]:=0; - end; - b:=buffer[loc]; incr(loc); - if b="'" then - begin if buffer[loc]<>"'" then goto found - else begin incr(loc); app_repl("'"); - end; - end; - end; -found: end {now |a| holds the final |"'"| that will be stored} - -@ @<Copy verbatim string...@>= -begin app_repl(verbatim); -buffer[limit+1]:="@@"; -reswitch: if buffer[loc]="@@" then - begin if loc<limit then if buffer[loc+1]="@@" then - begin app_repl("@@"); - loc:=loc+2; - goto reswitch; - end; - end -else begin app_repl(buffer[loc]); - incr(loc); - goto reswitch; - end; -if loc>=limit then err_print('! Verbatim string didn''t end') -@.Verbatim string didn't end@> -else if buffer[loc+1]<>">" then - err_print('! You should double @@ signs in verbatim strings'); -@.You should double \AT! signs@> -loc:=loc+2; -end {another |verbatim| byte will be stored, since |a=verbatim|} - -@ The following procedure is used to define a simple or parametric macro, -just after the `\.{==}' of its definition has been scanned. - -@p procedure define_macro(@!t:eight_bits); -var p:name_pointer; {the identifier being defined} -begin p:=id_lookup(t); scan_repl(t);@/ -equiv[p]:=cur_repl_text; text_link[cur_repl_text]:=0; -end; - -@* Scanning a module. -The |scan_module| procedure starts when `\.{@@\ }' or `\.{@@*}' has been -sensed in the input, and it proceeds until the end of that module. It -uses |module_count| to keep track of the current module number; with luck, -\.{WEAVE} and \.{TANGLE} will both assign the same numbers to modules. - -@<Globals...@>= -@!module_count:0..@'27777; {the current module number} - -@ The top level of |scan_module| is trivial. -@p procedure scan_module; -label continue, done, exit; -var p:name_pointer; {module name for the current module} -begin incr(module_count); -@<Scan the \(definition part of the current module@>; -@<Scan the \PASCAL\ part of the current module@>; -exit: end; - -@ @<Scan the \(definition part...@>= -next_control:=0; -loop@+ begin continue: while next_control<=format do - begin next_control:=skip_ahead; - if next_control=module_name then - begin {we want to scan the module name too} - loc:=loc-2; next_control:=get_next; - end; - end; - if next_control<>definition then goto done; - next_control:=get_next; {get identifier name} - if next_control<>identifier then - begin err_print('! Definition flushed, must start with ', -@.Definition flushed...@> - 'identifier of length > 1'); goto continue; - end; - next_control:=get_next; {get token after the identifier} - if next_control="=" then - begin scan_numeric(id_lookup(numeric)); goto continue; - end - else if next_control=equivalence_sign then - begin define_macro(simple); goto continue; - end - else @<If the next text is `|(#)==|', call |define_macro| - and |goto continue|@>; - err_print('! Definition flushed since it starts badly'); -@.Definition flushed...@> - end; -done: - -@ @<If the next text is `|(#)==|'...@>= -if next_control="(" then - begin next_control:=get_next; - if next_control="#" then - begin next_control:=get_next; - if next_control=")" then - begin next_control:=get_next; - if next_control="=" then - begin err_print('! Use == for macros'); -@.Use == for macros@> - next_control:=equivalence_sign; - end; - if next_control=equivalence_sign then - begin define_macro(parametric); goto continue; - end; - end; - end; - end; - -@ @<Scan the \PASCAL...@>= -case next_control of -begin_Pascal:p:=0; -module_name: begin p:=cur_module; - @<Check that |=| or |==| follows this module name, otherwise |return|@>; - end; -othercases return -endcases;@/ -@<Insert the module number into |tok_mem|@>; -scan_repl(module_name); {now |cur_repl_text| points to the replacement text} -@<Update the data structure so that the replacement text is accessible@>; - -@ @<Check that |=|...@>= -repeat next_control:=get_next; -until next_control<>"+"; {allow optional `\.{+=}'} -if (next_control<>"=")and(next_control<>equivalence_sign) then - begin err_print('! Pascal text flushed, = sign is missing'); -@.Pascal text flushed...@> - repeat next_control:=skip_ahead; - until next_control=new_module; - return; - end - -@ @<Insert the module number...@>= -store_two_bytes(@'150000+module_count); {|@'150000=@'320*@'400|} - -@ @<Update the data...@>= -if p=0 then {unnamed module} - begin text_link[last_unnamed]:=cur_repl_text; last_unnamed:=cur_repl_text; - end -else if equiv[p]=0 then equiv[p]:=cur_repl_text {first module of this name} -else begin p:=equiv[p]; - while text_link[p]<module_flag do p:=text_link[p]; {find end of list} - text_link[p]:=cur_repl_text; - end; -text_link[cur_repl_text]:=module_flag; - {mark this replacement text as a nonmacro} - -@* Debugging. -The \PASCAL\ debugger with which \.{TANGLE} was developed allows breakpoints -to be set, and variables can be read and changed, but procedures cannot be -executed. Therefore a `|debug_help|' procedure has been inserted in the main -loops of each phase of the program; when |ddt| and |dd| are set to appropriate -values, symbolic printouts of various tables will appear. - -The idea is to set a breakpoint inside the |debug_help| routine, at the -place of `\ignorespaces|breakpoint:|\unskip' below. Then when -|debug_help| is to be activated, set |trouble_shooting| equal to |true|. -The |debug_help| routine will prompt you for values of |ddt| and |dd|, -discontinuing this when |ddt<=0|; thus you type $2n+1$ integers, ending -with zero or a negative number. Then control either passes to the -breakpoint, allowing you to look at and/or change variables (if you typed -zero), or to exit the routine (if you typed a negative value). - -Another global variable, |debug_cycle|, can be used to skip silently -past calls on |debug_help|. If you set |debug_cycle>1|, the program stops -only every |debug_cycle| times |debug_help| is called; however, -any error stop will set |debug_cycle| to zero. - -@<Globals...@>= -@!debug@!trouble_shooting:boolean; {is |debug_help| wanted?} -@!ddt:integer; {operation code for the |debug_help| routine} -@!dd:integer; {operand in procedures performed by |debug_help|} -@!debug_cycle:integer; {threshold for |debug_help| stopping} -@!debug_skipped:integer; {we have skipped this many |debug_help| calls} -@!term_in:text_file; {the user's terminal as an input file} -gubed - -@ The debugging routine needs to read from the user's terminal. -@^system dependencies@> -@<Set init...@>= -@!debug trouble_shooting:=true; debug_cycle:=1; debug_skipped:=0;@/ -trouble_shooting:=false; debug_cycle:=99999; {use these when it almost works} -reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|} -gubed - -@ @d breakpoint=888 {place where a breakpoint is desirable} -@^system dependencies@> - -@p @!debug procedure debug_help; {routine to display various things} -label breakpoint,exit; -var k:integer; {index into various arrays} -begin incr(debug_skipped); -if debug_skipped<debug_cycle then return; -debug_skipped:=0; -loop@+ begin write(term_out,'#'); update_terminal; {prompt} - read(term_in,ddt); {read a list of integers} - if ddt<0 then return - else if ddt=0 then - begin goto breakpoint;@\ {go to every label at least once} - breakpoint: ddt:=0;@\ - end - else begin read(term_in,dd); - case ddt of - 1: print_id(dd); - 2: print_repl(dd); - 3: for k:=1 to dd do print(xchr[buffer[k]]); - 4: for k:=1 to dd do print(xchr[mod_text[k]]); - 5: for k:=1 to out_ptr do print(xchr[out_buf[k]]); - 6: for k:=1 to dd do print(xchr[out_contrib[k]]); - othercases print('?') - endcases; - end; - end; -exit:end; -gubed - -@* The main program. -We have defined plenty of procedures, and it is time to put the last -pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where -it ends. -@^system dependencies@> - -@p begin initialize; -@<Initialize the input system@>; -print_ln(banner); {print a ``banner line''} -@<Phase I: Read all the user's text and compress it into |tok_mem|@>; -stat for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii];@+tats@;@/ -@<Phase II:...@>; -end_of_TANGLE: -if string_ptr>number_chars 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|@>; -end. - -@ @<Phase I:...@>= -phase_one:=true; -module_count:=0; -repeat next_control:=skip_ahead; -until next_control=new_module; -while not input_has_ended do scan_module; -@<Check that all changes have been read@>; -phase_one:=false; - -@ @<Finish off the string pool file@>= -begin print_nl(string_ptr-number_chars:1, - ' strings written to string pool file.'); -write(pool,'*'); -for ii:=1 to 9 do - begin out_buf[ii]:=pool_check_sum mod 10; - pool_check_sum:=pool_check_sum div 10; - end; -for ii:=9 downto 1 do write(pool,xchr["0"+out_buf[ii]]); -write_ln(pool); -end - -@ @<Glob...@>= -stat @!wo:0..ww-1; {segment of memory for which statistics are being printed} -tats - -@ @<Print statistics about memory usage@>= -print_nl('Memory usage statistics:'); -print_nl(name_ptr:1, ' names, ', text_ptr:1, ' replacement texts;'); -print_nl(byte_ptr[0]:1); -for wo:=1 to ww-1 do print('+',byte_ptr[wo]:1); -if phase_one then - for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii]; -print(' bytes, ', max_tok_ptr[0]:1); -for ii:=1 to zz-1 do print('+',max_tok_ptr[ii]:1); -print(' tokens.'); - -@ Some implementations may wish to pass the |history| value to the -operating system so that it can be used to govern whether or not other -programs are started. Here we simply report the history to the user. -@^system dependencies@> - -@<Print the job |history|@>= -case history of -spotless: print_nl('(No errors were found.)'); -harmless_message: print_nl('(Did you see the warning message above?)'); -error_message: print_nl('(Pardon me, but I think I spotted something wrong.)'); -fatal_message: print_nl('(That was a fatal error, my friend.)'); -end {there are no other cases} - -@* System-dependent changes. -This module should be replaced, if necessary, by changes to the program -that are necessary to make \.{TANGLE} work at a particular installation. -It is usually best to design your change file so that all changes to -previous modules preserve the module numbering; then everybody's version -will be consistent with the printed program. More extensive changes, -which introduce new modules, can be inserted here; then only the index -itself will get a new module number. -@^system dependencies@> - -@* Index. -Here is a cross-reference table for the \.{TANGLE} processor. -All modules in which an identifier is -used are listed with that identifier, except that reserved words are -indexed only when they appear in format definitions, and the appearances -of identifiers in module names are not indexed. Underlined entries -correspond to where the identifier was declared. Error messages and -a few other things like ``ASCII code'' are indexed here too. |