diff options
author | Karl Berry <karl@freefriends.org> | 2021-02-25 19:22:25 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2021-02-25 19:22:25 +0000 |
commit | ad547a6b5986815fda458221149728d9d9ab1d87 (patch) | |
tree | 16296910eb3eca724371474ea9aea3994dc69614 /Build/source/texk/web2c/tangle.web | |
parent | 947b43de3dd21d58ccc2ffadefc4441ea1c2a813 (diff) |
restore Build,TODO from r57911
git-svn-id: svn://tug.org/texlive/trunk@57915 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/tangle.web')
-rw-r--r-- | Build/source/texk/web2c/tangle.web | 3324 |
1 files changed, 3324 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/tangle.web b/Build/source/texk/web2c/tangle.web new file mode 100644 index 00000000000..d20bbd85928 --- /dev/null +++ b/Build/source/texk/web2c/tangle.web @@ -0,0 +1,3324 @@ +% 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). +% Version 4.5 prevents modno-comments from being split across lines (Dec 2002). +% Version 4.6 fixes archaic @@z logic; is again big enough for TeX (Jan 2021). + +% 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{TANGLE} +\def\contentspagenumber{125} % 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 TANGLE} processor} + \vskip 15pt + \centerline{(Version 4.6)} + \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 TANGLE, Version 4.6' + +@ 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 TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool); +label end_of_TANGLE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@<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=45000; {|1/ww| times the number of bytes in identifiers, + strings, and module names; must be less than 65536} +@!max_toks=65000; {|1/zz| times the number of bytes in compressed \PASCAL\ code; + must be less than 65536} +@!max_names=4000; {number of identifiers, strings, module names; + must be less than 10240} +@!max_texts=2000; {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 + +@<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=0..65535; {unsigned 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 or 2. (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:=256; 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 search 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_n$, 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]+@'100000 +else begin equiv[p]:=string_ptr+@'100000; + 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. +The \.{@@>} at the end of such a string is also denoted by |verbatim|. + +\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]-@'100000; 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$&&$-1$\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$&$-1$\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 `|out_contrib[1]:="{"|' that appears here should +be replaced by `\ignorespaces|begin out_contrib[1]:="("; out_contrib[2]:="*"; +incr(k); end|', and a similar change should be made to +`|out_contrib[k]:="}"|'. + +@<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 k:=2; + if brace_level=0 then out_contrib[1]:="{" + else out_contrib[1]:="["; + if cur_val<0 then + begin out_contrib[k]:=":"; cur_val:=-cur_val; incr(k); + end; + n:=10; + while cur_val>=n do n:=10*n; + repeat n:=n div 10; + out_contrib[k]:="0"+(cur_val div n); cur_val:=cur_val mod n; incr(k); + until n=1; + if out_contrib[2]<>":" then + begin out_contrib[k]:=":"; incr(k); + end; + if brace_level=0 then out_contrib[k]:="}" + else out_contrib[k]:="]"; + send_out(str,k); + 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 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-1 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<>"*") 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 procedure |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)>=@'100000 then + begin err_print('! Value too big: ',accumulator:1); accumulator:=0; +@.Value too big@> + end; +equiv[p]:=accumulator+@'100000; {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]-@'100000); + 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 print_nl('#'); update_terminal; {prompt} + read(term_in,ddt); {read a debug-command code} + 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>256 then @<Finish off the string pool file@>; +stat @<Print statistics about memory usage@>;@+tats@;@/ +@t\4\4@>{here files should be closed if the operating system requires it} +@<Print the job |history|@>; +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-256: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. |