diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /web/noweb/examples |
Initial commit
Diffstat (limited to 'web/noweb/examples')
-rw-r--r-- | web/noweb/examples/Makefile | 55 | ||||
-rw-r--r-- | web/noweb/examples/Makefile.awk | 58 | ||||
-rw-r--r-- | web/noweb/examples/README | 49 | ||||
-rw-r--r-- | web/noweb/examples/README.h | 72 | ||||
-rw-r--r-- | web/noweb/examples/breakmodel.nw | 459 | ||||
-rw-r--r-- | web/noweb/examples/compress.nw | 1637 | ||||
-rw-r--r-- | web/noweb/examples/dag.nw | 163 | ||||
-rw-r--r-- | web/noweb/examples/graphs.nw | 244 | ||||
-rw-r--r-- | web/noweb/examples/mipscoder.nw | 1118 | ||||
-rw-r--r-- | web/noweb/examples/multicol.sty | 525 | ||||
-rw-r--r-- | web/noweb/examples/primes.bbl | 13 | ||||
-rw-r--r-- | web/noweb/examples/primes.nw | 186 | ||||
-rw-r--r-- | web/noweb/examples/scanner.nw | 444 | ||||
-rwxr-xr-x | web/noweb/examples/sharpline | 31 | ||||
-rw-r--r-- | web/noweb/examples/test.nw | 17 | ||||
-rw-r--r-- | web/noweb/examples/tree.nw | 326 | ||||
-rw-r--r-- | web/noweb/examples/wc.bbl | 14 | ||||
-rw-r--r-- | web/noweb/examples/wc.nw | 372 | ||||
-rw-r--r-- | web/noweb/examples/wc.nw2html | 370 | ||||
-rw-r--r-- | web/noweb/examples/whitespace | 10 |
20 files changed, 6163 insertions, 0 deletions
diff --git a/web/noweb/examples/Makefile b/web/noweb/examples/Makefile new file mode 100644 index 0000000000..9295cf54fc --- /dev/null +++ b/web/noweb/examples/Makefile @@ -0,0 +1,55 @@ +WWW=$(HOME)/www/noweb/examples +SHELL=/bin/sh +NOTANGLE=nountangle -m3 +NOWEAVE=noweave + +.SUFFIXES: .i3 .m3 .nw .tex .dvi .html +.nw.html: ; $(NOWEAVE) -filter l2h -filter btdefn -index -html $*.nw > $*.html +.nw.tex: ; $(NOWEAVE) -index -filter btdefn $*.nw > $*.tex +.nw.i3: ; $(NOTANGLE) -Rinterface -L'<* LINE %L "%F" *>%N' $*.nw > $*.i3 +.nw.m3: ; $(NOTANGLE) -L'<* LINE %L "%F" *>%N' $*.nw > $*.m3 +.tex.dvi: ; latex '\scrollmode \input '"$*"; while grep -s 'Rerun to get cross-references right' $*.log; do latex '\scrollmode \input '"$*"; done + +HTML=breakmodel.html compress.html dag.html graphs.html mipscoder.html primes.html \ + scanner.html test.html tree.html wc.html wcni.html + + +www: $(HTML) + copy -v $(HTML) $(WWW) + copy -v README.h $(WWW)/index.html + +clean: + rm -f *~ *.aux *.tex *.dvi *.log *.html *.toc + +clobber: clean + +compress.html: compress.nw + $(NOWEAVE) -filter l2h -index -autodefs c -html compress.nw > compress.html +compress.tex: compress.nw + $(NOWEAVE) -index -autodefs c compress.nw > compress.tex +dag.html: dag.nw + $(NOWEAVE) -filter l2h -index -autodefs icon -html dag.nw > dag.html +dag.tex: dag.nw + $(NOWEAVE) -index -autodefs icon dag.nw > dag.tex +mipscoder.html: mipscoder.nw + $(NOWEAVE) -filter l2h -index -autodefs sml -html mipscoder.nw > mipscoder.html +mipscoder.tex: mipscoder.nw + $(NOWEAVE) -autodefs sml -index mipscoder.nw > mipscoder.tex +scanner.html: scanner.nw + $(NOWEAVE) -filter l2h -index -autodefs c -autodefs yacc -html scanner.nw > scanner.html +scanner.tex: scanner.nw + $(NOWEAVE) -index -autodefs c -autodefs yacc scanner.nw > scanner.tex +tree.html: tree.nw + $(NOWEAVE) -filter l2h -index -autodefs icon -html tree.nw > tree.html +tree.tex: tree.nw + $(NOWEAVE) -index -autodefs icon tree.nw > tree.tex +test.html: test.nw + $(NOWEAVE) -filter l2h -html test.nw > test.html +test.tex: test.nw + $(NOWEAVE) test.nw > test.tex +wc.html: wc.nw2html + $(NOWEAVE) -autodefs c -filter btdefn -index -html -n wc.nw2html > wc.html +wcni.html: wc.nw2html + $(NOWEAVE) -filter btdefn -x -html -n wc.nw2html > wcni.html +wc.tex: wc.nw + $(NOWEAVE) -autodefs c -filter btdefn -index wc.nw > wc.tex diff --git a/web/noweb/examples/Makefile.awk b/web/noweb/examples/Makefile.awk new file mode 100644 index 0000000000..304fe88baa --- /dev/null +++ b/web/noweb/examples/Makefile.awk @@ -0,0 +1,58 @@ +WWW=$(HOME)/www/noweb/examples +SHELL=/bin/sh +NOTANGLE=nountangle -m3 +NOWEAVE=noweave + +.SUFFIXES: .i3 .m3 .nw .tex .dvi .html +.nw.html: ; $(NOWEAVE) -filter btdefn -index -html $*.nw > $*.html +.nw.tex: ; $(NOWEAVE) -index -filter btdefn $*.nw > $*.tex +.nw.i3: ; $(NOTANGLE) -Rinterface -L'<* LINE %L "%F" *>%N' $*.nw > $*.i3 +.nw.m3: ; $(NOTANGLE) -L'<* LINE %L "%F" *>%N' $*.nw > $*.m3 +.tex.dvi: ; latex '\scrollmode \input '"$*"; while grep -s 'Rerun to get cross-references right' $*.log; do latex '\scrollmode \input '"$*"; done + +HTML=breakmodel.html compress.html dag.html graphs.html mipscoder.html primes.html \ + scanner.html test.html tree.html wc.html wcni.html +DVI=compress.dvi dag.dvi mipscoder.dvi scanner.dvi tree.dvi test.dvi wc.dvi + + +texonly: $(DVI) + +www: $(HTML) + copy -v $(HTML) $(WWW) + copy -v README.h $(WWW)/index.html + +clean: + rm -f *~ *.aux *.tex *.dvi *.log *.html *.toc + +clobber: clean + +compress.html: compress.nw + $(NOWEAVE) -index -html compress.nw > compress.html +compress.tex: compress.nw + $(NOWEAVE) -index compress.nw > compress.tex +dag.html: dag.nw + $(NOWEAVE) -index -html dag.nw > dag.html +dag.tex: dag.nw + $(NOWEAVE) -index dag.nw > dag.tex +mipscoder.html: mipscoder.nw + $(NOWEAVE) -index -html mipscoder.nw > mipscoder.html +mipscoder.tex: mipscoder.nw + $(NOWEAVE) -index mipscoder.nw > mipscoder.tex +scanner.html: scanner.nw + $(NOWEAVE) -index -html scanner.nw > scanner.html +scanner.tex: scanner.nw + $(NOWEAVE) -index scanner.nw > scanner.tex +tree.html: tree.nw + $(NOWEAVE) -index -html tree.nw > tree.html +tree.tex: tree.nw + $(NOWEAVE) -index tree.nw > tree.tex +test.html: test.nw + $(NOWEAVE) -html test.nw > test.html +test.tex: test.nw + $(NOWEAVE) test.nw > test.tex +wc.html: wc.nw2html + $(NOWEAVE) -filter btdefn -index -html -n wc.nw2html > wc.html +wcni.html: wc.nw2html + $(NOWEAVE) -filter btdefn -x -html -n wc.nw2html > wcni.html +wc.tex: wc.nw + $(NOWEAVE) -filter btdefn -index wc.nw > wc.tex diff --git a/web/noweb/examples/README b/web/noweb/examples/README new file mode 100644 index 0000000000..3cf8e981a4 --- /dev/null +++ b/web/noweb/examples/README @@ -0,0 +1,49 @@ +All these examples have been set up to work with latex, although I +often prefer plain TeX because latex's page breaking is so bad and so +hard to control. breakmodel.nw is the only one that requires +cross-referencing (noweave -x). I have included the nonstandard +`multicol' style file, although it is readily available as part of the +Mainz distribution. + +Except for breakmodel.nw, each example file is a fragment of a larger +program. noweb itself is not a good example of literate programming. +It is harder than most people realize to write a truly literate +program, and noweb wasn't worth the effort. + +If you have installed noweb with LIBSRC=awk instead of LIBSRC=icon, +you need to use Makefile.awk instead of Makefile. + +The files are: + + Makefile Shows some sample default rules for use + in a Makefile. Try `make tree.tex tree.dvi'. + Makefile.awk Like Makefile but doesn't require Icon. + None of the HTML examples will be readable + without Icon. + breakmodel.nw A formal model of breakpoints using the + Promela modeling language. + dag.nw Fragment of an Icon program that compiles + patterns into decision-tree pattern-matching + code. tree.nw builds the decision trees; + dag.nw turns them into dags. + graphs.nw Several graphs written in jgraph (write + plank@cs.utk.edu for information about jgraph). + mipscoder.nw Part of the original MIPS code generator from + Standard ML of New Jersey. Writting in Standard ML. + primes.nw noweb version of DEK's original prime-number program. + scanner.nw Part of a student compiler project. Includes + C code and lex and yacc specifications, all in + a single file. + sharpline A noweb filter that makes noweb `see' #line directives + in a noweb file. + test.nw A simple test file. + tree.nw Fragment of an Icon program that compiles + patterns into decision-tree pattern-matching + code. tree.nw builds the decision trees; + dag.nw turns them into dags. + wc.nw A re-implementation in noweb of the CWEB + example from DEK's book. This example is + intended to be as exact a copy as possible; no + attempt was made to improve the code. + whitespace A noweb filter that makes whitespace insignificant + within chunk names. diff --git a/web/noweb/examples/README.h b/web/noweb/examples/README.h new file mode 100644 index 0000000000..0ff13d92e8 --- /dev/null +++ b/web/noweb/examples/README.h @@ -0,0 +1,72 @@ +<html> +<head> +<title>Examples programs written in <tt>noweb</tt></title> +</head> +<body> +<h1>Noweb example programs</h1> +All but one of +these examples have had their documentation parts converted automatically +from LaTeX to HTML. +(Can you tell which one?) +Except for <a href=breakmodel.html>breakmodel</a>, +each example file is a fragment of a larger +program. +<p> +The typical command line used to create one of these documents is: +<pre> +noweave -filter l2h -index -autodefs c -html compress.nw > compress.html +</pre> +for various values of <tt>c</tt> :-) +<p> +The example programs are: +<dl> +<dt><a href=breakmodel.html>breakmodel</a><dd> + A formal model of breakpoints using the + Promela modeling language. +<dt><a href=compress.html>compress</a><dd> + A library that modifies the <t>open</t>, <t>close</t>, <t>read</t>, + and <t>write</t> system calls (along with some others) to + transparently read and write files in Unix <t>compress</t> format. + Graciously contributed by + <a href=http://www.cs.princeton.edu/~blume>Matthias Blume</a> +<dt><a href=dag.html>dag</a><dd> + Fragment of an <a href=http://www.cs.arizona.edu/icon/>Icon</a> + program that compiles + patterns into decision-tree pattern-matching + code. tree.nw builds the decision trees; + dag.nw turns them into dags. +<dt><a href=graphs.html>graphs</a><dd> + Several graphs written in + <a href=http://www.cs.utk.edu/~plank/plank/jgraph/jgraph.html>jgraph</a>. +<dt><a href=mipscoder.html>mipscoder</a><dd> + Part of the original MIPS code generator from + Standard ML of New Jersey. Written in Standard ML. +<dt><a href=primes.html>primes</a><dd> + noweb version of DEK's original prime-number program. + I got tired of typing and never entered all the text. +<dt><a href=scanner.html>scanner</a><dd> + Part of a student compiler project. Includes + C code and lex and yacc specifications, all in + a single file. +<dt><a href=solver.html>solver</a><dd> +An equation solver, published in <em>Software---Practice & Experience</em>. +The <A href=/~nr/pubs/solver.ps>PostScript</a> is probably easier to read. +<dt><a href=test.html>test</a><dd> + A simple test file. +<dt><a href=tree.html>tree</a><dd> + Fragment of an <a href=http://www.cs.arizona.edu/icon/>Icon</a> + program that compiles + patterns into decision-tree pattern-matching + code. tree.nw builds the decision trees; + dag.nw turns them into dags. +<dt><a href=wc.html>wc</a><dd> + An re-implementation of the example word-count program from Don + Knuth's book on literate programming. + This example is as exact a copy as possible; no + attempt was made to improve the code. + <a href="wcni.html">Here</a> is a version without identifier + cross-reference, which gives it a cleaner look. + <a href="wc.nw.html">Here</a> you can see a plain-text + rendering of the <tt>noweb</tt> source. +</dl> +</body> diff --git a/web/noweb/examples/breakmodel.nw b/web/noweb/examples/breakmodel.nw new file mode 100644 index 0000000000..284ad01719 --- /dev/null +++ b/web/noweb/examples/breakmodel.nw @@ -0,0 +1,459 @@ +% \global\def\begindocs#1{\relax} +% \global\let\enddocs=\relax + +{\def\semifilbreak#1{\vskip0pt plus #1\penalty-200\vskip0pt plus -#1} +\def\single{\def\baselinestretch{1.0}\small\normalsize} + +% l2h ignore semifilbreak { +% l2h ignore single + +% l2h substitution LA < +% l2h substitution RA > + +\section{A Formal Model of Breakpoints} +\label{appendix:breakpoint-model} +This appendix provides a formal model of {\tt ldb}'s follow-set breakpoints. +The model takes the form of a PROMELA program~\cite{holzmann:design}. +PROMELA programs define several threads of control that communicate by +passing messages. +Each thread of control runs a program written in a guarded-command +language with a C-like syntax. +Programs may be nondeterministic. +PROMELA can simulate the execution of a program and +search its state space for states violating assertions embedded in the +program. +The simulator also searches for states with no successors, i.e., +deadlocks. + +The PROMELA code in this appendix models {\tt ldb}'s implementation of +breakpoints. +Although {\tt ldb} does not work with multithreaded programs, the +model uses multiple threads because a procedure call from {\tt ldb} to +a target process effectively creates a new thread. +The assertions embedded in the model specify that the debugger +takes a breakpoint action just before any thread's +successful execution of the instruction at the breakpoint. +Breakpoints may be implemented either in the operating system or in +the debugger itself; the choice does not affect the model used here. +The model assumes it can plant trap instructions in +the instruction stream of the target program, and that +it will be notified when the target program encounters a trap. +The model also suits a machine with a ``trace mode'' + that causes a trap after the execution of every instruction. + + +The model has a single +breakpoint. +To keep the state space small, the model has only two threads, so that + a single bit can represent thread [[id]]s.\label{noweb-sample-page-number} +<<declarations>>= +#define NTHREADS 2 +#define threadid bit +@ \noindent +The {\footnotesize\pageref{noweb-sample-page-number}} in +\LA{}declarations~\footnotesize\pageref{noweb-sample-page-number}\RA{} +is the page number on which the definition appears. + +\section{Modeling the program counter and execution} +To keep things simple, I partition the possible values of the program +counter into three sets: +\begin{quote} +\begin{tabular}{ll} + [[Break]]&the breakpoint itself,\\ + [[Follow]]&the instruction(s) following the breakpoint,\\ + [[Outside]]&outside the breakpoint.\\ +\end{tabular} +\end{quote} +\semifilbreak{2\baselineskip} +\noindent The three sets are modeled by the following constants. +<<declarations>>= +#define NPCS 3 +#define Break 0 /* pc at the breakpoint */ +#define Follow 1 /* pc in breakpoint's follow set */ +#define Outside 2 /* all other pc's */ +@ + +The ability to plant traps is modeled by the array [[trapped]], which +records whether a trap instruction has been +stored at a particular location: +<<declarations>>= +bool trapped[NPCS]; +@ + +The model has five active components: two threads, a CPU that +executes one thread at a time, the breakpoint, and the rest of the debugger. +Here are the channels that are used for communication between the +threads, the CPU, the breakpoint, and the debugger. +Taking a breakpoint action is modeled by sending a message on the channel +[[breakaction]]. +<<declarations>>= +chan execute[NTHREADS] = [0] of {bit}; /* try to execute instruction */ +chan cont[NTHREADS] = [0] of {bit}; /* instruction executed */ +chan trap = [0] of {byte}; /* CPU trapped on id! */ +chan resume = [0] of {bit}; /* debugger resumed after trap */ +chan breakaction = [0] of {byte}; /* deliver breakpoint to debugger */ +@ \noindent [[[0]]] indicates that the channels are synchronous; + senders block until a receiver is ready and vice~versa.{\hfuzz=0.9pt\par} + +The communication structure is: +\begin{center} +\setlength{\unitlength}{0.01in}% +\footnotesize +\begin{picture}(580,180)( 50,-90) +\thicklines +\put(585, 0){\oval(90,60)} +\put(402, 0){\oval(90,62)} +\put(252, 0){\oval(90,60)} +\put( 95, 60){\oval(90,60)} +\put( 95,-60){\oval(90,60)} +\put(295, 10){\vector( 1, 0){ 60}} +\put(355,-10){\vector(-1, 0){ 60}} +\put(450, 0){\vector( 1, 0){ 90}} +\put(140, 55){\vector( 2,-1){ 70}} +\put(205, 10){\vector(-2, 1){ 70}} +\put(135,-45){\vector( 2, 1){ 70}} +\put(210,-20){\vector(-2,-1){ 70}} +\put(585, 0){\makebox(0,0){{\tt debugger()}}} +\put(402, 0){\makebox(0,0){{\tt breakpoint()}}} +\put(255, 0){\makebox(0,0){{\tt CPU()}}} +\put( 95,-65){\makebox(0,0)[b]{{\tt thread(1)}}} +\put( 95, 55){\makebox(0,0)[b]{{\tt thread(0)}}} +\put(165,-21){\makebox(0,0)[rb]{{\tt execute[1]}}} +\put(165, 16){\makebox(0,0)[rb]{{\tt cont[0]}}} +\put(170,-50){\makebox(0,0)[lb]{{\tt cont[1]}}} +\put(165, 50){\makebox(0,0)[lb]{{\tt execute[0]}}} +\put(330,-20){\makebox(0,0)[b]{{\tt resume}}} +\put(330, 15){\makebox(0,0)[b]{{\tt trap!id}}} +\put(493, 5){\makebox(0,0)[b]{{\tt breakaction!id}}} +\end{picture} +\end{center} +@ + +\noindent The CPU repeats the following steps. +\begin{enumerate}\single +\item +Wait for a thread to attempt to execute the instruction at [[pc]]. +\item +If the instruction is a trap, notify the debugger. +When the debugger tells the CPU to resume, [[pc]] is unchanged. +\item +If the instruction is not a trap, advance [[pc]]. +\item +Ask the thread to continue executing. +\end{enumerate} +There is only one debugger, but there are multiple threads, and each +one has its own [[pc]] and its own communication with the CPU. +When the CPU notifies the debugger of a trap, it identifies the +trapping thread. +Other messages are used only for synchronization, so they send and +receive the nonsense variable [[x]]. +<<declarations>>= +bit x; /* junk variable for sending messages */ +@ +A [[proctype]] is a procedure that a thread can execute; this one +models the CPU. + [[c?x]] receives the value [[x]] on channel [[c]]; [[c!x]] sends. +Arrows ([[->]]) separate guards from commands. +<<proctypes>>= +proctype CPU(byte count) { + threadid id = 0; + do + :: execute[id]?x -> + if + :: trapped[pc[id]] -> trap!id ; resume?x + :: !trapped[pc[id]] -> <<advance [[pc[id]]]>> + fi; + cont[id]!x; + <<possible context switch (change of [[id]])>> + od +} +@ Context switching is discussed below. +@ +\semifilbreak{1in} % page tuning +@ +Since the program counter is an abstraction, advancing it does not +mean incrementing it. A successful execution at [[Break]] is +guaranteed to be followed by an attempt to execute [[Follow]]; +aside from that, any instruction can follow any other. +<<advance [[pc[id]]]>>= +if +:: pc[id] == Break -> pc[id] = Follow +:: pc[id] != Break -> /* any instruction can be next */ + if + :: pc[id] = Outside + :: pc[id] = Break + :: pc[id] = Follow + fi +fi +@ \noindent +The second [[if]] statement has no guards, so an alternative is +chosen nondeterministically. + +All threads begin execution outside the breakpoint. +<<declarations>>= +byte pc[NTHREADS]; +<<initialize data for thread [[id]]>>= +pc[id] = Outside; + +@ +\section{Counting events} +The correctness criterion for the breakpoint implementation is that +one breakpoint action must be taken for every +successful execution of an instruction at [[Break]]. +[[threadcount[id]]] counts how many times thread~[[id]] +has executed the breakpoint, and [[actioncount[id]]] counts how many +breakpoint actions have been taken on behalf of thread~[[id]]. +<<declarations>>= +byte threadcount[NTHREADS]; +byte actioncount[NTHREADS]; +<<initialize data for thread [[id]]>>= +threadcount[id] = 0; +actioncount[id] = 0; +@ +\semifilbreak{0.75in} % page tuning +@ +Here is the model of a thread, including the assertion that the thread +and debugger counts are the same: +<<proctypes>>= +proctype thread(threadid id) { + do + :: if + :: pc[id] == Break -> execute[id]!x; cont[id]?x; + <<if successfully executed [[Break]], increment [[threadcount[id]]]>> + :: pc[id] != Break -> execute[id]!x; cont[id]?x + fi; + assert(pc[id] != Outside || threadcount[id] == actioncount[id]) + od +} +@ +The corresponding model of the debugger is +<<proctypes>>= +proctype debugger() { + threadid id; + do + :: atomic { breakaction?id -> <<increment [[actioncount[id]]]>> } + od +} +@ \noindent +[[atomic]] groups statements into a single atomic action. +When the debugger takes a breakpoint action, it atomically increments +[[actioncount[id]]]. +Without [[atomic]], it might delay incrementing the counter and +invalidate the assertion above. + +A thread knows it has successfully executed [[Break]] if the [[pc]] +has changed: +<<if successfully executed [[Break]], increment [[threadcount[id]]]>>= +if +:: pc[id] != Break -> <<increment [[threadcount[id]]]>> +:: pc[id] == Break -> skip +fi +@ + To keep the state space small, I restrict the values of the +counters to be in the range [[0..3]]. +<<increment [[threadcount[id]]]>>= +threadcount[id] = (threadcount[id] + 1) % 4 +<<increment [[actioncount[id]]]>>= +actioncount[id] = (actioncount[id] + 1) % 4 +@ +\section{Implementing the breakpoint} +There is a long tradition of implementing breakpoints using traps +and single stepping. To set a breakpoint at $I$, plant a trap +at $I$. When the target program hits the trap, that's a breakpoint +event. +To resume execution after the breakpoint, + restore the original instruction to $I$, + single step the machine to execute just the instruction at $I$, +and once again plant a trap at $I$ and continue execution. +Not all machines have a single-step mode in hardware, but +single stepping can be simulated in software by using more trap +instructions. +In my model, I eliminate single stepping entirely, working directly +with trap instructions and a follow set +(modeled by [[Follow]]). + +The simpler model does not preclude the use of hardware single stepping. +One of the operations in the model is planting traps at the locations +in the follow set of an instruction. +This operation can be implemented either by computing the follow set +and planting actual traps, or by setting a trace bit on a machine with +hardware single stepping. + +\semifilbreak{3\baselineskip} + +An active breakpoint is trapped either on the instruction of the +breakpoint itself or on that instruction's follow set. +The breakpoint keeps track of which state it is in, with the following +invariant. +\begin{verbatim} + breakstate == Break && trapped[Break] = 1 && trapped[Follow] = 0 +|| breakstate == Follow && trapped[Break] = 0 && trapped[Follow] = 1 +\end{verbatim} +<<declarations>>= +byte breakstate = Break; +<<initialization>>= +trapped[Break] = 1; +@ Changing the state preserves the invariant.\label{move-traps-page} +<<move traps to [[Break]]>>= +atomic { breakstate = Break; trapped[Break] = 1; trapped[Follow] = 0 } +<<move traps to [[Follow]]>>= +atomic { breakstate = Follow; trapped[Break] = 0; trapped[Follow] = 1 } +@ + +It's necessary to keep track of the state of each thread with respect +to the breakpoint. A thread is ``in the breakpoint'' if it has +trapped at [[Break]], and it does not ``leave the breakpoint'' until +it traps at [[Follow]]. Threads are initially outside the breakpoint. +<<declarations>>= +bit inbreak[NTHREADS]; +<<initialize data for thread [[id]]>>= +inbreak[id] = 0; +@ +\semifilbreak{2in} % page tuning +@ +One possible implementation just keeps track of the various states and +delivers a breakpoint event at the right time: +<<candidate breakpoint implementation>>= +proctype breakpoint() { + threadid id; + + do + :: trap?id -> + if + :: breakstate == Break -> + if + :: !inbreak[id] -> breakaction!id ; inbreak[id] = 1 + :: inbreak[id] -> skip /* no event */ + fi; + <<move traps to [[Follow]]>> + :: breakstate == Follow -> + if + :: inbreak[id] -> inbreak[id] = 0 + :: !inbreak[id] -> skip + fi; + <<move traps to [[Break]]>> + fi; + resume!x + od +} +@ +This implementation works fine for a single thread. +With two threads, the PROMELA state-space search finds the +following erroneous execution sequence +(attempted executions that trap are marked with a {*}): +\begin{quote}\single +\begin{tabular}{llcc} +breakpoint (debugger)& CPU & thread 0 & thread 1\\ +& & [[Outside]]\\ +& & [[Break]]\rlap{*}\\ +%\multicolumn{3}{l} +{\LA{}take breakpoint action\RA{}}\\ +{\LA{}move traps to [[Follow]]~\footnotesize\pageref{move-traps-page}\RA{}}\\ +resume\\ +&context switch\\ + &&& [[Outside]]\\ + &&& [[Break]]\\ + &&& [[Follow]]\rlap{*}\\ +%\multicolumn{3}{l} +{\LA{}take no action\RA{}}\\ +{\LA{}move traps to [[Break]]~\footnotesize\pageref{move-traps-page}\RA{}}\\ +resume\\ + &&& [[Outside]]\\ +&context switch\\ + && [[Follow]]\\ + && [[Outside]]\\ +\end{tabular} +\end{quote} +In this execution sequence, thread~1 goes through the breakpoint +without triggering a breakpoint action. +In an earlier version of {\tt ldb}, this sequence could be provoked by +executing a procedure call after the user's program hit a breakpoint; +the user's program was thread~0, and the procedure call was thread~1. + +%%%% \semifilbreak{3in} % page tuning +To prevent such an occurrence, the CPU must not be permitted to change +contexts when a thread is in the middle of a breakpoint. +If the CPU can change contexts only when [[noswitch == 0]], then the +following breakpoint implementation works correctly. +<<proctypes>>= +proctype breakpoint() { + threadid id; + + do + :: trap?id -> + if + :: breakstate == Break -> + if + :: !inbreak[id] -> breakaction!id ; inbreak[id] = 1 + :: inbreak[id] -> assert(0) + fi; + noswitch = noswitch + 1; + <<move traps to [[Follow]]>> + :: breakstate == Follow -> + if + :: inbreak[id] -> inbreak[id] = 0 + :: !inbreak[id] -> assert(0) + fi; + noswitch = noswitch - 1; + <<move traps to [[Break]]>> + fi; + resume!x + od +} +@ \noindent The ban on context switching makes it possible to strengthen + [[skip]] to [[assert(0)]]. + +[[noswitch]] is declared to be a counter, not a bit, because that +implementation generalizes to multiple breakpoints. +<<declarations>>= +byte noswitch = 0; +@ +\semifilbreak{1.6in} % page tuning +@ +The CPU code to do the context switching correctly is: +<<possible context switch (change of [[id]])>>= +if +:: noswitch == 0 -> <<set [[id]] randomly>> +:: noswitch > 0 -> skip +fi +<<set [[id]] randomly>>= +atomic { + if + :: id = 0 + :: id = 1 + fi +} +@ +\section{Completing the model} +The boilerplate needed to turn the model into +a complete PROMELA specification is: +<<*>>= +<<declarations>> +<<proctypes>> +init { + threadid id; + atomic { + <<initialization>> + <<for $0 \le \tt id < NTHREADS$, initialize data for thread [[id]]>>; + run thread(0); + run thread(1); + run debugger(); + run breakpoint(); + run CPU (2) + } +} +@ \semifilbreak{1in} +<<for $0 \le \tt id < NTHREADS$, initialize data for thread [[id]]>>= +id = 0; +do +:: id < NTHREADS -> <<initialize data for thread [[id]]>> + if + :: id == NTHREADS - 1 -> break + :: id < NTHREADS - 1 -> id = id + 1 + fi +od +@ +} +@ +\section{List of chunks} +\nowebchunks diff --git a/web/noweb/examples/compress.nw b/web/noweb/examples/compress.nw new file mode 100644 index 0000000000..9c24df13fe --- /dev/null +++ b/web/noweb/examples/compress.nw @@ -0,0 +1,1637 @@ +\title{Transparent on-the-fly data compression {\tt COS595}} +\author{Matthias Blume\\ +Dept.\ of Computer Science, Princeton University,\\ +Princeton, NJ 08544} + +\maketitle + +\tableofcontents + +\section{Introduction} + +The C library on UNIX provides functions for calling the operating +system. +Replacing those functions can provide a different program functionality +without the need to make changes to the program text. + +Replacing the functions [[open]], [[creat]], [[close]], [[read]] and +[[write]] along with a couple of other routines will change the file +system interface. +Since on today's computer systems most information are stored with a +high redundancy, it seems to be useful to apply data compression +algorithms to them. +If the compression and uncompression is done by the file system +interface itself, then it will become transparent to the programs +using it. + +Although a truly general solution can only be done in the file system +itself, it is nevertheless possible to approximate this to a high +degree within the C library. +I will show a sample implementation, which does this. + +\section{System call substitutes} + +Since I am going to replace the functions [[open]], [[read]], +[[write]] etc. by my own versions, I will not be able to use them to do +actual input and output. +Therefore it is necessary to write new versions of the original C +library function. +The only things to change are the {\em names} of those routines. + +The following program text gives the implementation for MIPS-based +machines. +By using the {\em m4} macro processor, which is available on +most UNIX systems, I take advantage of the fact, that the sequences of +instructions needed for any of the functions follow a +common pattern. + +<<mips-asm.m>>= +# include <sys/syscall.h> +# include <regdef.h> + + .text + + .globl _cerror + +define(sc,` + .globl _sys_$1 + .ent _sys_$1 +_sys_$1: + li v0, SYS_$1 + syscall + beq a3, zero, 9f + j _cerror +9:$2 + j ra + .end') + +sc(open) +sc(creat) +sc(close) +sc(read) +sc(write) +sc(dup) +sc(lseek) +sc(pipe,` sw v0, 0 (a0) + sw v1, 4 (a0)') +@ +The Second argument of the [[sc]] macro is necessary to implement the +[[pipe]] system call, because it has to store two file descriptors +into locations given as the argument of the call. + +@ +\section{Overall structure} + +My new versions of the file system interface functions are implemented +in the file [[compress.c]]. +The structure of the file can be described as follows: + +<<compress.c>>= +<<include files>> +<<constant definitions>> +<<type definitions>> +<<external prototypes>> +<<static prototypes>> +<<static definitions>> +<<initialization>> +<<write compressed>> +<<read compressed>> +<<other io-substitutes>> +<<replaced system calls>> +@ +The necessary system header files are: + +<<include files>>= +# include <stdlib.h> +# include <stdio.h> +# include <string.h> +# include <assert.h> +# include <fcntl.h> +# include <errno.h> +@ + +\section{Replacing system calls} + +In this implementation I will give substitutes for the following +functions: +\begin{itemize} +\item +[[creat]] - creates a new file or truncates it to 0 bytes; opens for +writing +\item +[[open]] - opens an existing file for reading or writing +\item +[[close]] - releases the association between a file descriptor and the +corresponding file +\item +[[read]] - reads a number of bytes from an open file into a given buffer +\item +[[write]] - writes a number of bytes from a given buffer to an open file +\item +[[dup]] - duplicates a file descriptor +\item +[[lseek]] - provides random access to arbitrary positions within an +open file (if supported) +\item +[[tell]] - this is not a true system call and could be simulated by +[[lseek]]; it returns the current position in the file +\item +[[pipe]] - opens an inter-process communication channel known as a +{\em pipe}; returns two file descriptors, one for reading from the +pipe, one for writing into the pipe +\end{itemize} + +The real file system interface will be driven by the external +functions: +<<external prototypes>>= +extern _sys_open (const char *, int); +extern _sys_creat (const char *, int); +extern int _sys_close (int); +extern int _sys_read (int, char *, int); +extern int _sys_write (int, const char *, int); +extern int _sys_dup (int fd); +extern long _sys_lseek (int fd, long offset, int whence); +extern int _sys_pipe (int [2]); +@ +and the replaced system call functions are: +<<replaced system calls>>= +<<replaced creat>> +<<replaced open>> +<<replaced close>> +<<replaced read>> +<<replaced write>> +<<replaced dup>> +<<replaced tell>> +<<replaced lseek>> +<<replaced pipe>> +@ +Data compression and uncompression will be done by the Lempel-Ziv +algorithm. +It is necessary to maintain several independent compression- or +un\-com\-pres\-sion-``engines'', because there can be many files open. +There is no fixed relationship between the number of characters read +from or written to the real file system and the number of characters +seen by the program. +This means, both compression and uncompression must be able to stop +``in the middle of the operation''. +All the relevant variables, which constitute the ``state'' of the +``engine'' have to be saved in a data structure, which in turn has to +be associated with the file descriptor. + +The existence of the [[dup]] system call introduces some further requirements +on the implementation. +Basically this means, that the same ``engine'' can be associated with +more than one file descriptor. + +Currently I restrict myself to at most [[MAXFILES]] open files. +This can easily be changed by using [[getdtablesize]] to find out the +maximum number of open files allowed by the operating system. + +<<constant definitions>>= +# define MAXFILES 256 +@ +The states of ``engines'' are stored in structures of type [[struct cfd]]. + +<<type definitions>>= +typedef struct cfd *cfd; + +struct cfd { + struct methods *methods; + int nbits; + int shared; + <<other cfd members>> +}; +@ +One crucial idea to deal with the complexity of the problem is to +adopt some ``object-oriented'' techniques. +I use the member [[methods]] to point to a collection of function +pointers. +Depending on whether a file is read or written, compressed or plain, I +need different algorithms to access the file. +Using the table of [[methods]] allows to do this without complicated +{\em if-then-else} chains all over the place. + +<<type definitions>>= +struct methods { + int (* read) (int, unsigned char *, int); + int (* write) (int, unsigned char *, int); + int (* close) (int); + long (* seek) (int, long, int); +}; +@ +There will be a global file table [[filetab]], indexed by file +descriptors, which contains pointers to structures of type [[struct cfd]]. +The contents of this table at a given position depends on the mode of +operation used with the file descriptor under question. +Possible modes are: +\begin{itemize} +\item +the file is a plain file (no compression or uncompression) +\item +the file is written using compression +\item +the file is read using uncompression +\item +the file is opened for reading, but it is still unclear, whether it is +compressed or not +\item +the file is opened for reading; the ``engine'' found, that the file is +not compressed by reading the first few characters of the file; +the program has not asked yet for all of those pre-read characters +\item +the file is unknown to the interface module---this usually happens, if +the file descriptor is inherited from a parent process (e.g. the +shell) +\end{itemize} + +Descriptors for plain files and unknown file descriptors are +passed directly to the real system calls. +Therefore, these two modes are represented the same: by a [[NULL]] +pointer in the corresponding position of the file table. + +We need two different method tables for reading or writing in +compressed mode. +A third table is necessary to deal with the remaining modes of operation. +A compressed file is recognized by the first three characters in the +file, which are known as the [[compress_prefix]]. + +<<static definitions>>= +<<file table>> +<<method tables>> +<<compress prefix>> +@ + +<<compress prefix>>= +static unsigned char compress_prefix [] = { 0x1f, 0x9d, 0x10 }; +@ + +<<file table>>= +static cfd filetab [MAXFILES] = { NULL, }; +@ +The three collections of methods are: + +<<method tables>>= +<<write-compressed table>> +<<read-compressed table>> +<<initial read table>> +@ +For writing: + +<<write-compressed table>>= +static struct methods cw_m = { + refuse_io, + write_compressed, + close_compressed_write, + refuse_seek, +}; +@ +For reading: + +<<read-compressed table>>= +static struct methods cr_m = { + read_compressed, + refuse_io, + close_compressed_read, + refuse_seek, +}; +@ +For deciding, whether to read a compressed or a plain file: + +<<initial read table>>= +static struct methods ir_m = { + read_prefix, + refuse_io, + close_prefix_read, + prefix_seek, +}; +@ +To define the above tables, I need the following prototype definitions: + +<<static prototypes>>= +static int read_compressed (int fd, unsigned char *buf, int n); +static int read_prefix (int fd, unsigned char *buf, int n); +static int write_compressed (int fd, unsigned char *buf, int n); +static int refuse_io (int fd, unsigned char *buf, int n); + +static int close_compressed_read (int fd); +static int close_prefix_read (int fd); +static int close_compressed_write (int fd); + +static long refuse_seek (int fd, long offset, int whence); +static long prefix_seek (int fd, long offset, int whence); +@ +In order not to confuse other programs started by a combination of +[[fork]] and [[exec]], I always use the real system call along with +the replaced one. +Therefore, the indices into [[filetab]] are real file descriptors +provided by the operating system. + +[[creat]] always sets the mode of operation to ``write with +compression'' by using the methods [[cw_m]]. + +As a general rule, I set the member [[nbits]] to zero when opening a +file. +This signals, that the data structures have not been fully initialized yet. + +The member [[shared]] counts the number of [[filetab]] entries, which +point to the same data structure. +The routines for closing a file will use this to determine, +whether the last connection to the file will be closed. +Only in this case I can perform cleanup operations like freeing the +data structures associated with the file. + +<<replaced creat>>= +int creat (const char *path, int mode) +{ + int fd; + + init (); + + fd = _sys_creat (path, mode); + + if (fd < 0 || fd > MAXFILES || + (filetab [fd] = malloc (sizeof (struct cfd))) == NULL) + return fd; + + filetab [fd]->nbits = 0; + filetab [fd]->methods = &cw_m; + + filetab [fd]->shared = 1; + + return fd; +} +@ +Opening a file for writing using [[open]] assumes, that the file +already exists. +Therefore it is not useful to write with compression, because the +compressed data will interfere with what has already been in the file. +As a consequence I leave the entry in [[filetab]] unchanged. + +It turns out, that new versions of the C library don't use [[creat]], +but call [[open]] with some additional flags and parameters as +specified by [[POSIX]]. +This means, that I have to simulate the desired behavior by calling +[[creat]] from within [[open]] if necessary. + +Opening a file for reading is the most complex case. +At some time I need to read the first few characters of the file to +decide, whether the file is compressed or not. +The most natural place to do this seems to be the [[open]] routine. +Unfortunately, this would violate the semantics of [[open]]. +(Imagine opening a terminal file for reading!) +The decision has to be delayed until the first call to [[read]] will +be executed. +[[open]] sets the mode of operation to ``unclear, whether to use +decompression'' by using the method table [[ir_m]]. + +<<replaced open>>= +int open (const char *path, int how, int mode) +{ + int fd; + + if (how == (O_WRONLY | O_CREAT | O_TRUNC)) + return creat (path, mode); + + init (); + + fd = _sys_open (path, how); + if (fd < 0 || fd > MAXFILES || how != 0) + return fd; + + if ((filetab [fd] = malloc (sizeof (struct cfd))) == NULL) + return fd; + + filetab [fd]->nbits = 0; + filetab [fd]->methods = &ir_m; + filetab [fd]->shared = 1; + + return fd; +} +@ +Most of the remaining substitutes for system call functions follow a +common pattern: +\begin{itemize} +\item +look, if the file descriptor points to non-[[NULL]] in [[filetab]] +\item +if not, then simply use the original system call +\item +otherwise call the appropriate function from the methods table +\end{itemize} + +<<replaced close>>= +int close (int fd) +{ + return (fd < 0 || fd > MAXFILES || filetab [fd] == NULL) + ? _sys_close (fd) + : (* filetab [fd]->methods->close) (fd); +} +@ + +<<replaced read>>= +int read (int fd, char *buf, int n) +{ + return (fd < 0 || fd > MAXFILES || filetab [fd] == NULL) + ? _sys_read (fd, buf, n) + : (* filetab [fd]->methods->read) (fd, (unsigned char *) buf, n); +} +@ + +<<replaced write>>= +int write (int fd, const char *buf, int n) +{ + return (fd < 0 || fd > MAXFILES || filetab [fd] == NULL) + ? _sys_write (fd, buf, n) + : (* filetab [fd]->methods->write) (fd, (unsigned char *) buf, n); +} +@ +[[dup]] simply copies, what is in [[filetab]] at a given place to +another place. +The [[cfd]]-member [[shared]] must be incremented. + +<<replaced dup>>= +int dup (int fd) +{ + int res = _sys_dup (fd); + + if (fd < 0 || fd > MAXFILES || filetab [fd] == NULL) + return res; + assert (res < MAXFILES); + assert (filetab [res] == NULL); + filetab [res] = filetab [fd]; + filetab [res]->shared++; + return res; +} +@ +[[lseek]], again, follows the general pattern. +There is one minor variation: if the arguments indicate, that no +actual repositioning is asked for, [[tell]] gets called. + +<<replaced lseek>>= +long lseek (int fd, long offset, int whence) +{ + if (offset == 0 && whence == 1) + return tell (fd); + return (fd < 0 || fd > MAXFILES || filetab [fd] == NULL) + ? _sys_lseek (fd, offset, whence) + : (* filetab [fd]->methods->seek) (fd, offset, whence); +} +@ +[[tell]] is not a real system call. +I simulate it using [[lseek]] if necessary. +For files in compressed mode I keep track of the file position myself. +Note, that [[filepos]] is not initialized until the first [[read]] from +or [[write]] to the file has been executed. + +<<other cfd members>>= +long filepos; +@ + +<<replaced tell>>= +long tell (int fd) +{ + return (fd < 0 || fd > MAXFILES || filetab [fd] == NULL) + ? _sys_lseek (fd, 0L, 1) + : (filetab [fd]->nbits < MINBITS) + ? 0 + : filetab [fd]->filepos; +} +@ +Since [[pipe]] creates two file descriptors, I have to deal with two +entries in [[filetab]]. +Writing to the pipe will be performed in compressed mode. +This seems to imply, that reading has to use compressed mode as well, +but this is not the case. +The most common case of using pipes is in the context of [[fork]] and +[[exec]]. +It is very likely, that the pipe will be written by another program, +and I have to check, whether this program uses compression or not. + +<<replaced pipe>>= +int pipe (int fd [2]) +{ + cfd p0, p1; + + init (); + + if (_sys_pipe (fd) < 0) + return -1; + + if (fd [0] > MAXFILES || fd [1] > MAXFILES) + return 0; + p0 = malloc (sizeof (struct cfd)); + if (p0 == NULL) + return 0; + p1 = malloc (sizeof (struct cfd)); + if (p1 == NULL) { + free (p0); + return 0; + } + + p0->nbits = p1->nbits = 0; + p0->methods = &ir_m; + p1->methods = &cw_m; + p0->shared = p1->shared = 1; + + filetab [fd [0]] = p0; + filetab [fd [1]] = p1; + + return 0; +} +@ + +\section{Initialization} + +The library function [[atexit]] provides a way to register a function, +which will be called, when the program exits (i.e. when it calls [[exit]]). +I use this to register a function, which closes all the open files +found in [[filetab]]. + +As you might have noticed, [[init]] will be called from any of the +functions, which create non-[[NULL]] entries in [[filetab]]. + +<<initialization>>= +static void cleanup (void) +{ + int i; + + for (i = 0; i < MAXFILES; i++) + if (filetab [i] != NULL) + (* filetab [i]->methods->close) (i); +} +@ +The registration of [[cleanup]] will be done exactly once. + +<<initialization>>= +static void init (void) +{ + static int initialized = 0; + + if (initialized == 0) { + atexit (cleanup); + initialized = 1; + } +} +@ + +\section{Compression} + +Compression employs the adaptive Lempel-Ziv algorithm. +Tables are constructed as data are written. +Every sequence of characters ever seen by the algorithm (which uses a +greedy heuristic to construct these sequences) is associated with a +unique code. +The [[cfd]]-member [[nextcode]] always holds the next available code +to be associated with the next sequence. +Because the algorithm writes data, which are not always aligned to +byte-boundaries, I have to use a buffer, the size of which is a +multiple of the current code size [[nbits]] and a multiple of eight. +Since the maximum code size is sixteen, a buffer of at most 16 bytes +is required. + +<<constant definitions>>= +# define TABSIZE 8192 +# define MAXBITS 16 +# define MINBITS 9 +# define FIRSTCODE 256 +@ + +I use [[struct cfd]] for both compress and uncompress. +Some of the members in [[struct cfd]] are only used for either +compression or uncompression, and not for both. +In order to save some space, these members are placed into a union. + +<<other cfd members>>= +unsigned long nextcode; +unsigned char buf [MAXBITS]; +int bitpos; +union { + struct { + <<compress-only members>> + } c; + struct { + <<uncompress-only members>> + } d; +} u; +@ +[[lastcode]] holds the code of the character sequence seen so far. +[[codes]] is a hashtable, which is used to describe the mapping of +strings to codes. + +<<compress-only members>>= +struct centry **codes; +unsigned long lastcode; +@ +The hashtable used by this algorithm has fixed size and uses chaining +to deal with collisions. +The data structure for the chaining is described by: + +<<type definitions>>= +struct centry { + unsigned short w; + unsigned char c; + unsigned short code; + struct centry *next; +}; +@ +Here, [[w]] is the code for the string without the last character, +[[c]] is the last character, [[code]] is the code for this sequence +and [[next]] holds the next entry of the chain. + +<<write compressed>>= +<<hashtable management>> +<<writing bits>> +<<writing character arrays>> +<<finish writing>> +@ +This is the hashtable management: + +<<hashtable management>>= +<<hash function>> +<<hashtable lookup>> +@ + +<<hash function>>= +# define hash(x,y) (((x)<<8|(y))%TABSIZE) +@ +There is not very much to say about hashtable lookup. +The only important thing to note is, that I use a ``move-to-front'' +heuristic to speed things up. + +<<hashtable lookup>>= +static struct centry *lookup (cfd fd, unsigned char c) +{ + unsigned lc = fd->u.c.lastcode; + struct centry **start = + &fd->u.c.codes [hash(lc, c)]; + struct centry **cur = start; + struct centry *tmp; + + while (*cur != NULL && ((*cur)->w != lc || (*cur)->c != c)) + cur = & (*cur)->next; + if (*cur == NULL) + return NULL; + else { + tmp = *cur; + *cur = tmp->next; + tmp->next = *start; + *start = tmp; + return tmp; + } +} +@ +In order to write a number of bits it is necessary to use the [[buf]] +member of the [[cfd]] structure, because I cannot write fractions of a +byte. +It is just a matter of shifting and masking bits correctly... + +I give the description of [[invmask]] here, although it is used only +later for reading bits. + +<<writing bits>>= +# define mask(x,n) ((x) & (~(~0 << (n)))) +# define invmask(x,n) ((x) & (~0 << (n))) +@ + +<<writing bits>>= +static int output (cfd fd, int ifd) +{ + unsigned char *byte = fd->buf + fd->bitpos / 8; + int bit = fd->bitpos % 8; + unsigned code = fd->u.c.lastcode; + + *byte = mask (*byte, bit) | code << bit; + byte++; + code >>= 8 - bit; + if (fd->nbits + bit > 16) { + *byte++ = code; + code >>= 8; + } + *byte = code; + fd->bitpos += fd->nbits; + if (fd->bitpos == 8 * fd->nbits) { + if (_sys_write (ifd, (char *) fd->buf, fd->nbits) < 0) + return -1; + fd->bitpos = 0; + } + return fd->bitpos; +} +@ +To be able to write arbitrary arrays of characters I need to suspend +compression not after a certain amount of characters {\em written}, but +after any amount of characters {\em seen}. +This means, that character sequences, which are collapsed into one +code, may extend across multiple calls to [[write]]. + +[[write]] checks first, whether this is the very first call to +[[write]] for this file and initializes the data structures. +Remember, that [[creat]] and [[pipe]] set [[nbits]] to zero to +indicate this situation. + +After using all possible codes no further entries to the hashtable are +made---[[write]] has to live with what is in the table. + +<<writing character arrays>>= +static int write_compressed (int ifd, unsigned char *buf, int n) +{ + cfd fd = filetab [ifd]; + int i, h; + struct centry *tmp; + unsigned char c; + + if (n == 0) + return 0; + + <<write initialization>> + + while (i-- > 0) { + c = *buf++; + + if ((tmp = lookup (fd, c)) == NULL) { + + <<output code for prefix>> + <<add code to table if necessary>> + + fd->nextcode++; + fd->u.c.lastcode = c; + + } else + fd->u.c.lastcode = tmp->code; + } + + fd->filepos += n; + + return n; +} +@ +A value of zero in [[nbits]] indicates, that the data structures have to be +initialized. + +<<write initialization>>= +if (fd->nbits == 0) { + if (_sys_write (ifd, (char *) compress_prefix, + sizeof (compress_prefix)) < 0) + return -1; + fd->nbits = MINBITS; + fd->nextcode = FIRSTCODE; + fd->bitpos = 0; + fd->u.c.codes = malloc (TABSIZE * sizeof (struct centry *)); + if (fd->u.c.codes == NULL) { + errno = ENOMEM; + return -1; + } + for (i = 0; i < TABSIZE; i++) + fd->u.c.codes [i] = NULL; + fd->filepos = 0; + fd->u.c.lastcode = *buf++; + i = n - 1; +} else + i = n; +@ +<<output code for prefix>>= +if (output (fd, ifd) < 0) + return -1; +@ +As long as not all the possible codes have been used, codes for new +sequences have to be introduces. + +<<add code to table if necessary>>= +if (fd->nextcode < (1L << MAXBITS)) { + if ((tmp = malloc (sizeof (struct centry))) == NULL) { + errno = ENOMEM; + return -1; + } + tmp->w = fd->u.c.lastcode; + tmp->c = c; + tmp->code = fd->nextcode; + + if (fd->nextcode == (1L << fd->nbits)) { + if (fd->bitpos > 0) { + if (_sys_write (ifd, (char *) fd->buf, fd->nbits) < 0) + return -1; + fd->bitpos = 0; + } + fd->nbits++; + } + + h = hash (fd->u.c.lastcode, c); + tmp->next = fd->u.c.codes [h]; + fd->u.c.codes [h] = tmp; +} +@ + +An important thing to note, is that I cannot simply close a file using +the operating system call. +It may be the case (in fact, it is always the case) that there is +still some accumulated code in [[lastcode]] that wants to be written +out. +I have to make sure, that I only really close the file, if the last +reference to this file is going to be abandoned. + +Unlike during a switch from [[nbits]] to [[nbits]]+1, where I always +flush the {\em entire} buffer [[buf]] (up to [[nbits]] bytes), I write +only those parts of [[buf]] which really contain written bits when +closing the file. +This provides the necessary information about the end of the file to +the uncompression algorithm. + +<<finish writing>>= +static int close_compressed_write (int ifd) +{ + cfd fd = filetab [ifd]; + int res, i; + struct centry *run, *next; + + if (--fd->shared == 0 && fd->nbits > 0) { + for (i = 0; i < TABSIZE; i++) + if ((run = fd->u.c.codes [i]) != NULL) + do { + next = run->next; + free (run); + run = next; + } while (run != NULL); + free (fd->u.c.codes); + if (output (fd, ifd) < 0) + return -1; + if (fd->bitpos > 0 && + _sys_write (ifd, + (char *) fd->buf, + (fd->bitpos + 7) / 8) + < 0) + return -1; + } + res = _sys_close (ifd); + if (fd->shared == 0) + free (fd); + filetab [ifd] = NULL; + return res; +} +@ + +\section{Uncompression} + +The algorithm to uncompress compressed files looks a little bit more +complicated. +First, I need a stack (described by the members [[stack]], +[[stacktop]] and [[stacksize]]) to reverse the sequence of characters, +which I obtain from a code. +The stack is realized as a rubber-band array, which is automatically +expanded when necessary. +Furthermore, [[buflen]] keeps track of the number of characters, which have +actually been read from the file system---fewer characters than +[[nbits]] indicate the end of the file. +[[oldcode]] holds the last code that has been read and [[finchar]] is the +final character produced from the last code. +This is necessary to deal correctly with the {\em +``AwAwA''}-phenomenon, where a code can be read, which is not in the +table yet. + +The ``hashtable'' [[htab]] is a rubber-band array which contains for +each code the associated prefix (i.e. the code for the string without +the last character) together with that last character. +Since entries are made in a sequential order, it is not +necessary to use a hash function. +The entry for a code {\em k} is at position {\em k-256}, because the +first codes 0-255 stand for themselves and don't need to be stored +into the table. + +Here are the missing members of [[struct cfd]]: + +<<uncompress-only members>>= +long tabsize; +struct { unsigned w; unsigned char c; } *htab; +unsigned stacksize; +unsigned stacktop; +unsigned char *stack; +int buflen; +unsigned short oldcode; +unsigned char finchar; +@ +Uncompression is split into the following tasks: + +<<read compressed>>= +<<stack management>> +<<reading bits>> +<<reading the first few bytes>> +<<reading compressed files>> +<<finish reading>> +@ +The stack management maintains a rubber band array. +The array can only expand, therefore ``popping'' items from the stack +can be ``in-lined''. +[[push]] is more complicated and gets its own function: + +<<constant definitions>>= +# define STACKGROWTH 64 +@ + +<<stack management>>= +static int push (cfd fd, unsigned char c) +{ + if (fd->u.d.stacktop >= fd->u.d.stacksize) { + fd->u.d.stacksize += STACKGROWTH; + if ((fd->u.d.stack = + realloc (fd->u.d.stack, fd->u.d.stacksize)) + == NULL) { + errno = ENOMEM; + return -1; + } + } + fd->u.d.stack [fd->u.d.stacktop++] = c; + return 0; +} +@ +Reading the bits into the buffer is a little bit more trickier than +writing. +Consider a pipe: If the pipe contains fewer characters than required, +then only those bytes are delivered. +The system call blocks for empty pipes only. +Therefore [[refill_buffer]] repeats the call to [[_sys_read]] until +either the buffer is completely filled or [[_sys_read]] signals +end-of-file or an error condition. + +<<reading bits>>= +static int refill_buffer (cfd fd, int ifd) +{ + int n, r; + + n = 0; + r = 0; + while (n < fd->nbits && + (r = _sys_read (ifd, + (char *) (fd->buf + n), + fd->nbits - n)) + > 0) + n += r; + if (r < 0) + return -1; + fd->u.d.buflen = 8 * n; + fd->bitpos = 0; + return 0; +} +@ +The [[input]]-function is very much like [[output]], except that it +has to return an end-of-file condition when the end of the file has +been reached. +I use -1 to signal the end of the file and -2 to signal an error. +[[buflen]] is used to describe, what is really in the buffer (the +number of bits). + +<<reading bits>>= +static int input (cfd fd, int ifd) +{ + unsigned char *byte; + int bit; + unsigned code; + + if (fd->bitpos + fd->nbits > fd->u.d.buflen) { + if (refill_buffer (fd, ifd)) + return -2; + if (fd->u.d.buflen == 0) + return -1; + } + byte = fd->buf + fd->bitpos / 8; + bit = fd->bitpos % 8; + code = invmask (*byte, bit) >> bit; + byte++; + bit = 8 - bit; + if (fd->nbits - bit >= 8) { + code |= *byte++ << bit; + bit += 8; + } + code |= mask (*byte, fd->nbits - bit) << bit; + fd->bitpos += fd->nbits; + + return code; +} +@ +There is still the problem, that [[read]] has to check first, whether +the contents of the file is compressed or not. +If [[read]] detects, that the file is not compressed, than it has to +arrange for {\em all} file descriptors associated with the file, that +it is read using the plain operating system call. +This is done using the function [[mark_uncompressed]]. + +<<reading the first few bytes>>= +static void mark_uncompressed (cfd fd) +{ + int i; + + for (i = 0; i < MAXFILES; i++) + if (filetab [i] == fd) + filetab [i] = NULL; + free (fd); +} +@ +The first attempt to read a file will be used to check, whether the +file is compressed. +To do this, I try to read the first three characters in the file and +compare them with [[compress_prefix]]. +If I don't get three characters or if those characters do not coincide +with [[compress_prefix]], then the file is considered to be not +compressed. +Otherwise I simply change the method table to be [[cr_m]] and call +[[read_compressed]]. + +In the case that the file is not compressed, the characters read are +part of the data and have to be placed into the buffer, which is the +argument to read. +After doing so, the file has to be marked being uncompressed. +If [[read]] has asked for more than three characters, then +[[_sys_read]] will try to get those. + +Difficulties arise, if [[read]] had asked for fewer characters than +received by the first [[_sys_read]]. +These characters have to be kept for further calls to [[read]]. +(To reset the file pointer to the beginning might be impossible, +because the file can be a terminal device or a pipe.) +I set [[nbits]] to 1 to indicate, that the file has already proven to +be in uncompressed state. +In this case [[read_prefix]] fetches the characters from the buffer +instead of reading them from the file system. +When all the characters are ``eaten up'' I mark the file as being +uncompressed. + +<<reading the first few bytes>>= +static int read_prefix (int ifd, unsigned char *buf, int n) +{ + cfd fd = filetab [ifd]; + int l; + + if (n == 0) + return 0; + + if (fd->nbits == 0) { + if ((l = _sys_read (ifd, + (char *) fd->buf, + sizeof compress_prefix)) + < 0) + return -1; + if (l == sizeof (compress_prefix) && + memcmp (fd->buf, + compress_prefix, + sizeof compress_prefix) + == 0) { + fd->methods = &cr_m; + return read_compressed (ifd, buf, n); + } + fd->nbits = 1; + fd->filepos = 0; + fd->bitpos = l; + } + + if (n < fd->bitpos - fd->filepos) { + memcpy (buf, fd->buf + fd->filepos, n); + fd->filepos += n; + return n; + } + + memcpy (buf, fd->buf + fd->filepos, fd->bitpos - fd->filepos); + if (n > fd->bitpos - fd->filepos) { + l = _sys_read (ifd, (char *) (buf + fd->bitpos - fd->filepos), + n - (fd->bitpos - fd->filepos)); + if (l < 0) + l = 0; + n = l + fd->bitpos - fd->filepos; + } + + mark_uncompressed (fd); + + return n; +} +@ +This is the code for reading compressed files. +Note, that the function initialized all the relevant data structures +if [[nbits]] equals zero. +Later it reads codes, constructs the corresponding character strings using the +stack and places those characters into the buffer. +Usually there will remain some characters, which have to be kept until +the next call to [[read]]. +The table of codes is again constructed as the algorithm goes. +The uncompress algorithm lags always one step behind, so it may +happen, that a code is not yet in the table. +In this case, the sequence of characters can be reconstructed using +[[finchar]] and [[oldcode]]. + +<<reading compressed files>>= +static int read_compressed (int ifd, unsigned char *buf, int n) +{ + cfd fd = filetab [ifd]; + int i = n; + unsigned incode, c; + int cin; + + <<read initialization>> + + for (;;) { + <<empty the stack>> + <<return or read next code>> + + c = incode = cin; + + <<special AwAwA case handling>> + <<analyse code and put bytes onto stack>> + <<enter code to table htab>> + + fd->u.d.oldcode = incode; + } +} +@ +The first time [[read]] gets called for a compressed file, the following code +will be executed: + +<<read initialization>>= +if (fd->nbits == 0) { + if (n == 0) + return 0; + + fd->nbits = MINBITS; + fd->nextcode = FIRSTCODE; + fd->bitpos = 8 * MINBITS; + fd->filepos = 0; + fd->u.d.tabsize = TABSIZE; + if ((fd->u.d.htab = + malloc (TABSIZE * sizeof (*fd->u.d.htab))) + == NULL) { + errno = ENOMEM; + return -1; + } + fd->u.d.stacksize = STACKGROWTH; + fd->u.d.stacktop = 0; + if ((fd->u.d.stack = malloc (STACKGROWTH)) == NULL) { + errno = ENOMEM; + return -1; + } + fd->u.d.buflen = 8 * MINBITS; + cin = input (fd, ifd); + if (cin < 0) + return cin == -1 ? 0 : -1; + *buf++ = cin; + --i; + fd->u.d.oldcode = cin; + fd->u.d.finchar = cin; +} +@ +First, [[read]] has to empty the stack: + +<<empty the stack>>= +while (fd->u.d.stacktop > 0 && i > 0) { + *buf++ = fd->u.d.stack [--fd->u.d.stacktop]; + --i; +} +@ +Then it can try to get another code, if necessary: + +<<return or read next code>>= +if (i == 0 || (cin = input (fd, ifd)) == -1) { + fd->filepos += n - i; + return n - i; +} + +if (cin < -1) + return -1; +@ +It may happen, that a code is not in the table yet. +[[oldcode]] and [[finchar]] contain enough information to deduce, what has to +be in the table: + +<<special AwAwA case handling>>= +if (c >= fd->nextcode) { + if (c > fd->nextcode) { + errno = EIO; + return -1; + } + if (push (fd, fd->u.d.finchar)) + return -1; + c = fd->u.d.oldcode; +} +@ +A code is analyzed from right to left. +Therefore, I need to use the stack to reverse the order of the characters: + +<<analyse code and put bytes onto stack>>= +while (c >= FIRSTCODE) { + if (push (fd, fd->u.d.htab [c - FIRSTCODE].c)) + return -1; + c = fd->u.d.htab [c - FIRSTCODE].w; +} +fd->u.d.finchar = c; +if (push (fd, c)) + return -1; +@ +Unless all possible codes are already used, I have to insert the a new code +into the table. + +<<enter code to table htab>>= +if (fd->nextcode < (1L << MAXBITS)) { + if (fd->nextcode - FIRSTCODE >= fd->u.d.tabsize) { + fd->u.d.tabsize += TABSIZE; + if ((fd->u.d.htab = + realloc (fd->u.d.htab, + fd->u.d.tabsize * sizeof (*fd->u.d.htab))) + == NULL) { + errno = ENOMEM; + return -1; + } + } + fd->u.d.htab [fd->nextcode - FIRSTCODE].c = c; + fd->u.d.htab [fd->nextcode - FIRSTCODE].w = fd->u.d.oldcode; + + if (fd->nextcode == (1L << fd->nbits) - 1 && + fd->nbits < MAXBITS) { + fd->nbits++; + if (refill_buffer (fd, ifd)) + return -1; + } + + fd->nextcode++; +} +@ + +Closing a file, which has been read from is not as difficult as +closing a file which has been written to, because no buffers have to +be flushed. +Nevertheless, it has to take care of freeing the data structures. +I have two different routines for closing, one for [[cr_m]], the other +for [[ir_m]]. + +<<finish reading>>= +static int close_compressed_read (int ifd) +{ + cfd fd = filetab [ifd]; + + if (--fd->shared == 0) { + if (fd->nbits > 0) { + free (fd->u.d.htab); + free (fd->u.d.stack); + } + free (fd); + } + filetab [ifd] = NULL; + return _sys_close (ifd); +} +@ + +<<finish reading>>= +static int close_prefix_read (int ifd) +{ + cfd fd = filetab [ifd]; + + if (--fd->shared == 0) + free (fd); + filetab [ifd] = NULL; + return _sys_close (ifd); +} +@ + +\section{Miscellaneous IO-substitutes} + +Reading from a file, that has been opened for writing or vice versa is +not allowed. + +<<other io-substitutes>>= +static int refuse_io (int fd, unsigned char *buf, int n) +{ + errno = EINVAL; + return -1; +} +@ +As far as [[lseek]] is concerned, a compressed file (regardless +whether read or written) behaves like a pipe, i.e. [[lseek]] returns -1. + +<<other io-substitutes>>= +static long refuse_seek (int fd, long offset, int whence) +{ + errno = ESPIPE; + return -1; +} +@ +An attempt to [[lseek]] a file, that is opened for reading and has not +(yet) proven to contain compressed data, will force to treat the file +as a plain file. + +<<other io-substitutes>>= +static long prefix_seek (int ifd, long offset, int whence) +{ + cfd fd = filetab [ifd]; + + mark_uncompressed (fd); + return _sys_lseek (ifd, offset, whence); +} +@ + +\section{Examples} + +The remainder of the text gives a collection of sample code, which +provides some evidence, that the implementation is correct. + +I start with a simple copy program. +The program takes one or two command line arguments the first of +which is the input file, while the second names the output file and +defaults to the standard output. + +The most interesting property of this program is, that is can be used +both as a substitute for [[compress]] and as a replacement for +[[uncompress]]. +Further, it will also work on plain files. +Consider: +\begin{itemize} +\item +{\tt t plain-input compressed-output} +\item +{\tt t compressed-input compressed-output} +\item +{\tt t plain-input >plain-output} +\item +{\tt t compressed-input >plain-output} +\end{itemize} + +<<t.c>>= +# include <stdio.h> +# include <errno.h> +# include <string.h> + +int main (int argc, char **argv) +{ + FILE *in, *out; + int c; + + if (argc != 3 && argc != 2) { + fprintf (stderr, "Usage: %s infile [ outfile ]\n", argv [0]); + exit (1); + } + + if ((in = fopen (argv [1], "r")) == NULL) { + fprintf (stderr, "Cannot open file %s for reading: %s\n", + argv [1], strerror (errno)); + exit (1); + } + if (argc == 2) + out = stdout; + else if ((out = fopen (argv [2], "w")) == NULL) { + fprintf (stderr, "Cannot open file %s for writing: %s\n", + argv [2], strerror (errno)); + exit (1); + } + + while ((c = getc (in)) != EOF) + putc (c, out); + + fclose (in); + fclose (out); + + return 0; +} +@ +The next example does the same thing while not using the +standard library. +Instead, it calls [[open]], [[read]] etc. directly. + +<<v.c>>= +# include <stdio.h> +# include <errno.h> +# include <string.h> + +int main (int argc, char **argv) +{ + int ifd, ofd; + int n; + char buf [4096]; + + if (argc != 3 && argc != 2) { + fprintf (stderr, "Usage: %s infile [ outfile ]\n", argv [0]); + exit (1); + } + + if ((ifd = open (argv [1], 0)) < 0) { + fprintf (stderr, "Cannot open file %s for reading: %s\n", + argv [1], strerror (errno)); + exit (1); + } + if (argc == 2) + ofd = 1; + else if ((ofd = creat (argv [2], 0666)) < 0) { + fprintf (stderr, "Cannot open file %s for writing: %s\n", + argv [2], strerror (errno)); + exit (1); + } + + while ((n = read (ifd, buf, 512)) > 0) + write (ofd, buf, n); + + close (ifd); + close (ofd); + + return 0; +} +@ +The next example uses [[dup]] and performs interleaved writes to both +file descriptors. +Of course, this isn't necessary, but it shows, that [[dup]] works as +expected. + +<<u.c>>= +# include <stdio.h> +# include <errno.h> +# include <string.h> + +int main (int argc, char **argv) +{ + int ifd, oofd, dofd; + int n; + char buf [512]; + + if (argc != 3 && argc != 2) { + fprintf (stderr, "Usage: %s infile [ outfile ]\n", argv [0]); + exit (1); + } + + if ((ifd = open (argv [1], 0)) < 0) { + fprintf (stderr, "Cannot open file %s for reading: %s\n", + argv [1], strerror (errno)); + exit (1); + } + if (argc == 2) + oofd = 1; + else if ((oofd = creat (argv [2], 0666)) < 0) { + fprintf (stderr, "Cannot open file %s for writing: %s\n", + argv [2], strerror (errno)); + exit (1); + } + + dofd = dup (oofd); + + while ((n = read (ifd, buf, 512)) > 0) + write (oofd, buf, n / 2), + write (dofd, buf + n / 2, n - n / 2); + + close (ifd); + close (oofd); + close (dofd); + + return 0; +} +@ +The following program is the most complex example. +It shows the use of pipes in the framework of [[fork]] and [[exec]]. +By two times executing [[fork]] I create a sequential arrangement of +three processes, which are connected by two pipes. +Pipe [[p1]] connects the {\em child} with the {\em parent}, while [[p2]] +provides a channel from the {\em grandchild} to the {\em child}. + +The {\em child} starts another program by calling either [[execl]] or +[[execvp]], depending on what command line arguments are given. +The idea is to pipe compressed data to a {\em filter} and read it +back. +Simple ``filters'' like [[cat]] or [[tee]] don't change the data. +Therefore, the {\em parent} should see, what the {\em grandchild} +wrote in this case. +It is worth trying to put {\tt uncompress~-C} into the place of the filter. +(The behavior should not change, because [[read]] automatically +detects, that the data in [[p1]] are not in compressed format.) + +Note, that all calls to [[fork]] and [[exec]] have to be executed {\em +before any actual input or output takes place}. + +<<w.c>>= +# include <stdio.h> +# include <assert.h> +# include <errno.h> +# include <string.h> + +# define check(x) \ + ((x)<0?(fprintf(stderr,"%s(%d): (%s) < 0 (%s)\n", \ + __FILE__, __LINE__, #x, strerror(errno)), \ + exit(1)):0) + +int main (int argc, char **argv) +{ + char buf [512]; + int n; + int p1 [2], p2 [2]; + int f; + + check (pipe (p1)); + + check (f = fork ()); + if (f > 0) { + check (close (p1 [1])); + while (check (n = read (p1 [0], buf, 512)), n > 0) + check (write (1, buf, n)); + putc ('\n', stderr); + check (close (p1 [0])); + check (wait (NULL)); + exit (0); + } else { + check (close (1)); + check (dup (p1 [1])); + check (close (p1 [0])); + check (close (p1 [1])); + + check (pipe (p2)); + + check (f = fork ()); + + if (f > 0) { + check (close (p2 [1])); + check (close (0)); + check (dup (p2 [0])); + check (close (p2 [0])); + + if (argc == 1) + check (execl ("/bin/cat", "cat", NULL)); + else + check (execvp (argv [1], argv + 1)); + } else { + check (close (p2 [0])); + while (check (n = read (0, buf, 512)), n > 0) + check (write (p2 [1], buf, n)); + check (close (p2 [1])); + exit (0); + } + } +} +@ +A small program shows the use of pipes through the [[popen]]-interface: + +<<x.c>>= +# include <stdio.h> + +# include <assert.h> + +int main (int argc, char **argv) +{ + FILE *fp; + int c; + + assert (argc == 2); + fp = popen (argv [1], "r"); + assert (fp != NULL); + while ((c = getc (fp)) != EOF) + putchar (c); + pclose (fp); + return 0; +} +@ +A final test case makes sure, that [[read_prefix]] works correctly, +even in the case, that the number of characters asked for is less than +the length of the [[compress_prefix]]. +The program always reads only one character at a time. +Try to use it with a plain file and remember, how [[read]] is implemented. + +<<y.c>>= +# include <assert.h> + +int main (int argc, char **argv) +{ + char c; + int fd; + + assert (argc == 2); + fd = open (argv [1], 0); + assert (fd >= 0); + while (read (fd, &c, 1) == 1) + write (1, &c, 1); + close (fd); + return 0; +} +@ + +\section{Conclusions} + +The examples in the previous section show, that the new file system +interface really hides the details of data compression, thereby +providing this service in a fashion transparent to the programs that +use it. +However, everything works only as long as a single program has +complete control over an open file. +In a multi-tasking environment like UNIX, this is generally not true. +This puts some severe constraints onto the usage of the new interface. +The implementation presented in this paper assumes, that files opened +for writing by [[open]] are not compressed. +What, if the data in that file actually {\em are} compressed? + +Recently, there are some efforts made to integrate data compression with +file system implementations themselves. +Only here one has the opportunity to know about {\em every} access to a file, +and things can be synchronized properly. + +Nevertheless, the given program text can be useful in many +circumstances. +I, for instance, tried to integrate it with [[VSCM]], which is my +implementation of {\em Scheme}. +Memory dumps written by [[VSCM]] are less than half as big as before, +and everything still works fine. +Probably, the fact that files containing symbolic expressions are +written in compressed mode as well is a little bit surprising and annoying. +(This leads to the demand for a switch to turn off compression, but +this would expose details of the implementation, which is what I +wanted to avoid in the first place.) + +\section{Indexes} + +\subsection{Code Chunks} +\nowebchunks + +\subsection{Identifiers} +\nowebindex diff --git a/web/noweb/examples/dag.nw b/web/noweb/examples/dag.nw new file mode 100644 index 0000000000..06ba17dbb8 --- /dev/null +++ b/web/noweb/examples/dag.nw @@ -0,0 +1,163 @@ +\section{Converting trees to dags} +The problem with the trees generated in the previous section is that +there's a different edge, and therefore a different child, for each +possible interval of the field tested, even if those children both +execute exactly the same ``original'' arm of the case statement. +The code in this section converts the trees to dags, and as part of +the process it combines edges pointing to the same node. +This can reduce the size of the tree by huge factors. + +To make the transformation work, I have to represent a {\em set of +intervals} on each edge, not just a single interval. Because no two intervals +overlap, I can use a wonderful dirty trick, detailed below. +I also {\em may} convert a node's name string to a [[namearray]] mapping +field values to strings. The goal is for children of the same +parent to share a single name array; that way the edges can be merged and +the name operator can be implemented with an array reference. +If I don't convert a node's name, the only penalty is that the tree +might be bigger. +(Code generation will be different for the two cases.) +@ +Now, the dirty representation trick: +I can represent a set of numbers $S$ (a union of intervals) as two +sets, $lo$ and $hi$, such that +\begin{itemize} +% l2h substitution cap <b>intersect</b># +% l2h substitution cup <b>union</b># +% l2h substitution emptyset <b>empty#set</b> +\item[] $lo \cap hi = \emptyset$ +\item[] if ${\tt sort}(lo \cup hi) = a, b, c, d, \ldots$, then + $S = [a,b-1] \cup [c,d-1] \cup \ldots$. +\end{itemize} +The procedure [[addinterval]] adds a new interval to such a set $S$, +relying on the fact that no two intervals overlap. +<<*>>= +procedure addinterval(loset, hiset, lonum, hinum) + if member(loset, hinum) then delete(loset, hinum) else insert(hiset, hinum) + if member(hiset, lonum) then delete(hiset, lonum) else insert(loset, lonum) + return +end +@ +To convert trees to dags I need to be able to compare two nodes +for structural identity, and the easiest way is to compute a canonical +representation as a string:\par\noindent [[ + node : [fname:patimage(list of edges)] + | <NOMATCH> + | (image(node.name):image(node.cs.arms[1].original)) + edge : patimage(list of sort(loset ++ hiset)):node +]] +<<*>>= +procedure nodetostring(n, depth) + static cache + initial cache := table() + /depth := 0 + if /cache[n] then + if *n.children > 0 then { + result := "[" || n.field.name || ":" + every result ||:= edgetostring(!n.children, depth+2) + cache[n] := result || "]" + } else if *n.cs.arms = 0 then + cache[n] := "<NOMATCH>" + else + cache[n] := "(" || image(n.name) || ":" || image(n.cs.arms[1].original) ||")" + return \cache[n] +end + +procedure edgetostring(e,depth) + return left("\n", depth) || + "{" || patimage(sort(e.lo ++ e.hi)) || ":" || nodetostring(e.node,depth) || "}" +end +@ +Conversion to dag is the usual bottom-up hashing; here I compute the +string and then use the string to index into a table. +The real work of merging edges is done by [[combinechildren]]. +If edge merging results in a single each, the node is replaced by +its child, provided the edge really covers all possible values +of the field. +<<*>>= +procedure tree2dag(n, nodetable, depth) + /nodetable := table() + /depth := 0 + if *n.children > 0 then + combinechildren(n, nodetable, depth+2) # converts edges to set form + if *n.children = 1 then { + e := n.children[1] + if covers(n.children[1], n.field.hi - n.field.lo) then + n := n.children[1].node # all roads to child: hoist it + else + warning("node with one child doesn't match all cases") + } + s := nodetostring(n, depth) + /nodetable[s] := n + return nodetable[s] +end +@ +Here's where I check coverage. +Only success or failure of [[covers]] is meaningful, not +the value returned. +<<*>>= +procedure covers(e, width) + l := sort(e.lo ++ e.hi) + return *l = 2 & l[1] = 0 & l[2] = 2^width +end +@ +The complicated stuff here is identifying a name array. +At each node, either all edges go in an exiting name array +or a new name array is used. +If not, I create a new one. +<<*>>= +record namearray(field, tbl, hi, codename) + # field used as index, table[integer] of name, bound on table, name of this array +global natable +<<*>>= +procedure arraycandidates(n) + initial MAXRANGE := 32 + suspend e := !n.children & type(e.node.name) == "string" & + e.hi - e.lo <= MAXRANGE & e +end + +procedure combinechildren(n, nodetable, depth) + initial natable := table() + + if arraycandidates(n).node.name ~== arraycandidates(n).node.name then { + <<change names of children from strings to namearrays when possible>> + } + + lotable := table() + hitable := table() + every e := !n.children & child := tree2dag(e.node, nodetable, depth) do { + /lotable[child] := set() + /hitable[child] := set() + addinterval(lotable[child], hitable[child], e.lo, e.hi) + } + n.children := [] + every child := key(lotable) do + put(n.children, edge(child, lotable[child], hitable[child])) + return +end +<<change names of children from strings to namearrays when possible>>= +mightuse := set() # name arrays we might use must have right field +every na := !\natable[n.field] do + insert(mightuse, na) +every e := arraycandidates(n) & na := !mightuse do + if \na.tbl[e.lo to e.hi - 1] ~== e.node.name then # slot used with wrong name + delete(mightuse, na) +if *mightuse > 0 then + willuse := ?mightuse +else { + /natable[n.field] := set() + insert(natable[n.field], willuse := namearray(n.field, table(), 0)) +} +every e := arraycandidates(n) & + e.lo - willuse.hi <= MAXRANGE do { + every willuse.tbl[e.lo to e.hi - 1] := e.node.name; + e.node.name := willuse + willuse.hi <:= e.hi + } +<<*>>= +procedure namesused(n, result) + /result := set() + if type(n.name) == "namearray" then insert(result, n.name) + every namesused((!n.children).node, result) + return result +end diff --git a/web/noweb/examples/graphs.nw b/web/noweb/examples/graphs.nw new file mode 100644 index 0000000000..a5f7b8cdc3 --- /dev/null +++ b/web/noweb/examples/graphs.nw @@ -0,0 +1,244 @@ +This is a noweb file for doing all the graphs in the paper. It sets +up generic chunks for setting up the axis sizes, etc, and gets all of +the graph's data from data.nw. + +@ This first chunk is to be used by all graphs. It sets up the axis +sizes, as well as the font sizes for labels. +<<Standard Defaults>>= + yaxis size 1.9 hash_labels fontsize 7 label fontsize 8 draw + xaxis size 2.14 hash_labels fontsize 7 label fontsize 8 draw + title fontsize 10 +@ +The following chunks define the curves for the four different +types of checkpointing algorithms. +<<Sequential Curve>>= + newcurve marktype circle fill 1 linetype solid +<<Concurrent Curve>>= + newcurve marktype diamond fill 0 linetype solid +<<Low Latency Curve>>= + newcurve marktype box fill 1 linetype solid +<<Low Latency Large Curve>>= + newcurve marktype box fill 0 linetype solid +@ +Finally, this chunk is for the split legends of graphs 1-4. +<<Legend>>= +newgraph + inherit_axes + xaxis min 0 max 10 nodraw + yaxis min 0 max 10 nodraw + <<Sequential Curve>> label fontsize 7 : Sequential + <<Concurrent Curve>> label fontsize 7 : Concurrent + legend x 0 y 11.5 +newgraph + inherit_axes + <<Low Latency Curve>> label fontsize 7 : Low Latency, Conc. + <<Low Latency Large Curve>> label fontsize 7 : Low Lat., Conc., Large + legend x 4.7 y 11.5 +@ +---- THE GRAPHS ---- +@ +GRAPHS 1 \& 2 +<<Graphs 1n2>>= +Y 3 +newgraph x_translate -1.37 + <<Graph 1>> +newgraph inherit_axes x_translate 1.7 + <<Graph 2>> +@ +Graph \#1: Checkpoint time. This is the wall-clock time to take one +checkpoint of a merge-sort program. +<<Graph 1>>= + <<Standard Defaults>> + title : Graph 1: Checkpoint Time. + xaxis min 0 max 10 hash 2 mhash 1 label : Heap Size (MBytes) + yaxis min 0 max 70 hash 10 mhash 1 label : Time (sec) + <<Sequential Curve>> + pts shell : notangle -R"Ckp Time" data.nw | head -6 | awk '{print $1" "$2}' + <<Concurrent Curve>> + pts shell : notangle -R"Ckp Time" data.nw | head -6 | awk '{print $1" "$3}' + <<Low Latency Curve>> + pts shell : notangle -R"Ckp Time" data.nw | head -6 | awk '{print $1" "$4}' + <<Low Latency Large Curve>> + pts shell : notangle -R"Ckp Time" data.nw | head -6 | awk '{print $1" "$5}' + <<Legend>> + +@ +Graph \#2: Checkpoint overhead. This is the extra time that it took +the program to complete after taking one checkpoint. +<<Graph 2>>= + <<Standard Defaults>> + title : Graph 2: Checkpoint Overhead. + xaxis min 0 max 10 hash 2 mhash 1 label : Heap Size (MBytes) + yaxis min 0 max 35 hash 10 mhash 1 label : Time (sec) + <<Sequential Curve>> + pts shell : notangle -R"Overhead" data.nw | awk '{print $1" "$2}' + <<Concurrent Curve>> + pts shell : notangle -R"Overhead" data.nw | awk '{print $1" "$3}' + <<Low Latency Curve>> + pts shell : notangle -R"Overhead" data.nw | awk '{print $1" "$4}' + <<Low Latency Large Curve>> + pts shell : notangle -R"Overhead" data.nw | awk '{print $1" "$5}' + <<Legend>> +@ +GRAPHS 3 \& 4 +<<Graphs 3n4>>= + Y 3 + newgraph x_translate -1.37 + <<Graph 3>> + newgraph inherit_axes x_translate 1.7 + <<Graph 4>> +@ +Graph \#3: Checkpoint Overhead Percentage. This is the percentage +of the checkpointing time which is overhead incurred on the target +program +<<Graph 3>>= + <<Standard Defaults>> + title : Graph 3: Checkpoint Overhead Percentage + xaxis min 0 max 10 hash 2 mhash 1 label : Heap Size (MBytes) + yaxis min 0 max 100 hash 10 mhash 1 label : % Overhead + <<Sequential Curve>> + pts shell : notangle -R"Ckp %age" data.nw | awk '{print $1" "$2}' + <<Concurrent Curve>> + pts shell : notangle -R"Ckp %age" data.nw | awk '{print $1" "$3}' + <<Low Latency Curve>> + pts shell : notangle -R"Ckp %age" data.nw | awk '{print $1" "$4}' + <<Low Latency Large Curve>> + pts shell : notangle -R"Ckp %age" data.nw | awk '{print $1" "$5}' + <<Legend>> +@ +Graph \#4: This displays what happens when the heaps get big +<<Graph 4>>= + <<Standard Defaults>> + title : Graph 4: Checkpoint Time for Large Heaps. + xaxis min 0 max 13 hash 2 mhash 1 label : Heap Size (MBytes) + yaxis min 0 max 700 hash 100 mhash 1 label : Time (sec) + <<Sequential Curve>> + pts shell : notangle -R"Ckp Time" data.nw | awk '{print $1" "$2}' + <<Concurrent Curve>> + pts shell : notangle -R"Ckp Time" data.nw | awk '{print $1" "$3}' + <<Low Latency Curve>> + pts shell : notangle -R"Ckp Time" data.nw | awk '{print $1" "$4}' + <<Low Latency Large Curve>> + pts shell : notangle -R"Ckp Time" data.nw | awk '{print $1" "$5}' + <<Legend>> +@ +Graph \#5: Latency Data +<<Graph 5>>= + Y 3 + newgraph + <<Standard Defaults>> + title : Graph 5: Latency Data. + xaxis min 0 max 13 hash 2 mhash 1 label : Heap Size (MBytes) + yaxis min 0 max .351 hash .1 mhash 1 label : Time(sec) + newcurve marktype circle fill 1 linetype solid + pts shell : notangle -R"Latency" data.nw | awk '{print $1" "$2}' + label : Initial Stop Time + newcurve marktype circle fill 0 linetype solid + pts shell : notangle -R"Latency" data.nw | awk '{print $1" "$3}' + label : Maximum Trap Time + legend right +@ +GRAPHS 6 \& 7 +<<Graphs 6n7>>= + Y 3 + newgraph x_translate -1.37 + <<Graph 6>> + newgraph inherit_axes x_translate 1.7 + <<Graph 7>> +@ +Graph \#6: Number of traps vs Segment Size +<<Graph 6>>= + <<Standard Defaults>> + title : Graph 6: Number of Traps vs. Segment Size. + xaxis min 0 max 128 hash 32 mhash 1 label : Segment Size (KBytes) + yaxis min 0 max 1000 hash 200 mhash 1 label : Number of Traps + newcurve marktype circle fill 1 linetype solid + pts shell : notangle -R"Num Traps" data.nw +@ +Graph \#7: Number of traps vs Segment Size +<<Graph 7>>= + <<Standard Defaults>> + title : Graph 7: Maximum Trap Time vs. Segment Size. + xaxis min 0 max 128 hash 32 mhash 1 label : Segment Size (KBytes) + yaxis min 0 max 1.4 hash .2 mhash 1 label : Maximum Trap Time (Sec) + newcurve marktype circle fill 1 linetype solid + pts shell : notangle -R"Trap Time" data.nw +@ +Graph \#8: Frequency of Traps +<<Graph 8>>= + Y 3 + newgraph + <<Standard Defaults>> + title : Graph \#8: Frequency of Traps. + xaxis min 0 max 2.6001 hash .5 mhash 4 + label : Starting Time of 0.1 second interval (sec) + yaxis min 0 max 10 hash 1 mhash 0 + label : Traps per 0.1 second Interval + newcurve marktype circle fill 0 pts + shell : notangle -R"Freq" data.nw + newstring hjr vjc fontsize 7 x 2.6 y 10 : Average Trap Time = 0.015 seconds +@ +GRAPHS 9 \& 10 +<<Graphs 9n10>>= + Y 3 + newgraph x_translate -1.37 + <<Graph 9>> + newgraph inherit_axes x_translate 1.7 + <<Graph 10>> +@ +Graph 9 \& 10 have bizarre legends as well: +<<Merge>>= + newcurve marktype circle fill 0 linetype solid +<<Trs>>= + newcurve marktype triangle fill 0 linetype none +<<Pattern>>= + newcurve marktype diamond fill 1 linetype none +<<Bubble>>= + newcurve marktype cross fill 1 linetype none +<<Matrix>>= + newcurve marktype box fill 1 linetype none +<<9n10 Legend>>= + newgraph inherit_axes + xaxis min 0 max 10 nodraw + yaxis min 0 max 10 nodraw + <<Merge>> + label fontsize 7 : Merge Sort + <<Trs>> + label fontsize 7 : Travelling Salesman + <<Pattern>> + label fontsize 7 : Pattern Match + legend x 0 y 12 + newgraph inherit_axes + <<Bubble>> + label fontsize 7 : Bubble Sort + <<Matrix>> + label fontsize 7 : Matrix Multiplication + legend x 5.6 y 12 +@ +Graph \#9: +<<Graph 9>>= + <<Standard Defaults>> + title : Graph 9: Checkpoint Time of Other Benchmarks. + xaxis min 0 max 10 hash 2 mhash 1 label : Heap Size (MBytes) + yaxis min 0 max 40 hash 10 mhash 1 label : Time (sec) + <<Merge>> + pts shell : notangle -R"Ckp Time" data.nw | head -6 | awk '{print $1" "$4}' + <<Trs>> pts .064 2.359 + <<Pattern>> pts 1.233 6.374 + <<Bubble>> pts .513 3.91 + <<Matrix>> pts 3.000 14.71 + <<9n10 Legend>> +@ +Graph \#10: +<<Graph 10>>= + <<Standard Defaults>> + title : Graph 10: Checkpoint Overhead of Other Benchmarks. + xaxis min 0 max 10 hash 2 mhash 1 label : Heap Size (MBytes) + yaxis min 0 max 5 hash 1 mhash 1 label : Time (sec) + <<Merge>> + pts shell : notangle -R"Overhead" data.nw | awk '{print $1" "$4}' + <<Trs>> pts .064 0.17 + <<Pattern>> pts 1.233 0.07 + <<Bubble>> pts .513 0.07 + <<Matrix>> pts 3.000 0.75 + <<9n10 Legend>> diff --git a/web/noweb/examples/mipscoder.nw b/web/noweb/examples/mipscoder.nw new file mode 100644 index 0000000000..a97f30774e --- /dev/null +++ b/web/noweb/examples/mipscoder.nw @@ -0,0 +1,1118 @@ +\section{A small assembler for the MIPS} +This is part of the code generator for Standard ML of New Jersey. +We generate code in several stages. +This is nearly the lowest stage; it is like an assembler. +The user can call any function in the [[MIPSCODER]] signature. +Each one corresponds to an assembler pseudo-instruction. +Most correspond to single MIPS instructions. +The assembler remembers all the instructions that have been +requested, and when [[codegen]] is called it generates MIPS +code for them. + +Some other structure will be able to use the MIPS structure to implement +a [[CMACHINE]], which is the abstract machine that ML thinks it is running +on. +(What really happens is a functor maps some structure +implementing [[MIPSCODER]] to a different structure implementing +[[CMACHINE]].) + +{\em Any function using a structure of this signature must avoid +touching registers 1~and~31. +Those registers are reserved for use by the assembler.} + +@ Here is the signature of the assembler, [[MIPSCODER]]. +It can be extracted from this file by +$$\hbox{\tt notangle mipsinstr.nw -Rsignature}.$$ +<<signature>>= +signature MIPSCODER = sig + +(* Assembler for the MIPS chip *) + +eqtype Label +datatype Register = Reg of int + (* Registers 1 and 31 are reserved for use by this assembler *) +datatype EA = Direct of Register | Immed of int | Immedlab of Label + (* effective address *) + +structure M : sig + + (* Emit various constants into the code *) + + val emitstring : string -> unit (* put a literal string into the + code (null-terminated?) and + extend with nulls to 4-byte + boundary. Just chars, no + descriptor or length *) + exception BadReal of string + val low_order_offset : int (* does the low-order word of a + floating point literal come + first (0) or second (1) *) + val realconst : string -> unit (* emit a floating pt literal *) + val emitlong : int -> unit (* emit a 4-byte integer literal *) + + + (* Label bindings and emissions *) + + val newlabel : unit -> Label (* new, unbound label *) + val define : Label -> unit (* cause the label to be bound to + the code about to be generated *) + val emitlab : int * Label -> unit (* L3: emitlab(k,L2) is equivalent to + L3: emitlong(k+L2-L3) *) + + (* Control flow instructions *) + + val slt : Register * EA * Register -> unit + (* (operand1, operand2, result) *) + (* set less than family *) + val beq : bool * Register * Register * Label -> unit + (* (beq or bne, operand1, operand2, branch address) *) + (* branch equal/not equal family *) + + val jump : Register -> unit (* jump register instruction *) + + val slt_double : Register * Register -> unit + (* floating pt set less than *) + val seq_double : Register * Register -> unit + (* floating pt set equal *) + val bcop1 : bool * Label -> unit (* floating pt conditional branch *) + + + (* Arithmetic instructions *) + (* arguments are (operand1, operand2, result) *) + + val add : Register * EA * Register -> unit + val and' : Register * EA * Register -> unit + val or : Register * EA * Register -> unit + val xor : Register * EA * Register -> unit + val sub : Register * Register * Register -> unit + val div : Register * Register * Register -> unit + (* first arg is some register + guaranteed to overflow when + added to itself. Used to + detect divide by zero. *) + val mult : Register * Register * Register -> unit + val mfhi : Register -> unit (* high word of 64-bit multiply *) + + (* Floating point arithmetic *) + + val neg_double : Register * Register -> unit + val mul_double : Register * Register * Register -> unit + val div_double : Register * Register * Register -> unit + val add_double : Register * Register * Register -> unit + val sub_double : Register * Register * Register -> unit + + (* Move pseudo-instruction : move(src,dest) *) + + val move : EA * Register -> unit + + (* Load and store instructions *) + (* arguments are (destination, source address, offset) *) + + val lbu : Register * EA * int -> unit (* bytes *) + val sb : Register * EA * int -> unit + val lw : Register * EA * int -> unit (* words *) + val sw : Register * EA * int -> unit + val lwc1: Register * EA * int -> unit (* floating point coprocessor *) + val swc1: Register * EA * int -> unit + val lui : Register * int -> unit + + (* Shift instructions *) + (* arguments are (shamt, operand, result) *) + (* shamt as Immedlab _ is senseless *) + + val sll : EA * Register * Register -> unit + val sra : EA * Register * Register -> unit + + + (* Miscellany *) + + val align : unit -> unit (* cause next data to be emitted on + a 4-byte boundary *) + val mark : unit -> unit (* emit a back pointer, + also called mark *) + + val comment : string -> unit + + end (* signature of structure M *) + + val codegen : unit->unit + + val codestats : outstream -> unit (* write statistics on stream *) + +end (* signature MIPSCODER *) +@ The basic strategy of the implementation is to hold on, via the [[kept]] +pointer, to the list of instructions generated so far. +We use [[instr]] for the type of an instruction, so +[[kept]] has type [[instr list ref]]. + +The instructions will be executed in the following order: the +instruction at the head of the [[!kept]] is executed last. +This enables us to accept calls in the order of execution but +add the new instruction(s) to the list in constant time. + + +@ +We structure the instruction stream a little bit by factoring +out the different load and store instructions that can +occur: we have load byte, load word, and load to coprocessor (floating point). +<<types auxiliary to [[instr]]>>= +datatype size = Byte | Word | Floating +@ +Here are the instructions that exist. +We list them in more or less the order of the MIPSCODER signature. +<<definition of [[instr]]>>= +<<types auxiliary to [[instr]]>> + +datatype instr = + STRINGCONST of string (* constants *) + | EMITLONG of int + + | DEFINE of Label (* labels *) + | EMITLAB of int * Label + + | SLT of Register * EA * Register (* control flow *) + | BEQ of bool * Register * Register * Label + | JUMP of Register + | SLT_D of Register * Register + | SEQ_D of Register * Register + | BCOP1 of bool * Label + + | NOP (* no-op for delay slot *) + + | ADD of Register * EA * Register (* arithmetic *) + | AND of Register * EA * Register + | OR of Register * EA * Register + | XOR of Register * EA * Register + | SUB of Register * Register * Register + | MULT of Register * Register + | DIV of Register * Register + | MFLO of Register (* mflo instruction used with + 64-bit multiply and divide *) + | MFHI of Register + + | NEG_D of Register * Register + | MUL_D of Register * Register * Register + | DIV_D of Register * Register * Register + | ADD_D of Register * Register * Register + | SUB_D of Register * Register * Register + + | MOVE of EA * Register (* put something into a register *) + | LDI_32 of int * Register (* load in a big immediate constant (>16 bits) *) + | LUI of Register * int (* Mips lui instruction *) + + | LOAD of size * Register * EA * int (* load and store *) + | STORE of size * Register * EA * int + + | SLL of EA * Register * Register (* shift *) + | SRA of EA * Register * Register + + | COMMENT of string (* generates nothing *) + | MARK (* a backpointer *) + + | BREAK of int (* break instruction *) +@ +Here is the code that handles the generated stream, [[kept]]. +It begins life as [[nil]] and returns to [[nil]] every time code is +generated. +The function [[keep]] is a convenient way of adding a single [[instr]] to +the list; it's very terse. +Sometimes we have to add multiple [[instr]]s; then we use [[keeplist]]. +We also define a function [[delay]] that is just like a [[keep]] but +it adds a NOP in the delay slot. +<<instruction stream and its functions>>= + val kept = ref nil : instr list ref + fun keep f a = kept := f a :: !kept + fun delay f a = kept := NOP :: f a :: !kept + fun keeplist l = kept := l @ !kept +<<reinitialize [[kept]]>>= + kept := nil +@ +\subsection{Exporting functions for {\tt MIPSCODER}} +We now know enough to implement most of the functions called for in +[[MIPSCODER]]. +We still haven't decided on an implementation of labels, +and there is one subtlety in multiplication and division, +but the rest is set. +<<[[MIPSCODER]] functions>>= + val emitstring = keep STRINGCONST (* literals *) + exception BadReal = IEEEReal.BadReal + val low_order_offset = Emitter.low_order_offset + val realconst = keep (STRINGCONST o order_real o IEEEReal.realconst) + val emitlong = keep EMITLONG + + <<label functions>> (* labels *) + + val slt = keep SLT (* control flow *) + val beq = delay BEQ + val jump = delay JUMP + val slt_double = delay SLT_D + val seq_double = delay SEQ_D + val bcop1 = delay BCOP1 + + val add = keep ADD (* arithmetic *) + val and' = keep AND + val or = keep OR + val xor = keep XOR + val op sub = keep SUB + <<multiplication and division functions>> + + val neg_double = keep NEG_D + val mul_double = keep MUL_D + val div_double = keep DIV_D + val add_double = keep ADD_D + val sub_double = keep SUB_D + + val move = keep MOVE + + fun lbu (a,b,c) = delay LOAD (Byte,a,b,c) (* load and store *) + fun lw (a,b,c) = delay LOAD (Word,a,b,c) + fun lwc1 (a,b,c) = delay LOAD (Floating,a,b,c) + fun sb (a,b,c) = keep STORE (Byte,a,b,c) + fun sw (a,b,c) = keep STORE (Word,a,b,c) + fun swc1 (a,b,c) = delay STORE (Floating,a,b,c) + val lui = keep LUI + + val sll = keep SLL (* shift *) + val sra = keep SRA + + fun align() = () (* never need to align on MIPS *) + val mark = keep (fn () => MARK) + val comment = keep COMMENT +@ +Multiplication has a minor complication; the +result has to be fetched from the LO register. +<<multiplication and division functions>>= +fun mult (op1, op2, result) = keeplist [MFLO result, MULT (op1, op2)] +val mfhi = keep MFHI +@ +Division has a major complication; I must test for divide by zero since +the hardware does not. +If the divisor is zero, I cause an overflow exception by +adding [[limitreg]] to itself. +<<multiplication and division functions>>= +fun op div (op1, op2, result) = + let val next = newlabel() + in keeplist [ + MFLO result, (* get the result *) + DEFINE next, (* skip to here if nonzero *) + BREAK 7, (* signals zerodivide *) + DIV (op1, op2), (* divide in delay slot *) + BEQ (false, Reg 0, op2, next) (* skip if divisor nonzero *) + ] + end +@ +For now, labels are just pointers to integers. +During code generation, those integers will be set to positions +in the instruction stream, and then they'll be useful as addresses +relative to the program counter pointer (to be held in [[Reg pcreg]]). +<<definition of [[Label]]>>= + type Label = int ref +<<label functions>>= + fun newlabel () = ref 0 + val define = keep DEFINE + val emitlab = keep EMITLAB +@ +Here's the overall plan of this structure: +<<*>>= +functor MipsCoder(Emitter: EMITTER) : MIPSCODER = struct + + open Emitter + <<definition of [[Label]]>> + + datatype Register = Reg of int + + datatype EA = Direct of Register + | Immed of int + | Immedlab of Label + + <<definition of [[instr]]>> + + <<instruction stream and its functions>> + + structure M = struct + <<[[MIPSCODER]] functions>> + end + + open M + + <<functions that assemble [[instr]]s into code>> + + <<statistics>> + +end (* MipsInstr *) +@ \subsection{Sizes of {\tt instr}s} +Now let's consider the correspondence between our [[instr]] type and the +actual MIPS instructions we intend to emit. +One important problem to solve is figuring out how big things are, +so that we know what addresses to generate for the various labels. +We will also want to know what address is currently stored in the program +counter regsiter ([[pcreg]]), +because we'll need to know when something is close +enough that we can use a sixteen-bit address relative to that register. +The kind of address we can use will determine how big things are. + +We'll rearrange the code so that we have a list of [[ref int * instr]] pairs, +where the [[ref int]] stores the position in the list. +(Positions start at zero.) +Since in the MIPS all instructions are the same size, we measure +position as number of instructions. +While we're at it, we reverse the list so that the head will execute first, +then the rest of the list. + +We begin with each position set to zero, and make a pass over the list +trying to set the value of each position. +We do this by estimating the size of (number of MIPS instructions +generated for) each [[instr]]. +Since there are forward references, we may not have all the distances right +the first time, so we have to make a second pass. +But during this second pass we could find that something is further +away than we thought, and we have to switch from using a pc-relative mode to +something else (or maybe grab the new pc?), which changes the size again, +and moves things even further away. +Because we can't control this process, we just keep making passes over the +list until the process quiesces (we get the same size twice). + +In order to guarantee termination, we have to make sure later passes only +increase the sizes of things. +This is sufficient since there is a maximum number of MIPS instructions +we can generate for each [[instr]]. + + +While we're at it, we might want to complicate things by making the function +that does the passes also emit code. +For a single pass we hand an optional triple of emitters, the initial position, +an [[int option]] for the program counter pointer (if known), and the +instructions. + + + +I'm not sure what explains the use of the [[ref int]] to track the position, +instead of just an [[int]]---it might be a desire to avoid the +overhead of creating a bunch of new objects, or it might be really hard +to do the passes cheaply. +It should think a variation on [[map]] would do the job, but maybe I'm +missing something. + +@ +[[emit : int * int -> unit]] emits one instruction, +and [[emit_string : int -> string -> unit]] emits a string constant. +[[emit_string]] could be specified as a function of [[emit]], +but the nature of the function would depend on whether the target +machine was little-endian or big-endian, and we don't want to have +that dependency built in. + + [[instrs]] is the +list of instructions (in execute-head-last order). + +The second argument to [[pass]] indicates for what instructions code +is to be generated. +It is a record (position of next instruction, program counter pointer if any, +remaining instructions to generate [with positions]). + +\indent [[prepare]] produces two results: the instruction stream with +size pointers added, and the total size of code to be generated. +We add the total size because that is the only way to find the number +of [[bltzal]]s, which are implicit in the instruction stream. + +<<assembler>>= +fun prepare instrs = + let fun add_positions(done, inst::rest) = + add_positions( (ref 0, inst) :: done, rest) + | add_positions(done, nil) = done + + val instrs' = add_positions(nil, instrs) (* reverse and add [[ref int]]s*) + + fun passes(oldsize) = + (* make passes with no emission until size is stable*) + let val size = pass false (0,NONE,instrs') + in if size=oldsize then size + else passes size + end + in {size = passes 0, stream = instrs'} + end + +fun assemble instrs = + pass true (0,NONE,#stream (prepare instrs)) + +<<functions that assemble [[instr]]s into code>>= +fun get (SOME x) = x + | get NONE = ErrorMsg.impossible "missing pcptr in mipscoder" + +<<[[pcptr]] functions>> +<<single pass>> +<<assembler>> + +fun codegen () = ( + assemble (!kept); + <<reinitialize [[kept]]>> + ) +@ +The program counter pointer is a device that enables us to to addressing +relative to the pcp register, register 31. +The need for it arises when we want to access a data element which we know +only by its label. +The labels give us addresses relative to the beginning of the function, +but we can only use addresses relative to some register. +The answer is to set register~31 with a [[bltzal]] instruction, +then use that for addressing. + +The function [[needs_a_pcptr]] determines when it is necessary +to have a known value in register~31. +That is, we need the program counter pointer +\begin{itemize} +\item +at [[NOP]] for a reason to be named later? +\item +at any operation that uses an effective address that refers to a label +(since all labels have to be relative to the program counter). +\item +BEQ's and BCOP1's to very far away, +since we have to compute the address for a JUMP +knowing the value of the program counter pointer. +\end{itemize} +<<[[pcptr]] functions>>= +fun needs_a_pcptr(_,SLT(_,Immedlab _,_)) = true + | needs_a_pcptr(_,ADD(_,Immedlab _,_)) = true + | needs_a_pcptr(_,AND(_,Immedlab _,_)) = true + | needs_a_pcptr(_,OR(_,Immedlab _,_)) = true + | needs_a_pcptr(_,XOR(_,Immedlab _,_)) = true + | needs_a_pcptr(_,MOVE(Immedlab _,_)) = true + | needs_a_pcptr(_,LOAD(_,_,Immedlab _,_)) = true + | needs_a_pcptr(_,STORE(_,_,Immedlab _,_)) = true + | needs_a_pcptr(_,SLL(Immedlab _,_,_)) = true + | needs_a_pcptr(_,SRA(Immedlab _,_,_)) = true + | needs_a_pcptr(1, BEQ _) = false (* small BEQ's dont need pcptr *) + | needs_a_pcptr(_, BEQ _) = true (* but large ones do *) + | needs_a_pcptr(1, BCOP1 _) = false (* small BCOP1's dont need pcptr *) + | needs_a_pcptr(_, BCOP1 _) = true (* but large ones do *) + | needs_a_pcptr _ = false +@ +Creating the program counter pointer once, with a [[bltzal]], is not +enough; we have to invalidate the program counter pointer at every +label, since control could arrive at the label from God knows where, and +therefore we don't know what the program counter pointer is. + +We use the function [[makepcptr]] to create a new program counter pointer +``on the fly'' while generating code for other [[instrs]]. +(I chose not to create a special [[instr]] for [[bltzal]], which I +could have inserted at appropriate points in the instruction stream.) +To try and find an odd bug, I'm adding no-ops after each [[bltzal]]. +I don't really believe they're necessary. + +The function [[gen]], which generates the instructions (or computes +their size), takes three arguments. +Third: the list of instructions to be generated (paired with pointers +to their sizes); first: the position (in words) at which to generate +those instructions; second: the current value of the program counter +pointer (register~31), if known. + +The mutual recursion between [[gen]] and [[makepcptr]] maintains +the program counter pointer. +[[gen]] invalidates it at labels, and calls [[makepcptr]] to create a valid +one when necessary (as determined by [[needs_a_pcptr]]). +<<single pass>>= +fun pass emit_now = +let fun makepcptr(i,x) = + (* may need to emit NOP for delay slot if next instr is branch *) + let val size = case x of ((_,BEQ _)::rest) => 2 + | ((_,BCOP1 _)::rest) => 2 + | _ => 1 + in if emit_now then (emit(Opcodes.bltzal(0,0)); + if size=2 then emit(Opcodes.add(0,0,0)) else ()) + else (); + gen(i+size, SOME (i+2), x) + end +and gen(i,_,nil) = i + | gen(i, _, (_,DEFINE lab) :: rest) = (lab := i; gen(i,NONE, rest)) + (* invalidate the pc pointer at labels *) + (* may want to do special fiddling with NOPs *) + | gen(pos, pcptr, x as ((sizeref as ref size, inst) :: rest)) = + if (pcptr=NONE andalso needs_a_pcptr(size, inst)) then makepcptr(pos,x) + else if emit_now + then + <<emit MIPS instructions>> + else + <<compute positions>> +in gen +end + +@ \subsection{Generating the instructions} +Now we need to consider the nitty-gritty details of just what instructions +are generated for each [[instr]]. +In early passes, we'll just need to know how many instructions are +required (and that number may change from pass to pass, so it must be +recomputed). +In the last pass, the sizes are stable (by definition), so we can look +at the sizes to see what instructions to generate. + +We'll consider the [[instrs]] in groups, but first, here's the +way we will structure things: +<<compute positions>>= +let <<functions for computing sizes>> + val newsize = case inst of + <<cases for sizes to be computed>> +in if newsize > size then sizeref := newsize else (); + gen(pos+(!sizeref) (* BUGS -- was pos+size*),pcptr,rest) +end +<<emit MIPS instructions>>= +let fun gen1() = gen(pos+size,pcptr,rest) + (* generate the rest of the [[instr]]s *) + open Bits + open Opcodes + <<declare reserved registers [[tempreg]] and [[pcreg]]>> + <<functions for emitting instructions>> +in case inst of + <<cases of instructions to be emitted>> +end +@ When we get around to generating code, we may need to use a temporary +register. +For example, if we want to load into a register +an immediate constant that won't fit +into 16~bits, we will have to load the high-order part of the constant +with [[lui]], then use [[addi]] to add then the low-order part. +The MIPS assembler has a similar problem, and on page D-2 of +the MIPS book we notice that register~1 is reserved for the use of the +assembler. +So we do the same. + +We need to reserve a second register for use in pointing to the program +counter. +We will use register 31 because the [[bltzal]] instruction automatically +sets register 31 to the PC. +<<declare reserved registers [[tempreg]] and [[pcreg]]>>= +val tempreg = 1 +val pcreg = 31 +@ +Before showing the code for the actual instructions, we should +point out that +we have two different ways of emitting a long word. +[[emitlong]] just splits the bits into two pieces for those cases +when it's desirable to put a word into the memory image. +[[split]] gives something that will load correctly +when the high-order piece is loaded into a high-order halfword +(using [[lui]]), +and the low-order piece is sign-extended and then added to the +high-order piece. +This is the way we load immediate constants of more than sixteen bits. +It is also useful for generating load or store instructions with +offsets of more than sixteen bits: we [[lui]] the [[hi]] part and +add it to the base regsiter, then use the [[lo]] part as an offset. +<<functions for emitting instructions>>= +fun emitlong i = emit(rshift(i,16), andb(i,65535)) + (* emit one long word (no sign fiddling) *) +fun split i = let val hi = rshift(i,16) and lo = andb(i,65535) + in if lo<32768 then (hi,lo) else (hi+1, lo-65536) + end + +@ We begin implementing [[instrs]] by considering those that emit constants. +String constants are padded with nulls out to a word boundary. +Integer constants are just emitted with [[emitlong]]. +<<cases for sizes to be computed>>= + STRINGCONST s => Integer.div(String.length(s)+3,4) +| EMITLONG _ => 1 +<<cases of instructions to be emitted>>= + STRINGCONST s => + let val s' = s ^ "\000\000\000\000" + in gen1(emit_string (4*size) s') + (* doesn't know Big vs Little-Endian *) + end +| EMITLONG i => gen1(emitlong i) +@ +Next consider the labels. +A [[DEFINE]] should never reach this far, and [[EMITLAB]] is almost like +an [[EMITLONG]]. +<<cases for sizes to be computed>>= +| DEFINE _ => ErrorMsg.impossible "generate code for DEFINE in mipscoder" +| EMITLAB _ => 1 +<<cases of instructions to be emitted>>= +| DEFINE _ => gen1(ErrorMsg.impossible "generate code for DEFINE in mipscoder") +| EMITLAB(i, ref d) => gen1(emitlong((d-pos)*4+i)) +@ +Now we have to start worrying about instructions with [[EA]] in them. +The real difficulty these things present is that they may have an +immediate operand that won't fit in 16~bits. +So we'll need to get this large immediate operand into a register, +sixteen bits at a time, and then do the operation on the register. + +Since all of the arithmetic instructions have this difficulty, and since +we can use them to implement the others, we'll start with those and +catch up with the control-flow instructions later. +@ [[SUB]], [[MULT]], [[DIV]], and [[MFLO]] all use registers only, +so they are easy. +The other arithmetic operations get treated exactly the same, so we'll +use a function to compute the size. +{\bf move this to follow the definition of [[arith]]?} +<<cases for sizes to be computed>>= +| ADD(_, ea, _) => easize ea +| AND(_, ea, _) => easize ea +| OR (_, ea, _) => easize ea +| XOR(_, ea, _) => easize ea +| SUB _ => 1 +| DIV (_,_) => 1 +| MULT (_,_) => 1 +| MFLO _ => 1 +| MFHI _ => 1 +@ Register operations take one instruction. +Immediate operations take one instruction for 16~bit constants, +and 3 for larger constants (since it costs two instructions to load +a big immediate constant into a register). +An immediate instruction with [[Immedlab l]] means that the operand +is intended to be the machine address associated with that label. +To compute that address, we need to add +[[4*(l-pcptr)]] to the contents of +register~[[pcreg]] (which holds [[4*pcptr]]), +put the results in a register, and operate on that register. + +This tells us enough to compute the sizes. +<<functions for computing sizes>>= +fun easize (Direct _) = 1 + | easize (Immed i) = if abs(i)<32768 then 1 else 3 + | easize (Immedlab(ref lab)) = 1 + easize(Immed (4*(lab-(get pcptr)))) +@ +As we have seen, +to implement any arithmetic operation, we need to know the register +form and the sixteen-bit immediate form. +We will also want the operator from [[instr]], since we do the +large immediate via a recursive call. +We'll set up a function, [[arith]], that does the job. +<<functions for emitting instructions>>= +fun arith (opr, rform, iform) = + let fun ar (Reg op1, Direct (Reg op2), Reg result) = + gen1(emit(rform(result,op1,op2))) + | ar (Reg op1, Immed op2, Reg result) = + (case size of + 1 (* 16 bits *) => gen1(emit(iform(result,op1,op2))) + | 3 (* 32 bits *) => + gen(pos,pcptr, + (ref 2, LDI_32(op2, Reg tempreg)):: + (ref 1, opr(Reg op1, Direct(Reg tempreg), Reg result)):: + rest) + | _ => gen(ErrorMsg.impossible + "bad size in arith Immed in mipscoder") + ) + | ar (Reg op1, Immedlab (ref op2), Reg result) = + gen(pos, pcptr, + (ref (size-1), + ADD(Reg pcreg,Immed(4*(op2-(get pcptr))), Reg tempreg)):: + (ref 1, opr(Reg op1, Direct(Reg tempreg), Reg result)):: + rest) + in ar + end +@ +The generation itself may be a bit anticlimactic. +The MIPS has no ``subtract immediate'' instruction, and [[SUB]] has +a different type than the others, so we emit it directly. +<<cases of instructions to be emitted>>= +| ADD stuff => arith (ADD,add,addi) stuff +| AND stuff => arith (AND,and',andi) stuff +| OR stuff => arith (OR,or,ori) stuff +| XOR stuff => arith (XOR,xor,xori) stuff +| SUB (Reg op1, Reg op2, Reg result) => gen1(emit(sub(result,op1,op2))) +| DIV (Reg op1, Reg op2) => gen1(emit(div(op1,op2))) +| MULT(Reg op1, Reg op2) => gen1(emit(mult(op1,op2))) +| MFLO(Reg result) => gen1(emit(mflo(result))) +| MFHI(Reg result) => gen1(emit(mfhi(result))) +@ Floating point arithmetic is pretty easy because we always do it in +registers. +We also support only one format, double precision. +<<cases for sizes to be computed>>= +| NEG_D _ => 1 +| MUL_D _ => 1 +| DIV_D _ => 1 +| ADD_D _ => 1 +| SUB_D _ => 1 +@ When emitting instructions we have to remember the Mips instructions +use result on the left, but the [[MIPSCODER]] signature requires result +on the right. +<<cases of instructions to be emitted>>= +| NEG_D (Reg op1,Reg result) => gen1(emit(neg_fmt(D_fmt,result,op1))) +<<functions for emitting instructions>>= +fun float3double instruction (Reg op1,Reg op2,Reg result) = + gen1(emit(instruction(D_fmt,result,op1,op2))) +<<cases of instructions to be emitted>>= +| MUL_D x => float3double mul_fmt x +| DIV_D x => float3double div_fmt x +| ADD_D x => float3double add_fmt x +| SUB_D x => float3double sub_fmt x + + +@ We offer a separate [[MOVE]] instruction because of large immediate +constants. +It is always possible to do [[move(src,dest)]] by doing +[[add(Reg 0,src,dest)]], but the general form [[add(Reg i, Immed c, dest)]] +takes three instructions when [[c]] is a large constant (more than 16 bits). +Rather than clutter up the code for [[add]] (and [[or]] and [[xor]]) by +trying to recognize register~0, we provide [[move]] explicitly. + +\indent [[LDI_32]] takes care of the particular case in which we are +loading a 32-bit immediate constant into a register. +It dates from the bad old days before [[MOVE]], and it might be a good idea +to remove it sometime. +<<functions for emitting instructions>>= +fun domove (Direct (Reg src), Reg dest) = gen1(emit(add(dest,src,0))) + | domove (Immed src, Reg dest) = + (case size of + 1 (* 16 bits *) => gen1(emit(addi(dest,0,src))) + | 2 (* 32 bits *) => + gen(pos,pcptr,(ref 2, LDI_32(src, Reg dest))::rest) + | _ => gen(ErrorMsg.impossible "bad size in domove Immed in mipscoder") + ) + | domove (Immedlab (ref src), Reg dest) = + gen(pos, pcptr, + (ref size, + ADD(Reg pcreg,Immed(4*(src-(get pcptr))), Reg dest))::rest) +@ Notice we use [[easize]] and not [[movesize]] in the third clause +because when we reach this point the treatment of a [[MOVE]] is the same +as that of an [[ADD]]. +<<functions for computing sizes>>= +fun movesize (Direct _) = 1 + | movesize (Immed i) = if abs(i)<32768 then 1 else 2 + | movesize (Immedlab(ref lab)) = easize(Immed (4*(lab-(get pcptr)))) + +<<cases for sizes to be computed>>= +| MOVE (src,_) => movesize src +| LDI_32 _ => 2 +| LUI _ => 1 +<<cases of instructions to be emitted>>= +| MOVE stuff => domove stuff +| LDI_32 (immedconst, Reg dest) => + let val (hi,lo) = split immedconst + in gen1(emit(lui(dest,hi));emit(addi(dest,dest,lo))) + end +| LUI (Reg dest,immed16) => gen1(emit(lui(dest,immed16))) + +@ +Now that we've done arithmetic, we can see how to do control flow without +too much trouble. +[[SLT]] can be treated just like an arithmetic operator. +[[BEQ]] is simple if the address to which we branch is close enough. +Otherwise we use the following sequence for [[BEQ(Reg op1, Reg op2, ref dest)]]: +\begin{verbatim} + bne op1,op2,L + ADD (Reg pcreg, Immed (4*(dest-pcptr)), Reg tempreg) + jr tempreg + L: ... +\end{verbatim} +Notice we don't have to put a [[NOP]] in the delay slot of the [[bne]]. +We don't need one after the jump unless we needed one after the +original [[BEQ]], in which case one will be there. +If the branch is taken, we're doing as well as we can. +If the branch is not taken, we will have executed an [[add]] or [[lui]] in the +delay slot of the [[bne]], but the results just get thrown away. +<<cases for sizes to be computed>>= +| SLT(_, ea, _) => easize ea +| BEQ(_,_,_,ref dest) => + if abs((pos+1)-dest) < 32768 then 1 (* single instruction *) + else 2+easize (Immed (4*(dest-(get pcptr)))) +| JUMP _ => 1 +| SLT_D _ => 1 +| SEQ_D _ => 1 +| BCOP1(_,ref dest) => + if abs((pos+1)-dest) < 32768 then 1 (* single instruction *) + else 2+easize (Immed (4*(dest-(get pcptr)))) +| NOP => 1 +@ The implementation is as described, except we use a +non-standard [[nop]]. +There are many Mips instructions that have no effect, and the standard +one is the word with all zeroes ([[sll 0,0,0]]). +We use [[add]], adding 0 to 0 and store the result in 0, because it +will be easy to distinguish from a data word that happens to be zero. +<<cases of instructions to be emitted>>= +| SLT stuff => arith (SLT,slt,slti) stuff +| BEQ(b, Reg op1, Reg op2, ref dest) => + if size = 1 then + gen1(emit((if b then beq else bne)(op1,op2,dest-(pos+1)))) + else gen(pos,pcptr, + (ref 1, BEQ(not b, Reg op1, Reg op2, ref(pos+size))) + ::(ref (size-2), + ADD(Reg pcreg, Immed(4*(dest-(get pcptr))), Reg tempreg)) + ::(ref 1, JUMP(Reg tempreg)) + ::rest) +| JUMP(Reg dest) => gen1(emit(jr(dest))) +| SLT_D (Reg op1, Reg op2) => + gen1(emit(c_lt(D_fmt,op1,op2))) +| SEQ_D (Reg op1, Reg op2) => + gen1(emit(c_seq(D_fmt,op1,op2))) +| BCOP1(b, ref dest) => + let fun bc1f offset = cop1(8,0,offset) + fun bc1t offset = cop1(8,1,offset) + in if size = 1 then + gen1(emit((if b then bc1t else bc1f)(dest-(pos+1)))) + else gen(pos,pcptr, + (ref 1, BCOP1(not b, ref(pos+size))) + ::(ref (size-2), + ADD(Reg pcreg, Immed(4*(dest-(get pcptr))), Reg tempreg)) + ::(ref 1, JUMP(Reg tempreg)) + ::rest) + end +| NOP => gen1(emit(add(0,0,0))) (* one of the many MIPS no-ops *) +@ +Our next problem is to tackle load and store. +The major difficulty is if the offset is too large to fit in +sixteen bits; if so, we have to create a new base register. +If we have [[Immedlab]], we do it as an offset from [[pcreg]]. +<<functions for emitting instructions>>= +fun memop(rform,Reg dest, Direct (Reg base), offset) = + (case size + of 1 => gen1(emit(rform(dest,offset,base))) + | 3 => let val (hi,lo) = split offset + in gen1(emit(lui(tempreg,hi)); (* tempreg = hi @<< 16 *) + emit(add(tempreg,base,tempreg));(* tempreg += base *) + emit(rform(dest,lo,tempreg)) (* load dest,lo(tempreg) *) + ) + end + | _ => gen1(ErrorMsg.impossible "bad size in memop Direct in mipscoder") + ) + | memop(rform,Reg dest, Immed address, offset) = + (case size + of 1 => gen1(emit(rform(dest,offset+address,0))) + | 2 => let val (hi,lo) = split (offset+address) + in gen1(emit(lui(tempreg,hi)); + emit(rform(dest,lo,tempreg)) + ) + end + | _ => gen1(ErrorMsg.impossible "bad size in memop Immed in mipscoder") + ) + | memop(rform,Reg dest, Immedlab (ref lab), offset) = + memop(rform, Reg dest, Direct (Reg pcreg), offset+4*(lab - get pcptr)) +@ The actual registers don't matter for computing sizes, and in fact +the value of [[pcreg]] is not visible here, so we use an arbitrary +register ([[Reg 0]]) to compute the size. +<<functions for computing sizes>>= +fun adrsize(_, Reg _, Direct _, offset) = + if abs(offset)<32768 then 1 else 3 + | adrsize(_, Reg _, Immed address, offset) = + if abs(address+offset) < 32768 then 1 else 2 + | adrsize(x, Reg dest, Immedlab (ref lab), offset) = + adrsize(x, Reg dest, Direct (Reg 0 (* pcreg in code *) ), + offset+4*(lab-(get pcptr))) +<<cases for sizes to be computed>>= +| LOAD x => adrsize x +| STORE x => adrsize x +<<cases of instructions to be emitted>>= +| LOAD (Byte,dest,address,offset) => memop(lbu,dest,address,offset) +| LOAD (Word,dest,address,offset) => memop(lw,dest,address,offset) +| LOAD (Floating,dest,address,offset) => memop(lwc1,dest,address,offset) +| STORE (Byte,dest,address,offset) => memop(sb,dest,address,offset) +| STORE (Word,dest,address,offset) => memop(sw,dest,address,offset) +| STORE (Floating,dest,address,offset) => memop(swc1,dest,address,offset) +@ +For the shift instructions, only register and immediate operands +make sense. +Immediate operands make sense if and only if they are representable +in five bits. +If everything is right, these are single instructions. +<<cases for sizes to be computed>>= +| SLL _ => 1 +| SRA _ => 1 +<<cases of instructions to be emitted>>= +| SLL (Immed shamt, Reg op1, Reg result) => gen1( + if (shamt >= 0 andalso shamt < 32) then emit(sll(result,op1,shamt)) + else ErrorMsg.impossible ("bad sll shamt " + ^ (Integer.makestring shamt) ^ " in mipscoder")) +| SLL (Direct(Reg shamt), Reg op1, Reg result) => + gen1(emit(sllv(result,op1,shamt))) +| SLL (Immedlab _,_,_) => ErrorMsg.impossible "sll shamt is Immedlab in mipscoder" +| SRA (Immed shamt, Reg op1, Reg result) => gen1( + if (shamt >= 0 andalso shamt < 32) then emit(sra(result,op1,shamt)) + else ErrorMsg.impossible ("bad sra shamt " + ^ (Integer.makestring shamt) ^ " in mipscoder")) +| SRA (Direct(Reg shamt), Reg op1, Reg result) => + gen1(emit(srav(result,op1,shamt))) +| SRA (Immedlab _,_,_) => ErrorMsg.impossible "sra shamt is Immedlab in mipscoder" +@ +Finally, comments are ignored, and marks (backpointers) are written into the +instruction stream. + +Comments are used by the front end to give diagnostics. +In the bad old days we would have had two different [[MIPSCODER]]s, one +which generated machine code (and ignored comments), and one which +wrote out assembly code (and copied comments). +Today we have just one, which means the rerouting of comments takes place +at a much higher level. Look in [[cps/mipsglue.nw]]. +<<cases for sizes to be computed>>= +| COMMENT _ => 0 +| MARK => 1 (* backpointer takes one word *) +| BREAK _ => 1 (* break instruction *) +@ Just for the record, here's the description of what a mark (backpointer) +is. +``Take the byte address at which the mark resides and add 4, giving +the byte address of the object following the mark. +(That object is the marked object.) +Subtract the byte address of the initial word that marks the +start of this instruction stream. +Now divide by 4, giving the distance in words between the +beginning of the block and the marked object. +Take that quantity and shift it left by multiplying by [[power_tags]], +and indicate the result is a mark by adding the tag bits [[tag_backptr]] +into the low order part.'' + [[pos+1]] is exactly the required distance in words. +<<cases of instructions to be emitted>>= +| COMMENT _ => gen1() +| MARK => gen1( + let open System.Tags + in emitlong((pos+1) * power_tags + tag_backptr) + end) +| BREAK n => gen1( + if n < 0 orelse n > 32 then ErrorMsg.impossible "bad break code" + else emit(break n)) +@ +\subsection{Optimization} +The first step towards optimization is to take statistics. +We will count: [[instrs]], Mips words, [[NOP]]s in load and branch delays, +and [[bltzal]]s. +In the current implementation the [[bltzal]]s are implicit, so there +is no way to count them or optimize them. +<<statistics>>= +fun printstats stream + {inst : int, code : int, data : int, + load : int, branch : int, compare : int, size : int} = + let val print = output stream + val nop = load+branch+compare + val bltzal = size - (code + data) + val code = code + bltzal + <<definition of [[sprintf]]>> + fun P x = substring(makestring(100.0 * x),0,4) (* percent *) + fun printf f d = print (sprintf f d) + in printf ["Counted "," instrs in "," words (", + " code, "," data)\n" ^ + "Used "," NOPs ("," load, "," branch,"," compare) and "," bltzals\n" ^ + "","% of code words were NOPs; ","% were bltzals\n" ^ + "","% of all words were code; ","% of all words were NOPs\n"] + [I inst, I size, I code, I data, + I nop, I load, I branch, I compare, I bltzal, + P (real nop / real code), P (real bltzal / real code), + P (real code / real size), P (real nop / real size)] + handle Overflow => print "[Overflow in computing Mips stats]\n" + end + +<<statistics>>= +<<definition of [[iscode]]>> +fun addstats (counts as {inst,code,data,load,branch,compare}) = + fn nil => counts + | (sizeref,first)::(_,NOP)::rest => addstats + {inst=inst+2, code=code+(!sizeref)+1, data=data, + load=load+ (case first of LOAD _ => 1 | _ => 0), + branch=branch +(case first of BEQ _ => 1 | JUMP _ => 1 + | BCOP1 _ => 1 | _ => 0), + compare=compare+(case first of SLT_D _ => 1 | SEQ_D _ => 1 + | _ => 0) + } rest + | (sizeref,first)::rest => addstats + {inst=inst+1, + code = code + if iscode(first) then !sizeref else 0, + data = data + if not (iscode first) then !sizeref else 0, + load=load, + branch=branch, + compare=compare + } rest + + +fun codestats outfile = + let val {size,stream=instrs} = prepare (!kept) + val zero = {inst=0, code=0, data=0, load=0, branch=0, compare=0} + val counts as {inst,code,data,load,branch,compare} = + addstats zero instrs + in printstats outfile + {inst=inst,code=code,data=data, + load=load,branch=branch,compare=compare,size=size} + end + +<<definition of [[iscode]]>>= +val iscode = fn + STRINGCONST _ => false + | EMITLONG _ => false + | DEFINE _ => false + | EMITLAB _ => false + + | SLT _ => true + | BEQ _ => true + | JUMP _ => true + | NOP => true + | SLT_D _ => true + | SEQ_D _ => true + | BCOP1 _ => true + + | ADD _ => true + | AND _ => true + | OR _ => true + | XOR _ => true + | SUB _ => true + | MULT _ => true + | DIV _ => true + | MFLO _ => true + | MFHI _ => true + + | NEG_D _ => true + | MUL_D _ => true + | DIV_D _ => true + | ADD_D _ => true + | SUB_D _ => true + + | MOVE _ => true + | LDI_32 _ => true + | LUI _ => true + + | LOAD _ => true + | STORE _ => true + + | SLL _ => true + | SRA _ => true + + | COMMENT _ => false + | MARK => false + | BREAK _ => true + +<<definition of [[sprintf]]>>= +val I = Integer.makestring +val R = Real.makestring +exception Printf +fun sprintf format values = + let fun merge([x],nil) = [x] + | merge(nil,nil) = nil + | merge(x::y,z::w) = x::z:: merge(y,w) + | merge _ = raise Printf + in implode(merge(format,values)) + end + +@ +At the moment these functions are meaningless junk. +<<functions that remove pipeline bubbles>>= +val rec squeeze = + + fn (x as LOAD(_,Reg d, m, i))::NOP::instr::rest => + if use(instr,d) then ?? + else squeeze(x::instr::rest) + | (x as STORE _)::(y as LOAD _)::rest => + x :: squeeze(y::rest) + | instr::(x as LOAD(_,Reg d, Direct(Reg s), i))::NOP::rest => + if use(instr, d) orelse gen(instr, s) then ?? + else squeeze(x::instr::rest) + | instr::(x as LOAD(_,Reg d, _, i))::NOP::rest => + if use(instr,d) then ?? + else squeeze(x::instr::rest) + | (x as MFLO _):: (y as MULDIV _) :: rest => + x :: squeeze (y::rest) + | (x as MFLO(Reg d))::instr::rest => + if (use(instr,d) orelse gen(instr,d) then ?? + else squeeze(instr::x::rest) + | instr :: (x as MULDIV(Reg a, Reg b)) :: rest => + if gen(instr,a) orelse gen(instr,b) then ?? + else squeeze(x::instr::rest) + +val rec final = + fn + | instr::(x as LOAD(_,Reg d, Direct(Reg s), i))::NOP::rest => + if gen(instr, s) then instr::final(x::NOP::rest) + else x::instr::(final rest) + | instr :: (x as JUMP _) :: NOP :: rest => + x :: instr :: final rest + | instr :: (x as BEQ(_,Reg a, Reg b, _)) :: NOP :: rest => + if gen(instr,a) orelse gen(instr,b) then instr::x::NOP::(final rest) + else x::instr::(final rest) +@ +\section{Indices} +\subsection{Chunks} +\nowebchunks +\subsection{Identifiers} +\nowebindex diff --git a/web/noweb/examples/multicol.sty b/web/noweb/examples/multicol.sty new file mode 100644 index 0000000000..bc1b703031 --- /dev/null +++ b/web/noweb/examples/multicol.sty @@ -0,0 +1,525 @@ +%% +%% This is file `multicol.sty', generated +%% on <1993/10/28> with the docstrip utility (2.1e). +%% +%% The original source files were: +%% +%% multicol.doc (with options: `style,check,marktrace') +%% +%% Copyright (C) 1989-1992 by Frank Mittelbach. All rights reserved. +%% +%% This file is part of the multicol package. +%% +%% IMPORTANT NOTICE: +%% +%% You are not allowed to change this file. You may however copy +%% this file to a file with a different name and then change the copy +%% if you obey the restrictions on file changes described in +%% readme.mz. +%% +%% You are NOT ALLOWED to distribute this file alone. You are NOT +%% ALLOWED to take money for the distribution or use of this file (or +%% a changed version) except for a nominal charge for copying etc. +%% +%% You are allowed to distribute this file under the condition that +%% it is distributed together with all files mentioned in readme.mz1. +%% +%% If you receive only some of these files from someone, complain! +%% +%% However, if these files are distributed by established suppliers +%% as part of a complete TeX distribution, and the structure of the +%% distribution would make it difficult to distribute the whole set +%% of files, *those parties* are allowed to distribute only some of +%% the files provided that it is made clear that the user will get a +%% complete distribution-set upon request to that supplier (not me). +%% Notice that this permission is not granted to the end user. +%% +%% +%% For error reports in case of UNCHANGED versions see readme.mz +%% +%% +\def\fileversion{v1.4m} +\def\filedate{92/09/04} +\def\docdate {92/09/04} + +%% \CheckSum{1101} +%% \CharacterTable +%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z +%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z +%% Digits \0\1\2\3\4\5\6\7\8\9 +%% Exclamation \! Double quote \" Hash (number) \# +%% Dollar \$ Percent \% Ampersand \& +%% Acute accent \' Left paren \( Right paren \) +%% Asterisk \* Plus \+ Comma \, +%% Minus \- Point \. Solidus \/ +%% Colon \: Semicolon \; Less than \< +%% Equals \= Greater than \> Question mark \? +%% Commercial at \@ Left bracket \[ Backslash \\ +%% Right bracket \] Circumflex \^ Underscore \_ +%% Grave accent \` Left brace \{ Vertical bar \| +%% Right brace \} Tilde \~} +%% +%% Style-option `multicol' to use with LaTeX v2.09 +%% Copyright (C) 1989-1992 Frank Mittelbach, all rights reserved. +\@ifundefined{mult@cols}{}{\endinput} +\typeout{Style option: `multicol' + \fileversion\space <\filedate> (FMi)} +\typeout{English documentation + \@spaces\@spaces\space<\docdate> (FMi)} +\def\multicols#1{\col@number#1\relax + \ifnum\col@number<\tw@ + \@warning{Using `\number\col@number' + columns doesn't seem a good idea.^^J + I therefore use two columns instead}% + \col@number\tw@ \fi + \ifnum\col@number>5 + \@warning{Current implementation doesn't + support more than five columns.^^J + I therefore use five columns instead}% + \col@number5 \fi + \@ifnextchar[\mult@cols{\mult@cols[]}} +\def\mult@cols[#1]{\@ifnextchar[% + {\mult@@cols{#1}}% + {\mult@@cols{#1}[\premulticols]}} +\def\mult@@cols#1[#2]{% + \par + \ifinner \@boxedmulticolstrue + \else + \ifnum \doublecol@number>\z@ + \@boxedmulticolstrue + \fi + \fi + \ifnum\c@tracingmulticols>\z@ + \typeout{^^J^^JStarting multicolumn + output with \the\col@number + \space columns% + \if@boxedmulticols\space + (boxed mode)\fi + \on@line:^^J}\fi + \enough@room{#2}% + {#1\par}\addvspace\multicolsep + \begingroup + \prepare@multicols + \if@boxedmulticols + \setbox\mult@box\vbox\bgroup + \penalty-\@M + \fi + \ignorespaces} +\newif\if@boxedmulticols \@boxedmulticolsfalse +\newbox\mult@box +\def\enough@room#1{% + \if@boxedmulticols\else + \par + \bgroup\@nobreakfalse\addpenalty\z@\egroup + \page@free \pagegoal + \advance \page@free -\pagetotal + \ifnum \c@tracingmulticols>\z@ + \typeout{Current page:}% + \message{\@spaces goal height=% + \the\pagegoal: used \the\pagetotal + \space -> free=\the\page@free}% + \typeout{\@spaces needed \the#1 + (for \string#1)}\fi + \ifdim \page@free <#1\newpage \fi + \fi} +\def\prepare@multicols{% + \multicol@leftmargin\@totalleftmargin + \@totalleftmargin\z@ + \parshape\z@ + \doublecol@number\col@number + \multiply\doublecol@number\tw@ + \if@boxedmulticols + \let\l@kept@firstmark\kept@firstmark + \let\l@kept@botmark\kept@botmark + \global\let\kept@firstmark\@empty + \global\let\kept@botmark\@empty + \else + \nointerlineskip \null + \output{% + \global\setbox\partial@page\vbox + {% + \ifvoid\partial@page\else + \@latexerr{Error saving partial + page\on@line}% + {The part of the page before + the multicols environment was + nearly full with the result + that starting the environment + will produce an overfull + page. Some text may be lost! + Please increase \premulticols + either generally or for this + environment by specifying a + suitable value in the second + optional argument to the + multicols environment.} + \unvbox\partial@page + \box\last@line + \fi + \unvbox\@cclv + \global\setbox\last@line\lastbox + }% + \prep@keptmarks + \global\let\kept@topmark\firstmark + }\eject + \advance\@colroom-\ht\partial@page + \vsize\col@number\@colroom + \advance\vsize\c@collectmore\baselineskip + \output{\multi@column@out}% + \multiply\count\footins\col@number + \multiply\skip \footins\col@number + \reinsert@footnotes + \fi + \vbadness10001 \hbadness5000 + \tolerance\multicoltolerance + \pretolerance\multicolpretolerance + \setemergencystretch\col@number\hsize + \set@floatcmds + \advance\baselineskip\multicolbaselineskip + \hsize\linewidth \advance\hsize\columnsep + \advance\hsize-\col@number\columnsep + \divide\hsize\col@number + \full@width\linewidth + \linewidth\hsize +} +\newdimen\multicol@leftmargin +\def\endmulticols{\par + \if@boxedmulticols + \egroup + \setbox\@tempboxa\vsplit\mult@box to\z@ + \balance@columns + \return@nonemptymark{first}\kept@firstmark + \return@nonemptymark{bot}\kept@botmark + \page@sofar + \global\let\kept@firstmark\l@kept@firstmark + \global\let\kept@botmark\l@kept@botmark + \ifnum\c@tracingmulticols>\tw@ + \typeout{Restore kept marks to% + ^^J first: \meaning\kept@firstmark% + ^^J bot\space\space: + \meaning\kept@botmark }% + \fi + \else + \bgroup\@nobreakfalse\addpenalty\z@\egroup + \output{\balance@columns@out}\eject + \ifvbox\partial@page\unvbox\partial@page\fi + \global\let\kept@firstmark\@empty + \global\let\kept@botmark\@empty + \ifnum\c@tracingmulticols>\tw@ + \typeout{Make kept marks empty}% + \fi + \fi + \@checkend{multicols}% + \endgroup + \if@boxedmulticols\else + \reinsert@footnotes + \fi + \global\c@unbalance\z@ + \enough@room\postmulticols + \addvspace\multicolsep + \ifnum\c@tracingmulticols>\z@ + \typeout{^^JEnding multicolumn + output% + \if@boxedmulticols + \space(boxed mode)\fi + .^^J^^J}\fi} +\newcount\c@unbalance +\newcount\c@collectmore +\newcount\c@tracingmulticols +\newcount\col@number +\newcount\doublecol@number +\newcount\multicoltolerance +\newcount\multicolpretolerance +\newdimen\full@width +\newdimen\page@free +\newdimen\premulticols +\newdimen\postmulticols +\newskip\multicolsep +\newskip\multicolbaselineskip +\newbox\partial@page +\newbox\last@line +\c@unbalance = 0 +\c@collectmore = 0 +\c@tracingmulticols = 0 +\col@number = 1 +\multicoltolerance = 9999 +\multicolpretolerance = -1 +\premulticols = 50pt +\postmulticols= 20pt +\multicolsep = 12pt plus 4pt minus 3pt +\multicolbaselineskip=0pt +\def\process@cols#1#2{\count@#1\relax + \loop #2% + \advance\count@\tw@ + \ifnum\count@<\doublecol@number + \repeat} +\def\page@sofar{% + \process@cols\z@{\wd\count@\hsize}% + \ifnum\c@tracingmulticols>\z@ + \typeout{Column spec: + (\the\multicol@leftmargin\space --> + \the\full@width\space = \the\hsize + \space x \the\col@number)^^J}% + \fi +\ifvmode\else\errmessage{Multicol Error}\fi + \moveright\multicol@leftmargin + \hbox to\full@width{% + \process@cols\tw@{\box\count@ + \hss\vrule\@width\columnseprule\hss}% + \box\z@ + \rlap{\phantom p}% +}% +} +\def\reinsert@footnotes{\ifvoid\footins\else + \insert\footins{}\fi} +\def\multi@column@out{% + \ifnum\outputpenalty <-\@Mi + \speci@ls \else + \splittopskip\topskip + \splitmaxdepth\maxdepth + \dimen@\@colroom + \divide\skip\footins\col@number + \ifvoid\footins \else + \advance\dimen@-\skip\footins + \advance\dimen@-\ht\footins \fi + \process@cols\tw@{\setbox\count@ + \vsplit\@cclv to\dimen@ + \set@keptmarks + \ifshr@nking + \setbox\count@\vbox to\dimen@ + {\unvbox\count@\vfill}% + \fi + }% + \setbox\z@\vsplit\@cclv to\dimen@ + \set@keptmarks + \ifshr@nking + \setbox\z@\vbox to\dimen@ + {\unvbox\z@\vfill}% + \fi + \ifvoid\@cclv \else + \unvbox\@cclv + \penalty\outputpenalty + \ifvoid\footins\else + \@warning{I moved some lines to + the next page.^^J + \@spaces Footnotes on page + \thepage\space might be wrong}% + \fi + \ifnum \c@tracingmulticols>\thr@@ + \hrule\allowbreak \fi + \fi + \ifx\@empty\kept@firstmark + \let\firstmark\kept@topmark + \let\botmark\kept@topmark + \else + \let\firstmark\kept@firstmark + \let\botmark\kept@botmark + \fi + \ifnum\c@tracingmulticols>\tw@ + \typeout{Use kept top + \space\space mark: + `\meaning\kept@topmark'% + ^^JUse kept first mark: + `\meaning\kept@firstmark'% + ^^JUse kept bot + \space\space mark: + `\meaning\kept@botmark'% + ^^JProduce first mark: + `\meaning\firstmark'% + ^^JProduce bot + \space\space mark: + `\meaning\botmark'}% + \fi + \setbox\@cclv\vbox{\unvbox\partial@page + \page@sofar}% + \@makecol\@outputpage + \global\let\kept@topmark\botmark + \global\let\kept@firstmark\@empty + \global\let\kept@botmark\@empty + \ifnum\c@tracingmulticols>\tw@ + \typeout{(Re)Init top + \space\space mark: + `\meaning\kept@topmark'}% + \fi + \global\@colroom\@colht + \process@deferreds + \@whilesw\if@fcolmade\fi{\@outputpage + \global\@colroom\@colht + \process@deferreds}% + \ifnum\c@tracingmulticols>\@ne + \typeout{Colroom: \the\@colht\space + after float space removed + = \the\@colroom }\fi + \global\vsize\col@number\@colroom + \global\advance\vsize + \c@collectmore\baselineskip + \fi} +\def\speci@ls{% + \typeout{Floats and marginpars not + allowed inside `multicols' + environment!}% + \unvbox\@cclv\reinsert@footnotes + \xdef\@freelist{\@freelist\@currlist}% + \gdef\@currlist{}} +\def\process@deferreds{% + \@floatplacement + \@tryfcolumn\@deferlist + \if@fcolmade\else + \begingroup + \let\@tempb\@deferlist + \gdef\@deferlist{}% + \let\@elt\@scolelt + \@tempb \endgroup + \fi} +\newif\ifshr@nking +\def\raggedcolumns{% + \@bsphack\shr@nkingtrue\@esphack} +\def\flushcolumns{% + \@bsphack\shr@nkingfalse\@esphack} +\def\balance@columns@out{% + \setbox\mult@box\vbox{\unvbox\@cclv}% + \balance@columns + \global\vsize\@colroom + \global\advance\vsize\ht\partial@page + \unvbox\partial@page + \return@nonemptymark{first}\kept@firstmark + \return@nonemptymark{bot}\kept@botmark + \page@sofar} +\def\balance@columns{% + \setbox\mult@box\vbox to\ht\mult@box{% + \unvbox\mult@box + \remove@discardable@items + }% + \get@keptmarks\mult@box + \splittopskip\topskip + \splitmaxdepth\maxdepth + \@tempdima\ht\mult@box + \advance\@tempdima\dp\mult@box + \divide\@tempdima\col@number + \count@\@tempdima + \divide\count@\baselineskip + \dimen@\count@\baselineskip + \advance\dimen@\topskip + \ifdim \dimen@ >\@tempdima + \advance\dimen@-\baselineskip + \fi + \advance\dimen@\c@unbalance\baselineskip + \ifnum\c@tracingmulticols>\@ne + \typeout{Balance columns\on@line: + \ifnum\c@unbalance=\z@\else + (off balance=\number\c@unbalance)\fi}% + \fi + \ifnum\dimen@<\topskip + \ifnum\c@tracingmulticols>\@ne + \typeout{Start value + \the\dimen@ \space -> + \the\topskip \space (corrected)}% + \fi + \dimen@\topskip + \fi + \vbadness\@M \loop + {\process@cols\@ne{\global\setbox\count@ + \box\voidb@x}}% + \global\setbox\@ne\copy\mult@box + {\process@cols\thr@@{% + \global\setbox\count@ + \vsplit\@ne to\dimen@ + }}% + \boxmaxdepth\maxdepth + \global\setbox\@ne\vbox{\unvbox\@ne}% + \ifnum\c@tracingmulticols>\@ne + \message{\@spaces First column + = \the\ht\thr@@}\fi + \ifshr@nking \global\setbox\thr@@ + \vbox{\unvbox\thr@@}% + \ifnum\c@tracingmulticols>\@ne + \message{ after shrinking + \the\ht\thr@@}\fi\fi + \ifnum\c@tracingmulticols>\@ne + \message{<> last column = + \the\ht\@ne^^J}% + \fi + \ifdim\ht\@ne >\ht\thr@@ + \advance\dimen@\p@ + \repeat + \dimen@\ht\thr@@ + \ifdim\dimen@>\@colroom + \dimen@\@colroom + \fi + \process@cols\z@{\@tempcnta\count@ + \advance\@tempcnta\@ne + \setbox\count@\vbox to\dimen@ + {\unvbox\@tempcnta + \ifshr@nking\vfill\fi}}% +} +\@ifundefined{emergencystretch} + {\newdimen\emergencystretch}{} +\def\setemergencystretch#1#2{% + \emergencystretch 4pt + \multiply\emergencystretch#1} + +\def\set@floatcmds{% + \let\@dblfloat\@dbflt + \def\end@dblfloat{\par + \vskip\z@\egroup + \ifnum\@floatpenalty<\z@ + \@cons\@deferlist\@currbox + \fi + \ifnum\@floatpenalty=-\@Mii + \@esphack + \fi}} +\def\kept@topmark{{}{}} +\let\kept@firstmark\@empty +\let\kept@botmark\@empty +\def\return@nonemptymark#1#2{% + \ifx#2\@empty + \else + \ifnum\c@tracingmulticols>\tw@ + \typeout{Returned #1 mark: \meaning#2}% + \nobreak + \fi + \mark{#2}% + \nobreak + \fi} +\def\get@keptmarks#1{% + \begingroup + \vbadness\@M + \setbox#1\copy#1% + \setbox#1\vsplit#1to\maxdimen + \set@keptmarks + \endgroup +} +\def\set@keptmarks{% + \ifx\kept@firstmark\@empty + \expandafter\gdef\expandafter + \kept@firstmark + \expandafter{\splitfirstmark}% + \ifnum\c@tracingmulticols>\tw@ + \ifx\kept@firstmark\@empty\else + \typeout{Set kept first mark: + `\meaning\kept@firstmark'}% + \fi + \fi + \fi + \expandafter\def\expandafter\@tempa + \expandafter{\splitbotmark}% + \ifx\@tempa\@empty\else + \global\let\kept@botmark\@tempa + \ifnum\c@tracingmulticols>\tw@ + \typeout{Set kept bot mark: + `\meaning\kept@botmark'}% + \fi + \fi}% +\def\prep@keptmarks{% + \if@boxedmulticols \else + \get@keptmarks\partial@page + \fi} +\def\remove@discardable@items{% + \unskip\unpenalty\unkern + \unskip\unpenalty\unkern + \unskip\unpenalty\unkern + \unskip\unpenalty\unkern +} +\endinput +%% +%% End of file `multicol.sty'. diff --git a/web/noweb/examples/primes.bbl b/web/noweb/examples/primes.bbl new file mode 100644 index 0000000000..6fbb9884a5 --- /dev/null +++ b/web/noweb/examples/primes.bbl @@ -0,0 +1,13 @@ +\begin{thebibliography}{1} + +\bibitem{knuth:literate} +Donald~E. Knuth. +\newblock Literate programming. +\newblock {\em The Computer Journal}, 27(2):97--111, 1984. + +\bibitem{dahl:structured} +Ole-Johan Dahl, Edsger~W. Dijkstra, and C.~A.~R. Hoare. +\newblock {\em Structured Programming}. +\newblock Academic Press, London and New York, 1972. + +\end{thebibliography} diff --git a/web/noweb/examples/primes.nw b/web/noweb/examples/primes.nw new file mode 100644 index 0000000000..d265b81b91 --- /dev/null +++ b/web/noweb/examples/primes.nw @@ -0,0 +1,186 @@ +% Copyright 1991 by Norman Ramsey. All rights reserved. +% See file COPYRIGHT for more information. + +% l2h substitution nw <tt>noweb</tt> +% some insanity is needed to avoid getting a double square bracket +% l2h substitution [ <b>[</b><b>[</b> +% l2h substitution ] <b>]</b><b>]</b> +\def\nw{{\tt noweb}} +\def\[{\ifhmode\ \fi$[\mkern-2mu[$} +\def\]{$]\mkern-2mu]$} + +\title{Printing Primes: An example of \nw} + +\section{Printing Primes: An example of \nw} +The following program is essentially the program that appears in +Reference~\cite{knuth:literate}, the first article on literate programming, +but rendered using \nw. +An important differents is the {\tt WEB} has macros, but \nw\ does not. +Knuth's program is itself essentially the same as Edsger Dijkstra's +``first example of step-wise program composition.''~\cite[pages +26--39]{dahl:structured}. + +Dijkstra's program prints a table of the first thousand prime numbers. +We shall begin as he did, by reducing the entire program to its +top-level description. + +<<*>>= +<<program to print the first thousand prime numbers>> +@ +\[Double brackets will be used in what follows to enclose comments +relating to \nw\ itself. +This definition of the root module could have been eliminated by +choosing to use +\begin{quote} +\tt notangle -R'program to print the first thousand prime numbers' +\end{quote} +to extract the program.\] +@ This program has no input, because we want to keep it simple. +The result of the program will be to produce a list of the first +thousand prime numbers, and this list will appear on the [[output]] +file. + +Since there is no input, we declare the value [[m = 1000]] as a +compile-time constant. +The program itself is capable of generating the first [[m]] prime +numbers for any positive [[m]], as long as the computer's finite +limitations are not exceeded. +<<program to print the first thousand prime numbers>>= +program `print_primes(output); + const m = 1000; + <<other constants of the program>> + var <<variables of the program>> + begin <<print the first [[m]] prime numbers>> + end. +@ + +\section{Plan of the program} +We shall proceed to fill out the rest of the program by making +whatever decisions seem easiest at each step; the idea will be to +strive for simplicity first and efficiency later, in order to see +where this leads us. +The final program may not be optimum, but we want it to be reliable, +well motivated, and reasonably fast. + +Let us decide at this point to maintain a table that includes all of +the prime numebrs that will be generated, and to sepaerate the +genreation problem from the printing problem. +<<print the first [[m]] prime numbers>>= +<<fill table [[p]] with the first [[m]] prime numbers>>; +<<print table [[p]]>> +@ +How should table [[p]] be represented? +Two possibilities suggest themselves: We could construct a +sifficiently large aray of boolean values in whith the $k$th entry is +[[true]] if and only if the number $k$ is prime; or we could build an +array of integers in which the $k$th entry is the $k$th prime number. +Let us choose the latter alternatice, by introducing an intereger +array called [[p[1..m]]]. +In the documentation below, the notation [[p[k]]] will refer to the +[[k]]th element of the array [[p]], while $p_k$ will refer to the +$k$th prime number. +If the program is correct [[p[k]]] will equal $p_k$ or it will not yet +have nbeen asigned any value. +<<variables of the program>>= +p: array [1..m] of integer; + { the first m prime numbers, in increasing order } +@ +\section{The output phase} +<<other constants of the program>>= +rr = 50; +cc = 4; +ww = 10; +<<variables of the program>>= +`page_number: integer; +`page_offset: integer; +`row_offset: integer; +c: 0..cc; +@ +<<print table [[p]]>>= +begin page_number := 1; page_offset := 1; +while page_offset <= m do + begin <<output a page of answers>>; + page_number := page_number + 1; + page_offset := page_poffset + rr * cc; + end; +end +<<output a page of answers>>= +begin write('The First '); +write(m:1); +write(' Prime Numbers --- Page '); +write(page_number:1); write_ln; write_ln; + { there's a blank line after the heading } +for row_offset := pages_offset to page_offset + rr - 1 + do <<output a line of answers>>; +page; +end +<<output a line of answers>>= +begin for c := 0 to cc - 1 do + if for_offset + c * rr <= m then + write(p[row_offset + c * rr]); +writeln; +end +@ +\section{Generating the primes} +<<fill table [[p]] with the first [[m]] prime numbers>>= +<<initialize the data structures>> +while k < m do + begin <<increase [[j]] until it is the next prime number>> + k := k + 1; p[k] := j; + end +<<variables of the program>>= +j: integer; { all primes <= j are in table p } +k: 0..m; { this many primes are in table p } +<<increase [[j]] until it is the next prime number>>= +repeat j := j + 2; + <<update variables that depend on [[j]]>>; + <<give to [[j_prime]] the meaning: [[j]] is a prime number>> +until j_prime +<<variables of the program>>= +`j_prime: boolean; +<<initialize the data structures>>= +j := 1; k := 1; p[1] := 2; +<<variables of the program>>= +`ord: 2..ord_max; + { the smallest index >= 2 such that p_ord squared > j } +`square: integer; + { square = p_ord squared } +<<initialize the data structures>>= +ord := 2; square := 9; +<<other constants of the program>>= +ord_max = 30; { p_ord_max squared must exceed p_m } +<<update variables that depend on [[j]]>>= +if j = square then + begin ord := ord + 1; + <<update variables that depend on [[ord]]>> + end +<<update variables that depend on [[ord]]>>= +square := p[ord] * p[ord]; { at this point ord <= k } +@ +\section{The inner loop} +<<give to [[j_prime]] the meaning: [[j]] is a prime number>>= +n := 2; j_prime := true; +while (n < ord) and j_prime do + begin <<if [[p[n]]] is a factor of [[j]], set [[j_prime := false]]>>; + n := n + 1; + end +<<variables of the program>>= +n: 2..ord_max; { runs from 2 to ord when testing divisibility } +<<variables of the program>>= +`mult: array [2..ord_max] of integer; + { runs through multiples of primes } +<<update variables that depend on [[ord]]>>= +mult[ord-1] := j; +<<if [[p[n]]] is a factor of [[j]], set [[j_prime := false]]>>= +while mult[n] < j do + mult[n] := mult[n] + p[n] + p[n]; +if mult[n] = j then j_prime := false; +@ +\section{Index} +\subsection{Chunks} +\nowebchunks +\subsection{Identifiers} +\nowebindex + +\bibliographystyle{unsrt} +\bibliography{web,cs,ramsey} diff --git a/web/noweb/examples/scanner.nw b/web/noweb/examples/scanner.nw new file mode 100644 index 0000000000..cb6372f8a4 --- /dev/null +++ b/web/noweb/examples/scanner.nw @@ -0,0 +1,444 @@ +% Norman Ramsey (nr@notecnirp) --- CS 320 + +\def\sizedboxit#1#2{\vtop{\vbox{\hrule\hbox{\vrule\kern #2% + \vtop{\vbox{\kern #2\hbox{#1}}\kern #2}\kern #2\vrule}}\hrule}} +\def\boxit#1{\sizedboxit{#1}{1pt}} +\def\token#1{\boxit{\strut\tt #1}} + +\setcounter{secnumdepth}{0} + +% l2h ignore boxit +% l2h argblock token tt +@ +In this assignment I print intermediate code. +<<grammatical C functions>>= +void print6 (Exp e) { + extern int yylineno; + printf("line %d:\n",yylineno); + if (e.type==error_type) + printf("# ERROR\n"); + else + printTree(e.tree,stdout); +} +<<grammatical C declarations>>= +void print6(Exp e); +@ +\section{The {\tt yacc} value stack} +Here are all the objects I use as synthesized attributes: +<<grammatical declarations>>= +%union { + char *string; + Type type; + Product product; + Symbol symbol; + Exp exp; + Explist explist; + int bit; +} +@ +\section{3. Vocabulary and representation} +\subsection{Representation of terminal symbols} +{\tt yacc} and {\tt lex} use integers to represent terminal +symbols (tokens). +Single-character tokens are represented by their ASCII codes. +Longer tokens are declared using {\tt yacc}'s [[%token]] declaration; +{\tt yacc} chooses an integer representation of each such token. +These representations are made available to the lexer via [[y.tab.h]]. +I use the standard trick from Kernighan and Pike ([[x.tab.h]] instead of +[[y.tab.h]]) to avoid remaking the lexer unecessarily. +<<lexical include files>>= +#include "x.tab.h" +@ +\subsection{1. Identifiers} +Since {\tt lex} is notoriously slow at using patterns to recognize + reserved words, I look up every identifier in a table of reserved words. +[[idcategory(id)]] returns the category of the reserved word [[id]] +when [[id]] is in fact a reserved word. +When [[id]] is not a reserved word, [[idcategory(id)]] returns [[IDENT]]. +<<lexical definitions>>= +letter [A-Za-z] +digit [0-9] +@ +The offensive [[<INITIAL>]] below has to do with handling comments (q.v.). +Both identifiers and reserved words +are saved in the string table and put on the {\tt yacc} value stack. +<<lexical rules>>= +<INITIAL>{letter}({letter}|{digit})* { yylval.string = strsave(yytext); + return idcategory(yytext); } +<<lexical C declarations>>= +extern char *strsave(char *s); +<<grammatical declarations>>= +%token IDENT +%type <string> IDENT +<<grammatical rules>>= +ident : IDENT + ; +<<grammatical declarations>>= +%type <string> ident +<<grammatical C declarations>>= +extern char yytext[]; +@ +\subsection{2. Numbers} +I have to use two different [[ScaleFactor]] definitions +so I can tell the difference between long and short reals. +Notice that the scale factor is {\em not} optional for the long real. +<<lexical rules>>= +<INITIAL>{digit}+|{digit}({hexDigit}*)[Hh] { yylval.string = strsave(yytext); + return INTEGER; } +<INITIAL>{digit}+"."{digit}*{EScaleFactor}? { yylval.string = strsave(yytext); + return REAL; } +<INITIAL>{digit}+"."{digit}*{DScaleFactor} { yylval.string = strsave(yytext); + return LONGREAL; } +<<grammatical declarations>>= +%token <string> INTEGER REAL LONGREAL +@ +I permit lower case where Wirth insists on upper case. +This will be convenient later on. +Besides, Hanson does it. + +I need parentheses around things like [[EScaleFactor]] because I'n not +really defining a regular expression---I'm using a macro facility. +<<lexical definitions>>= +hexDigit [0-9A-Fa-f] +EScaleFactor ([eE][+\-]?{digit}+) +DScaleFactor ([dD][+\-]?{digit}+) +@ +\subsection{3,4. Strings and character constants} +Single character strings [["x"]] become character constants, +not strings, thanks to the {\tt lex} disambiguation rules. +<<lexical rules>>= +<INITIAL>"\'"{nonquote}"\'" { yylval.string=strsave(yytext); return CHARCONST; } +<INITIAL>{digit}{hexDigit}*[Xx] { yylval.string=strsave(yytext); return CHARCONST; } +<INITIAL>"\""{nondoublequote}*"\"" { yylval.string=strsave(yytext); return STRING; } +<<grammatical declarations>>= +%token <string> CHARCONST STRING +@ +The character set for string literals is awkward, +because I want to include backslash escapes. +I use the ANSI standard backslash escapes from section A2.5.2 of +the second edition of Kernighan and Ritchie. +Because the lexical analyzer is probably not the right place to +handle illegal backslash escapes, I allow any reasonable +character to follow the backslash. +I define [[nonoctalx]] to be those characters +that can't start an octal or hexadecimal constant (when following +a backslash). +Then I can recognize octal and hexdecimal character constants like [["\012"]]. +I {\em don't} insist that at least one [[hexDigit]] follow [[\x]], +because again that should be handled downstream of the lexical analyzer. +<<lexical definitions>>= +plainnonquote [ \t\]\"!#$%&()*+,\-./0-9:;<=>?@A-Z[^_`a-z{|}~] +plainnondoublequote [ \t\]\'!#$%&()*+,\-./0-9:;<=>?@A-Z[^_`a-z{|}~] +escapedchar (\\({nonoctalx}|{octal}{octal}?{octal}?|x{hexDigit}*)) +nonoctalx [ \]\'\"!#$%&()*+,\-./89:;<=>?@A-Z[\\^_`a-wyz{|}~] +nonquote ({plainnonquote}|{escapedchar}) +nondoublequote ({plainnondoublequote}|{escapedchar}) +octal [0-7] +@ +I also need to handle strings that don't terminate. +When I see one, I gobble up the whole line on which it sits---that should +make it easier for the parser to recover. +(The alternative is trying to tokenize the characters following the open +quote.) +<<lexical rules>>= +<INITIAL>("\""{nondoublequote}*|"\'"{nonquote}*) <<complain; return bad string>> +@ +I print the first few characters of a nonterminated string, +followed by an ellipsis. +I return the string anyway because that way there's a chance that the parser +can just ignore the error. +<<complain; return bad string>>= +{ yyerror("Unterminated string %.8s%s",yytext,yyleng>8?"...":""); + yylval.string=strsave(""); + return STRING; +} +@ +I include prototypes for the string functions, to keep {\tt lcc -A} +from complaining about missing prototypes. +<<common include files>>= +#include <string.h> +@ +\subsection{5. Operators and delimiters} +Here are [[%token]] declarations for all the multicharacter tokens, +including the reserved words. +I use [[yyBEGIN]] because [[BEGIN]] means something special to {\tt lex}. +<<grammatical declarations>>= +%token ARROW INC DEC LSHIFT RSHIFT LEQ GEQ EQ NEQ AND OR + /* -> ++ -- @<< @>> <= >= == != && || */ +@ +I make sure the lexer always returns strings for identifiers +and reserved words. +@ +Recognizing the operators and delimiters is straightforward: +<<lexical rules>>= +<INITIAL>"->" return ARROW; +<INITIAL>"++" return INC; +<INITIAL>"--" return DEC; +<INITIAL>"<<" return LSHIFT; +<INITIAL>">>" return RSHIFT; +<INITIAL>"<=" return LEQ; +<INITIAL>">=" return GEQ; +<INITIAL>"==" return EQ; +<INITIAL>"!=" return NEQ; +<INITIAL>"&&" return AND; +<INITIAL>"||" return OR; +<INITIAL>[\]+!\-*/~&.,;|()[{}^=#<>:] return *yytext; +@ +\paragraph{Reserved word search} +Recall that, instead of having the {\tt lex}-generated automaton +recognize reserved words, I wanted to look up each identifier to see +if it is a reserved word. +I put the reserved words into an array and use binary search to find their +categories. +A word that isn't in the list has category [[IDENT]]. + +The list itself is excruciating to read. +I use a trick I got from Dave Hanson---I put the list in a header +file as calls to the [[kw]] (keyword) macro. +Then I include the header with appropriate macros wherever I need it. +<<list of reserved words>>= +kw(INT, "int") +@ +A binary search table of reserved words: +<<reserved word data structures>>= +static +struct reserved {char *s; int category;} +reservedwords[] = { +#define kw(VAL,STRING) {STRING,VAL}, +<<list of reserved words>> +#undef kw +}; +static int numreservedwords = (sizeof(reservedwords)/sizeof(struct reserved)); +@ +[[idcategory]] is just binary search. +<<lexical C functions>>= +<<reserved word data structures>> +static int idcategory (char *id) { + int low=0, high=numreservedwords-1, mid; + int compare; + while (low <= high) { + /* Invariant: if id is in the initial range low...high, + it is in the current range low...high */ + mid = (low+high)/2; /* note low <= mid <= high */ + compare = strcmp(id,reservedwords[mid].s); + if (compare>0) low = mid + 1; + else if (compare<0) high = mid - 1; + else return reservedwords[mid].category; + } + return IDENT; /* id is not a reserved word */ +} +<<lexical C declarations>>= +static int idcategory(char *); +@ +\subsection{Comments} +I use the standard trick of defining a special state just for comments. +A begin comment sends the lexer into state [[<COMMENT>]], and an +end comment returns it to state [[<INITIAL>]]. +All tokens that aren't comments are recognized only in state [[<INITIAL>]], +which explains the offensive [[<INITIAL>]] prepended to every rule. + +<<lexical definitions>>= +%S COMMENT +<<lexical rules>>= +<INITIAL>"/*" BEGIN COMMENT; +<COMMENT>"*/" BEGIN INITIAL; +<COMMENT>"\n" ; +<COMMENT>. ; +@ +\subsection{Whitespace and bad characters} +<<lexical rules>>= +<INITIAL>[ \t\n]+ ; /* ignore whitespace */ +<INITIAL>. <<complain about a bad character>> +@ +The error message we print is different for printable and nonprintable +characters. +<<complain about a bad character>>= +{ if (*yytext >= ' ' && *yytext < 0177) + yyerror("bad character `%c'", *yytext); + else yyerror("bad character `\\%03o'", *yytext); +} +@ +\section{8. Expressions} +\subsection{8.1 Operands (designators and constants)} +There are no qualified identifiers, so this simplifies the parsing +of designators. +It is a bit awkward to distinguish variables and parameters from +constant identifiers. +There is also an awkwardness with rvalues---boolean expressions +have to be converted from ``test'' to values using [[BOOL]]. +Following a suggestion of Hanson's, I use +three nonterminals: [[exp]] is an expression (possibly a test); +[[rvalue]] is an rvalue (never a test), and +[[lvalue]] is an lvalue. +I introduce [[complex_lvalue]] because I need to distinguish identifiers from +all other lvalues (otherwise I get a reduce-reduce conflict when converting +lvalues to expressions). +@ +<<grammatical declarations>>= +%type <exp> arraydes lvalue complex_lvalue rvalue exp +@ +Here are productions for all the C literals. +I use [[make_constval(type,string)]] to convert a string to a value of +the type desired. + +I issue warnings for long reals, since they aren't supported in Oberon/320. +<<grammatical rules>>= +exp : INTEGER { $$ = make_constval(integer_type,$1); } + | REAL { $$ = make_constval(real_type,$1); } + | LONGREAL { warning("Long reals not supported (replaced with zero)"); + $$ = make_constval(real_type,strsave("0.0")); } + | CHARCONST { $$ = make_constval(char_type,$1); } + | STRING { $$ = make_constval(build_array(0,stringchar_type),$1); } + ; +@ +\subsection{8.2 Operators} +I use {\tt yacc} precedence declarations. + +These declarations define precedence. +My task is much simplified because unary and binary [[-]] have +exactly the same precedence. +<<grammatical declarations>>= +%left OR +%left AND +%left '|' +%left '^' +%left '&' +%left EQ NEQ +%left '<' '>' LEQ GEQ +%left LSHIFT RSHIFT +%left '+' '-' +%left '*' '/' '%' +%right '!' '~' INC DEC /* unary operators */ +%left ARROW '.' +@ +[[binop]] checks types and generates intermediate code. +Consult the chapter on typechecking for the description of the +correct operation of [[binop]] and the meanings of +various permissions [[p_xxx]]. +<<grammatical rules>>= +complex_lvalue : lvalue '.' ident { $$ = find_field($1,$3); } + | exp ARROW ident { $$ = find_field(deref($1),$3) } + | '*' rvalue { $$ = deref($1); } + | arraydes ']' { $$ = $1; } + ; + +arraydes : rvalue '[' exp { $$ = subscript($1,$3); } + ; + +lvalue : complex_lvalue { $$ = $1; } + | ident { $$ = lookup_lvalue($1); } + ; + +exp : complex_lvalue { $$.type=$1.type; + $$.tree=tMEM($1.type->size,$1.tree); } + | ident { $$ = lookup_exp($1); } + ; + +rvalue : exp { $$ = boolval($1); } + ; +<<grammatical rules>>= +exp : exp EQ exp { $$ = binop(OSeq, $1,$3,boolean_type,p_equality); } + | exp NEQ exp { $$ = binop(OSneq,$1,$3,boolean_type,p_equality); } + | exp '<' exp { $$ = binop(OSlt, $1,$3,boolean_type,p_relational); } + | exp LEQ exp { $$ = binop(OSleq,$1,$3,boolean_type,p_relational); } + | exp '>' exp { $$ = binop(OSgt, $1,$3,boolean_type,p_relational); } + | exp GEQ exp { $$ = binop(OSgeq,$1,$3,boolean_type,p_relational); } + ; +exp : exp '+' exp { $$ = binop(OSplus, $1,$3,0,p_numeric); } + | exp '-' exp { $$ = binop(OSminus,$1,$3,0,p_numeric); } + | exp OR exp { $$ = binop(OSor, $1,$3,0,p_boolean); } + ; +exp : exp '*' exp { $$ = binop(OSmul, $1,$3,0,p_numeric); } + | exp AND exp { $$ = binop(OSand,$1,$3,0,p_boolean); } + ; +exp : '(' exp ')' { $$ = $2; } + ; +@ +\subsection{Function calls} +Calls to functions (procedures having a return type) +may occur {\em only} as factors in the production given below. +The +bottom of p.~678 of the Oberon report makes it clear that the~[[()]] are +required even if the function has no parameters. +<<not yet grammatical rules>>= +exp : ident ActualParameters { $$ = fcall($1,$2); } + ; + +ActualParameters: '(' ExpList ')' { $$ = $2; } + | '(' ')' { $$ = 0; } + ; + +ExpList : rvalue ',' ExpList { $$ = explist($1,$3); } + | rvalue { $$ = explist($1,0); } + ; +<<not yet grammatical declarations>>= +%type <explist> ActualParameters ExpList +@ +\section{11. Compilation units} +<<grammatical rules>>= +module : exp { compile($1); } +<<grammatical declarations>>= +%start module +@ +\section{Error recovery} +Here are some simple error productions that might help the parser continue. +The first four gobble up mangled declarations. +The last two are stabs in the dark; I hope they give the parser a chance +to recover from errors in statements and expressions. +<<grammatical rules>>= +exp : error { $$.type = error_type; } +@ +\section{Putting it all together} +Here are the necessary {\tt\#include} files: +<<common include files>>= +#include <assert.h> +#include <stdio.h> +#include "types.h" +#include "predef.h" +#include "tree.h" +#include "typecheck.h" +#include "codegen.h" +#include "symbol.h" +#include "declarations.h" +#include "constants.h" +#include "errors.h" +@ +There are no include files used exclusively by the parser. +This is because the lexer sees {\tt y.tab.h}, and so has to know everything +the parser knows. +<<grammatical include files>>= + +@ +This is boilerplate for every {\tt lex} specification ever written: +<<lexer>>= +%{ +<<common include files>> +<<lexical include files>> +<<lexical C declarations>> +%} +<<lexical definitions>> +%% +<<lexical rules>> +%% +<<lexical C functions>> +@ +And this is boilerplate for every {\tt yacc} specification ever written: +<<parser>>= +%{ +<<common include files>> +<<grammatical include files>> +<<grammatical C declarations>> +extern int yylex(void); +%} +<<grammatical declarations>> +%% +<<grammatical rules>> +%% +#define lint /* keep lcc from barking about no reference to yaccpar_sccsid */ +<<grammatical C functions>> +@ +\section{Indices} +\subsection{Chunks} +\nowebchunks +\subsection{Identifiers} +\nowebindex diff --git a/web/noweb/examples/sharpline b/web/noweb/examples/sharpline new file mode 100755 index 0000000000..5682c942b8 --- /dev/null +++ b/web/noweb/examples/sharpline @@ -0,0 +1,31 @@ +#!/bin/sh +# +# noweb filter to handle #line directives in noweb input +# +# sample usage: +# +# preprocessor files | notangle -L -filter sharpline - > result.c +# + +nawk ' +BEGIN { linestart = 1 } +/^(@nl|@index nl)$/ { linestart = 1; print; next } +/^@text #line +[0-9]+$/ { + if (linestart) + printf "@line %d\n", $3 + else + print + linestart = 0; next +} +/^@text #line +[0-9]+ +".*"$/ { + if (linestart) { + thisline = $3 + sub(/^@text #line +[0-9]+ +/, "") + thisfile = substr($0, 2, length($0) - 2) + printf "@file %s\n@line %d\n", thisfile, thisline + } else + print + linestart = 0; next +} +/^@(text |quote )/ { linestart = 0 } +{ print }' "$@" diff --git a/web/noweb/examples/test.nw b/web/noweb/examples/test.nw new file mode 100644 index 0000000000..c69da5a0ce --- /dev/null +++ b/web/noweb/examples/test.nw @@ -0,0 +1,17 @@ +% Copyright 1991 by Norman Ramsey. All rights reserved. +% See file COPYRIGHT for more information. +<<*>>= +one <<two>> <<three>> # uses two and three +@ %def one +<<two>>= +first of two +second of two +third of two +@ %def fish fowl duck +@ %def two +<<three>>= +first of three + second of three + third of three +@ %def three + diff --git a/web/noweb/examples/tree.nw b/web/noweb/examples/tree.nw new file mode 100644 index 0000000000..43613fb431 --- /dev/null +++ b/web/noweb/examples/tree.nw @@ -0,0 +1,326 @@ +\section{Generating decision trees} + +The crux of the problem is to transform a {\em case statement} into a +{\em decision tree}. A case statement has a {\em value}, a sequence +of {\em arms}, and a {\em trailer}. +Each arm has a pattern, and code to be executed. +When the case statement is executed, it chooses the first arm whose +pattern matches the value, then executes the corresponding code, then +executes the trailer. +I generate a {\em decision tree} to do the job. +Each internal node of the decision tree tests a field of the value. +It then chooses an edge (child) based on that value, and continues +testing fields until it reaches a leaf, at which time it executes the +code associated with that leaf. + +The goal of tree generation is not to generate just any tree, but the +tree with the fewest nodes. This problem is NP-complete, so I apply +a few heuristics. The results, at least for the machine descriptions +I use, seem to be as good as what I would come up with by hand. +@ +The arms of the case statement have some extra information. +The file and line number help with error message and make it possible +to generate [[#line]] statements that identify the source of the code. +The original arm gives the arm from which the current arm is derived, +and is useful for many of the heuristics. +<<*>>= +record caserec(arms,valcode,trailer) + # case arms, code to compute value, trailing code +record arm(file, line, pattern, code, original) + # pattern and code are the content + # line, file, original(pattern) are used for error reporting +@ +Each node of the decision tree is associated with a particular case +statement. +Internal nodes have children, and a [[field]] which says which field +we decided to test on. The edges that point to the children record +the interval of values for the particular child. +Leaf nodes have a [[name]] that records the name of the pattern known +to match at that leaf node. +<<*>>= +record node(cs, children, field, name) + # case statement, list of edges to children, field chosen, pattern name + # (name field used to support name operator, assigned only to leaves) +record edge(node, lo, hi) + # node pointed to and lo and hi interval of field for this edge +@ +To create a decision tree, I begin with a node containing the full, +original case statement. I then use a ``work queue'' approach to check +each node and see if it needs to be split. +If no pattern matches the node, or if the first pattern always matches +(with a unique name), no further splitting needs to be done, and I +assign a name to the leaf.\footnote{If the name isn't used, I assign +the name [["-unused-"]], because that will make it easier to combine +nodes in the dagging phase.} +Otherwise, I split the node. +<<*>>= +procedure needs_splitting(n) + if *n.cs.arms = 0 then fail + p := n.cs.arms[1].pattern + name := \p.disjuncts[1].name | p.name + every d := !p.disjuncts do { + n := \d.name | p.name + if n ~=== name then return # different names, needs splitting + else if *d.constraints = 0 then fail # always matches, needn't split + } + return # pattern doesn't always match -> split +end + +procedure tree(cs) + static heuristics + initial heuristics := [leafarms, childarms, nomatch, childdisjuncts, branchfactor] + + root := node(cs) + work := [edge(root)] # work queue of edges (nodes) to be expanded + while n := get(work).node do + if needs_splitting(n) then { + <<split node [[n]] and add children to work queue>> + } else { + if *n.cs.arms = 0 then + n.name := "-NOMATCH-" + else if n.cs.arms[1].code ? find_id("name") then { + p := n.cs.arms[1].pattern + n.name := \p.disjuncts[1].name | \p.name | "-unnamed-" + } else + n.name := &null + if \mapnames then n.name := map(\n.name) + } + return root +end +@ +Splitting a node involves choosing a field, finding out which intervals +of values of that field are interesting, and creating a child node for +each such interval of values. The patterns in the case statement of the +child node reflect the knowledge of the value interval of the tested +field. + +I make the decision by splitting the node on {\em each} field +mentioned in the case statement. I then compute some heuristic +functions of the children from each splitting and use the +best-scoring field. + +Some debugging information may be written to [[hdebug]] or [[sdebug]]. +<<split node [[n]] and add children to work queue>>= +fields := mentions(n.cs) +*fields > 0 | impossible("internal node mentions no fields") +candidates := table() +every f := !fields do + candidates[f] := split(n, f) +<<if debugging, split all and report>> +*fields > 1 & write(\hdebug, "Choosing one of ", patimage(fields)) +every h := !heuristics do { + if *fields = 1 then break + fields := findmaxima(h, candidates, fields) +write(\hdebug, image(h), " chose ", patimage(fields)) +} +*fields > 0 | impossible("no fields") +*fields = 1 | write(\hdebug, "tie among fields", patimage(fields), " near ", + image(n.cs.arms[1].original.file), ", line ", + n.cs.arms[1].original.line) +work |||:= n.children := candidates[n.field := ?fields] +<<if debugging, split all and report>>= +if \tryall & \hdebug & *fields > 1 then { + write(\hdebug, repl("=",10), " Splitting ", repl("=", 10)) + every findmaxima(!heuristics, candidates, fields) do write(\hdebug) + write(\hdebug, repl("=", 30), "\n") +} +@ +To split a node, I look at each interval of values that might be +interesting. I apply that interval to the case statement, and if there +can be any match, I create and add a new child node. +<<*>>= +procedure split(n, f) + local vals,v,d,val,c,p,j,i,newd,cst,child,newp + + patterns := [] + children := [] + every put(patterns, (!n.cs.arms).pattern) + r := intervals(patterns, f) + <<if debugging, write about splitting this node>> + + every i := 1 to *r - 1 do + put(children, edge(node(apply(n.cs, f, r[i], r[i+1]),[]), r[i], r[i+1])) + + write(\sdebug, "Done splitting.\n") + return children +end +<<if debugging, write about splitting this node>>= +writes(\sdebug, "Splitting ") +outpattern(\sdebug, patterns[1]) +every i := 2 to *patterns do { writes(\sdebug, " | "); outpattern(\sdebug, patterns[i])} +write(\sdebug, " on ", f.name) +@ +So, what is the new case statement that results from applying +$\tt lo \le f < hi$ to [[cs]]? +For each arm, I match the pattern against the interval. +If it succeeds, I create a new arm for the new case statement, +containing the reduced pattern. +<<*>>= +procedure apply(cs, f, lo, hi) + result := copy(cs) + result.arms := [] + write(\sdebug, " Applying ", stringininterval(f.name, lo, hi)) + every a := !cs.arms do + put(result.arms, + arm(a.file, a.line, pmatch(a.pattern, f, lo, hi), a.code, a.original)) + if alwaysmatches(result.arms[1].pattern) then + result.arms := [result.arms[1]] + return result +end + +# if lo <= f < hi and p matches, return the new p + +procedure pmatch(p, f, lo, hi) + result := pattern([], p.name) + every d := !p.disjuncts do + if c := !d.constraints & c.field === f then # disjunct mentions f + if c.lo <= lo & hi <= c.hi then { # this constraint is matched + newd := disjunct([], d.name) + every c := !d.constraints & c.field ~=== f do + put(newd.constraints, c) + put(result.disjuncts, newd) + } else + c.hi <= lo | c.lo >= hi | impossible("bad intervals") + else # disjunct does not mention f + put(result.disjuncts, d) + <<if debugging, write about results of [[pmatch]]>> + if *result.disjuncts > 0 then return result +end + +<<if debugging, write about results of [[pmatch]]>>= +if *result.disjuncts > 0 then writes(\sdebug, " ===> ") & outpattern(\sdebug, p) +# else writes(\sdebug, " ") & outpattern(\sdebug, p) + +if *result.disjuncts > 0 then write(\sdebug, " matches") +# else write(\sdebug, " does not match") +@ +\subsection{Tree-minimization heuristics} +First, the boilerplate that takes a heuristic [[h]], candidate +splittings, and a set of fields, and returns the set of fields with +the largest score on [[h]]. +<<*>>= +procedure findmaxima(h, candidates, fields) + local max + S := [] + every f := !fields do { + score := h(candidates[f], f) + write(\hdebug,"Field ", f.name, " scores ", score, " on ", image(h)) + /max := score - 1 + if score > max then { + max := score + S := [f] + } else if score = max then + put(S, f) + } + return set(S) +end +@ +Here's a big pile of heuristics. +I'm not sure I've ever needed more than the first two, but they're +amusing and easy enough to write. +<<*>>= +# leafarms: prefer candidate with most arms that appear at leaf +# nodes. Each original arm counted only once. +# Not matching is also counted as an arm. + +procedure leafarms(children, f) + arms := set() + every n := (!children).node & *n.cs.arms > 0 do + if not needs_splitting(n) then + insert(arms, n.cs.arms[1].original) + return *arms + if *(!children).node.cs.arms = 0 then 1 else 0 +end + +# childarms: prefer the candidate with the fewest arms in children + +procedure childarms(children, f) + sum := 0 + every sum -:= *(!children).node.cs.arms + return sum +end + +# nomatch: if tied on leafarms and childarms, take candidate +# with real leaf in preference to nomatch leaf + +procedure nomatch(children, f) + return if *(!children).node.cs.arms = 0 then -1 else 0 +end + +# childdisjuncts: prefer the candidate with the fewest disjuncts in children + +procedure childdisjuncts(children, f) + sum := 0 + every sum -:= *(!(!children).node.cs.arms).pattern.disjuncts + return sum +end + +# branchfactor: prefer the candidate with the fewest children + +procedure branchfactor(children, f) + return - *children +end +@ +\subsection{Utility functions} +<<*>>= +# If f is to be used to split patterns, what intervals need to be considered? + +procedure intervals(patterns, f) + cuts := set([0, 2^(f.hi - f.lo)]) + every p := !patterns & d := !p.disjuncts & c := !d.constraints & c.field === f do + every insert(cuts, c.lo | c.hi) + return sort(cuts) +end + +# what fields are mentioned in a case statement? + +procedure mentions(cs) + result := set() + every a := !cs.arms & d := !a.pattern.disjuncts & c := !d.constraints do + insert(result, c.field) + return result +end + +# find_id: tab to and past identifier id, returning its position +# ignores quotes, comment brackets + +procedure find_id(id) + static notlnum + initial notlnum := ~ (&letters ++ &digits ++ '_') + tab(p := find(id)) & p = 1 | (move(-1) & any(notlnum) & move(1)) & + =id & pos(0) | any(notlnum) & suspend p +end +@ +\subsection{Tree checking} +Once the tree is generated, it's useful to check it for redundant arms +and for arms that never match. These checks will help users catch +mistakes in their specifications. Note that I must check the +``original'' arms; that's why they're there. +<<*>>= +procedure checktree(n) + originals := set() + every insert(originals, (!n.cs.arms).original) + deletematching(n, originals) + every a := !originals do + warning("No word matches pattern at ", image(a.file), ", line ", a.line) + if hasnomatch(n) then + warning("Case statement at ", image(n.cs.arms[1].file), ", line ", + n.cs.arms[1].line - 1, " doesn't cover all cases") + return n +end + +procedure deletematching(n, originals) + if *originals = 0 then return + else if *n.children > 0 then every deletematching((!n.children).node, originals) + else every delete(originals, (!n.cs.arms).original) +end + +procedure hasnomatch(n) + if *n.children > 0 then return hasnomatch((!n.children).node) + else if *n.cs.arms = 0 then return # found it +end +@ +\section{Indices} +\subsection{Chunks} +\nowebchunks +\subsection{Identifiers} +\nowebindex diff --git a/web/noweb/examples/wc.bbl b/web/noweb/examples/wc.bbl new file mode 100644 index 0000000000..363d36fbe7 --- /dev/null +++ b/web/noweb/examples/wc.bbl @@ -0,0 +1,14 @@ +\begin{thebibliography}{1} + +\bibitem{guntermann:cweb} +Klaus Guntermann and Joachim Schrod. +\newblock {{\tt WEB}} adapted to {C}. +\newblock {\em {TUG}boat}, 7(3):134--137, October 1986. + +\bibitem{knuth:literate:book} +Donald~E. Knuth. +\newblock {\em Literate Programming}, volume~27 of {\em Center for the Study of + Language and Information Lecture Notes}. +\newblock Leland Stanford Junior University, Stanford, California, 1992. + +\end{thebibliography} diff --git a/web/noweb/examples/wc.nw b/web/noweb/examples/wc.nw new file mode 100644 index 0000000000..16ec82e7bf --- /dev/null +++ b/web/noweb/examples/wc.nw @@ -0,0 +1,372 @@ +\makeatletter +\def\idxexample#1{\nwix@id@uses#1} +\makeatother + +\section{An example of {\tt noweb}} +The following short program illustrates the use of {\tt noweb}, +a low-tech tool for literate programming. +The purpose of the program is to provide a basis for +comparing {\tt WEB} and {\tt noweb}, so I have used a program that has +been published before; +the text, code, and presentation are taken +from~\cite[Chapter~12]{knuth:literate:book}. +The notable differences are: +\begin{itemize} +\item +When displaying source code, +{\tt noweb} uses different typography. +In particular, {\tt WEB} makes good use of multiple fonts +and the ablity to typeset mathematics, and it may use + mathematical symbols in place of C~symbols (e.g. +``$\land$'' for ``{\tt \&\&}''). +{\tt noweb} uses a single fixed-width font for code. +\item +{\tt noweb} can work with {\LaTeX}, and I have used {\LaTeX} in this example. +\item +{\tt noweb} has no numbered ``sections.'' +\ifx\wbn\undefined +When numbers are needed for cross-referencing, {\tt noweb} uses page +numbers. +\else +When numbers are needed for cross-referencing, {\tt noweb} ordinarily uses page +numbers. +\fi +If two or more chunks appear on a page, for example, page~24, they are +distinguished by appending a letter to the page number, for example, +24a or 24b. +\ifx\wbn\undefined\else +{\LaTeX} computes these page numbers, but since {\LaTeX} is not used +in the production of {\it IEEE Software}, this example uses +consecutive ``chunk numbers'' instead of page numbers. +\fi +\item +{\tt noweb} has no special support for macros. +In the sample program, I have used the chunk +``\LA{}Definitions~{\nwtagstyle{}\subpageref{NWwc.5-DefB-1}}\RA{}'' to hold +macro definitions. +\item +{\tt noweb} does not recognize C~identifier definitions automatically, +so I had to add a list of defined identifiers to each code chunk. +Because {\tt noweb} is language-independent, it must use a heuristic +to find uses of identifiers. +This heuristic can be fooled into finding false ``uses'' +in comments or string literals, such as the use of +{\tt status} in chunk~\subpageref{NWwc.5-DefB-1}. +\item +The {\tt CWEB} version of this program has semicolons following most uses +of \LA$\cdots$\RA{}. +{\tt WEB} needs the semicolon or its equivalent to make +its prettyprinting come out right. +Because it does not attempt prettyprinting, {\tt noweb} needs no semicolons. +\item +Both {\tt WEB} and {\tt noweb} write chunk cross-reference information in +{\footnotesize footnote} font below each code chunk, for example, +``{\footnotesize\let\nwcodecomment=\relax\nwused{\\{NWwc.5-TheG-1}}}'' +Unlike {\tt WEB}, {\tt noweb} also includes cross-reference +information for identifiers, for example, +``{\footnotesize Defines +{\let\nwcodecomment=\relax\idxexample{{file\_count}{file:uncount}}}}'' +This information is generated using the {\tt @~\%def} markings in the +{\tt noweb} source. +\end{itemize} + +\subsection{Counting words} +This example, based on a program by Klaus Guntermann and +Joachim Schrod~\cite{guntermann:cweb} and a program by Silvio Levy and +D. E. Knuth~\cite[Chapter~12]{knuth:literate:book}, presents the ``word count'' +program from {\sc Unix}, rewritten in {\tt noweb} to demonstrate +literate programming using {\tt noweb}. +The level of detail in this document is intentionally high, for +didactic purposes; many of the things spelled out here don't need to +be explained in other programs. + +The purpose of {\tt wc} is to count lines, words, and/or characters in +a list of files. +The number of lines in a file is the number of newline characters it +contains. +The number of characters is the file length in bytes. +A ``word'' is a maximal sequence of consecutive characters other than +newline, space, or tab, containing at least one visible ASCII code. +(We assume that the standard ASCII code is in use.) + +\bigskip +@ +Most literate C programs share a common structure. +It's probably a good idea to state the overall structure explicitly at +the outset, even though the various parts could all be introduced in +chunks named \LA{*}\RA{} if we wanted to add them piecemeal. + +Here, then, is an overview of the file {\tt wc.c} that is defined by +the {\tt noweb} program {\tt wc.nw}: +<<*>>= +<<Header files to include>> +<<Definitions>> +<<Global variables>> +<<Functions>> +<<The main program>> +@ +We must include the standard I/O definitions, since we want to send +formatted output to [[stdout]] and [[stderr]]. +<<Header files to include>>= +#include <stdio.h> +@ + +The [[status]] variable will tell the operating system if the run was +successful or not, and [[prog_name]] is used in case there's an error +message to be printed. +<<Definitions>>= +#define OK 0 + /* status code for successful run */ +#define usage_error 1 + /* status code for improper syntax */ +#define cannot_open_file 2 + /* status code for file access error */ +<<Global variables>>= +int status = OK; + /* exit status of command, initially OK */ +char *prog_name; + /* who we are */ +@ + +Now we come to the general layout of the [[main]] +function. +<<The main program>>= +main(`argc, `argv) + int argc; + /* number of arguments on UNIX command line */ + char **argv; + /* the arguments, an array of strings */ +{ + <<Variables local to [[main]]>> + prog_name = argv[0]; + <<Set up option selection>> + <<Process all the files>> + <<Print the grand totals if there were multiple files>> + exit(status); +} +@ + +If the first argument begins with a `{\tt-}', the +user is choosing the desired counts and specifying +the order in which they should be displayed. +Each selection is given by the +initial character (lines, words, or characters). +For example, `{\tt-cl}' would cause just the +number of characters and the number of lines to +be printed, in that order. + +We do not process this string now; we simply remember where it is. +It will be used to control the formatting at output time. +<<Variables local to [[main]]>>= +int file_count; + /* how many files there are */ +char *which; + /* which counts to print */ +<<Set up option selection>>= +which = "lwc"; + /* if no option is given, print 3 values */ +if (argc > 1 && *argv[1] == '-') { + which = argv[1] + 1; + argc--; + argv++; +} +file_count = argc - 1; +@ + +Now we scan the remaining arguments and try to open a file, if possible. +The file is processed and its statistics are given. +We use a [[do ... while]] loop because we should read from the standard +input if no file name is given. +<<Process all the files>>= +argc--; +do { + <<If a file is given, try to open [[*(++argv)]]; [[continue]] if unsuccessful>> + <<Initialize pointers and counters>> + <<Scan file>> + <<Write statistics for file>> + <<Close file>> + <<Update grand totals>> + /* even if there is only one file */ +} while (--argc > 0); +@ + +Here's the code to open the file. A special trick allows us to handle +input from [[stdin]] when no name is given. +Recall that the file descriptor to [[stdin]] is~0; that's what we use +as the default initial value. +<<Variables local to [[main]]>>= +int `fd = 0; + /* file descriptor, initialized to stdin */ +<<Definitions>>= +#define READ_ONLY 0 + /* read access code for system open */ +<<If a file is given, try to open [[*(++argv)]]; [[continue]] if unsuccessful>>= +if (file_count > 0 +&& (fd = open(*(++argv), READ_ONLY)) < 0) { + fprintf(stderr, + "%s: cannot open file %s\n", + prog_name, *argv); + status |= cannot_open_file; + file_count--; + continue; +} +<<Close file>>= +close(fd); +@ +We will do some homemade buffering in order to speed things up: +Characters will be read into the [[buffer]] array before we process +them. +To do this we set up appropriate pointers and counters. +<<Definitions>>= +#define buf_size BUFSIZ + /* stdio.h BUFSIZ chosen for efficiency */ +<<Variables local to [[main]]>>= +char buffer[buf_size]; + /* we read the input into this array */ +register char *ptr; + /* first unprocessed character in buffer */ +register char *buf_end; + /* the first unused position in buffer */ +register int c; + /* current char, or # of chars just read */ +int in_word; + /* are we within a word? */ +long word_count, line_count, char_count; + /* # of words, lines, and chars so far */ +<<Initialize pointers and counters>>= +ptr = buf_end = buffer; +line_count = word_count = char_count = 0; +in_word = 0; +@ + +The grand totals must be initialized to zero at the beginning of the +program. +If we made these variables local to [[main]], we would have to do this +initialization explicitly; however, C's globals are automatically +zeroed. (Or rather, ``statically zeroed.'') (Get it?) +<<Global variables>>= +long tot_word_count, tot_line_count, + tot_char_count; + /* total number of words, lines, chars */ +@ + +\vskip0pt plus3in\penalty-500\vskip0pt plus-3in +The present chunk, which does the counting that is {\tt wc}'s {\em +raison d'\^etre}, was actually one of the simplest to write. +We look at each character and change state if it begins or ends a word. +<<Scan file>>= +while (1) { + <<Fill [[buffer]] if it is empty; [[break]] at end of file>> + c = *ptr++; + if (c > ' ' && c < 0177) { + /* visible ASCII codes */ + if (!in_word) { + word_count++; + in_word = 1; + } + continue; + } + if (c == '\n') line_count++; + else if (c != ' ' && c != '\t') continue; + in_word = 0; + /* c is newline, space, or tab */ +} +@ + +Buffered I/O allows us to count the number of characters almost for +free. +<<Fill [[buffer]] if it is empty; [[break]] at end of file>>= +if (ptr >= buf_end) { + ptr = buffer; + c = read(fd, ptr, buf_size); + if (c <= 0) break; + char_count += c; + buf_end = buffer + c; +} +@ + +It's convenient to output the statistics by defining a new function +[[wc_print]]; then the same function can be used for the totals. +Additionally we must decide here if we know the name of the file we have +processed or if it was just [[stdin]].{\hfuzz=11.1pt\par} +<<Write statistics for file>>= +wc_print(which, char_count, word_count, + line_count); +if (file_count) + printf(" %s\n", *argv); /* not stdin */ +else + printf("\n"); /* stdin */ +@ +<<Update grand totals>>= +tot_line_count += line_count; +tot_word_count += word_count; +tot_char_count += char_count; +@ + +We might as well improve a bit on {\sc Unix}'s {\tt wc} by displaying +the number of files too. +<<Print the grand totals if there were multiple files>>= +if (file_count > 1) { + wc_print(which, tot_char_count, + tot_word_count, tot_line_count); + printf(" total in %d files\n", file_count); +} +@ + +Here now is the function that prints the values according to the +specified options. +The calling routine is supposed to supply a newline. +If an invalid option character is found we inform the user about proper +usage of the command. +Counts are printed in 8-digit fields so that they will line up in +columns. +<<Definitions>>= +#define print_count(n) printf("%8ld", n) +<<Functions>>= +wc_print(which, char_count, word_count, line_count) + char *which; /* which counts to print */ + long char_count, word_count, line_count; + /* given totals */ +{ + while (*which) + switch (*which++) { + case 'l': print_count(line_count); + break; + case 'w': print_count(word_count); + break; + case 'c': print_count(char_count); + break; + default: + if ((status & usage_error) == 0) { + fprintf(stderr, + "\nUsage: %s [-lwc] [filename ...]\n", + prog_name); + status |= usage_error; + } + } +} +@ + +Incidentally, a test of this program against the system {\tt wc} +command on a SPARCstation showed that the ``official'' {\tt wc} was +slightly slower. +Furthermore, although that {\tt wc} gave an appropriate error message +for the options `{\tt-abc}', it made no complaints about the options +`{\tt-labc}'! +Dare we suggest that the system routine might have been better if its +programmer had used a more literate approach? +@ + +\section*{List of code chunks} +This list is generated automatically. +The numeral is that of the first definition of the chunk. +\nowebchunks +%\begin{multicols}{2}[ +\section*{Index} +Here is a list of the identifiers used, and where they appear. +Underlined entries indicate the place of definition. +This index is generated automatically. +%] +\nowebindex +%\end{multicols} + diff --git a/web/noweb/examples/wc.nw2html b/web/noweb/examples/wc.nw2html new file mode 100644 index 0000000000..6067d7768c --- /dev/null +++ b/web/noweb/examples/wc.nw2html @@ -0,0 +1,370 @@ +<html> +<HEAD> +<title>An Example of noweb</title></HEAD> +<BODY> + +<H1>An Example of noweb</H1> +<address>Norman Ramsey<br> +Dept. of Computer Science, Princeton University<br> +Princeton, NJ 08544 +</address> + +<h2><a name="contents">Contents</a></h2> +<ul> +<li><a href="#intro">Introduction</a> +<li><a href="#counting">Counting words</a> +<li><a href="#index">Index</a> +</ul> + +<h2><a name="intro">Introduction</a></h2> + +The following short program illustrates the use of <tt>noweb</tt>, +a low-tech tool for literate programming. +The purpose of the program is to provide a basis for +comparing <tt>WEB</tt> and <tt>noweb</tt>, so I have used a program that has +been published before; +the text, code, and presentation are taken +from Chapter 12 of D. E. Knuth, +<cite>Literate Programming</cite> +(volume 27 of <cite>Center for the Study of +Language and Information Lecture Notes</cite>, +Stanford Univ., 1992).<p> + +The notable differences are: +<ul> +<li> +When displaying source code, +<tt>noweb</tt> uses different typography. +In particular, <tt>WEB</tt> makes good use of multiple fonts +and the ablity to typeset mathematics, and it may use + mathematical symbols in place of C symbols (e.g. +a logical ``and'' symbol for ``[[&&]]''). +<tt>noweb</tt> uses a single fixed-width font for code. +<li> +<tt>noweb</tt> can work with HTML, and I have used HTML in this example. +<li> +<tt>noweb</tt> has no numbered ``sections.'' +When cross-referencing is needed, <tt>noweb</tt> uses hypertext links or page +numbers. +<li> +<tt>noweb</tt> has no special support for macros. +In the sample program, I have used +a ``Definitions'' chunk to hold +macro definitions. +<li> +<tt>noweb</tt>'s index of identifiers is less accurate than <tt>WEB</tt>'s, +because it uses a language-independent heuristic to find identifiers. +This heuristic may erroneously find ``uses'' of identifiers +in string literals or comments. +Although <tt>noweb</tt> does have a language-dependent algorithm for finding +definitions of identifiers, that algorithm is less reliable than <tt>CWEB</tt>'s, +because <tt>noweb</tt> does not really parse C code. +<li> +The <tt>CWEB</tt> version of this program has semicolons following most uses +of <...>. +<tt>WEB</tt> needs the semicolon or its equivalent to make +its prettyprinting come out right. +Because it does not attempt prettyprinting, <tt>noweb</tt> needs no semicolons. +</ul> + +<h2><a name="counting">Counting words</a></h2> + +This example, based on a program by Klaus Guntermann and +Joachim Schrod (`<tt>WEB</tt> adapted to C.' +<cite>TUGboat</cite> <b>7</b>(3):134-7, Oct. 1986) +and a program by Silvio Levy and +D. E. Knuth (Ch. 12 of <cite>Literate Programming</cite>), +presents the ``word count'' +program from Unix, rewritten in <tt>noweb</tt> to demonstrate +literate programming using <tt>noweb</tt>. +The level of detail in this document is intentionally high, for +didactic purposes; many of the things spelled out here don't need to +be explained in other programs.<p> + +The purpose of <tt>wc</tt> is to count lines, words, and/or characters in +a list of files. +The number of lines in a file is the number of newline characters it +contains. +The number of characters is the file length in bytes. +A ``word'' is a maximal sequence of consecutive characters other than +newline, space, or tab, containing at least one visible ASCII code. +(We assume that the standard ASCII code is in use.)<p> + +Most literate C programs share a common structure. +It's probably a good idea to state the overall structure explicitly at +the outset, even though the various parts could all be introduced in +chunks named <*> if we wanted to add them piecemeal.<p> + +Here, then, is an overview of the file <tt>wc.c</tt> that is defined by +the <tt>noweb</tt> program <tt>wc.nw</tt>: +<<*>>= +<<Header files to include>> +<<Definitions>> +<<Global variables>> +<<Functions>> +<<The main program>> +@ +We must include the standard I/O definitions, since we want to send +formatted output to [[stdout]] and [[stderr]]. +<<Header files to include>>= +#include <stdio.h> +@ + +The [[status]] variable will tell the operating system if the run was +successful or not, and [[prog_name]] is used in case there's an error +message to be printed. +<<Definitions>>= +#define OK 0 + /* status code for successful run */ +#define usage_error 1 + /* status code for improper syntax */ +#define cannot_open_file 2 + /* status code for file access error */ +@ %def OK usage_error cannot_open_file +<<Global variables>>= +int status = OK; + /* exit status of command, initially OK */ +char *prog_name; + /* who we are */ +@ %def status prog_name + +Now we come to the general layout of the [[main]] +function. +<<The main program>>= +main(argc, argv) + int argc; + /* number of arguments on UNIX command line */ + char **argv; + /* the arguments, an array of strings */ +{ + <<Variables local to [[main]]>> + prog_name = argv[0]; + <<Set up option selection>> + <<Process all the files>> + <<Print the grand totals if there were multiple files>> + exit(status); +} +@ %def main argc argv + +If the first argument begins with a `[[-]]', the +user is choosing the desired counts and specifying +the order in which they should be displayed. +Each selection is given by the +initial character (lines, words, or characters). +For example, `[[-cl]]' would cause just the +number of characters and the number of lines to +be printed, in that order.<p> + +We do not process this string now; we simply remember where it is. +It will be used to control the formatting at output time. +<<Variables local to [[main]]>>= +int file_count; + /* how many files there are */ +char *which; + /* which counts to print */ +@ %def file_count which +<<Set up option selection>>= +which = "lwc"; + /* if no option is given, print 3 values */ +if (argc > 1 && *argv[1] == '-') { + which = argv[1] + 1; + argc--; + argv++; +} +file_count = argc - 1; +@ + +Now we scan the remaining arguments and try to open a file, if possible. +The file is processed and its statistics are given. +We use a [[do ... while]] loop because we should read from the standard +input if no file name is given. +<<Process all the files>>= +argc--; +do { + <<If a file is given, try to open [[*(++argv)]]; [[continue]] if unsuccessful>> + <<Initialize pointers and counters>> + <<Scan file>> + <<Write statistics for file>> + <<Close file>> + <<Update grand totals>> + /* even if there is only one file */ +} while (--argc > 0); +@ + +Here's the code to open the file. A special trick allows us to handle +input from [[stdin]] when no name is given. +Recall that the file descriptor to [[stdin]] is 0; that's what we use +as the default initial value. +<<Variables local to [[main]]>>= +int fd = 0; + /* file descriptor, initialized to stdin */ +@ %def fd +<<Definitions>>= +#define READ_ONLY 0 + /* read access code for system open */ +@ %def READ_ONLY +<<If a file is given, try to open [[*(++argv)]]; [[continue]] if unsuccessful>>= +if (file_count > 0 +&& (fd = open(*(++argv), READ_ONLY)) < 0) { + fprintf(stderr, + "%s: cannot open file %s\n", + prog_name, *argv); + status |= cannot_open_file; + file_count--; + continue; +} +<<Close file>>= +close(fd); +@ +We will do some homemade buffering in order to speed things up: +Characters will be read into the [[buffer]] array before we process +them. +To do this we set up appropriate pointers and counters. +<<Definitions>>= +#define buf_size BUFSIZ + /* stdio.h BUFSIZ chosen for efficiency */ +@ %def buf_size +<<Variables local to [[main]]>>= +char buffer[buf_size]; + /* we read the input into this array */ +register char *ptr; + /* first unprocessed character in buffer */ +register char *buf_end; + /* the first unused position in buffer */ +register int c; + /* current char, or # of chars just read */ +int in_word; + /* are we within a word? */ +long word_count, line_count, char_count; + /* # of words, lines, and chars so far */ +@ %def buffer ptr buf_end in_word word_count line_count char_count +<<Initialize pointers and counters>>= +ptr = buf_end = buffer; +line_count = word_count = char_count = 0; +in_word = 0; +@ + +The grand totals must be initialized to zero at the beginning of the +program. +If we made these variables local to [[main]], we would have to do this +initialization explicitly; however, C's globals are automatically +zeroed. (Or rather, ``statically zeroed.'') (Get it?) +<<Global variables>>= +long tot_word_count, tot_line_count, + tot_char_count; + /* total number of words, lines, chars */ +@ + +The present chunk, which does the counting that is <tt>wc</tt>'s +<i>raison d'etre</i>, was actually one of the simplest to write. +We look at each character and change state if it begins or ends a word. +<<Scan file>>= +while (1) { + <<Fill [[buffer]] if it is empty; [[break]] at end of file>> + c = *ptr++; + if (c > ' ' && c < 0177) { + /* visible ASCII codes */ + if (!in_word) { + word_count++; + in_word = 1; + } + continue; + } + if (c == '\n') line_count++; + else if (c != ' ' && c != '\t') continue; + in_word = 0; + /* c is newline, space, or tab */ +} +@ + +Buffered I/O allows us to count the number of characters almost for +free. +<<Fill [[buffer]] if it is empty; [[break]] at end of file>>= +if (ptr >= buf_end) { + ptr = buffer; + c = read(fd, ptr, buf_size); + if (c <= 0) break; + char_count += c; + buf_end = buffer + c; +} +@ + +It's convenient to output the statistics by defining a new function +[[wc_print]]; then the same function can be used for the totals. +Additionally we must decide here if we know the name of the file we have +processed or if it was just [[stdin]]. +<<Write statistics for file>>= +wc_print(which, char_count, word_count, + line_count); +if (file_count) + printf(" %s\n", *argv); /* not stdin */ +else + printf("\n"); /* stdin */ +@ +<<Update grand totals>>= +tot_line_count += line_count; +tot_word_count += word_count; +tot_char_count += char_count; +@ + +We might as well improve a bit on Unix's <tt>wc</tt> by displaying +the number of files too. +<<Print the grand totals if there were multiple files>>= +if (file_count > 1) { + wc_print(which, tot_char_count, + tot_word_count, tot_line_count); + printf(" total in %d files\n", file_count); +} +@ + +Here now is the function that prints the values according to the +specified options. +The calling routine is supposed to supply a newline. +If an invalid option character is found we inform the user about proper +usage of the command. +Counts are printed in 8-digit fields so that they will line up in +columns. +<<Definitions>>= +#define print_count(n) printf("%8ld", n) +@ %def print_count +<<Functions>>= +wc_print(which, char_count, word_count, line_count) + char *which; /* which counts to print */ + long char_count, word_count, line_count; + /* given totals */ +{ + while (*which) + switch (*which++) { + case 'l': print_count(line_count); + break; + case 'w': print_count(word_count); + break; + case 'c': print_count(char_count); + break; + default: + if ((status & usage_error) == 0) { + fprintf(stderr, + "\nUsage: %s [-lwc] [filename ...]\n", + prog_name); + status |= usage_error; + } + } +} +@ %def wc_print + +Incidentally, a test of this program against the system <tt>wc</tt> +command on a SPARCstation showed that the ``official'' <tt>wc</tt> was +slightly slower. +Furthermore, although that <tt>wc</tt> gave an appropriate error message +for the options `[[-abc]]', it made no complaints about the options +`[[-labc]]'! +Dare we suggest that the system routine might have been better if its +programmer had used a more literate approach? + +<h2><a name=index>Index</a></h2> +<h3>Chunks +<nowebchunks> +<h3>Indifiers +<nowebindex> +</body> +</html> diff --git a/web/noweb/examples/whitespace b/web/noweb/examples/whitespace new file mode 100644 index 0000000000..5ac6c1d0f9 --- /dev/null +++ b/web/noweb/examples/whitespace @@ -0,0 +1,10 @@ + +# whitespace -- noweb filter to make multiple whitespace +# characters equivalent to a single space, so that +# << Hello World>>, <<Hello World>>, +# and <<Hello World >> all refer to the chunk +# <<Hello World>> + +sed -e '/^@use /s/[ \t][ \t]*/ /g' -e '/^@defn /s/[ \t][ \t]*/ /g' \ + -e '/^@use /s/[ \t]*$//g' -e '/^@defn /s/[ \t]*$//g' + |